/* REXX */
/* CLS2REXXed by UMLA01S on 19 Dec 2024 at 15:45:15  */
  trace r?
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
 
/*********************************************************************/
/* 11/15/2005 JL Nelson Copied from CARC0501 for Top Secret.         */
/* 11/02/2005 JL Nelson Split out ACPs from SY$ACTON.                */
/* 11/02/2005 JL Nelson RACF only, create list of users in DATA      */
/*            file.                                                  */
/* 11/04/2005 JL Nelson Test for End-Of-File condition code.         */
/* 11/15/2005 JL Nelson Modified next User condition to force write. */
/* 11/15/2005 JL Nelson Copied/modified for Top Secret extracts.     */
/* 11/18/2005 JL Nelson Added tests for File condition codes.        */
/* 01/31/2006 JL Nelson Made intermediate file a seq. was PDS.       */
/* 01/31/2006 JL Nelson Changed from TSO to ISPF commands.           */
/* 02/15/2006 JL Nelson Drop FACILITYs from DEPT/DIV/ZONE records.   */
/* 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.                                                  */
/* 05/09/2006 JL Nelson Added WRITE &LASTCC for debugging.           */
/* 02/10/2008 CL Fenton Removed unused variables and obtain trace    */
/*            variables.                                             */
/* 12/19/2024 CL Fenton Converted script from CLIST to REXX.         */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname = "CATC0501 12/19/24"
listuddn = "NULLFILE"                  /* LISTUSER DDname            */
dataddn  = "NULLFILE"                  /* DATA DDname                */
datambr  = "ALLUSERS"                  /* DATA default member name   */
sysprompt = "OFF"                 /* CONTROL NOPROMPT                */
sysflush = "OFF"                  /* CONTROL NOFLUSH                 */
sysasis = "ON"                    /* CONTROL ASIS - caps off         */
Numeric digits 10                 /* default of 9 not enough         */
maxcc = 0
 
Arg OPTION
if OPTION <> "" then,
  do until OPTION = ""
    parse var OPTION key"("val")" OPTION
    val = strip(val,"b","'")
    val = strip(val,"b",'"')
    optcmd = key '= "'val'"'
    interpret optcmd
    end
 
Address ISPEXEC
"CONTROL NONDISPL ENTER"
"CONTROL ERRORS RETURN"
sysprompt = "OFF"                       /* CONTROL NOPROMPT          */
sysflush = "OFF"                        /* CONTROL NOFLUSH           */
sysasis = "ON"                          /* CONTROL ASIS - caps off   */
zispfrc = 0
 
/* Called from CACC0501*/
return_code = 0
"VGET (SYMLIST CONSLIST COMLIST TERMMSGS ACPNAME ACPVERS) ASIS"
If acpname <> "TSS" then do
  Say pgmname "Top Secret Job running on the wrong system."
  Say pgmname acpname acpvers
  return_code = 20
  SIGNAL ERR_EXIT
  End
 
syssymlist = symlist                    /* CONTROL SYMLIST/NOSYMLIST */
sysconlist = conslist                   /* CONTROL CONLIST/NOCONLIST */
syslist = comlist                       /* CONTROL LIST/NOLIST       */
sysmsg = termmsgs                       /* CONTROL MSG/NOMSG         */
 
/*******************************************/
/* INITIALIZE LIBRARY MANAGEMENT           */
/*******************************************/
 
return_code = 0
"LMINIT DATAID(LISTUID) DDNAME("listuddn")"
If return_code <> 0 then do
  Say pgmname "LMINIT_LISTUID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  End
 
"LMOPEN DATAID("listuid") OPTION(INPUT)"
If return_code <> 0 then do
  Say pgmname "LMOPEN_LISTUID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  End
 
"LMINIT DATAID(DATAID) DDNAME("dataddn")"
If return_code <> 0 then do
  Say pgmname "LMINIT_DATAID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  End
 
"LMOPEN DATAID("dataid") OPTION(OUTPUT)"
If return_code <> 0 then do
  Say pgmname "LMOPEN_DATAID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  End
 
