🚀 go-pugleaf

Attached is an experimental program to do this using the formal
interface -- SVC 26.  Note that this is undocumented and unsupported.
When asked for documentation, IBM replied that it is an internal
interface, not for customer use, or some such thing, implying that
they may change it incompatibly at any time without warning.  But I
doubt it.

SVC 26 and the CTGPL/CTGFL also can be used to update catalog fields.
APF authorization and some magical knowledge of how to build the
parm structure is required.  If you want to know how to do this, read
the PL/S source like I did...  Then guess, cross your fingers, and
hope.  (And try it on catalogs you don't care about!!!)

The catalog field names are not easy to determine.  Search LPA for
modules containing C'ENTYPE  ' and look around at the other 8 byte
constants surrounding it.  Not all field types are valid for all entry
types.

*Note*:  This is a very crude program that I wrote just for poking
around.  Please don't ask me to send the macros so that you can
assemble it.  (The IEZCTGPL and IEZCTGFL macros must be obtained from
the "optional" material tapes.)  This is a sample only.  Use at your
own risk.  Etc.


Leonard D. Woren
Senior MVS Systems Programmer
<LDW@USCMVSA.BITNET>  <LDW@MVSA.USC.EDU>
University of Southern California


VSDFLDS  TITLE '-----  Display Catalog fields for VSAM datasets  -----'
*---------------------------------------------------------------------*
*                                                                     *
*   Program name:  VSDFLDS                                            *
*                                                                     *
*   Purpose:       Issue SVC 26 and display any desired catalog       *
*                  entry for any VSAM dataset.                        *
*                                                                     *
*   Author:        Leonard D. Woren                                   *
*                                                                     *
*   Date:          November 19, 1989                                  *
*                                                                     *
*   Attributes:    none                                               *
*                                                                     *
*   Installation:  University of Southern California                  *
*                                                                     *
*   Updates:                                                          *
*      00mmm88  Unnn LDW - None                                       *
*                                                                     *
*---------------------------------------------------------------------*
         EJECT ,
VSDFLDS  OSENTER  EXIT=LEAVE,RC=(R15),GETMAIN=(WORKLEN,WORKD,ZERO)
         SPACE 1
LOOP1    TPUTX 'Enter dsname or "end"'
         LA    R1,INBUFF
         TGET  (1),L'INBUFF
         LTR   R15,R15
         BNZ   LEAVE
         OC    INBUFF,BLANKS
         CLC   =C'END',INBUFF
         BE    LEAVE
         MVC   DSN,INBUFF
         SPACE 2
LOOP2    TPUTX 'Enter field name or "end"'
         LA    R1,INBUFF
         TGET  (1),L'INBUFF
         LTR   R15,R15
         BNZ   LEAVE
         OC    INBUFF,BLANKS
         CLC   =C'END',INBUFF
         BE    LOOP1
         SPACE 2
         LA    R3,AREACTG
         USNGX CTGPL,R3
         XC    0(CTGPLLEN,R3),0(R3)     clear CTGPL
         XC    RTNAREA(RTNAREAL),RTNAREA  clear return workarea
         LA    R0,RTNAREA
         ST    R0,CTGWKA                set data return area addr
         MVC   RTNAREA(2),=Y(RTNAREAL-4)  set length of area
         OI    CTGOPTN1,CTGNAME         indicate 44 byte name
         OI    CTGOPTN3,CTGAM0          indicate os/vs2 catlg request
         OI    CTGOPTN3,CTGLOC          indicate "locate"
         LA    R0,DSN
         ST    R0,CTGENT
*                ,ctgpswd=@pswd
         LA    R1,FPLAREA               entype FPL
         ST    R1,CTGFIELD
         XC    FPLAREA(FPLAREAL),FPLAREA  clear FPL area
*
         LA    R4,FPLAREA               -> first FPL
         USNGX CTGFL,R4
         MVI   CTGFLDNO,1
         LA    R1,INBUFF                -> CL8'field_name'
         ST    R1,CTGFLDNM              set address of field name
         MVI   CTGNOFLD,1               set number of fields
*
         DROPX R4                       ctgfl
         SPACE 2
FUNC3    EQU   *
*              CTGCNAME => ctgcat points to cat name
*%%%     OI    CTGOPTN1,CTGBYPSS        bypass cat auth checking
*%%%     OI    CTGOPTN4,CTGCOIN         controller intercept requested
*%%%     MODESET  KEY=ZERO              required for above flags
         LA    R1,CTGPL                 -> parmlist
         SVC   26                       invoke catalog management
         LR    R2,R15                   save return code
*%%%     MODESET  KEY=NZERO
         LTR   R15,R2                   test return code
         BZ    LOC$OK
         ST    R2,WORK1
         MVC   MSG(34),=C'SVC 26 (for LOCATE) return code = '
         HEX   MSG+34,WORK1,LEN=4
         TPUTX MSG,42
         LA    R15,1000(,R2)            set my return code
         B     LEAVE                    bail out
         SPACE 2
LOC$OK   TPUTX 'LOCATE ok!'
         L     R1,CTGFIELD+4*0          -> first FPL
         LH    R2,CTGFLNG-CTGFL(,R1)    data length
         L     R3,CTGFLPT-CTGFL(,R1)    -> data
         MVC   MSG,BLANKS
         HEX   MSG+00,(00,R3),LEN=4
         HEX   MSG+09,(04,R3),LEN=4
         HEX   MSG+19,(08,R3),LEN=4
         HEX   MSG+28,(12,R3),LEN=4
         TPUTX MSG,36
         B     LOOP2
         SPACE 2
         LTORG ,
         SPACE 2
BLANKS   DC    CL80' '
         HEXTAB  DUAL=NO
         SPACE 3
WORKD    DSECT ,                        resume
WORK1    DS    F                        general work area
DSN      DS    CL44
INBUFF   DS    CL80
RTNAREA  DS    50F
RTNAREAL EQU   *-RTNAREA
FPLAREA  DS    6F                       24 byte entries for FPLs
FPLAREAL EQU   *-FPLAREA
MSG      DS    CL80
         EJECT ,
         IEZCTGPL  ,
         EJECT ,
         IEZCTGFL  ,
         EJECT ,
WORKD    DSECT ,                        resume
AREACTG  DS    0F,(CTGPLLEN)X
         DS    4F                       space for 4 more FPL pointers
WORKLEN  EQU   *-WORKD                  length to getmain
         SPACE 2
         END