Rexx Tools

------- $INDEX -------
______________________________________________________________________
|REXX TOOL |DESCRIPTION |
|___________|__________________________________________________________|
| | |
|ADDMEM |GENERATE SCL FOR ADDING ELEMENTS TO ENDEVOR. |
| | |
|ASMPROG |GENERATES THE DESCRIPTION OF THE ASSEMBLER PROGRAMS |
| | |
|ASMREPT |REPORT OF NO OF TIMES CHANGED AND NO OF CHGS DONE. |
| | |
|CHKSTAT |DISPLAYS THE JOBS THAT ARE IN THE HELD QUEUE |
| | |
|CIRCREXX |ABC CIRC STAT CONVERSION PROJECT |
| | |
|COBTOEZ |CONVERT COBOL COPYBOOK TO EASYTRIEVE COPYBOOK |
| | |
|COMMASPT |REFORMAT DATA DELIMITED BY COMMA (BATCH MODE) |
| | |
|COPYMEM |COPY MEMBERS FROM A SOURCE PDS TO DEST PDS (ONLINE) |
| | |
|CREADSN |CREATES PDS FOR NEWMAG SETUP |
| | |
|DELMEM |DELETES MEMBERS OF A PDS WITH PATTERNS |
| | |
|DRPSFP |DISPLAY DR, PS AND FP PARMS OF A JCL IN PRODUCTION |
| | |
|DSCOPY |MANIPULATE A DATASET USING COBOL COPYBOOK |
| | |
|DSNLIST |DISPLAYS DSN LIST MATCHING A PATTERNS |
| | |
|ENDVUTIL |MAIN PROGRAM FOR ENDEVOR UTILITY |
| | |
|FACTRIAL |CALCULATE FACTORIAL OF A NUMBER - RECURSION |
| | |
|FILRDTMP |TEMPLATE FOR READING A FILE AND WRITING OUTPUT |
| | |
|GDGUTIL |GENERATE JOB TO CREATE GDGS |
| | |
|JC |TO CUT LINES FROM AN EDIT SESSION |
| | |
|JCLCK |JCL CHECK UTILITY |
| | |
|JCLGEN |GENERATE JCLS BY FILE TAILORING A SKELETON |
| | |
|JCLINFO |CREATE ACCOUNTING INFO FOR JCLS |
| | |
|JHSREPT |GENERATE PROGRAM STATISTICS FROM JHS OUTPUT |
| | |
|JP |PASTE LINES TO EDIT SESSION WHICH ARE CUT USING JCUT |
| | |
|KEYCHANG |CHANGE DEFAULT FUNCTIONS OF FUNCTION KEYS |
| | |
|LIMIT |DISPLAY GDG LIMIT |
| | |
|NXTSTR |FIND THE NEXT OCCURANCE OF THE STRING AT CURSOR POS |
| | |
|PBAR |CALCULATE TIME ELAPSED BETWEEN A TASK |
| | |
|PGMKEY |USE A FUNCTION KEY FOR MULTIPLE PURPOSE |
| | |
|PRODCNT |THIS TOOL GENERATES THE PRODUCTION COUNTS FOR PROGRAMS |
| | |
|RECURSE |DETERMINING PROGRAM CALLS USING RECURSION CONCEPT |
| | |
|RETMEM |GENERATE SCL FOR RETRIEVING ELEMENTS FROM ENDEVOR. |
| | |
|REXXCHAT |CHAT UTILITY |
| | |
|REXXMAC |PROCESS AN ISPF EDIT MACRO ON EVERY MEMBER OF A PDS |
| | |
|SUPRC |SUPERCE UTILITY |
| | |
|TABLEDEM |DEMONSTRATE ISPF TABLE FUNCTIONS |
| | |
|UTILREXX |GENERATE SYSINS TO CREATE GDGS |
| | |
|VENDOR |VENDOR SETUP UTILITY |
| | |
|VERSION |DISPLAY LATEST VERSION OF A GDG BASE |
| | |
|VERT |GENERATE VERTICAL TRACEABILTY MATRIX |
| | |
|WRPCOND |GENERATE COBOL STATEMENTS FOR WRAP INCLUSION CONDITIONS |
| | |
|WRPVAR |GENERATE COBOL VAR DECLARATION FOR WRAP INCLUSIONS |
| | |
|ZIPGEN |GENERATE ZIP CODES TO BE USED IN COBOL PROGRAMS |
|___________|__________________________________________________________|
------- ADDMEM -------
/******************************* REXX *********************************/

/* */
/* CREATES SCL FOR ADDING/UPDATING ELEMENTS TO ENDEVOR */
/* */
/* AUTHOR : BALU SUBRAMONIAM V */
/* */
/* INPUT LAYOUT : */
/* -------------- */
/* */
/* ELEMENT NAME 01-10 */
/* ENVIRONMENT 12-04 */
/* SYSTEM 24-08 */
/* SUBSYSTEM 33-08 */
/* TYPE 43-10 */
/* */
/******************************* REXX *********************************/
ADDRESS TSO
MSGVAL = MSG('OFF')
LSTDS = ""
OUTDS = ""
SRCEDS = ""
P = ""
A = ""
E = "E"
COMMENTS = ""
ERR = "<<< ENTER THE REQUIRED INPUTS !!! >>>"
ADDRESS ISPEXEC
"LIBDEF ISPPLIB DATASET ID('M#T053.BALU.REXX.PANEL')"
"ADDPOP "
"DISPLAY PANEL(ADDMEM)"
DO WHILE KEYPB <> 'PF03'
SELECT
WHEN KEYPB = 'PF03' THEN

DO
EXIT
END
OTHERWISE
DO
CALL EXEC_PGM
ADDRESS ISPEXEC
"REMPOP "
"ADDPOP "
"DISPLAY PANEL(ADDMEM)"
END
END
END
MSGVAL = MSG(MSGVAL)
EXIT
EXEC_PGM :
/* INPUT DATASETS VALIDATION */
IF SYSDSN("'"LSTDS"'") \= "OK" THEN DO

ERR = "<<< LIST DATASET IS NOT FOUND !!! >>>"
RETURN
END
IF SYSDSN("'"SRCEDS"'") \= "OK" THEN DO

ERR = "<<< SOURCE DATASET IS NOT FOUND !!! >>>"
RETURN
END
ADDRESS TSO
"ALLOC DD(LSTFILE) DA('"LSTDS"') SHR REU"
"EXECIO * DISKR LSTFILE (STEM LST. FINIS"
"FREE F(LSTFILE)"
O = 1
OUT.O = " SET STOPRC 16 . "

O = O + 1
/* GENERATE THE SCLS */
DO I = 1 TO LST.0
ELMT = STRIP(SUBSTR(LST.I,1,10))
ENV = STRIP(SUBSTR(LST.I,12,4))
SYS = STRIP(SUBSTR(LST.I,24,8))
SUB = STRIP(SUBSTR(LST.I,33,8))
TYP = STRIP(SUBSTR(LST.I,43,10))
IF A = "A" THEN OPRT = "ADD"

IF A = "U" THEN OPRT = "UPDATE"
OUT.O = " "||OPRT|| " ELEMENT "|| "'"||ELMT|| "'"

O = O + 1
OUT.O = " FROM DSNAME "|| "'"|| SRCEDS || "'"
O = O + 1
OUT.O = " TO ENVIRONMENT " ||"'"|| ENV || "'" ||,
" SYSTEM " ||"'"|| SYS || "'" ||,
" SUBSYSTEM " ||"'"|| SUB ||"'"
O = O + 1
OUT.O = " TYPE "|| "'"||TYP|| "'"
O = O + 1
OUT.O = " OPTIONS CCID "|| "'"||USERID()|| "'" ||,
" COMMENTS '"|| COMMENTS ||"'"
O = O + 1
/* PROC GP IF REQUIRED OR ONLY FOR COBOL/ASSEMBLR */

IF P = "Y" & (SUBSTR(TYP,1,3) = "COB" | SUBSTR(TYP,1,3) = "ASS" )
THEN DO
IF TYP = "COBOL" THEN PRCGRP = "'COBNBLVU'"
IF TYP = "COBOL2" THEN PRCGRP = "'CO2NBLVU'"
IF TYP = "COBOL370" THEN PRCGRP = "'CO3NBLVU'"
IF TYP = "ASSEMBLR" THEN PRCGRP = "'ASMNBLVU'"
OUT.O = " PROC GROUP " || PRCGRP
O = O + 1
END
OUT.O = " ."
O = O + 1
END
/* WRITE TO OUTPUT */
ADDRESS TSO
"ALLOC DD(OUTFILE) DA('"OUTDS"') SHR REU"
"EXECIO * DISKW OUTFILE (STEM OUT. FINIS"
IF RC \= 0 THEN DO
ERR = "USE PDS(MEM) (OR) USE EXST PS FOR O/P"
RETURN
END
ADDRESS TSO
"FREE F(OUTFILE)"
IF E = "E" THEN DO
ADDRESS ISPEXEC
"EDIT DATASET('"OUTDS"')"
END
IF E = "S" THEN DO
USR = USERID()
ADDRESS ISPEXEC
"VPUT (USR,OUTDS) PROFILE"
"LIBDEF ISPSLIB DATASET ID('M#T053.BALU.REXX.SKELETON')"
ADDRESS TSO
"ISPEXEC LIBDEF ISPFILE"
"ALLOC REUSE FI(SELFILE) DA('MTAT.TATA.WORKAREA') SHR"
"ISPEXEC LIBDEF ISPFILE LIBRARY ID(SELFILE)"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL ENDBTCH"
"ISPEXEC FTCLOSE NAME(ENDBTCH)"
"FREE FI(SELFILE)"
ADDRESS TSO
"SUBMIT 'MTAT.TATA.WORKAREA(ENDBTCH)'"
ERR = "<<< JOB IS SUBMITTED FOR ADD/UPD !! >>>"

RETURN
END
ERR = "<<< SCL GENERATION COMPLETE !! >>>"
RETURN
------- ASMPROG -------
/******************************* REXX *********************************/

/* */
/* GENERATES THE DESCRIPTION OF THE ASSEMBLER PROGRAMS */
/* */
/* INPUTS : */
/* -------- */
/* */
/* LISTING PDS : PDS WHICH CONTAINS THE ASM PRG LISTING */
/* SEARCH LIB : LIBRARY WHERE THE ASM PGMS RESIDE */
/* */
/* OUTPUT : */
/* -------- */
/* */
/* OUTPUT PS : PS WHICH CONTAINS PROGRAM NAME AND DESCRIPTION */
/* DESCRIPTION IS OBTAINED FROM THE TITLE IN ASM */
/* PROGRAM. */
/* */
/* */
/******************************* REXX *********************************/
SAY 'ENTER LISTING PDS :'

PULL LISTPDS
SAY 'ENTER SEARCH LIB :'
PULL SRCHLIB
SAY 'ENTER OUTPUT DS:'
PULL OUTDS
OUTDS = "'" || OUTDS || "'"
IF SYSDSN(OUTDS) \= "OK" THEN DO
SAY "OUTDS NOT PRESENT, IT IS CREATED !!!"

ADDRESS TSO
"ALLOCATE DA("OUTDS") NEW SPACE(50,50) DSORG(PS) ,
RECFM(F,B) LRECL(133) BLKSIZE(27930) MGMTCLAS(XTRABKUP) F(LIS1)"
"FREE DD (LIS1) NOHOLD"
END
ADDRESS ISPEXEC
"CONTROL ERRORS RETURN"

"LMINIT DATAID(PDSID) DATASET('"LISTPDS"') ENQ(SHR)"
"LMOPEN DATAID("PDSID")"
STOP = 0
"LMMLIST DATAID("PDSID") OPTION(LIST) MEMBER(MEM)"
K = 1
DO WHILE STOP = 0
MEM = STRIP(MEM)
PDSMEM = SRCHLIB ||"(" || MEM || ")"
RECORD = " "
ADDRESS TSO
"ALLOC DD(PRGFILE) DA('"PDSMEM"') SHR REU"
"EXECIO * DISKR PRGFILE (STEM PRG. FINIS"
"FREE F(PRGFILE)"
DO I = 1 TO PRG.0
IF STRIP(SUBSTR(PRG.I,10,6)) = "TITLE" THEN DO
DESC = SUBSTR(PRG.I,POS("TITLE",PRG.I)+6,LENGTH(PRG.I)-24)
J = I + 1
IF SUBSTR(PRG.I,72,1) = "X" THEN

DESC = DESC || STRIP(SUBSTR(PRG.J,1,LENGTH(PRG.I)-24))
IF POS("-",DESC) > 0 THEN DO

LENL = LENGTH(DESC)-(POS("-",DESC))
DESC = SUBSTR(DESC,POS("-",DESC)+2,LENL)
IF POS("'",DESC) > 0 THEN
DESC = SUBSTR(DESC,1,POS("'",DESC)-1)
END
ELSE IF POS(":",DESC) > 0 THEN DO
LENL = LENGTH(DESC)-(POS(":",DESC))
DESC = SUBSTR(DESC,POS(":",DESC)+2,LENL)
IF POS("'",DESC) > 0 THEN
DESC = SUBSTR(DESC,1,POS("'",DESC)-1)
END
ELSE DO
DESC = STRIP(DESC)
DESC = SUBSTR(DESC,2,LENGTH(DESC)-2)
END
DESC = STRIP(DESC)
RECORD = LEFT(MEM,10) || DESC
LEAVE
END
END
IF RECORD = " " THEN OUTREC.K = LEFT(MEM,10) || "DESC NOT FOUND"

ELSE OUTREC.K = RECORD
K = K + 1
ADDRESS ISPEXEC
"LMMLIST DATAID("PDSID") MEMBER(MEM) OPTION(LIST)"
STOP = RC
END
ADDRESS TSO
"ALLOC DD(OUTFILE) DA("OUTDS") SHR REU"
"EXECIO * DISKW OUTFILE (STEM OUTREC. FINIS"
"FREE F(OUTFILE)"
ADDRESS ISPEXEC
"LMMLIST DATAID("PDSID") OPTION(FREE)"
"LMCLOSE DATAID("PDSID")"
"LMFREE DATAID("PDSID")"
EXIT
------- ASMREPT -------
/******************************* REXX *********************************/

/* */
/* TAKES THE LISTING AND GENERATES REPORT OF NO OF TIMES */
/* PROGRAM CHANGED AND NO OF CHANGES DONE. */
/* */
/* INPUT : */
/* LISTING DATASET - COMPILE LISTING OF PROGRAMS */
/* */
/* OUTPUT : */
/* */
/* OUTPUT DATASET - DATASET WHERE REPORT IS WRITTEN */
/* */
/* */
/******************************* REXX *********************************/
SAY "ENTER LISTING DATASET : "

PULL LSTDS
SAY "ENTER OUTPUT DATASET : "
PULL OUTDS
ADDRESS TSO
"FREE F(LSTFILE)"
O = 1
/* INITIALIZE FOR FIRST TIME */

PROGRAM = LEFT(STRIP(SUBSTR(LST.1,11,8)),10)
Y2000C = RIGHT(0,5)
Y2001C = RIGHT(0,5)
Y2002C = RIGHT(0,5)
Y2003C = RIGHT(0,5)
Y2004C = RIGHT(0,5)
Y2000N = RIGHT(0,5)
Y2001N = RIGHT(0,5)
Y2002N = RIGHT(0,5)
Y2003N = RIGHT(0,5)
Y2004N = RIGHT(0,5)
DO I = 1 TO LST.0
IF SUBSTR(LST.I,2,8) = "ELEMENT:" THEN

DO
IF STRIP(SUBSTR(LST.I,11,8)) = STRIP(PROGRAM) THEN ITERATE
/* PROGRAM YEAR # OF CHGS # OF TIMES */

/*--------------------------------------------------------------*/
OUTREC.O = PROGRAM || " 2000 " || Y2000C || " " || Y2000N
O = O + 1
O = O + 1
O = O + 1
O = O + 1
O = O + 1
PROGRAM = LEFT(STRIP(SUBSTR(LST.I,11,8)),10)
/* INITIALIZE */
Y2000C = RIGHT(0,5)
Y2001C = RIGHT(0,5)
Y2002C = RIGHT(0,5)
Y2003C = RIGHT(0,5)
Y2004C = RIGHT(0,5)
Y2000N = RIGHT(0,5)
Y2001N = RIGHT(0,5)
Y2002N = RIGHT(0,5)
Y2003N = RIGHT(0,5)
Y2004N = RIGHT(0,5)
END
ELSE
DO
IF SUBSTR(LST.I,30,2) = "00" THEN
DO
Y2000C = RIGHT(Y2000C + STRIP(SUBSTR(LST.I,57,4)) ,
+ STRIP(SUBSTR(LST.I,67,4)),5)
Y2000N = RIGHT(Y2000N + 1,5)
END
DO
Y2001N = RIGHT(Y2001N + 1,5)
END
DO
Y2002N = RIGHT(Y2002N + 1,5)
END
DO
Y2003N = RIGHT(Y2003N + 1,5)
END
DO
Y2004N = RIGHT(Y2004N + 1,5)
END
END
END
/* WRITE THE LAST PROGRAM */
O = O + 1
O = O + 1
O = O + 1
O = O + 1
ADDRESS TSO
"FREE F(OUTFILE)"
SAY "COMPLETED !!!"

EXIT
------- CHKSTAT -------
/* THIS REXX DISPLAYS THE JOBS THAT ARE IN THE HELD QUEUE */
/* FOR STATUS OF OTHER QUEUE(S) CHANGE PARM VALUES ACCORDINGLY */
ADDRESS ISPEXEC "SELECT PGM(ISFISP) PARM(H) NEWAPPL(TCS)"
EXIT
------- CIRCREXX -------
/******************************* REXX *********************************/

/* */
/* ABC CIRC STAT CONVERSION PROJECT */
/* */
/**********************************************************************/
/*------------------*/
/* INPUT SECTION :- */
/*------------------*/
SAY "ENTER MAGAZINE DETAILS DATASET :"

PULL LSTDS
SAY "ENTER SKELETON DATASET :"

PULL SKELDS
SAY "ENTER SKELETON NAME :"

PULL SKELMEM
SAY "ENTER OUTPUT DATASET :"

PULL OUTDS
IF SYSDSN("'"SKELDS"'") \= "OK" THEN DO

SAY "UNABLE TO LOCATE SKELETON DATASET !!!"
EXIT
END

SAY "UNABLE TO LOCATE INPUT DATASET !!!"
EXIT
END
/*-----------------------------------------*/
/* IF OUTPUT DATASET NOT FOUND THEN CREATE */
/*-----------------------------------------*/
IF SYSDSN("'"OUTDS"'") \= "OK" THEN DO

SAY OUTDS || " - DATASET NOT FOUND, IT IS CREATED !!!"
ADDRESS TSO
"ALLOCATE DA('"OUTDS"') NEW DIR(100) SPACE(90,90) DSORG(PO) ,
END
ADDRESS TSO
"FREE F(LSTFILE)"
DO I = 3 TO LST.0
/*------------------------*/
/* PARSING THE INPUT FILE */
/*------------------------*/
USRID = USERID()
MG = SUBSTR(LST.I,1,2)
ISSUE = SUBSTR(LST.I,10,4)
WEEK = SUBSTR(LST.I,16,2)
REGION = STRIP(SUBSTR(LST.I,21,6))
FMSLIR = STRIP(SUBSTR(LST.I,28,8))
SCSSLIR = SUBSTR(LST.I,38,1)
ELM = MG || ISSUE || WEEK
TYPE = " "
IF SUBSTR(FMSLIR,1,1) = "G" THEN TYPE = "RL1"

ELSE TYPE = "RL2"
/*------------------------*/
/* TAILORING THE SKELETON */
/*------------------------*/
ADDRESS ISPEXEC
"VPUT (USRID,MG,ISSUE,WEEK,REGION,FMSLIR,SCSSLIR,TYPE)"
"LIBDEF ISPSLIB DATASET ID('"SKELDS"')"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('"OUTDS"') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL "SKELMEM""
"ISPEXEC FTCLOSE NAME("ELM")"
"FREE FI(SELFILE)"
END
/*---------------*/
/* END OF PRORAM */
/*---------------*/
EXIT
------- COBTOEZ -------
/*--REXX---------------------------------------------------------------*
* *
* *
* COBOL Copybook to EZ-Trieve Data Definitions. *
* *
* Posted by : Balu Subramoniam.V. *
* *
* "TSO COB2EZ member" Get COBOL copybook from: */
dfDSN = 'MAGP.ENDEVOR.COBCOPYP'
/* *
* "TSO COB2EZ 'dsn(member)'" as-is. *
* *
* "TSO COB2EZ dsn(member)" Adds UserID high qualifier to dsn. *
* *
* "TSO COB2EZ dsn... +n" Adds "n" to all starting locations. *
* *
* "TSO COB2EZ dsn... WORK" Generate WORKING-STORAGE lines *
* instead of FILE data lines. *
* *
* "TSO COB2EZ dsn... HDR" Generate HEADING() parms based on *
* name of variable. *
* *
* "TSO COB2EZ dsn... HDR2" Generate HEADING() parms starting at *
* node 2 of variable name. *
* *
* The Easytrieve output lines will be written to */
tmpDSN = userid()".TEMP.EZDATA"
/* *
* All input COBOL lines will be displayed on the screen. *
* *
* *
* If only one COBOL structure is present the generated *
* EZ-Trieve lines will also be displayed on the screen. *
* *
* *
* If first COBOL data line is not an "01" level then a *
* "01 01-FILLER." line is inserted. *
* *
* *
* If multiple "01" data structures are in the input they all *
* will be processed. *
* *
*--------------------------------------------------------------------*
This program first reads in COBOL copybook and loads arrays

with information about each data item (comments and 88 levels
are ignored) - what data type (A, B, P, N) it is, which items are
its "children" (next level items within its scope), which item
it REDEFINES (if any), the OCCURS number.
Once this data has been tabled the "hierarchy", starting with
the 01 level, is "traversed" accumulating the lengths of a data
items children. This may be a recurrsive process since a child
of an item can be a group that must first be traversed to determine
its length (and so-on for children of the children). The info
gleaned during this traversal is used to generate EZ-trieve lines.
---------------------------------------------------------------------*/
/* If executed as Edit macro then use data in edit session */

