ISREDIT MACRO       /* CAAM0421 EDIT TEMP4(pdi*)   */
 
/* 06/01/2004 JL.NELSON CREATED TO WRITE OUT NEW FINDINGS
/* 06/15/2004 JL.NELSON ADDED EXIT CODE
/* 07/12/2004 JL.NELSON copied from CARM0421 for TSS
/* 11/16/2004 JL.NELSON Drop N/A Alias or File not found
/* 11/16/2004 JL.NELSON Limit PDI to 25 user errors
/* 01/14/2005 JL.NELSON Changed messages for AU log and access.
/* 01/25/2005 JL.NELSON Add data set list to PDI members for Access
/* 01/28/2005 JL.NELSON Add data set list to PDI members for Generic
/* 02/01/2005 JL.NELSON Indent USERs and PROFILEs
/* 02/09/2005 JL.NELSON Changed constants to variables before rename
/* 02/17/2004 JL.NELSON Moved PDILIMIT to variable pool
/* 03/10/2005 JL.NELSON Changed LMMREP to LMMADD/LMMREP to avoid errors
/* 06/06/2006 C. STERN  Updated ERROR ROUTINE.
/* 06/09/2006 C. STERN  Resolved error code 840 (missing close paren.)
/*                      Resolved error code 920 (end pos. < start pos.)
/* 06/28/2007 CL.FENTON Resolved several rc 20 error on ISREDIT cmds.
/* 07/25/2007 CL.FENTON Resolved rc 932 and chg ISREDIT END to CANCEL.
/* 07/25/2007 CL.FENTON chgs to offsets in TEMP4 records
/* 04/14/2008 CL.FENTON Corrected extract of UID string with space
/* 08/13/2010 CL.FENTON Corrected excluding UID strings with different
/*            accesses.
/* 06/17/2011 CL.FENTON Added ISREDIT CONTROLs.  Added additional
/*            analysis to remove entries that are less specific rule.
/*            TEST_KEYS added for this analysis.
/* 05/23/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.
/* 03/06/2014 CL.FENTON Removed TEST_KEYS.  Chgs include the ACF2 TEST
/*            command to ensure the proper permission is used, STS-004278
/*            and STS-004282.
/* 10/21/2014 CL.FENTON Chgs to ACF2 TEST to compare KEY1 and KEY2.  Plus
/*            evaluate both UID and LID STS-008154.
/* 09/08/2015 CL.FENTON Chgs made to ACF2 TEST to evaluate ACCESS to avoid
/*            issues with NEXTKEY with accesses, STS-012020.
 
SET PGMNAME = &STR(CAAM0421 09/08/15)
 
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 DO
    WRITE &PGMNAME LASTCC = &LASTCC &ZERRLM
    WRITE &PGMNAME MEMBER = &MEMBER
    END
  RETURN
  END
 
/* *************************************** */
/* VARIABLES ARE PASSED TO THIS MACRO      */
/* CONSLIST                                */
/* COMLIST                                 */
/* SYMLIST                                 */
/* TERMMSGS                                */
/* *************************************** */
 
NGLOBAL RETURN_CODE PGMNAME
 
ISPEXEC CONTROL NONDISPL ENTER
ISPEXEC CONTROL ERRORS RETURN
 
ISREDIT (MEMBER) = MEMBER
SET RETURN_CODE = 0
 
ISPEXEC VGET ( +
  CONSLIST     +
  COMLIST      +
  SYMLIST      +
  TERMMSGS     +
  AUACCESS     +
  PDIDD        +
  PDIMBR       +
  RPTMBR       +
  ODSNAME      +
  TBLUSR       +
  ) ASIS
 
SET AM21VGET = &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 AUACCESS/&AUACCESS
  WRITE &PGMNAME PDIDD/&PDIDD PDIMBR/&PDIMBR RPTMBR/&RPTMBR +
    ODSNAME/&ODSNAME TBLUSR/&TBLUSR
  GOTO ERR_EXIT
  END
 
SET SYSSYMLIST = &SYMLIST          /* CONTROL SYMLIST/NOSYMLIST */
SET SYSCONLIST = &CONSLIST         /* CONTROL CONLIST/NOCONLIST */
SET SYSLIST    = &COMLIST          /* CONTROL LIST/NOLIST       */
SET SYSMSG     = &TERMMSGS         /* CONTROL MSG/NOMSG         */
 
