ISREDIT MACRO       /* CATM0420 EDIT TEMP6(iter)  */
 
/* EDIT MACRO SEARCHES FOR FINDINGS IN RESOURCE INFORMATION
 
/* 03/31/2008 CL.FENTON Created from modified CATM0420
/* 04/08/2008 CL.Fenton Corrected INSUFFICIENT STORAGE by collecting
/*            250 ACIDs in ACIDLIST variable.
/* 04/17/2008 CL.Fenton Corrected resource being defined when it is
/*            not to be defined to TSS.
/* 05/05/2008 CL.Fenton Various corrections to correct issues found
/*            by site evaluating process.
/* 11/15/2008 CL.Fenton Changed evaluation of resource and tres cleanup.
/* 03/09/2009 CL.Fenton Changed evaluation of resource to drop evalation
/*            of hlq when rule contain hlq and addition lvls.
/* 10/09/2009 CL.Fenton Chgs made in the asterisk analysis.
/* 03/18/2010 CL.Fenton Corrected 932 error on REC3TBL entries.  Chgd
/*            analysis on Resource Classes that dont require ACCESS.
/* 07/26/2010 CL.Fenton Corrected error caused by resource classes without
/*            access requirements, when READ specified in tables.  Chg
/*            made to set UACC_LVL to 9 when RDTACC eq space.
/* 11/30/2010 CL.Fenton Corrected 932 error caused when processing RDT for
/*            resource class (RESVAL) on continuation line that is less
/*            than 18 characters.
/* 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.
/* 06/06/2012 CL Fenton Corrected 852 and 932 errors on REC2TBL on
/*            resources that have special characters (+, -, *, and /),
/*            CSD-AR003419256.
/* 09/19/2012 CL Fenton Corrected 860 errors on RESNAME in the collection
/*            of REC3TBL entries with special characters (+, -, *, and /).
/* 01/04/2013 CL Fenton Corrected 932 and 900 errors permission that
/*            contain '&' in permission, STS-001536.
/* 04/08/2013 CL Fenton Removed clean up of mismatched records.
/* 10/01/2013 CL Fenton Corrected 920 return_code on substr for RESOURCE,
/*            STS-004151.
/* 12/20/2013 CL Fenton Moved "Undefined Resource" process and "Resource
/*            that are defined and donot have prevent" process after RDT
/*            process, also deleted GOTO CLEAN_UP when variables are
/*            different, STS-004303, ...
/* 12/04/2015 CL Fenton Corrected evaluation of access requirements and
/*            changed the sort order for this correction.  Issue with the
/*            use of resources ending with a period, STS-011658.
/* 06/29/2016 CL Fenton Corrected evaluation of access requirements of
/*            resources.
/* 07/13/2017 CL Fenton Corrected action performed when member is not
/*            found in AUACCESS file.
/* 05/02/2019 CL Fenton Added addition accesses for CICS SPI permissions,
/*            STS-021044.
/* 05/23/2019 CL.FENTON Chgs to evaluate ZCIC0021 for system that are
/*            running both production and test/developement CICS regions,
/*            STS-021044.
 
SET PGMNAME = &STR(CATM0120 05/23/19)
 
NGLOBAL PGMNAME RETURN_CODE AUUACC_LVL AULOG_LVL PDINAME
NGLOBAL Y0 M PDIDD CUR_DATA RDTDEF RDTACC
 
SET SYSPROMPT = OFF                /* CONTROL NOPROMPT          */
SET SYSFLUSH  = OFF                /* CONTROL NOFLUSH           */
SET SYSASIS   = ON                 /* CONTROL ASIS - caps off   */
 
/* ERROR ROUTINE */
ERROR DO
  SET RETURN_CODE = &LASTCC          /* SAVE LAST ERROR CODE */
  IF &LASTCC GE 16 THEN +
    WRITE &PGMNAME LASTCC = &LASTCC PDINAME = &PDINAME &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     +
  AUACCESS     +
  CNTL         +
  PDIDD        +
  PDINAME      +
  ODSNAME      +
  CACT0008     +
  CACM042R     +
  CATM0405     +
  TSSLISTP     +
  RESVAL       +
  REC2TBL      +
  ) 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 AUACCESS/&AUACCESS CNTL/&CNTL PDIDD/&PDIDD +
    PDINAME/&PDINAME ODSNAME/&ODSNAME CACT0008/&CACT0008 +
    CACM042R/&CACM042R + CATM0405/&CATM0405 +
    TSSLISTP/&TSSLISTP
  WRITE &PGMNAME RESVAL/&RESVAL REC2TBL/&NRSTR(&REC2TBL)
  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  /* Resource not defined      */
SET Y2 = 0  /* Access authorization      */
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
 
SET BLANK = &STR( )
SET SP10 = &STR(          )
SET SP80 = &STR(&SP10&SP10&SP10&SP10&SP10&SP10&SP10&SP10)
 
/************************************************************/
/* Optain RDT for resource                                  */
/************************************************************/
SET CMD = &STR(TSS LIST(RDT) RESCLASS(&RESVAL))
SET SYSOUTTRAP = 999
&CMD
SET CNT = &SYSOUTLINE
SET A   = 0
DO X = 1 TO &CNT
  SET AB  = &&SYSOUTLINE&X             /* set variable
  SET AB  = &SYSNSUB(2,&AB)            /* set value with limits
  IF &SUBSTR(1:12,&NRSTR(&AB)) NE &STR(ACCESSORID =) AND +
     &NRSTR(&AB)               NE &STR( ) AND +
     &SUBSTR(1:3,&NRSTR(&AB))  NE &STR(TSS) THEN DO
    IF &SUBSTR(18,&NRSTR(&AB)&SP80) EQ &STR(=) THEN DO
      SET A = &A + 1
      SET AX&A = &NRSTR(&AB)
      END
    ELSE +
      SET AX&A = &SYSNSUB(2,&&AX&A)+
        &SUBSTR(14:&LENGTH(&NRSTR(&AB)),&NRSTR(&AB))
    END
END
SET SYSOUTTRAP = 0
/************************************************************/
/* Determine if RDT for resource specifies DEFPROT and/or   */
/* ACCESS in the RDT Attributes.                            */
/************************************************************/
SET RDTACC =
SET RDTDEF =
SET B = &LENGTH(&NRSTR(&RESVAL  ))
DO B = &B TO 1 BY -1 UNTIL &SUBSTR(&B,&NRSTR(&RESVAL   )) +
  NE &STR( )
  END
