ISREDIT MACRO
 
/********************************************************************/
/* THIS EDIT MACRO (CATM0102) GENERATES THE WHOHAS REPORTS AND      */
/* CREATES THE PDINAME MEMBER FOR MODE WITHOUT USING THE WHOHAS     */
/* COMMAND.                                                         */
/********************************************************************/
 
/* ***************************************    */
/* VARIABLES ARE PASSED TO THIS MACRO         */
/* PDINAME                                    */
/* RESVAL                                     */
/* CONSLIST                                   */
/* COMLIST                                    */
/* SYMLIST                                    */
/* TERMPRO                                    */
/* TERMMSGS                                   */
/* ***************************************    */
/* 03/18/2010 CL.Fenton Copied from CATM0101 and chgd to collect only
/*            XA MODE entries from TSS LIST(ACIDS)DATA(NAME,RESOURCE,XA)
/* 12/10/2012 CL.Fenton Corrected 900 error, STS-001432.
/* 05/02/2019 CL Fenton Added addition accesses for CICS SPI permissions,
/*            STS-021044.
 
SET PGMNAME = &STR(CATM0102 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    +
  TSSLIST     +
  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
NGLOBAL RETURN_CODE PGMNAME
NGLOBAL SENSITVE MEMBER OMBR
NGLOBAL PROF_LIST AUDDSNS
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 LINE = 1
 
SET SPC = &STR(          )
SET SPC = &STR(&SPC&SPC&SPC&SPC&SPC&SPC&SPC&SPC&SPC&SPC)
SET RES =
SET ACID =
SET ACCESS =
SET ACC8 = &STR(        )
SET AUDIT = N
SET DENY = &STR( )
SET REC2TBL=&STR(DORMANT IMPL WARN )
 
GETFILE: +
SET RETURN_CODE = 0
 
ISPEXEC LMGET DATAID(&TSSLIST) MODE(INVAR) DATALOC(DATA) +
  DATALEN(INLNGTH) MAXLEN(80)
 
SET LMGET_TSSLIST_RC = &RETURN_CODE
IF &RETURN_CODE EQ 8 THEN DO              /* END OF FILE */
  SET LMGET_TSSLIST_RC = 0
  GOTO JOBDONE
  END
 
