On Thu, 19 Mar 2020 21:04:27 +0800, David Crayford <dcrayf...@gmail.com> wrote:
I think that sample is a perfect example why you shouldn't use REXX for
processing complex records!
All the magic number offsets and data conversions will only get worse as
the complexity of the program increases.
Which is why REXX has variables! Set the "magic numbers" once, in one place and reference
them by variable name. If the value changes, update the variable setting and nothing else needs to be
changed. Talk about "magic"! :-)>
I have written several REXX programs that use the Catalog Search Interface
(CSI, aka IGGCSI00). I figured out early on that a lot of the code for setup,
processing, and error decoding could be done with a set of common routines that
could be used in every REXX program that I create that uses CSI. That way, I
only have to code the unique parts for the particular processing I want to do
and then include the common code. Yes, you have to code offsets and/or lengths
for each Catalog Field you want to process, and those are documented in the
manual. (DFSMS Managing Catalogs).
The CSI Common Code and the REXX programs that use are not completely
independent of each other, (that is some variables need to be set in the main
program and used in the CSI Code some are set in the CSI Code and used in the
main program. Their are also two routines that must be defined in the main
program that are called from the CSI Common Code. The routines must be named
PROCESS_ENTRY: and ENTRY_ERROR: (The CSI Common code will Call PROCESS_ENTRY
for every Catalog Entry returned, PROCESS_ENTRY then Calls the correct routine
to process that entry. I set it up that way to allow multiple Catalog Entry
types to be processed in a single program.
Here is a working example of a REXX program I wrote (GDGINFO) that uses CSI to
extract and display information on one or GDG Catalog Entries. The REXX
program expects the GDG DSN as it's only parameter. The DSN specified to
GDGINFO must contain at least one period. It can be a full DSN, like
XXXXX.A.B, or a prefix like XXXX. It can also contain wildcards, like
XXXX.*.YYYYY or XXXX.userid.** CMDOUT is where the output is written to. It
can be written to SYSOUT or a data set. GDGINFO can be run in TSO Batch
(CMDOUT default to SYSOUT) or under TSO/ISPF (CMDOUT goes to a temporary file
that will be viewed. Here is some sample output from GDGINFO XXXX.
Data-Set-Name OwnerID Limit Defined Alter-Date
Extended? Empty? Order Purge? Scratch?
XXXX.A.B.C.D * 005 000 NEVER
NOEXTENDED NOEMPTY LIFO NOPURGE SCRATCH
XXXX.A * 002 000 2012-02-04
NOEXTENDED NOEMPTY LIFO NOPURGE SCRATCH
XXXX.A.B.C * 252 037 2012-10-10
NOEXTENDED NOEMPTY LIFO NOPURGE SCRATCH
XXXX.A.B,C.D * 005 000 2011-03-30
NOEXTENDED NOEMPTY LIFO NOPURGE NOSCRATCH
XXXX.A.B.C * 025 001 2009-01-29
NOEXTENDED EMPTY LIFO NOPURGE SCRATCH
XXXX.A.B.C * 020 020 2020-03-19
NOEXTENDED NOEMPTY LIFO NOPURGE SCRATCH
Ownerid is set to "*" if no owner is defined. Limit is how many generations
are allowed. Defined is how many generations are Cataloged. 000 means no generations
are currently Cataloged. Alter-Date is the last date that a generation was added or
deleted. NEVER means that no generation was ever created for this GDG.
EXTENDED/NOEXTENDED indicates whether the GDG allows a maximum of 255 generations
(NOEXTENDED) or a maximum of 999 generations (EXTENDED).
Here is the main REXX program with a "/*%INCLUDE CSICOM */" where the CSI
Common Code will go. I'll include the CSI Common Code after GDGINFO:
/*--------------------------- GDGINFO REXX ---------------------------*/
/* Extract and Display Information for the Specified GDG Definitions. */
/*--------------------------------------------------------------------*/
GDGINFO:
Parse Source . ctype ename eoutddn edsname . system subsys .
pgmvers = 1 /* Program Version */
msghdr = ename': ' /* Message Header for Say */
tso = (system = 'TSO')
ispf = (subsys = 'ISPF')
If \tso Then
Do
Say ename 'must be invoked from TSO.'
Exit 4
End
Address TSO
batch = (SYSVAR('SYSENV') = 'BACK')
outddn = 'CMDOUT' /* Output DD Name */
myuid = Userid()
Numeric Digits 10
Arg dsn .
If dsn = '' Then
Do
Say msghdr 'No Data Set Name Specified.'
Say msghdr 'A Data Set Name is Required.'
Exit 4
End
If Pos('.',dsn) = 0 Then
Do
Say msghdr 'Invalid Data Set Name Specified: ' dsn
Say msghdr 'A Data Set Name must contain at least one period.'
Exit 4
End
If Right(dsn,1) = '.' Then dsn = dsn'**'
Call DEFOUT
If result \= 0 Then Call EXIT result
Call CSI_INIT /* Initialize CSI Parameters */
/*--------------------------------------------------------------------*/
/* CSI Settings used by this Program. */
/*--------------------------------------------------------------------*/
gdgempty = '80'x /* GDGATTR - GDG EMPTY Parm */
gdgscr = '40'x /* GDGATTR - GDG SCRATCH Parm */
gdgfifo = '20'x /* GDGATTR - GDG FIFO Parm */
gdgpurge = '10'x /* GDGATTR - GDG PURGE Parm */
gdgext = '08'x /* GDGATTR - GDG EXTENDED Parm */
attlen = 1 /* Length of GDG Attributes Byte */
limlen = 2 /* Length of GDG Extended Limit */
altlen = 4 /* Length of GDG Alteration Date */
genlen = 4 /* Length of GDG Generations */
ownlen = 8 /* Length of Owner ID */
rec.0 = 0 /* Initialize Output Array Count */
gettype = 'GDG' /* Catalog Entry Type to Process */
n = WordPos(gettype,etypesi) /* Get Entry Number */
If n = 0 Then
Do
Say msghdr 'Invalid Entry Type Specified: ' gettype
Call EXIT 4
End
dtypes = Word(dtypesi,n) /* CSI Type(s) to Use */
/* CSI Field Names to Return */
fldnames = 'OWNERID GDGATTR GDGLIMTE GDGALTDT GENLEVEL'
gdghdr = 'Data-Set-Name OwnerID ',
'Limit Defined Alter-Date Extended? Empty? Order',
'Purge? Scratch?'
Call CSI_SET /* Initialize CSI Parameter List */
Call CSI_PROCESS /* Extract Catalog Information */
If rec.0 > 0 Then 'EXECIO' rec.0 'DISKW' outddn '(STEM REC. FINIS'
Call EXIT 0
/*---------------------------- GDG_ENTRY -----------------------------*/
/* Extract Information for GDG, (Generation Data Group), Entries. */
/*--------------------------------------------------------------------*/
GDG_ENTRY:
ptr2 = ptr1 + (fldlen*2) /* Point to Field Lengths */
lownerid = C2D(SubStr(csiwork,ptr2,fldlen)) /* Owner ID */
ptr2 = ptr2 + fldlen /* Skip Field Length */
lgdgattr = C2D(SubStr(csiwork,ptr2,fldlen)) /* Attribute */
ptr2 = ptr2 + fldlen /* Skip Field Length */
lgdglimte = C2D(SubStr(csiwork,ptr2,fldlen)) /* Limit */
ptr2 = ptr2 + fldlen /* Skip Field Length */
lgdgaltdt = C2D(SubStr(csiwork,ptr2,fldlen)) /* Alter Date */
ptr2 = ptr2 + fldlen /* Skip Field Length */
lgenlevel = C2D(SubStr(csiwork,ptr2,fldlen)) /* Generations */
ptr2 = ptr2 + fldlen /* Skip Field Length */
If lownerid < ownlen Then
Do
Say msghdr 'No Owner ID Returned for Entry: ' csiename
Return
End
If lgdgattr < attlen Then
Do
Say msghdr 'No GDG Attributes Returned for Entry: ' csiename
Return
End
If lgdglimte < limlen Then
Do
Say msghdr 'No GDG Limit Returned for Entry: ' csiename
Return
End
If lgdgaltdt < altlen Then
Do
Say msghdr 'No GDG Alteration Date Returned for Entry: ',
csiename
Return
End
ownerid = SubStr(csiwork,ptr2,ownlen)
ptr2 = ptr2 + ownlen /* Skip Owner ID */
gdgattr = SubStr(csiwork,ptr2,attlen)
ptr2 = ptr2 + attlen /* Skip Attribute */
gdglimte = Right(C2D(SubStr(csiwork,ptr2,limlen)),3,'0')
ptr2 = ptr2 + limlen /* Skip Limit */
gdgaltdt = Left(C2X(SubStr(csiwork,ptr2,altlen-1)),5)
If gdgaltdt = '00000' Then
altdate = 'NEVER '
Else
Do
altdate = Date('S',gdgaltdt,'J')
altdate = Translate('1234-56-78',altdate,'12345678')
End
If rec.0 = 0 Then Call BLDREC gdghdr
If ownerid = '' | Left(ownerid,1) == 'FF'x Then
ownerid = Left('*',8)
If BitAnd(gdgattr,gdgext) == gdgext Then
extopt = 'EXTENDED '
Else
extopt = 'NOEXTENDED'
If BitAnd(gdgattr,gdgempty) == gdgempty Then
empopt = 'EMPTY '
Else
empopt = 'NOEMPTY'
If BitAnd(gdgattr,gdgfifo) == gdgfifo Then
ordopt = ' FIFO'
Else
ordopt = ' LIFO'
If BitAnd(gdgattr,gdgpurge) == gdgpurge Then
puropt = 'PURGE '
Else
puropt = 'NOPURGE'
If BitAnd(gdgattr,gdgscr) == gdgscr Then
scropt = 'SCRATCH'
Else
scropt = 'NOSCRATCH'
If lgenlevel = 0 Then
gencnt = 000
Else
gencnt = Right(lgenlevel / genlen,3,'0')
Call BLDREC Left(csiename,44) ownerid Right(gdglimte,5),
Right(gencnt,7) altdate extopt empopt ordopt,
puropt scropt
Return
/*-------------------------- PROCESS_ENTRY ---------------------------*/
/* Process Data Set Entry Returned by CSI. */
/*--------------------------------------------------------------------*/
PROCESS_ENTRY:
Arg etype .
Select /* Entry Type */
When etype = 'GDG' Then Call GDG_ENTRY
Otherwise
Nop
End /* Select Entry Type */
Return
/*--------------------------- ENTRY_ERROR ----------------------------*/
/* Process Entry Errors. */
/*--------------------------------------------------------------------*/
ENTRY_ERROR:
toterr = toterr + 1
Call CSI_ENTRY_ERROR
Return
/*%INCLUDE CSICOM */
/*------------------------------ DEFOUT ------------------------------*/
/* Define the Output File (outddn). If running in Batch, Allocate */
/* the Output to Sysout, otherwise Allocate the Output to a Temporary */
/* Disk File that will be Viewed later. */
/*--------------------------------------------------------------------*/
DEFOUT: Procedure Expose batch outddn
Call 'BPXWDYN' 'INFO DD('outddn') INRTDSN(OUTDSN)'
If outdsn \= '' Then Return 0 /* "outddn" Allocated */
If batch Then
'ALLOCATE DDNAME('outddn') REUSE SYSOUT'
Else
'ALLOCATE DDNAME('outddn') REUSE DSORG(PS) UNIT(SYSDA)',
'RECFM(V,B) LRECL(255) SPACE(1,1) CYLINDER RELEASE'
Return rc
/*------------------------------ BLDREC ------------------------------*/
/* Build output array, (rec.), one record at a time. */
/*--------------------------------------------------------------------*/
BLDREC: Procedure Expose rec.
n = rec.0 + 1
rec.n = Arg(1)
rec.0 = n
Return
/*------------------------------- EXIT -------------------------------*/
/* End of Program processing. If running in Batch, just Exit. */
/* If not Batch, View the Output File and then Delete it. */
/*--------------------------------------------------------------------*/
EXIT:
Arg src .
If batch Then Exit src
If ispf & src = 0 Then
Do
Address ISPEXEC
'LMINIT DATAID(VIEWID) DDNAME('outddn')'
'VIEW DATAID('viewid')'
'LMFREE DATAID('viewid')'
Address TSO
End
'FREE DDNAME('outddn')'
Exit src
Here is the CSI Common Code used by GDGINFO and other REXX programs I have
written:
/*----- Begin Catalog Search Interface (CSI) Common Subroutines ------*/
/*--------------------------- CSI_PROCESS ----------------------------*/
/* Call the Catalog Search Interface, (CSI), Module, (IGGCSI00), to */
/* Retrieve Entries for the specified Entry Type and Data Set Name. */
/* CSI is documented in the "Catalog Search Interface User's Guide" */
/* Chapter in the "DFSMS Managing Catalogs" Manual. */
/*--------------------------------------------------------------------*/
CSI_PROCESS:
resume = 'Y' /* Set Resume Flag to "Y" */
pcsiename = '' /* Previous Entry Name */
Parse Value 0 With =1 totent =1 toterr =1 vvdsdsn .
Do While resume = 'Y'
Address LINKPGM 'IGGCSI00 CSIRSNRC CSIFIELD CSIWORK' /* CSI */
csirc = rc
If csirc > 0 Then
Do
Call CSI_ERROR /* Check Return Code/Reason Code */
If result > 0 Then Exit result /* Exit if Bad RC */
End
resume = SubStr(csifield,150,1) /* Resume Flag */
csiusdln = C2D(SubStr(csiwork,9,4)) /* Work Area Used */
ptr1 = hdrlen + 1 /* Starting Position (Skip Header) */
Do While ptr1 < csiusdln
csietype = SubStr(csiwork,ptr1+1,1) /* Entry Type */
If csietype = 0 Then
Do
Call CSI_CATALOG_ENTRY /* Process Catalog Entry */
ptr1 = ptr1 + catlen /* Skip Catalog Entry */
Iterate /* Do While ptr1 < csiusdln */
End
csieflag = SubStr(csiwork,ptr1,1) /* Entry Flag */
csiename = Strip(SubStr(csiwork,ptr1+2,44)) /* Entry Name */
vvdsdsn = (Left(csiename,10) = 'SYS1.VVDS.')
totent = totent + 1
If BitAnd(csieflag,csienter) == csienter Then
Do
Call ENTRY_ERROR
ptr1 = ptr1 + datlen + errlen /* Next Entry */
Iterate /* Do While ptr1 < csiusdln */
End
ptr1 = ptr1 + datlen /* Skip Default Data Entry */
csitotln = C2D(SubStr(csiwork,ptr1,2)) /* Data Length */
n = WordPos(csietype,dtypeso) /* Valid Entry Type ? */
If n = 0 Then
Do
Say msghdr 'Unknown Data Type for Entry: ' csiename
ptr1 = ptr1 + csitotln /* Next Entry */
toterr = toterr + 1
Iterate /* Do While ptr1 < csiusdln */
End
etypeo = Word(etypeso,n) /* Convert Entry Type */
Call PROCESS_ENTRY etypeo
ptr1 = ptr1 + csitotln /* Next Entry */
End /* Do While ptr1 < csiusdln */
If resume = 'Y' & pcsiename = csiename Then
Do /* Exit if we have tried to process this entry twice */
Say msghdr csiename 'cannot be Processed with the',
'Work Area Size provided - you must increase',
'the Work Area Size and Retry'
Exit 40
End
pcsiename = csiename
End /* Do While resume = 'Y' */
Return
/*------------------------ CSI_CATALOG_ENTRY -------------------------*/
/* Entry Returned from CSI is a Catalog. This may indicate an error. */
/*--------------------------------------------------------------------*/
CSI_CATALOG_ENTRY:
csicflg = SubStr(csiwork,ptr1,1) /* Catalog Flag */
Select /* Catalog Flag */
When csicflg == bzero Then Nop /* No Error */
When BitAnd(csicflg,csinoent) == csinoent Then
Do /* No Entries Found */
Say msghdr 'No Entries Found for DSN: ' dsn ' Type: ' etype
Exit 28
End
Otherwise
csicname = Strip(SubStr(csiwork,ptr1+2,44)) /* Catalog Name */
csicretn = SubStr(csiwork,ptr1+46,4) /* Catalog Error */
Say msghdr 'Error Processing CSI Request for Entry: ' dsn
Say msghdr 'CSICNAME='csicname
Say msghdr 'CSICFLG ='C2X(csicflg) /* Catalog Flag */
Call CSI_ERRCODE csicretn /* Decode Catalog Error */
Exit 32
End /* Select Catalog Flag */
Return
/*----------------------------- CSI_SET ------------------------------*/
/* Set CSI Variables and Build the CSI Parameter List. */
/*--------------------------------------------------------------------*/
CSI_SET:
csifiltk = Left(dsn,44) /* Data Set Name Filter Key */
csicatnm = Left(catname,44) /* Catalog Name to Process */
csidtyps = Left(dtypes,16) /* Entry Types to be Returned */
numflds = Words(fldnames) /* Number of Field Names */
csinumen = D2C(numflds,2) /* Number of Fields to Return */
csifldnm = '' /* List of 8 Byte Field Names */
Do f = 1 to numflds
csifldnm = csifldnm||Left(Word(fldnames,f),8)
End /* Do f = 1 to numflds */
/*--------------------------------------------------------------------*/
/* Build the Selection Criteria Fields part of the Parameter List. */
/*--------------------------------------------------------------------*/
csiopts = csicldi || csiresum || csis1cat || csioptns
csifield = csifiltk || csicatnm || csiresnm || csidtyps ||,
csiopts || csinumen || csifldnm
Return
/*----------------------------- CSI_INIT -----------------------------*/
/* Initialize CSI Variables and Variables that need to be set once. */
/*--------------------------------------------------------------------*/
CSI_INIT:
/*--------------------------------------------------------------------*/
/* Initialize Device Type Codes, Entry Types, and Reason Messages. */
/*--------------------------------------------------------------------*/
dasdlist = '3010200F 3390 3010200E 3380 30102004 9345'
tapelist = '78048081 3490 78048083 3590-1 78048080 3480X ',
'78008080 3480 32108003 3400-6 32008003 3400-5',
'30C08003 3400-2 33008003 3400-9 34008003 3400-3'
etypesi = 'NONVSAM GDG CLUSTER AIX GDS PATH UCAT ALIAS',
'ATLLIB ATLVOL CATCBD'
dtypesi = 'A B C G H R U X ',
'L W Z '
etypeso = etypesi 'DATA INDEX'
dtypeso = dtypesi 'D I '
rsnmsg. = 'Unknown Reason Code'
rsnmsg.1 = 'Insufficent Storage for GETMAIN, Increase Region Size.'
rsnmsg.2 = 'Invalid Entry Type in CSIDTYPS.'
rsnmsg.3 = 'Invalid Data/Index Option in CSICLDI, Should be "Y"',
'or Blank.'
rsnmsg.4 = 'Invalid Resume Option in CSIRESUM, Should be "Y" or',
'Blank.'
rsnmsg.5 = 'Invalid Search One Catalog Option in CSIS1CAT, Should',
'be "Y" or Blank.'
rsnmsg.6 = 'Invalid Number of Fields in CSINUMEN, Should be',
'between Zero and 100, Inclusive.'
rsnmsg.7 = 'Invalid Work Area Length, Should be between 1024 and',
'8,388,608, Inclusive.'
rsnmsg.8 = 'Invalid Length Option in CSIOPTNS, Should be "F" or',
'Blank.'
/*------------ Reason Codes 9 and 10 Added in z/OS V2.2. ------------*/
rsnmsg.9 = 'Entry Type "Z" must be the only Entry Type in CSIDTYPS.'
rsnmsg.10 = 'Entry Type "Z" request contains an invalid Field Name.'
/*------------ Reason Codes 11 and 12 Added in z/OS V2.3. ------------*/
rsnmsg.11 = 'CSIRESUM is Set to "Y" and CSIRESNM is zeroes.'
rsnmsg.12 = '"Z" Entry Field Names cannot be used with non-"Z"',
'Entry Type requests.'
/*--------------------------------------------------------------------*/
/* Initialize CSI Parameters. */
/*--------------------------------------------------------------------*/
csirsnrc = Left(' ',4) /* CSI Module Return/Reason Code */
catname = Left(' ',44) /* Catalog Name to Search */
csiresnm = Left(' ',44) /* Resume Data Set Name */
csicldi = 'Y' /* Return Data/Index for Cluster */
csiresum = ' ' /* Resume Flag (More Entries) */
csis1cat = 'Y' /* Search Only 1 Catalog */
csioptns = ' ' /* Use Halfword Length Fields */
/*--------------------------------------------------------------------*/
/* Initialize Flags and Length Variables. */
/*--------------------------------------------------------------------*/
bzero = '00'x /* Binary Zero - No Errors */
csinticf = '80'x /* CSICFLG - Non-ICF Catalog */
csinoent = '40'x /* CSICFLG - No Entries Found */
csintcmp = '20'x /* CSICFLG - Data not Complete */
csicerr = '10'x /* CSICFLG - Catalog Error */
csicerrp = '08'x /* CSICFLG - Catalog Error */
csipment = '80'x /* CSIEFLAG - Primary Entry */
csienter = '40'x /* CSIEFLAG - Entry Error */
csiedata = '20'x /* CSIEFLAG - Entry has Data */
/*---- Work Area Max Size = 1MiB. Inceased to 8MiB in z/OS V2.2 -----*/
worklen = 1*(1024*1024) /* Length of Work Area 1MiB */
hdrlen = 14 /* Length of Work Area Header */
catlen = 50 /* Length of Catalog Entry */
datlen = 46 /* Length of Dataset Entry */
errlen = 4 /* Length of Error Entry */
If csioptns = ' ' Then
fldlen = 2 /* Length of Field Length Entry */
Else
fldlen = 4 /* Length of Field Length Entry */
/*--------------------------------------------------------------------*/
/* Initialize and Build Work Area output part of the Parameter List. */
/*--------------------------------------------------------------------*/
csiusrln = D2C(worklen,4)
csiwork = csiusrln || Copies('00'x,worklen-4)
Return
/*------------------------- CSI_ENTRY_ERROR --------------------------*/
/* Process CSI Entry Errors. */
/*--------------------------------------------------------------------*/
CSI_ENTRY_ERROR:
Say msghdr 'Error Processing CSI Request for Entry: ' csiename
Say msghdr 'CSIEFLAG='C2X(csieflag)
csiretn = SubStr(csiwork,ptr1+46,4) /* Entry Error */
Call CSI_ERRCODE csiretn /* Decode Entry Error */
Return
/*---------------------------- CSI_ERROR -----------------------------*/
/* Check and Process the CSI Module Return Code and Reason Code. */
/* CSI Module Return Codes and Reason Codes are documented in Chapter */
/* "Catalog Search Interface User's Guide" in the "DFSMS Managing */
/* Catalogs" Manual. */
/*--------------------------------------------------------------------*/
CSI_ERROR:
Call CSI_ERRCODE csirsnrc, 'QUIET' /* Decode Module Error */
Select /* Return Code */
When csirc = 4 Then /* Some Catalog Information Returned */
Select /* retcode */
When retcode = 100 Then /* Catalog/DSN Error Detected */
Do
If rsncode = 4 Then Return 0 /* DSN Entry Error */
If rsncode = 8 Then Nop /* Cat Entry Error */
End
When retcode = 122 Then /* Invalid Filter Key */
Do
Say msghdr 'Invalid CSI Filter Key',
'(Data Set Name): ' csifiltk
Call CSI_ERRCODE csirsnrc /* Decode Module Error */
Return retcode
End
Otherwise
Nop
End /* Select retcode */
When csirc = 8 Then /* CSI Failure */
Do
Say msghdr rsncode rsnmsg.rsncode /* Reason Code Msg */
Return csirc
End
Otherwise
Nop
End /* Select Return Code */
Say msghdr 'Error' csirc 'from Call to CSI'
Call CSI_ERRCODE csirsnrc /* Decode Module Error */
ptr3 = hdrlen + 1 /* Skip Header */
csicflg = SubStr(csiwork,ptr3,1) /* Catalog Flag */
csicname = Strip(SubStr(csiwork,ptr3+2,44)) /* Catalog Name */
csicretn = SubStr(csiwork,ptr3+46,4) /* Catalog Error */
Say msghdr 'Catalog Entry Error Information:'
Say msghdr 'CSICNAME='csicname
Say msghdr 'CSICFLG ='C2X(csicflg)
Call CSI_ERRCODE csicretn /* Decode Catalog Error */
ptr3 = ptr3 + catlen /* Skip Catalog Entry */
csieflag = SubStr(csiwork,ptr3,1) /* Entry Flag */
csiename = Strip(SubStr(csiwork,ptr3+2,44)) /* Entry Name */
csiretn = SubStr(csiwork,ptr3+46,4) /* Entry Error */
Say msghdr 'Dataset Entry Error Information:'
Say msghdr 'CSIENAME='csiename
Say msghdr 'CSIEFLAG='C2X(csieflag)
Call CSI_ERRCODE csiretn /* Decode Entry Error */
Return csirc
/*--------------------------- CSI_ERRCODE ----------------------------*/
/* Decode Error Data into Module ID, Return Code, and Reason Code. */
/* CSI Return Codes and Reason Codes are documented in Message */
/* IDC3009I in one of the "MVS System Messages" Manuals. */
/*--------------------------------------------------------------------*/
CSI_ERRCODE:
Parse Arg csicodes, parm, .
Parse Var csicodes =1 modid +2 rsncode +1 retcode +1 .
If modid << 'AA' | modid >> '99' Then modid = C2X(modid)
retcode = C2D(retcode)
rsncode = C2D(rsncode)
If parm = 'QUIET' Then Return
Say msghdr 'ModID='modid 'Return Code='retcode,
'Reason Code='rsncode
Return
/*----- End Catalog Search Interface (CSI) Common Subroutines ------*/
I know this is long post, but I hope it will be helpful to the OP and to anyone
else that wants to write REXX programs that extract Catalog information using
CSI. If anyone has questions about the code, either post them here or email me
directly. If you want to see other examples, let me know that also.
FYI, we used the output from GDGINFO to help get rid of many unused GDG
definitions!