SET RESVAL = &SUBSTR(1:&B,&NRSTR(&RESVAL))
DO X = 1 TO &A
  SET AB  = &&AX&X             /* set variable
  SET AB  = &SYSNSUB(2,&AB)            /* set value with limits
  SET ZZ  = &SYSINDEX(&STR(=),&NRSTR(&AB))
  IF &SYSINDEX(&STR(DEFPROT),&NRSTR(&AB)) GT &ZZ THEN +
    SET RDTDEF = Y
  IF &SYSINDEX(&STR(ACCESS),&NRSTR(&AB)) GT &ZZ THEN +
    SET RDTACC = Y
END
 
 
/*************************************************/
/* Undefined Resource                            */
/*************************************************/
 
IF &LASTLINE GT 0 THEN +
  ISREDIT CURSOR = 1 0
 
IF &RDTDEF NE &STR( ) THEN GOTO BYPASS_UNDEFINED
 
DO XX = 1 TO &LENGTH(&NRSTR(&REC2TBL))
  SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+9)
  SET RESOURCE = &SUBSTR(&XX+9:&Y,&NRSTR(&REC2TBL))
  SET FLD      = &SUBSTR(&XX+8,&NRSTR(&REC2TBL))
  SET XX = &Y + 1
 
  SET RETURN_CODE = 0
  ISREDIT FIND '&SUBSTR(1:48,&NRSTR(&RESOURCE&SP80))' 75 ALL NX
  IF &RETURN_CODE GT 0 THEN DO
    SYSCALL STATEMENT_WRITE Y1 TYPE(1)
    SET AC = &STR(     &RESOURCE)
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    END
  ELSE DO
    ISREDIT (DATA) = LINE .ZCSR
    IF &SUBSTR(1:48,&NRSTR(&DATA)) EQ &STR( ) AND +
       &NRSTR(&FLD) EQ &STR( ) THEN DO
      SYSCALL STATEMENT_WRITE Y1 TYPE(1)
      SET AC = &STR(     &RESOURCE)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      END
    END
END
 
 
/****************************************************/
/* Resource that are defined and donot have prevent */
/****************************************************/
 
BYPASS_UNDEFINED: +
IF &LASTLINE GT 0 THEN +
  ISREDIT CURSOR = 1 0
 
SET ORES      =
SET ORESOURCE =
 
DO XX = 1 TO &LENGTH(&NRSTR(&REC2TBL))
  SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+9)
  SET RESOURCE = &SUBSTR(&XX+9:&Y,&NRSTR(&REC2TBL))
  SET FLD      = &SUBSTR(&XX+8,&NRSTR(&REC2TBL))
  SET XX = &Y + 1
 
  IF &FLD EQ &STR( ) THEN GOTO DEFINE_END
 
  DEFINE_LOOP: +
  SET RETURN_CODE = 0
  ISREDIT FIND '&SUBSTR(1:48,&NRSTR(&RESOURCE&SP80))' 75 NX
  IF &RETURN_CODE GT 0 THEN GOTO DEFINE_END
 
  ISREDIT (DATA) = LINE .ZCSR
  ISREDIT (CURLINE) = LINENUM .ZCSR
  SET RES  = &SUBSTR(1:48,&STR(&DATA))
  IF &NRSTR(&RES) EQ &STR( ) THEN +
    GOTO DEFINE_LOOP
 
  SET CUR_ACC  = &SUBSTR(65:72,&NRSTR(&DATA))
  SET CUR_ACT  = &SUBSTR(73:73,&NRSTR(&DATA))
  SET CUR_DENY = &SUBSTR(74:74,&NRSTR(&DATA))
 
  IF &NRSTR(&CUR_ACC) EQ &STR( ) AND +
     &NRSTR(&CUR_DENY) EQ &STR( ) THEN +
    GOTO DEFINE_LOOP
 
  SET SP = &STR(                                              )
 
  SET ACCESS =
  IF &RDTACC NE &STR( ) THEN +
    SYSCALL DETERMINE_ACCESS CUR_ACC ACCESS
 
  IF (&RDTACC EQ &STR( ) AND +
      &NRSTR(&CUR_DENY) EQ &STR(Y)) OR +
     (&RDTACC EQ &STR(Y) AND +
      &SYSINDEX(NONE,&ACCESS) GT 0) THEN +
    GOTO DEFINE_LOOP
 
  SYSCALL STATEMENT_WRITE Y4 TYPE(4)
 
  IF &NRSTR(&ORESOURCE) NE &NRSTR(&RESOURCE) THEN DO
    IF &NRSTR(&ORESOURCE) NE &STR( ) THEN DO
      SET AC = &STR( )
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      END
    SET AC = &STR(     &RESOURCE)
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    SET ORESOURCE = &NRSTR(&RESOURCE)
    SET ORES      =
    END
 
  SET CUR_ACT  = &SUBSTR(73:73,&NRSTR(&DATA))
  SET CUR_DENY = &SUBSTR(74:74,&NRSTR(&DATA))
 
  SET DSNAUD =
  IF &CUR_ACT EQ X OR +
     &CUR_ACT EQ Z THEN +
      SET DSNAUD = &STR(AUDIT)
 
  IF &NRSTR(&RES) NE &NRSTR(&ORES) THEN DO
    SET ORES = &NRSTR(&RES)
    SET AC = &STR(          &NRSTR(&RES) &DSNAUD)
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    END
 
  SET CUR_DATA  = &NRSTR(&DATA)
 
  SYSCALL WRITE_ACID BYPASS
 
  ISREDIT CURSOR = &CURLINE 100
 
  GOTO DEFINE_LOOP
 
  DEFINE_END: +
