ISREDIT MACRO       /* CATM0420 EDIT TEMP6(iter)  */
 
/* EDIT MACRO SEARCHES FOR FINDINGS
 
/* 05/25/2004 JL Nelson CHANGED TO DISPLAY NEW FINDINGS
/* 06/15/2004 JL Nelson ADDED EXIT CODE
/* 07/08/2004 JL Nelson copied from CARM0420 for TSS
/* 07/15/2004 JL Nelson Changed DISA Standard to STIG requirement
/* 11/15/2004 JL Nelson Added code for Authorized users
/* 12/06/2004 JL Nelson Changed STIG message to match AUUACC
/* 12/20/2004 JL Nelson Added SCRATCH and NOCREATE to SELECT list
/* 12/22/2004 JL Nelson Adjust access levels
/* 01/14/2005 JL Nelson Made AULOG and AUUACC fixed length
/* 01/25/2005 JL Nelson Changed to add dslist to PDIs
/* 01/28/2005 JL Nelson Drop users in PROFILEs if also as USER
/* 02/09/2005 JL Nelson Changed constants to variables before rename
/* 03/10/2005 JL Nelson Changed LMMREP to LMMADD/LMMREP to avoid errors
/* 06/08/2005 JL Nelson Pass MAXCC in ZISPFRC variable
/* 06/10/2005 JL Nelson Fixed error 828 IF &TYPE EQ &STR(USER=)
/* 06/15/2005 JL Nelson Set return code to end job step
/* 08/23/2005 JL Nelson Added code for Global Auditing by datasets.
/* 03/15/2006 JL Nelson Made changes to avoid SUBSTR abend 920/932.
/* 03/21/2006 JL Nelson Use NRSTR avoid abend 900 if ampersand in data.
/* 03/30/2006 JL Nelson Test for empty member LINENUM Rcode = 4.
/* 05/16/2006 JL Nelson Execute TSSSIM to eliminate false findings ACC.
/* 05/22/2006 JL Nelson Check for generic userid before calling TSSSIM.
/* 06/01/2006 JL Nelson Added Dataset name to detail line for TSSSIM
/* 09/29/2006 CL Fenton Added test for execution of TSSSIM process.
/* 10/23/2006 CL Fenton Chgd test for which accesses to ignore to use
/*            AUUACC_LVL over access in record.
/* 03/31/2008 CL Fenton Script modified to use new input information.
/* 04/08/2008 CL Fenton Corrected INSUFFICIENT STORAGE by collecting
/*            250 ACIDs in ACIDLIST variable.
/* 05/05/2008 CL Fenton Various corrections to correct issues found
/*            by site evaluating process.
/* 05/05/2008 CL Fenton chgs to use NRSTR.
/* 02/16/2010 CL Fenton added CUR_DATA test for blank bef writing record,
/*            to prevent 932 error.  Repossioned cursor after excluding
/*            all '2*NONE*  ' records.
/* 06/03/2010 CL Fenton chgd evaluation of DDDSNS for ACP00120.
/* 06/17/2011 CL Fenton chg to allow TSTCAUDT for TSS1010.
/* 09/22/2011 CL Fenton chg exclude for above to point to proper column.
/* 06/05/2012 CL Fenton Chgs to allow use of AUACCESS for authorized
/*            users list to prevent the possible "IKJ56548I INSUFFICIENT
/*            STORAGE FOR CLIST TO CONTINUE" message from occurring when
/*            a DIALOG user group contains an excessive number of user,
/*            CSD-AR003400969.
/* 01/25/2013 CL Fenton Chgs to correct logging process for TSS1010 in
/*            obtaining DIALOG data set, STS-001724.
/* 06/14/2018 CL Fenton Deleted TSS_SIM PROC.
/* 02/07/2023 CL Fenton Corrected issue with DSNLIST by removing
/*            excess space in field, STS-029392.
 
SET PGMNAME = &STR(CATM0420 02/07/23)
 
NGLOBAL PGMNAME RETURN_CODE AUUACC_LVL AULOG_LVL RPTMBR
NGLOBAL Y0 M PDIDD CUR_DATA
 
SET SYSPROMPT = OFF                /* CONTROL NOPROMPT          */
SET SYSFLUSH  = OFF                /* CONTROL NOFLUSH           */
SET SYSASIS   = ON                 /* CONTROL ASIS - caps off   */
SET BYPTSIM = ON
 
/* ERROR ROUTINE */
ERROR DO
  SET RETURN_CODE = &LASTCC          /* SAVE LAST ERROR CODE */
  IF &LASTCC GE 16 THEN +
    WRITE &PGMNAME LASTCC = &LASTCC &ZERRLM
  RETURN
  END
 
/* *************************************** */
/* VARIABLES ARE PASSED TO THIS MACRO      */
/* CONSLIST                                */
/* COMLIST                                 */
/* TERMMSGS                                */
/* *************************************** */
 
ISPEXEC CONTROL NONDISPL ENTER
ISPEXEC CONTROL ERRORS RETURN
 
SET RETURN_CODE = 0
 
