PROC 0                                                                -
  LISTUDDN(NULLFILE)         /* LISTUSER DDname            */         -
  DATADDN(NULLFILE)          /* DATA DDname                */         -
  DATAMBR(ALLUSERS)          /* DATA default member 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.
 
SET PGMNAME = &STR(CARC0501 03/31/08)
 
NGLOBAL RACFUSR RACFNAM GRP1 GRP2 GRP3 GRP4 GRP5 GRP6 NR
NGLOBAL DATAID DATAMEM RETURN_CODE
 
ISPEXEC CONTROL ERRORS RETURN
 
/* ERROR ROUTINE */
ERROR DO
  SET RETURN_CODE = &LASTCC          /* SAVE LAST ERROR CODE */
  IF &LASTCC GE 16 THEN +
    WRITE &PGMNAME LASTCC = &LASTCC &ZERRLM
  RETURN
  END
 
SET SYSPROMPT = OFF                /* CONTROL NOPROMPT          */
SET SYSFLUSH  = OFF                /* CONTROL NOFLUSH           */
SET SYSASIS   = ON                 /* CONTROL ASIS - caps off   */
 
SET ZISPFRC = 0
 
/* Called from CACC0501
/* ISPEXEC VPUT (ZISPFRC) SHARED
 
SET RETURN_CODE = 0
 
ISPEXEC VGET ( +
  SYMLIST      +
  CONSLIST     +
  COMLIST      +
  TERMMSGS     +
  ACPNAME      +
  ACPVERS      +
  ) ASIS
 
IF &STR(&ACPNAME) NE &STR(RACF) THEN DO
  WRITE &PGMNAME RACF Job running on the wrong system
  WRITE &PGMNAME &ACPNAME &ACPVERS
  SET RETURN_CODE = 20
  GOTO ERR_EXIT
  END
 
SET SYSSYMLIST = &SYMLIST           /* CONTROL SYMLIST/NOSYMLIST */
SET SYSCONLIST = &CONSLIST          /* CONTROL CONLIST/NOCONLIST */
SET SYSLIST    = &COMLIST           /* CONTROL LIST/NOLIST       */
SET SYSMSG     = &TERMMSGS          /* CONTROL MSG/NOMSG         */
 
/* *************************************** */
/* INITIALIZE LIBRARY MANAGEMENT           */
/* *************************************** */
 
SET RETURN_CODE = 0
 
ISPEXEC LMINIT DATAID(LISTUID) DDNAME(&LISTUDDN)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMINIT_LISTUID_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMOPEN DATAID(&LISTUID) OPTION(INPUT)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMOPEN_LISTUID_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMINIT DATAID(DATAID) DDNAME(&DATADDN)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMINIT_DATAID_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMOPEN DATAID(&DATAID) OPTION(OUTPUT)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMOPEN_DATAID_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
SET DATAMEM = &DATAMBR        /* Can not be in PROC & GLOBAL  */
SET CNT = 0
SET NR  = 0
SET NRM = 6
SET BLK10 = &STR(          )
DO X = 1 TO &NRM
  SET GRP&X = &STR(        )
  END
 
READRF: +
SET RETURN_CODE = 0
 
ISPEXEC LMGET DATAID(&LISTUID) MODE(INVAR) DATALOC(LISTU) +
  DATALEN(LRECL) MAXLEN(255)
 
IF &RETURN_CODE EQ 8 THEN GOTO EOF_LISTUSER
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMGET_LISTUID_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
IF &LENGTH(&STR(&LISTU)) LT 23 THEN GOTO READRF
 
IF &SYSINDEX(&STR(USER=),&STR(&LISTU)) GT 0 THEN DO
  IF &NR GT 0 THEN SYSCALL PUT_DATA
  SET RACFUSR =
  SET RACFNAM =
  SET CNT = &CNT + 1
 
  SET XU = &SYSINDEX(&STR(USER=),&STR(&LISTU))
  SET XN = &SYSINDEX(&STR(NAME=),&STR(&LISTU))
  SET XO = &SYSINDEX(&STR(OWNER=),&STR(&LISTU))
 
  IF &XU GT 0   AND +
     &XN GT &XU AND +
     &XO GT &XN THEN DO
    SET RACFUSR = &SUBSTR(&XU+5:&XN-2,&LISTU)
    SET RACFNAM = &SUBSTR(&XN+5:&XO-2,&LISTU)
 
    SET RACFUSR = &SUBSTR(1:8,&RACFUSR&BLK10)
    SET RACFNAM = &SUBSTR(1:17,&RACFNAM&BLK10&BLK10)
    END
  GOTO READRF
  END
 
IF &SUBSTR(2:12,&STR(&LISTU)) EQ &STR(ATTRIBUTES=) THEN DO
  SET XF = 13
  SET XC = &SYSINDEX(&STR( ),&STR(&LISTU),&XF)
  IF &XC EQ 0 THEN DO
    SET NR = &NR + 1
    SET GRP&NR = &SUBSTR(13:20,&STR(&LISTU))
    IF &NR EQ &NRM THEN SYSCALL PUT_DATA
    GOTO READRF
    END
  ELSE DO
 
    NEXT_ATTR: +
    SET ATTR = &SUBSTR(&XF:&XC-1,&STR(&LISTU))
    IF &STR(&ATTR) EQ &STR(NONE) THEN GOTO READRF
    SET NR = &NR + 1
    SET GRP&NR = &SUBSTR(1:8,&ATTR&BLK10)
    IF &NR EQ &NRM THEN SYSCALL PUT_DATA
    SET XF = &XC+1
    SET XC = &SYSINDEX(&STR( ),&STR(&LISTU),&XF)
    IF &XC-1 GT &XF THEN +
      IF &SUBSTR(&XF:&XC-1,&STR(&LISTU)) NE &STR( ) THEN GOTO NEXT_ATTR
    GOTO READRF
    END
  END
 
