ISREDIT MACRO
 
/********************************************************************/
/* THIS EDIT MACRO (CATM0101) GENERATES THE WHOHAS REPORTS AND      */
/* CREATES THE PDINAME MEMBER DEPENDING ON THE VALUES IN VARIABLE   */
/* RESOURCE.  VALUE VARIABLE CONTAINS THE RESOURCE TO BE GENERATED. */
/********************************************************************/
 
/* ***************************************    */
/* VARIABLES ARE PASSED TO THIS MACRO         */
/* PDINAME                                    */
/* RESVAL                                     */
/* CONSLIST                                   */
/* COMLIST                                    */
/* SYMLIST                                    */
/* TERMPRO                                    */
/* TERMMSGS                                   */
/* ***************************************    */
/* 04/08/2008 CL.Fenton Corrected INSUFFICIENT STORAGE by collecting
/*            250 ACIDs in ACIDLIST variable.
/* 10/09/2009 CL.Fenton Chgs made in the asterisk analysis.
/* 06/29/2010 CL.Fenton Chgs to work around UNTIL on ACCESS record.
/* 04/19/2011 CL.FENTON Corrected issue with the use of single and
/*            double quotes in NAME field, CSD-AR003073274.
/* 06/06/2012 CL Fenton Corrected 852 and 932 errors on REC2TBL on
/*            resources that have special characters (+, -, *, and /),
/*            CSD-AR003419256.
/* 01/04/2013 CL Fenton Corrected 932 and 900 errors permission that
/*            contain '&' in permission, STS-001536.
/* 04/08/2013 CL Fenton Corrected issue with matching masked RES fields
/*            and selecting from AUDIT record.
/* 07/28/2014 CL Fenton Corrected issue with JES2MON resources not defined
/*            being identified when "JES2." is owned and DEFPROT is specified
/*            in the RDT, STS-007144.
/* 06/29/2016 CL Fenton Corrected issue with resource ownership.
/* 03/15/2017 CL Fenton Corrected issue with MVS.VARY.TCPIP and
/*            MVS.VARY.TCPIP. being reviewed, STS-016392 and STS-019117.
/* 12/12/2017 CL Fenton Corrected 932 errors on permissions that specify
/*            all asterisks (*****) and 912 errors on WHOO_RES_CK that has
/*            asterisks (**), STS-019001.
/* 05/02/2019 CL Fenton Added addition accesses for CICS SPI permissions,
/*            STS-021044.
/* 05/02/2019 CL.FENTON Chgs to evaluate ZCIC0021 for system that are
/*            running both production and test/developement CICS regions,
/*            STS-021044.
 
SET PGMNAME = &STR(CATM0101 05/02/19)
 
SET RETURN_CODE = 0                   /* SET RETURN CODE TO 0  */
 
ISPEXEC  CONTROL  NONDISPL  ENTER
ISPEXEC  CONTROL  ERRORS  RETURN
 
ERROR DO
  SET RETURN_CODE = &LASTCC
  IF &LASTCC GE 16 THEN +
    WRITE &PGMNAME LASTCC = &LASTCC &ZERRLM
  RETURN
  END
 
ISPEXEC VGET (+
  PDINAME     +
  RESVAL      +
  AUDDSNS     +
  CNTL        +
  SENSITVE    +
  TSSLISTP    +
  CATM0405    +
  CONSLIST    +
  COMLIST     +
  SYMLIST     +
  TERMMSGS    +
  ) ASIS
 
SET VGET_RC = &RETURN_CODE
 
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 SYSASIS    = ON
 
NGLOBAL RESOURCE SPC RES ACID ACC8 AUDIT DENY FAC
NGLOBAL RETURN_CODE PGMNAME RESVAL
NGLOBAL SENSITVE MEMBER OMBR LMPUT_SW
NGLOBAL PROF_LIST AUDDSNS CMD
NGLOBAL CUR_DATA TSSLISTP CATM0405 CURDSN
 
ISREDIT NUMBER OFF
ISREDIT DELETE .ZF .ZL
 
SET RETURN_CODE = 0                         /* SET RETURN CODE TO 0 */
 
 
/***************************************************************** */
/*  START PROCESS                                                  */
/***************************************************************** */
 
SET RETURN_CODE = 0   /* SET RETURN CODE TO 0 */
 
SET RECTYPE = 2
SET RESNAME =
 
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
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC VGET ( +
  REC2TBL      +
  ) ASIS
 
SET LINE = 1
 
SET SPC = &STR(          )
SET SPC = &STR(&SPC&SPC&SPC&SPC&SPC&SPC&SPC&SPC&SPC&SPC)
SET RES =
SET ACID = &STR(        )
SET ACCESS =
SET ACC8 = &STR(        )
SET AUDIT = N
SET DENY = &STR( )
 
SET &SYSOUTTRAP = 999999999
 
SET RESVAL = &RESVAL
 
