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*/           -
  CATM0527(CATM0527)         /* EDIT MACRO USERLIST report */         -
  USERLDSN(NULLFILE)         /* LIST dataset name        */           -
  USERRDSN(NULLFILE)         /* RACF report dataset name */           -
  PDIDDN(PDIDD)              /* PDI DDNAME IN JCL          */         -
  TBLDDN(TABLE)              /* TABLE 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.
/* 02/15/2011 CL Fenton Added addition collection data for addition PDIs.
/* 09/12/2011 CL Fenton Chgs to add TABLE for additional analisys.
/* 01/11/2012 CL Fenton Corrected error on SUBSTR cc 912 on blank &F1.
/* 01/02/2013 CL Fenton Corrected offset on interval on PASSWORD w/
/*            *NOPW* specified, STS-001499.
/* 07/22/2013 CL Fenton Issue with identifing more GRPxx entries,
/*            additional entries specified, STS-003500.
/* 06/02/2014 CL Fenton Added collection of BYPASSING, STS-005665.
/* 03/03/2020 CL Fenton Added PHRASE INTERVAL for evaluation, STS-023663.
 
SET PGMNAME = &STR(CATC0527 03/03/20)
 
NGLOBAL USRID USRNAM NR TYPE INTERVAL TSOLPROC PASSWORD PGMNAME
NGLOBAL PHRASE PHRINT
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 GRP40 GRP41 GRP42 GRP43 GRP44 GRP45 GRP46 GRP47 GRP48 GRP49
NGLOBAL GRP50 GRP51 GRP52 GRP53 GRP54 GRP55 GRP56 GRP57 GRP58 GRP59
NGLOBAL GRP60 GRP61 GRP62 GRP63 GRP64 GRP65 GRP66 GRP67 GRP68 GRP69
NGLOBAL GRP70 GRP71 GRP72 GRP73 GRP74 GRP75 GRP76 GRP77 GRP78 GRP79
NGLOBAL GRP80 GRP81 GRP82 GRP83 GRP84 GRP85 GRP86 GRP87 GRP88 GRP89
NGLOBAL GRP90 GRP91 GRP92 GRP93 GRP94 GRP95 GRP96 GRP97 GRP98 GRP99
NGLOBAL GRP100 GRP101 GRP102 GRP103 GRP104 GRP105 GRP106 GRP107 GRP108 GRP109
NGLOBAL GRP110 GRP111 GRP112 GRP113 GRP114 GRP115 GRP116 GRP117 GRP118 GRP119
NGLOBAL DATAID DATAMEM RETURN_CODE USRL_LRECL
 
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      +
  ) ASIS
 
IF &STR(&ACPNAME) NE &STR(TSS) THEN DO
  WRITE &PGMNAME TSS 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 &SYSREASON 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 &SYSREASON 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 TNR    = 0
SET BLK10  = &STR(          )
SET USRID  = &STR(        )
SET PASSWORD = &STR(N)
SET TSOLPROC = &STR(        )
SET INTERVAL = &STR(   )
SET PHRASE = &STR(N)
SET PHRINT = &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(1:10,&STR(&LISTU))
 
SELECT &STR(&F1)
  WHEN (          ) GOTO BLANK
  WHEN (ACCESSORID) GOTO ACCESSORID
  WHEN (TYPE      ) GOTO TYPE
  WHEN (FACILITY  ) DO
    SET IND = &STR(F)
    GOTO GRP_PROF
    END
  WHEN (MASTER FAC) DO
    SET IND = &STR(M)
    GOTO GRP_PROF
    END
  WHEN (PROFILES  ) DO
    SET IND = &STR(P)
    GOTO GRP_PROF
    END
  WHEN (GROUPS    ) DO
    SET IND = &STR(G)
    GOTO GRP_PROF
    END
  WHEN (BYPASSING ) GOTO ATTRIBUTES
  WHEN (SOURCES   ) GOTO ATTRIBUTES
  WHEN (TSOLPROC  ) DO
    SET TSOLPROC = &SUBSTR(14:21,&STR(&LISTU&BLK10&BLK10))
    END
  WHEN (PASSWORD  ) DO
    SET PASSWORD = &SUBSTR(14:21,&STR(&LISTU&BLK10&BLK10&BLK10&BLK10))
    IF &NRSTR(&PASSWORD) EQ &STR( ) OR +
       &NRSTR(&PASSWORD) EQ &STR(*NOPW*) THEN DO
      SET INTERVAL = &SUBSTR(60:62,&STR(&LISTU&BLK10&BLK10&BLK10&BLK10))
      SET PASSWORD = &SUBSTR(1:1,&PASSWORD)
      END
    ELSE DO
      SET INTERVAL = &SUBSTR(61:63,&STR(&LISTU&BLK10&BLK10&BLK10&BLK10))
      SET PASSWORD = &STR(X)
      END
    END
  WHEN (PHRASE    ) DO
    SET PHRASE = &SUBSTR(14,&STR(&LISTU&BLK10&BLK10&BLK10&BLK10))
    ISPEXEC LMGET DATAID(&LISTUID) MODE(INVAR) DATALOC(LISTU) +
      DATALEN(LRECL) MAXLEN(255)
    IF &NRSTR(&PHRASE) EQ &STR( ) THEN +
      SET PHRINT = &SUBSTR(59:61,&STR(&LISTU&BLK10&BLK10&BLK10&BLK10))
    ELSE +
      SET PHRINT = &SUBSTR(59:61,&STR(&LISTU&BLK10&BLK10&BLK10&BLK10))
    END
  WHEN (ATTRIBUTES) GOTO ATTRIBUTES
  OTHERWISE SET OF1 = &NRSTR(&F1)
  END
 
GOTO READRF
 
 
BLANK: +
IF &STR(&LISTU) EQ &STR( ) THEN DO
  IF &NR GT &TNR THEN SET TNR = &NR
  IF &NR GT 0 THEN SYSCALL PUT_DATA
  GOTO READRF
  END
 
SELECT &STR(&OF1)
  WHEN (FACILITY  ) DO
    SET IND = &STR(F)
    GOTO GRP_PROF
    END
  WHEN (MASTER FAC) DO
    SET IND = &STR(M)
    GOTO GRP_PROF
    END
  WHEN (PROFILES  ) DO
    SET IND = &STR(P)
    GOTO GRP_PROF
    END
  WHEN (GROUPS    ) DO
    SET IND = &STR(G)
    GOTO GRP_PROF
    END
  WHEN (BYPASSING ) GOTO ATTRIBUTES
  WHEN (SOURCES   ) GOTO ATTRIBUTES
  WHEN (ATTRIBUTES) GOTO ATTRIBUTES
  END
 
GOTO READRF
 
 
ACCESSORID: +
IF &NRSTR(&USRID) NE &STR( ) AND +
   &NR GT 0 THEN SYSCALL PUT_DATA
SET CNT = &CNT + 1
 
SET USRID  = &SUBSTR(14:21,&STR(&LISTU))
SET USRNAM = &SUBSTR(37:57,&STR(&LISTU&BLK10&BLK10))
 
GOTO READRF
 
 
TYPE: +
SET TYPE = &SUBSTR(14:21,&STR(&LISTU&BLK10))
 
SELECT &NRSTR(&TYPE)
  WHEN (USER    ) SET TYPE = &STR(USER    )
  WHEN (CENTRAL ) SET TYPE = &STR(SCA     )
  WHEN (MASTER  ) SET TYPE = &STR(MSCA    )
  WHEN (LIMITED ) SET TYPE = &STR(LSCA    )
  WHEN (&STR(DEPT C/A)) SET TYPE = &STR(DCA     )
  WHEN (&STR(DIV  C/A)) SET TYPE = &STR(VCA     )
  WHEN (&STR(ZONE C/A)) SET TYPE = &STR(ZCA     )
  WHEN (GENERIC ) SET TYPE = &STR(USER    )
  WHEN (GROUP   ) SET TYPE = &STR(GROUP   )
  WHEN (PROFILE ) SET TYPE = &STR(PROFILE )
  WHEN (DEPT    ) SET TYPE = &STR(DEPT    )
  WHEN (DIV     ) SET TYPE = &STR(DIV     )
  WHEN (DIVISION) SET TYPE = &STR(DIVISION)
  WHEN (ZONE    ) SET TYPE = &STR(ZONE    )
  OTHERWISE DO
    WRITE &PGMNAME Invalid TYPE &TYPE was found for report
    SET USRID = &STR( )
    END
  END
 
GOTO READRF
 
 
GRP_PROF: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
SET RETURN_CODE = 0
 
/*DO X = &LENGTH(&STR(&LISTU)) TO 12 BY -1 +
/*  WHILE &SUBSTR(&X,&STR(&LISTU)) EQ &STR( )
/*END
/*SET LISTU = &SUBSTR(1:&X,&STR(&LISTU))
DO X = 14 TO &LENGTH(&STR(&LISTU)) BY 10 +
  WHILE &SUBSTR(&X,&STR(&LISTU&BLK10&BLK10)) NE &STR( )
  SET NR = &NR + 1
  SET Y   = &SYSINDEX(&STR( ),&STR(&LISTU&BLK10),&X)
  SET GRP = &SUBSTR(&X:&Y-1,&STR(&LISTU&BLK10))
  SET GRP&NR = &STR(&IND&LP&GRP&RP)
END
 
GOTO READRF
 
 
ATTRIBUTES: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
SET RETURN_CODE = 0
IF &TYPE = &STR(PROFILE) THEN GOTO READRF
 
DO X = &LENGTH(&STR(&LISTU)) TO 12 BY -1 +
  WHILE &SUBSTR(&X,&STR(&LISTU)) EQ &STR( )
END
SET LISTU = &SUBSTR(1:&X,&STR(&LISTU))
DO X = 14 TO &LENGTH(&STR(&LISTU)) BY 1 +
  WHILE &SUBSTR(&X,&STR(&LISTU&BLK10&BLK10)) NE &STR( )
  SET Y = &SYSINDEX(&STR(,),&STR(&LISTU)&STR(,),&X)
  SET NR = &NR + 1
  SET GRP&NR = &SUBSTR(&X:&Y-1,&STR(&LISTU&BLK10))
  SET X = &Y
END
 
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
 
GOTO READRF
 
 
PRIV: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
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 = &STR(&ATTR)
    SET XF = &XC+1
    GOTO NEXT_ATTR
    END
  END
 
GOTO READRF
 
 
RESTRICT: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
SET RETURN_CODE = 0
SET XF = &SYSINDEX(&STR(AUTHSUP1),&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(GROUP&LP),&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(PREFIX&LP),&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
 
 
TSO: +
IF &STR(&F1) NE &STR( ) THEN +
  SET OF1 = &STR(&F1)
 
SET RETURN_CODE = 0
 
SET TSOTBL = &STR(ALLCMDS NOINTERCOM NOLGN-ACCT LGN-ACCT NOMAIL MAIL +
  MOUNT NOMSGID MSGID NONOTICES NOTICES NOOPERATOR OPERATOR NOPROMPT +
  PROMPT TSOPROC NOVLD-PROC VLD-PROC)
 
DO X = 1 TO &LENGTH(&STR(&TSOTBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TSOTBL ),&X)
  SET FLD = &SUBSTR(&X:&Y,&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 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
 
 
EOF_LISTUSER: +
SET RETURN_CODE = 0
 
IF &NR GT 0 THEN SYSCALL PUT_DATA
 
WRITE &PGMNAME The max number of entries is &TNR..
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 LMINIT DATAID(TABLEID) DDNAME(&TBLDDN)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMINIT &TBLDDN 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
 
ISPEXEC LMOPEN DATAID(&TABLEID)
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMOPEN &TBLDDN 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       +
  TABLEID      +
  ) ASIS
 
SET RETURN_CODE = 0
 
ISPEXEC EDIT DATAID(&DATAID) MACRO(&CATM0527)
 
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 TSS 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
 
SET DATA = &STR(&USRID &USRNAM &TYPE&PASSWORD&INTERVAL+
  &PHRASE&PHRINT&TSOLPROC)
 
DO X = 1 TO &NR
  SET GRP = &&GRP&X
  SET GRP = &STR(&GRP)
  IF &SYSINDEX(&NRSTR( &GRP ),&NRSTR(&DATA )) EQ 0 THEN +
    SET DATA = &STR(&DATA &GRP)
  END
 
IF &LENGTH(&STR(&DATA)) GT &USRL_LRECL THEN +
  WRITE &PGMNAME Record created for &USRID but length is +
    &LENGTH(&STR(&DATA)) which is over &USRL_LRECL..
 
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
  WRITE &PGMNAME Error occurred in &NRSTR(&USRID)
  SET RETURN_CODE = &RETURN_CODE + 16
  END
 
SET PASSWORD = &STR(N)
SET TSOLPROC = &STR(        )
SET INTERVAL = &STR(   )
SET PHRASE = &STR(N)
SET PHRINT = &STR(   )
DO X = 1 TO &NR
  SET GRP&X = &STR(        )
  END
SET NR = 0
 
END