IF &SUBSTR(13:23,&STR(&LISTU)) EQ &STR(ATTRIBUTES=) THEN DO
  SET XF = 24
  SET XC = &SYSINDEX(&STR( ),&STR(&LISTU),&XF)
  IF &XC EQ 0 THEN DO
    SET NR = &NR + 1
    SET GRP&NR = &SUBSTR(24:31,&STR(&LISTU.&BLK10))
    IF &NR EQ &NRM THEN SYSCALL PUT_DATA
    GOTO READRF
    END
  ELSE DO
 
    GROUP_ATTR: +
    SET ATTR = &SUBSTR(&XF:&XC-1,&STR(&LISTU))
    IF &STR(&ATTR) EQ &STR(NONE) THEN GOTO READRF
    SET NR = &NR + 1
    SET GRP&NR = &SUBSTR(1:8,G&ATTR&BLK10)
    IF &NR EQ &NRM THEN SYSCALL PUT_DATA
    SET XF = &XC+1
    SET XC = &SYSINDEX(&STR( ),&STR(&LISTU),&XF)
    IF &XC-1 GT &XF THEN +
      IF &SUBSTR(&XF:&XC-1,&STR(&LISTU)) NE &STR( ) THEN GOTO GROUP_ATTR
    GOTO READRF
    END
  END
 
IF &SUBSTR(3:8,&STR(&LISTU)) EQ &STR(GROUP=) THEN DO
  SET NR = &NR + 1
  SET GRP&NR = &SUBSTR(9:16,&STR(&LISTU))
  IF &NR EQ &NRM THEN SYSCALL PUT_DATA
  END
 
GOTO READRF
 
 
EOF_LISTUSER: +
SET RETURN_CODE = 0
 
IF &NR GT 0 THEN SYSCALL PUT_DATA
 
SYSCALL ADD_MEMBER
 
SET RETURN_CODE = 0
 
ISPEXEC LMCLOSE DATAID(&LISTUID)
 
SET LMCLOSE_LISTUID_RC = &RETURN_CODE
SET RETURN_CODE = 0
 
ISPEXEC LMFREE DATAID(&LISTUID)
SET LMFREE_LISTCUD_RC = &RETURN_CODE
 
ISPEXEC LMCLOSE DATAID(&DATAID)
 
SET LMCLOSE_DATAID_RC = &RETURN_CODE
SET RETURN_CODE = 0
 
ISPEXEC LMFREE DATAID(&DATAID)
SET LMFREE_DATAID_RC = &RETURN_CODE
 
/* *************************************** */
/* END of program                          */
/* *************************************** */
 
END_EXIT: +
SET RETURN_CODE = 0
 
IF &TERMMSGS = ON THEN DO
WRITE ===============================================================
WRITE &PGMNAME Output member &DATAMBR
WRITE &PGMNAME Users = &CNT
WRITE &PGMNAME RACF Processing completed.
END
 
/* *************************************** */
/* ERROR EXIT                              */
/* *************************************** */
 
ERR_EXIT: +
IF &MAXCC GE 16 OR +
   &RETURN_CODE GT 0 THEN DO
  ISPEXEC VGET (ZISPFRC) SHARED
  IF &MAXCC GT &ZISPFRC THEN +
    SET ZISPFRC = &MAXCC
  ELSE +
    SET ZISPFRC = &RETURN_CODE
  ISPEXEC VPUT (ZISPFRC) SHARED
  WRITE &PGMNAME ZISPFRC = &ZISPFRC
  END
 
EXIT CODE(0)
 
/*******************************************
/* Write record and clear variables        *
/*******************************************
 
PUT_DATA: PROC 0
 
SET DATA = &STR(&RACFUSR &RACFNAM &GRP1 &GRP2 +
           &GRP3 &GRP4 &GRP5 &GRP6)
 
SET RETURN_CODE = 0
 
ISPEXEC LMPUT DATAID(&DATAID) MODE(INVAR) DATALOC(DATA) +
  DATALEN(&LENGTH(&STR(&DATA)))
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMPUT_DATAID_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  END
 
DO X = 1 TO &NR
  SET GRP&X = &STR(        )
  END
 
SET NR = 0
 
END
 
/* *************************************** */
/*  SYSCALL SUBROUTINES                    */
/* *************************************** */
 
ADD_MEMBER: PROC 0
 
SET RETURN_CODE = 0
 
ISPEXEC LMMADD DATAID(&DATAID) MEMBER(&DATAMEM)
 
IF &RETURN_CODE EQ 4 THEN DO          /* MEMBER ALREADY EXISTS
  SET RETURN_CODE = 0
 
  ISPEXEC LMMREP DATAID(&DATAID) MEMBER(&DATAMEM)
 
  IF &RETURN_CODE NE 0 THEN DO
    WRITE &PGMNAME LMMREP_DATA_RCODE = &RETURN_CODE &DATAMEM  &ZERRSM
    END
  END
ELSE DO
  IF &RETURN_CODE NE 0 THEN +
    WRITE &PGMNAME LMMADD_DATA_RCODE = &RETURN_CODE &DATAMEM  &ZERRSM
  END
END