PROC 0                                                                -
  CONSLIST(OFF)              /* DEFAULT IS OFF */                     -
  COMLIST(OFF)               /* DEFAULT IS OFF */                     -
  SYMLIST(OFF)               /* DEFAULT IS OFF */                     -
  TERMMSGS(ON)               /* DEFAULT IS OFF */                     -
  TYPERUN(FSO)               /* Run for SRRAUDIT | FSO   */           -
  CACC1000(CACC1000)         /* SELECT SECURITY CHECK PGM*/           -
  CAAM0527(CAAM0527)         /* EDIT MACRO USERLIST report */         -
  USERLDSN(NULLFILE)         /* LIST dataset name        */           -
  USERRDSN(NULLFILE)         /* RACF report dataset name */           -
  PDIDDN(PDIDD)              /* PDI DDNAME IN JCL          */         -
  DIALDDN(DIALOG)            /* DIALOG DDNAME IN JCL       */         -
  USERLDDN(USERLIST)         /* USERLIST DDNAME IN JCL     */         -
  USERRDDN(USERREPT)         /* ACP REPORT DDNAME IN JCL   */         -
  TRACE(OFF)                 /* TRACE ACTIONS AND ERRORS */
 
/* 11/16/2005 JL Nelson Copied from CAAC0501.
/* 10/01/2010 CL Fenton Ensured that all information is collected for
/*            each logon id.
/* 11/24/2010 CL Fenton Correct problem that cause 912 in CAAM0527.
/*            Problem comes from writing record that exceed LRECL.
/*            Corrected addition problem with obtaining TSO logonid.
/* 12/03/2010 CL Fenton Correct problem on processing TSO entries
/*            as well as the TSO logonid.
/* 04/08/2011 CL Fenton Stream lined process to drop the number
/*            of GRPx variables and to evaluate UIDFLDS for each
/*            record. CSD-AR002675967 and CSD-AR002675979.
/* 09/12/2011 CL Fenton Added collection of additional information
/*            for further automation, CSD-AR002893724.
/* 05/31/2013 CL Fenton Added collection of LIDZMAX and LIDZMIN for
/*            the evaluation of ACF0570, STS-000796.
/* 07/26/2013 CL Fenton Chgd evaluation of field F1 and its size,
/*            this includes expanding the key words in positions
/*            2 thru 22, STS-002573.
/* 06/29/2021 CL Fenton Chgs to remove ACF0570, STS-026845.
/* 12/03/2025 CL Fenton Change to remove LMCOMP.
 
SET PGMNAME = &STR(CAAC0527 12/03/25)
 
NGLOBAL USRID USRNAM NR PGMNAME
NGLOBAL GRP0  GRP1  GRP2  GRP3  GRP4  GRP5  GRP6  GRP7  GRP8  GRP9
NGLOBAL GRP10 GRP11 GRP12 GRP13 GRP14 GRP15 GRP16 GRP17 GRP18 GRP19
NGLOBAL GRP20 GRP21 GRP22 GRP23 GRP24 GRP25 GRP26 GRP27 GRP28 GRP29
NGLOBAL GRP30 GRP31 GRP32 GRP33 GRP34 GRP35 GRP36 GRP37 GRP38 GRP39
NGLOBAL DATAID DATAMEM RETURN_CODE UID USRL_LRECL CNT
 
ISPEXEC CONTROL ERRORS RETURN
 
/* ERROR ROUTINE */
ERROR DO
  SET RETURN_CODE = &LASTCC      /* SAVE LAST ERROR CODE */
  IF &LASTCC GT 16 AND +
     &LASTCC NE 400 THEN         /* End of file */ +
    WRITE &PGMNAME LASTCC = &LASTCC &ZERRLM
  RETURN
  END
 
SET SYSPROMPT = OFF                /* CONTROL NOPROMPT          */
SET SYSFLUSH  = OFF                /* CONTROL NOFLUSH           */
SET SYSASIS   = ON                 /* CONTROL ASIS - caps off   */
 