ISPEXEC VGET ( +
  CONSLIST     +
  COMLIST      +
  SYMLIST      +
  TERMMSGS     +
  PDIMBR       +
  RPTMBR       +
  ODSNAME      +
  CATM0405     +
  AUACCESS     +
  PDIDD        +
  TSSLISTP     +
  TBLUSR       +
  ACPNAME      +
  ) ASIS
 
SET TM20VGET = &RETURN_CODE
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME VGET RC = &RETURN_CODE  &ZERRSM
  WRITE &PGMNAME CONSLIST/&CONSLIST COMLIST/&COMLIST SYMLIST/&SYMLIST +
    TERMMSGS/&TERMMSGS
  WRITE &PGMNAME PDIMBR/&PDIMBR ODSNAME/&ODSNAME +
    TBLUSR/&NRSTR(&TBLUSR)
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
/* *************************************** */
/* TURN ON MESSAGES                        */
/* *************************************** */
 
SET SYSSYMLIST = &SYMLIST          /* CONTROL SYMLIST/NOSYMLIST */
SET SYSCONLIST = &CONSLIST         /* CONTROL CONLIST/NOCONLIST */
SET SYSLIST    = &COMLIST          /* CONTROL LIST/NOLIST       */
SET SYSMSG     = &TERMMSGS         /* CONTROL MSG/NOMSG         */
 
/* *************************************** */
/* MAIN PROCESS                            */
/* *************************************** */
 
ISREDIT (MEMBER) = MEMBER
ISREDIT (DSNAME) = DATASET
SET M = 1
SET Y0 = 0  /* Leading finding statement */
SET Y1 = 0  /* Access authorization      */
SET Y2 = 0  /* Global access             */
SET Y3 = 0  /* Logging                   */
SET Y4 = 0  /* Resource defined with access when should be deny */
 
SET RETURN_CODE = 0
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
IF &RETURN_CODE GT 0 THEN DO    /* Empty RC = 4
  IF &LASTLINE EQ 0 THEN +
    WRITE &PGMNAME Empty file RCode = &RETURN_CODE +
          DSN=&DSNAME  MEMBER=&MEMBER  &ZERRSM
  ELSE +
    WRITE &PGMNAME LINENUM Error RCode = &RETURN_CODE +
          DSN=&DSNAME  MEMBER=&MEMBER  &ZERRSM
  GOTO ERR_EXIT
  END
 
IF &PDIMBR EQ ACP00120 THEN DO
  ISPEXEC SELECT CMD(CACC3000 DD JESPROC &ACPNAME)
  ISPEXEC VGET (DDDSNS) ASIS
  IF &NRSTR(&DDDSNS) NE &STR( ) THEN +
    SYSCALL EXTRACT_DSN DDDSNS
  END
SET BLANK = &STR( )
SET SP10 = &STR(          )
SET SP80 = &STR(&SP10&SP10&SP10&SP10&SP10&SP10&SP10&SP10)
 
SET LP = &STR((
SET RP = )
ISREDIT EXCLUDE ALL '2' 118
ISREDIT DELETE ALL X
 
/************************************************************/
/* Process to expand Profiles and add ACIDS into member     */
/************************************************************/
PROCESS_PROFILE: +
ISREDIT CURSOR = 1 0
SET LINE = 0
 
SET RETURN_CODE = 0
 
ISREDIT FIND 'PROFILE' 56 NX
 
IF &RETURN_CODE GT 0 THEN +
  GOTO PROCESS_PROFILE_END
 
ISREDIT (LINE) = LINENUM .ZCSR
ISREDIT (DATA) = LINE .ZCSR
 
SET CURACID = &SUBSTR(47:54,&NRSTR(&DATA))
 
ISPEXEC VPUT ( +
  CURACID  +
  ) ASIS
 
GET_NEXT_ACIDS: +
SET RETURN_CODE = 0
 
ISPEXEC EDIT DATAID(&TSSLISTP) MACRO(&CATM0405)
 
SET VIEW_TSSLISTP_RC = &RETURN_CODE
 
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME ERROR ON VIEW OF &CATM0405 RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC VGET ( +
  ACIDLIST +
  ACIDNUM +
  ) ASIS
 
ADD_ACIDS: +
SET INFO    = &SUBSTR(1:117,&NRSTR(&DATA))
DO X = 1 TO &LENGTH(&NRSTR(&ACIDLIST)) BY 38
  SET UDATA = &SUBSTR(&X:&X+37,&NRSTR(&ACIDLIST))
 
  SET CMD = &NRSTR(&INFO.2&UDATA)
 
  ISREDIT LINE_AFTER &LINE = (CMD)
 
  SET LINE = &LINE + 1
END
 
ISREDIT EXCLUDE ALL '&INFO' 1
ISREDIT FIND LAST '&INFO' 1
 
ISREDIT CURSOR = &LINE 100
 
SET RETURN_CODE = 0
ISREDIT FIND '&CURACID' 47
 
IF &RETURN_CODE GT 0 THEN DO
  IF &DATATYPE(&ACIDNUM) EQ &STR(NUM) THEN +
    GOTO GET_NEXT_ACIDS
  ISREDIT EXCLUDE ALL '&CURACID' 47
  GOTO PROCESS_PROFILE
  END
 
ISREDIT (LINE) = LINENUM .ZCSR
ISREDIT (DATA) = LINE .ZCSR
 
