/* REXX */
/* CLS2REXXed by UMLA01S on 2 Oct 2020 at 15:56:05  */
/*Trace ?r*/
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
 
/*********************************************************************/
/* 06/16/2004 JL Nelson Added EXIT CODE.                             */
/* 06/23/2004 JL Nelson Added code to check security system.         */
/* 11/30/2004 JL Nelson Changed to use CACM042T for table.           */
/* 02/08/2005 JL Nelson Changed constants to variables before        */
/*            rename.                                                */
/* 03/28/2005 JL Nelson Added TYPERUN for Reports without PDIs.      */
/* 06/08/2005 JL Nelson Pass MAXCC in ZISPFRC variable.              */
/* 06/15/2005 JL Nelson Reset return code to end job step.           */
/* 03/21/2006 JL Nelson Use NRSTR avoid abend 900 if ampersand in    */
/*            data.                                                  */
/* 05/09/2006 JL Nelson Added WRITE &LASTCC for debugging.           */
/* 02/10/2008 CL Fenton Removed CACCACP0 to refer to CACC1000.       */
/* 06/02/2009 CL Fenton Changes CACT0001 to CACT0000, CACM042T to    */
/*            CACM000T.  Changes for reflect new table information.  */
/* 10/02/2020 CL Fenton Converted script from CLIST to REXX.         */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
CONSLIST = "OFF"                  /* DEFAULT IS OFF                  */
COMLIST  = "OFF"                  /* DEFAULT IS OFF                  */
SYMLIST  = "OFF"                  /* DEFAULT IS OFF                  */
TERMMSGS = "OFF"                  /* DEFAULT IS OFF                  */
TYPERUN  = "FSO"                  /* Run for SRRAUDIT | FSO          */
CACT0000 = "CACT0000"             /* SELECT MVS REPORT TABLE         */
CATM0401 = "CATM0001"             /* SELECT EDIT macro TEMP3         */
CACC1000 = "CACC1000"             /* SELECT SECURITY CHECK PGM       */
CACM000T = "CACM000T"             /* SELECT EDIT macro CT0000        */
CNTLDDN  = "CNTL"                 /* DDName for CNTL                 */
TEMP3DDN = "TEMPDATA"             /* DDName for TEMP3                */
TRACE    = "OFF"                  /* TRACE ACTIONS AND ERRORS        */
pgmname  = "CATC0001 10/02/20"
sysprompt = "OFF"                 /* CONTROL NOPROMPT                */
sysflush = "OFF"                  /* CONTROL NOFLUSH                 */
sysasis  = "ON"                   /* CONTROL ASIS - caps off         */
Numeric digits 10                 /* default of 9 not enough         */
maxcc = 0
lminit_cntl_rc   = "N/A"
lminit_temp3_rc  = "N/A"
view_cact0000_rc = "N/A"
edit_temp3_rc    = "N/A"
tm01lmcl         = "N/A"
tm01lmfr         = "N/A"
tm01lmin         = "N/A"
tm01lmop         = "N/A"
tm01lmpe         = "N/A"
tm01vget         = "N/A"
tm001rc          = "N/A"
lmfree_temp3_rc  = "N/A"
lmfree_cntl_rc   = "N/A"
 
zerrsm           = ""
zerrlm           = ""
zerrmsg          = ""
 
Arg OPTION
do until OPTION = ""
  parse var OPTION key"("val")" OPTION
  val = strip(val,"b","'")
  val = strip(val,"b",'"')
  optcmd = key '= "'val'"'
  interpret optcmd
  end
 
return_code = 0
If trace = "ON" then do            /* TURN messages on          */
  termmsgs = "ON"                  /* CONTROL MSG               */
  comlist = "ON"                   /* CONTROL LIST              */
  conslist = "ON"                  /* CONTROL CONLIST           */
  symlist = "ON"                   /* CONTROL SYMLIST           */
  end
 
If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" | TRACE = "ON",
  then Trace ?r
 
syssymlist = symlist          /* CONTROL SYMLIST/NOSYMLIST */
sysconlist = conslist         /* CONTROL CONLIST/NOCONLIST */
syslist = comlist             /* CONTROL LIST/NOLIST       */
sysmsg = termmsgs             /* CONTROL MSG/NOMSG         */
Address ISPEXEC
"CONTROL NONDISPL ENTER"
"CONTROL ERRORS RETURN"
zispfrc = 0
"VPUT (ZISPFRC) SHARED"
 