IF &TRACE = ON THEN DO              /* TURN messages on          */
  SET TERMMSGS = ON                 /* CONTROL MSG               */
  SET COMLIST  = ON                 /* CONTROL LIST              */
  SET CONSLIST = ON                 /* CONTROL CONLIST           */
  SET SYMLIST  = ON                 /* CONTROL SYMLIST           */
  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         */
 
SET ZISPFRC = 0
SET RETURN_CODE = 0
 
ISPEXEC VPUT (ZISPFRC) SHARED
 
/* Called from CACC0501
/* ISPEXEC VPUT (ZISPFRC) SHARED
 
ISPEXEC VPUT ( +
  SYMLIST      +
  CONSLIST     +
  COMLIST      +
  TERMMSGS     +
  TYPERUN      +
  ) ASIS
 
SET AC527VP = &RETURN_CODE
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME VPUT RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
SET RETURN_CODE = 0
 
ISPEXEC SELECT CMD(&CACC1000 ACP)
 
ISPEXEC VGET ( +
  ACPNAME      +
  ACPVERS      +
  UIDFLDS      +
  UIDLNTH      +
  ) ASIS
 
GOTO BYPASS_UIDFLDS
SET UIDFLDS = &STR(PHYACT COSTCTR TYPEUSER USERFUNC LOCALUSE LID)
SET UIDLNTH = 23
ISPEXEC VPUT ( +
  ACPNAME      +
  ACPVERS      +
  UIDFLDS      +
  UIDLNTH      +
  ) ASIS
 
BYPASS_UIDFLDS: +
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
 
/* *************************************** */
/* INITIALIZE LIBRARY MANAGEMENT           */
/* *************************************** */
 
LISTDSI &USERLDDN FILE
 
IF &RETURN_CODE EQ 0 THEN DO
   SET USERLDSN = &SYSDSNAME
   SET LISTDSI_USER_MSGLVL2 = &STR(&SYSMSGLVL2)
   END
ELSE DO
   WRITE &PGMNAME Unable to determine LIST DSNAME SYSREASON &SYSREASON
   WRITE &PGMNAME &STR(&SYSMSGLVL1)
   WRITE &PGMNAME &STR(&SYSMSGLVL2)
   SET RETURN_CODE = 12
   GOTO ERR_EXIT
   END
 
IF &SYSINDEX(&STR(V),&STR(&SYSRECFM)) EQ 0 THEN +
  SET USRL_LRECL = &SYSLRECL
ELSE +
  SET USRL_LRECL = &SYSLRECL - 4
 
LISTDSI &USERRDDN FILE
 
IF &RETURN_CODE EQ 0 THEN DO
   SET USERRDSN = &SYSDSNAME
   SET LISTDSI_USER_MSGLVL2 = &STR(&SYSMSGLVL2)
   END
ELSE DO
   WRITE &PGMNAME Unable to determine REPT DSNAME SYSREASON &SYSREASON
   WRITE &PGMNAME &STR(&SYSMSGLVL1)
   WRITE &PGMNAME &STR(&SYSMSGLVL2)
   SET RETURN_CODE = 12
   GOTO ERR_EXIT
   END
 
IF &TRACE EQ ON THEN DO
  WRITE &PGMNAME Input file  &USERRDSN
  WRITE &PGMNAME Output file &USERLDSN
  END
 
SET RETURN_CODE = 0
 
ISPEXEC LMINIT DATAID(LISTUID) DDNAME(&USERRDDN)
 
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(&USERLDDN)
 
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 LP     = &STR((
SET RP     = )
SET CNT    = 0
SET NR     = 0
SET NRM    = 39
SET XN     = &UIDLNTH + 22
SET BLK10  = &STR(          )
SET UID    = &STR( )
SET USRID  = &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:22,&STR(&LISTU))
 
SET SW =
SET A = 1
DO WHILE &A LT &LENGTH(&STR(&UIDFLDS))
  SET B = &SYSINDEX(&STR( ),&STR(&UIDFLDS ),&A) - 1
  SET ATTR = &SUBSTR(&A:&B,&STR(&UIDFLDS))
  SET C = &SYSINDEX(&STR( &ATTR&LP),&NRSTR(&LISTU)) + 1
  IF &C GT 1 THEN DO
    SET SW = &STR(Y)
    SET D = &SYSINDEX(&STR( ),&NRSTR(&LISTU ),&C) - 1
    SET NR = &NR + 1
    SET GRP&NR = &SUBSTR(&C:&D,&NRSTR(&LISTU))
    END
  SET A = &B + 2
  END
 