GOTO ADD_ACIDS
 
 
PROCESS_PROFILE_END: +
SET RETURN_CODE = 0
 
ISREDIT RESET
ISREDIT CURSOR = 1 0
SET LINE = 0
 
 
/************************************************************/
/* Process to remove users that are in profiles and have    */
/* direct access to the dataset.                            */
/************************************************************/
 
 
PROCESS_ACID: +
SET RETURN_CODE = 0
 
ISREDIT FIND 'USER ' 56 NX
 
IF &RETURN_CODE GT 0 THEN +
  GOTO PROCESS_ACID_END
 
ISREDIT (LINE) = LINENUM .ZCSR
ISREDIT (DATA) = LINE .ZCSR
 
SET CURACID = &SUBSTR(47:54,&NRSTR(&DATA))
SET CURDSN  = &SUBSTR(74:117,&NRSTR(&DATA))
 
ISREDIT EXCLUDE ALL '&NRSTR(&CURDSN)2&NRSTR(&CURACID)' 74
 
ISREDIT CURSOR = &LINE 100
 
GOTO PROCESS_ACID
 
PROCESS_ACID_END: +
ISREDIT SEEK ALL ' ' NX
ISREDIT (A,B) = SEEK_COUNTS
ISREDIT SEEK ALL ' ' X
ISREDIT (A1,B1) = SEEK_COUNTS
SET RETURN_CODE = 0
 
ISREDIT DELETE ALL X
SET RETURN_CODE = 0
SET AUUACC_LVL = 0
SET AUUACC     = &STR(NONE    )
SET X  = &SYSINDEX(&STR(UACC  ),&NRSTR(&TBLUSR))
SET XL = &LENGTH(&NRSTR(&TBLUSR))
 
IF &X GT 0 THEN DO
  SET AUUACC_LVL = &SUBSTR(&X+8:&X+8,&NRSTR(&TBLUSR))
  SELECT &AUUACC_LVL
    WHEN (0) SET AUUACC = &STR(NONE    )
    WHEN (1) SET AUUACC = &STR(EXECUTE )
    WHEN (3) SET AUUACC = &STR(READ    )
    WHEN (4) SET AUUACC = &STR(WRITE   )
    WHEN (5) SET AUUACC = &STR(UPDATE  )
    WHEN (6) SET AUUACC = &STR(CONTROL )
    WHEN (9) SET AUUACC = &STR(ALTER   )
    END
  END
 
SET AULOG_LVL = 0
SET AULOG     = &STR(NONE    )
SET X = &SYSINDEX(&STR(LOGGING ),&NRSTR(&TBLUSR))
 
IF &X GT 0 THEN DO
  SET AULOG_LVL = &SUBSTR(&X+8:&X+8,&NRSTR(&TBLUSR))
  SELECT &AULOG_LVL
    WHEN (0) SET AULOG = &STR(NONE    )
    WHEN (1) SET AULOG = &STR(EXECUTE )
    WHEN (3) SET AULOG = &STR(READ    )
    WHEN (4) SET AULOG = &STR(WRITE   )
    WHEN (5) SET AULOG = &STR(UPDATE  )
    WHEN (6) SET AULOG = &STR(CONTROL )
    WHEN (9) SET AULOG = &STR(ALTER   )
    END
  END
 
ISREDIT EXCLUDE ALL 'GENERIC' 56
 
DO X = &AUUACC_LVL TO 0 BY - 1
  ISREDIT EXCLUDE ALL '&X' 72
  ISREDIT (A,B) = EXCLUDE_COUNTS
  END
 
/* *************************************** */
/* Authorized user checks                  */
/* *************************************** */
SET RETURN_CODE = 0
ISPEXEC LMMFIND DATAID(&AUACCESS) MEMBER(&RPTMBR)
 
IF &RETURN_CODE GT 0 THEN GOTO END_USER
 
ISREDIT EXCLUDE ALL 'PROFILE ' 56
ISREDIT FIND ALL '2' 118
 
READ_AUACCESS: +
SET RETURN_CODE = 0
ISPEXEC LMGET DATAID(&AUACCESS) MODE(INVAR) DATALOC(AUREC) +
  DATALEN(LRECL) MAXLEN(255)
 
IF &RETURN_CODE EQ 8 THEN DO
  ISREDIT EXCLUDE ALL '2*NONE*  ' 118
  ISREDIT CURSOR = 1 0
  ISREDIT (LASTLINE) = LINENUM .ZLAST
  SET CURLINE   = 0
  GOTO NEXT_USER
  END
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMGET_AUACCESS_RC = &RETURN_CODE  &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO END_USER
  END
 
SET AULID = &SUBSTR(1:8,&NRSTR(&AUREC))
SET AULVL = &SUBSTR(9,&NRSTR(&AUREC))
SET RETURN_CODE = 0
 
ISREDIT FIND ALL '&NRSTR(&AULID)3' 47
 
