/* REXX */ /* CLS2REXXed by FSOX001 on 14 Jul 2016 at 16:23:18 */ Signal On NoValue Call On Error Signal On Failure Signal On Syntax Parse source opsys . exec_name . Address ISREDIT "MACRO" /* CACM0404 EDIT JES2PARM */ /*********************************************************************/ /* This EDIT MACRO is user to obtain the JES2 SPOOL and CHECK POINT */ /* datasets from a copy of the JES2 PARM dataset. */ /*********************************************************************/ /* 06/15/2004 JL.NELSON ADDED EXIT CODE */ /* 10/26/2004 JL.NELSON ADDED TBLMSR FOR DATASET GROUP IDENTIFER */ /* 12/02/2004 JL.NELSON CHANGED FOR ALL FIELDS IN TBLMBR */ /* 02/14/2005 JL.NELSON Changed constants to variables before rename */ /* 03/14/2005 JL.NELSON Changed for old table */ /* 03/16/2005 JL.NELSON Correct length error code 864 */ /* 04/06/2005 JL.NELSON Combined JES2 reports ACP00150/ACP00160 */ /* 06/09/2005 JL.NELSON Pass MAXCC in ZISPFRC variable */ /* 06/15/2005 JL.NELSON Set return code to end job step */ /* 03/03/2006 JL.NELSON Made changes to avoid SUBSTR abend 920/932. */ /* 03/09/2006 JL.NELSON Set/test RCode for every ISPEXEC command. */ /* 03/29/2006 JL.NELSON Test for empty member LINENUM Rcode = 4. */ /* 04/17/2006 JL.NELSON Use NRSTR avoid abend 900 if ampersand in */ /* data. */ /* 06/02/2009 CL.FENTON Changes on how TBLMBR is processed. */ /* 08/01/2016 CL.FENTON Converted script from CLIST to REXX. */ /* */ /* */ /*********************************************************************/ pgmname = "CACM0004 08/01/16" sysprompt = "OFF" /* CONTROL NOPROMPT */ sysflush = "OFF" /* CONTROL NOFLUSH */ sysasis = "ON" /* CONTROL ASIS - caps off */ /* *************************************** */ /* VARIABLES ARE PASSED TO THIS MACRO */ /* CONSLIST */ /* COMLIST */ /* SYMLIST */ /* TERMMSGS */ /* ITER */ /* TEMP3 */ /* TBLMBR */ /* *************************************** */ Address ISPEXEC "CONTROL NONDISPL ENTER" Address ISPEXEC "CONTROL ERRORS RETURN" return_code = 0 Address ISPEXEC "VGET (CONSLIST COMLIST SYMLIST TERMMSGS ITER", "TEMP3 TBLMBR) ASIS" cm04vget = return_code If return_code <> 0 then do Say pgmname "VGET RC =" return_code strip(zerrsm) Say pgmname "CONSLIST/"conslist "COMLIST/"comlist "SYMLIST/"symlist, "TERMMSGS/"termmsgs Say pgmname "ITER/"iter "TEMP3/"temp3 "TBLMBR/"tblmbr return_code = return_code + 16 SIGNAL ERR_EXIT end If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" , then Trace r maxcc = 0 return_code = 0 tblmbr = tblmbr /* *************************************** */ /* TURN ON MESSAGES */ /* *************************************** */ syssymlist = symlist /* CONTROL SYMLIST/NOSYMLIST */ sysconlist = conslist /* CONTROL CONLIST/NOCONLIST */ syslist = comlist /* CONTROL LIST/NOLIST */ sysmsg = termmsgs /* CONTROL MSG/NOMSG */ /* *************************************** */ /* Main process */ /* *************************************** */ "(MEMBER) = MEMBER" "(DSNAME) = DATASET" return_code = 0 "(LASTLINE) = LINENUM .ZLAST" If return_code > 0 then do If lastline = 0 then Say pgmname "Empty file RCode =" return_code "DSN="dsname, "MEMBER="member strip(zerrsm) Else Say pgmname "LINENUM Error RCode =" return_code "DSN="dsname, "MEMBER="member strip(zerrsm) SIGNAL ERR_EXIT end blk44 = " " return_code = 0 "CURSOR = 1 0" old = " " mbrrpt = "JES2RPT" Call find_iter LOOP_SPOOLDEF: do forever return_code = 0 "FIND 'SPOOLDEF'" /* FIND SPOOLDEF */ cm04fer = return_code If return_code <> 0 then leave "(COUNTER,COL) = CURSOR" "(DATA) = LINE" counter com1 = pos("/*",data) If com1 < col & com1 > 0 then iterate parse var data data "/*" . data = strip(data) spdef_data = data GET_SPOOLDEF_DSN: do until lastpos(",",data) <> length(data) | counter = lastline counter = counter + 1 "(DATA) = LINE" counter parse var data data "/*" . data = strip(data) spdef_data = spdef_data||data end old = "" parse var spdef_data "DSNAME=" old "," . if old = "" then parse var spdef_data "DSN=" old "," . if old <> "" then do ac = substr(iter||old||blk44,1,50) ac = ac||pgmname return_code = 0 Address ISPEXEC "LMPUT DATAID("temp3") MODE(INVAR) DATALOC(AC)", "DATALEN("length(ac)") NOBSCAN" If return_code > 4 then do Say pgmname "LMPUT TEMP3" return_code strip(zerrsm) return_code = return_code + 16 SIGNAL ERR_EXIT end leave end end /* START HERE START HERE */ START_CKPTDEF_SEARCH: "CURSOR = 1 0" LOOP_CKPTDEF: do forever return_code = 0 "FIND 'CKPTDEF'" cm04f2er = return_code If return_code <> 0 then leave "(COUNTER,COL) = CURSOR" "(DATA) = LINE" counter com1 = pos("/*",data) If com1 < col & com1 > 0 then iterate parse var data data "/*" . data = strip(data) ckpt_data = data GET_SPOOLDEF_DSN: do until lastpos(",",data) <> length(data) | counter = lastline counter = counter + 1 "(DATA) = LINE" counter parse var data data "/*" . data = strip(data) ckpt_data = ckpt_data||data end do until pos("DSNAME=",ckpt_data) = 0 & pos("DSN=",ckpt_data) = 0 old = "" parse var ckpt_data "DSNAME=" old "," ckpt_data1 if old = "" then parse var ckpt_data "DSN=" old "," ckpt_data1 if old <> "" then do ac = substr(iter||old||blk44,1,50) ac = ac||pgmname return_code = 0 Address ISPEXEC "LMPUT DATAID("temp3") MODE(INVAR) DATALOC(AC)", "DATALEN("length(ac)") NOBSCAN" If return_code > 4 then do Say pgmname "LMPUT TEMP3" return_code strip(zerrsm) return_code = return_code + 16 SIGNAL ERR_EXIT end end ckpt_data = ckpt_data1 end end END_EXIT: return_code = 0 ERR_EXIT: If maxcc >= 16 | return_code > 0 then do Address ISPEXEC "VGET (ZISPFRC) SHARED" If maxcc > zispfrc then zispfrc = /*!*/maxcc Else zispfrc = return_code Address ISPEXEC "VPUT (ZISPFRC) SHARED" Say pgmname "ZISPFRC =" zispfrc end cm004rc = return_code Address ISPEXEC "VPUT (CM04VGET CM04FER CM04F2ER CM004RC) ASIS" "END" "MEND" Exit (0) /* *************************************** */ /* SYSCALL SUBROUTINES */ /* *************************************** */ NoValue: Failure: Syntax: say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc)) say SOURCELINE(sigl) SIGNAL ERR_EXIT Error: return_code = RC if RC > 4 & RC <> 8 then do say pgmname "LASTCC =" RC strip(zerrlm) say pgmname 'REXX error' rc 'in line' sigl':' ERRORTEXT(rc) say SOURCELINE(sigl) end return FIND_ITER: /*********************************************************************/ /* Find MBRRPT in TBLMBR and extract additional fields */ /*********************************************************************/ ITER = "99 " TITLE = PDI = x = 0 do forever if x = 0 then x = wordpos(MBRRPT,TBLMBR) else x = wordpos(MBRRPT,TBLMBR,x) if x = 0 then leave y = wordindex(TBLMBR,x)-4 if substr(TBLMBR,y,1) = "#" then do TBLENT = substr(TBLMBR,y) parse var TBLENT . 2 ITER 5 . 14 PDI 23 TITLE "#" . leave end end if TITLE <> ' ' then do x = index(TITLE,'@') TITLE = substr(TITLE,1,x-1) end Return (rc)