/* REXX */
/* CLS2REXXed by UMLA01S on 5 Oct 2020 at 14:02:24  */
/*Trace ?r*/
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
 
/*********************************************************************/
/* 06/16/2004 JL Nelson Changed EXIT CODE.                           */
/* 06/23/2004 JL Nelson Added code to check security system.         */
/* 07/08/2004 JL Nelson Added code for whohas dsn('xxxx').           */
/* 07/20/2004 JL Nelson Added whoami to get return code of zero.     */
/* 11/30/2004 JL Nelson Changed to use CACM042T for table.           */
/* 12/21/2004 JL Nelson Write out highest access level, dups         */
/*            dropped.                                               */
/* 12/22/2004 JL Nelson Adjust access levels.                        */
/* 02/08/2005 JL Nelson Changed constants to variables before        */
/*            rename.                                                */
/* 03/28/2005 JL Nelson Added TYPERUN for Reports without PDIs.      */
/* 06/01/2005 JL Nelson Made change to allow generic data set        */
/*            names.                                                 */
/* 06/08/2005 JL Nelson Pass MAXCC in ZISPFRC variable.              */
/* 06/15/2005 JL Nelson Reset return code to end job step.           */
/* 07/19/2005 JL Nelson Changed to allow DSN = *.                    */
/* 08/19/2005 JL Nelson Added macro to VIEW TSS LIST() PROFILE       */
/*            dataset.                                               */
/* 11/29/2005 JL Nelson Modified to drop dups by access per Charles. */
/* 03/15/2006 JL Nelson Made changes to avoid SUBSTR abend 920/932.  */
/* 03/21/2006 JL Nelson Use NRSTR avoid abend 900 if ampersand in    */
/*            data.                                                  */
/* 04/19/2006 JL Nelson Add rule period count to XAUTH output.       */
/* 04/20/2006 JL Nelson Ignore invalid rules from WHOHAS.            */
/* 04/20/2006 JL Nelson Fixed ACID length, picking up until data.    */
/* 05/09/2006 JL Nelson Added WRITE &LASTCC for debugging.           */
/* 05/31/2006 JL Nelson Use TM0528 to find global audit prefixes.    */
/* 10/20/2006 CL Fenton Removed TM0528 to find global audit, may     */
/*            cause insufficient storage with large number of dsns   */
/*            being auditted.                                        */
/* 10/20/2006 CL Fenton Added script to obtain global audit.         */
/* 02/10/2008 CL Fenton Removed CACCACP0 to refer to CACC1000.       */
/* 03/31/2008 CL Fenton Chgd process for TEMP6 to create PDS         */
/*            members.                                               */
/* 07/07/2008 CL Fenton Corrected issue with dsn not having any      */
/*            permissions specified.                                 */
/* 06/02/2009 CL Fenton Changes CACT0001 to CACT0000, CACM042T to    */
/*            CACM000T.  Changes for reflect new table information.  */
/* 10/09/2009 CL Fenton Changes to check for masking characters in   */
/*            ADSN field when compared to DSN field.                 */
/* 03/02/2010 CL Fenton Changes to check for masking character, (*)  */
/*            ADSN field when compared to DSN field dropping record  */
/*            when other masking characters are in the ADSN field.   */
/* 05/13/2010 CL Fenton Changes to drop records when (*) is in first */
/*            position of DSN and ADSN contains other masking        */
/*            characters are in first position.                      */
/* 07/01/2010 CL Fenton Changes to drop records when (*) is in       */
/*            first position of DSN and ADSN starts with (*) and     */
/*            alphanumbic characters in positions after mask.        */
/* 04/19/2011 CL Fenton Added ISPEXEC CONTROL statement. Changed     */
/*            comparison of DSN and ADSN to evaluate masking         */
/*            characters in both fields, CSD-AR002692245.            */
/* 09/07/2011 CL Fenton Added bypass for permissions for temporary   */
/*            data sets, CSD-AR002965170.                            */
/* 08/26/2016 CL Fenton Correct issue with TBLMBR.                   */
/* 06/14/2018 CL Fenton Deleted CATM0528 varible.                    */
/* 10/02/2020 CL Fenton Converted script from CLIST to REXX.         */
/* 10/01/2021 CL Fenton Correct issue when resource and permission   */
/*            characters match, CATALOG.MSTRMTY and CATALOG.MSTR,    */
/*            STS-027538.                                            */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
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          */
NOUSR    = "OFF"                  /* PRODUCE USER LIST               */
CACT0000 = "CACT0000"             /* DEFAULT name table              */
CACC1000 = "CACC1000"             /* SELECT SECURITY CHECK PGM       */
CATM0402 = "CATM0002"             /* DEFAULT EDIT MACRO TEMP6        */
CATM0405 = "CATM0405"             /* DEFAULT MACRO TSSLISTP          */
CACM000T = "CACM000T"             /* SELECT EDIT macro CT0000        */
TRACE    = "OFF"                  /* TRACE ACTIONS AND ERRORS        */
pgmname  = "CATC0002 10/01/21"
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_temp5_rc     = "N/A"
lminit_temp6_rc     = "N/A"
lminit_sensitve_rc  = "N/A"
lmopen_temp5_rc     = "N/A"
lmopen_temp6_rc     = "N/A"
lmopen_sensitve_rc  = "N/A"
lmclose_temp5_rc    = "N/A"
lmclose_temp6_rc    = "N/A"
lmclose_sensitve_rc = "N/A"
lmfree_cntl_rc      = "N/A"
lmfree_temp3_rc     = "N/A"
lmfree_temp5_rc     = "N/A"
lmfree_temp6_rc     = "N/A"
lmfree_sensitve_rc  = "N/A"
lmfree_tsslistp_rc  = "N/A"
lmget_temp5_rc      = 12
lmput_temp6_rc      = 12
edit_temp6_rc       = 12
 
