/* REXX */
/* CLS2REXXed by UMLA01S on 16 Dec 2024 at 10:10:49  */
/*trace r?*/
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
 
/*********************************************************************/
/* 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/18/2005 JL Nelson Added tests for File condition codes.        */
/* 12/09/2005 JL Nelson Added check for GROUP attributes.            */
/* 12/09/2005 JL Nelson Made PUT_DATA a subroutine.                  */
/* 01/17/2006 JL Nelson Identify GROUP attributes with G*.           */
/* 01/26/2006 JL Nelson Made intermediate file a seq. was PDS.       */
/* 01/26/2006 JL Nelson Changed from TSO to ISPF commands.           */
/* 03/07/2006 JL Nelson Made changes to avoid abend 920/932.         */
/* 02/10/2008 CL Fenton Removed unused variables and obtain trace    */
/*            variables.                                             */
/* 12/16/2024 CL Fenton Converted script from CLIST to REXX.         */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname = "CARC0501 12/16/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 */
"VGET (SYMLIST CONSLIST COMLIST TERMMSGS ACPNAME ACPVERS) ASIS"
 
If acpname <> "RACF" then do
  Say pgmname "RACF 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
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 length(listu) < 23 then iterate
 
  If pos("USER=",listu) > 0 then do
    If nr > 0 then,
      Call put_data
    parse var listu . "USER=" racfusr "NAME=" racfnam "OWNER=" .
    racfusr = left(racfusr,8)
    racfnam = left(racfnam,17)
    End
 
  If pos("ATTRIBUTES=",listu) = 2 then do
    attr = substr(listu,13)
    Do x = 1 to words(attr)
      if word(attr,x) = "NONE" then iterate
      nr = nr + 1
      grp.nr = word(attr,x)
      end
    End
 
  If pos("ATTRIBUTES=",listu) = 13 then do
    attr = substr(listu,24)
    Do x = 1 to words(attr)
      if word(attr,x) = "NONE" then iterate
      nr = nr + 1
      grp.nr = "G"word(attr,x)
      end
    End
 
  If pos("GROUP=",listu) = 3 then do
    parse var listu . "GROUP=" attr .
    nr = nr + 1
    grp.nr = attr
    End
  End
 
 
EOF_LISTUSER:
return_code = 0
If nr > 0 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
 
return_code = 0
"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 "RACF 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:
data = racfusr" "racfnam
cnt = cnt + 1
grpcnt = 0
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 = racfusr" "racfnam
    End
  data = data" "grp.x
  grpcnt = grpcnt + 1
  End
 
if grpcnt > 0 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
  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