END
 
 
SET LP = &STR((
SET RP = )
SET RETURN_CODE = 0
ISREDIT EXCLUDE ALL '2' 123
IF &RETURN_CODE EQ 0 THEN DO
  ISREDIT DELETE ALL X
  END
 
/*ISREDIT SORT 49 56 A 1 48 A 75 122 D
/* SORT BY   ACID    RES    RESOURCE  */
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET COUNTER = 1
 
EXPAND_RES: +
SET RETURN_CODE = 0
 
IF &COUNTER GT &LASTLINE THEN +
  GOTO EXPAND_RES_END
 
ISREDIT (DATA) = LINE &COUNTER
 
SET RESOURCE = &SUBSTR(75:122,&NRSTR(&DATA))
SET X = &SYSINDEX(&STR( ),&NRSTR(&RESOURCE))
IF &X GT 1 THEN +
  SET RESOURCE = &SUBSTR(1:&X-1,&NRSTR(&RESOURCE))
SET RES      = &SUBSTR(1:48,&NRSTR(&DATA))
SET X = &SYSINDEX(&STR( ),&NRSTR(&RES))
IF &X GT 1 THEN +
  SET RES = &SUBSTR(1:&X-1,&NRSTR(&RES))
 
SET TRES = &NRSTR(&RES)
 
 
MASK_PERIOD: +
IF &SYSINDEX(&STR(* ),&NRSTR(&TRES )) GT 1 THEN DO
  SET TRES = &SUBSTR(1:&LENGTH(&NRSTR(&TRES))-1,&NRSTR(&TRES))
  GOTO MASK_PERIOD
  END
 
IF &SYSINDEX(&STR(. ),&NRSTR(&TRES )) GT 0 THEN DO
  SET TRES = &SUBSTR(1:&LENGTH(&NRSTR(&TRES))-1,&NRSTR(&TRES))
  GOTO MASK_PERIOD
  END
 
SET DATA = &SUBSTR(1:154,&NRSTR(&DATA)&SP80&SP80)&NRSTR(&TRES)
 
ISREDIT LINE &COUNTER = (DATA)
 
/* If added to negate record */
IF &SYSINDEX(&NRSTR(&RESOURCE),&NRSTR(&TRES)) GT 0 AND +
   &SYSINDEX(&NRSTR(.),&NRSTR(&TRES)) GT 0 AND +
   &SYSINDEX(&NRSTR(.),&NRSTR(&RESOURCE)) EQ 0 THEN DO
  ISREDIT XSTATUS &COUNTER = X
/*ISREDIT CHANGE ALL P'^' ' ' 49 74 X
  END
 
EXPAND_RES_BYPASS: +
SET COUNTER = &COUNTER + 1
 
GOTO EXPAND_RES
 
EXPAND_RES_END: +
SET RETURN_CODE = 0
 
ISREDIT SORT 49 56 A 155 202 A 75 122 A
/* SORT BY   ACID    TRES    RESOURCE  */
 
  ISREDIT SAVE
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET COUNTER = 0
 
CLEAN_UP: +
SET RETURN_CODE = 0
 
SET COUNTER = &COUNTER + 1
 
IF &COUNTER GT &LASTLINE THEN +
  GOTO CLEAN_UP_END
 
ISREDIT (DATA) = LINE &COUNTER
ISREDIT (XSTA) = XSTATUS &COUNTER
 
SET ACID     = &SUBSTR(49:56,&NRSTR(&DATA))
 
IF &NRSTR(&ACID) EQ &STR( ) THEN +
  GOTO CLEAN_UP
IF &XSTA EQ &STR(X) THEN +
  GOTO CLEAN_UP
 
SET RESOURCE = &SUBSTR(75:122,&NRSTR(&DATA))
SET X = &SYSINDEX(&STR( ),&NRSTR(&RESOURCE))
IF &X GT 1 THEN +
  SET RESOURCE = &SUBSTR(1:&X-1,&NRSTR(&RESOURCE))
SET RES      = &SUBSTR(1:48,&NRSTR(&DATA))
SET X = &SYSINDEX(&STR( ),&NRSTR(&RES))
IF &X GT 1 THEN +
  SET RES = &SUBSTR(1:&X-1,&NRSTR(&RES))
SET TRES      = &SUBSTR(155:202,&NRSTR(&DATA))
SET X = &SYSINDEX(&STR( ),&NRSTR(&TRES))
IF &X GT 1 THEN +
  SET TRES = &SUBSTR(1:&X-1,&NRSTR(&TRES))
 
IF &SYSINDEX(&STR(*),&NRSTR(&RES)) GT 0 AND +
   &LENGTH(&NRSTR(&RES)) LT 3 THEN DO
  ISREDIT EXCLUDE ALL '&SUBSTR(1:72,&NRSTR(&DATA))' 1
  ISREDIT XSTATUS &COUNTER = NX
  GOTO CLEAN_UP
  END
 
IF &NRSTR(&OACID) NE &NRSTR(&ACID) THEN DO
  SET ORESOURCE = &NRSTR(&RESOURCE)
  SET ORES      = &NRSTR(&RES)
  SET OACID     = &NRSTR(&ACID)
  SET OTRES     = &NRSTR(&TRES)
/*GOTO CLEAN_UP
  END
 
IF &NRSTR(&OTRES) NE &NRSTR(&TRES) THEN DO
  SET ORESOURCE = &NRSTR(&RESOURCE)
  SET ORES      = &NRSTR(&RES)
  SET OTRES     = &NRSTR(&TRES)
/*GOTO CLEAN_UP
  END
 
IF &SYSINDEX(&STR(*),&NRSTR(&RES)) GT 0 THEN DO
  SET XRES = &NRSTR(&RES)
  SYSCALL CONVERT_RES XRES RESOURCE
  END
ELSE +
  SET XRES = &NRSTR(&RES)
 
IF &NRSTR(&TRES) EQ &NRSTR(&RESOURCE) THEN DO
  ISREDIT EXCLUDE ALL '&SUBSTR(1:72,&NRSTR(&DATA))' 1
  ISREDIT XSTATUS &COUNTER = NX
  GOTO CLEAN_UP
  END
 
IF &SYSINDEX(&NRSTR(&RESOURCE),&NRSTR(&TRES)) GT 0 THEN DO
  ISREDIT SEEK '&SUBSTR(1:72,&NRSTR(&DATA))' 1 ALL NX
  ISREDIT (A,B) = SEEK_COUNTS
  IF &B GT 1 THEN DO
    ISREDIT XSTATUS &COUNTER = X
    END
  END
 
GOTO CLEAN_UP
 
CLEAN_UP_END: +
ISREDIT DELETE ALL X
SET RETURN_CODE = 0
 
ISREDIT SORT 075 122 A 001 056 A
/* SORT BY   RESOURCE  RES/ACID  */
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
/************************************************************/
/* 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' 57 NX
 
IF &RETURN_CODE GT 0 THEN +
  GOTO PROCESS_PROFILE_END
 
ISREDIT (LINE) = LINENUM .ZCSR
ISREDIT (DATA) = LINE .ZCSR
 
SET CURACID = &SUBSTR(49:56,&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:122,&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' 49
 
IF &RETURN_CODE GT 0 THEN DO
  IF &DATATYPE(&ACIDNUM) EQ &STR(NUM) THEN +
    GOTO GET_NEXT_ACIDS
  ISREDIT EXCLUDE ALL '&CURACID' 49
  GOTO PROCESS_PROFILE
  END
 
ISREDIT (LINE) = LINENUM .ZCSR
ISREDIT (DATA) = LINE .ZCSR
 
GOTO ADD_ACIDS
 
 
PROCESS_PROFILE_END: +
SET RETURN_CODE = 0
/*ISREDIT SAVE
 
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 ' 57 NX
 
IF &RETURN_CODE GT 0 THEN +
  GOTO PROCESS_ACID_END
 
ISREDIT (LINE) = LINENUM .ZCSR
ISREDIT (DATA) = LINE .ZCSR
 
SET CURACID = &SUBSTR(49:56,&NRSTR(&DATA))
SET CURDSN  = &SUBSTR(75:122,&NRSTR(&DATA))
 
ISREDIT EXCLUDE ALL '&NRSTR(&CURDSN)2&NRSTR(&CURACID)' 75
 
ISREDIT CURSOR = &LINE 100
 
GOTO PROCESS_ACID
 
PROCESS_ACID_END: +
SET RETURN_CODE = 0
 
ISREDIT DELETE ALL X
SET RETURN_CODE = 0
 
/*************************************************/
/* Resource access requirements                  */
/*************************************************/
 
SET ORESOURCE =
SET ORES      =
 
DO XX = 1 TO &LENGTH(&NRSTR(&REC2TBL))
  SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+9)
  SET RESOURCE  = &SUBSTR(&XX+9:&Y,&NRSTR(&REC2TBL))
  SET TRESOURCE = &SUBSTR(1:48,&NRSTR(&RESOURCE&SP80))
  SET FLD       = &SUBSTR(&XX+8,&NRSTR(&REC2TBL))
  SET XX = &Y + 1
 
  ISREDIT RESET
  ISREDIT EXCLUDE ALL '        ' 49
  ISREDIT EXCLUDE ALL 'PROFILE ' 57
  ISREDIT FIND ALL '2' 123
  ISREDIT EXCLUDE ALL '2*NONE*  ' 123
 
  IF &STR(&RDTACC) EQ &STR( ) THEN +
    ISREDIT EXCLUDE ALL 'Y' 74   /* Exc all records with DENY */
 
  IF &FLD EQ &STR(X) THEN GOTO ACCESS_END
 
  SET RECTYPE = 3
  SET RESNAME = &NRSTR(&RESOURCE)
 
  ISPEXEC VPUT ( +
    RECTYPE      +
    PDINAME      +
    RESNAME      +
    ) ASIS
 
  SET RETURN_CODE = 0
 
  ISPEXEC VIEW DATAID(&CNTL) MEMBER(&CACT0008) MACRO(&CACM042R)
 
  SET VIEW_CACT0008_RC = &RETURN_CODE
  IF &VIEW_CACT0008_RC GT 4 THEN DO
    WRITE &PGMNAME VIEW CNTL &CACT0008  RC = &VIEW_CACT0008_RC
    GOTO ACCESS_END
    END
 
  ISPEXEC VGET ( +
    REC3TBL      +
    AUACCCNT     +
    ) ASIS
 
  IF &AUACCCNT GT 50 THEN DO
 
    SET RETURN_CODE = 0
    ISPEXEC LMCLOSE DATAID(&AUACCESS)
    SET LMCLOSE_PDIDD_RC = &RETURN_CODE
    IF &RETURN_CODE NE 0 THEN DO
      WRITE &PGMNAME LMCLOSE_AUACCESS_RC &RETURN_CODE  &ZERRSM
      END
 
    SET RETURN_CODE = 0
    ISPEXEC LMCOMP DATAID(&AUACCESS)
    SET LMCOMP_AUACCESS_RC = &RETURN_CODE
    IF &RETURN_CODE NE 0 THEN DO
      WRITE &PGMNAME LMCOMP_AUACCESS_RC &RETURN_CODE  &ZERRSM
      END
 
    SET RETURN_CODE = 0
    ISPEXEC LMOPEN DATAID(&AUACCESS) OPTION(INPUT)
    SET LMOPEN_AUACCESS_RC = &RETURN_CODE
    IF &RETURN_CODE NE 0 THEN DO
      WRITE &PGMNAME LMOPEN_AUACCESS_RC &RETURN_CODE  &ZERRSM
      END
    SET AUACCCNT = 0
    ISPEXEC VPUT (AUACCCNT) ASIS
    END
 
  ISPEXEC VERASE ( +
    REC3TBL      +
    ) ASIS
 
  SET AUUACC_LVL = 0
  SET X = &SYSINDEX(&STR(#*       ),&STR(&REC3TBL&SP))
 
  IF &X GT 0 THEN +
    SET AUUACC_LVL = &SUBSTR(&X+9,&NRSTR(&REC3TBL&SP))
  IF &RDTACC EQ &STR( ) THEN +
    IF &AUUACC_LVL NE 0 THEN +
      SET AUUACC_LVL = 9
 
  IF &NRSTR(&AUUACC_LVL) EQ &STR(9) THEN +
    GOTO ACCESS_END
 
  SET AUUACC_MASK =
 
  SYSCALL DETERMINE_ACC AUUACC_LVL AUUACC_MASK
 
  SET RETURN_CODE = 0
 
  ISPEXEC LMMFIND DATAID(&AUACCESS) MEMBER(&PDINAME)
 
/*IF &RETURN_CODE GT 0 THEN GOTO ACCESS_END
  IF &RETURN_CODE GT 0 THEN GOTO AUUACC_CHECK
 
  ISREDIT CURSOR = 1 0
 
  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 CURSOR = 1 0
    GOTO AUUACC_CHECK
    END
  IF &RETURN_CODE GT 4 THEN DO
    WRITE &PGMNAME LMGET AUACCESS RC = &RETURN_CODE &ZERRSM
    SET RETURN_CODE = &RETURN_CODE + 16
    GOTO ACCESS_END
    END
 
  SET AULID = &SUBSTR(1:8,&NRSTR(&AUREC))
  SET AULVL = &SUBSTR(9,&NRSTR(&AUREC))
  SET AU_MASK =
 
  IF &NRSTR(&AULID) EQ &STR(*) THEN +
    GOTO READ_AUACCESS
 
  IF &RDTACC EQ &STR( ) THEN +
    SET AULVL = 9
 
  SYSCALL DETERMINE_ACC AULVL AU_MASK
 
  SET RETURN_CODE = 0
  ISREDIT FIND ALL '&NRSTR(&AULID)' 49 NX
 
  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)' 49 NX
      IF &RETURN_CODE EQ 0 THEN DO
        ISREDIT (DATA) = LINE .ZCSR
        SET RES    = &SUBSTR(75:122,&NRSTR(&DATA))
        SET ACC    = &SUBSTR(65:72,&NRSTR(&DATA))
        SET TYPE   = &SUBSTR(57:64,&NRSTR(&DATA))
        SET OTHER  = &SUBSTR(123:131,&NRSTR(&DATA))
        IF &NRSTR(&TYPE) NE &STR(PROFILE) AND +
           &NRSTR(&RES) EQ &NRSTR(&TRESOURCE) THEN DO
          IF &RDTACC EQ &STR( ) THEN +
            SET TEST_ACC = &STR(A)
          ELSE DO
            SET TEST_ACC = &STR(R)
            DO X = 1 TO 8 WHILE &SUBSTR(&X,&NRSTR(&ACC)) NE &STR( )
              IF &STR(&TEST_ACC) GE &SUBSTR(&X,&NRSTR(&ACC)) THEN +
                SET TEST_ACC = &SUBSTR(&X,&NRSTR(&ACC))
              END
            END
          IF &AUUACC_MASK LE &TEST_ACC OR +
             &AU_MASK LE &TEST_ACC THEN +
            ISREDIT XSTATUS .ZCSR = X
          END
        END
      END
    END
 
  SET RETURN_CODE = 0
  ISREDIT FIND ALL '&TRESOURCE.2&AULID' 75 NX
 
  IF &RETURN_CODE EQ 0 THEN DO
    ISREDIT CURSOR = 1 0
    SET RETURN_CODE = 0
    DO UNTIL &RETURN_CODE GT 0
      ISREDIT FIND '&TRESOURCE.2&AULID' 75 NX
      IF &RETURN_CODE EQ 0 THEN DO
        ISREDIT (DATA) = LINE .ZCSR
        SET RES    = &SUBSTR(1:48,&NRSTR(&DATA))
        SET TYPE   = &SUBSTR(57:64,&NRSTR(&DATA))
        SET ACC    = &SUBSTR(65:72,&NRSTR(&DATA))
        IF &RDTACC EQ &STR( ) THEN +
          SET TEST_ACC = &STR(A)
        ELSE DO
          SET TEST_ACC = &STR(R)
          DO X = 1 TO 8 WHILE &SUBSTR(&X,&NRSTR(&ACC)) NE &STR( )
            IF &STR(&TEST_ACC) GE &SUBSTR(&X,&NRSTR(&ACC)) THEN +
              SET TEST_ACC = &SUBSTR(&X,&NRSTR(&ACC))
            END
          END
        IF &AUUACC_MASK LE &TEST_ACC OR +
           &AU_MASK LE &TEST_ACC THEN +
          ISREDIT XSTATUS .ZCSR = X
        END
      END
    END
 
  GOTO READ_AUACCESS
 
  AUUACC_CHECK: +
  SET RETURN_CODE = 0
  ISREDIT FIND ALL '&TRESOURCE' 75 NX
 
  IF &RETURN_CODE EQ 0 THEN DO
    ISREDIT CURSOR = 1 0
    SET RETURN_CODE = 0
    DO UNTIL &RETURN_CODE GT 0
      ISREDIT FIND '&TRESOURCE' 75 NX
      IF &RETURN_CODE EQ 0 THEN DO
        ISREDIT (DATA) = LINE .ZCSR
        ISREDIT (CURLINE) = LINENUM .ZCSR
        SET ACC    = &SUBSTR(65:72,&NRSTR(&DATA))
        /* following line is for trace information
        SET DATA   = &NRSTR(&DATA)
        IF &RDTACC EQ &STR( ) THEN +
          SET TEST_ACC = &STR(A)
        ELSE DO
          SET TEST_ACC = &STR(R)
          DO X = 1 TO 8 WHILE &SUBSTR(&X,&NRSTR(&ACC)) NE &STR( )
            IF &STR(&TEST_ACC) GE &SUBSTR(&X,&NRSTR(&ACC)) THEN +
              SET TEST_ACC = &SUBSTR(&X,&NRSTR(&ACC))
            END
          END
        IF &AUUACC_MASK LE &TEST_ACC THEN DO
          ISREDIT XSTATUS &CURLINE = X
          ISREDIT CURSOR = 1 0
          SET TEST = &SUBSTR(75:131,&DATA)
          SET T_ACID = &SUBSTR(49:56,&NRSTR(&DATA))
          DO UNTIL &RETURN_CODE GT 0
            ISREDIT FIND '&TEST' NX
            ISREDIT (DATA1) = LINE .ZCSR
            IF &NRSTR(&T_ACID) EQ &SUBSTR(49:56,&NRSTR(&DATA1)) THEN +
              ISREDIT XSTATUS .ZCSR = X
            END
          ISREDIT CURSOR = &CURLINE 100
          SET RETURN_CODE = 0
          END
        END
      END
    END
 
  ISREDIT CURSOR = 1 0
  SET RETURN_CODE = 0
 
  ACCESS_PROFILE: +
  ISREDIT FIND '&SUBSTR(1:48,&NRSTR(&RESOURCE&SP80))2' 75 NX
  IF &RETURN_CODE GT 0 THEN DO
    SET RETURN_CODE = 0
    ISREDIT CURSOR = 1 0
    GOTO ACCESS_REPORT
    END
 
  ISREDIT (DATA) = LINE .ZCSR
 
  SET INFO = &SUBSTR(1:122,&NRSTR(&DATA))
 
  ISREDIT FIND ALL '&NRSTR(&INFO)1' 1
 
  ISREDIT SEEK LAST '&NRSTR(&INFO)2' 1
 
  ISREDIT CURSOR = .ZCSR 100
 
  GOTO ACCESS_PROFILE
 
  ACCESS_REPORT: +
  SET RETURN_CODE = 0
  ISREDIT FIND '&SUBSTR(1:48,&NRSTR(&RESOURCE&SP80))1' 75 NX
  IF &RETURN_CODE GT 0 THEN DO
    ISREDIT CURSOR = 1 0
    GOTO ACCESS_END
    END
 
  ISREDIT (DATA) = LINE .ZCSR
  ISREDIT (CURLINE) = LINENUM .ZCSR
 
  SET RES    = &SUBSTR(1:48,&NRSTR(&DATA))
 
  SYSCALL STATEMENT_WRITE Y2 TYPE(2)
 
  IF &NRSTR(&ORESOURCE) NE &NRSTR(&RESOURCE) THEN DO
    IF &NRSTR(&ORESOURCE) NE &STR( ) THEN DO
      SET AC = &STR( )
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      END
  IF &SYSINDEX(&STR(#),&NRSTR(&RESOURCE)) EQ 0 THEN +
    SET AC = &NRSTR(     &RESOURCE)
  ELSE DO
    SET AA = &SYSINDEX(&STR(#),&NRSTR(&RESOURCE))
    SET AB = &SYSINDEX(&STR( ),&NRSTR(&RESOURCE))
    SET CURRES = &SUBSTR(1:&AA-1,&NRSTR(&RESOURCE))
    SET CURFAC = &SUBSTR(&AA+1:&AB,&NRSTR(&RESOURCE))
    SET AC = &NRSTR(     &CURRES      FAC=&CURFAC)
    END
/*  SET AC = &STR(     &RESOURCE)
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    SET ORESOURCE = &NRSTR(&RESOURCE)
    SET ORES      =
    END
 
  SET DSNAUD =
 
  IF &CUR_ACT EQ X OR +
     &CUR_ACT EQ Z THEN +
      SET DSNAUD = &STR(AUDIT)
 
  IF &NRSTR(&RES) NE &NRSTR(&ORES) THEN DO
    SET ORES = &NRSTR(&RES)
    SET AC = &STR(          &NRSTR(&RES) &DSNAUD)
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    END
 
  SET CUR_DATA  = &NRSTR(&DATA)
 
  SYSCALL WRITE_ACID
 
  ISREDIT CURSOR = &CURLINE 100
 
  GOTO ACCESS_REPORT
 
  ACCESS_END: +
END
/*GOTO ERR_EXIT
 
 
LOGGING_PROCESS: +
ISREDIT RESET
ISREDIT EXCLUDE ALL P'=' 1
ISREDIT FIND ALL 'N' 73
ISREDIT EXCLUDE ALL '2' 123
ISREDIT CURSOR = 1 0
SET RETURN_CODE = 0
 
/* *************************************** */
/* Check Auditing                          */
/* *************************************** */
 
SET ORES      =
SET ORESOURCE =
 
DO XX = 1 TO &LENGTH(&NRSTR(&REC2TBL))
  SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+9)
  SET LOGGING  = &SUBSTR(&XX:&XX+7,&NRSTR(&REC2TBL))
  SET RESOURCE = &SUBSTR(&XX+9:&Y,&NRSTR(&REC2TBL))
  SET FLD      = &SUBSTR(&XX+8,&NRSTR(&REC2TBL))
  SET XX = &Y + 1
 
  IF &NRSTR(&LOGGING) EQ &STR( ) THEN +
    GOTO LOGGING_BYPASS
 
  SET AULOG_LVL =
  SYSCALL DETERMINE_ACC LOGGING AULOG_LVL
 
  LOGGING_LOOP: +
  SET RETURN_CODE = 0
  ISREDIT FIND '&SUBSTR(1:48,&NRSTR(&RESOURCE&SP80))' 75 NX
  IF &RETURN_CODE GT 0 THEN +
    GOTO LOGGING_BYPASS
 
  ISREDIT (DATA) = LINE .ZCSR
  ISREDIT (CURLINE) = LINENUM .ZCSR
  SET RES    = &SUBSTR(1:48,&NRSTR(&DATA))
  SET ACC    = &SUBSTR(65:72,&NRSTR(&DATA))
  SET DENY   = &SUBSTR(74,&NRSTR(&DATA))
 
  IF &RDTACC EQ &STR( ) AND +
     &NRSTR(&CUR_DENY) EQ &STR(Y) THEN +
    GOTO LOGGING_LOOP
 
  DO X = 1 TO 8 WHILE &SUBSTR(&X,&NRSTR(&ACC)) NE &STR( )
    IF &STR(&AULOG_LVL) LT &SUBSTR(&X,&NRSTR(&ACC)) THEN +
      GOTO LOGGING_LOOP
  END
 
  SYSCALL STATEMENT_WRITE Y3 TYPE(3)
 
  IF &NRSTR(&ORESOURCE) NE &NRSTR(&RESOURCE) THEN DO
    IF &NRSTR(&ORESOURCE) NE &STR( ) THEN DO
      SET AC = &STR( )
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      END
    SET AC = &STR(     &RESOURCE)
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    SET ORESOURCE = &NRSTR(&RESOURCE)
    SET ORES      =
    END
 
  IF &CUR_ACT EQ X OR +
     &CUR_ACT EQ Z THEN +
      SET DSNAUD = &STR(AUDIT)
 
  IF &NRSTR(&RES) NE &NRSTR(&ORES) THEN DO
    SET ORES = &NRSTR(&RES)
    SET AC = &STR(          &NRSTR(&RES) &DSNAUD)
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    END
 
  SET CUR_DATA  = &NRSTR(&DATA)
 
  SYSCALL WRITE_ACID BYPASS
 
  ISREDIT CURSOR = &CURLINE 100
 
  GOTO LOGGING_LOOP
 
LOGGING_BYPASS:+
END
 
 
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)))
  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&PDINAME&RP..)
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC)))
 