ISREDIT CHANGE ALL '"' "'"
ISREDIT (ROW) = LINENUM .ZLAST
 
IF &ROW EQ 0 THEN +
  GOTO EXIT_IT
 
ISREDIT SORT 7 108 A
 
SET COUNT = 1
 
DUPLICATE_LOOP: +
IF &COUNT GT &ROW THEN DO
  ISREDIT DELETE ALL X
  ISREDIT (ROW) = LINENUM .ZLAST
  ISREDIT CURSOR = 1 0
  SET RETURN_CODE = 0
  SET COUNT = 1
  GOTO DUPLICATE_END
  END
 
ISREDIT (XSTAT) = XSTATUS &COUNT
 
IF &XSTAT EQ &STR(NX) THEN DO
  ISREDIT (DATA) = LINE &COUNT
  ISREDIT EXCLUDE ALL "&SUBSTR(7:93,&NRSTR(&DATA))" 7 93
  ISREDIT FIND FIRST "&SUBSTR(7:93,&NRSTR(&DATA))" 7 93
  END
 
SET COUNT = &COUNT + 1
 
GOTO DUPLICATE_LOOP
 
 
DUPLICATE_END: +
SET RETURN_CODE = 0
ISREDIT (DSNAME) = DATASET
 
SET BLANK = &STR( )
 