IF &RETURN_CODE EQ 0 THEN DO
  ISREDIT CURSOR = 1 0
  SET RETURN_CODE = 0
  DO UNTIL &RETURN_CODE GT 0
    ISREDIT FIND '&NRSTR(&AULID)' 47
    IF &RETURN_CODE EQ 0 THEN DO
      ISREDIT (DATA) = LINE .ZCSR
      SET ALVL  = &SUBSTR(72,&NRSTR(&DATA))
      IF &ALVL LE &AUUACC_LVL OR +
         &ALVL LE &AULVL THEN DO
        ISREDIT XSTATUS .ZCSR = X
        END
      END
    END
  END
 
SET RETURN_CODE = 0
 
ISREDIT FIND ALL '2&NRSTR(&AULID)' 118
 
IF &RETURN_CODE EQ 0 THEN DO
  ISREDIT CURSOR = 1 0
  SET RETURN_CODE = 0
  DO UNTIL &RETURN_CODE GT 0
    ISREDIT FIND '&NRSTR(&AULID)' 119
    IF &RETURN_CODE EQ 0 THEN DO
      ISREDIT (DATA) = LINE .ZCSR
      SET ALVL  = &SUBSTR(72,&NRSTR(&DATA))
      IF &ALVL LE &AUUACC_LVL OR +
         &ALVL LE &AULVL THEN DO
        ISREDIT XSTATUS .ZCSR = X
        END
      END
    END
  END
 
GOTO READ_AUACCESS
 
 
NEXT_USER: +
SET RETURN_CODE = 0
 
SET CURLINE = &CURLINE + 1
IF &CURLINE GT &LASTLINE THEN DO
  ISREDIT EXCLUDE ALL '2*NONE*  ' 118
  ISREDIT CURSOR = 1 0
  GOTO RESET_PROFILE
  END
 
ISREDIT (ST) = XSTATUS &CURLINE
IF &STR(&ST) EQ &STR(X) THEN GOTO NEXT_USER
 
ISREDIT (DATA) = LINE &CURLINE
 
/* *************************************** */
/* CHECK USER / GROUP                      */
/* *************************************** */
 
SET TYPE  = &SUBSTR(56:63,&NRSTR(&DATA))
SET RECT  = &SUBSTR(118,&NRSTR(&DATA))
 
IF &NRSTR(&TYPE) EQ &STR(PROFILE) AND +
   &NRSTR(&RECT) EQ &STR(1) THEN DO
  ISREDIT XSTATUS &CURLINE = X
  GOTO NEXT_USER
  END
 
IF &NRSTR(&TYPE) EQ &STR(PROFILE) THEN +
   SET USER    = &SUBSTR(119:126,&NRSTR(&DATA))
ELSE +
   SET USER    = &SUBSTR(47:54,&NRSTR(&DATA))
 
SET ACCESS  = &SUBSTR(64:71,&NRSTR(&DATA))
SET ALVL    = &SUBSTR(72,&NRSTR(&DATA))
 
IF &ALVL LE &AUUACC_LVL THEN DO
  ISREDIT XSTATUS &CURLINE = X
  GOTO NEXT_USER
  END
 
IF &PDIMBR EQ ACP00120 THEN DO
  SET DSN = &SUBSTR(74:117,&NRSTR(&DATA))
  SET DSN = &DSN
  IF &SYSINDEX(&NRSTR(&DSN ),&NRSTR(&DDDSNS )) GT 0 AND +
     &ALVL LE 3 THEN DO
    ISREDIT XSTATUS &CURLINE = X
    GOTO NEXT_USER
    END
  END
 
GOTO NEXT_USER
 
 
RESET_PROFILE: +
SET RETURN_CODE = 0
 
ISREDIT FIND P'=' 1 NX
 
IF &RETURN_CODE NE 0 THEN DO
  ISREDIT CURSOR = 1 0
  GOTO USERID_NOTAUTH
  END
 
ISREDIT (DATA) = LINE .ZCSR
 
SET TYPE  = &SUBSTR(56:63,&NRSTR(&DATA))
 
IF &NRSTR(&TYPE) NE &STR(PROFILE) THEN +
  GOTO RESET_PROFILE
 
SET INFO  = &SUBSTR(1:117,&NRSTR(&DATA))
 
ISREDIT FIND '&NRSTR(&INFO)1' PREV
 
ISREDIT FIND '&NRSTR(&INFO)2' LAST NX
 
GOTO RESET_PROFILE
 
 
USERID_NOTAUTH: +
SET RETURN_CODE = 0
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET RETURN_CODE = 0
ISREDIT FIND P'=' 1 NX ALL
 
IF &RETURN_CODE NE 0 THEN DO
  GOTO GENERIC_PROCESS
  END
 
SYSCALL STATEMENT_WRITE Y1 TYPE(1)
SET AC = &STR( )
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC)))
 
SET CUR_ADSN =
SET CUR_ACID =
SET CUR_DATA =
SET DSNLIST  =
SET LINE = 0
 
 
WRITE_LOOP: +
SET RETURN_CODE = 0
 
SET LINE = &LINE + 1
IF &LINE GT &LASTLINE THEN DO
  IF &NRSTR(&CUR_DATA ) NE &STR( ) THEN +
    SYSCALL WRITE_ACID
  GOTO GENERIC_PROCESS
  END
 
ISREDIT (ST) = XSTATUS &LINE
IF &STR(&ST) EQ &STR(X) THEN GOTO WRITE_LOOP
 
ISREDIT (DATA) = LINE &LINE
 