SELECT &STR(&F1)
  WHEN (        ) GOTO BLANK
  WHEN (ACCESS  ) GOTO SET_OF1
  WHEN (CICS    ) GOTO CICS
  WHEN (IMS     ) GOTO SET_OF1
  WHEN (IDMS    ) GOTO SET_OF1
  WHEN (MUSASS  ) GOTO PROCESS_INFO
  WHEN (PASSWORD) GOTO PASSWORD
  WHEN (PRIVILEGES) GOTO PROCESS_INFO
  WHEN (RESTRICTIONS) GOTO RESTRICT
  WHEN (STATISTICS) GOTO SET_OF1
  WHEN (TSO     ) GOTO TSO
  WHEN (&STR(CANCEL/SUSPEND)) GOTO PROCESS_INFO
  OTHERWISE DO
    SET OF1 = &STR(&F1)
/*  IF &STR(&USRID) NE &STR( ) THEN GOTO READRF
    END
  END
 
PROCESS_USRID: +
IF &NRSTR(&USRID) EQ &STR( ) AND +
  &SUBSTR(1,&NRSTR(&LISTU)) EQ &STR( ) THEN DO
  SET USRID  = &SUBSTR(1:8,&STR(&F1))
  SET USRID  = &SUBSTR(1:8,&USRID&BLK10)
  SET USRNAM = &SUBSTR(&XN+2:&XN+21,&STR(&LISTU))
  SET UID    = &SUBSTR(23:&XN,&STR(&LISTU))
  SET OF1    =
  END
 
GOTO READRF
 
 
BLANK: +
IF &STR(&LISTU) EQ &STR( ) THEN DO
  IF &NR GT 0 THEN SYSCALL PUT_DATA
  GOTO READRF
  END
 
SELECT &STR(&OF1)
  WHEN (CICS    ) GOTO CICS
  WHEN (MUSASS  ) GOTO PROCESS_INFO
  WHEN (PASSWORD) GOTO PASSWORD
  WHEN (PRIVILEGES) GOTO PROCESS_INFO
  WHEN (RESTRICTIONS) GOTO RESTRICT
  WHEN (TSO     ) GOTO TSO
  WHEN (&STR(CANCEL/SUSPEND)) GOTO PROCESS_INFO
  END
 
GOTO READRF
 
 
SET_OF1: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
GOTO READRF
 
 
CICS: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
SET RETURN_CODE = 0
 
SET XF = &SYSINDEX(&STR(IDLE),&STR(&LISTU),23)
 
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 = &STR(&ATTR)
    END
  END
 
GOTO READRF
 
 
PROCESS_INFO: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
SET RETURN_CODE = 0
 
DO X = &LENGTH(&STR(&LISTU)) TO 23 BY -1 +
  WHILE &SUBSTR(&X,&STR(&LISTU)) EQ &STR( )
END
SET PROCESS_INFO = &SUBSTR(23:&X,&STR(&LISTU))
IF &STR(&PROCESS_INFO) EQ &STR( ) THEN GOTO READRF
SET NR = &NR + 1
SET GRP&NR = &STR(&PROCESS_INFO)
 
GOTO READRF
 
 
PASSWORD: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
SET RETURN_CODE = 0
SET XF = &SYSINDEX(&STR(MAXDAYS),&STR(&LISTU),23)
 
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 = &STR(&ATTR)
    END
  END
 
SET XF = &SYSINDEX(&STR(MINDAYS),&STR(&LISTU),23)
 
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 = &STR(&ATTR)
    END
  END
 
SET XF = &SYSINDEX(&STR(LIDZMAX),&STR(&LISTU),23)
 
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 = &STR(&ATTR)
    END
  END
 
SET XF = &SYSINDEX(&STR(LIDZMIN),&STR(&LISTU),23)
 
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 = &STR(&ATTR)
    END
  END
 
GOTO READRF
 
 
RESTRICT: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
SET RETURN_CODE = 0
SET TBL = &STR(AUTHSUP1 GROUP&LP PREFIX&LP SOURCE&LP)
 
DO X = 1 TO &LENGTH(&STR(&TBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TBL ),&X)
  SET FLD = &SUBSTR(&X:&Y-1,&STR(&TBL ))
  SET X = &Y
  SET XF = &SYSINDEX(&STR( &FLD),&STR(&LISTU),22) + 1
 
  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 = &STR(&ATTR)
      END
    END
  END
 
GOTO READRF
 
 
TSO: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
SET RETURN_CODE = 0
 
SET TSOTBL = &STR(ACCTPRIV ALLCMDS INTERCOM NOINTERCOM NOLGN-ACCT +
  LGN-ACCT NOMAIL MAIL MOUNT NOMSGID MSGID NONOTICES NOTICES +
  NOOPERATOR OPERATOR NOPROMPT PROMPT TSOPROC NOVLD-PROC +
  VLD-PROC)
 
SET FLDFND =
DO X = 1 TO &LENGTH(&STR(&TSOTBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TSOTBL ),&X)
  SET FLD = &SUBSTR(&X:&Y-1,&STR(&TSOTBL ))
  SET X = &Y
  SET XF = &SYSINDEX(&STR( &FLD),&STR(&LISTU),22) + 1
 
  SET XC = &SYSINDEX(&STR( ),&STR(&LISTU),&XF)
  IF &XC-1 GT &XF THEN DO
    SET FLDFND = X
    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 = &STR(&ATTR)
      END
    END
  END
 
IF &STR(&FLDFND) EQ &STR( ) THEN GOTO PROCESS_USRID
 
GOTO READRF
 
 
EOF_LISTUSER: +
SET RETURN_CODE = 0
 
IF &NR GT 0 THEN SYSCALL PUT_DATA
 
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 LMINIT DATAID(PDIID) DDNAME(&PDIDDN)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMINIT &PDIDDN RC = &RETURN_CODE  &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMINIT DATAID(DIALOG) DDNAME(&DIALDDN)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMINIT &DIALDDN RC = &RETURN_CODE  &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMOPEN DATAID(&PDIID) OPTION(OUTPUT)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMOPEN &PDIDDN RC = &RETURN_CODE  &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMOPEN DATAID(&DIALOG)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMOPEN &DIALDDN RC = &RETURN_CODE  &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
SET RETURN_CODE = 0
 
/* *************************************** */
/* PUT VARS IN POOL                        */
/* *************************************** */
 