return_code = 0                 /* SET RETURN CODE TO 0 */
"VPUT (CONSLIST COMLIST SYMLIST TERMMSGS CACT0000 TYPERUN)",
  "ASIS"
tc01vput = return_code
If return_code <> 0 then do
  Say pgmname "VPUT RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
/* Determine which security system is running */
return_code = 0
"SELECT CMD("cacc1000 "ACP)"
"VGET (ACPNAME ACPVERS) ASIS"
If left(acpname,3) <> "TSS" then do
  Say pgmname "Top Secret Job running on the wrong system."
  Say pgmname acpname acpvers
  return_code = 20
  SIGNAL  ERR_EXIT
  end
 
/*******************************************/
/* INITIALIZE LIBRARY MANAGEMENT           */
/*******************************************/
return_code = 0
"LMINIT DATAID(CNTLID) DDNAME("cntlddn")"
lminit_cntl_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_CNTL_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL  ERR_EXIT
  end
 
return_code = 0
"LMINIT DATAID(TEMP3) DDNAME("temp3ddn")"
lminit_temp3_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_TEMP3_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL  ERR_EXIT
  end
 
/*******************************************/
/* GET TABLE VALUES                        */
/*******************************************/
return_code = 0
"VIEW DATAID("cntlid") MACRO("cacm000t") MEMBER("cact0000")"
view_cact0000_rc = return_code
If return_code > 4 then do
  Say pgmname "VIEW_CACT0000_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL  ERR_EXIT
  end
 
/*******************************************/
/* INITIALIZE VARIABLES FOR EDIT MACRO     */
/*******************************************/
return_code = 0
"EDIT DATAID("temp3") MACRO("catm0401")"
edit_temp3_rc = return_code
If return_code > 4 then do
  Say pgmname "EDIT_TEMP3_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL  ERR_EXIT
  end
 
return_code = 0
"LMFREE DATAID("temp3")"
lmfree_temp3_rc = return_code
If return_code <> 0 then,
  Say pgmname "LMFREE TEMP3" return_code zerrsm
 
return_code = 0
"LMFREE DATAID("cntlid")"
lmfree_cntl_rc = return_code
If return_code <> 0 then,
  Say pgmname "LMFREE CNTL" return_code zerrsm
 
return_code = 0
 
 
/*******************************************/
/* ERROR EXIT                              */
/*******************************************/
ERR_EXIT:
If maxcc >= 16 | return_code > 0 then do
  "VGET (ZISPFRC) SHARED"
  If maxcc > zispfrc then,
    zispfrc = /*!*/maxcc
  Else,
    zispfrc = return_code
  "VPUT (ZISPFRC) SHARED"
  Say pgmname "ZISPFRC =" zispfrc
  end
 
"VGET (TM01LMCL TM01LMFR TM01LMIN TM01LMOP TM01LMPE TM01VGET",
  "TM001RC) ASIS"
 
If termmsgs = "ON" then do
  Say "==============================================================="
  Say pgmname "LMINIT_CNTL_ERR        " lminit_cntl_rc
  Say pgmname "LMINIT_TEMP3_RC        " lminit_temp3_rc
  Say pgmname "VIEW_CACT0000_RC       " view_cact0000_rc
  Say pgmname "EDIT_TEMP3_RC          " edit_temp3_rc
  If tm001rc <> 0 then do
    Say "==============================================================="
    Say pgmname catm0401 "LMCLOS        " tm01lmcl
    Say pgmname catm0401 "LMFREE        " tm01lmfr
    Say pgmname catm0401 "LMINIT        " tm01lmin
    Say pgmname catm0401 "LMOPEN        " tm01lmop
    Say pgmname catm0401 "LMPUT         " tm01lmpe
    Say pgmname catm0401 "VGET          " tm01vget
    Say pgmname catm0401 "TM001RC       " tm001rc
    Say "==============================================================="
    end
  Say pgmname "LMFREE_TEMP3_RC        " lmfree_temp3_rc
  Say pgmname "LMFREE_CNTL_RC         " lmfree_cntl_rc
  Say "==============================================================="
  end
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
 
 
/* ERROR ROUTINE */
/*!ERROR "DO"*/
return_code = rc          /* SAVE LAST ERROR CODE */
If rc >= 16
  Then
    Say pgmname "LASTCC =" rc zerrlm
Return
Exit