SET ADSN   = &SUBSTR(4:46,&NRSTR(&DATA))
SET ACID   = &SUBSTR(47:54,&NRSTR(&DATA))
SET DSN    = &SUBSTR(74:117,&NRSTR(&DATA))
SET ACTION = &SUBSTR(73,&NRSTR(&DATA))
SET REC    = &SUBSTR(118,&NRSTR(&DATA))
IF &REC EQ 2 THEN +
  GOTO WRITE_LOOP
 
IF &NRSTR(&ADSN) NE &NRSTR(&CUR_ADSN) THEN DO
  IF &NRSTR(&CUR_ADSN) NE &STR() THEN DO
    SYSCALL WRITE_ACID
 
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    END
  SET CUR_ADSN = &NRSTR(&ADSN)
  SET CUR_ACID =
  SET DSNLIST  =
  END
 
IF &NRSTR(&ACID) NE &NRSTR(&CUR_ACID) THEN DO
  IF &NRSTR(&CUR_ACID) NE &STR( ) THEN DO
    SYSCALL WRITE_ACID
    END
  SET CUR_ACID = &NRSTR(&ACID)
  SET CUR_DATA = &NRSTR(&DATA)
  END
 
SET CURDSN = &NRSTR(&DSN)
SET BI = &SYSINDEX( ,&NRSTR(&CURDSN ))
SET XDSN = &SUBSTR(1:&BI-1,&NRSTR(&CURDSN ))
 
IF &NRSTR(&DSNLIST) EQ &STR() THEN DO
  SET AC = &NRSTR(     &ADSN)
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
     DATALEN(&LENGTH(&NRSTR(&AC)))
  SET X = 0
  END
ELSE +
  SET X = &SYSINDEX(&NRSTR(&XDSN)#,&NRSTR(&DSNLIST))
/*SET X = &SYSINDEX(&NRSTR(&DSN),&NRSTR(&DSNLIST))
 
IF &X EQ 0  THEN DO
/*SET DSNLIST = &NRSTR(&DSNLIST.&CURDSN.#)
  SET DSNLIST = &NRSTR(&DSNLIST.&XDSN.#)
  SET DSNAUD  = &STR(ACTION&LP.NONE&RP)
 
  IF &ACTION EQ &STR(X) OR +
     &ACTION EQ &STR(Z) THEN +
    SET DSNAUD = &STR(ACTION&LP.AUDIT&RP)
 
  SET DDSN=&NRSTR(          &CURDSN &DSNAUD)
  SET RETURN_CODE = 0
 
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(DDSN) +
      DATALEN(&LENGTH(&NRSTR(&DDSN)))
  END
 
GOTO WRITE_LOOP
 
 
GENERIC_PROCESS: +
ISREDIT CURSOR = 1 0
ISREDIT RESET
 
SET CUR_ADSN =
SET CUR_DATA =
SET DSNLIST  =
 
NEXT_GENERIC: +
SET RETURN_CODE = 0
 
ISREDIT FIND 'GENERIC' 56
 
IF &RETURN_CODE NE 0 THEN DO
  IF &NRSTR(&CUR_DATA) NE &STR( ) THEN +
    SYSCALL WRITE_ACID
  GOTO LOG_PROCESS
  END
 
ISREDIT (DATA) = LINE .ZCSR
ISREDIT (LINE) = LINENUM .ZCSR
 
SET LVL  = &SUBSTR(72,&NRSTR(&DATA))
 
IF &LVL LE &AUUACC_LVL THEN +
  GOTO NEXT_GENERIC
 
ISREDIT (LINE) = LINENUM .ZCSR
 
IF &NRSTR(&CUR_ADSN) EQ &STR( ) THEN DO
  SYSCALL STATEMENT_WRITE Y2 TYPE(2)
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC)))
  END
 
SET ADSN   = &SUBSTR(4:46,&NRSTR(&DATA))
SET ACID   = &SUBSTR(47:54,&NRSTR(&DATA))
SET DSN    = &SUBSTR(74:117,&NRSTR(&DATA))
SET ACTION = &SUBSTR(73,&NRSTR(&DATA))
 
IF &NRSTR(&ADSN) NE &NRSTR(&CUR_ADSN) THEN DO
  IF &NRSTR(&CUR_ADSN) NE &STR() THEN DO
    SYSCALL WRITE_ACID
 
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    END
  SET CUR_ADSN = &NRSTR(&ADSN)
  SET DSNLIST  =
  END
 
SET CUR_DATA = &NRSTR(&DATA)
 
SET CURDSN = &NRSTR(&DSN)
SET BI = &SYSINDEX( ,&NRSTR(&CURDSN ))
SET XDSN = &SUBSTR(1:&BI-1,&NRSTR(&CURDSN ))
 
IF &NRSTR(&DSNLIST) EQ &STR() THEN DO
  SET AC = &NRSTR(     &ADSN)
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
     DATALEN(&LENGTH(&NRSTR(&AC)))
  SET X = 0
  END
ELSE +
  SET X = &SYSINDEX(&NRSTR(&XDSN)#,&NRSTR(&DSNLIST))
/*SET X = &SYSINDEX(&NRSTR(&DSN),&NRSTR(&DSNLIST))
 
IF &X EQ 0  THEN DO
/*SET DSNLIST = &NRSTR(&DSNLIST.&CURDSN.#)
  SET DSNLIST = &NRSTR(&DSNLIST.&XDSN.#)
  SET DSNAUD  = &STR(ACTION&LP.NONE&RP)
 
  IF &ACTION EQ &STR(X) OR +
     &ACTION EQ &STR(Z) THEN +
    SET DSNAUD = &STR(ACTION&LP.AUDIT&RP)
 
  SET DDSN=&NRSTR(          &CURDSN &DSNAUD)
  SET RETURN_CODE = 0
 
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(DDSN) +
      DATALEN(&LENGTH(&NRSTR(&DDSN)))
  END
 
ISREDIT CURSOR = &LINE 100
 
GOTO NEXT_GENERIC
 
 
LOG_PROCESS: +
SET RETURN_CODE = 0
 
/* *************************************** */
/* Check Auditing                          */
/* *************************************** */
 
IF &AULOG_LVL EQ 0 THEN +
  GOTO END_EDIT
 
ISREDIT EXCLUDE ALL P'=' 1
SET RETURN_CODE = 0
ISREDIT FIND ALL 'N' 73
 
IF &RETURN_CODE GT 0 THEN +
  GOTO END_EDIT
 
ISREDIT EXCLUDE ALL '2' 118
 
DO X = &AULOG_LVL - 1 TO 0 BY - 1
  ISREDIT EXCLUDE ALL '&X' 72
  ISREDIT (A,B) = EXCLUDE_COUNTS
  END
 
IF &PDIMBR EQ &STR(TSS1010) THEN DO
  ISREDIT FIND ALL ' ' NX
  ISREDIT (A,B) = FIND_COUNTS
  SYSCALL DIALOG_RTN TSTCAUDT
  ISREDIT FIND ALL ' ' NX
  ISREDIT (A,B) = FIND_COUNTS
  END
 
SET RETURN_CODE = 0
ISREDIT FIND ALL 'N' 73 NX
 
IF &RETURN_CODE GT 0 THEN +
  GOTO END_EDIT
 
SYSCALL STATEMENT_WRITE Y3 TYPE(3)
 
ISREDIT CURSOR = 1 0
 
SET CUR_ADSN =
SET CUR_ACID =
 
 
NEXT_LOG: +
SET RETURN_CODE = 0
 
ISREDIT FIND 'N' 73 NX
 
IF &RETURN_CODE NE 0 THEN +
  GOTO END_EDIT
 
ISREDIT (DATA) = LINE .ZCSR
 
SET ADSN   = &SUBSTR(4:46,&NRSTR(&DATA))
SET ACID   = &SUBSTR(47:54,&NRSTR(&DATA))
SET TYPE   = &SUBSTR(56:63,&NRSTR(&DATA))
SET ACC    = &SUBSTR(64:71,&NRSTR(&DATA))
SET ACTION = &SUBSTR(73,&NRSTR(&DATA))
SET NAME   = &SUBSTR(119:148,&NRSTR(&DATA))
 
IF &NRSTR(&ADSN) NE &NRSTR(&CUR_ADSN) THEN DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC)))
 
  SET AC = &NRSTR(     &ADSN)
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
     DATALEN(&LENGTH(&NRSTR(&AC)))
 
  SET CUR_ADSN = &NRSTR(&ADSN)
  SET CUR_ACID =
  END
 