zerrsm           = ""
zerrlm           = ""
zerrmsg          = ""
return_code = 0
 
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"
 
 
/* Determine which security system is running */
 
/*******************************************/
/* INITIALIZE LIBRARY MANAGEMENT           */
/*******************************************/
return_code = 0
"LMINIT DATAID(CNTL) DDNAME(CNTL)"
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(TEMP3ID) DDNAME(TEMP3)"
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
 
return_code = 0
"LMINIT DATAID(TEMP5) DDNAME(TEMP5)"
lminit_temp5_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_TEMP5_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"LMINIT DATAID(TEMP6) DDNAME(TEMP6)"
lminit_temp6_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_TEMP6_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"LMINIT DATAID(SENSITVE) DDNAME(SENSITVE) ENQ(EXCLU)"
lminit_sensitve_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_SENSITVE_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"LMINIT DATAID(TSSLISTP) DDNAME(TSSLISTP)"
lminit_tsslistp_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_TSSLISTP_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"LMOPEN DATAID("temp6") OPTION(OUTPUT)"
lmopen_temp6_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMOPEN_TEMP6_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"LMOPEN DATAID("sensitve") OPTION(OUTPUT)"
lmopen_sensitve_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMOPEN_SENSITVE_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"LMOPEN DATAID("temp5") OPTION(INPUT)"
lmopen_temp5_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMOPEN_TEMP5_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"VPUT (CONSLIST COMLIST SYMLIST NOUSR TERMMSGS CACT0000 CACM000T",
  "CATM0405 SENSITVE TSSLISTP TYPERUN ) ASIS"
tc02vput = return_code
If return_code <> 0 then do
  Say pgmname "VPUT error" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
"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
 
/********************************************************************/
/* MAIN PROCESS LOOP                                                */
/********************************************************************/
 
member = ""
adsn = " "
dsn = " "
access = "NONE    "
action = "N"
 