DO A = 1 TO &LENGTH(&NRSTR(&REC2TBL))
  SET CMD =
  SET B = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&A+9)
  SET RESOURCE = &SUBSTR(&A+9:&B-1,&NRSTR(&REC2TBL))
  SET LMPUT_SW = &STR( )
  SET RES =
  SET FAC =
  IF &SYSINDEX(&STR(#),&NRSTR(&RESOURCE)) GT 0 THEN DO
    SET C = &SYSINDEX(&STR(#),&NRSTR(&RESOURCE))
    SET FAC = &SUBSTR(&C+1:&LENGTH(&RESOURCE),&NRSTR(&RESOURCE))
    SET RESOURCE = &SUBSTR(1:&C-1,&NRSTR(&RESOURCE))
    END
  SET A = &B + 1
 
  SET &SYSLIST = ON
  SET RETURN_CODE = 0
  TSS WHOH &RESVAL(&RESOURCE)
  SET &SYSLIST = OFF
  SET LINE = &SYSOUTLINE
 
  IF &RETURN_CODE GT 0 THEN DO
/*  DO X = 1 TO &LINE
/*    SET DATA = &&SYSOUTLINE&X
/*    SET DATA = &NRSTR(&DATA)
/*    SET DATA = &SYSNSUB(2,&DATA)
/*    WRITE &DATA
/*    END
    SET RETURN_CODE = 0
    SET RESULT =
    SYSCALL WHOO_RES_CK RESVAL RESOURCE RESULT
    IF &NRSTR(&RESULT) NE &STR( ) THEN DO
      SET &SYSLIST = ON
      TSS WHOH &RESVAL(&NRSTR(&RESULT))
      SET &SYSLIST = OFF
      SET LINE = &SYSOUTLINE
 
      END
    IF &NRSTR(&RESULT) EQ &STR( ) OR +
       &RETURN_CODE GT 0 THEN DO
      SET CMD = &STR(&SUBSTR(1:74,&SPC)&RESOURCE)
      GOTO BYPASS_RESOURCE
      END
    END
  SET RESOWNER =
  IF &FAC NE &STR() THEN +
    SET RESOURCE = &STR(&RESOURCE.#&FAC)
  DO X = 1 TO &LINE
    SET DATA = &&SYSOUTLINE&X
    SET DATA = &NRSTR(&DATA)
    SET DATA = &SYSNSUB(2,&DATA)
    SET L = &LENGTH(&NRSTR(&DATA))
 
    IF &SUBSTR(1:3,&NRSTR(&DATA)) EQ &STR(TSS) THEN +
      GOTO NEXT_SYSOUT
 
    IF &SUBSTR(1:8,&NRSTR(&DATA)) EQ &STR(&RESVAL) THEN DO
      SET R1       = &SYSINDEX(&STR( ),&NRSTR(&DATA),14) - 1
      IF &R1 GT 14 THEN +
        SET RESOWNER = &SUBSTR(14:&R1,&NRSTR(&DATA))
      ELSE +
        SET RESOWNER =
      GOTO NEXT_SYSOUT
      END
 
    IF &SUBSTR(2:6,&NRSTR(&DATA)) EQ &STR(XAUTH) THEN DO
      IF &NRSTR(&RES) NE &STR() AND +
         &NRSTR(&FAC) EQ &STR() THEN +
        SYSCALL WRITE_REC
      SET RX  = &SYSINDEX(&STR( ),&NRSTR(&DATA ),14) - 1
      SET RES = &SUBSTR(14:&RX,&NRSTR(&DATA))
 
      SET ACID = &SUBSTR(66:73,&NRSTR(&DATA))
      GOTO NEXT_SYSOUT
      END
 
    IF &SUBSTR(4:9,&NRSTR(&DATA)) EQ &STR(ACCESS) THEN DO
      SET ACC8 = &STR(        )
      SET Y = &SYSINDEX(&STR( ),&NRSTR(&DATA ),14)-1
      SET ACCESS = &SUBSTR(14:&Y,&NRSTR(&DATA))
      SET ACCESS = &STR(&ACCESS,)
      SET Y = 1
 
      DO UNTIL &Y GT &LENGTH(&ACCESS)
        SET Z = &SYSINDEX(&STR(,),&STR(&ACCESS),&Y)
        SET ACC = &SUBSTR(&Y:&Z-1,&ACCESS)
        SELECT (&ACC)
          WHEN (ALL)       SET ACC = A
          WHEN (ALTER)     SET ACC = B
          WHEN (INSTALL)   SET ACC = C
          WHEN (BLP)       SET ACC = D
          WHEN (SCRATCH)   SET ACC = E
          WHEN (CREATE)    SET ACC = F
          WHEN (CONTROL)   SET ACC = G
          WHEN (UPDATE)    SET ACC = H
          WHEN (SET)       SET ACC = I
          WHEN (COLLECT)   SET ACC = J
          WHEN (DISCARD)   SET ACC = K
          WHEN (PERFORM)   SET ACC = L
          WHEN (WRITE)     SET ACC = M
          WHEN (READ)      SET ACC = N
          WHEN (INQUIRE)   SET ACC = O
          WHEN (NOCREATE)  SET ACC = P
          WHEN (FETCH)     SET ACC = Q
          WHEN (EXECUTE)   SET ACC = R
          WHEN (EXEC)      SET ACC = S
          WHEN (NONE)      SET ACC = T
          OTHERWISE DO
            WRITE &PGMNAME Found &ACC as an access on &RESOURCE..
            SET ACC =
            END
        END
 
        SET Y = &Z + 1
        SET ACC8 = &ACC8&ACC
 
        END
      SET ACC8 = &SUBSTR(1:8,&ACC8        )
      GOTO NEXT_SYSOUT
      END
 
    IF &SUBSTR(4:9,&NRSTR(&DATA)) EQ &STR(ACTION) THEN DO
      SET IND = &SYSINDEX(AUDIT,&SUBSTR(14:&L,&NRSTR(&DATA)))
      IF &IND GT 0 THEN +
        SET AUDIT = Y
      SET IND = &SYSINDEX(DENY,&SUBSTR(14:&L,&NRSTR(&DATA)))
      IF &IND GT 0 THEN +
        SET DENY = Y
      END
 
    IF &SUBSTR(4:9,&NRSTR(&DATA)) EQ &STR(FAC   ) AND +
       &SYSINDEX(&FAC,&NRSTR(&DATA)) EQ 14 THEN DO
      SYSCALL WRITE_REC
      SET RES = &STR()
      END
 
    NEXT_SYSOUT:+
  END
 
  IF &NRSTR(&FAC) NE &STR( ) THEN DO
    SET ACC8 = &STR(        )
    SET ACID = &STR(        )
    END
 
  IF &NRSTR(&RES) NE  THEN DO
    SYSCALL WRITE_REC
    SET RETURN_CODE = 0
    IF &LMPUT_SW EQ &STR(Y) THEN +
      SET CMD = &STR( )
    ELSE +
      SET CMD = &STR(&SUBSTR(1:74,&STR(&RESOWNER &SPC))&RESOURCE)
    END
  ELSE +
    IF &LMPUT_SW EQ &STR(Y) THEN +
      SET CMD = &STR( )
    ELSE +
      SET CMD = &STR(&SUBSTR(1:74,&STR(&RESOWNER &SPC))&RESOURCE)
/*  SET CMD = &STR(&SUBSTR(1:74,&STR(&RESOWNER &SPC))&RESOURCE)
 
  BYPASS_RESOURCE: +
  IF &NRSTR(&CMD) NE &STR( ) THEN DO
    IF &NRSTR(&RESULT) NE &STR( ) THEN DO
      SET RES = &NRSTR(&RESULT)
      SET RESULT =
      END
    ELSE +
      SET RES = &NRSTR(&RESOWNER)
    SET ACID = &STR(        )
    SYSCALL WRITE_REC  /* CMD NE &STR( ) */
    SET CMD =
    END
  SET RESOWNER =
END
 
ISPEXEC  VPUT  ( -
  T2VGERR -
  ) ASIS
 
SET RETURN_CODE = 0                   /* SET RETURN CODE TO 0  */
 
ISREDIT SORT 49 56 A 1 48 A 75 122 D
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET COUNTER = 1
 
CLEAN_UP: +
SET RETURN_CODE = 0
 
IF &COUNTER GT &LASTLINE THEN +
  GOTO CLEAN_UP_END
 
ISREDIT (DATA) = LINE &COUNTER
 
SET RESOURCE = &SUBSTR(75:122,&NRSTR(&DATA))
SET RES      = &SUBSTR(1:48,&NRSTR(&DATA))
SET ACID     = &SUBSTR(49:56,&NRSTR(&DATA))
 
IF &SYSINDEX(&STR(#),&RESOURCE) GT 0 THEN DO
  SET XX = &SYSINDEX(&STR(#),&NRSTR(&DATA),75)
  SET TDATA = &SUBSTR(1:&XX-1,&NRSTR(&DATA))
  SET TDATA = &SUBSTR(1:122,&NRSTR(&TDATA)&SPC)
  ISREDIT EXCLUDE ALL '&NRSTR(&TDATA)' 1
  END
 
IF &NRSTR(&OACID) NE &NRSTR(&ACID) THEN DO
  SET ORESOURCE = &NRSTR(&RESOURCE)
  SET ORES      = &NRSTR(&RES)
  SET OACID     = &NRSTR(&ACID)
  GOTO CLEAN_UP_BYPASS
  END
 
IF &NRSTR(&ORES) NE &NRSTR(&RES) THEN DO
  SET ORESOURCE = &NRSTR(&RESOURCE)
  SET ORES      = &NRSTR(&RES)
  GOTO CLEAN_UP_BYPASS
  END
 
CLEAN_UP_BYPASS: +
SET COUNTER = &COUNTER + 1
 
GOTO CLEAN_UP
 
CLEAN_UP_END: +
SET RETURN_CODE = 0
 
ISREDIT DELETE ALL X
 
ISREDIT (MEMBER) = MEMBER
ISREDIT (DSNAME) = DATASET
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
  SET RETURN_CODE = &RETURN_CODE +16
  GOTO ERR_EXIT
  END
 
SET RETURN_CODE = 0
 
/* START LIST ----------------------------------------- */
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
ISREDIT CURSOR = 1 0
SET LINE = 0
SET SYSOUTTRAP = 999999
 
 
LIST_LOOP: +
SET RETURN_CODE = 0
 
SET LINE = &LINE + 1
IF &LINE GT &LASTLINE THEN +
  GOTO SORT2
 
ISREDIT (DATA) = LINE &LINE
 
SET CUR_ACID = &SUBSTR(49:56,&NRSTR(&DATA))
SET CUR_TYPE = &SUBSTR(57:64,&NRSTR(&DATA))
 
IF &NRSTR(&CUR_ACID) EQ &STR( ) THEN +
  GOTO LIST_LOOP
 
IF &NRSTR(&CUR_TYPE) NE &STR( ) THEN +
  GOTO LIST_LOOP
 
IF &NRSTR(&CUR_ACID) EQ &STR(*ALL*) THEN DO
  SET TYPE = &STR(GENERIC )
  SET NAME = &NRSTR(&CUR_ACID &SPC)
  GOTO CHANGE_ACID
  END
 
SET RETURN_CODE = 0
 
TSS LIST(&CUR_ACID)
 
SET TSSLIST_RC = &RETURN_CODE
IF &TSSLIST_RC EQ 0 THEN DO
  IF &SUBSTR(1:8,&NRSTR(&SYSOUTLINE1 &SPC)) EQ &STR(TSS LIST) THEN DO
    SET ACID=&SUBSTR(14:21,&NRSTR(&SYSOUTLINE2 &SPC))
    SET NAME=&SUBSTR(37:66,&NRSTR(&SYSOUTLINE2 &SPC))
    SET TYPE=&SUBSTR(14:21,&NRSTR(&SYSOUTLINE3 &SPC))
    END
  ELSE DO
    SET ACID=&SUBSTR(14:21,&NRSTR(&SYSOUTLINE1 &SPC))
    SET NAME=&SUBSTR(37:66,&NRSTR(&SYSOUTLINE1 &SPC))
    SET TYPE=&SUBSTR(14:21,&NRSTR(&SYSOUTLINE2 &SPC))
    END
 
  IF &NRSTR(&CUR_ACID) EQ &NRSTR(&ACID) THEN +
    GOTO CHANGE_ACID
  ELSE -
    DO
    SET TYPE = &STR(NOT_DEF )
    SET NAME = &NRSTR(1 RC=&TSSLIST_RC &SYSOUTLINE1 &SPC)
    END
  END
ELSE DO
  SET TYPE = &STR(NOT_DEF )
  SET NAME = &NRSTR(2 RC=&TSSLIST_RC &SYSOUTLINE1 &SPC)
  END
 
CHANGE_ACID: +
SET RETURN_CODE = 0
 
SELECT &NRSTR(&TYPE)
  WHEN (USER    ) SET TYPE = &STR(&TYPE)
  WHEN (CENTRAL ) SET TYPE = &STR(USER )
  WHEN (MASTER  ) SET TYPE = &STR(USER )
  WHEN (LIMITED ) SET TYPE = &STR(USER )
  WHEN (PROFILE ) SET TYPE = &STR(&TYPE)
  WHEN (GENERIC ) SET TYPE = &STR(&TYPE)
  WHEN (NOT_DEF ) SET TYPE = &STR(&TYPE)
  WHEN (DEPT    ) SET TYPE = &STR(USER )
  WHEN (&STR(DEPT C/A)) SET TYPE = &STR(USER )
  WHEN (DIV     )       SET TYPE = &STR(USER )
  WHEN (&STR(DIV  C/A)) SET TYPE = &STR(USER )
  WHEN (ZONE    )       SET TYPE = &STR(USER )
  WHEN (&STR(ZONE C/A)) SET TYPE = &STR(USER )
  OTHERWISE DO
    WRITE &PGMNAME INVALID TYPE &TYPE WAS FOUND FOR REPORT
    SET TYPE = &STR(&TYPE)
    END
  END
 
NEXT_AMPERSAND: +
SET XA = &SYSINDEX(&SYSNSUB(0,&),&NRSTR(&NAME))
 
IF &XA GT 0 THEN DO
  SET NL = &LENGTH(&NRSTR(&NAME))
  IF &XA EQ 1 THEN DO
    SET NAME = &SUBSTR(2:&NL,&NRSTR(&NAME))
    GOTO NEXT_AMPERSAND
    END
 
  IF &XA EQ &NL THEN DO
    SET NAME = &SUBSTR(1:&NL-1,&NRSTR(&NAME))
    GOTO NEXT_AMPERSAND
    END
 
  SET NAME = &SUBSTR(1:&XA-1,&NRSTR(&NAME))+
             &SUBSTR(&XA+1:&NL,&NRSTR(&NAME))
  GOTO NEXT_AMPERSAND
  END
 
SET TYPE = &SUBSTR(1:8,&NRSTR(&TYPE        ))
SET NAME = &SUBSTR(1:30,&NRSTR(&NAME &SPC))
 
ISREDIT X ALL
ISREDIT FIND ALL '&CUR_ACID' 49
 
SET CF = &STR('&CUR_ACID        ')
SET CT = &STR('&CUR_ACID&TYPE')
ISREDIT CHANGE &CF &CT ALL NX 49
 
SET CF = &STR('                              ')
SET SQ = &SYSINDEX(&STR('),&NRSTR(&NAME))
SET DQ = &SYSINDEX(&STR("),&NRSTR(&NAME))
IF &SQ = 0 THEN +
  SET CT = &STR('&NAME')
ELSE +
  IF &DQ = 0 THEN +
    SET CT = &STR("&NAME")
  ELSE +
    SET CT = &STR(&NAME)
ISREDIT CHANGE &CF &CT ALL NX 124
ISREDIT RESET
 
GOTO LIST_LOOP
 
/* END LIST ----------------------------------------- */
 
SORT2: +
SET RETURN_CODE = 0
 
ISREDIT SORT 001 048 A 049 055 A 075 122 A
/* SORT BY   RES       ACID      RESOURCE  */
ISREDIT SORT 001 048 A 075 122 A 049 055 A
/* SORT BY   RES       RESOURCE  ACID      */
 
SET LP = &STR((
SET RP = )
 
SET CUR_ARES =
SET CUR_ACID =
SET CUR_DATA =
SET RESLIST =
SET PROF_LIST = &STR(#)
SET COUNTER = 1
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
SET CMD = &STR(&SYSDATE   &NRSTR(&PDINAME))
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR( )
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR(XAUTH             )
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR(     RESOURCE)
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR(          ACID     TYPE)
SET CMD = &STR(&CMD&SUBSTR(1:41,&STR(&SPC))ACCESS)
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET DASH = &STR(==========)
SET DASH = &NRSTR(&DASH&DASH&DASH&DASH)
 
SET CMD = &SUBSTR(1:93,&NRSTR(&DASH&DASH&DASH))
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR( )
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
 
WRITE_LOOP: +
SET RETURN_CODE = 0
 
IF &COUNTER GT &LASTLINE THEN DO
  SYSCALL WRITE_ACID
  SYSCALL ADD_MEMBER
  GOTO END_EDIT
  END
 
ISREDIT (DATA) = LINE &COUNTER
 
SET ARES     = &SUBSTR(1:48,&NRSTR(&DATA))
SET ACID     = &SUBSTR(49:56,&NRSTR(&DATA))
SET RESOURCE = &SUBSTR(75:122,&NRSTR(&DATA))
SET AUDIT    = &SUBSTR(73:73,&NRSTR(&DATA))
 
IF &NRSTR(&ARES) NE &NRSTR(&CUR_ARES) THEN DO
  IF &NRSTR(&CUR_ARES) NE &STR() OR +
     &NRSTR(&CURRESOURCE) NE &STR() THEN DO
    SYSCALL WRITE_ACID
 
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    END
  SET CUR_DATA = &NRSTR(&DATA)
  SET CUR_ARES = &NRSTR(&ARES)
  SET CUR_ACID =
  SET RESLIST  =
  END
 
IF &NRSTR(&RESLIST) EQ &STR() AND +
   &NRSTR(&ARES) NE &STR( ) THEN DO
  SET RETURN_CODE = 0
 
  ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(ARES) +
     DATALEN(&LENGTH(&NRSTR(&ARES)))
 
  SET X = 0
  END
ELSE +
  SET X = &SYSINDEX(&NRSTR(&RESOURCE),&NRSTR(&RESLIST))
 
IF &NRSTR(&ACID) NE &NRSTR(&CUR_ACID) THEN DO
  IF &NRSTR(&CUR_ACID) NE &STR() THEN +
    SYSCALL WRITE_ACID
  SET CUR_ACID = &NRSTR(&ACID)
  SET CUR_DATA = &NRSTR(&DATA)
  END
 
SET CURRESOURCE = &NRSTR(&RESOURCE)
IF &X EQ 0 THEN DO
  SET RESLIST = &NRSTR(&RESLIST.&CURRESOURCE.#)
  SET RESAUD  =
  IF &AUDIT EQ X OR +
     &AUDIT EQ Z THEN +
    SET RESAUD  = &STR(AUDIT)
 
  IF &SYSINDEX(&STR(#),&NRSTR(&CURRESOURCE)) EQ 0 THEN +
    SET DDSN=&NRSTR(     &CURRESOURCE &RESAUD)
  ELSE DO
    SET AB = &SYSINDEX(&STR(#),&NRSTR(&CURRESOURCE))
    SET AC = &SYSINDEX(&STR( ),&NRSTR(&CURRESOURCE))
    SET CURRES = &SUBSTR(1:&AB-1,&NRSTR(&CURRESOURCE))
    SET CURFAC = &SUBSTR(&AB+1:&AC,&NRSTR(&CURRESOURCE))
    SET CURRESFAC = &NRSTR(&CURRES      FAC=&CURFAC)
    SET DDSN = &STR(     &SUBSTR(1:48,&CURRESFAC&SPC) &RESAUD)
    END
  SET RETURN_CODE = 0
 
  ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(DDSN) +
      DATALEN(&LENGTH(&NRSTR(&DDSN)))
  END
 
/*IF &NRSTR(&ACID) NE &NRSTR(&CUR_ACID) THEN DO
/*  IF &NRSTR(&CUR_ACID) NE &STR() THEN +
/*    SYSCALL WRITE_ACID
/*  SET CUR_ACID = &NRSTR(&ACID)
/*  SET CUR_DATA = &NRSTR(&DATA)
/*  END
 
SET COUNTER = &COUNTER + 1
 
GOTO WRITE_LOOP
 
END_EDIT: +
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
 
ISREDIT END
 
EXIT
END
 
 
/* *************************************** */
/*  SYSCALL SUBROUTINES                    */
/* *************************************** */
 
WRITE_ACID: PROC 0
 
SET LP = &STR((
SET RP = )
 
IF &NRSTR(&CUR_DATA) EQ &STR() THEN DO
  SET AC = &NRSTR(          Resource Not Defined.)
 
  ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC)))
 
  SET AC = &NRSTR( )
 
  ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC)))
 
  GOTO WRITE_END
  END
SET CURRESOURCE = &SUBSTR(75:122,&NRSTR(&CUR_DATA))
SET CUR_ARES    = &SUBSTR(1:48,&NRSTR(&CUR_DATA))
SET CUR_ACID    = &SUBSTR(49:56,&NRSTR(&CUR_DATA))
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 &SPC))
SET CUR_DENY    = &SUBSTR(74:74,&NRSTR(&CUR_DATA &SPC))
SET CUR_NAME    = &SUBSTR(124:153,&NRSTR(&CUR_DATA &SPC))
 
IF &NRSTR(&CUR_ACID) EQ &STR() THEN DO
  SET AC = &NRSTR(          No ACIDS have access.)
 
  ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC)))
 
  SET AC = &NRSTR( )
 
  ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC)))
 
  GOTO WRITE_END
  END
/* 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 ACCESS =
IF &STR(&CUR_ACC) NE &STR( ) THEN DO
  SET ACCESS = &STR( ACCESS&LP)
  DO X = 1 TO 8
    SET ACC = &SUBSTR(&X,&STR(&CUR_ACC))
    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 = CREATE
        WHEN (F) SET ACC = SCRATCH
        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 = FETCH
        WHEN (Q) SET ACC = EXECUTE
        WHEN (R) SET ACC = EXEC
        WHEN (S) SET ACC = NONE
        WHEN (T) SET ACC = NOCREATE
        END
      SET ACCESS = &STR(&ACCESS.&ACC.,)
      END
    END
  SET X = &LENGTH(&NRSTR(&ACCESS))
  SET ACCESS = &STR(&SUBSTR(1:&X-1,&NRSTR(&ACCESS))&RP)
  END
 
SET AC = &SUBSTR(1:10,&SPC)&NRSTR(&CUR_ACID) &NRSTR(&CUR_TYPE)
SET AC = &NRSTR(&AC NAME=&CUR_NAME)
SET AC = &NRSTR(&AC&ACCESS&ACTION)
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
   DATALEN(&LENGTH(&NRSTR(&AC)))
 
IF &NRSTR(&CUR_TYPE) NE &STR(PROFILE) THEN +
  GOTO WRITE_END
 
IF &SYSINDEX(&NRSTR(&CUR_ACID.#),&NRSTR(&PROF_LIST)) NE 0 THEN +
  GOTO WRITE_END
 
SET PROF_LIST = &NRSTR(&PROF_LIST.&CUR_ACID.#)
 
/* *************************************** */
/* EXPAND PROFILE                          */
/* *************************************** */
SET CURACID = &NRSTR(&CUR_ACID)
 
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
 
DO X = 1 TO &LENGTH(&NRSTR(&ACIDLIST)) BY 38
SET UACID = &SUBSTR(&X:&X+7,&NRSTR(&ACIDLIST))
SET NAME  = &SUBSTR(&X+8:&X+37,&NRSTR(&ACIDLIST))
 
SET AC = &SUBSTR(1:15,&NRSTR(&SPC))&NRSTR(USER=&UACID)
SET AC = &NRSTR(&AC NAME=&NAME)
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
   DATALEN(&LENGTH(&NRSTR(&AC)))
 
END
 
IF &DATATYPE(&ACIDNUM) EQ &STR(NUM) THEN +
  GOTO GET_NEXT_ACIDS
 
WRITE_END: +
SET RETURN_CODE = 0
 
RETURN CODE(&RETURN_CODE)
END
 
 
ADD_MEMBER: PROC 0
 
SET M8 = &SUBSTR(1:8,&MEMBER        )
SET RETURN_CODE = 0
 
ISPEXEC LMMADD DATAID(&SENSITVE) MEMBER(&MEMBER)
 
IF &RETURN_CODE EQ 4 THEN DO          /* MEMBER ALREADY EXISTS
  SET RETURN_CODE = 0
 
  ISPEXEC LMMREP DATAID(&SENSITVE) MEMBER(&MEMBER)
 
  IF &RETURN_CODE NE 0 THEN DO
    WRITE &PGMNAME LMMREP_SENS_RCODE = &RETURN_CODE &MEMBER  &ZERRSM
    END
  ELSE DO
    WRITE &PGMNAME SENSITVE MEMBER &M8 COMPLETE  LMMREP &RETURN_CODE
    END
  END
ELSE DO
  IF &RETURN_CODE NE 0 THEN +
    WRITE &PGMNAME LMMADD_SENS_RCODE = &RETURN_CODE &MEMBER  &ZERRSM
  ELSE +
    WRITE &PGMNAME SENSITVE member &M8 complete  LMMADD &RETURN_CODE
  END
 
RETURN CODE(&RETURN_CODE)
END
 
 
WRITE_REC: PROC 0
 
/*WRITE LMPUT_SW=&LMPUT_SW CMD="&CMD"
IF &NRSTR(&RES) EQ &STR( ) OR +
  &NRSTR(&CMD) NE &STR( ) THEN +
  GOTO PERFORM_LMPUT
 
SET TKEY = &NRSTR(&RES)
SYSCALL TRUNC_MASK TKEY
 
SET RPC = 0         /* RULE PERIOD COUNTER
SET DPC = 0         /* RESOURCE PERIOD COUNTER
 
DO RBI = 1 TO &LENGTH(&NRSTR(&TKEY)) +
  WHILE &SUBSTR(&RBI,&NRSTR(&TKEY)) NE &STR( )
  SET X = &SYSINDEX(&STR(.),&NRSTR(&TKEY),&RBI)
  IF &X GT 1 THEN DO
    SET RPC = &RPC + 1
    SET RBI = &X
    END
  ELSE +
    SET RBI = &LENGTH(&NRSTR(&TKEY))
  END
 
DO DBI = 1 TO &LENGTH(&NRSTR(&RESOURCE)) +
  WHILE &SUBSTR(&DBI,&NRSTR(&RESOURCE)) NE &STR( )
  SET X = &SYSINDEX(&STR(.),&NRSTR(&RESOURCE),&DBI)
  IF &X GT 1 THEN DO
    SET DPC = &DPC + 1
    SET DBI = &X
    END
  ELSE +
    SET DBI = &LENGTH(&NRSTR(&RESOURCE))
  END
 
IF &RPC EQ &DPC AND +
  &SYSINDEX(&STR(*),&NRSTR(&RES)) EQ 0 THEN +
  GOTO PERFORM_LMPUT
 
IF &RPC EQ &DPC AND +
   &RPC EQ 0 AND +
   (&SYSINDEX(&STR(*),&NRSTR(&RES)) EQ 1 OR +
    &SYSINDEX(&STR(+),&NRSTR(&RES)) EQ 1) THEN +
  GOTO PERFORM_LMPUT
 
IF &DPC LT &RPC AND +
   &SYSINDEX(&STR(. ),&NRSTR(&RESOURCE )) EQ 0 THEN DO
  SET RES = &STR( )
  GOTO BYPASS_LMPUT
  END
 
SET DX = 1  /* RESOURCE INDEX
SET RX = 1  /* RULE INDEX
SET M = 0   /* MATCH CHARACTERS
NEXT_AST: +
IF &DX GT &LENGTH(&NRSTR(&RESOURCE)) OR +
   &RX GT &LENGTH(&NRSTR(&TKEY)) THEN DO
  SET DX = &DX - 1
  SET RX = &RX - 1
  GOTO FINISH_AST
  END
 
IF &SUBSTR(&DX,&NRSTR(&RESOURCE)) EQ &SUBSTR(&RX,&NRSTR(&TKEY)) THEN DO
  SET RX = &RX + 1
  SET M  = &M  + 1
  END
ELSE +
  IF &SUBSTR(&RX,&NRSTR(&TKEY)) EQ &STR(*) THEN DO
    SET RX = &RX + 1
    SET M  = &M  + 1
    END
  ELSE +
    IF &RX GT 1 THEN +
      IF &SUBSTR(&RX-1,&NRSTR(&TKEY)) EQ &STR(*) THEN +
        SET M  = &M  + 1
 
SET DX = &DX + 1
GOTO NEXT_AST
 
FINISH_AST: +
SET RETURN_CODE = 0
/*WRITE RESVAL: &NRSTR(&RESVAL) RESOURCE: &NRSTR(&RESOURCE) +
/*  RES: &NRSTR(&RES)
 
IF &LENGTH(&NRSTR(&TKEY)) LT 3 AND +
  &M EQ &DX AND +
  &SUBSTR(&RX,&NRSTR(&TKEY)) EQ &STR(*) THEN
ELSE +
  IF &M EQ &DX AND +
     &SUBSTR(&RX,&NRSTR(&TKEY)) EQ &STR(*) AND +
     &DPC LT 2 THEN +
    GOTO BYPASS_LMPUT
 
PERFORM_LMPUT: +
SET RES = &SUBSTR(1:48,&NRSTR(&RES.&SPC))
SET CMD = &NRSTR(&RES.&ACID        &ACC8)
 
DO Z = 1 TO &LENGTH(&STR(&AUDDSNS)) BY 50
  SET AUDDSN = &SUBSTR(&Z:&Z+49,&STR(&AUDDSNS))
  SET X1 = &SYSINDEX(&STR( ),&STR(&AUDDSN))
  SET AUDDSN = &SUBSTR(1:&X1-1,&STR(&AUDDSN))
 
  SET AUDX = &STR(&AUDDSN)
 
  SYSCALL TRUNC_MASK AUDX
 
  DO X = 1 TO &LENGTH(&NRSTR(&AUDX)) +
    WHILE &SUBSTR(&X,&NRSTR(&AUDX)) EQ &STR(*)
    END
 
  SET TDATA = &SUBSTR(&X:&LENGTH(&NRSTR(&AUDX)),&NRSTR(&AUDX))
  SET Y = 0
  SET Y = 1
 
  DO X1 = 1 TO &LENGTH(&NRSTR(&TDATA))
    SET Y1 = &SYSINDEX(&SUBSTR(1:&X1,&NRSTR(&TDATA)),&NRSTR(&RESOURCE))
    IF &Y1 GT &Y THEN SET Y = &Y1
    END
 
  IF &Y EQ 0 THEN SET Y = 1
  SET MCNT = 0
 
  DO A1 = 1 TO &LENGTH(&NRSTR(&TDATA))
    IF &SUBSTR(&A1,&NRSTR(&TDATA)) EQ &STR(+) OR +
       &SUBSTR(&A1,&NRSTR(&TDATA)) EQ +
       &SUBSTR(&A1 + &Y - 1,&NRSTR(&RESOURCE        )) THEN +
      SET MCNT = &MCNT + 1
    ELSE +
      SET A1 = &LENGTH(&NRSTR(&TDATA))
    END
 
  IF &LENGTH(&NRSTR(&TDATA)) EQ &MCNT THEN DO
    IF &AUDIT EQ N THEN +
      SET AUDIT = &STR(X)
    ELSE +
      SET AUDIT = &STR(Z)
    SET Z = &LENGTH(&STR(&AUDDSNS))
    END
  END
 
IF &NRSTR(&RES) EQ &STR( ) OR +
   &NRSTR(&ACID) EQ &STR( ) THEN SET AUDIT = &STR( )
 
SET RESOURCE = &SUBSTR(1:48,&STR(&RESOURCE &SPC))
SET CMD = &NRSTR(&CMD.&AUDIT&DENY&RESOURCE.1)
ISREDIT LINE_AFTER .ZLAST = (CMD)
SET LMPUT_SW = &STR(Y)
SET CMD = &STR( )
 
BYPASS_LMPUT: +
SET RETURN_CODE = 0
 
SET ACCESS =
SET ACC8 = &STR(        )
SET AUDIT = N
SET DENY = &STR( )
 
RETURN CODE(&LASTCC)
END
 
 
TRUNC_MASK: PROC 1 STRING
SYSREF &STRING
SET RETURN_CODE = 0
SET DL = &LENGTH(&NRSTR(&STRING))
IF &DL EQ 0 THEN RETURN CODE(&RETURN_CODE)
IF &DL LT 3 THEN RETURN CODE(&RETURN_CODE)
DO X = &DL TO 1 BY -1 UNTIL &SUBSTR(&X,&NRSTR(&STRING)) NE &STR(*)
  END
IF &X EQ 0 THEN RETURN CODE(&RETURN_CODE)
IF &X LT &DL THEN SET DL = &X
IF &SUBSTR(&DL,&NRSTR(&STRING)) EQ &STR(*) OR +
   &SUBSTR(&DL,&NRSTR(&STRING)) EQ &STR(%) THEN +
  SET DL = &DL - 1
IF &SUBSTR(&DL-1:&DL,&NRSTR(&STRING)) EQ &STR(*.) OR +
   &SUBSTR(&DL-1:&DL,&NRSTR(&STRING)) EQ &STR(%.) THEN +
  SET DL = &DL - 2
/*IF &SUBSTR(&DL,&NRSTR(&STRING)) EQ &STR(.) THEN +
/*  SET DL = &DL - 1
SET &STRING = &SUBSTR(1:&DL,&NRSTR(&STRING))
RETURN CODE(&RETURN_CODE)
END
 
 
WHOO_RES_CK: PROC 3 P1 P2 P3
SYSREF &P1
SYSREF &P2
SYSREF &P3
SET RETURN_CODE = 0
SET &SYSLIST = ON
TSS WHOO &P1(*)
SET &SYSLIST = OFF
SET LINE = &SYSOUTLINE
DO A = 1 TO &LINE
  SET DATA = &&SYSOUTLINE&A
  SET DATA = &NRSTR(&DATA)
  SET DATA = &SYSNSUB(2,&DATA)
  SET L = &LENGTH(&NRSTR(&DATA))
  SET L = &SYSINDEX(&STR( ),&NRSTR(&DATA),24) - 1
  IF &L GE 24 THEN DO
    SET DATA = &SUBSTR(24:&L,&NRSTR(&DATA))
    SYSCALL TRUNC_MASK DATA
 
    DO X = 1 TO &LENGTH(&NRSTR(&DATA)) +
      WHILE &SUBSTR(&X,&NRSTR(&DATA)) EQ &STR(*)
      END
 
    IF &X GT &LENGTH(&NRSTR(&DATA)) THEN DO
      SET P3 = &NRSTR(&DATA)
      RETURN CODE(&RETURN_CODE)
      END
 
    SET TDATA = &SUBSTR(&X:&LENGTH(&NRSTR(&DATA)),&NRSTR(&DATA))
    SET Y = 0
    SET Y = 1
 
    DO X1 = 1 TO &LENGTH(&NRSTR(&TDATA))
      SET Y1 = &SYSINDEX(&SUBSTR(1:&X1,&NRSTR(&TDATA)),&NRSTR(&P2))
      IF &Y1 GT &Y THEN DO
        SET Y = &Y1
        SET DATA = &STR( )
        END
      END
 
    IF &Y EQ 0 THEN SET Y = 1
    SET MCNT = 0
 
    DO A1 = 1 TO &LENGTH(&NRSTR(&TDATA))
      IF &SUBSTR(&A1,&NRSTR(&TDATA)) EQ &STR(+) OR +
         &SUBSTR(&A1,&NRSTR(&TDATA)) EQ +
         &SUBSTR(&A1 + &Y - 1,&NRSTR(&P2        )) THEN +
        SET MCNT = &MCNT + 1
      ELSE +
        SET A1 = &LENGTH(&NRSTR(&TDATA))
      END
 
    IF &LENGTH(&NRSTR(&TDATA)) EQ &MCNT THEN DO
      SET P3 = &NRSTR(&DATA)
      RETURN CODE(&RETURN_CODE)
      END
 
    END
END
 
RETURN CODE(&RETURN_CODE)
END