IF &ACTION EQ &STR(N) OR +
   &ACTION EQ &STR(X) THEN +
  SET ACT = &NRSTR(ACTION&LP.NONE&RP)
ELSE +
  SET ACT = &NRSTR(ACTION&LP.AUDIT&RP)
 
IF &NRSTR(&ACID) NE &NRSTR(&CUR_ACID) THEN DO
  SET AC = &SUBSTR(1:10,&SP80)&NRSTR(&ACID &TYPE NAME=+
    &NAME ACCESS&LP&ACC&RP &ACT)
 
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
     DATALEN(&LENGTH(&NRSTR(&AC)))
 
  SET CUR_ACID = &NRSTR(&ACID)
  END
 
GOTO NEXT_LOG
 
 
END_EDIT: +
SET RETURN_CODE = 0
 
IF &Y0 EQ 0 THEN DO
  SET AC = &STR(Not a Finding)
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME)
  END
 
SET AC = &STR( )
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC)))
 
SET AC = &STR(For complete details see &ODSNAME&LP&RPTMBR&RP..)
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC)))
 
ISPEXEC LMMADD DATAID(&PDIDD) MEMBER(&PDIMBR)
 
IF &RETURN_CODE EQ 4 THEN DO          /* MEMBER ALREADY EXISTS
  SET RETURN_CODE = 0
 
  ISPEXEC LMMREP DATAID(&PDIDD) MEMBER(&PDIMBR)
 
  IF &RETURN_CODE NE 0 THEN DO
    WRITE &PGMNAME LMMREP_PDIDD_RCODE = &RETURN_CODE &PDIMBR  &ZERRSM
    END
  END
ELSE DO
  IF &RETURN_CODE NE 0 THEN +
    WRITE &PGMNAME LMMADD_PDIDD_RCODE = &RETURN_CODE &PDIMBR  &ZERRSM
  END
 
SET RETURN_CODE = 0
 
 
 
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
 
SET TM420RC = &RETURN_CODE
 
ISPEXEC VPUT ( +
  TM20VGET     +
  TM420RC      +
  ) ASIS
 
/* *************************************** */
/* SAVE OUTPUT                             */
/* *************************************** */
 