Call get_audit_rec "DATASET"
 
 
/* GETFILE: GETFILE TEMP5 */
GETFILE:
do until return_code > 0
  return_code = 0
  "LMGET DATAID("temp5") MODE(INVAR) DATALOC(INDATA)",
    "DATALEN(INLNGTH) MAXLEN(300)"
  lmget_temp5_rc = return_code
  If return_code = 8 then do
    lmget_temp5_rc = 0
    return_code = 0
    Call write_rec
    lmput_temp6_rc = return_code
    Call add_member
    leave
    end
 
  If lmget_temp5_rc > 4 then do
    Say pgmname "LMGET_TEMP5_RC" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
 
  recid = substr(indata,5,4)
  If recid = 0001 then do
    If dsn <> " " then do
      return_code = 0
      Call write_rec
      lmput_temp6_rc = return_code
      end
 
    If pos("TSS WHOAMI",indata) = 33 then do
      If member <> " " then
        Call add_member
      member = substr(indata,49,2)
      dsn = " "
      adsn = " "
      acid = "        "
      end
 
    If pos("TSS WHOH DSN",indata) = 33 then do
      parse var indata . "DSN(" dsn ")" .
      If substr(dsn,1,1) = "'" then do
        dsn = strip(dsn,"B","'")
        end
      dsn = left(dsn,44)
      adsn = " "
      acid = "        "
      access = "NONE    "
      action = "N"
      end
    iterate
    end
 
  If recid = 2007 then do
    If acid <> " " then do
      return_code = 0
      Call write_rec
      lmput_temp6_rc = return_code
      access = "NONE    "
      action = "N"
      end
    parse var indata . 41 acid +8 . 65 adsn .
    /* until mm/dd/yy  49:56*/
    If left(adsn,1) = "'" then do
      adsn = strip(adsn,"B","'")
      exp = "Y"
      end
    Else,
      If dsn = adsn then,
        exp = "N"
      Else
        exp = " "
    iterate
    end
 
  If recid = 1950 then do
    parse var indata . 49 adsn .
    If left(adsn,1) = "'" then do
      adsn = strip(adsn,"B","'")
      exp = "Y"
      end
    Else,
      If dsn = adsn then,
        exp = "N"
      Else,
        exp = " "
    adsn = left(adsn,44)
    iterate
    end
 
  If recid = 2021 then do
    parse var indata . 33 access 153 .
    iterate
    end
 
  If recid = 2016 then do
    If pos("AUDIT",indata) <> 0 then,
      action = "Y"
    end
  end
 
 
JOBDONE:
return_code = 0
"LMCLOSE DATAID("temp5")"
lmclose_temp5_rc = return_code
 
return_code = 0
"LMCLOSE DATAID("temp6")"
lmclose_temp6_rc = return_code
If return_code > 4 then do
  Say pgmname "LMCLOSE_TEMP6_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
/*******************************************/
/* GET TABLE VALUES                        */
/*******************************************/
return_code = 0
"VIEW DATAID("cntl") MACRO("cacm000t") MEMBER("cact0000")"
view_cact0000_rc = return_code
If return_code > 4 then do
  Say pgmname "Error on VIEW of" cact0000 "RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"VGET (TBLMBR) ASIS"
tblmbr = strip(tblmbr,"T")
 
return_code = 0
Do X = 2 to length(tblmbr)
  iter = substr(tblmbr,x,2)
  "EDIT DATAID("temp6") MACRO("catm0402") MEMBER("iter")"
  edit_temp6_rc = return_code
  x = pos("#",tblmbr,x)
  end
 
return_code = 0
"LMCLOSE DATAID("sensitve")"
lmclose_sensitve_rc = return_code
 
return_code = 0
"LMFREE DATAID("cntl")"
lmfree_cntl_rc = return_code
 
return_code = 0
"LMFREE DATAID("temp3id")"
lmfree_temp3_rc = return_code
 
return_code = 0
"LMFREE DATAID("temp5")"
lmfree_temp5_rc = return_code
 
return_code = 0
"LMFREE DATAID("temp6")"
lmfree_temp6_rc = return_code
 
return_code = 0
"LMFREE DATAID("sensitve")"
lmfree_sensitve_rc = return_code
 