SET LP = &STR((
SET RP = )
SET SPC = &STR(          )
SET SPC = &STR(&SPC.&SPC.&SPC.&SPC.&SPC)
 
SET ACC_TBL = &STR(0NONE 4EXEC 1READ 2WRITE3ALLOC)
 
SET ACC_SW =
SET UACC_SW =
SET LOG_SW =
 
SET AUUACC_LVL = 0
SET AUUACC     = NONE
SET AX = &SYSINDEX(&STR(UACC  ),&STR(&TBLUSR))
 
IF &AX GT 0 THEN DO
  SET AUUACC_LVL  = &SUBSTR(&AX+8:&AX+8,&NRSTR(&TBLUSR))
  SELECT &AUUACC_LVL
    WHEN (0) DO
      SET AUUACC = &STR(NONE )
      SET AUUACC_MASK = &STR('      ') /* NONE              */
      END
    WHEN (1) DO
      SET AUUACC = &STR(EXEC )
      SET AUUACC_MASK = &STR(P'   =  ') /* EXEC             */
      END
    WHEN (3) DO
      SET AUUACC = &STR(READ )
      SET AUUACC_MASK = &STR(P'=  =  ') /* READ             */
      END
    WHEN (5) DO
      SET AUUACC = &STR(WRITE)
      SET AUUACC_MASK = &STR(P'== =  ') /* WRITE/UPDATE */
      END
    WHEN (9) DO
      SET AUUACC = &STR(ALLOC)
      SET AUUACC_MASK = &STR(P'====  ') /* ALLOC            */
      END
    END
  END
 
SET AULOG_LVL = 0
SET AULOG     = NONE
SET BX = &SYSINDEX(&STR(LOGGING ),&STR(&TBLUSR))
 
IF &BX GT 0 THEN DO
  SET AULOG_LVL  = &SUBSTR(&BX+8:&BX+8,&NRSTR(&TBLUSR))
  SET AULOG_SET  = &SUBSTR(&BX+8:&BX+8,&NRSTR(&TBLUSR))
  SELECT &AULOG_LVL
    WHEN (0) SET AULOG = &STR(NONE )
    WHEN (1) SET AULOG = &STR(EXEC )
    WHEN (3) SET AULOG = &STR(READ )
    WHEN (5) SET AULOG = &STR(WRITE)
    WHEN (9) SET AULOG = &STR(ALLOC)
    END
  SET AULOG      = &AULOG
  END
 
ISREDIT EXCLUDE ALL '3' 49
 
ISREDIT DELETE ALL X
 
ISREDIT EXCLUDE ALL &AUUACC_MASK 94
ISREDIT EXCLUDE ALL '0' 49
ISREDIT CURSOR = 1 0
 
REC2_START: +
SET RETURN_CODE = 0
 
ISREDIT FIND '2' 49 NX
 
IF &RETURN_CODE NE 0 THEN DO
  SET CNT = 1
  GOTO REC_START
  END
 
ISREDIT (CURLINE) = LINENUM .ZCSR
 
ISREDIT (DATA) = LINE &CURLINE
 
SET KEY1    = &SUBSTR(01:48,&STR(&DATA))
SET RECTYPE = &SUBSTR(49,&STR(&DATA))
SET KEY2    = &SUBSTR(50:99,&STR(&DATA))
 
SET X = &SYSINDEX(&LP,&NRSTR(&KEY2)) + 1
SET Y = &SYSINDEX(&RP,&NRSTR(&KEY2))
IF &Y = 0 THEN +
  SET Y = &SYSINDEX(&STR( ),&NRSTR(&KEY2))
 
IF &X GT 0 AND &X LT &Y THEN +
  SET TESTUID = &SUBSTR(&X:&Y-1,&NRSTR(&KEY2))
 
IF &STR(&TESTUID) EQ &STR(*) THEN DO
  SET DATA = &STR(&KEY1.3&KEY2)+
    &STR(ALL LOGONIDS MATCH SPECIFIED UID STRING)
  ISREDIT LINE_AFTER &CURLINE = (DATA)
  GOTO REC2_START
  END
 
SET UIDACC  = &SUBSTR(94:99,&STR(&DATA        ))
 
SET X = &SYSINDEX(&AUUACC,&ACC_TBL) + 5
 
DO X = &X TO &LENGTH(&ACC_TBL) BY 6
 
  SET ACC_I = &SUBSTR(&X,&ACC_TBL)
 
  SET ACC_T = &SUBSTR(&X+1:&X+5,&ACC_TBL)
 
  IF &SUBSTR(&ACC_I,&UIDACC) NE &STR( ) THEN DO
    SET X = &LENGTH(&ACC_TBL)
    SET UACC_SW = X
    END
END
 
SET X = 0
 
SET Y = &LENGTH(&STR(&TESTUID))
 
DO UNTIL &X EQ 0
  SET X = &SYSINDEX(&STR(*),&STR(&TESTUID))
  IF &X EQ 1 THEN +
    SET TESTUID = &STR(=)&SUBSTR(&X+1:&Y,&STR(&TESTUID))
  IF &X GT 1 THEN +
    SET TESTUID = &SUBSTR(1:&X-1,&STR(&TESTUID))&STR(=)+
      &SUBSTR(&X+1:&Y,&STR(&TESTUID))
END
 
SET LIDRC = 0
SET LIDLINE = 1
 
ISPEXEC VPUT ( +
  TESTUID +
  LIDRC +
  LIDLINE +
  ) ASIS
 
IF &UACC_SW EQ X THEN DO
  ISPEXEC  VIEW DATASET('&DSNAME(LIDS)') MACRO(CAAM0013)
 
  ISPEXEC VGET ( +
    TESTUID +
    LIDRC +
    LIDLINE +
    LIDNAME +
    ) ASIS
 
  SET LIDLN = &CURLINE
 
  LID_LOOP: +
  IF &LIDLINE GT 1 THEN -
    DO X = 1 TO &LENGTH(&STR(&LIDNAME)) BY 30
      SET DATA = &STR(&KEY1.3&KEY2)+
        &SUBSTR(&X:&X+29,&STR(&LIDNAME)&SPC)
      ISREDIT LINE_AFTER &LIDLN = (DATA)
/*    ISREDIT LINE_AFTER &CURLINE = (DATA)
    END
 
  ISREDIT CURSOR = &LIDLN 50
  SET RETURN_CODE = 0
  ISREDIT SEEK "2&SUBSTR(1:44,&NRSTR(&KEY2))" 49 NX
  IF &RETURN_CODE EQ 0 THEN DO
    ISREDIT (LIDLN) = LINENUM .ZCSR
    ISREDIT (DATA) = LINE &LIDLN
    SET KEY1    = &SUBSTR(01:48,&STR(&DATA))
    SET KEY2    = &SUBSTR(50:99,&STR(&DATA))
    GOTO LID_LOOP
    END
  ISREDIT EXCLUDE ALL "2&SUBSTR(1:44,&NRSTR(&KEY2))" 49
  END
ELSE DO
  ISREDIT EXCLUDE ALL '&UIDACC' 94 99
  END
 
ISREDIT SAVE /* TEMP SAVE */
 
ISREDIT CURSOR = &CURLINE 50
 
SET RETURN_CODE = 0
SET UACC_SW =
 
GOTO REC2_START
 
 
REC_START: +
SET RETURN_CODE = 0
 
ISPEXEC LMMFIND DATAID(&AUACCESS) MEMBER(&MEMBER)
 
IF &RETURN_CODE GT 0 THEN GOTO LOGGING_CHECK
ISREDIT (ENDER) = LINENUM .ZLAST
 
ISREDIT CURSOR = 1 0
 
REC3_CHK: +
SET RETURN_CODE = 0
ISPEXEC LMGET DATAID(&AUACCESS) MODE(INVAR) DATALOC(AUREC) +
  DATALEN(LRECL) MAXLEN(255)
 
IF &RETURN_CODE EQ 8 THEN DO
  ISREDIT SEEK ALL '3' NX 49
  ISREDIT (CNT3) = SEEK_COUNTS
  IF &CNT3 GT 0 THEN SET ACC_SW = X
  SET RETURN_CODE = 0
  ISREDIT FIND ALL P'^' NX
  SET CNT = 1
  IF &RETURN_CODE EQ 0 THEN DO
    SYSCALL FIND_REC 3 NOACCESS
    ISREDIT CURSOR = 1 0
    GOTO REC2_CHK
    END
  GOTO LOGGING_CHECK
  END
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMGET AUACCESS RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO LOGGING_CHECK
  END
 
SET RETURN_CODE = 0
 
ISREDIT FIND ALL '&SUBSTR(1:8,&NRSTR(&AUREC))' 100
 
IF &RETURN_CODE NE 0 THEN GOTO REC3_CHK
ISREDIT (CNT) = FIND_COUNTS
 
SET AULID = &SUBSTR(1:8,&NRSTR(&AUREC))
SET AULVL = &SUBSTR(9,&NRSTR(&AUREC))
 
SELECT &AULVL
  WHEN (0) SET AUMASK = &STR('      &AULID')     /* NONE         */
  WHEN (1) SET AUMASK = &STR(P'   =  &AULID')    /* EXEC         */
  WHEN (2) SET AUMASK = &STR(P'=  =  &AULID')    /*              */
  WHEN (3) SET AUMASK = &STR(P'=  =  &AULID')    /* READ         */
  WHEN (4) SET AUMASK = &STR(P'== =  &AULID')    /*              */
  WHEN (5) SET AUMASK = &STR(P'== =  &AULID')    /* WRITE/UPDATE */
  WHEN (6) SET AUMASK = &STR(P'====  &AULID')    /*              */
  WHEN (7) SET AUMASK = &STR(P'====  &AULID')    /*              */
  WHEN (8) SET AUMASK = &STR(P'====  &AULID')    /*              */
  WHEN (9) SET AUMASK = &STR(P'====  &AULID')    /* ALLOC        */
  END
 
ISREDIT EXCLUDE ALL &AUMASK 94
 
GOTO REC3_CHK
 
 
REC2_CHK: +
SET RETURN_CODE = 0
 
ISREDIT FIND '2' 49 NX
 
IF &RETURN_CODE NE 0 THEN DO
  SET RETURN_CODE = 0
  SET CNT = 1
  IF &ACC_SW EQ X OR +
     &UACC_SW EQ X THEN DO
/*  SYSCALL FIND_REC 2 ACCESS
    SYSCALL FIND_REC 3 ACCESS
    END
  SET RETURN_CODE = 0
 
  ISREDIT FIND ALL '3' 49 NX
  IF &RETURN_CODE EQ 0 THEN +
    GOTO FIND_YES
  ELSE DO
    SET ACC_SW =
    SET UACC_SW =
    GOTO LOGGING_CHECK
    END
  END
 
ISREDIT (CURLINE) = LINENUM .ZCSR
 
ISREDIT (DATA) = LINE &CURLINE
 
SET KEY2 = &SUBSTR(50:93,&STR(&DATA))
 
DO WHILE &RETURN_CODE EQ 0
 
  ISREDIT SEEK '2&KEY2' 49 93 X
 
  IF &RETURN_CODE EQ 0 THEN DO
    ISREDIT (CURLINE1) = LINENUM .ZCSR
 
    ISREDIT (DATA) = LINE &CURLINE1
 
    SET UIDACC  = &SUBSTR(94:99,&STR(&DATA        ))
 
    SET X = &SYSINDEX(&AUUACC,&ACC_TBL) + 5
 
    DO X = &X TO &LENGTH(&ACC_TBL) BY 6
 
      SET ACC_I = &SUBSTR(&X,&ACC_TBL)
 
      SET ACC_T = &SUBSTR(&X+1:&X+5,&ACC_TBL)
 
      IF &SUBSTR(&ACC_I,&UIDACC) NE &STR( ) THEN DO
        ISREDIT XSTATUS &CURLINE1 = NX
        SET X = &LENGTH(&ACC_TBL)
        SET UACC_SW = X
        END
    END
    END
END
 
ISREDIT CURSOR = &CURLINE 50
 
SET RETURN_CODE = 0
 
GOTO REC2_CHK
 
 
FIND_YES: +
SET RETURN_CODE = 0
 
DO X = 2 TO 0 BY -1
  ISREDIT CURSOR = 1 0
  REC_CHECK: +
  SET RETURN_CODE EQ 0
  SET Y = &X + 1
  ISREDIT FIND '&X' 49 NX
  IF &RETURN_CODE = 0 THEN DO
    ISREDIT (CURLINE) = LINENUM .ZCSR
 
    ISREDIT (DATA) = LINE &CURLINE
 
    SET KEY0 = &SUBSTR(7:14,&STR(&DATA))
    SET KEY1 = &SUBSTR(7:48,&STR(&DATA))
    SET RETURN_CODE = 0
    IF &X EQ 0 THEN DO
      ISREDIT FIND ALL "&KEY0" 7 14 NX
      ISREDIT (,CNT) = FIND_COUNTS
      IF &CNT EQ 1 THEN +
        ISREDIT EXCLUDE ALL "&SUBSTR(1:42,&NRSTR(&KEY0&SPC))0" 7 49
      END
    ELSE DO
      ISREDIT FIND ALL "&KEY1&Y" 7 49 NX
      ISREDIT (,CNT) = FIND_COUNTS
      IF &CNT EQ 0 THEN +
        ISREDIT EXCLUDE ALL "&KEY1&X" 7 49
      END
    ISREDIT CURSOR = &CURLINE 50
    GOTO REC_CHECK
    END
END
 
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))) MEMBER(&PDIMBR)
 
SET AC = &STR( )
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
SET MSGACC =
IF &AUUACC_LVL LT 5 THEN SET MSGACC = &STR(WRITE and/or )
IF &AUUACC_LVL LT 3 THEN SET MSGACC = &STR(READ, WRITE, and/or )
IF &AUUACC_LVL LT 1 THEN SET MSGACC = &STR(EXEC, &MSGACC)
 
SET X = &SYSINDEX(&STR(WRITE),&STR(&MSGACC)) - 1
IF &X GT 0 THEN DO
  SET MSGACC1 = &SUBSTR(1:&X,&STR(&MSGACC))
  IF &LENGTH(&STR(&MSGACC1)) LT 6 THEN +
    SET MSGACC1 = &STR(&SUBSTR(1:&X-2,&STR(&MSGACC1)) )
  SET MSGACC1 = &STR(&MSGACC1 and/or )
  END
 
SET RETURN_CODE = 0
IF &AUUACC_LVL GT 3 THEN +
  ISREDIT FIND ALL P'^' 95 96 NX
 
SET CNT = 1
IF &RETURN_CODE EQ 0 THEN DO
  SELECT (&MEMBER)
    WHEN (UADSRPT) DO
      SET AC = &STR(&CNT&RP Data set access authorization +
        does not restrict ALLOCATE access to systems +
        programming personnel.)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
        DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
      SET CNT = &CNT + 1
      SET AC = &STR(&CNT&RP Data set access authorization +
        does not restrict &MSGACC1.WRITE access to systems +
        programming personnel and/or security personnel.)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
        DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
      SET CNT = &CNT + 1
      END
    WHEN (ACPRPT) DO
      SET AC = &STR(&CNT&RP Data set access authorization +
        does not restrict &MSGACC.ALLOCATE access to +
        systems programming personnel and/or security +
        personnel.)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
        DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
      SET CNT = &CNT + 1
      END
    OTHERWISE DO
      SET AC = &STR(&CNT&RP Data set access authorization +
        does not restrict &MSGACC.ALLOCATE access to +
        systems programming personnel.)
      ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
        DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
      SET CNT = &CNT + 1
      END
    END
  END
 
IF &CNT GT 1 THEN +
  SET PD = &CNT.&RP&STR( )
ELSE +
  SET PD =
 
SET AC = &STR(&PD.Justification for access authorization +
  was not provided.)
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
SET CNT = &CNT + 1
 
SYSCALL WRITE_REC
 
LOGGING_CHECK: +
SET RETURN_CODE = 0
 
ISREDIT EXCLUDE ALL P'=' 1
 
ISREDIT CURSOR = 1 0
 
SET X = &SYSINDEX(&AULOG,&ACC_TBL) - 1
 
DO X = &X TO &LENGTH(&ACC_TBL) BY 6
 
  SET ACC_I = &SUBSTR(&X,&ACC_TBL)
 
  SET ACC_T = &SUBSTR(&X+1:&X+5,&ACC_TBL)
  SET ACC_T = &ACC_T
 
  ISREDIT FIND ALL 'A' &EVAL(93+&ACC_I) &EVAL(93+&ACC_I)
END
 
ISREDIT EXCLUDE ALL '3' 49
 
SYSCALL FIND_REC 2 LOGGING
 
ISREDIT FIND ALL P'=' 1 1 NX
 
IF &RETURN_CODE GT 0 THEN GOTO END_EDIT
 
SET MSGLOG = &STR(ALLOCATE )
IF &AULOG_LVL LT 9 THEN SET MSGLOG = &STR(WRITE and/or &MSGLOG)
IF &AULOG_LVL LT 5 THEN SET MSGLOG = &STR(READ, &MSGLOG)
IF &AULOG_LVL LT 3 THEN SET MSGLOG = &STR(All data set )
ELSE SET MSGLOG = &STR(Data set &MSGLOG)
IF &AULOG_LVL NE 0 THEN DO
  IF &ACC_SW EQ   AND +
     &UACC_SW EQ   THEN 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))) MEMBER(&PDIMBR)
 
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
        DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    END
  ELSE DO
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    END
  SET AC = &STR(&CNT&RP &MSGLOG.access is not logged.)
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SYSCALL WRITE_REC
 
  SET LOG_SW = X
  END
 
GOTO END_EDIT
 
 
WRITE_REC: PROC 0
 
ISPEXEC VGET ( +
  CONSLIST     +
  COMLIST      +
  SYMLIST      +
  TERMMSGS     +
  PDIDD        +
  PDIMBR       +
  RPTMBR       +
  ODSNAME      +
  TBLUSR       +
  ) ASIS
 
SET ACC_TBL = &STR(READ WRITEALLOCEXEC )
SET LP = &STR((
SET RP = )
 
SET RETURN_CODE = 0
 
ISREDIT CURSOR = 1 0
 
WRITE_LOOP: +
SET RETURN_CODE = 0
 
ISREDIT FIND P'^' 1 1 NX
 
IF &RETURN_CODE GT 0 THEN +
  GOTO WRITE_END
 
ISREDIT (DATA) = LINE .ZCSR
 
SET KEY = &SUBSTR(7:14,&STR(&DATA))
SET KEY = &KEY
SET KEY1 = &SUBSTR(15:48,&STR(&DATA))
SET KEY1 = &SUBSTR(1:&SYSINDEX(&STR( ),&STR(&KEY1 )),&STR(&KEY1 ))
SET RECTYPE = &SUBSTR(49,&STR(&DATA))
SET KEY2 = &SUBSTR(50:93,&STR(&DATA))
DO X = &LENGTH(&NRSTR(&KEY2)) TO 1 BY -1 +
  UNTIL &SUBSTR(&X,&NRSTR(&KEY2)) NE &STR( )
END
SET KEY2 = &SUBSTR(1:&X+1,&NRSTR(&KEY2 ))
 
SELECT (&RECTYPE)
  WHEN (0) GOTO WRITE_REC0
  WHEN (1) GOTO WRITE_REC1
  WHEN (2) GOTO WRITE_REC2
  WHEN (3) GOTO WRITE_REC3
  OTHERWISE WRITE INVALID RECORD TYPE &RECTYPE
END
 
SET COUNT = &COUNT + 1
 
GOTO WRITE_LOOP
 
 
WRITE_REC0: +
SET CMD = &STR( )
 
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDIMBR)
 
SET CMD = &STR(     $KEY(&KEY) &SUBSTR(50:&LENGTH(&STR(&DATA)),+
  &STR(&DATA)))
 
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDIMBR)
 
SET COUNT = &COUNT + 1
 
GOTO WRITE_LOOP
 
WRITE_REC1: +
SET CMD = &STR(          &KEY2)
 
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDIMBR)
 
SET COUNT = &COUNT + 1
 
GOTO WRITE_LOOP
 
 
WRITE_REC2: +
SET ACCESS = &SUBSTR(94:99,&STR(&DATA))
SET EXP_ACC =
 
DO X = 1 TO 4
  SET X1 = &X * 5
  IF &SUBSTR(&X:&X,&ACCESS) NE &STR( ) THEN DO
    SET ACC_T = &SUBSTR(&X1-4:&X1,&ACC_TBL)
    SET ACC_T = &ACC_T
    SET EXP_ACC = &STR(&EXP_ACC+
      &ACC_T&LP&SUBSTR(&X:&X,&ACCESS)&RP )
    END
END
SET CMD = &STR(               &KEY1&KEY2&EXP_ACC)
 
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDIMBR)
 
SET COUNT = &COUNT + 1
 
GOTO WRITE_LOOP
 
 
WRITE_REC3: +
SET CMD = &STR(                    &SUBSTR(100:140,&STR(&DATA)))
 
ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDIMBR)
 
SET COUNT = &COUNT + 1
 
GOTO WRITE_LOOP
 
 
WRITE_END: +
END
 
 
FIND_REC: PROC 2 P1 P2
 
SET RETURN_CODE = 0
SET LP = &STR((
SET RP = )
SET ACCLST = &STR(ALLOC WRITE READ EXEC )
SET SPC = &STR(          )
SET SPC = &STR(&SPC.&SPC.&SPC.&SPC.&SPC)
 
ISREDIT CURSOR = 1 0
 
REC_LOOP: +
ISREDIT FIND '&P1' NEXT 49 NX
 
IF &RETURN_CODE NE 0 THEN DO
  IF &P1 EQ 3 THEN DO
    SET P1 = &P1 - 1
    ISREDIT CURSOR = 1 0
    SET RETURN_CODE = 0
    GOTO REC_LOOP
    END
  ELSE +
    GOTO REC_END
  END
 
ISREDIT (CURLINE) = LINENUM .ZCSR
 
ISREDIT (DATA) = LINE &CURLINE
 
SET KEY0 = &SUBSTR(7:14,&STR(&DATA))
SET KEY0 = &SUBSTR(1:42,&STR(&KEY0)&SPC)
SET KEY1 = &SUBSTR(7:48,&STR(&DATA))
SET RECTYPE = &SUBSTR(49,&STR(&DATA))
SET KEY2 = &SUBSTR(50:93,&STR(&DATA))
SET LID  = &SUBSTR(100:107,&STR(&DATA))
SET KEY3 = &SUBSTR(94:107,&STR(&DATA))
 
IF &P1 EQ 3 THEN DO
  ISREDIT FIND "&STR(&KEY1.2&KEY2)" 7 93 ALL
  SET STRNG = &STR(LID(&LID))
  END
ELSE +
  SET STRNG = &STR(&KEY2)
 
IF &P2 EQ &STR(ACCESS) THEN DO
  ISREDIT FIND "&STR(&KEY1.1)" 7 49 ALL
  ISREDIT (DATA) = LINE .ZCSR
  SET X = &SYSINDEX(&STR( ),&NRSTR(&DATA),50)
  SET DSN = &SUBSTR(50:&X-1,&STR(&DATA))
  SET DSNL = &LENGTH(&NRSTR(&DSN))
  IF &SUBSTR(&DSNL,&NRSTR(&DSN)) EQ &STR(.) THEN +
    SET DSN = &NRSTR(&DSN.&STR(-))
 
  SET ACCSW = &STR(N)
  DO X1 = 1 TO &LENGTH(&STR(&ACCLST))
  SET Y = &SYSINDEX(&STR( ),&STR(&ACCLST),&X1)
  SET ACCESS = &SUBSTR(&X1:&Y-1,&STR(&ACCLST))
  SET X1 = &Y
/*WRITE TEST &KEY0 DS('&DSN') &STRNG ACCESS(&ACCESS)
  SET &SYSOUTTRAP = 999
 
  DATA
  ACF
  TEST &KEY0
/*DS('&DSN') &KEY2
  DS('&DSN') &STRNG ACCESS(&ACCESS)
  ENDDATA
 
  SET A = &SYSOUTLINE
 
  SET &SYSOUTTRAP = 0
 
  DATA
  QUIT
  QUIT
  ENDDATA
 
  DO X = 1 TO &A
    SET AB = &&SYSOUTLINE&X
    SET AB = &SYSNSUB(2,&AB)
    IF &SYSINDEX( VALIDATED ,&NRSTR(&AB)) GT 0 THEN DO
      SET A = &SYSINDEX( FROM ,&NRSTR(&AB))+6
      SET B = &SYSINDEX( ,&NRSTR(&AB),&A)
      SET TKEY0 = &SUBSTR(&A:&B,&NRSTR(&AB))
      SET TKEY0 = &SUBSTR(1:8,&TKEY0        )
      SET X = &X + 1
      SET AB = &&SYSOUTLINE&X
      SET AB = &SYSNSUB(2,&AB)
      SET A = &SYSINDEX( ,&NRSTR(&AB),2)
      SET TKEY1 = &SUBSTR(2:&A,&NRSTR(&AB))
      SET TKEY1 = &SUBSTR(1:42,&NRSTR(&TKEY0&TKEY1&SPC))
      SET A = &A + 1
      SET B = &SYSINDEX( ,&NRSTR(&AB),&A)
      SET TKEY2 = &SUBSTR(&A:&B,&NRSTR(&AB))
      IF &NRSTR(&TKEY1) EQ &NRSTR(&KEY1) AND +
         &NRSTR(&TKEY2) EQ &NRSTR(&KEY2) THEN DO
        SET X = &LENGTH(&STR(&ACCLST))
        SET ACCSW = &STR(Y)
        END
      END
  END
 
  END
/*WRITE TEST &KEY0 DS('&DSN') &STRNG &ACCSW
      IF &ACCSW EQ &STR(N) THEN DO
        IF &P1 EQ 3 THEN +
          ISREDIT EXCLUDE ALL "&KEY1.3&KEY2&KEY3" 7 107
        ELSE DO
          ISREDIT EXCLUDE ALL "&KEY1.2&KEY2" 7 93
          ISREDIT EXCLUDE ALL "&KEY1.3&KEY2" 7 93
          END
        END
  END
 
IF &RETURN_CODE EQ 0 THEN DO
  ISREDIT FIND "&STR(&KEY1.1)" 7 49 ALL
  ISREDIT FIND "&STR(&KEY0.0)" 7 49 ALL
  END
 
ISREDIT CURSOR = &CURLINE 50
 
SET RETURN_CODE = 0
 
GOTO REC_LOOP
 
REC_END: +
END
 
 
END_EDIT: -
SET RETURN_CODE = 0
 
IF &ACC_SW EQ   AND +
   &UACC_SW EQ   AND +
   &LOG_SW EQ   THEN DO
  SET AC = &STR(Not a Finding)
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
IF &ENDER EQ 0 THEN DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR(No data available &MEMBER is empty.)
  ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) -
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
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 +
    WRITE &PGMNAME LMMREP_PDIDD_RCODE = &RETURN_CODE &PDIMBR   &ZERRSM
  END
ELSE +
  IF &RETURN_CODE GT 0 THEN +
    WRITE &PGMNAME LMMADD_PDIDD_RCODE = &RETURN_CODE &PDIMBR   &ZERRSM
 
 
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
 
ISPEXEC VPUT ( -
  AM21VGET -
  ) ASIS
 
/* *************************************** */
/* SAVE OUTPUT                             */
/* *************************************** */
 
ISREDIT CANCEL
 
EXIT CODE(0)