ISREDIT END
 
EXIT CODE(0)
ISREDIT MEND
 
/* *************************************** */
/*  SYSCALL SUBROUTINES                    */
/* *************************************** */
 
STATEMENT_WRITE: PROC 1 P1 TYPE()
 
IF &TYPE GT 0 THEN +
  SYSCALL STATEMENT_WRITE Y0 TYPE(0)
 
SET RETURN_CODE = 0
SET LP = &STR((
SET RP = )
SYSREF &P1
SET RETURN_CODE = 0
IF &P1 EQ 0 THEN DO
  SET &P1 = &P1 + 1
  SELECT (&TYPE)
    WHEN (0) DO
      SET AC = &STR(The following data set access authorization+
        &LP.s&RP is &LP.are&RP inappropriate:)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
          DATALEN(&LENGTH(&NRSTR(&AC)))
      END
    WHEN (1) DO
      SET AC = &STR( )
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
          DATALEN(&LENGTH(&NRSTR(&AC)))
      IF &AUUACC_LVL LT 5 THEN SET MSGACC = &STR(UPDATE and/or )
      IF &AUUACC_LVL LT 3 THEN SET MSGACC = &STR(READ, UPDATE, and/or )
      IF &AUUACC_LVL LT 1 THEN SET MSGACC = &STR(FETCH, &MSGACC)
      SET TEXT1 = &NRSTR(Data set access authorization does not +
        restrict)
      SET AC = &NRSTR(&M&RP &TEXT1 &MSGACC)
      SET AC1 =
      SELECT &RPTMBR
        WHEN (UADSRPT) DO
          SET AC1 = &NRSTR(&M&RP &TEXT1 ALL access to systems +
            programming  personnel.)
          ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC1) +
            DATALEN(&LENGTH(&NRSTR(&AC1)))
          SET M  = &M  + 1
          SET XA = &SYSINDEX(&STR(, and),&NRSTR(&MSGACC))
          IF &XA EQ 0 THEN +
            SET XA = &SYSINDEX(&STR( and),&NRSTR(&MSGACC))
          SET XB = &SYSINDEX(&STR(, ),&NRSTR(&MSGACC))
          IF &XA GT 0 THEN +
            IF &XB GT 0 THEN +
              SET MSGACC = &SUBSTR(1:&XB-1,&NRSTR(&MSGACC))+
                &STR( and &SUBSTR(&XB+2:&XA-1,&NRSTR(&MSGACC)) )
            ELSE +
              SET MSGACC = &STR(&SUBSTR(1:&XA-1,&NRSTR(&MSGACC)) )
          SET AC = &NRSTR(&M&RP &TEXT1 &MSGACC)
          SET AC1 = &NRSTR(access to systems programming personnel +
            and/or security personnel.)
          END
        WHEN (ACPRPT) DO
          SET AC1 = &STR(ALL access to systems programming personnel +
            and/or security personnel.)
          END
        OTHERWISE DO
          SET AC1 = &STR(ALL access to systems programming personnel.)
          END
        END
 
      SET AC = &NRSTR(&AC.&AC1)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
 
      SET M  = &M  + 1
      SET AC = &NRSTR(&M&RP Justification for access authorization +
        was not provided.)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      SET M  = &M  + 1
      SET Y1 = &Y1 + 1
      END
    WHEN (2) DO
      SET AC = &STR( )
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
          DATALEN(&LENGTH(&NRSTR(&AC)))
      SET AC = &STR(&M&RP Access authorization does not +
        restrict access to the ALL ACID appropriate personnel.)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      SET M  = &M  + 1
      SET AC = &STR(&M&RP Justification for access authorization was +
        not provided.)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