ARG copybk2
"ISPEXEC CONTROL ERRORS RETURN"
"ISREDIT MACRO (PARMS) NOPROCESS"
EDITRC = RC
IF EDITRC = 20 THEN
COPYBOOK = copybk2
ELSE DO
"%JCUT"
COPYBOOK = "'"USERID()".RTMPN.CUTPASTE' "PARMS
END
copybook = Copybook(copybook)
IF EDITRC = 20 THEN
SOURCE = copybook
ELSE DO
"ISREDIT (SRCDSN) = DATASET"
"ISREDIT (SRCMEM) = MEMBER"
SOURCE = "'"SRCDSN"("SRCMEM")'"
END
recsIn = 0 /* wjgt */
fillerTB = 0 /* tie breaker for making unique FILLER labels */
CALL InitializeVariables
CALL OpenAllFiles
/* "CLEAR" */
/*-------------------------------------------------------*/
usage. = 0
i = 'BINARY' ; usage.i = 'BINARY'

i = 'COMP' ; usage.i = 'BINARY'
i = 'COMPUTATIONAL' ; usage.i = 'BINARY'
i = 'COMP-4' ; usage.i = 'BINARY'
i = 'COMPUTATIONAL-4'; usage.i = 'BINARY'
i = 'COMPUTATIONAL-3'; usage.i = 'PACKED-DECIMAL'

i = 'COMP-3' ; usage.i = 'PACKED-DECIMAL'
i = 'PACKED-DECIMAL' ; usage.i = 'PACKED-DECIMAL'
i = 'DISPLAY' ; usage.i = 'DISPLAY'
EOF = 'ff'x
firstRecord = 1
FILLER01 = 0
justOneCopybook = 1
DO UNTIL s = EOF
CALL DoCOBOLstructure
CALL InitializeVariables /* Maybe multiple */
FILLER01 = 1 /* "01" date structures. */
firstRecord = 1
END
PUSH 'MEND '

"EXECIO 1 DISKW FILEO"
CALL CloseAllFiles
"ISPEXEC VIEW DATASET('"tmpDSN"')"
EXIT
/*-------------------------------------------------------*/
DoCOBOLstructure:
DO FOREVER /* When no 01 level present */

IF FILLER01 THEN /* "01 FILLER." record WAS inserted. */
DO
s = holdS /* This is the actual first record */
FILLER01 = 0 /* or a subsequent "01". */
END
ELSE
s = GetRec()
IF s = EOF THEN
LEAVE /* >>>>>------> */
v = '' /* wjgk */
holdS = s
PARSE VAR s rlvl nm s
/*-------------- start wjgi ----------------*/
IF rlvl = 1 THEN
IF WORDPOS('REDEFINES', s) > 0 THEN
DO
SAY '...ABEND - 01 level REDEFINES not supported'
EXIT 12
END
/*-------------- end wjgi ------------------*/
rlvl = STRIP(rlvl, Leading, 0) /* wjgb */
IF firstRecord THEN /* When no 01 level present then */
IF rlvl <> 1 THEN /* insert "01 FILLER." record. */
DO
FILLER01 = 1
rlvl = 1
nm = '01-FILLER'
END
ELSE
NOP
ELSE /* NOT the first record */
IF rlvl = 1 THEN /* but level is "01". */
DO
justOneCopybook = 0
LEAVE /* >>>>>------> */
END
firstRecord = 0
IF WORDPOS(nm, reservedWordList) > 0 THEN /* wjgq */

DO /* wjgq */
s = SPACE(nm s) /* wjgq */
nm = 'FILLER' /* wjgq */
END /* wjgq */
nm = Name(nm)
lineNo = line.0 + 1
line.0 = lineNo
lineNo2nm.lineNo = nm
nm2lineNo.nm = lineNo
IF rlvl = 66 THEN /* wjgc */

DO
IF HandleRENAMES(nm s) THEN
ITERATE
ELSE
DO
/* wjgh */ SAY '...ABEND - uncoded-for clause type: "'s'" ('recsIn')'
EXIT 12
END
END
SELECT
WHEN lvl < rlvl THEN
DO
lvl = rlvl
ord = ord + 1
ord2lvl.ord = lvl
lvl2ord.lvl = ord
ord2nm.ord = nm
nm2ord.nm = ord
parentIndex = ord - 1
END
WHEN lvl = rlvl THEN
DO
ord2nm.ord = nm
nm2ord.nm = ord
END
OTHERWISE
DO
/*------------ start wjgi ----------------*/
DO lookForBadStepDown = 1
DO i = ord - 1 TO 1 BY -1
IF rlvl = ord2lvl.i THEN
LEAVE lookForBadStepDown
END
SAY '...ABEND - invalid level step down: "'holdS'"'
EXIT 12
END
/*-------------- end wjgi -----------------*/
lvl = rlvl
ord = lvl2ord.lvl
ord2nm.ord = nm
nm2ord.nm = ord
END
END
pNm = ord2nm.parentIndex
c.pNm = c.pNm nm
isOccursLvlItself.nm = 0 /* wjgj */
isOccursLvl.nm = 0 /* wjgg */
p.nm = pNm /* wjgg */
length = 0
ln.nm = 0
beenThere. = 0
usage = 'DISPLAY'
occurs = 1
redefines = ''
dataType = 'A'
scale = 0
reservedWordList = 'USAGE BINARY COMP COMPUTATIONAL' ,
'COMP-3 COMPUTATIONAL-3' ,
'COMP-4 COMPUTATIONAL-4' ,
'PACKED-DECIMAL DISPLAY' ,
/* wjgh */ 'DEPENDING ON JUSTIFIED JUST RIGHT' ,
/* wjgq */ 'REDEFINES' ,
'PIC PICTURE OCCURS ASCENDING DESCENDING'
DO WHILE s <> '' /* Process the leftmost clause in "s". */

SELECT
WHEN UsageClause() THEN
NOP
WHEN PictureClause() THEN
NOP
WHEN OccursClause() THEN
NOP
WHEN RedefinesClause() THEN
NOP
WHEN IndexedByClause() THEN
NOP
WHEN AscendingDescendingClause() THEN
NOP
WHEN JustifiedClause() THEN
NOP
WHEN ValueClause() THEN
NOP
WHEN DependingOnClause() THEN /* wjgh */
NOP /* wjgh */
OTHERWISE /* Leftmost clause is of unknown type. */
DO
/* wjgh */ SAY '...ABEND - uncoded-for clause type: "'s'" ('recsIn')'
EXIT 12
END
END
END
IF length <> 0 THEN /* When elementary data item, compute */
CALL ComputeLength /* length in bytes (take into account */
ln.nm = length /* "dataType" - P, B, A, or N). */
IF generateWorkingStorageLines THEN /* wjgr */
IF v |== '' THEN
v.nm = 'VALUE' v /* wjgk */
occurs.nm = occurs
IF redefines <> '' THEN
DO
redefines = Name(redefines, 'Should already be defined')
DO WHILE redefines.redefines <> ''
redefines =redefines.redefines
END
redefines.nm = redefines
END
IF occurs > 1 THEN /* wjgg */

DO /* wjgj */
isOccursLvlItself.nm = 1 /* wjgj */
END /* wjgj */
ELSE /* wjgg */
IF isOccursLvl.pNm THEN /* wjgg */
dataType.nm = dataType
scale.nm = scale
END
/* SAY 'arrays are loaded...' */

x = Traverse(ord2nm.1)
DO WHILE renamesList <> '' /* wjgc */

PARSE VAR renamesList a renamesList
PARSE VAR raw.a aaa bbb ccc
ln.a = loc.ccc + ln.ccc*occurs.ccc - loc.bbb
lineNo = nm2lineNo.a
line.lineNo = a loc.bbb+1 ln.a 'A'
line.lineNo = LEFT(a, MAX(30, LENGTH(a))) ,
RIGHT(loc.bbb+1, 4) RIGHT(ln.a, 4) 'A'
END
IF justOneCopybook THEN
/* SAY '--------------------------' */ NOP
PUSH ' '
firstTimeSw = 1
DO i = 1 TO line.0
IF line.i <> '' THEN
DO
IF generateWorkingStorageLines THEN
line.i = WSline(line.i, i)
ELSE
line.i = MaybeOccurs(line.i, i)
/*--- start wjgl

/*----------------- start wjgk -----------------*/
IF lineNo2nm.i <> '' THEN

DO
nnn = lineNo2nm.i
IF LENGTH(STRIP(line.i v.nnn, "Trailing")) > 68 THEN
DO
PUSH line.i '+'
line.i = ' ' v.nnn
END
ELSE
line.i = STRIP(line.i v.nnn, "Trailing")
END
/*----------------- end wjgk -----------------*/

--- end wjgl ---*/
/*wjgq*/ IF POS('ff'x, line.i) > 0 THEN

/*wjgq*/ DO
/*wjgq*/ PARSE VAR line.i ffront1 'ff'x fnbr 'FILLER' fback
/*wjgq*/ line.i = ffront1 || fnbr'#FILLER'fback
/*wjgq*/ END
CALL MaybeContinuedLine /* wjgl */
IF lineNo2nm.i <> '' THEN /* wjgk */
/* Generate header lines if HDR or HDR2 parm given */
IF generateHeaderLine = 1 | ,
generateHeaderLine = 2 THEN DO
/* PARSE VAR line.i HDRVAR . wjgh */
HDRVAR = lineNo2nm.i /* wjgk */
IF generateHeaderLine = 1 THEN
PARSE VAR HDRVAR HDR1 '-' REST
ELSE
PARSE VAR HDRVAR . '-' HDR1 '-' REST
PARSE VAR REST HDR2 '-' REST
HDRLINE = COPIES(" ",10)"HEADING ('"HDR1"'"
IF HDR2 <> "" THEN HDRLINE = HDRLINE" '"HDR2"'"
HDRLINE = HDRLINE")"
line.i = LEFT(line.i, 70) "+"
END
/* IF justOneCopybook THEN DO
* SAY line.i
* SAY HDRLINE
* END */
PUSH line.i
IF lineNo2nm.i <> '' THEN /* wjgk */
IF generateHeaderLine = 1 |,
generateHeaderLine = 2 THEN DO
PUSH HDRLINE
END
END
END
RETURN
/*------------------ wjgl ------------------------------*/
MaybeContinuedLine:
IF lineNo2nm.i <> '' THEN

DO
nnn = lineNo2nm.i /* get variable name for this line */
IF v.nnn |== '' THEN /* VALUE has been specified */
IF generateHeaderLine = 1 | generateHeaderLine = 2 THEN
IF LENGTH(STRIP(line.i v.nnn, 'T')) > 70 THEN
DO
IF LENGTH(STRIP(line.i, 'T')) > 70 THEN
PUSH LEFT(SPACE(line.i), 70) '+' /* wjgo */
ELSE
PUSH LEFT(STRIP(line.i, 'T'), 70) '+' /* wjgo */
line.i = ' ' v.nnn
END
ELSE /* room for VALUE without scrunching */
line.i = STRIP(line.i v.nnn, 'T')
ELSE /* VALUE present but no HDR */
DO
IF LENGTH(STRIP(line.i v.nnn, 'T')) > 72 THEN
DO
PUSH LEFT(SPACE(line.i), 70) '+' /* wjgo */
ELSE
PUSH LEFT(STRIP(line.i, 'T'), 70) '+' /* wjgo */
line.i = ' ' v.nnn
END
ELSE
line.i = STRIP(line.i v.nnn, 'T')
END
ELSE /* no VALUE present */
IF generateHeaderLine = 1 | generateHeaderLine = 2 THEN
IF LENGTH(STRIP(line.i, 'T')) > 70 THEN /* room for ' +' */
line.i = SPACE(line.i)
ELSE
line.i = STRIP(line.i, 'T')
ELSE /* no VALUE and no HDRs */
line.i = SPACE(line.i)
ELSE
line.i = STRIP(line.i, 'T')
END
RETURN
/*------------------ wjgg ------------------------------*/
MaybeOccurs: PROCEDURE EXPOSE reference firstTimeSw ,

isOccursLvl. loc. p. ,
isOccursLvlItself.
PARSE ARG ln, i
IF SUBSTR(ln,1,1) = '*' | ln = '' THEN

RETURN ln
PARSE VAR ln nm loc rest
pNm = p.nm
IF firstTimeSw THEN
DO
firstTimeSw = 0
reference = nm
RETURN ln
END
IF |isOccursLvl.pNm THEN
RETURN ln
ELSE DO
pNm = p.nm
refr = reference
locOffset = loc.nm
IF isOccursLvl.pNm THEN
DO
/* refr = pNm wjgj */
refr = pNm(pNm) /* wjgj */
/* locOffset = loc.nm - loc.pNm wjgp */
locOffset = loc.nm - loc.refr /* wjgp */
END
IF locOffset = 0 THEN
ref = refr ' '
ELSE
/*wjgs ref = refr RIGHT('+'locOffset,4) */
/*wjgs*/ ref = refr RIGHT('+'locOffset,MAX(4,LENGTH(locOffset+0)+1))
END
RETURN LEFT(nm, MAX(30, LENGTH(nm))) ref rest
/*-------------------------------------------------------*/
WSline: PROCEDURE EXPOSE reference firstTimeSw ,

/* wjgg */ isOccursLvl. loc. p. ,
/* wjgj */ isOccursLvlItself. loc. p.
PARSE ARG ln, i
IF SUBSTR(ln,1,1) = '*' | ln = '' THEN

RETURN ln
PARSE VAR ln nm loc rest
IF firstTimeSw THEN
DO
firstTimeSw = 0
reference = nm
ref = 'W'
END
/* ref = reference RIGHT('+'loc-1, 4) */
ELSE DO
pNm = p.nm
refr = reference
locOffset = loc.nm
IF isOccursLvl.pNm THEN
DO
/* refr = pNm wjgj */
refr = pNm(pNm) /* wjgj */
locOffset = loc.nm - loc.pNm
END
IF locOffset = 0 THEN
ref = refr ' '
ELSE
/*wjgs ref = refr RIGHT('+'locOffset,4) */
/*wjgs*/ ref = refr RIGHT('+'locOffset,MAX(4,LENGTH(locOffset+0)+1))
END
RETURN LEFT(nm, MAX(30, LENGTH(nm))) ref rest
/*-------------------------------------------------------*/
pNm: PROCEDURE EXPOSE p. isOccursLvlItself.
ARG nm
DO WHILE |isOccursLvlItself.nm
nm = p.nm
END
RETURN nm
/*-------------------------------------------------------*/
ComputeLength: PROCEDURE EXPOSE usage length
SELECT
WHEN usage = 'BINARY' THEN
DO
IF length > 4 THEN
length = 4
ELSE
length = 2
END
WHEN usage = 'PACKED-DECIMAL' THEN
length = (length + 2) % 2
WHEN usage = 'DISPLAY' THEN
NOP
END
RETURN
/*-------------------------------------------------------*/
RedefinesClause: PROCEDURE EXPOSE s beenThere. redefines
i = 'Redefines Clause'
IF beenThere.i THEN
RETURN 0
PARSE VAR s w tail
IF w = 'REDEFINES' THEN
DO
s = tail
PARSE VAR s w tail
redefines = w
s = tail
beenThere.i = 1
RETURN 1
END
RETURN 0
/*---------------------------- wjgc ---------------------*/
HandleRENAMES: PROCEDURE EXPOSE renamesList raw.
ARG s
PARSE VAR s a RENAMES b THRU c d
IF d <> '' THEN
RETURN 0
IF RENAMES <> 'RENAMES' THEN
RETURN 0
IF THRU = '' THEN
c = b
ELSE
IF THRU <> 'THRU' & THRU <> 'THROUGH' THEN
RETURN 0
renamesList = renamesList a
raw.a = a b c
RETURN 1
/*-------------------------------------------------------*/
OccursClause: PROCEDURE EXPOSE s beenThere. occurs
i = 'Occurs Clause'
IF beenThere.i THEN
RETURN 0
saveS = s
PARSE VAR s w tail
IF w = 'OCCURS' THEN
DO
s = tail
PARSE VAR s w tail
IF VERIFY(w, '0123456789') = 0 THEN
/* IF w > 0 THEN */ IF 1 THEN
DO
occurs = w
s = tail
PARSE VAR s w tail
IF w = 'TIMES' THEN
s = tail
ELSE
IF w = 'TO' THEN
DO
s = tail
PARSE VAR s w tail
IF VERIFY(w, '0123456789') = 0 THEN
DO
occurs = w
s = tail
PARSE VAR s w tail
IF w = 'TIMES' THEN
s = tail
END
ELSE
DO
s = saveS
RETURN 0
END
END
beenThere.i = 1
RETURN 1
END
END
s = saveS
RETURN 0
/*-------------------------------------------------------*/
PictureClause: PROCEDURE EXPOSE s beenThere. length dataType scale
i = 'Picture Clause'
IF beenThere.i THEN
RETURN 0
saveS = s
PARSE VAR s w tail
IF |NumPic() THEN
IF |CharPic() THEN
DO
s = saveS
RETURN 0
END
beenThere.i = 1
RETURN 1
/*-------------------------------------------------------*/
UsageClause: PROCEDURE EXPOSE s beenThere. usage. usage dataType
i = 'Usage Clause'
IF beenThere.i THEN
RETURN 0
saveS = s
PARSE VAR s w tail
IF w = 'USAGE' THEN
DO
s = tail
IF Is() THEN
NOP
PARSE VAR s w tail
END
IF usage.w <> 0 THEN

SELECT
WHEN usage.w = 'BINARY' THEN
dataType = 'B'
WHEN usage.w = 'PACKED-DECIMAL' THEN
dataType = 'P'
WHEN usage.w = 'DISPLAY' THEN
NOP
END
ELSE
DO
s = saveS
RETURN 0
END
usage = usage.w
s = tail
beenThere.i = 1
RETURN 1
/*-------------------------------------------------------*/
Is: PROCEDURE EXPOSE s
PARSE VAR s w tail

IF w = 'IS' THEN
s = tail
RETURN 1
/*-------------------------------------------------------*/
NumPic: PROCEDURE EXPOSE s length dataType scale
PARSE VAR s w tail

saveS = s
IF w = 'PICTURE' | w = 'PIC' THEN
DO
s = tail
PARSE VAR s w tail
IF NumLength(w) THEN
DO
s = tail
RETURN 1
END
END
s = saveS
RETURN 0
/*-------------------------------------------------------*/
NumLength: PROCEDURE EXPOSE length dataType scale
ARG s /* Count the digit positions in the PICTURE "s". */
/* IF VERIFY(s,'SP9V()012345678') = 0 THEN /* Numeric item */

*/ IF VERIFY(s,'SP9V()Z,012345678') = 0 THEN /* Numeric item */
DO
scale = Scale(s)
length = 0
/* s q u e e z e o u t S V P */
w = SPACE(TRANSLATE(s, '404040'x, 'SVP'), 0)
DO WHILE POS('(', w) > 0
PARSE VAR w a '(' count ')' w
length = length + LENGTH(a) - 1 + count
END
length = length + LENGTH(w)
IF dataType = 'A' THEN
dataType = 'N'
RETURN 1
END
ELSE
RETURN 0
/* ELSE /* Numeric-edited item */
DO
EXIT 999
END
*/
/*-------------------------------------------------------*/
Scale: PROCEDURE /* How many decimal places are there */

/* in the PICTURE "s"? */
ARG s
IF POS('P', s) > 0 THEN /* Don't deal with these. */

RETURN 0
scale = 0
PARSE VAR s . 'V' w /* Isolate decimal positions. */
DO WHILE POS('(', w) > 0
PARSE VAR w a '(' count ')' w
scale = scale + LENGTH(a) - 1 + count
END
scale = scale + LENGTH(w)
RETURN scale
/*-------------------------------------------------------*/
CharPic: PROCEDURE EXPOSE s length dataType
saveS = s
PARSE VAR s w tail
IF w = 'PICTURE' | w = 'PIC' THEN
DO
s = tail
PARSE VAR s w tail
IF CharLength(w) THEN
DO
s = tail
RETURN 1
END
END
s = saveS
RETURN 0
/*-------------------------------------------------------*/
CharLength: PROCEDURE EXPOSE length dataType
ARG s
IF VERIFY(s,'AXZ9B0/()012345678,.-') = 0 THEN
DO
length = 0
DO WHILE POS('(', s) > 0
PARSE VAR s a '(' count ')' s
length = length + LENGTH(a) - 1 + count
END
length = length + LENGTH(s)
RETURN 1
END
ELSE
RETURN 0
/*------------------------------------------------------------*/
Traverse: PROCEDURE EXPOSE c. ln. loc ,

