/* REXX */ /* CLS2REXXed by FSOX001 on 14 Jul 2016 at 15:30:45 */ Signal On NoValue Call On Error Signal On Failure Signal On Syntax Parse source opsys . exec_name . Address ISREDIT "MACRO" /* CACM0403 EDIT EXAM.RPT(JES2PARM) */ /*********************************************************************/ /* This EDIT MACRO is user to obtain the JES2 dataset and member */ /* used by the JES2 procedure from an EXAMINE report. */ /*********************************************************************/ /* PASS JES2 DATASET NAME/MEMBER TO CALLING CLIST */ /* 06/15/2004 JL.NELSON ADDED EXIT CODE */ /* 02/14/2005 JL.NELSON Changed constants to variables before rename */ /* 06/09/2005 JL.NELSON Pass MAXCC in ZISPFRC variable */ /* 06/15/2005 JL.NELSON Set return code to end job step */ /* 03/20/2006 JL.NELSON Use NRSTR avoid abend 900 if ampersand in */ /* data. */ /* 03/29/2006 JL.NELSON Test for empty member LINENUM Rcode = 4. */ /* 04/05/2006 JL.NELSON Added TRUNC_DATA routine to drop blanks */ /* RC=864. */ /* 07/14/2016 CL.FENTON Converted script from CLIST to REXX. */ /* */ /* */ /*********************************************************************/ pgmname = "CACM0003 07/14/16" sysprompt = "OFF" /* CONTROL NOPROMPT */ sysflush = "OFF" /* CONTROL NOFLUSH */ sysasis = "ON" /* CONTROL ASIS - caps off */ Address ISPEXEC "CONTROL NONDISPL ENTER" Address ISPEXEC "CONTROL ERRORS RETURN" /* *************************************** */ /* VARIABLES ARE PASSED TO THIS MACRO */ /* CONSLIST */ /* COMLIST */ /* SYMLIST */ /* TERMMSGS */ /* */ /* VARIABLES RETURNED TO CALLING CLIST */ /* JES2CNT */ /* JES2PARM */ /* *************************************** */ return_code = 0 Address ISPEXEC "VGET (CONSLIST COMLIST SYMLIST TERMMSGS) ASIS" cm03vget = 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 return_code = return_code + 16 SIGNAL ERR_EXIT end If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" , then Trace r maxcc = 0 return_code = 0 /* *************************************** */ /* 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 cm03fe = 12 jes2cnt = 0 jes2parm = "" "CURSOR = 1 0" counter = 0 return_code = 0 "FIND 'DATASETS:'" cm03fe = return_code If return_code <> 0 then do Say pgmname "FIND 'DATASETS:' RC =" return_code strip(zerrsm) SIGNAL ERR_EXIT end "(COUNTER,COL) = CURSOR" /* *************************************** */ /* MAIN LOOP */ /* *************************************** */ do forever return_code = 0 counter = counter + 1 If counter > lastline then leave "(DATA) = LINE" counter If substr(data,7,1) <> " " then do data = strip(data) jes2parm = jes2parm||data" " jes2cnt = jes2cnt + 1 end end 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 cm003rc = return_code Address ISPEXEC "VPUT (JES2PARM JES2CNT CM03VGET CM03FE CM003RC)", "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 if return_code > maxcc then maxcc = return_code return