/*    SET AC = &STR( )
/*    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
/*      DATALEN(&LENGTH(&NRSTR(&AC)))
      SET M  = &M  + 1
      END
    WHEN (3) DO
      SET MSGLOG = &STR(ALL)
      IF &AULOG_LVL LT 9 THEN +
        IF &AULOG_LVL LT 4 THEN SET MSGLOG = &STR(UPDATE, and/or +
          &MSGLOG)
        ELSE SET MSGLOG = &STR(UPDATE and/or &MSGLOG)
/*    IF &AULOG_LVL LT 5 THEN SET MSGLOG = &STR(WRITE, &MSGLOG)
      IF &AULOG_LVL LT 4 THEN SET MSGLOG = &STR(READ, &MSGLOG)
      IF &AULOG_LVL LT 3 THEN SET MSGLOG = &STR(FETCH, &MSGLOG)
      IF &AULOG_LVL EQ 0 THEN SET MSGLOG = &STR(None)
      SET AC = &STR( )
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      SET AC = &NRSTR(&M&RP Data set &MSGLOG access is not +
        logged.)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
/*    SET AC = &STR( )
/*    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
/*      DATALEN(&LENGTH(&NRSTR(&AC)))
      SET M  = &M  + 1
      END
    OTHERWISE WRITE INVALID TYPE &TYPE
    END
  END
END
 
 
WRITE_ACID: PROC 0
 
SET LP = &STR((
SET RP = )
SET CUR_ACID = &SUBSTR(47:54,&NRSTR(&CUR_DATA))
SET CUR_TYPE = &SUBSTR(56:63,&NRSTR(&CUR_DATA))
SET CUR_ACC  = &SUBSTR(64:71,&NRSTR(&CUR_DATA))
SET ACTION   = &SUBSTR(73,&NRSTR(&CUR_DATA))
SET CUR_NAME = &SUBSTR(119:148,&NRSTR(&CUR_DATA))
SET CUR_INFO = &SUBSTR(1:117,&NRSTR(&CUR_DATA))
 
SET SP = &STR(                                              )
 
IF &ACTION EQ &STR(N) OR +
   &ACTION EQ &STR(X) THEN +
  SET CUR_ACT = &NRSTR(ACTION&LP.NONE&RP)
ELSE +
  SET CUR_ACT = &NRSTR(ACTION&LP.AUDIT&RP)
 
SET AC = &SUBSTR(1:15,&SP)&NRSTR(&CUR_ACID &CUR_TYPE NAME=+
  &CUR_NAME ACCESS&LP&CUR_ACC&RP &CUR_ACT)
 
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
   DATALEN(&LENGTH(&NRSTR(&AC)))
 
ISREDIT CURSOR = 1 0
 
WRITE_INFO: +
SET RETURN_CODE = 0
 
ISREDIT SEEK '&CUR_INFO.2' 1 NX
 
IF &RETURN_CODE GT 0 THEN +
  GOTO END_INFO
 
ISREDIT (DATA) = LINE .ZCSR
 
SET ACID = &SUBSTR(119:126,&NRSTR(&DATA))
SET NAME = &SUBSTR(127:156,&NRSTR(&DATA))
SET AC = &SUBSTR(1:20,&SP)&NRSTR(USER=&ACID NAME=&NAME)
 
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
   DATALEN(&LENGTH(&NRSTR(&AC)))
 
GOTO WRITE_INFO
 
END_INFO: +
RETURN CODE(&RETURN_CODE)
 
END
 
 
EXTRACT_DSN: PROC 1 P1
 
SET DSN =
SYSREF &P1
SET RETURN_CODE = 0
SET X = &SYSINDEX(//RECFILE,&NRSTR(&P1))
IF &X GT 0 THEN DO
  SET Y = &SYSINDEX(&STR( //),&NRSTR(&P1),&X+1)
  IF &Y EQ 0 THEN SET &Y = &LENGTH(&P1) + 2
  SET X = &SYSINDEX(&STR( ),&NRSTR(&P1),&X)
  SET DSN = &SUBSTR(&X+1:&Y,&NRSTR(&P1))
  END
SET X = 1
DO UNTIL &X EQ 0
  SET X = &SYSINDEX(//AUDIT,&NRSTR(&P1),&X)
  IF &X GT 0 THEN DO
    SET Y = &SYSINDEX(&STR( //),&NRSTR(&P1),&X+1)
    IF &Y EQ 0 THEN SET &Y = &LENGTH(&P1)
    SET X = &SYSINDEX(&STR( ),&NRSTR(&P1),&X+1)
    SET DSN = &STR(&DSN&SUBSTR(&X+1:&Y,&NRSTR(&P1)))
    END
  END
SET &P1 = &STR(&DSN)
END
 
 
DIALOG_RTN: PROC 1 AUMBR
 
SET RETURN_CODE = 0
 
ISPEXEC VGET ( +
  DIALOG       +
  ) ASIS
 
SET RETURN_CODE = 0
 
ISPEXEC LMMFIND DATAID(&DIALOG) MEMBER(&AUMBR)
 
SET LMMFIND_DIALOG_RC = &RETURN_CODE
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME Authorized user list &AUMBR not found.
  RETURN
  END
 
GET_NEXT_USR: +
SET RETURN_CODE = 0
 
ISPEXEC LMGET DATAID(&DIALOG) MODE(INVAR) DATALOC(URECORD) +
  MAXLEN(80) DATALEN(LRECL)
 
SET LMGET_DIALOG_RC = &RETURN_CODE
IF &RETURN_CODE EQ 8 THEN DO           /* END OF MEMBER */
   SET LMGET_DIALOG_RC = 0             /* SET RETURN CODE TO 0 */
   RETURN
   END
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMGET  DIALOG  RC = &RETURN_CODE  &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  RETURN
  END
 
IF &SUBSTR(1,&NRSTR(&URECORD)) EQ &STR(*) OR   +
   &SUBSTR(1,&NRSTR(&URECORD)) EQ &STR( ) THEN +
  GOTO GET_NEXT_USR
 
SET USR = &SUBSTR(1:8,&NRSTR(&URECORD))
 
/*ISREDIT EXCLUDE ALL '&USR' 1
ISREDIT EXCLUDE ALL '&USR' 47
ISREDIT EXCLUDE ALL '&USR' 119
 
GOTO GET_NEXT_USR
 
/*  ---------------   */
 
END