ISPEXEC LMMADD DATAID(&PDIDD) MEMBER(&PDINAME)
 
IF &RETURN_CODE EQ 4 THEN DO          /* MEMBER ALREADY EXISTS
  SET RETURN_CODE = 0
 
  ISPEXEC LMMREP DATAID(&PDIDD) MEMBER(&PDINAME)
 
  IF &RETURN_CODE NE 0 THEN DO
    WRITE &PGMNAME LMMREP_PDIDD_RCODE = &RETURN_CODE &PDINAME  &ZERRSM
    END
  END
ELSE DO
  IF &RETURN_CODE NE 0 THEN +
    WRITE &PGMNAME LMMADD_PDIDD_RCODE = &RETURN_CODE &PDINAME  &ZERRSM
  END
 
SET RETURN_CODE = 0
 
 
ERR_EXIT: +
IF &MAXCC GE 16 OR +
   &RETURN_CODE GT 4 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                             */
/* *************************************** */
 
SET ZEDSMSG = FINISHED
SET ZEDLMSG = &STR(Finished processing &DSNAME(&MEMBER).)
ISPEXEC LOG MSG(ISRZ000)
/*ISREDIT END
ISREDIT CANCEL
 
EXIT CODE(0)
 
/* *************************************** */
/*  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
      SELECT &STR(&PDINAME)
        WHEN (ZJES0051) +
          SET AC = &STR(The JES2 resource is protected improperly.)
        OTHERWISE +
          SET AC = &STR(The following access authorization&LP.s&RP +
            is &LP.are&RP inappropriate:)
        END
      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)))
      SET AC = &STR(&M&RP Required resource&LP.s&RP is &LP.are&RP +
        not defined/owned.)
      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 (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 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 AC = &STR( )
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      SET AC = &STR(&M&RP All resource 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
    WHEN (4) DO
      SET AC = &STR( )
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC)))
      SET AC = &STR(&M&RP Resource&LP.s&RP is &LP.are&RP +
        defined.)
      SET AC = &STR(&M&RP Resource&LP.s&RP is &LP.are&RP +
        permitted to user&LP.s&RP without ACCESS&LP.NONE&RP or +
        ACTION&LP.DENY&RP..)
      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
RETURN CODE(&RETURN_CODE)
 
END
 
 
WRITE_ACID: PROC 0 BYPASS
 
SET LP = &STR((
SET RP = )
SET CUR_ACID = &SUBSTR(49:56,&NRSTR(&CUR_DATA))
IF &NRSTR(&CUR_ACID) EQ &STR( ) THEN +
  GOTO END_INFO
 
SET CUR_TYPE = &SUBSTR(57:64,&NRSTR(&CUR_DATA))
SET CUR_ACC  = &SUBSTR(65:72,&NRSTR(&CUR_DATA))
SET CUR_ACT  = &SUBSTR(73:73,&NRSTR(&CUR_DATA))
SET CUR_DENY = &SUBSTR(74:74,&NRSTR(&CUR_DATA))
SET CUR_NAME = &SUBSTR(124:153,&NRSTR(&CUR_DATA))
SET CUR_INFO = &SUBSTR(1:122,&NRSTR(&CUR_DATA))
 
SET SP = &STR(                                              )
 
SET ACCESS =
IF &RDTACC NE &STR( ) THEN +
  SYSCALL DETERMINE_ACCESS CUR_ACC ACCESS
 
/* Evaluate ACTION entries of AUDIT and DENY */
 