line. nm2lineNo. occurs. ,
redefines. loc. ,
dataType. scale. nm2ord. ,
ord2realLoc. indent comment ,
/* wjgg */ isOccursLvl. p. ,
/* wjgj */ isOccursLvlItself. ,
/* wjgk */ v.
PARSE ARG n
lnTot = 0 /* Accum total length for "n" here */

s = c.n /* If "n" is a group, these are his children */
IF redefines.n <> '' THEN

DO
/* "n" redefines "redefines.n" so set back "loc" */
base = redefines.n
loc = loc.base
END
loc.n = loc /* Save "n" location in case it is REDEFINED */
IF s = '' THEN /* "n" is an elementary item (NOT a group) */

DO
CALL GenElementaryEZline
loc = loc + ln.n*occurs.n
DO
ord = nm2ord.n
loc = ord2realLoc.ord /* Restore real loc */
RETURN 0 /* "n" is a REDEFINES - return 0 length */
END
ELSE
DO
ord = nm2ord.n
ord2realLoc.ord = loc /* Save real loc */
RETURN ln.n*occurs.n
END
END
/* "n" is a group - accumulated the lengths of his "children". */
DO WHILE s <> ''

PARSE VAR s c s
ln = Traverse(c)
lnTot = lnTot + ln
END
/* startingLoc = loc+1-lnTot
*/ startingLoc = loc.n + 1
loc = loc + lnTot * (occurs.n - 1)
CALL GenGroupEZline

DO
ord = nm2ord.n
loc = ord2realLoc.ord /* Restore real loc */
RETURN 0
END
ELSE
DO
ord = nm2ord.n
ord2realLoc.ord = loc
RETURN lnTot * occurs.n
END
/*-------------------------------------------------------------------*/
GenGroupEZline:
lineNo = nm2lineNo.n
IF substr(n, 1, 1) <> 'ff'x THEN /* NOT a FILLER line. */
DO
nl = MAX(30, LENGTH(n))
IF scale.n = 0 THEN
scale.n = ''
IF occurs.n = 1 THEN
occursDisplay = ''
ELSE
occursDisplay = 'OCCURS' occurs.n
IF indent THEN
line.lineNo = ,
LEFT(COPIES(' ', MIN(12, 2*(nm2ord.n - 1))) n, nl+12) ,
|| RIGHT(startingLoc,4) RIGHT(lnTot, 4) ,
dataType.n scale.n occursDisplay
ELSE
line.lineNo = ,
LEFT(n,nl) ,
RIGHT(startingLoc,4) RIGHT(lnTot, 4) ,
END
RETURN
/*-------------------------------------------------------------------*/
GenElementaryEZline:
lineNo = nm2lineNo.n
/* IF substr(n, 1, 1) <> 'ff'x THEN wjgq */
IF substr(n, 1, 1) <> 'ff'x | , /* wjgq */
v.n |== '' THEN /* wjgq */
DO
nl = MAX(30, LENGTH(n))
IF scale.n = 0 THEN
scale.n = ''
IF occurs.n = 1 THEN
occursDisplay = ''
ELSE
occursDisplay = 'OCCURS' occurs.n
IF indent THEN
line.lineNo = ,
LEFT(COPIES(' ', MIN(12, 2*(nm2ord.n - 1))) n, nl+12) ,
|| RIGHT(loc+1,4) RIGHT(ln.n, 4) ,
ELSE
line.lineNo = ,
LEFT(n,nl) ,
RIGHT(loc+1,4) RIGHT(ln.n,4) ,
END
RETURN
/*-------------------------------------------------------------------*/
Name: PROCEDURE EXPOSE fillerTB varSub nm.
ARG nm, redefines
IF nm = 'FILLER' THEN
DO
fillerTB = fillerTB + 1
/* nm = 'ff'x || D2C(fillerTB, 2) || 'FILLER'
*/ nm = 'ff'x || fillerTB || 'FILLER' /* wjga */
END
ELSE
IF LENGTH(SPACE(TRANSLATE(nm, '40'x, ':'), 0)) + 2 = ,
LENGTH(nm) THEN
DO
PARSE VAR nm a ':' b ':' c
IF varSub <> '' THEN
nm = a || varSub || c
ELSE
IF c <> '' THEN
nm = a || '&' || b || '.' || c
ELSE
nm = a || '&' || b
END
IF redefines = '' THEN

DO
IF nm.nm THEN
DO
SAY 'ERROR - "'nm'" has already been defined.'
EXIT 12
END
nm.nm = 1
END
ELSE
IF |nm.nm THEN
DO
SAY 'ERROR - "'nm'" REDEFINES not defined.'
EXIT 12
END
RETURN nm
/*-------------------------------------------------------------------*/
CloseAllFiles:
"EXECIO 0 DISKW FILEO (FINIS"

"FREE F(FILEO)"
RETURN
/*-------------------------------------------------------------------*/
OpenAllFiles:
"ALLOC F(FILEI) SHR REUSE " ,

"DA("copybook")"
userID = USERID()
IF SYSDSN("'"tmpDSN"'") = 'OK' THEN DO

DEFINE = MSG("OFF")
"DELETE ('"tmpDSN"') SCRATCH"
DEFINE = MSG("ON")
END
"ALLOC F(FILEO) DA('"tmpDSN"')

NEW SPACE(5,1) BLKSIZE(0) LRECL(80) RECFM(F B) UNIT(SYSDA)
DSORG(PS) CYLINDERS"
PUSH 'MACRO '

DATE = DATE(M)" "RIGHT(DATE(S),2)", "LEFT(DATE(S),4)
PUSH '* This MACRO was created on 'DATE' at 'TIME(C)
/* PUSH '* from COBOL copybook ' copybook */
PUSH '* from COBOL copybook ' SOURCE
RETURN
/*-------------------------------------------------------------------*/
GetRec: PROCEDURE EXPOSE EOF line. comment ,

recsIn /* wjgt */
r = ''
DO FOREVER
"EXECIO 1 DISKR FILEI"

IF RC <> 0 THEN
DO
"EXECIO 0 DISKR FILEI (FINIS"
"FREE F(FILEI)"
RETURN EOF
END
ELSE
DO
recsIn = recsIn + 1 /* wjgt */
PARSE PULL . 7 aster +1 record 73 .
IF aster = '*' | record = '' THEN
/* Begin wjge */
IF comment THEN
DO
lineNo = line.0 + 1
line.0 = lineNo
line.lineNo = aster || record
ITERATE /* <-------<<<<< */
END
ELSE
/* end wjge */
ITERATE /* <-------<<<<< */
if aster='+' then return eof
END
r = STRIP(r record)
IF SUBSTR(REVERSE(r), 1, 1) = '.' THEN
IF WORD(r, 1) = 88 THEN
r = ''
ELSE
RETURN STRIP(r, 'Trailing', '.')
END
/*-------------------------------------------------------*/
IndexedByClause: PROCEDURE EXPOSE s beenThere. reservedWordList
i = 'Indexed By Clause'
IF beenThere.i THEN
RETURN 0
PARSE VAR s w tail

IF w = 'INDEXED' THEN
DO
s = tail
PARSE VAR s w tail
IF w = 'BY' THEN
s = tail
DO WHILE s <> '' /* wjgb */
PARSE VAR s w ps
IF WORDPOS(w, reservedWordList) > 0 THEN
LEAVE
s = ps
END
/* PARSE VAR s w s wjgb */

beenThere.i = 1
RETURN 1
END
RETURN 0
/*---------------- wjgh ---------------------------------*/
DependingOnClause: PROCEDURE EXPOSE s beenThere. reservedWordList
i = 'Depending On Clause'
IF beenThere.i THEN
RETURN 0
PARSE VAR s w tail

IF w = 'DEPENDING' THEN
DO
s = tail
PARSE VAR s w tail
IF w = 'ON' THEN
s = tail
PARSE VAR s w s
beenThere.i = 1
RETURN 1
END
RETURN 0
/*-------------------------------------------------------*/
AscendingDescendingClause: PROCEDURE EXPOSE s beenThere.
i = 'Ascending-Descending Clause'
IF beenThere.i THEN
RETURN 0
PARSE VAR s w tail

IF w = 'ASCENDING' | w = 'DESCENDING' THEN
DO
s = tail
PARSE VAR s w tail
IF w = 'KEY' THEN
s = tail
PARSE VAR s w tail
IF w = 'IS' THEN
s = tail
PARSE VAR s w s
beenThere.i = 1
RETURN 1
END
RETURN 0
/*-------------------------------------------------------*/
JustifiedClause: PROCEDURE EXPOSE s beenThere.
i = 'Justified Clause'
IF beenThere.i THEN
RETURN 0
PARSE VAR s w tail

IF w = 'JUSTIFIED' | w = 'JUST' THEN
DO
s = tail
PARSE VAR s w tail
IF w = 'RIGHT' THEN
s = tail
beenThere.i = 1
RETURN 1
END
RETURN 0
/*-------------------------------------------------------*/
ValueClause: PROCEDURE EXPOSE s beenThere. usage. ,

v /* wjgk */
i = 'Value Clause'
IF beenThere.i THEN
RETURN 0
PARSE VAR s w tail

IF w = 'VALUE' THEN
DO
s = STRIP(tail)
char = SUBSTR(s, 1, 1)
IF char = "'" THEN
CALL PassQuotedLiteral
ELSE
/* PARSE VAR s . s wjgk */
PARSE VAR s v s /* wjgk */
/*----- start wjgn ------*/
IF v = 'SPACE' | v = 'SPACES' THEN
v = "' '"
ELSE
IF v = 'ZERO' | v = 'ZEROS' | v = 'ZEROES' THEN
v = 0
ELSE
IF v = 'ALL' THEN /* bypass a "VALUE ALL" */
DO
v = ''
PARSE VAR s . s
END
/*----- end wjgn ------*/
beenThere.i = 1
RETURN 1
END
RETURN 0
/*-------------------------------------------------------*/
PassQuotedLiteral: PROCEDURE EXPOSE s ,

v /* wjgk */
v = "'" /* wjgk */
quoteCnt = 1
s = SUBSTR(s, 2)
DO WHILE quoteCnt//2 = 1 | SUBSTR(s, 1, 1) = "'"
IF SUBSTR(s, 1, 1) = "'" THEN
quoteCnt = quoteCnt + 1
/* s = SUBSTR(s, 2) wjgk */
PARSE VAR s vByte +1 s /* wjgk */
v = v || vByte /* wjgk */
END
s = STRIP(s)
v = STRIP(SUBSTR(v,1,LENGTH(v)-1), 'Trailing') || "'"
IF v == "''" THEN
v = "' '"
RETURN
/*-------------------------------------------------------*/
/*Copybook: PROCEDURE EXPOSE offset generateWorkingStorageLines ,

* varSub dfDSN indent comment generateHeaderLine */
Copybook: PROCEDURE EXPOSE offset generateWorkingStorageLines ,
varSub dfDSN tmpDSN indent comment generateHeaderLine
ARG dsn
saveArg = dsn /* wjgm */
/* wjgd */
dsn = ' 'dsn' '
comment = 0
IF POS(' COMMENT ', ' 'dsn' ') > 0 THEN
DO
comment = 1
PARSE VAR dsn a ' COMMENT ' b
dsn = SPACE(a b)
END
ELSE
dsn = SPACE(dsn)
/* wjge */
dsn = ' 'dsn' '
indent = 0
IF POS(' INDENT ', ' 'dsn' ') > 0 THEN
DO
indent = 1
PARSE VAR dsn a ' INDENT ' b
dsn = SPACE(a b)
END
ELSE
dsn = SPACE(dsn)
/* Look for Borgster variable-substitution stuff */
PARSE VALUE dsn'ff'x WITH a '==' varSub '==' c

IF c <> '' & ,
LENGTH(varSub) > 0 & ,
POS('40'x, varSub) = 0 THEN
dsn = SPACE(a SUBSTR(c, 1, LENGTH(c)-1))
/* Generate WORKING-STORAGE structure? */
/* Accept WORK, HDR or HDR2 as valid parm */

/*IF WORDPOS('WORK', dsn, 2) > 0 THEN
* dsn = STRIP(DELWORD(dsn, WORDPOS('WORK', dsn, 2), 1)) */
IF WORDPOS('WORK', dsn) > 0 THEN DO

dsn = STRIP(DELWORD(dsn, WORDPOS('WORK', dsn), 1))
generateWorkingStorageLines = 1
END
ELSE
generateWorkingStorageLines = 0
IF WORDPOS('HDR', dsn) > 0 THEN DO

dsn = STRIP(DELWORD(dsn, WORDPOS('HDR', dsn), 1))
generateHeaderLine = 1
END
ELSE DO
IF WORDPOS('HDR2', dsn) > 0 THEN DO
dsn = STRIP(DELWORD(dsn, WORDPOS('HDR2', dsn), 1))
END
ELSE
END
/* Check for Location-Offset (+n) */
PARSE VAR dsn da '+' offset

IF offset <> '' & VERIFY(offset, '0123456789') = 0 THEN
dsn = STRIP(da)
ELSE
DO
PARSE VAR dsn da '-' offset
IF offset <> '' & VERIFY(offset, '0123456789') = 0 THEN
DO
dsn = STRIP(da)
offset = '-'offset
END
ELSE
offset = 0
END
IF dsn = '' THEN

/* dsn = "'#JXGECI.PUBLIC.EXEC(COPYBOOK)'" */
CALL Documentation
ELSE
IF WORDS(dsn) <> 1 THEN /* wjgm */

DO /* wjgm */
SAY '...ABEND - Invalid option(s) specified' /* wjgm */
SAY ' "'saveArg'"' /* wjgm */
EXIT 12 /* wjgm */
END /* wjgm */
/* If member name only, default to PROD ECIS Copybook Lib */
IF LENGTH(dsn) |> 8 & ,