datamem = datambr        /* Can not be in PROC & GLOBAL  */
cnt = 0
nr = 0
usrid = " "
usrname = " "
grp. = ""
 
 
READRF:
Do until return_code <> 0
  return_code = 0
  "LMGET DATAID("listuid") MODE(INVAR) DATALOC(LISTU)",
    "DATALEN(LRECL) MAXLEN(255)"
  listu = listu
  If return_code = 8 then iterate
 
  If return_code <> 0 then do
    Say pgmname "LMGET_LISTUID_RC =" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    End
 
  If listu = " " then iterate
 
  If pos("ACCESSORID =",listu) > 0 then do
    If nr > 0 then,
      Call put_data
    parse var listu . "=" usrid . "=" usrname
    usrid = left(usrid,8)
    usrname = left(usrname,17)
    End
 
  If pos("TYPE       =",listu) > 0 then do
    parse var listu . "=" type .
    Select
      When type = "USER" then,
        type = "USER"
      When type = "CENTRAL" then,
        type = "SCA"
      When type = "MASTER" then,
        type = "MSCA"
      When type = "LIMITED" then,
        type = "LSCA"
      When type = "DEPT C/A" then,
        type = "DCA"
      When type = "DIV C/A" then,
        type = "VCA"
      When type = "ZONE C/A" then,
        type = "ZCA"
      When type = "GENERIC" then,
        usrid = " "
      When type = "GROUP" then,
        usrid = " "
      When type = "PROFILE" then,
        usrid = " "
      When type = "DEPT" then,
        usrid = " "
      When type = "DIVISION" then,
        usrid = " "
      When type = "ZONE" then,
        usrid = " "
      Otherwise do
        Say pgmname "Invalid TYPE" type "was found for report"
        usrid = " "
        End
      End
    End
 
  If usrid <> " " |,
     pos("FACILITY   =",listu) > 0 then do
    nr = nr + 1
    grp.nr = strip(substr(listu,14),"T")
    End
 
  If pos("ATTRIBUTES =",listu) > 0 then do
    data = substr(listu,14)
    Do until data = ""
      parse var data attr "," data
      nr = nr + 1
      grp.nr = attr
      End
    End
 
  If pos("PROFILES   =",listu) > 0 |
     pos("GROUPS     =",listu) > 0 then do
    data = substr(listu,14)
    Do until data = ""
      parse var data attr "," data
      nr = nr + 1
      grp.nr = attr
      End
    End
  End
 
 
EOF_LISTUSER:
return_code = 0
If usrid <> " " then,
  Call put_data
 
Call add_member
 
return_code = 0
"LMCLOSE DATAID("listuid")"
lmclose_listuid_rc = return_code
 
return_code = 0
"LMFREE DATAID("listuid")"
lmfree_listcud_rc = return_code
 
"LMCLOSE DATAID("dataid")"
lmclose_dataid_rc = return_code
 
return_code = 0
"LMFREE DATAID("dataid")"
lmfree_dataid_rc = return_code
 
 
/*******************************************/
/* END of program                          */
/*******************************************/
END_EXIT:
return_code = 0
If termmsgs = "ON" then do
  Say "==============================================================="
  Say pgmname "Output member" datambr
  Say pgmname "Users =" cnt
  Say pgmname "Top Secret Processing completed."
  Say "==============================================================="
  End
 
 
/*******************************************/
/* 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
Exit (0)
 
 
/*******************************************/
/*  SYSCALL SUBROUTINES                    */
/*******************************************/
/* Write record and clear variables        */
/*******************************************/
PUT_DATA:
If usrid = " " then Return
cnt = cnt + 1
data = usrid" "usrname
 
Do x = 1 to nr
  If grpcnt = 6 then do
    return_code = 0
    "LMPUT DATAID("dataid") MODE(INVAR) DATALOC(DATA)",
      "DATALEN("length(data)")"
    If return_code <> 0 then do
      Say pgmname "LMPUT_DATAID_RC =" return_code zerrsm
      return_code = return_code + 16
      End
    grpcnt = 0
    data = usrid" "usrname
    End
  data = data" "grp.x
  grpcnt = grpcnt + 1
  End
 
grp. = ""
nr = 0
Return
 
 
ADD_MEMBER:
return_code = 0
"LMMADD DATAID("dataid") MEMBER("datamem")"
If return_code = 4 then do
  return_code = 0
  "LMMREP DATAID("dataid") MEMBER("datamem")"
  If return_code <> 0 then do
    Say pgmname "LMMREP_DATA_RCODE =" return_code datamem zerrsm
    End
  End
Else do
  If return_code <> 0 then,
    Say pgmname "LMMADD_DATA_RCODE =" return_code datamem zerrsm
  End
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 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