PROC 0                                                                -
  LISTUDDN(NULLFILE)         /* LISTUSER DDname            */         -
  DATADDN(NULLFILE)          /* DATA DDname                */         -
  DATAMBR(ALLUSERS)          /* DATA default member name   */
 
/* 11/16/2005 JL.NELSON Copied from CARC0501 for ACF2.
/* 11/02/2005 JL.NELSON Split out ACPs from SY$ACTON
/* 11/16/2005 JL.NELSON Copied/modified for ACF2 extracts.
/* 11/17/2005 JL.NELSON Modified search for variable UID strings.
/* 11/18/2005 JL.NELSON Added tests for File condition codes.
/* 01/30/2006 JL.NELSON Made intermediate file a seq. was PDS.
/* 01/30/2006 JL.NELSON Changed from TSO to ISPF commands.
/* 01/30/2006 JL.NELSON Change for ACF2 8.0 DFP now MISCELLANEOUS
/* 02/02/2006 JL.NELSON Modified for 24 byte UID.
/* 02/02/2006 JL.NELSON Modified for ASC string after NAME field
/* 06/06/2006 C. STERN  Updated ERROR ROUTINE.
/* 02/10/2008 CL FENTON Removed unused variables and obtain trace variables.
 
SET PGMNAME = &STR(CAAC0501 03/31/08)
 
NGLOBAL USRID USRNAM GRP1 GRP2 GRP3 GRP4 GRP5 GRP6 NR
NGLOBAL DATAID DATAMEM RETURN_CODE UID
 
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
 
ISPEXEC VGET ( +
  SYMLIST      +
  CONSLIST     +
  COMLIST      +
  TERMMSGS     +
  ACPNAME      +
  ACPVERS      +
  ) ASIS
 
IF &STR(&ACPNAME) NE &STR(ACF2) THEN DO
  WRITE &PGMNAME ACF2 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 LP = &STR((
SET RP = )
SET CNT = 0
SET NR = 0
SET NRM = 6
SET BLK10 = &STR(          )
SET UID   = &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
 
NEXT_RF: +
SET RETURN_CODE = 0
SET F1 = &SUBSTR(2:9,&STR(&LISTU))
 
SELECT &STR(&F1)
  WHEN (        ) GOTO ASC
  WHEN (PRIVILEG) GOTO PRIV
  WHEN (DFP     ) GOTO DFP
  WHEN (MISCELLA) GOTO DFP
  WHEN (ACCESS  ) GOTO READRF
  WHEN (PASSWORD) GOTO READRF
  WHEN (TSO     ) GOTO TSO
  WHEN (STATISTI) GOTO READRF
  WHEN (CICS    ) GOTO READRF
  WHEN (RESTRICT) GOTO READRF
  WHEN (&STR(CANCEL/S)) GOTO READRF
  END
 
SET XN = &SYSINDEX(&STR(&F1),&STR(&LISTU),23)
IF &XN EQ 0 THEN GOTO READRF
 
IF &NR GT 0 THEN SYSCALL PUT_DATA
SET CNT = &CNT + 1
 
SET USRID  = &STR(&F1)
SET USRNAM = &SUBSTR(&XN+9:&XN+29,&STR(&LISTU))
 
SET USRID  = &SUBSTR(1:8,&USRID&BLK10)
SET USRNAM = &SUBSTR(1:17,&USRNAM&BLK10&BLK10)
 
SET UID = &SUBSTR(23:46,&LISTU)
SET NR = 3
 
IF &XN GT 39 THEN DO
  SET UID = &SUBSTR(23:&XN+7,&STR(&LISTU))
  SET NR = &NR + 1
  END
 
GOTO READRF
 
 
PRIV: +
SET RETURN_CODE = 0
SET XF = 23
 
NEXT_ATTR: +
  SET XC = &SYSINDEX(&STR( ),&STR(&LISTU),&XF)
  IF &XC-1 GT &XF THEN DO
    SET ATTR = &SUBSTR(&XF:&XC-1,&STR(&LISTU))
    IF &STR(&ATTR) EQ &STR( ) THEN GOTO READRF
    ELSE DO
      SET NR = &NR + 1
      SET GRP&NR = &SUBSTR(1:8,&ATTR&BLK10)
      IF &NR EQ &NRM THEN SYSCALL PUT_DATA
      SET XF = &XC+1
      GOTO NEXT_ATTR
      END
    END
 
GOTO READRF
 
TSO: +
SET RETURN_CODE = 0
 
IF &SYSINDEX(&STR(MOUNT ),&STR(&LISTU),23) GT 0 THEN DO
  SET NR = &NR + 1
  SET GRP&NR = &STR(MOUNT   )
  IF &NR EQ &NRM THEN SYSCALL PUT_DATA
  END
 
IF &SYSINDEX(&STR(OPERATOR),&STR(&LISTU),23) GT 0 THEN DO
  SET NR = &NR + 1
  SET GRP&NR = &STR(OPERATOR)
  IF &NR EQ &NRM THEN SYSCALL PUT_DATA
  END
 
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
 
SET F1 = &SUBSTR(2:9,&STR(&LISTU))
IF &STR(&F1) EQ &STR( ) THEN GOTO TSO
 
GOTO NEXT_RF
 
 
ASC: +
SET RETURN_CODE = 0
 
IF &SYSINDEX(&STR(ASC&LP),&STR(&LISTU),23) EQ 0 THEN GOTO READRF
 
DFP: +
SET RETURN_CODE = 0
 
IF &NR GT 0 THEN SYSCALL PUT_DATA
 
SET DFP = &SUBSTR(23:76,&STR(&LISTU))
IF &STR(&DFP) EQ &STR( ) THEN GOTO READRF
 
SET DATA = &STR(&USRID &USRNAM &DFP)
 
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
  GOTO ERR_EXIT
  END
 
SET DFP = &SUBSTR(77:130,&STR(&LISTU))
IF &STR(&DFP) EQ &STR( ) THEN GOTO READRF
 
SET XF = 76
DO UNTIL &SUBSTR(&XF:&XF,&STR(&LISTU)) EQ &STR( )
  SET XF = &XF - 1
  IF &XF = 0 THEN GOTO READRF
  END
 
SET DFP = &SUBSTR(&XF+1:&XF+54,&STR(&LISTU))
 
SET DATA = &STR(&USRID &USRNAM &DFP)
 
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
  GOTO ERR_EXIT
  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 ACF2 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)
END
 
/*******************************************
/* Write record and clear variables        *
/*******************************************
 
PUT_DATA: PROC 0
 
IF &STR(&UID) NE &STR( ) THEN DO
SET DATA = &STR(&USRID &USRNAM &UID &GRP4 &GRP5 &GRP6)
  END
ELSE DO
  SET DATA = &STR(&USRID &USRNAM &GRP1 &GRP2 +
           &GRP3 &GRP4 &GRP5 &GRP6)
  END
 
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
SET UID = &STR(        )
 
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