return_code = 0
"LMFREE DATAID("tsslistp")"
lmfree_tsslistp_rc = return_code
 
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 (T2LMMR T2LMPUT T2SAVE T2SORT1 T2SORT2 TM02VGET TM002RC",
  "TM405RC TM405VG CM0TVGET CM0TVPUT CM00TRC) ASIS"
If termmsgs = "ON" then do
    Say "================================================================"
    Say pgmname "LMINIT_CNTL_RC            " lminit_cntl_rc
    Say pgmname "LMINIT_TEMP3_RC           " lminit_temp3_rc
    Say pgmname "LMINIT_TEMP5_RC           " lminit_temp5_rc
    Say pgmname "LMINIT_TEMP6_RC           " lminit_temp6_rc
    Say pgmname "LMINIT_SENSITVE_RC        " lminit_sensitve_rc
    Say pgmname "LMINIT_TSSLISTP_RC        " lminit_tsslistp_rc
    Say pgmname "LMOPEN_TEMP5_RC           " lmopen_temp5_rc
    Say pgmname "LMOPEN_TEMP6_RC           " lmopen_temp6_rc
    Say pgmname "LMOPEN_SENSITVE_RC        " lmopen_sensitve_rc
    Say pgmname "LMGET_TEMP5_RC            " lmget_temp5_rc
    Say pgmname "LMPUT_TEMP6_RC            " lmput_temp6_rc
    Say pgmname "TC02VPUT                  " tc02vput
    Say pgmname "EDIT_TEMP6_RC             " edit_temp6_rc
    Say "================================================================"
    Say pgmname catm0402 "VGET             " tm02vget
    Say pgmname catm0402 "LMMR             " t2lmmr
    Say pgmname catm0402 "LMPUT            " t2lmput
    Say pgmname catm0402 "SAVE             " t2save
    Say pgmname catm0402 "SORT1            " t2sort1
    Say pgmname catm0402 "SORT2            " t2sort2
    Say pgmname catm0402 "TM002RC          " tm002rc
    Say pgmname catm0405 "VGET             " tm405vg
    Say pgmname catm0405 "TM405RC          " tm405rc
    Say pgmname cacm000t "VGET             " cm0tvget
    Say pgmname cacm000t "VPUT             " cm0tvput
    Say pgmname cacm000t "CM42TRC          " cm00trc
    Say "================================================================"
    Say pgmname "LMCLOSE_TEMP5_RC          " lmclose_temp5_rc
    Say pgmname "LMCLOSE_TEMP6_RC          " lmclose_temp6_rc
    Say pgmname "LMCLOSE_SENSITVE_RC       " lmclose_sensitve_rc
    Say pgmname "LMFREE_CNTL_RC            " lmfree_cntl_rc
    Say pgmname "LMFREE_TEMP3_RC           " lmfree_temp3_rc
    Say pgmname "LMFREE_TEMP5_RC           " lmfree_temp5_rc
    Say pgmname "LMFREE_TEMP6_RC           " lmfree_temp6_rc
    Say pgmname "LMFREE_SENSITVE_RC        " lmfree_sensitve_rc
    Say pgmname "LMFREE_TSSLISTP_RC        " lmfree_tsslistp_rc
    Say "================================================================"
    end
Exit (0)
 
 
/*******************************************/
/*  SYSCALL SUBROUTINES                    */
/*******************************************/
ADD_MEMBER:
return_code = 0
"LMMADD DATAID("temp6") MEMBER("member")"
If return_code = 4 then do
  return_code = 0
  "LMMREP DATAID("temp6") MEMBER("member")"
  If return_code <> 0 then,
    Say pgmname "LMMREP TEMP6 RCODE =" return_code zerrsm
  end
Else do
  If return_code <> 0 then,
    Say pgmname "LMMADD TEMP6 RCODE =" return_code zerrsm
  end
Return (rc)
 
 
WRITE_REC:
/* Ignore invalid records from WHOHAS   .*.*.*.    */
rpc = 0         /* Rule period counter */
rpi = 0         /* Rule period index   */
dpc = 0         /* DSN period counter  */
dsn = strip(dsn,"T")
adsn = strip(adsn,"T")
 
If left(dsn,1) = "*" &,
   pos("+",adsn) = 0 &,
   pos("%",adsn) = 0 &,
   pos("-",adsn) = 0 then do
  Do X = 1 to length(adsn) while substr(adsn,x,1) <> " "
    If substr(adsn,x,1) > "*" then,
      SIGNAL BYPASS_LMPUT
    end
  Call PERFORM_LMPUT
  SIGNAL BYPASS_LMPUT
  end
 
If left(dsn,1) = "*" &,
  (pos("+",adsn) = 1 |,
   pos("%",adsn) = 1 |,
   pos("-",adsn) = 1) then,
  SIGNAL BYPASS_LMPUT
 
Do RBI = 1 to length(adsn) while substr(adsn,rbi,1) <> " "
  If substr(adsn,rbi,1) = "." then do
    rpc = rpc + 1
    rpi = rbi
    end
  end
 
If rpc <= 1 &,
   rpi+1 = rbi &,
   pos("*",adsn) = 0 then do
  Call PERFORM_LMPUT
  SIGNAL BYPASS_LMPUT
  end
 
 
NEXT_AST:
Do forever while rbi > 2
  If rbi > 2 then do
    If substr(adsn,rbi-1,1) = "*" then do
      rbi = rbi - 1
      iterate
/*    SIGNAL NEXT_AST*/
      end
    leave
    end
  end
 
Do DBI = 1 to length(dsn) while substr(dsn,dbi,1) <> " "
  If substr(dsn,dbi,1) = "." then,
    dpc = dpc + 1
  end
 
/******************************************************/
/* Bypass invalid data set rule if:                   */
/*   The rule has more qualiferes than the dataset or */
/*   The rule is longer than the dataset name.        */
/******************************************************/
 
If substr(dsn,dbi-1,1) <> "." then,
  If rpc > dpc |,
     rbi > dbi then,
    SIGNAL BYPASS_LMPUT
 
If left(dsn,1) = "*" &,
   rbi > dbi then,
  SIGNAL BYPASS_LMPUT
 
bypass_lmput_sw = ""
ri = 1
di = 1
rx = 0
dx = 0
match = ""
dsn = strip(dsn)
adsn = strip(adsn)
 
ccnt = compare(dsn,adsn)
Do until substr(dsn,di,1) = " " | substr(dsn,ri,1) = " "
  If ccnt = 0 then leave
  If ccnt > 0 & substr(adsn,ccnt,1) = " " then leave
  If substr(dsn,di,1) = substr(adsn,ri,1) |,
     substr(adsn,ri,1) = "+" |,
     substr(dsn,di,1) = "+" then do
    di = di + 1
    ri = ri + 1
    rx = 0
    dx = 0
    end
  Else do
    If rx > 0 then do
      rx = rx - 1
      ri = ri - 1
      end
    Else,
    If dx > 0 then do
      dx = dx - 1
      di = di - 1
      end
    Else,
    If substr(adsn,ri,1) = "*" then do
      rx = rx + 8
      end
    Else,
    If substr(dsn,di,1) = "*" then do
      dx = dx + 8
      end
    Else,
    If substr(adsn,ri,1) = "-" then do
      rx = rx + 256
      end
    Else,
    If substr(dsn,di,1) = "-" then do
      dx = dx + 256
      end
    Else do
/*    say dsn adsn compare(dsn,adsn) compare(adsn,dsn)*/
      bypass_lmput_sw = "X"
      leave
      end
 
 
    COMPARE_NEXT:
    di = di + 1
    ri = ri + 1
    end
  end
 
If bypass_lmput_sw = "X" then,
  SIGNAL BYPASS_LMPUT
 
If ri > 1 & di > 1 then,
  If substr(adsn,ri,1) <> " " &,
     substr(dsn,di-1,1) <> "." then,
    SIGNAL BYPASS_LMPUT
 
/* Bypass permission rule for temporary data set names */
If pos("SYS+++++.T",adsn) = 1 |,
   pos("SYS0++++.T",adsn) = 1 |,
   pos("SYS1++++.T",adsn) = 1 then,
  SIGNAL BYPASS_LMPUT
 
Call PERFORM_LMPUT
 
 
BYPASS_LMPUT:
return_code = 0
adsn = " "
acid = "        "
access = "NONE    "
action = "N"
Return (rc)
 
 
/*******************************************/
/*  SYSCALL SUBROUTINES                    */
/*******************************************/
GET_AUDIT_REC:
Arg RESOURCE
auddsns = ""
x = outtrap("out.")
Address TSO "TSS LIST(AUDIT) RESCLASS("resource")"
Do I = 1 to out.0
  data = out.i
  If left(data,8) <> resource then,
    iterate
/*  SIGNAL NEXT_DO */
  auddsn = substr(data,14)
  if auddsn = "*ALL*" then do
    auddsns = auddsns""auddsn" "
    iterate
    end
  dl = length(data)
  x = 14
  y = 41
 
 
NEXT_AUDIT:
  If y > dl then,
    y = dl
  If x < y & y <= dl then do
    If auddsn = " " then,
      iterate I
/*    SIGNAL NEXT_DO*/
    end
  /* Remove masking character from end of audit information. */
  a1 = pos("* ",auddsn" ")
  If a1 > 1 then,
    auddsn = left(auddsn,a1-1)
  a1 = pos("*." ,auddsn" ")
  If a1 > 1 then,
    auddsn = left(auddsn,a1-1)
  auddsn = strip(auddsn,"T")
  auddsns = auddsns""auddsn" "
 
 
NEXT_DO:
  end
"VPUT (AUDDSNS) ASIS"
al = length(auddsns)
Say pgmname "Length of global audit list is" al
Return (rc)
 
 
PERFORM_LMPUT:
return_code = 0
xpc = 000||rpc
l = length(xpc)
xdsn = substr(xpc,l,1)left(adsn,43)
plvl = 0
acc = "NONE    "
acidt = "         "    /* 9 blanks filled in by CATM0002*/
Do X = 1 to length(access) by 8 while substr(access,x,1) <> " "
  acc8 = substr(access,x,8)
  Select
    When acc8 = "NONE    " then lvl = 0
    When acc8 = "FETCH   " then lvl = 1
    When acc8 = "NOCREATE" then lvl = 2
    When acc8 = "READ    " then lvl = 3
    When acc8 = "INQUIRE " then lvl = 3
    When acc8 = "WRITE   " then lvl = 4
    When acc8 = "UPDATE  " then lvl = 5
    When acc8 = "CONTROL " then lvl = 6
    When acc8 = "CREATE  " then lvl = 7
    When acc8 = "SCRATCH " then lvl = 8
    When acc8 = "ALL     " then lvl = 9
    Otherwise do
      Say pgmname "Unknown access" acc8 "not found in list"
      lvl = 9
      end
    end
  If plvl < lvl then do
      plvl = lvl
      acc = acc8
    end
  end
 
Do XA = 1 to length(auddsns)
  ya = pos(" ",auddsns,xa)
  parse var auddsns . =(xa) auddsn .
  xa = ya
  xb = pos("'",auddsn)
  If xb = 1 then do
    auddsn = strip(auddsn,"B","'")
    If auddsn = adsn then do
      If action = "N" then,
        action = "X"
      Else,
        action = "Z"
          xa = length(auddsns)
      iterate xa
      end
    end
 
  If pos(auddsn,adsn) = 1 |,
     pos(auddsn,dsn) = 1 then do
    If action = "N" then,
      action = "X"
    Else,
      action = "Z"
    xa = length(auddsns)
    end
 
  If auddsn > dsn then,
    xa = length(auddsns)
  end
 
outdata = member""xdsn""acid""acidt""acc""plvl""action""left(dsn,44)"1"
"LMPUT DATAID("temp6") MODE(INVAR) DATALOC(OUTDATA)",
  "DATALEN("length(outdata)")"
return
 
 
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 & RC <> 14 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