ISPEXEC VPUT ( +
  PDIID        +
  DIALOG       +
  ) ASIS
 
SET RETURN_CODE = 0
 
ISPEXEC EDIT DATAID(&DATAID) MACRO(&CAAM0527)
 
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME VIEW_USERLIST_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
SET RETURN_CODE = 0
 
ISPEXEC LMCLOSE DATAID(&PDIID)
SET LMCLOSE_PDI_RC = &RETURN_CODE
SET RETURN_CODE = 0
 
/*ISPEXEC LMCOMP DATAID(&PDIID)
SET LMCOMP_PDI_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 Input file  &USERRDSN
WRITE &PGMNAME Output file &USERLDSN
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 +
  SET DATA = &STR(&USRID &USRNAM &UID)
ELSE +
  SET DATA = &STR(&USRID &USRNAM)
 
DO X = 1 TO &NR
  SET GRP = &&GRP&X
  SET GRP = &STR(&GRP)
  SET DATA = &STR(&DATA &GRP)
  END
 
IF &LENGTH(&STR(&DATA)) GT &USRL_LRECL THEN +
  WRITE &PGMNAME Record not created for &USRID length is +
    &LENGTH(&STR(&DATA)).
ELSE DO
  ISPEXEC LMPUT DATAID(&DATAID) MODE(INVAR) DATALOC(DATA) +
    DATALEN(&LENGTH(&STR(&DATA)))
  SET CNT = &CNT + 1
  END
 
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( )
SET USRID  = &STR( )
 
END