/*SET DATA = &STR(&DATA)
SET L = &LENGTH(&NRSTR(&DATA))
 
IF &SUBSTR(1:3,&NRSTR(&DATA)) EQ &STR(TSS) THEN +
  GOTO NEXT_SYSOUT
 
IF &SUBSTR(1:10,&NRSTR(&DATA)) EQ &STR(ACCESSORID) THEN DO
  IF &STR(&RES) NE  THEN +
    SYSCALL WRITE_REC
  SET ACID = &SUBSTR(14:21,&NRSTR(&DATA))
  SET RES  =
  GOTO NEXT_SYSOUT
  END
 
IF &SUBSTR(1:10,&NRSTR(&DATA)) EQ &STR(MODE      ) THEN DO
  SET RESOWNER  = &STR(&ACID)
  SET RESDATA   = &SUBSTR(14:&L,&NRSTR(&DATA ))
  GOTO NEXT_SYSOUT
  END
 
IF &SUBSTR(1:7,&NRSTR(&DATA)) EQ &STR(XA MODE) THEN DO
  SET RX   = &SYSINDEX(&STR( ),&NRSTR(&DATA ),14) - 1
  SET RES  = &SUBSTR(14:&RX,&NRSTR(&DATA))
  SET C=&SYSINDEX(&STR( &NRSTR(&RES)),&NRSTR( &REC2TBL )) + 1
  IF &C GT 1 THEN DO
    SET D = &SYSINDEX(&STR( ),&NRSTR( &REC2TBL ),&C) - 1
    SET RESOURCE = &SUBSTR(&C:&D,&NRSTR( &REC2TBL ))
    SET B = &LENGTH(&NRSTR(&RES))
    END
  ELSE +
    SET RES = &STR( )
 
  SET R1   = &SYSINDEX(&STR( ),&NRSTR(&DATA ),60) - 1
  GOTO NEXT_SYSOUT
  END
 
NEXT_SYSOUT:+
GOTO GETFILE
 
 
JOBDONE: +
IF &STR(&RES) NE  THEN +
  SYSCALL WRITE_REC
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET COUNTER = 1
 
DO A = 1 TO &LENGTH(&NRSTR(&RESDATA)) BY 12
  SET B = &SYSINDEX(&STR( ),&NRSTR(&RESDATA ),&A)
  IF &B GT &A THEN DO
    SET RES      = &SUBSTR(&A:&B-1,&NRSTR(&RESDATA ))
    SET C=&SYSINDEX(&STR( &NRSTR(&RES)),&NRSTR( &REC2TBL)) + 1
    IF &C GT 1 THEN DO
      SET D = &SYSINDEX(&STR( ),&NRSTR( &REC2TBL ),&C) - 1
      SET RESOURCE = &SUBSTR(&C:&D,&NRSTR( &REC2TBL ))
      SET RETURN_CODE = 0
      ISREDIT FIND FIRST '&RESOURCE' 75
      IF &RETURN_CODE GT 0 THEN DO
        SET CMD = &STR(&SUBSTR(1:74,&STR(&RES &SPC))&RESOURCE)
        ISREDIT LINE_AFTER .ZLAST = (CMD)
        END
      END
    END
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
 
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 &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 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  */
 
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(&DATA) NE &NRSTR(&CUR_DATA) THEN +
/*  SET CUR_DATA = &NRSTR(&DATA)
 
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))
 
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)
 
  SET DDSN=&NRSTR(     &CURRESOURCE &RESAUD)
  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 = )
 
/*SET RESOURCE = &SUBSTR(75:122,&NRSTR(&CUR_DATA))
/*SET RES      = &SUBSTR(1:48,&NRSTR(&CUR_DATA))
/*SET ACID     = &SUBSTR(49:56,&NRSTR(&CUR_DATA))
 
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 = 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 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)
/*SET AC = &NRSTR(&AC *&CUR_ARES* &CURRESOURCE)
 
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
 
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
 
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 &SUBSTR(&RX-1,&NRSTR(&TKEY)) EQ &STR(*) THEN +
      SET M  = &M  + 1
 
SET DX = &DX + 1
GOTO NEXT_AST
 
FINISH_AST: +
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 = &STR(&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))
 
  IF &SYSINDEX(&STR(&AUDDSN),&STR(&RES)) EQ 1 OR +
     &SYSINDEX(&NRSTR(&AUDDSN),&NRSTR(&RESOURCE)) EQ 1 THEN DO
    IF &AUDIT EQ N THEN +
      SET AUDIT = &STR(X)
    ELSE +
      SET AUDIT = &STR(Z)
    SET Z = &LENGTH(&STR(&AUDDSNS))
    END
 
  SET AUDX = &STR(&AUDDSN)
  SET SCNT = 0
  STAR_CHK: +
  IF &SYSINDEX(&STR(*),&STR(AUDX)) EQ 0 THEN +
    GOTO STAR_END
  IF &SUBSTR(1:1,&STR(&AUDX)) EQ &STR(*) THEN DO
    SET X1 = &LENGTH(&STR(&AUDX))
    SET AUDX = &SUBSTR(2:&X1,&STR(&AUDX))
    SET SCNT = &SCNT + 1
    GOTO STAR_CHK
    END
 
  IF &SYSINDEX(&STR(&AUDX),&STR(&RES)) EQ &SCNT + 1 THEN DO
    IF &AUDIT EQ N THEN +
      SET AUDIT = &STR(X)
    ELSE +
      SET AUDIT = &STR(Z)
    SET Z = &LENGTH(&STR(&AUDDSNS))
    END
 
  STAR_END: +
  IF &STR(&AUDDSN) GT &STR(&RES) THEN +
    SET Z = &LENGTH(&STR(&AUDDSNS))
 
  END
 
SET CMD = &STR(&CMD.&AUDIT&DENY&SUBSTR(1:48,&STR(&RESOURCE &SPC))1)
ISREDIT LINE_AFTER .ZLAST = (CMD)
 
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)
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