VERIFY(dsn, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@#') = 0 THEN
dsn = "'"dfDSN"("dsn")'"
ELSE
IF SUBSTR(dsn, 1, 1) |= "'" THEN
dsn = "'"UserID()'.'dsn"'"
ELSE
dsn = STRIP(dsn, 'Trailing', "'")"'"
msg = SYSDSN(dsn)
IF msg = 'OK' THEN
RETURN dsn
SAY '...'msg
EXIT 12
/*-------------------------------------------------------*/
InitializeVariables:
p. = '' /* "parent" */
c. = '' /* "children" list */
ln. = 0 /* elementarty data item length */
loc = 0 /* current pointer location - march from start */
loc = offset
occurs. = 1 /* data item OCCURS number */
redefines. = '' /* data item being redefined */
scale. = 0 /* decimal places */
nm. = 0 /* has name been defines? */
lvl = 0 /* i.e.: 01, 05, 10, 15,... */

ord = 0 /* sequential number associated with level */
ord2lvl. = 0 /* not used */
lvl2ord. = 0 /* Translate "lvl" to "ord" - 01->1, 05->2,... */
ord2nm. = '' /* Translate "ord" to data item name */
nm2ord. = 0 /* Translate data item name to "ord" */
line. = '' /* Store generate EZ lines here */

line.0 = 0 /* Generated EZ lines count */
lineNo2nm. = '' /* not used */
nm2lineNo. = 0
renamesList = ''
linev. = '' /* wjgk */

lineh. = '' /* wjgk */
v. = '' /* wjgk */
isOccursLvlItself. = 0 /* wjgj */
isOccursLvl. = 0 /* wjgg */
loc. = 0 /* wjgg */
RETURN
/*-------------------------------------------------------*/
Documentation:
/* "CLEAR" */
"CLRSCRN"
SAY
SAY " C O B O L C o p y b o o k t o E a s y t r i e v e"
SAY
SAY " COMMAND SYNTAX:"
SAY
SAY " %COB2EZ -Get COBOL copybook from current",
"Edit session."
SAY " TSO COB2EZ member -Get COBOL copybook from default:"
SAY " '"dfDSN"(member)'. "
SAY " TSO COB2EZ 'dsn(member)' -as is."
SAY " TSO COB2EZ dsn(member) -Adds UserID high qualifier to dsn."
SAY " TSO COB2EZ dsn... +n -Adds 'n' to all starting locations."
SAY " TSO COB2EZ dsn... WORK -Generate WORKING-STORAGE lines"
SAY " instead of FILE data lines."
SAY " TSO COB2EZ dsn... INDENT -Indent variable names as in "
SAY " the COBOL copybook."
SAY " TSO COB2EZ dsn... COMMENT -Include copybook 'comment' lines."
SAY " TSO COB2EZ dsn... HDR -Generate HEADING() parms based on"
SAY " name of variable. "
SAY " TSO COB2EZ dsn... HDR2 -Generate HEADING() parms starting"
SAY " at node 2 of variable name"
SAY
SAY
SAY
SAY
SAY " NOTES:"
SAY
SAY " -The Easytrieve output lines will always be written to",
"'"tmpDSN"'."
SAY
SAY " -If the first COBOL data line is not an 01 level then a",
"'01-FILLER' line"
SAY " is inserted."
SAY
SAY " -If multiple 01 data structures are in the input they will",
"all be processed."
SAY
EXIT
------- COMMASPT -------
/******************************* REXX *********************************/

/* */
/* COMMASPT - REFORMAT DATA DELIMITED BY COMMA (BATCH MODE) */
/* */
/* */
/*******************************REXX***********************************/
INPDS = "MTAT.TD.BIC.T1041.INPUT.FILE2" /* INPUT DATASET */

OUTDS = "MTAT.TD.BIC.T1041.INPUT.FILE2.REFORMAT" /* OUTPUT DATASET */

ADDRESS TSO
"ALLOC F(OUTDD) DSN('"OUTDS"') LIKE ('"INPDS"') NEW"
END
ADDRESS TSO
"ALLOC DA ('"INPDS"') F(INPDD) SHR REUSE "
"EXECIO * DISKR INPDD (STEM INPUT. FINIS"
"EXECIO 0 DISKW OUTDD (OPEN"
COUNT = 0
DO I = 1 TO INPUT.0
/**********************************************************************/
/* LAYOUT OF THE INPUT DATASET */
/**********************************************************************/
PARSE VAR INPUT.I VAR1 ',' VAR2 ',' VAR3 ',' VAR4 ',' VAR5 ',' ,
VAR6 ',' VAR7 ',' VAR8 ',' VAR9 ',' VAR10
MISC = LEFT(STRIP(VAR1) ,15)

ADDR1 = LEFT(STRIP(VAR2) ,35)
ADDR2 = LEFT(STRIP(VAR3) ,35)
CITY = LEFT(STRIP(VAR4) ,15)
STATE = LEFT(STRIP(VAR5) ,04)
ZIP = LEFT(STRIP(VAR6) ,15)
TITLE = LEFT(STRIP(VAR7) ,35)
NAME = VAR8 || ' ' || VAR9 /* MERGE FNAME & LNAME */
NAME = LEFT(STRIP(NAME) ,30)
/**********************************************************************/
/* LAYOUT OF THE OUTPUT DATASET */
/**********************************************************************/
OUTREC = MISC || ' ' || ,

ADDR1 || ' ' || ,
ADDR2 || ' ' || ,
CITY || ' ' || ,
STATE || ' ' || ,
ZIP || ' ' || ,
TITLE || ' ' || ,
NAME
PUSH OUTREC
"EXECIO 1 DISKW OUTDD"
COUNT = COUNT + 1
END
SAY '**************************************************************'
SAY ' COMMASPT - COUNT DESCRIPTION '
SAY '**************************************************************'
SAY ' '
SAY 'NO. OF INPUT RECS : ' INPUT.0
SAY 'NO. OF OUTPUT RECS : ' COUNT
SAY ' '
SAY '**************************************************************'
"FREE F(INPDD)"
"FREE F(OUTDD)"
EXIT
------- COPYMEM -------
/******************************* REXX *********************************/

/* */
/* COPY MEMBERS FROM A SOURCE PDS TO DEST PDS (ONLINE) */
/* */
/* INPUT : */
/* ------- */
/* MEMBER LIST - MEMBER NAMES THAT NEEDS TO BE COPIED */
/* SOURCE - SOURCE FROM WHICH DATA NEEDS TO BE COPIED */
/* DESTINATION - DATASET WHERE DATA NEEDS TO BE COPIED TO. */
/* */
/* -------------- */
/* */
/* POS 1 - 8 => MEMBER NAME */
/* */
/* */
/******************************* REXX *********************************/
SAY "ENTER MEMBER LIST : "

PULL LSTDS
SAY "ENTER SOURCE PDS : "
PULL SRCE
SAY "ENTER DESTINATION PDS : "
PULL DESTDS
ADDRESS TSO
DROP INPUT.
/* ALLOCATE LIST DATASET */

"ALLOC DA('"LSTDS"') F(INPDD) SHR REUSE"
"FREE DD (INPDD) NOHOLD"
IF INPUT.0 = 0 THEN
DO
SAY ' EMPTY '
EXIT
END
OUTREC. = ''
EMPREC. = ''
CREREC. = ''
GDGREC. = ''
J = 0 ; M = 0 ; N = 0 ; CKPT = 0
DDCNT = 0; CRECNT = 0
DO K = 1 TO INPUT.0
LT= ' ' ; X = 0;
DSN = STRIP(SUBSTR(INPUT.K,1,9)) /* <- MEMBER */
DEST = "'"||DESTDS||"("||DSN||")'"
IF LENGTH(DSN) = 0 THEN ITERATE
DSN = STRIP(TRANSLATE(DSN))
DEST= STRIP(TRANSLATE(DEST))
ODSN = "'"SRCE"("DSN")'"
IF SYSDSN(ODSN)\= OK THEN SAY DSN || " - NOT FOUND"
IF SYSDSN(ODSN) = OK THEN DO
XDSN = ODSN
NDSN = DEST
IF SYSDSN(NDSN)= MEMBER NOT FOUND THEN
DO
ERR = ' FILE FOUND AND COPIED'
ADDRESS TSO
"ALLOC F(OUTFILE) DA ("NDSN") SHR REUSE"
QUEUE "END NOSAVE"
"EDIT "NDSN" NONUM OLD DATA "
ADDRESS TSO
"ALLOC F(INFILE) DA ("XDSN") SHR REUSE"
"NEWSTACK"
"EXECIO * DISKR INFILE (FINIS"
NUMREC = QUEUED()
"EXECIO" NUMREC "DISKW OUTFILE (FINIS"
"DELSTACK"
"FREE DD (INFILE) NOHOLD"
"FREE DD (OUTFILE) NOHOLD"
OUTREC. = ''
EMPREC. = ''
CREREC. = ''
GDGREC. = ''
END
END
END
RETURN
------- CREADSN -------
/******************************* REXX *********************************/

/* */
/* CREATES PDS FOR NEWMAG SETUP PROCESS */
/* COPY IS ALREADY AVAILABLE IN MTAT.TATA.TOOL */
/* */
/* */
/*********************************************************************/
RETCD = 0
ADDRESS ISPEXEC
"VGET (MAGCODE,SUBSYS) PROFILE"
IF RC > 0 then
DO
MAGCODE = ''
ERR = 'ENTER THE NEW MAG CODE (FOR NOW PLS USE YY)'
END
ADDRESS ISPEXEC
"ADDPOP "
"DISPLAY PANEL(COPYPAN) "
DO WHILE KP <> 'PF03'
CALL CRE_DSN
ADDRESS ISPEXEC
"DISPLAY PANEL(GDGUTIL)"
END
ADDRESS ISPEXEC
"REMPOP"
EXIT (RETCD)
/*FOR CREATING DSNS FOR NEWMAG SUBSYSTEMS*/

CRE_DSN :
ADDRESS TSO
"ALLOC DA('MTAT.NEWMAG.SUBSYS.COPY(DSNS)') F(INPDD) SHR REUSE"
DO K = 1 TO INPUT.0
PARSE VAR INPUT.K SUBSYSTEM JCL JCLCHK ,
SOURCE SYSIN PANEL SKEL PROC CLIST RUNDOC SUPERC MSG SYSIN1
IF SUBSYSTEM = SUBSYS THEN DO

IF JCL = "JCL" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || JCL
"ALLOCATE DA('"DSN"') NEW DIR(40) SPACE(50,50) DSORG(PO) ,
END
IF JCLCK = "JCLCHK" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || JCLCK
END
IF SOURCE = "SOURCE" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || SOURCE
END
IF SYSIN = "SYSIN" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || SYSIN
END
IF PANEL = "PANEL" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || PANEL
END
IF SKEL = "SKEL" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || SKEL
END
IF PROC = "PROC" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || PROC
END
IF CLIST = "CLIST" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || CLIST
END
IF RUNDOC = "RUNDOC" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || RUNDOC
END
IF SUPERC = "SUPERC" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || SUPERC
END
IF MSG = "MSG" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || MSG
END
IF SYSIN1 = "SYSIN1" THEN DO
DSN = "MTAT.NEWMAG." || SUBSYSTEM || "." || MAGCODE || "." || "SYSIN1"
END
END
END
ERR = 'DATASET ARE CREATED SUCCESSFULLY !!!'
RETURN
------- DELMEM -------
/******************************* REXX *********************************/

/* */
/* DELETES MEMBERS OF A PDS WITH PATTERNS */
/* */
/* */
/**********************************************************************/
SAY 'ENTER DATASET <WITHIN SINGLE QUOTES>'

PULL IDSN
SAY 'ENTER PATTERN'
PULL PTTRN
IF INDEX(PTTRN,'*') = 0 THEN PTTRN = PTTRN || '*'
ADDRESS ISPEXEC
"LMINIT DATAID(INDD1) DATASET("IDSN") ENQ(SHR)"
"LMOPEN DATAID(&INDD1)"
"LMMLIST DATAID("INDD1") OPTION(SAVE) GROUP("TEST") PATTERN("PTTRN")"
IF RC = 0 THEN
DO
"LMFREE DATAID(INDD1)"
"LMCLOSE DATAID(&INDD1)"
END
ELSE EXIT 0
LDSN = USERID()||".TEST.MEMBERS"
LDSN_FMT = "'" || LDSN || "'"
EOF = 'NO'
ADDRESS TSO
"ALLOCATE DA("LDSN_FMT") F(INDD1) SHR NEW LIKE DA(M#T053.REXX.PROGRAM)"
DO WHILE EOF = 'NO'
"EXECIO 1 DISKR INDD1 (STEM LINE."
IF RC = 2 THEN
EOF = 'YES'
ELSE
DO
MEM = WORD(LINE.1,1)
IDSN = STRIP(IDSN)
IDSN_FMT = SUBSTR(IDSN,2,LENGTH(IDSN) - 2)
DELMEM = IDSN_FMT || '(' || MEM || ')'
DELMEM_FMT = "'" ||DELMEM||"'"
"DELETE "DELMEM_FMT" "
END
END
------- DRPSFP -------
/******************************* REXX *********************************/

/* */
/* DISPLAY DR, PS AND FP PARMS OF A JCL IN PRODUCTION */
/* */
/* */
/**********************************************************************/
SAY "ENTER MEMBER : "

PULL MEM
IF SYSDSN("'APCP.ENDEVOR.JCLP("MEM")'") \= "OK" THEN DO

SAY MEM || "IS NOT FOUND FOR THIS FILE !!!"
EXIT
END
/* READ THE INPUT JCLCHK FILE TO A BUFFER AND FREE THE FILE */
"ALLOC DA('APCP.ENDEVOR.JCLP("MEM")') F(INPDD) SHR REUSE"
SAY DR IS SUBSTR(INPUT.1,22,2)
SAY FP IS SUBSTR(INPUT.1,24,2)
SAY PS IS SUBSTR(INPUT.1,32,2)
------- DSCOPY -------
/******************************* REXX *********************************/

/* */
/* MANIPULATE A DATASET USING COBOL COPYBOOK */
/* */
/* */
/**********************************************************************/
ADDRESS TSO
MSGVAL = MSG('OFF')
COPYDS = ""
COPYBK = ""
DATAST = ""
OUTDS = ""
OUTFLD = ""
F = ' '
LTH = 1
ERR = "<<< ENTER THE REQUIRED INPUTS PLEASE >>>"
ADDRESS ISPEXEC
"ADDPOP "
"DISPLAY PANEL(DPANEL)"
SELECT

DO
EXIT
END
OTHERWISE
DO
CALL EXEC_PROGRAM
ADDRESS ISPEXEC
"REMPOP "
"ADDPOP "
"DISPLAY PANEL(DPANEL)"
END
END
END
EXIT
EXEC_PROGRAM :
LEN = 0
PREV = 0
O = 1
COPY ="'" || COPYDS || "(" || COPYBK || ")'"
IF LTH = " " THEN LTH = 0
IF F = " " THEN FILLER = COPIES(" ",LTH)

ELSE FILLER = COPIES(F,LTH)
IF SYSDSN(COPY) \= "OK" THEN DO

ERR = "<<< COPYBOOK NOT FOUND !!! >>>"
EXIT
END
IF SYSDSN("'"OUTFLD"'") \= "OK" THEN DO

ERR = "<<< OUTPUT COPYBOOK NOT FOUND !!! >>>"
EXIT
END
ADDRESS TSO
"ALLOC DD(INPFILE) DA('"DATAST"') SHR REU"
"EXECIO * DISKR INPFILE (STEM INPUT. FINIS"
"FREE F(INPFILE)"
ADDRESS TSO
"ALLOC DD(OUTFILE) DA('"OUTFLD"') SHR REU"
"EXECIO * DISKR OUTFILE (STEM FLD. FINIS"
"FREE F(OUTFILE)"
RECD = "= " || STRIP(FLD.1)
DO J = 2 TO FLD.0
REC = "= STRIP(FLD." || J || ")"
INTERPRET 'REC1' REC
RECD = RECD ||" || " || REC1
END
DO I = 1 TO INPUT.0
CALL PARSE_REC
INTERPRET 'RECORD.O' RECD
LEN = LENGTH(RECORD.O)
LEN = MAX(LEN,PREV)
PREV= LEN
O = O + 1
END
IF SYSDSN("'"OUTDS"'") = "OK" THEN DO

"DELETE '"OUTDS"'"
END
BLK = LEN * 100
ADDRESS TSO
"ALLOCATE DA('"OUTDS"') NEW SPACE(50,50) DSORG(PS) ,
RECFM(F,B) LRECL("LEN") BLKSIZE("BLK") MGMTCLAS(XTRABKUP) F(LIS1)"

"EXECIO * DISKW OUTFILE (STEM RECORD. FINIS"
"FREE F(OUTFILE)"
ERR = "<<< FUNCTION COMPLETED SUCCESSFULLY !!! >>>"

RETURN
/*--------- PARSE REC USING A COBOL COPYBOOK LAYOUT -----------------*/

/*
REQUIREMENT :-
--------------
1) COPYDS - COPYBOOK DATASET NAME

2) COPYBK - COPYBOOK MEMBER NAME
3) DATASET TO BE PARSED SHOULD BE READ ONLY TO INPUT. ARRAY
4) ONLY COBOL COPYBOOK IS SUPPORTED
*/
PARSE_REC :
/* CREATING SYSIN FOR INSYNC */
ADDRESS ISPEXEC
"VPUT (COPYBK) PROFILE"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('M#T053.MISC.CNTL') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL INSYSLAY"
"ISPEXEC FTCLOSE NAME(INSYSLAY)"
"FREE FI(SELFILE)"
/* CALLING INSYNC TO GET THE LAYOUT */
"ALLOC F(#INDD) DA('"COPYDS"') SHR REU"

"ALLOC F(#PRINT) DA('M#T053.TEST.LAYOUT') SHR REU"
"ALLOC F(#PARM) DA('M#T053.MISC.CNTL(INSYSLAY)') SHR REU"
"ALLOC F(#LOG) DA('M#T053.TEST.LOG') SHR REU"
"CALL 'MVSISV.INSYNC.LOADLIB(INSYNC)'"
"FREE F(#INDD)"
"FREE F(#PRINT)"
"FREE F(#PARM)"
"FREE F(#LOG)"
/* GOT THE LAYOUT - NOW CREATE VARIABLES AND ASSIGN POSITION TO THEM */
"ALLOC DD(LAYFILE) DA('M#T053.TEST.LAYOUT') SHR REU"

"EXECIO * DISKR LAYFILE (STEM LAYOUT. FINIS"
"FREE F(LAYFILE)"
DO J = 7 TO LAYOUT.0
PARSE VAR LAYOUT.J SEQN LVL FIELD FORMT MID START LEN DECI
IF SUBSTR(LEN,1,1) \=" " THEN LAST = LEN

ELSE LAST = MID
CONV = "=C2X(" || FIELD || ")"

REMC = "=SUBSTR(" || FIELD || ",1,"|| LAST+1 ||")"
NEGA = "=SUBSTR("|| FIELD ||","||LAST+1|| ",1)"
SGNN = "= '-'||SUBSTR("|| FIELD ||","||"1"||","||LAST||")"
SGNP = "= '+'||SUBSTR("|| FIELD ||","||"1"||","||LAST||")"
IF FORMT = "G" THEN DO
SBSTR = "=" || "SUBSTR(INPUT.I,"||MID||","||START||")"

INTERPRET FIELD SBSTR
END
ELSE DO
IF FIELD \="FILLER" THEN DO
IF FORMT = "Z" & DECI \= " " THEN DO
INTGR = "=" || "SUBSTR(INPUT.I,"||LEN||","||MID||")"

DECIM = "=" || "SUBSTR(INPUT.I,"||LEN+MID||","||START||")"
INTERPRET 'ING' INTGR

INTERPRET 'DEC' DECIM
SBSTR = "=" || ING || "." || DEC

ITERATE
END
SBSTR = "=" || "SUBSTR(INPUT.I,"||START||","||LEN||")"

IF FORMT = "B" | FORMT = "PS" THEN
INTERPRET FIELD CONV
IF FORMT = "PS" THEN DO
INTERPRET 'SGN' NEGA
IF SGN = "D" THEN
INTERPRET FIELD SGNN
ELSE
INTERPRET FIELD SGNP
INTERPRET FIELD REMC
END
END
END
END
RETURN
------- DSNLIST -------
/******************************* REXX *********************************/

/* */
/* DISPLAYS DSN LIST MATCHING A PATTERNS */
/* */
/* */
/**********************************************************************/
SAY "ENTER DSN PATTERN: "
PULL DSN
SAY "THE DSNS WITH THE PATTERN ARE: "
COUNT = 0
X= OUTTRAP("DSNINFO.",'*',"NOCONCAT")
ADDRESS TSO "LISTCAT ENT('"DSN"') ALL"
DO I=1 TO DSNINFO.0
IF SUBSTR(DSNINFO.I,1,7) = "NONVSAM" THEN
DO
SAY SUBSTR(DSNINFO.I,17,20)
COUNT = COUNT + 1
END
END
SAY "TOTAL NO OF DSN'S FOUND WITH THE PATTERN : " COUNT
EXIT
------- DSNS -------
ABC JCL JCLCHK - - - SKEL PROC - - SUPERC -

AGENCY JCL JCLCHK SOURCE SYSIN - SKEL - - - SUPERC -
BILLING JCL JCLCHK SOURCE SYSIN PANEL SKEL PROC CLIST RUNDOC SUPERC MSG
CORRESP JCL JCLCHK SOURCE SYSIN - SKEL PROC - - SUPERC -
FM JCL JCLCHK SOURCE SYSIN - SKEL PROC - - SUPERC -
JOBTRACK JCL JCLCHK - SYSIN - - PROC - - SUPERC -
LETTERGN - - SOURCE - PANEL - PROC - - SUPERC -
MKTRPTS JCL JCLCHK - SYSIN PANEL SKEL - CLIST RUNDOC SUPERC MSG
ONLINE JCL JCLCHK SOURCE SYSIN - SKEL - - - SUPERC -
PREMIUM JCL JCLCHK - SYSIN - - PROC - - SUPERC -
RABIT JCL JCLCHK - - - - PROC - RUNDOC SUPERC -
RENEWALS JCL JCLCHK SOURCE SYSIN PANEL SKEL PROC CLIST RUNDOC SUPERC -
REPORTS JCL JCLCHK SOURCE SYSIN PANEL SKEL PROC - - SUPERC -
SELECTNS JCL JCLCHK SOURCE SYSIN PANEL SKEL - CLIST - SUPERC -
SWEEPS JCL JCLCHK SOURCE SYSIN PANEL SKEL PROC CLIST RUNDOC SUPERC -
------- ENDVUTIL -------
/******************************* REXX *********************************/

/* */
/* ENDEVOR SCL UTILITY */
/* */
/* */
/******************************* REXX *********************************/
ADDRESS ISPEXEC
"LIBDEF ISPPLIB DATASET ID('MTAT.TATA.PANEL1')"
"ADDPOP"
"SELECT PANEL(ENDPNL)"
ADDRESS TSO
MESG = "THANK YOU, GOOD DAY !"
EXIT
------- FACTRIAL -------
/******************************* REXX *********************************/

/* */
/* CALCULATE FACTORIAL OF A NUMBER - RECURSION */
/* */
/* */
/**********************************************************************/
/* DEMONSTRATE RECURSIVE SUBROUTINE EXECUTION */
SAY "ENTER NO OF FACTORIAL :"

PULL Z
CALL FACTORIAL Z
SAY Z'! =' RESULT
EXIT
FACTORIAL: PROCEDURE /* CALCULATE FACTORIAL BY */
ARG N /* RECURSIVE INVOCATION. */
IF N=0 THEN RETURN 1
CALL FACTORIAL N-1
RETURN RESULT * N
------- FILRDTMP -------
/******************************* REXX *********************************/

/* */
/* TEMPLATE FOR READING A FILE AND WRITING OUTPUT */
/* */
/* */
/**********************************************************************/
LSTDS = "' '"

OUTDS = "' '"
"ALLOC DD(LSTFILE) DA("LSTDS") SHR REU"

"FREE F(LSTFILE)"
O = 1
DO I = 1 TO LST.0
END
"FREE F(OUTFILE)"
SAY "SCL GENERATED. EXITING..."
EXIT
------- GDGTEMP -------
*COLS 1-39 GDG NAME , COL 40-42 NO.OF GENERATIONS, COL 50-72 COMMENT
*
* GDG NAME GEN COMMENT
* -------- --- -------
MMBP.PRODCICS.MAGRENW.MQSDUMP 030 INED **

MMBP.COMBO.RNWL 030 INED **
MMBP.COMBO.RNWL.BKUP 030 INED **
MMBP.COMBO.GUEST 030 INED **
MMBP.OGRID.PROD 055 INED **
MMBP.PROJ.FILEOUT 055 INED **
MMBP.J4531DST.USMAIL.RNWL.WRAPRPT 006 FIRST INED **
MMBP.PRODCICS.MAGRENW 255 FIRST INED **
------- GDGUTIL -------
/****************************** REXX *********************************/

/* This exec gives you the list of gdgs, first generations that needs*/
/* to be created for new|ag subsystems */
/* */
/*********************************************************************/
/* Nov / 2003 Krishna Priya.M code initial version */
/* */
/* Nov / 2003 Balu added job card to jcl */
/*********************************************************************/
RETCD = 0
TITLE = 'NEWMAG - GDG UTILITY'
ADDRESS ISPEXEC
"VGET (CD C1 subsys) PROFILE"
IF RC > 0 then
DO
CD = ''
C1 = ''
subsys = ''
END
ADDRESS ISPEXEC
"LIBDEF ISPPLIB DATASET ID('MTAT.TATA.PANEL')"
"LIBDEF ISPSLIB DATASET ID('MTAT.TATA.ISPSLIB')"
"ADDPOP "
"DISPLAY PANEL(GDGUTIL) "
"VPUT (CD C1 subsys) PROFILE"
DO WHILE KP <> 'PF03'
CALL GDG_UTIL
ADDRESS ISPEXEC
"DISPLAY PANEL(GDGUTIL)"
END
ADDRESS ISPEXEC
"REMPOP"
EXIT (RETCD)
GDG_UTIL :
ADDRESS TSO
USER = USERID()
memgdg = 'MEMGDG'
memEMP = 'MEMEMPTY'
memCRE = 'MEMCREAT'
/* ----------- ALLOC INPUT FILE FOR GETTING GDG BASE NAMES ---------*/
"ALLOC DA('MTAT.NEWMAG.CNTL.GDGS("subsys")') F(INPDD) SHR REUSE"
"ALLOC DA('MTAT.NEWMAG.CNTL.GDGS.OUT1("subsys")') F(OUTDD) SHR REUSE"
/* TRACE i */
"ALLOC DA('MTAT.NEWMAG.CNTL.GDGS.OUT1("memgdg")') F(OUTGDG) SHR REUSE"
"ALLOC DA('MTAT.NEWMAG.CNTL.GDGS.OUT1("MEMEMP")') F(OUTEMP) SHR REUSE"
"ALLOC DA('MTAT.NEWMAG.CNTL.GDGS.OUT1("MEMCRE")') F(OUTCRE) SHR REUSE"
/* "EXECIO 0 DISKW OUTDD (OPEN"
"EXECIO 0 DISKW OUTGDG (OPEN" */
IF INPUT.0 = O THEN
DO
SAY SUBSYSTEM ' EMPTY '
EXIT
END
OUTREC. = ''
EMPREC. = ''
J = 0 ; M = 0 ; N = 0 ; ckpt = 0; c = 0; SCNT = 1
/*------------ START WRITING THE OUTPUT FILE -------------------------*/
GDGREC. = ''
M = 1
GDGREC.M = '//'|| USERID() ||'GB JOB (M000,NG31,20,PS26,SM,1,5,''G''),'
M = M + 1
GDGREC.M = '// ''CNTL/KG SUPT'',CLASS=A,REGION=6000K,NOTIFY='||USERID()
M = M + 1
GDGREC.M = '//TCSJHS OUTPUT JESDS=ALL,DEFAULT=Y,DEST=LOCAL'
M = M + 1
GDGREC.M = '//*--------------------------------------------------------'
M = M + 1
GDGREC.M = '//* GDG BASE CREATION USING IDCAMS UTILITY'
M = M + 1
GDGREC.M = '//*--------------------------------------------------------'
M = M + 1
GDGREC.M = '//DEFGDG EXEC PGM=IDCAMS'
M = M + 1
GDGREC.M = '//SYSPRINT DD SYSOUT=*'
M = M + 1
GDGREC.M = '//SYSIN DD *'
creREC. = ''
c = 1
creREC.c = '//'|| USERID() ||'FT JOB (M000,NG31,20,PS26,SM,1,5,''G''),'
c = c + 1
creREC.c = '// ''CNTL/KG SUPT'',CLASS=A,REGION=6000K,NOTIFY='||USERID()
creREC.c = creREC.c ||','
c = c + 1
creREC.c = '// MSGCLASS=T,PRTY=9'
c = c + 1
creREC.c = '//*'
c = c + 1
creREC.c = '//*------------------- RMS STEP --------------------------'
c = c + 1
creREC.c = '//RMSSTEP EXEC UCC15TST,'
c = c + 1
creREC.c = '// TYPRUN=''P'''
c = c + 1
creREC.c = '//*--------------------------------------------------------'
ddcnt = 0;
DO K = 1 TO INPUT.0
LT= ' ' ; X = 0;
/* If first char is * or space, then treat as comment */
IF substr(input.k,1,1) = '*' then iterate
/* IF substr(input.k,1,1) = ' ' then iterate */
PARSE VAR INPUT.K DSN LMT frst .
ckpt = ckpt + 1
if ckpt > 10 then
do
/* say k*/
ckpt = 0
end
MODDSN = STRIP(TRANSLATE(DSN))
FRST= STRIP(TRANSLATE(FRST))
STR = 'XX'
DO WHILE POS('XX',DSN) > 0
DSN = OVERLAY(CD,DSN,POS(STR,DSN),LENGTH(STR))
MODDSN = OVERLAY(C1,MODDSN,POS(STR,MODDSN),LENGTH(STR))
END
OPTION="ALL"
X= OUTTRAP("GDGINFO.",'*',"NOCONCAT")
ADDRESS "TSO" "LISTCAT ENT('"DSN"') GDG ALL"
IF (RC \= 0) THEN
X = 1
LIMIT= ' '

FIRST_GDG = 0
END_SRCH = 0
DO I= 6 TO GDGINFO.0
GDGINFO.I= TRANSLATE(GDGINFO.I,' ','-')
/* CHECK FOR LIMIT */
LPOS= WORDPOS('LIMIT',GDGINFO.I)
IF (LPOS > 0) THEN
DO
LIMIT= WORD(GDGINFO.I,2)
SCRATCH= WORD(GDGINFO.I,3)
EMPTY= WORD(GDGINFO.I,4)
END_SRCH = 1
END
/* CHECK FOR ASSOCIATIONS */
APOS= WORDPOS('ASSOCIATIONS',GDGINFO.I)
IF (APOS > 0) & (FRST = 'FIRST') THEN
DO
END_SRCH = 2
NPOS= WORDPOS('(NULL)',GDGINFO.I)
IF (NPOS > 0) & (frst = 'FIRST') THEN
DO
FIRST_GDG = 1
END
END
/* LEAVE ONCE BOTH ARE FOUND */
IF END_SRCH = 2 THEN
DO
LEAVE
END
END
IF LMT = LIMIT THEN
LT = 'YES'
ELSE
LT = 'NO'
J = J + 1
IF X = 1 THEN
DO
OUTREC.J = LEFT(STRIP(DSN),44)||' '||LEFT(STRIP(LMT),5)||' '||,
LEFT(STRIP(LT),5)||' '||LIMIT||'** GDG NOT DEFINED **'
M = M + 1
GDGREC.M = ' DEFINE GDG (NAME('DSN') -'
M = M + 1
GDGREC.M = ' LIMIT('LMT') SCRATCH NOEMPTY)'
M = M + 1
GDGREC.M = ' '
END
ELSE
DO
LEFT(STRIP(LT),5)||' '||LIMIT
END
/* SAY OUTREC */
IF FIRST_GDG = 1 THEN
DO
N = N + 1
EMPREC.N = LEFT(STRIP(DSN),44)||' '||LEFT(STRIP(LMT),5)||' '||,
LEFT(STRIP(LT),5)||' '||LIMIT || '**NO EMPTY GEN**'
DDCNT = DDCNT + 1
c = c + 1
CREREC.c ='//STEP' ||SCNT||' EXEC PGM=IEFBR14'
c = c + 1
CREREC.c = "//DD" || DDCNT || ' '|| 'DD DSN=' ||,
DSN || "(+1),"
c = c + 1
CREREC.c = "// " || "DISP=(,CATLG)," ||,
"SPACE=(TRK,(0,0),RLSE), "
c = c + 1
CREREC.c = "// " || "DCB=" || MODDSN ||,
".G0001V00"
c = c + 1
CREREC.c = '//SYSPRINT DD SYSOUT=*'
c = c + 1
CREREC.c = '//SYSIN DD DUMMY'
c = c + 1
CREREC.c = '//*'
SCNT = SCNT + 1
END
END
/*SAY 'NO OF INPUT READ' J*/
outrec.0 = j
/* for each new gdg, 3 lines are written */
m = m / 3
GDGREC.0 = m
/*err = 'NO OF empty gens to be creatED ' n*/
EMPREC.0 = n
"EXECIO * DISKW OUTDD (STEM outrec. FINIS"
"FREE DD (OUTDD) NOHOLD"
"EXECIO * DISKW OUTGDG (STEM GDGREC. FINIS"
"FREE DD (OUTGDG) NOHOLD"
"EXECIO * DISKW OUTEMP (STEM EMPREC. FINIS"
"FREE DD (OUTEMP) NOHOLD"
"EXECIO * DISKW OUTCRE (STEM CREREC. FINIS"
"FREE DD (OUTCRE) NOHOLD"
/*for displaying no.of gdg base creation dsn*/
err = 'NO OF GDGS/first gens TO BE DEFINED ' M n
err1 = 'CHECK IN MTAT.NEWMAG.CNTL.GDGS.OUT1(MEMGDG,EMPTY,CREAT)'
/*for displaying the job to the user */
address ispexec
"EDIT DATASET('mtat.newmag.cntl.gdgs.out1(memgdg)')"
"EDIT DATASET('mtat.newmag.cntl.gdgs.out1(memcreat)')"
return
------- JC -------
/************************* REXX ***********************************

* %JCUT
* This REXX is used as an Edit macro to CUT lines from an
* Edit session. Use %JPASTE to retrieve the CUT lines.
*
* Posted by : Balu Subramoniam.V.
*
******************************************************************/
/*
* The following fields are hardcoded: */
CUTDSN = "'"USERID()".RTMPN.CUTPASTE'"
/**********************************************************************/
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"
ADDRESS ISREDIT
"MACRO (DUMMY) NOPROCESS"
"(MACLVL) = MACRO_LEVEL"
IF MACLVL <> 001 THEN DO
ZEDLMSG = "%JCUT can only be executed as an EDIT macro from",
"an EDIT session."
SIGNAL EXIT
END
/*
* Check for an empty member
*/
"(ZLAST) = LINENUM .ZLAST"
IF ZLAST = 0 THEN DO
ZEDLMSG = "There are no lines to CUT."
SIGNAL EXIT
END
/*
* Process Edit session range parameters (CC or MM)
*/
"(WIDTH) = DATA_WIDTH"
"PROCESS RANGE C M"
IF RC = 0 THEN DO
"(FROMLINE) = LINENUM .ZFRANGE"
"(TOLINE) = LINENUM .ZLRANGE"
END
ELSE DO
IF RC = 4 THEN DO
"(FROMLINE) = LINENUM .ZFIRST"
"(TOLINE) = LINENUM .ZLAST"
END
ELSE DO
ZEDSMSG = ZERRSM
ZEDLMSG = ZERRLM
SIGNAL EXIT
END
END
/*
* Queue specified lines
*/
COUNTER = FROMLINE
"(LINE) = LINE "COUNTER
RETCODE = RC
DO UNTIL COUNTER > TOLINE | RETCODE <> 0
QUEUE LINE
COUNTER = COUNTER + 1
"(LINE) = LINE "COUNTER
RETCODE = RC
END
/*
* If edit session range is M then delete lines
*/
"(RANGECMD) = RANGE_CMD"
IF RANGECMD = "M" THEN,
"DELETE "FROMLINE" "TOLINE
/*
* Allocate CUT dataset
*/
X = LISTDSI(CUTDSN)
ADDRESS TSO
IF SYSREASON = 0 & SYSLRECL = WIDTH THEN,
"ALLOC FI(CUTDD) DA("CUTDSN") SHR REUSE"
ELSE DO
DEFINE = MSG("OFF")
"DEL "CUTDSN
"ALLOC FI(CUTDD) DA("CUTDSN") NEW REUSE DSORG(PS)",
"SPACE(5,5) CYLINDERS LRECL("WIDTH")",
"BLKSIZE(0) RECFM(F,B) CATALOG UNIT(SYSDA)"
END
/*
* Write queued lines to allocated CUT dataset
*/
LINESCUT = QUEUED()
"EXECIO "QUEUED()" DISKW CUTDD (FINIS"
RETCODE = RC
IF RETCODE = 0 THEN DO
IF LINESCUT = 1 THEN DO
ZEDSMSG = "1 Line CUT"
ZEDLMSG = "The line you specified has been CUT. Use",
"PASTE to retrieve."
END
ELSE DO
ZEDSMSG = LINESCUT" Lines CUT"
ZEDLMSG = LINESCUT" Specified lines have been CUT. Use",
"PASTE to retrieve."
END
END
ELSE,
ZEDLMSG = "CUT FAILED.....RC="RETCODE
"DELSTACK"
"FREE FI(CUTDD)"
EXIT:
ADDRESS ISPEXEC
"SETMSG MSG(ISRZ000)"
EXIT
------- JCLCK -------
/****************************** REXX *********************************/

/* */
/* JCL CHECK UTILITY */
/* */
/* BALU SUBRAMONIAM .V. */
/*********************************************************************/
ADDRESS TSO
MSGVAL = MSG('OFF')
JCL1=""
JCL2=""
EQ ="="
NEQ ="\="
ERR ="<<< ENTER THE JCL AND JCLCHK DATASET >>>"
ADDRESS ISPEXEC
"LIBDEF ISPPLIB DATASET ID('M#T053.REXX.PROGRAM')"
"ADDPOP "
"DISPLAY PANEL(JPANEL)"
SELECT

DO
EXIT
END
OTHERWISE
DO
CALL EXEC_JCL
ADDRESS ISPEXEC
"REMPOP "
"ADDPOP "
"DISPLAY PANEL(JPANEL)"
END
END
END
EXIT
EXEC_JCL:
IF SYSDSN("'"JCL1"'") \= "OK" THEN DO

ERR = "<<< JCL DATASET IS NOT FOUND !!! >>>"
RETURN
END
IF SYSDSN("'"JCL2"'") \= "OK" THEN DO

ADDRESS TSO
"ALLOCATE DA('"JCL2"') NEW DIR(100) SPACE(50,50) DSORG(PO) ,
END
JCL1='"'||JCL1||'"'
JCL2='"'||JCL2||'"'
ADDRESS ISPEXEC
"VPUT (JCL1,JCL2,EQ,NEQ) PROFILE"
"LIBDEF ISPSLIB DATASET ID('M#T053.TEST.SKELETON')"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('M#T053.MISC1.CNTL') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL FSTSKEL"
"ISPEXEC FTCLOSE NAME(JCLCHK)"
"FREE FI(SELFILE)"
JID = USERID() || "RX"

TID = USERID()
TYPE= "JCLCHK"
ADDRESS ISPEXEC
"VPUT (JID,TID,TYPE) PROFILE"
ADDRESS TSO
"ALLOC REUSE FI(TELFILE) DA('M#T053.SELECTN.CNTL') SHR"
"ISPEXEC LIBDEF ISPFILE LIBRARY ID(TELFILE)"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL MODJCL"
"ISPEXEC FTCLOSE NAME(MODJCLA)"
"FREE FI(TELFILE)"
ADDRESS TSO
"SUBMIT 'M#T053.SELECTN.CNTL(MODJCLA)'"
JCL1=""
JCL2=""
ERR = "<<<< YOUR JOB IS SUBMITTED !!! >>>>"
RETURN
------- JCLGEN -------
/******************************* REXX *********************************/

/* */
/* GENERATE JCLS BY FILE TAILORING A SKELETON */
/* */
/* */
/**********************************************************************/
SAY "ENTER MAGAZINE DETAILS DATASET :"

PULL LSTDS
SAY "ENTER SKELETON DATASET :"

PULL SKELDS
SAY "ENTER OUTPUT DATASET :"

PULL OUTDS

SAY OUTDS || " - DATASET NOT FOUND, IT IS CREATED !!!"
ADDRESS TSO
"ALLOCATE DA('"OUTDS"') NEW DIR(100) SPACE(90,90) DSORG(PO) ,
END
IF SYSDSN("'"SKELDS"'") \= "OK" THEN DO
SAY "UNABLE TO LOCATE SKELETON DATASET !!!"
EXIT
END
ADDRESS TSO
"FREE F(LSTFILE)"
DO I = 3 TO LST.0
/*--------------------------------------------------------------------*/
/* LAYOUT OF THE INPUT FILE */
/*--------------------------------------------------------------------*/
MG = SUBSTR(LST.I,1,2)
DR = SUBSTR(LST.I,4,2)
PS = SUBSTR(LST.I,7,2)
FP = SUBSTR(LST.I,10,2)
REGION = STRIP(SUBSTR(LST.I,13,6))
SF = SUBSTR(LST.I,20,2)
SORTCYL = STRIP(SUBSTR(LST.I,23,7))
/*--------------------------------------------------------------------*/
TDATE = DATE('U')
ADDRESS ISPEXEC
"CONTROL ERRORS RETURN"
"LMINIT DATAID(PDSID) DATASET('"SKELDS"') ENQ(SHR)"
"LMOPEN DATAID("PDSID")"
SKEL = " " ; STOP = 0
"LMMLIST DATAID("PDSID") OPTION(LIST) MEMBER(SKEL)"
DO WHILE STOP = 0
SKEL = STRIP(SKEL)
IF POS('XX',SKEL) > 0 THEN DO

ELM = OVERLAY(MG,SKEL,POS('XX',SKEL),LENGTH('XX'))
END
ADDRESS ISPEXEC
"VPUT (MG,SF,SORTCYL,DR,PS,REGION,FP) PROFILE"
"LIBDEF ISPSLIB DATASET ID('"SKELDS"')"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('"OUTDS"') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL "SKEL""
"ISPEXEC FTCLOSE NAME("ELM")"
"FREE FI(SELFILE)"
ADDRESS ISPEXEC
"LMMLIST DATAID("PDSID") MEMBER(SKEL) OPTION(LIST)"
STOP = RC
END
ADDRESS ISPEXEC
"LMMLIST DATAID("PDSID") OPTION(FREE)"
"LMCLOSE DATAID("PDSID")"
"LMFREE DATAID("PDSID")"
END
EXIT
------- JCLINFO -------
/******************************* REXX *********************************/

/* */
/* CREATE ACCOUNTING INFO FOR JCLS */
/* */
/* */
/**********************************************************************/
SAY " ENTER THE JCL DATASET"
PULL JCLDSN
JCLDSN = STRIP(JCLDSN)
SAY " ENTER THE PATTERN (USE *)"

PULL PATTERN
S = POS("*",PATTERN)
IF (S < 4) THEN SRCH = STRIP(SUBSTR(PATTERN,S,LENGTH(PATTERN)))
ELSE SRCH = STRIP(SUBSTR(PATTERN,1,S))
IF SYSDSN("'"JCLDSN"'") <> 'OK' THEN

DO
SAY "JCL DATASET NOT FOUND !!!"
EXIT
END
SAY " ENTER DESTINATION DATASET WITH MEMBER NAME IN BRACKETS"

PULL ACCTDSN
ACCTDSN = STRIP(ACCTDSN)
POSI = POS("(",ACCTDSN)
ADSN = SUBSTR(ACCTDSN,1,POSI - 1)
IF SYSDSN("'"ADSN"'") <> 'OK' THEN

DO
SAY " INVALID DESTINATION DATASET :" ADSN
EXIT
END
J = 0
OUT. = ' '
X = OUTTRAP(LIS.)
"LISTDS '"JCLDSN"' MEMBERS"
X = OUTTRAP(OFF)
DO I = 7 TO LIS.0
MEM = STRIP(LIS.I)
MEM1 = SUBSTR(MEM,2,2)
IF POS(SRCH,MEM) > 0 THEN
DO
LEN = LENGTH(MEM)
FRM = LEN + 1
TILL = 38 - LEN
MEMDSN = JCLDSN || '(' || MEM || ')'
"ALLOC DA('"MEMDSN"') F(INPD2) SHR REUSE"
"EXECIO 1 DISKR INPD2 (STEM INPUT2. FINIS"
"FREE DD (INPD2) NOHOLD"
PRPOS = POS(",PS",INPUT2.1)
DS = SUBSTR(INPUT2.1,PRPOS - 7,2)
FP = SUBSTR(INPUT2.1,PRPOS - 5,2)
PR = SUBSTR(INPUT2.1,PRPOS + 3,2)
J = J + 1
OUT.J = MEM || SUBSTR(OUT.J,FRM,TILL) || PR || ' ' || FP || ' ' || DS
NEW.J = OUT.J
END
END
"ALLOCATE F(OUTDD) DS('"ACCTDSN"') SHR REUSE"

"EXECIO * DISKW OUTDD (STEM NEW. FINIS"
"FREE F(OUTDD)"
EXIT
------- JHSREPT -------
/******************************* REXX *********************************/

/* */
/* GENERATE PROGRAM STATISTICS FROM JHS OUTPUT */
/* */
/* */
/**********************************************************************/
SAY 'ENTER JHS DATASET :'

PULL LSTDS
SAY 'ENTER OUTPUT DATASET :'

PULL OUTDS
ADDRESS TSO
"FREE F(LSTFILE)"
O = 1
I = 1
DO WHILE SUBSTR(LST.I,40,18) \= "PROGRAM STATISTICS"

I = I + 1
END
I = I + 3
DO WHILE SUBSTR(LST.I,12,16) \= "*****TOTALS*****"
LINE = SUBSTR(LST.I,24,19)
DO WHILE POS(',',LINE) > 0

LINE = SUBSTR(LINE,1,(POS(',',LINE)-1)) || ,
SUBSTR(LINE,(POS(',',LINE)+1),LENGTH(LINE))
END
PROGRAM = RIGHT(SUBSTR(LINE,1,8),8)
COUNT = RIGHT(STRIP(SUBSTR(LINE,9,11)),10)
OUT.O = PROGRAM || COUNT

O = O + 1
I = I + 1
END
ADDRESS TSO
"FREE F(OUTFILE)"
SAY "DONE..."
EXIT
------- JP -------
/************************* REXX ***********************************

* %JPASTE
* This REXX is used as an Edit macro to PASTE lines into the
* current Edit session that were previously CUT using %JCUT.
*
* Posted by : Balu Subramonim .V.
*
******************************************************************/
/*
* The following fields are hardcoded: */
CUTDSN = "'"USERID()".RTMPN.CUTPASTE'"
/**********************************************************************/
ADDRESS ISREDIT
"MACRO (DUMMY) NOPROCESS"
"(MACLVL) = MACRO_LEVEL"
IF MACLVL <> 001 THEN DO
ZEDLMSG = "%JPASTE can only be, executed as an EDIT macro from",
"an EDIT session."
SIGNAL EXIT
END
/*
* Allocate CUT dataset and check LRECL
*/
"(WIDTH) = DATA_WIDTH"
X = LISTDSI(CUTDSN)
IF SYSREASON = 0 THEN DO
IF SYSLRECL > WIDTH THEN DO
ZEDSMSG = "TRUNCATION OCCURRED"
ZEDLMSG = "Truncation of CUT data occured: CUT-LRECL=",
SYSLRECL" PASTE-LRECL= " WIDTH
END
ADDRESS TSO "ALLOC FI(CUTDD) DA("CUTDSN") SHR REUSE"
END
ELSE DO
ZEDSMSG = "USE CUT FIRST"
ZEDLMSG = "Something must be CUT before PASTE can be used"
SIGNAL EXIT
END
/*
* Process edit session destination parms (A or B)
*/
"PROCESS DEST"
IF RC = 0 THEN,
"(DEST) = LINENUM .ZDEST"
ELSE DO
IF RC = 8 THEN,
"(DEST) = LINENUM .ZLAST"
ELSE
DEST = 0
END
/*
* Load queue with contents of CUT dataset
*/
ADDRESS TSO "EXECIO * DISKR CUTDD (FINIS)"
/*
* Insert queued lines into edit session at specified destination
*/
LINENUM = DEST
LINESCUT = QUEUED()
DO LINESCUT
PARSE PULL RECORD /* PARSE used to not convert to upper case */
"LINE_AFTER "LINENUM" = (RECORD)"
LINENUM = LINENUM + 1
END
/*
* Clean up and issue messages
*/
ADDRESS TSO "DELSTACK"
ADDRESS TSO "FREE FI(CUTDD)"
"RESET LABEL"
IF DEST = 0 THEN
"CURSOR = 1 1"
ELSE,
"CURSOR = "DEST" 1"
IF ZEDLMSG = "ZEDLMSG" THEN DO
IF LINESCUT = 1 THEN DO
ZEDSMSG = "1 Line PASTED"
ZEDLMSG = "The line you previously CUT has been PASTED"
END
ELSE DO
ZEDSMSG = LINESCUT" LINES PASTED"
ZEDLMSG = LINESCUT" previously CUT lines have been PASTEd"
END
END
EXIT:
ADDRESS ISPEXEC
"SETMSG MSG(ISRZ000)"
EXIT
------- KEYCHANG -------
/******************************* REXX *********************************/

/* */
/* CHANGE DEFAULT FUNCTIONS OF FUNCTION KEYS */
/* */
/* */
/**********************************************************************/
ADDRESS ISPEXEC
"LIBDEF ISPPLIB DATASET ID('M#T053.MISC.CNTL')"
"ADDPOP"
"DISPLAY PANEL(RCHATPNL)"
ADDRESS ISPEXEC
"VGET (ZPFKEY)"
IF ZPFKEY= 'PF03' THEN DO
ZPFKEY= ' HI '
SAY ZPFKEY
END
EXIT
------- LIMIT -------
/*rexx*/
say "enter the gdg to find the limit"
pull gdg
do while gdg = ' '
say "kindly enter the gdg"
pull gdg
end
ADDRESS "TSO" "LISTCAT ENT('"gdg"') GDG ALL"
parse var gdginfo.7 limit scratch

parse var gdginfo.1 val1 rest
str1=right(limit,3)
if val1 \= 'GDG' then

say "it is not a gdg base"
else
call limit
exit
limit:
s2=strip(str1,,'-')
say "limit of the gdg " || gdg || " is " || s2
return
------- NXTSTR -------
/******************************* REXX *********************************/

/* */
/* FIND THE NEXT OCCURANCE OF THE STRING AT CURSOR POS */
/* */
/* */
/**********************************************************************/
ADDRESS ISREDIT
"MACRO"
"(LPTR,COL) = CURSOR"
"(LRECL) = LRECL"
"(RECORD) = LINE" LPTR
RECORD = SUBSTR(RECORD,COL,LRECL)
POSSPACE = POS(' ',RECORD)
IF POSSPACE = 0 THEN
POSSPACE = LRECL
WRD = SUBSTR(RECORD,1,POSSPACE)
ADDRESS ISREDIT
"F ALL '"WRD"'"
------- PBAR -------
/******************************* REXX *********************************/

/* */
/* CALCULATE TIME TAKEN BY A FUNCTION */
/* */
/* */
/**********************************************************************/
/* Rexx Think */
t = sysvar(syscpu)
ADDRESS ISPEXEC delay 5
/* some process*/
t = sysvar(syscpu) - t
zedsmsg = 'Took' t 'seconds'
'ispexec setmsg msg(isrz000)'
return
------- PGMKEY -------
/******************************* REXX *********************************/

/* */
/* USE A FUNCTION KEY FOR MULTIPLE PURPOSE */
/* */
/* */
/**********************************************************************/
ARG CMD ARG1
IF CMD = "E" THEN

DO
IF SYSDSN("'"||ARG1||"'") = "OK" THEN "ISPEXEC EDIT DATASET('"ARG1"')"

ELSE DO
ZEDLMSG = "DATASET " || ARG1 || " NOT FOUND"
'ISPEXEC SETMSG MSG(ISRZ000)'
END
END
IF CMD = "V" THEN

DO
IF SYSDSN("'"||ARG1||"'") = "OK" THEN "ISPEXEC VIEW DATASET('"ARG1"')"

ELSE DO
ZEDLMSG = "DATASET " || ARG1 || " NOT FOUND"
'ISPEXEC SETMSG MSG(ISRZ000)'
END
END
IF CMD = "T" THEN

DO
DSN = "MTAT.TIMERPT."|| SUBSTR(DATE('M'),1,3) || SUBSTR(DATE('S'),3,2) ,
|| "(BALU)"
"ISPEXEC EDIT DATASET('"DSN"')"
END
IF CMD = "W" THEN

DO
IF ARG1 = "S" THEN DSN="MTAT.WORK.PROGRESS("|| SUBSTR(DATE('M'),1,3) ,

|| SUBSTR(DATE('S'),3,2) ||")"
IF ARG1 = "C" THEN DSN="MTAT.WORK.PROGRESS("|| SUBSTR(DATE('M'),1,3) ,
|| SUBSTR(DATE('S'),3,2) ||")"
IF ARG1 = "M" THEN DSN="MTAT.WORK.PROGRESS("|| SUBSTR(DATE('M'),1,3) ,
|| SUBSTR(DATE('S'),3,2) ||"M)"
"ISPEXEC VIEW DATASET('"DSN"')"
END
IF CMD = "J" THEN "JCLCHK"
IF CMD = "S" THEN "SUPRC"

EXIT
------- PRODCNT -------
/********************************REXX**********************************/
/* */
/* THIS TOOL GENERATES THE PRODUCTION COUNTS FOR PROGRAMS */
/* */
/* */
/**********************************************************************/
INPTEMP = "'MTAT.TATA.WORKAREA(PDSTEMP)'"
ZEDLMSG = " ENTER THE MAGCODE, FMDATE AND PROGRAM NAME !!! "
ADDRESS ISPEXEC "SETMSG MSG(ISRZ000)"
ADDRESS ISPEXEC
"EDIT DATASET("INPTEMP")"
ADDRESS TSO
"FREE DATASET("INPTEMP")"
SAY 'MAIL DATASET : '

PULL OUTDS
ADDRESS TSO
MSGVAL = MSG('OFF')
"ALLOC DD(INPFILE) DA("INPTEMP") SHR REU"

"EXECIO * DISKR INPFILE (STEM INP. FINIS"
"FREE F(INPFILE)"
O = 1
OUTREC.O = " " || DATE()

O = O + 1
OUTREC.O = "Hi Arun,"
O = O + 1
OUTREC.O = " "
O = O + 1
OUTREC.O = "Here are the production counts for <task name>"
O = O + 1
OUTREC.O = " "
O = O + 1
DO K = 8 TO INP.0
MAG = STRIP(SUBSTR(INP.K,1,2))
FMDATE = STRIP(SUBSTR(INP.K,4,8))
PROGNAME = STRIP(SUBSTR(INP.K,13,8))
IF MAG = " " THEN LEAVE

ELSE DO
CALL PROD_OUTDS
CALL PROD_COUNTS
END
END
"FREE F(OUTFILE)"
ZEDLMSG = " PRODUCTION COUNTS GENERATED !!! "

ADDRESS ISPEXEC
EXIT
/*--------------------------------------------------------------------*/
PROD_OUTDS :
/* TAILORING SYSIN NEEDED FOR JHSPRINT */
OUT.1 = "LOGON SYSTEM(JHS)"

OUT.2 = "OPTIONS AUTORESTORE(NO) RESTOREWAIT(59) MAXJOBS(999)"
OUT.3 = "PRINT JOB(M"||MAG||"PFM) -"
OUT.4 = "FROMSTARTTIME(0000) -"
OUT.5 = "FROMSTARTDATE("||FMDATE||") -"
OUT.6 = "TOSTARTTIME(2359) -"
OUT.7 = "TOSTARTDATE("||FMDATE||") -"
OUT.8 = "DDNAME(JESJCL) -"
OUT.9 = "OUTFILE(PRINTER) "
OUT.10= "LOGOFF "
"ALLOC DD(OUTFILE) DA('MTAT.TATA.WORKAREA(JESJCL)') SHR REU"

"FREE F(OUTFILE)"
/* CALLING JHSPRINT TO PRINT THE OCOMBRP2 DD CARD */
"ALLOC F(PRINTER) DA('MTAT.JHS.LIST') SHR REU"

"ALLOC F(SYSPRINT) DA('MTAT.JHSPRINT.SYSPRINT') SHR REU"
"ALLOC F(SYSIN) DA('MTAT.TATA.WORKAREA(JESJCL)') SHR REU"
"CALL 'MVSISV.JHS.JHSLIB.ZOS(JHSPRINT)'"
"FREE F(PRINTER)"
"FREE DDNAME(SYSPRINT)"
IPSRCH = "II" || SUBSTR(PROGNAME,4,3)

OPSRCH = "OO" || SUBSTR(PROGNAME,4,3)
"ALLOC DD(LSTFILE) DA('MTAT.JHS.LIST') SHR REU"

"EXECIO * DISKR LSTFILE (STEM JES. FINIS"
"FREE F(LSTFILE)"
IC = 1
OC = 1
DROP IPDSN.
DROP OPDSN.
DO I = 1 TO JES.0
IF SUBSTR(JES.I,23,5) = IPSRCH THEN DO

J = I + 1
IPDSN.IC = SUBSTR(JES.J,25,35)
IC = IC + 1
END
IF SUBSTR(JES.I,23,5) = OPSRCH THEN DO

J = I + 4
OPDSN.OC = SUBSTR(JES.J,16,35)
OC = OC + 1
END
END
RETURN
/*--------------------------------------------------------------------*/
PROD_COUNTS :
/* TAILORING SYSIN NEEDED FOR JHSPRINT */
OUT.1 = "LOGON SYSTEM(JHS)"

OUT.2 = "OPTIONS AUTORESTORE(NO) RESTOREWAIT(59) MAXJOBS(999)"
OUT.3 = "PRINT JOB(M"||MAG||"PFM) -"
OUT.4 = "FROMSTARTTIME(0000) -"
OUT.5 = "FROMSTARTDATE("||FMDATE||") -"
OUT.6 = "TOSTARTTIME(2359) -"
OUT.7 = "TOSTARTDATE("||FMDATE||") -"
OUT.8 = "DDNAME(OCOMBRP2) -"
OUT.9 = "OUTFILE(PRINTER) "
OUT.10= "LOGOFF "
"ALLOC DD(OUTFILE) DA('MTAT.TATA.WORKAREA(JHSPRINT)') SHR REU"

"FREE F(OUTFILE)"
/* CALLING JHSPRINT TO PRINT THE OCOMBRP2 DD CARD */
"ALLOC F(PRINTER) DA('MTAT.JHS.LIST') SHR REU"

"ALLOC F(SYSPRINT) DA('MTAT.JHSPRINT.SYSPRINT') SHR REU"
"ALLOC F(SYSIN) DA('MTAT.TATA.WORKAREA(JHSPRINT)') SHR REU"
"CALL 'MVSISV.JHS.JHSLIB.ZOS(JHSPRINT)'"
"FREE F(PRINTER)"
"FREE DDNAME(SYSPRINT)"
/* READ THE OCOMBRP2 DS */
"ALLOC DD(LSTFILE) DA('MTAT.JHS.LIST') SHR REU"

"FREE F(LSTFILE)"
/* WRITING HEADER RECORDS TO OUTPUT FILE */
OUTREC.O = " PRODUCTION COUNTS FOR " || MAG || " MAGAZINE"

O = O + 1
OUTREC.O = " *-------------------------------*"
O = O + 1
OUTREC.O = " "
O = O + 1
IF (IC - 1) > 0 THEN DO
OUTREC.O = "INPUT FILE : "
O = O + 1
DO I = 1 TO (IC - 1)
OUTREC.O = IPDSN.I
O = O + 1
END
END
OUTREC.O = "OUTPUT FILE : "
O = O + 1
DO I = 1 TO (OC - 1)
OUTREC.O = OPDSN.I
O = O + 1
END
OUTREC.O = " "
O = O + 1
OUTREC.O = "COUNTS : "
O = O + 1
OUTREC.O = " "
O = O + 1
I = 1
/* READ THE OCOMBRP2 AND EXTRACT THE REQUIRED COUNTS */
DO FOREVER
IF STRIP(SUBSTR(LST.I,35,8)) = PROGNAME THEN LEAVE
ELSE I = I + 1
IF I > LST.0 THEN DO

SAY PROGNAME || " NOT FOUND FOR " || MAG
RETURN
END
END
I = I + 1
DO FOREVER
IF SUBSTR(LST.I,27,8) = "PROGRAM=" THEN DO

IF STRIP(SUBSTR(LST.I,35,8)) \= PROGNAME THEN LEAVE
END
OUTREC.O = SUBSTR(LST.I,1,80)
O = O + 1
I = I + 1
END
OUTREC.O = " "

O = O + 1
RETURN
------- RECURSE -------
/******************************* REXX *********************************/

/* */
/* DETERMINING PROGRAM CALLS USING RECURSION CONCEPT */
/* */
/* */
/**********************************************************************/
/* OPEN INPUT DATASET INPUT DATASET :- */

"ALLOC DD(LSTFILE) DA('M#T053.BALU.MISC.CNTL(CALLANAL)') SHR REU"
"FREE F(LSTFILE)"
/* INITIALIZE THE VARIABLES */

O = 1
X = 1
FIRST = 1
PREV = " "
/* GET THE LIST OF PROGRAM BY REMOVING THE DUPLICATES IN COL 1 :- */

DO I = 1 TO LST.0
PRES.I = STRIP(SUBSTR(LST.I,1,9))
IF PREV = PRES.I THEN ITERATE
PGM.O = PRES.I
O = O + 1
PREV = PRES.I
END
/* FOR EACH PROGRAM, CALL THE FINDSUB SUBRTN TO GET THE PGMS/SUBPGMS */
DO J = 1 TO O-1
ROOT = PGM.J
CALL FINDSUB PGM.J
END
/* WRITE THE OUTPUT TO A FILE */

"ALLOC DD(OUTFILE) DA('MTAT.ASSEMBLR.CALLANAL.REPORT') SHR REU"
"FREE F(OUTFILE)"
/* END OF PROGRAM */
EXIT
/*********************************************************************/
/* FIND SUB SUBROUTINE :- FINDS THE PGM/SUBPGM CALLED BY A ASSEMBLR */
/* */
/* PASSED PARM : PROGRAM FOR WHICH PGM/SUBPGM NEEDS TO BE FOUND */
/* RETURN : NOTHING */
/*********************************************************************/
FINDSUB : PROCEDURE EXPOSE X ROOT FIRST OUTREC.

ARG PROGRAM
FOUND = "NO"
/* OPEN THE INPUT FILE AGAIN */

"ALLOC DD(LSTFILE) DA('M#T053.BALU.MISC.CNTL(CALLANAL)') SHR REU"
"FREE F(LSTFILE)"
/* IGNORE THE ROOT VALUE I.E..FIRST TIME */

IF FIRST = 1 THEN FIRST = 0
/* WRITE THE PROGRAM TO OUTPUT */

ELSE DO
OUTREC.X = LEFT(ROOT,10) || LEFT(PROGRAM,15)
X = X + 1
END
/* SEARCH THE RECIEVED PROGRAM TO FIND ANY SUBPROGRAMS */

DO K = 1 TO LST.0
IF PROGRAM \= STRIP(SUBSTR(LST.K,1,9)) THEN DO
ITERATE
END
/*IF COL1 VALUE = RECIEVED PROGRAM THEN SUBPGM FOUND, RECURSIVELY CALL
THE FINDSUB SUB USING THIS SUBPGM TO FIND THE NEXT LEVEL OF SUBPGMS */
SUB = STRIP(SUBSTR(LST.K,11,9))
CALL FINDSUB SUB
FOUND = "YES"
END
/* IF NO MATCH FOUND THEN THERE ARE NO MORE SUBPGMS SO RETURN */

IF FOUND = "NO" THEN DO
RETURN
END
/* END OF SUBROUTINE */
RETURN
------- RETMEM -------
/******************************* REXX *********************************/

/* */
/* CREATES SCL FOR RETRIEVING ELEMENTS FROM ENDEVOR */
/* */
/* */
/* -------------- */
/* */
/* ELEMENT NAME 01-10 */
/* ENVIRONMENT 12-04 */
/* SYSTEM 24-08 */
/* SUBSYSTEM 33-08 */
/* TYPE 43-10 */
/* */
/******************************* REXX *********************************/
ADDRESS TSO
MSGVAL = MSG('OFF')
LSTDS = ""
OUTDS = ""
SRCEDS = ""
COMMENTS = ""
E = "E"
ERR = "<<< ENTER THE REQUIRED INPUTS !!! >>>"
ADDRESS ISPEXEC
"ADDPOP "
"DISPLAY PANEL(RETMEM)"
SELECT

DO
EXIT
END
OTHERWISE
DO
CALL EXEC_PGM
ADDRESS ISPEXEC
"REMPOP "
"ADDPOP "
"DISPLAY PANEL(RETMEM)"
END
END
END
EXIT
EXEC_PGM :
/* INPUT DATASETS VALIDATION */

ERR = "<<< LIST DATASET IS NOT FOUND !!! >>>"
RETURN
END
IF SYSDSN("'"SRCEDS"'") \= "OK" THEN DO

ERR = "<<< SOURCE DATASET IS NOT FOUND !!! >>>"
RETURN
END
ADDRESS TSO
"FREE F(LSTFILE)"
O = 1
OUT.O = " SET STOPRC 16 . "

O = O + 1
/* GENERATE THE SCLS */
DO I = 1 TO LST.0
ELMT = STRIP(SUBSTR(LST.I,1,10))
ENV = STRIP(SUBSTR(LST.I,12,4))
SYS = STRIP(SUBSTR(LST.I,24,8))
SUB = STRIP(SUBSTR(LST.I,33,8))
TYP = STRIP(SUBSTR(LST.I,43,10))
OUT.O = " RETRIEVE ELEMENT "|| "'"||ELMT|| "'"

O = O + 1
OUT.O = " FROM ENVIRONMENT " ||"'"|| ENV || "'" ||,
" SYSTEM " ||"'"|| SYS || "'" ||,
" SUBSYSTEM " ||"'"|| SUB ||"'"
O = O + 1
OUT.O = " TYPE "|| "'"||TYP|| "'"
O = O + 1
OUT.O = " STAGE 'P'"
O = O + 1
OUT.O = " TO DSNAME "|| "'"|| SRCEDS || "'"
O = O + 1
OUT.O = " OPTIONS CCID "|| "'"||USERID()|| "'" ||,
" COMMENTS '"|| COMMENTS ||"'"
O = O + 1
OUT.O = " ."
O = O + 1
END
/* WRITE TO OUTPUT */
ADDRESS TSO
IF RC \= 0 THEN DO
ERR = "USE PDS(MEM) (OR) USE EXST PS FOR O/P"
RETURN
END
ADDRESS TSO
"FREE F(OUTFILE)"
IF E = "E" THEN DO
ADDRESS ISPEXEC
END
IF E = "S" THEN DO
USR = USERID()
ADDRESS ISPEXEC
"VPUT (USR,OUTDS) PROFILE"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('MTAT.TATA.WORKAREA') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL ENDBTCH"
"ISPEXEC FTCLOSE NAME(ENDBTCH)"
"FREE FI(SELFILE)"
ADDRESS TSO
"SUBMIT 'MTAT.TATA.WORKAREA(ENDBTCH)'"
ERR = "<<< JOB IS SUBMITTED FOR RETRIEVE !! >>>"

RETURN
END
ERR = "<<< SCL GENERATION COMPLETE !! >>>"
RETURN
------- REXXCHAT -------
/*rexx*/
/* IF <prefix>.CLIST PDS is there, look there for panel d
by default using ISPPLIB
*/
/*If sysdsn(clist) = OK then do
ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID(CLIST)"
End
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"*/
ADDRESS ISPEXEC
"Libdef ispplib dataset id('MTAT.TATA.PANEL')"

user = userID()": "
continue='Y'
scrl='CSR'
tbname=userID() || 'T'
ADDRESS ISPEXEC "TBCREATE "tbname " NAMES(msgOut) NOWRITE"
cursFld='destID'
invite ='/'
do while continue='Y'
msgIn=''
ADDRESS ISPEXEC "TBBOTTOM " tbname
/* Display latest messages*/
ADDRESS ISPEXEC "TBSKIP "tbname" NUMBER(-15)"
ADDRESS ISPEXEC "TBDISPL "tbname " PANEL(chatpnl) cursor("cursFld")"
cursFld='msgIn'
If RC<>0 then
continue ='N'
Else do
call SendMessage
call ReceiveMessage
End
end
call saveConversation
ADDRESS ISPEXEC "TBCLOSE "tbname
exit(0)
/*-------------------------------------------------------------------*/
SendMessage:
restOfString = strip(msgIn)
if length(restOfString)=0 then return
parse value restOfString with firstPart "'" restOfString
tempIn = firstPart
do while Length(restOfString) >0
parse value restOfString with firstPart "'" restOfString
tempIn = tempIn ||"''" || firstPart
End
x=outtrap('sendmsg.')
ADDRESS TSO
"SE '"tempIn"' USER("destID") SAVE"
x=outtrap('off')
errorMsg = 'USER LOG DOES NOT EXIST'
if index(sendmsg.1,errorMsg) >0 & sendmsg.trapped>0 Then Do
ZEDSMSG='INVALID USER ID'
ZEDLMSG='User ID 'destID 'Can not be reached. Message cancelled.'
return
End
if invite = '/' then do
ADDRESS TSO
"SE 'Invitation For Chat From:' USER("destID")"
"SE '"tempIn"' USER("destID")"
End
ADDRESS ISPEXEC "TBBOTTOM "tbname
msgOut = user || left(msgIn,71)
ADDRESS ISPEXEC "TBADD "tbname
return
/*--------------------------------------------------------*/
ReceiveMessage:
x=outtrap('msg.')
ADDRESS TSO
"LISTBC NONOTICES"
x=outtrap('off')
Do i=1 to msg.trapped
if index(msg.i,'NO BROADCAST MESSAGES')>0 then iterate
wordCount=words(msg.i)
sender = word(msg.i,wordCount) /* Last word is Sender's ID*/
msg.i = sender":"delword(msg.i,wordCount)
ADDRESS ISPEXEC "TBBOTTOM "tbname
msgOut = left(msg.i,80)
ADDRESS ISPEXEC "TBADD "tbname
End
return
/*--------------------------------------------------------*/
SaveConversation:
ADDRESS TSO
dsname=getDSName()
"ALLOC DA("dsname") fi(outdd) spa(10 5) lrecl(80) recfm(f) new"
ADDRESS ISPEXEC "TBSTATS "tbname " ROWCURR(rowCnt)"
out.0=rowCnt
ADDRESS ISPEXEC "TBTOP "tbname
Do i=1 to out.0
ADDRESS ISPEXEC "TBSKIP "tbname
ADDRESS ISPEXEC "TBGET "tbname
out.i = msgOut
End
"EXECIO * DISKW OUTDD (STEM out. FINIS"
"FREE FI(outdd)"
Say "The conversation is saved in the dataset "
say sysvar('syspref')||"."||dsname
return
/*--------------------------------------------------------*/
getDSName:
parse value time() with hh":"mm":"ss":"
parse value date() with dd" "mon" "yyyy
user=userID()
yyyy=right(yyyy,2)
dsname=user||".CHAT.D"||dd||mon||yyyy||".T"||hh||mm||ss
return dsname
/*-------------------------------------------------------*/
------- REXXMAC -------
/* REXX */
/* */
/* AUTHOR: RAJESH KUMAR.E */
/* LAST UPDATED 21TH MAR 2003 */
/* */
/***************************************************************/
/* */
/* THIS REXX EXEC CAN BE USED TO PROCESS AN ISPF EDIT MACRO */
/* AGAINST EVERY MEMBER OF A PDS. */
/* */
/***************************************************************/
/* COMMAND SYNTAX: */
/* */
/* TSO %REXXMAC DATA_SET_NAME MACRO_NAME */
/* */
/* IF DATA_SET_NAME IS NOT ENCLOSED IN QUOTES, THEN THE */
/* TSO PREFIX (NORMALLY THE USERID) WILL BE ADDED TO THE */
/* BEGINNING OF THE DATA SET NAME. */
/* */
/***************************************************************/
/* SAMPLE EDIT MACRO AND REXXMAC EXECUTION: */
/* */
/* MACRO1 EDIT MACRO */
/* */
/* /* REXX EDIT MACRO TO CHANGE "SYSA." TO "SYSB." */ */
/* ADDRESS ISREDIT */
/* "MACRO" */
/* "CHANGE 'SYSA.' 'SYSB.' ALL" */
/* "SAVE" */
/* "END" */
/* */
/* REXXMAC EXECUTION */
/* 1. FIRST CONCAT THE DATASET USING CONCATRX MEMBER */
/* 2. TYPE THIS IN THE COMMAND LINE */
/* TSO %REXXMAC 'BNY011.TEST.JCLS' MACRO1 */
/***************************************************************/
ARG DSN MACNAME .
IF MACNAME = '' THEN DO /* NO MACRO NAME PARM GIVEN */
SAY 'ERROR - EDIT MACRO NAME NOT SPECIFIED' /* ISSUE ERROR MSG */
EXIT 12 /* EXIT RC=12 */
END
IF POS("'",DSN) = 0 & SYSVAR(SYSPREF) <> '' THEN , /* IF NO QUOTES */
DSN = SYSVAR(SYSPREF) || '.' || DSN /* AND PREF NOT NULL, ADD IT */
ELSE DSN = STRIP(TRANSLATE(DSN,"","'")) /* REMOVE QUOTES IF USED */
CHKLIB = SYSDSN("'"DSN"'") /* SEE IF DATA SET EXISTS */
IF CHKLIB <> 'OK' THEN DO /* DATA SET NOT FOUND */
SAY 'ERROR -' DSN 'NOT FOUND. CHECK NAME AND QUOTES.' /* ISSUE MSG*/
END
JUNK = OUTTRAP('MBR.') /* CAPTURE OUTPUT TO MBR. STEM */
"LISTD '" || DSN || "' MEMBERS" /* ISSUE LISTD CMD AGAINST PDS */
JUNK = OUTTRAP('OFF') /* STOP CAPTURING OUTPUT */
DO I = 1 TO MBR.0 /* LOOP TO GET PAST VOL INFO */
IF MBR.I = "--MEMBERS--" THEN LEAVE /* IF MEMBER SECTION, EXIT LOOP*/
END
IF I = MBR.0 THEN DO /* NO MEMBERS IN PDS */
SAY 'ERROR - NO MEMBERS FOUND IN' DSN'.' /* ISSUE ERROR MSG */
END
SAY 'PROCESSING' MBR.0 - I 'MEMBERS ...'
DO J = I+1 TO MBR.0 /* LOOP TO EXECUTE EDIT MACRO */
PARSE VAR MBR.J MACMEM . /* GET RID OF ALIAS INFO */
ADDRESS ISPEXEC "EDIT DATASET('" || DSN || "(" || MACMEM || ")')" ,
"MACRO("MACNAME")"
END
SAY 'PROCESSING COMPLETE!'
EXIT 0
------- SUPRC -------
/****************************** REXX *********************************/

/* */
/* SUPER CE UTILITY */
/* */
/* BALU SUBRAMONIAM .V. */
/*********************************************************************/
ADDRESS TSO
MSGVAL = MSG('OFF')
ELM1 = ""
ELM2 = ""
ELM3 = ""
ELM4 = ""
NM = ""
OM = ""
GT = ">"
BLANK= " "
ERR = "<<< ENTER THE NEW, OLD AND SUPERC DSNS >>>"
ADDRESS ISPEXEC
"ADDPOP "
"DISPLAY PANEL(SPANEL1)"
SELECT

DO
EXIT
END
OTHERWISE
DO
CALL EXEC_SUPERC
ADDRESS ISPEXEC
"REMPOP "
"ADDPOP "
"DISPLAY PANEL(SPANEL1)"
END
END
END
EXIT
EXEC_SUPERC:
/* START OF CHANGE */
IF NM \= " " & OM = " " THEN DO
ERR = "PLEASE ENTER MODEL MAG CODE !!!"
RETURN
END
IF NM = " " & OM \= " " THEN DO
ERR = "PLEASE ENTER NEW MAG CODE !!!"

RETURN
END
IF SUBSTR(ELM1,4,1) = "P" & SUBSTR(ELM2,4,1) = "P" THEN DO

/* SUPERC BETWEEN P AND P */
/*
NEW DSN : ELM1(P)
OLD DSN : ELM2(P)
SUPERC DSN : ELM3
MODEL DSN : ELM4 <= REQUIRES MODEL DSN
*/
NEW = "P"
OLD = "P"
IF ELM4 = "" THEN DO

ERR = "<<< PLEASE ENTER MODEL DSN !!! >>>"
RETURN
END
END
IF SUBSTR(ELM1,4,1) = "P" & SUBSTR(ELM2,4,1) \= "P" THEN DO

/* SUPERC BETWEEN P AND T */
/*
NEW DSN : ELM1(P)
OLD DSN : ELM2(T)
SUPERC DSN : ELM3
MODEL DSN : ELM2(IF NOT BLANK)
*/
NEW = "P"
OLD = "T"

ELM4 = ELM2
END
END
IF SUBSTR(ELM1,4,1) \= "P" & SUBSTR(ELM2,4,1) = "P" THEN DO

/* SUPERC BETWEEN T AND P */
/*
NEW DSN : ELM1(T)
OLD DSN : ELM2(P)
SUPERC DSN : ELM3
*/
NEW = "T"
OLD = "P"

ELM4 = ELM1
END
IF NM = "" THEN DO
ERR = "PLS ENTER NEWMAG CODE !!!"
RETURN
END
IF OM = "" THEN DO
ERR = "PLS ENTER MODEL CODE !!!"
RETURN
END
END
IF SUBSTR(ELM1,4,1) \= "P" & SUBSTR(ELM2,4,1) \= "P" THEN DO

/* SUPERC BETWEEN T AND T */
/*
NEW DSN : ELM1(T)
OLD DSN : ELM2(T)
SUPERC DSN : ELM3
*/
NEW = "T"
OLD = "T"

ELM4 = ELM1
END
IF NM = "" THEN DO
ERR = "PLS ENTER NEWMAG CODE !!!"
RETURN
END
IF OM = "" THEN DO
ERR = "PLS ENTER MODEL CODE !!!"
RETURN
END
END
IF SYSDSN("'"ELM1"'") \= "OK" THEN DO

ERR = "<<< NEW DSN IS NOT FOUND !!! >>>"
RETURN
END

ERR = "<<< OLD DSN IS NOT FOUND !!! >>>"
RETURN
END
ADDRESS TSO
"ALLOCATE DA('"ELM3"') NEW DIR(100) SPACE(50,50) DSORG(PO) ,
END
IF ELM4 \= "" & SYSDSN("'"ELM4"'") \= "OK" THEN DO

ERR = "<<< MODEL DSN IS NOT FOUND !!! >>>"
RETURN
END
ELM1 = '"'||ELM1||'"'
ELM2 = '"'||ELM2||'"'
ELM3 = '"'||ELM3||'"'
ELM4 = '"'||ELM4||'"'
ADDRESS ISPEXEC
"VPUT (ELM1,ELM2,ELM3,ELM4,NEW,OLD,NM,OM,GT,BLANK) PROFILE"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('M#T053.MISC1.CNTL') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL THDSKEL"
"ISPEXEC FTCLOSE NAME(SUPERC)"
"FREE FI(SELFILE)"
JID = USERID() || "SX"

TID = USERID()
TYPE= "SUPERC"
ADDRESS ISPEXEC
"VPUT (JID,TID,TYPE) PROFILE"
ADDRESS TSO
"ALLOC REUSE FI(TELFILE) DA('M#T053.SELECTN.CNTL') SHR"
"ISPEXEC LIBDEF ISPFILE LIBRARY ID(TELFILE)"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL MODJCL"
"ISPEXEC FTCLOSE NAME(MODJCLB)"
"FREE FI(TELFILE)"
ADDRESS TSO
"SUBMIT 'M#T053.SELECTN.CNTL(MODJCLB)'"
ELM1 = ""
ELM2 = ""
ELM3 = ""
ERR = "<<<< YOUR JOB IS SUBMITTED !!! >>>>"
RETURN
------- TABLEDEM -------
/******************************* REXX *********************************/

/* */
/* DEMONSTRATE ISPF TABLE FUNCTIONS */
/* */
/* */
/**********************************************************************/
TBNAME = SAMPLE
ADDRESS ISPEXEC "TBCREATE "TBNAME " NAMES(MSGOUT) NOWRITE"
MSGOUT = "FIRST LINE"

ADDRESS ISPEXEC "TBADD "TBNAME
MSGOUT = "SECOND LINE"

MSGOUT = "THIRD LINE"

CALL SAYTABCON
ADDRESS ISPEXEC
"ADDPOP "
"TBDISPL "TBNAME" PANEL(CHATPNL2)"
ADDRESS ISPEXEC "TBBOTTOM "TBNAME
ADDRESS ISPEXEC "TBCLOSE "TBNAME
SAYTABCON :
ADDRESS ISPEXEC "TBSTATS "TBNAME " ROWCURR(ROWCNT)"
ADDRESS ISPEXEC "TBTOP "TBNAME
ADDRESS ISPEXEC "TBGET "TBNAME

MSGOUT1 = MSGOUT
ADDRESS ISPEXEC "TBSKIP "TBNAME
MSGOUT2 = MSGOUT
ADDRESS ISPEXEC "TBSKIP "TBNAME
MSGOUT3 = MSGOUT
RETURN
------- TESTMAC -------
/* REXX */
"ISREDIT MACRO"
"ISREDIT CUT "MEDIANO" "MEDIANO" TEST"
"ISREDIT END"
------- UTILREXX -------
/* REXX */
SAY "ENTER mag code "
PULL MAG
SAY "ENTER MODEL MAG CODE (FOR CREATING EMPTY GEN) "
PULL MODELMAG
SAY "ENTER Subsystem"
PULL subsys
memgdg = 'MEMGDG'
memEMP = 'MEMEMPTY'
memCRE = 'MEMCREAT'
/* ----------- ALLOC INPUT FILE FOR GETTING GDG BASE NAMES ---------*/
"ALLOC DA('M#T053.TEMPLATE.JCL("subsys")') F(INPDD) SHR REUSE"
"ALLOC DA('M#T053.MISC1.CNTL("subsys")') F(OUTDD) SHR REUSE"
/* TRACE i */
"ALLOC DA('M#T053.TEMPLATE.JCL("memgdg")') F(OUTGDG) SHR REUSE"
"ALLOC DA('M#T053.TEMPLATE.JCL("MEMEMP")') F(OUTEMP) SHR REUSE"
"ALLOC DA('M#T053.TEMPLATE.JCL("MEMCRE")') F(OUTCRE) SHR REUSE"
/* "EXECIO 0 DISKW OUTDD (OPEN"
"EXECIO 0 DISKW OUTGDG (OPEN" */
IF INPUT.0 = O THEN
DO
SAY SUBSYSTEM ' EMPTY '
EXIT
END
OUTREC. = ''
EMPREC. = ''
creREC. = ''
GDGREC. = ''
J = 0 ; M = 0 ; N = 0 ; ckpt = 0
ddcnt = 0; crecnt = 0
DO K = 1 TO INPUT.0
LT= ' ' ; X = 0;
/* If first char is * or space, then treat as comment */
IF substr(input.k,1,1) = '*' then iterate
/* IF substr(input.k,1,1) = ' ' then iterate */
PARSE VAR INPUT.K DSN LMT frst .
ckpt = ckpt + 1
if ckpt > 10 then
do
say k
ckpt = 0
end
MODDSN = STRIP(TRANSLATE(DSN))
FRST= STRIP(TRANSLATE(FRST))
STR = 'XX'
DO WHILE POS('XX',DSN) > 0
DSN = OVERLAY(MAG,DSN,POS(STR,DSN),LENGTH(STR))
MODDSN = OVERLAY(MODELMAG,MODDSN,POS(STR,MODDSN),LENGTH(STR))
END
OPTION="ALL"
ADDRESS "TSO" "LISTCAT ENT('"DSN"') GDG ALL"
IF (RC \= 0) THEN
X = 1
LIMIT= ' '

FIRST_GDG = 0
END_SRCH = 0
DO I= 6 TO GDGINFO.0
GDGINFO.I= TRANSLATE(GDGINFO.I,' ','-')
/* CHECK FOR LIMIT */
LPOS= WORDPOS('LIMIT',GDGINFO.I)
IF (LPOS > 0) THEN
DO
LIMIT= WORD(GDGINFO.I,2)
SCRATCH= WORD(GDGINFO.I,3)
EMPTY= WORD(GDGINFO.I,4)
END_SRCH = 1
END
/* CHECK FOR ASSOCIATIONS */
APOS= WORDPOS('ASSOCIATIONS',GDGINFO.I)
IF (APOS > 0) & (FRST = 'FIRST') THEN
DO
END_SRCH = 2
NPOS= WORDPOS('(NULL)',GDGINFO.I)
IF (NPOS > 0) & (frst = 'FIRST') THEN
DO
FIRST_GDG = 1
END
END
/* LEAVE ONCE BOTH ARE FOUND */
IF END_SRCH = 2 THEN
DO
LEAVE
END
END
IF LMT = LIMIT THEN
LT = 'YES'
ELSE
LT = 'NO'
J = J + 1
IF X = 1 THEN
DO
LEFT(STRIP(LT),5)||' '||LIMIT||'** GDG NOT DEFINED **'
M = M + 1
GDGREC.M = ' DEFINE GDG (NAME('DSN') -'
M = M + 1
GDGREC.M = ' LIMIT('LMT') SCRATCH NOEMPTY)'
M = M + 1
GDGREC.M = ' '
END
ELSE
DO
LEFT(STRIP(LT),5)||' '||LIMIT
END
/* SAY OUTREC */
IF FIRST_GDG = 1 THEN
DO
N = N + 1
EMPREC.N = LEFT(STRIP(DSN),44)||' '||LEFT(STRIP(LMT),5)||' '||,
LEFT(STRIP(LT),5)||' '||LIMIT || '**NO EMPTY GEN**'
DDCNT = DDCNT + 1
CRECNT = CRECNT + 1
CREREC.CRECNT = "//DD" || DDCNT || ' '|| 'DD DSN=' ||,
DSN || "(+1),"
CRECNT = CRECNT + 1
CREREC.CRECNT = "// " || "DISP=(,CATLG)," ||,
"SPACE=(TRK,(0,0),RLSE), "
CRECNT = CRECNT + 1
CREREC.CRECNT = "// " || "DCB=" || MODDSN ||,
".G0001V00"
END
END
SAY 'NO OF INPUT READ' J
outrec.0 = j
/* for each new gdg, 3 lines are written */
m = m / 3
SAY 'NO OF GDGS TO BE DEFINED ' M
GDGREC.0 = m
SAY 'NO OF empty gens to be creatED ' n
EMPREC.0 = n
"EXECIO * DISKW OUTDD (STEM outrec. FINIS"
"FREE DD (OUTDD) NOHOLD"
"EXECIO * DISKW OUTGDG (STEM GDGREC. FINIS"
"FREE DD (OUTGDG) NOHOLD"
"EXECIO * DISKW OUTEMP (STEM EMPREC. FINIS"
"FREE DD (OUTEMP) NOHOLD"
"EXECIO * DISKW OUTCRE (STEM CREREC. FINIS"
"FREE DD (OUTCRE) NOHOLD"
exit
------- VENDOR -------
/****************************** REXX *********************************/

/* */
/* VENDOR SETUP UTILITY */
/* */
/* BALU SUBRAMONIAM.V */
/*********************************************************************/
ADDRESS TSO
MSGVAL = MSG('OFF')
VID = " "

MID = " "
L = " "
REGION = " "
F = " "
MESSAGE = "ENTER DETAILS"
BARCHAR = ''
BARPOINTER = 0
STATUS = 0
ST = STATUS || "%"
ADDRESS ISPEXEC
"ADDPOP "
"DISPLAY PANEL(VPANEL)"
SELECT

DO
EXIT
END
OTHERWISE
DO
CALL SETUP
ADDRESS ISPEXEC
"REMPOP "
"ADDPOP "
END
END
END
EXIT
SETUP :
/* REFRESHING THE PROGRESSING BAR */

BARDYE = 'WHITE'
MESSAGE = "CHOOSING THE SKELETONS . . ."
CALL REFRESH
STATUS = STATUS + 10
ST = STATUS || "%"
IF KEYPB = 'PF03' THEN EXIT
IF REGION = "MAGIC" THEN RG = "AG"

ELSE IF REGION = "MERLIN" THEN RG = "SP"
ELSE IF REGION = "MIRAGE" THEN RG = "EP"
/* COMPLIANT ; SINGLE ; ONE REGION */
IF L = "C" & F = "S" THEN DO

JCLSKEL = "VNDCMSG1"
RUNSKEL = "VNDRDCMS"
JOBNAME = "M"|| RG ||"P" || VID ||"F"
IF REGION = "MAGIC" THEN MODEL = "MAGPADCF"

ELSE IF REGION = "MERLIN" THEN MODEL = "MSPPBBLF"
ELSE IF REGION = "MIRAGE" THEN MODEL = "MEPPALRF"
IF MID \= " " THEN MODEL = "M"|| RG ||"P" || MID ||"F"
END
/* COMPLIANT ; MIXED ; ONE REGION */
IF L = "C" & F = "M" THEN DO

JCLSKEL = "VNDCMMX1"
RUNSKEL = "VNDRDCPM"
IF REGION = "MAGIC" THEN MODEL = "MAGPCHOF"

ELSE IF REGION = "MERLIN" THEN MODEL = "MSPPIWOF"
ELSE IF REGION = "MIRAGE" THEN MODEL = "MEPPBGIF"
END
/* COMPLIANT ; SINGLE ; MAGIC/MERLIN */
IF L = "C" & F = "T" THEN DO
IF REGION = "MIRAGE" THEN DO
MESSAGE = "<<< SPLIT IS ONLY FOR MAGIC AND MERLIN >>>"

RETURN
END
JCLSKEL = "VNDCMSG2"
RUNSKEL = "VNDRDCMS"
MODEL = "MAGPCKFF"

END
/* NON - COMPLIANT LAYOUT */
IF L = "N" THEN DO
JCLSKEL = "VNDNCOMP"
RUNSKEL = "VNDRDNCM"
IF REGION = "MAGIC" THEN MODEL = "MAGPAVEF"

ELSE IF REGION = "MERLIN" THEN MODEL = "MSPPASIF"
ELSE IF REGION = "MIRAGE" THEN MODEL = "MEPPCSCF"
END
/* MDG8 UNIVERSAL LAYOUT */
IF L = "U" THEN DO
JCLSKEL = "VNDMDG8"
RUNSKEL = "VNDRDMG8"
JOBNAME = "MDG8" || VID ||"L"
MODEL = "MDG8AOLL"
IF MID \= " " THEN MODEL = "MDG8" || MID ||"L"
END

BARDYE = 'YELLOW'
MESSAGE = "TAILORING THE JCL . . ."
CALL REFRESH
ST = STATUS || "%"
/* TAILOR THE JCL */

ADDRESS ISPEXEC
"VPUT (VID,REGION,RG,JOBNAME,MID) PROFILE"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('MTAT.VENDOR.SETUP.JCL') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL "JCLSKEL""
"ISPEXEC FTCLOSE NAME("JOBNAME")"
"FREE FI(SELFILE)"

BARDYE = 'TURQ'
MESSAGE = "CAPTURING JCL SUPERCE. . ."
CALL REFRESH
ST = STATUS || "%"
/* CAPTURE JCL SUPERCE */
OPTS = "DELTAL,LINECMP,'NOPRTCC',''"
PRO1 = "'SYS1.PROCLIB','SYS1.ENDEVOR.PROCLIBP','SYS1.ISV.PROCLIB',"
PRO2 = "'SYS1.TCS.MISC.PROCLIB','SYS1.SYSPROC','SYS1.SHRPROC'"
PROC = PRO1 || PRO2
ADDRESS TSO
"ALLOC FI(NEWDD) DA('MTAT.VENDOR.SETUP.JCL("JOBNAME")') SHR REUSE"
"ALLOC FI(OLDDD) DA('APCP.ENDEVOR.JCLP("MODEL")') SHR REUSE"
"ALLOC FI(OUTDD) DA('MTAT.VENDOR.SETUP.JCL.SUPERC("JOBNAME")') SHR ,
REUSE"
"ALLOC FI(SYSIN) DA('MTAT.SYSIN.SUPERC') SHR REUSE"
"ISRSUPC" OPTS
"FREE FI(NEWDD OLDDD OUTDD SYSIN)"

BARDYE = 'BLUE'
MESSAGE = "TAILORING THE RUNDOC. . ."
CALL REFRESH
ST = STATUS || "%"
/* COPY AND CHANGE THE RUNDOC TEMPLATE */

ADDRESS TSO
"ALLOC F(OUTFILE) DA ('MTAT.VENDOR.SETUP.RUNDOC("JOBNAME")') SHR REUSE"
QUEUE "END NOSAVE"
"EDIT 'MTAT.VENDOR.SETUP.RUNDOC("JOBNAME")' NONUM OLD DATA "
ADDRESS TSO
"ALLOC F(INFILE) DA ('MTAT.TATA.ISPSLIB("RUNSKEL")') SHR REUSE"
"NEWSTACK"
NUMREC = QUEUED()
"DELSTACK"
ADDRESS ISPEXEC
"EDIT DATASET('MTAT.VENDOR.SETUP.RUNDOC("JOBNAME")') MACRO (VNDRMAC)"

BARDYE = 'GREEN'
MESSAGE = "CAPTURING RUNDOC SUPER-CE. . . "
CALL REFRESH
ST = STATUS || "%"
/* CAPTURE RUNDOC SUPERCE */

ADDRESS TSO
"ALLOC FI(NEWDD) DA('MTAT.VENDOR.SETUP.RUNDOC("JOBNAME")') SHR REUSE"
"ALLOC FI(OLDDD) DA('APCP.ENDEVOR.RUNDOCP("MODEL")') SHR REUSE"
"ALLOC FI(OUTDD) DA('MTAT.VENDOR.SETUP.RUNDOC.SUPERC("JOBNAME")') SHR ,
REUSE"
"ALLOC FI(SYSIN) DA('MTAT.SYSIN.SUPERC') SHR REUSE"
"ISRSUPC" OPTS
"FREE FI(NEWDD OLDDD OUTDD SYSIN)"

BARDYE = 'RED'
MESSAGE = "CREATING CNTL FOR GDGS. . ."
CALL REFRESH
ST = STATUS || "%"
/* CREATE GDGS BY TAILORING THE JOB */

ADDRESS ISPEXEC
"VPUT (VID,REGION,RG,JOBNAME,F,L) PROFILE"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('MTAT.VENDOR.SETUP.CNTL') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL "VNDRGDG""
"ISPEXEC FTCLOSE NAME("JOBNAME")"
"FREE FI(SELFILE)"

BARDYE = 'WHITE'
MESSAGE = "CAPTURING JCLCHK. . ."
CALL REFRESH
ST = STATUS || "%"
/* CAPTURE JCLCHK */
OPTS = 'PROC(PROC00)'
PRO1 = "'SYS1.PROCLIB','SYS1.ENDEVOR.PROCLIBP','SYS1.ISV.PROCLIB',"
PRO2 = "'SYS1.TCS.MISC.PROCLIB','SYS1.SYSPROC','SYS1.SHRPROC'"
PROC = PRO1 || PRO2
ADDRESS TSO
"ALLOC FI(PROC00) DA("PROC") SHR"
"ALLOC FI(SYSPRINT) DA('MTAT.VENDOR.SETUP.JCLCHK("JOBNAME")') SHR REUSE"
"ALLOC FI(SYSIN) DA('MTAT.VENDOR.SETUP.JCL("JOBNAME")') SHR REUSE"
"JCLCHECK" OPTS
"FREE FI(PROC00 SYSPRINT SYSIN)"

BARDYE = 'YELLOW'
MESSAGE = "CREATING CNTL FOR ONCALL. . ."
CALL REFRESH
ST = STATUS || "%"
/* TAILOR ONCALL JOB */
ONCALMEM = "ONCAL" || VID

SYSUID = USERID()
JOBNAM = SYSUID || "OC"
NEWJOB = JOBNAME
ADDRESS ISPEXEC
"VPUT (JOBNAM,SYSUID,MODEL,NEWJOB) PROFILE"
ADDRESS TSO
"ALLOC REUSE FI(SELFILE) DA('MTAT.VENDOR.SETUP.CNTL') SHR"
"ISPEXEC FTOPEN"
"ISPEXEC FTINCL "ONCALONE""
"ISPEXEC FTCLOSE NAME("ONCALMEM")"
"FREE FI(SELFILE)"

BARDYE = 'TURQ'
MESSAGE = "PREPARING ACCTINFO MAIL. . ."
CALL REFRESH
ST = STATUS || "%"
/* TAILOR ACCOUNTING INFO MAIL */

ADDRESS TSO
"ALLOC F(OUTFILE) DA ('MTAT.VENDOR.SETUP.ACCTINFO.MAIL("JOBNAME")') ,
SHR REUSE"
QUEUE "END NOSAVE"
"EDIT 'MTAT.VENDOR.SETUP.ACCTINFO.MAIL("JOBNAME")' NONUM OLD DATA "
ADDRESS TSO
"ALLOC F(INFILE) DA ('MTAT.TATA.ISPSLIB(VDACMAIL)') SHR REUSE"
"NEWSTACK"
NUMREC = QUEUED()
"DELSTACK"
ADDRESS ISPEXEC
"EDIT DATASET('MTAT.VENDOR.SETUP.ACCTINFO.MAIL("JOBNAME")') ,
MACRO (VNDRMAC)"

BARDYE = 'BLUE'
MESSAGE = "PREPARING SETUP MAIL. . ."
CALL REFRESH
MESSAGE = "VENDOR SETUP COMPLETED SUCCESSFULLY. . ."

ST = STATUS || "%"
/* TAILOR SETUP MAIL */

ADDRESS TSO
"ALLOC F(OUTFILE) DA ('MTAT.VENDOR.SETUP.MAIL("JOBNAME")') ,
SHR REUSE"
QUEUE "END NOSAVE"
"EDIT 'MTAT.VENDOR.SETUP.MAIL("JOBNAME")' NONUM OLD DATA "
ADDRESS TSO
"ALLOC F(INFILE) DA ('MTAT.TATA.ISPSLIB(VDSTMAIL)') SHR REUSE"
"NEWSTACK"
NUMREC = QUEUED()
"DELSTACK"
ADDRESS ISPEXEC
"EDIT DATASET('MTAT.VENDOR.SETUP.MAIL("JOBNAME")') ,
MACRO (VNDRMAC)"
ADDRESS ISPEXEC
"EDIT DATASET('MTAT.VENDOR.SETUP.MAIL("JOBNAME")') "
CALL REFRESH
/* END OF SUBROUTINE */
RETURN
REFRESH :
ADDRESS ISPEXEC "REMPOP"
DO I = 1 TO 6
IF BARPOINTER >= 66 THEN DO
BARCHAR = ''
BARPOINTER = 0
END
ELSE DO
BARCHAR = COPIES('C',BARPOINTER)
BARPOINTER = BARPOINTER + 1
END
ADDRESS ISPEXEC
"CONTROL DISPLAY LOCK"
"ADDPOP"
"REMPOP"
END
ADDRESS ISPEXEC
"ADDPOP"
RETURN
------- VERSION -------
/*rexx*/
/*to find out the latest version of gdg */
count = 0
say "enter the gdg to find the version"
pull gdg
do while gdg = ' '
say "kindly enter the gdg"
pull gdg
end
ADDRESS "TSO" "LISTCAT ENT('"gdg"') GDG ALL"
parse var gdginfo.1 val1 rest
if val1 \= 'GDG' then

do
say "it is not a gdg base"
exit
end
g1=strip(gdginfo.8,,' ')
g2 = length(g1)
if g2 > 12 then
do
say " only base version is there"
exit
end
else
do j= 8 to gdginfo.0
count = count + 1
end
count = count - 1
c1 = 8 + count
gdginfo.c1 = strip(gdginfo.c1,,' ')

c3=substr(gdginfo.c1,10,)
say c3
------- VERT -------
/* reXX */
/* This rexx is used to create the verticla tracebility matrix */
"ALLOCATE F(TMP) DSN('M#T053.VERT.MEMBERS') SHR REUSE"
"EXECIO * DISKR TMP(STEM TEM. FINIS"
"FREE F(TMP)"
prev = 'dummy'
prevmon = 0
i = 0
init:
z = i + 1
do i = z to tem.0
item = substr(tem.i,12,5)
task = substr(tem.i,20,22)
task = strip(task)
changemon = substr(tem.i,44,2)
item1= substr(tem.i,12,7)
item1 = strip(item1)
len = length(item1)
if len > 5 then itemk = item || '*'
if item = prev & changemon = prevmon then signal init
else
do
prev = item
prevmon = changemon
select
when changemon = 09 then
month = SEP04
month = OCT04
month = NOV04
month = DEC04
otherwise
signal init
end /* select */
itemn = substr(item,1,1)
month1 = month || itemn
outdsn = 'M#T053.VERT.SEPTODEC.'|| month
vertdsn = strip(outdsn) || '(' || item || ')'
if SYSDSN("'"outdsn"'") <> 'OK' then
do
"alloc da('"outdsn"') dd(inp) NEW DIR(40) SPACE(50,50) DSORG(PO) ,
RECFM(F,B) LRECL(133) BLKSIZE(27930) MGMTCLAS(XTRABKUP)"
end
dsn = 'MTAT.COMMON.UTP.MISC.YEAR2004(' || item1 || ')'
itemk = substr(item,1,5) || '*'
dsn1 = 'MTAT.COMMON.UTP.MISC.YEAR2004(' || itemk || ')'
"ALLOCATE F(mis) DSN('"dsn"') SHR REUSE"
"EXECIO * DISKR mis(STEM misc. FINIS"
"FREE F(mis)"
srce = 'dummy'
do k = 1 to misc.0
upper misc.k
sourcepos = find(misc.k,'SOURCE')
cntlpos = find(misc.k,'CNTL')
jclpos = find(misc.k,'JCL')
if sourcepos > 0 & srce = 'dummy' then srce = word(misc.k,3)
if cntlpos > 0 & srce = 'dummy' then srce = word(misc.k,3)
if jclpos > 0 & srce = 'dummy' then srce = word(misc.k,3)

end
inp.1 = ' VERTICAL TRACEBILITY'

inp.2 = ' ----------------------'
inp.3 = '|-----------------------------------------------------------------
inp.4 = '| LLD SEC |TASK NAME :' || task
inp.5 = '| |TASK CODE :' || item || '
inp.6 = '| |BOTH TASK NAME AND TASK CODE ENTRY HAS BEEN MADE
inp.7 = '| |IN MTAT.WORK.PROGRESS(' || month1 || ')'
inp.8 = '|-----------------------------------------------------------------
inp.9 = '|# CODE | '|| srce|| '
inp.10 = '|-----------------------------------------------------------------
inp.11 = '|UTS CASES | ' || dsn1 || ' |'
inp.12 = '| |
inp.13 = '|-----------------------------------------------------------------
inp.14 = '|UTR | ' || dsn1 || ' |'
inp.15 = '|-----------------------------------------------------------------
"ALLOCATE F(INP) DSN('"vertdsn"') SHR REUSE"
"EXECIO * DISKW inp(STEM inp. FINIS"
"FREE F(inp)"
end
end
exit
------- VNDRMAC -------
/* REXX */
ADDRESS ISPEXEC "VGET (JOBNAME VID RG REGION ZDATE) PROFILE"
ADDRESS ISPEXEC "VGET ZDATE"
DD = SUBSTR(ZDATE,7,2)
MM = SUBSTR(ZDATE,4,2)
YY = SUBSTR(ZDATE,1,2)
IF YY < 98 THEN
PDATE = MM||'/'||DD||'/20'||YY
ELSE
PDATE = MM||'/'||DD||'/19'||YY
"ISREDIT MACRO"
"ISREDIT C ALL JOBNAME '"JOBNAME"'"
"ISREDIT C ALL TODATE '"PDATE"'"
"ISREDIT C ALL VID '"VID"'"
"ISREDIT C ALL RG '"RG"'"
"ISREDIT C ALL REGION '"REGION"'"
"ISREDIT SAVE"
"ISREDIT END"
------- WRPCOND -------
/******************************* REXX *********************************/

/* */
/* GENERATE COBOL STATEMENTS FOR WRAP INCLUSION CONDITIONS */
/* */
/* */
/**********************************************************************/
LSTDS = "'M#T053.WRAP.WORK'"
OUTDS = "'M#T053.BALU.MISC.CNTL(TIHEWRAP1)'"

"FREE F(LSTFILE)"
O = 1
CAT = 1
DO I = 1 TO LST.0
J = I - 1
IF I > 2 & STRIP(SUBSTR(LST.I,8,5)) \= STRIP(SUBSTR(LST.J,8,5)) THEN

CAT = CAT + 1
VAR1 = STRIP(SUBSTR(LST.I,14,8))
VAL1 = STRIP(SUBSTR(LST.I,26,8))
COND = "M1RSUBRP-CAT" || CAT || " AND " ,

|| VAR1 || "-" || VAL1 || " AND ",
|| VAR2 || "-" || VAL2 || " AND ",
|| VAR3 || "-" || VAL3 || " AND ",
|| VAR4 || "-" || VAL4
OUT.O = "***"
O = O + 1
OUT.O = "*** EMAIL REF# " || I || " - INCLUSION RULE " || I
O = O + 1
OUT.O = "***"
O = O + 1
OUT.O = "IF " COND
O = O + 1
OUT.O = " "
O = O + 1
OUT.O = " SET PASSED TO TRUE"
O = O + 1
OUT.O = " SET INCL-" || I || " TO TRUE"
O = O + 1
OUT.O = " GO TO 5300-EXIT"
O = O + 1
OUT.O = "END-IF"
O = O + 1
END
"FREE F(OUTFILE)"
EXIT
------- WRPVAR -------
/******************************* REXX *********************************/

/* */
/* GENERATE COBOL VAR DECLARATION FOR WRAP INCLUSIONS */
/* */
/* */
/**********************************************************************/
LSTDS = "'M#T053.WRAP.WORK'"
OUTDS = "'M#T053.BALU.MISC.CNTL(WRAPVAR)'"

"FREE F(LSTFILE)"
O = 1
DO I = 1 TO LST.0
OUT.O = " 88 " || VAR1 || "-" || VAL1

LINE1= " VALUES ARE " || VAL1 ||"."
OUT.O = OUT.O || LEFT(LINE1,30)
O = O + 1
IF STRIP(VAR2) \=" " THEN DO

OUT.O = " 88 " || VAR2 || "-" || VAL2
LINE2 = " VALUES ARE " || VAL2 ||"."
O = O + 1
END

OUT.O = " 88 " || VAR3 || "-" || VAL3
O = O + 1
END

OUT.O = " 88 " || VAR4 || "-" || VAL4
O = O + 1
END
END
"FREE F(OUTFILE)"
EXIT
------- ZIPGEN -------
/******************************* REXX *********************************/

/* */
/* GENERATE ZIP CODES TO BE USED IN COBOL PROGRAMS */
/* */
/* */
/**********************************************************************/
LSTDS = "'M#T053.BALU.MISC.CNTL(DLZIP)'"
OUTDS = "'M#T053.BALU.MISC.CNTL(DLZIPFM)'"

"FREE F(LSTFILE)"
O = 1
CNT = 1
LINE = " "
DO I = 1 TO LST.0
IF CNT <= 7 THEN DO

LINE = LINE || " " || STRIP(SUBSTR(LST.I,1,30))
CNT = CNT + 1
END
IF CNT > 7 THEN DO
OUT.O = LINE
O = O + 1
CNT = 1
LINE = " "
END
END
OUT.O = LINE || "."
"FREE F(OUTFILE)"
EXIT

Rexx Tools

Uploaded by

Copyright:

Rexx Tools

Uploaded by

Document Information

Copyright

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Rexx Tools

Uploaded by

Copyright:

------- $INDEX -------

/******************************* REXX *********************************/

DO WHILE KEYPB <> 'PF03'

WHEN KEYPB = 'PF03' THEN

/* INPUT DATASETS VALIDATION */

IF SYSDSN("'"LSTDS"'") \= "OK" THEN DO

IF SYSDSN("'"SRCEDS"'") \= "OK" THEN DO

OUT.O = " SET STOPRC 16 . "

/* GENERATE THE SCLS */

IF A = "A" THEN OPRT = "ADD"

OUT.O = " "||OPRT|| " ELEMENT "|| "'"||ELMT|| "'"

/* PROC GP IF REQUIRED OR ONLY FOR COBOL/ASSEMBLR */

ERR = "<<< JOB IS SUBMITTED FOR ADD/UPD !! >>>"

/******************************* REXX *********************************/

SAY 'ENTER LISTING PDS :'

OUTDS = "'" || OUTDS || "'"

IF SYSDSN(OUTDS) \= "OK" THEN DO

SAY "OUTDS NOT PRESENT, IT IS CREATED !!!"

"CONTROL ERRORS RETURN"

"LMMLIST DATAID("PDSID") OPTION(LIST) MEMBER(MEM)"

IF STRIP(SUBSTR(PRG.I,10,6)) = "TITLE" THEN DO

IF SUBSTR(PRG.I,72,1) = "X" THEN

IF POS("-",DESC) > 0 THEN DO

IF RECORD = " " THEN OUTREC.K = LEFT(MEM,10) || "DESC NOT FOUND"

/******************************* REXX *********************************/

SAY "ENTER LISTING DATASET : "

/* INITIALIZE FOR FIRST TIME */

IF SUBSTR(LST.I,2,8) = "ELEMENT:" THEN

/* PROGRAM YEAR # OF CHGS # OF TIMES */

SAY "COMPLETED !!!"

/******************************* REXX *********************************/

SAY "ENTER MAGAZINE DETAILS DATASET :"

SAY "ENTER SKELETON DATASET :"

SAY "ENTER SKELETON NAME :"

SAY "ENTER OUTPUT DATASET :"

IF SYSDSN("'"SKELDS"'") \= "OK" THEN DO

IF SYSDSN("'"LSTDS"'") \= "OK" THEN DO

IF SYSDSN("'"OUTDS"'") \= "OK" THEN DO

IF SUBSTR(FMSLIR,1,1) = "G" THEN TYPE = "RL1"

This program first reads in COBOL copybook and loads arrays

/* If executed as Edit macro then use data in edit session */

i = 'BINARY' ; usage.i = 'BINARY'

i = 'COMPUTATIONAL-3'; usage.i = 'PACKED-DECIMAL'

i = 'DISPLAY' ; usage.i = 'DISPLAY'

PUSH 'MEND '

"ISPEXEC VIEW DATASET('"tmpDSN"')"

DO FOREVER /* When no 01 level present */

IF WORDPOS(nm, reservedWordList) > 0 THEN /* wjgq */

IF rlvl = 66 THEN /* wjgc */

DO WHILE s <> '' /* Process the leftmost clause in "s". */

IF occurs > 1 THEN /* wjgg */

/* SAY 'arrays are loaded...' */

DO WHILE renamesList <> '' /* wjgc */

/*--- start wjgl

IF lineNo2nm.i <> '' THEN

/*----------------- end wjgk -----------------*/

/*wjgq*/ IF POS('ff'x, line.i) > 0 THEN

CALL MaybeContinuedLine /* wjgl */

IF lineNo2nm.i <> '' THEN /* wjgk */

/* Generate header lines if HDR or HDR2 parm given */

/*------------------ wjgl ------------------------------*/

IF lineNo2nm.i <> '' THEN

/*------------------ wjgg ------------------------------*/

MaybeOccurs: PROCEDURE EXPOSE reference firstTimeSw ,

/* REXX ***/

/* REXX ***/

/* REXX ***/

/* REXX ***/

/----------------- end wjgk -----------------/

/wjgq/ IF POS('ff'x, line.i) > 0 THEN

/------------------ wjgl ------------------------------/

/------------------ wjgg ------------------------------/

/---------------------------- wjgc ---------------------/

/---------------- wjgh ---------------------------------/