SET ACTION =
IF (&CUR_ACT EQ Y OR &CUR_ACT EQ Z) AND +
   &CUR_DENY EQ Y THEN +
  SET ACTION = &STR( ACTION(AUDIT DENY))
ELSE +
  IF &CUR_ACT EQ Y OR &CUR_ACT EQ Z THEN +
    SET ACTION = &STR( ACTION(AUDIT))
  ELSE +
    IF &CUR_DENY EQ Y THEN +
      SET ACTION = &STR( ACTION(DENY))
 
SET AC = &SUBSTR(1:15,&SP)&NRSTR(&CUR_ACID &CUR_TYPE NAME=+
  &CUR_NAME&ACCESS&ACTION)
 
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) +
   DATALEN(&LENGTH(&NRSTR(&AC)))
 
IF &BYPASS NE &STR( ) THEN +
  GOTO END_INFO
 
ISREDIT CURSOR = 1 0
 
WRITE_INFO: +
SET RETURN_CODE = 0
 
ISREDIT SEEK '&NRSTR(&CUR_INFO)2' 1 NX
 
IF &RETURN_CODE GT 0 THEN +
  RETURN
 
ISREDIT (DATA) = LINE .ZCSR
 
SET ACID = &SUBSTR(124:131,&NRSTR(&DATA))
SET NAME = &SUBSTR(132:161,&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
 
 
DETERMINE_ACCESS: PROC 2 P1 P2
 
SYSREF &P1
SYSREF &P2
SET LP = &STR((
SET RP = )
SET SP = &STR(                                              )
 
SET &P2 =
IF &STR(&P1) EQ &STR( ) THEN RETURN CODE(&RETURN_CODE)
 
SET &P2 = &STR( ACCESS&LP)
DO X = 1 TO &LENGTH(&NRSTR(&P1))
  SET ACC = &SUBSTR(&X,&STR(&P1))
  IF &STR(&ACC) EQ &STR( ) THEN +
    SET X = 8
  ELSE DO
    SELECT (&ACC)
      WHEN (A) SET ACC = ALL
      WHEN (B) SET ACC = ALTER
      WHEN (C) SET ACC = INSTALL
      WHEN (D) SET ACC = BLP
      WHEN (E) SET ACC = SCRATCH
      WHEN (F) SET ACC = CREATE
      WHEN (G) SET ACC = CONTROL
      WHEN (H) SET ACC = UPDATE
      WHEN (I) SET ACC = SET
      WHEN (J) SET ACC = COLLECT
      WHEN (K) SET ACC = DISCARD
      WHEN (L) SET ACC = PERFORM
      WHEN (M) SET ACC = WRITE
      WHEN (N) SET ACC = READ
      WHEN (O) SET ACC = INQUIRE
      WHEN (P) SET ACC = NOCREATE
      WHEN (Q) SET ACC = FETCH
      WHEN (R) SET ACC = EXECUTE
      WHEN (S) SET ACC = EXEC
      WHEN (T) SET ACC = NONE
      END
    SET &P2 = &STR(&P2.&ACC.,)
    END
END
SET X = &LENGTH(&NRSTR(&P2))
SET &P2 = &STR(&SUBSTR(1:&X-1,&NRSTR(&P2))&RP)
RETURN CODE(&RETURN_CODE)
 
END
 
 
DETERMINE_ACC: PROC 2 P1 P2
 
SYSREF &P1
SYSREF &P2
 
SET &P2 =
IF &STR(&P1) EQ &STR( ) THEN RETURN CODE(&RETURN_CODE)
IF &DATATYPE(&P1) EQ &STR(CHAR) THEN +
  SELECT (&P1)
    WHEN (ALL     )  SET &P2 = &STR(A)
    WHEN (ALTER   )  SET &P2 = &STR(B)
    WHEN (INSTALL )  SET &P2 = &STR(C)
    WHEN (BLP     )  SET &P2 = &STR(D)
    WHEN (CREATE  )  SET &P2 = &STR(E)
    WHEN (SCRATCH )  SET &P2 = &STR(F)
    WHEN (CONTROL )  SET &P2 = &STR(G)
    WHEN (UPDATE  )  SET &P2 = &STR(H)
    WHEN (SET     )  SET &P2 = &STR(I)
    WHEN (COLLECT )  SET &P2 = &STR(J)
    WHEN (DISCARD )  SET &P2 = &STR(K)
    WHEN (PERFORM )  SET &P2 = &STR(L)
    WHEN (WRITE   )  SET &P2 = &STR(M)
    WHEN (READ    )  SET &P2 = &STR(N)
    WHEN (INQUIRE )  SET &P2 = &STR(O)
    WHEN (FETCH   )  SET &P2 = &STR(P)
    WHEN (EXECUTE )  SET &P2 = &STR(Q)
    WHEN (EXEC    )  SET &P2 = &STR(R)
    WHEN (NONE    )  SET &P2 = &STR(S)
    WHEN (NOCREATE)  SET &P2 = &STR(T)
    END
ELSE +
  SELECT (&P1)
    WHEN (9)         SET &P2 = &STR(A)
    WHEN (8)         SET &P2 = &STR(F)
    WHEN (7)         SET &P2 = &STR(E)
    WHEN (6)         SET &P2 = &STR(G)
    WHEN (5)         SET &P2 = &STR(H)
    WHEN (4)         SET &P2 = &STR(M)
    WHEN (3)         SET &P2 = &STR(N)
    WHEN (2)         SET &P2 = &STR(T)
    WHEN (1)         SET &P2 = &STR(Q)
    WHEN (0)         SET &P2 = &STR(S)
    END
RETURN CODE(&RETURN_CODE)
 
END
 
 
CONVERT_RES: PROC 2 P1 P2
 
SYSREF &P1
SYSREF &P2
SET TEST =
SET CP1 = 1
SET CP2 = 1
 
LOOP_RES: +
IF &CP1 GT &LENGTH(&NRSTR(&P1)) AND +
   &CP2 GT &LENGTH(&NRSTR(&P2)) THEN DO
  SET &P1 = &NRSTR(&TEST)
  RETURN CODE(&RETURN_CODE)
  END
 
IF &SUBSTR(&CP1,&NRSTR(&P1  )) EQ &STR(*) THEN DO
  IF &SUBSTR(&CP1+1,&NRSTR(&P1 )) NE &SUBSTR(&CP2,&NRSTR(&P2 )) AND +
    &SUBSTR(&CP2,&NRSTR(&P2 )) NE &STR( ) THEN +
    SET CP1 = &CP1 - 1
  ELSE +
    SET CP1 = &CP1 + 1
  END
 
/*IF &SUBSTR(&CP1,&NRSTR(&P1  )) EQ &STR( ) THEN
IF &CP1 GT 0 THEN +
  IF &SUBSTR(&CP1,&NRSTR(&P1  )) EQ &STR( ) THEN +
    SET CP2 = &LENGTH(&NRSTR(&P2))+1
 
IF &CP2 LE &LENGTH(&NRSTR(&P2)) THEN +
  SET TEST = &NRSTR(&TEST)&SUBSTR(&CP2,&NRSTR(&P2))
ELSE +
  IF &SUBSTR(&CP1,&NRSTR(&P1  )) NE &STR( ) THEN DO
    SET TEST = &NRSTR(&TEST)&SUBSTR(&CP1,&NRSTR(&P1))
    SET CP2 = &CP2 - 1
    END
 
SET CP1 = &CP1 + 1
SET CP2 = &CP2 + 1
GOTO LOOP_RES
 
END