ISREDIT MACRO       /* CATM0527 VIEW USERLIST report  */
 
/* 04/28/2010 CL Fenton Created to perform ACID checks.
/* 12/20/2010 CL Fenton Chgd to save file after collecting PROFILE
/*            information for other ACIDs.
/* 01/03/2011 CL Fenton Chgd to correct possible 852 error in PROF_ACID,
/* 02/15/2011 CL Fenton Chgs to add analysis for TSS0750, TSS0755,
/*            TSS0760, TSS0810, TSS0820, TSS0890, TSS0900, TSS0970,
/*            TSS0990, and TSS0995.
/* 03/15/2011 CL Fenton Added GSKSRVR to list of trusted STC users.
/* 07/05/2011 CL Fenton Added removal of EMERAUDT for TSS0755.
/* 09/12/2011 CL Fenton Added analysis for Zxxx0032 PDIs, CSD-AR002893724.
/* 05/30/2013 CL Fenton Added FTPUSERS for TSS0755 and removed 254 day
/*            for FTP users to remove conflict between TSS0755 and
/*            TSS0550, STS-000796.  Also added the removal of EMERAUDT
/*            for TSS0755.
/* 03/07/2014 CL Fenton Removed requirement for TSOLPROC in TSS0755,
/*            STS-004646.
/* 06/02/2014 CL Fenton Added exclution of users with FTP in name for
/*            TSS0755, STS-005560.
/* 06/02/2014 CL Fenton Added check for NOSUSPEND for TSS0755, STS-005665.
/* 09/08/2015 CL Fenton Changed IF statement for STCMBR to correct 932
/*            error, STS-012097.
/* 02/05/2018 CL Fenton Added CEA as trusted started task for TSS0810,
/*            STS-019223.
/* 05/23/2018 CL Fenton Added "Not Reviewed" to TSS0790 when the
/*            default STC does not specify FAIL, and TSS0810 for vuls
/*            that require additional analysis, STS-019713.
/* 03/03/2020 CL Fenton Added PHRASE INTERVAL for evaluation, STS-023663.
/* 03/05/2024 CL Fenton Removed obsolete PDI member automation for
/*            TSS0970, SCTASK0103747.
 
SET PGMNAME = &STR(CATM0527 03/05/24)
 
NGLOBAL PGMNAME RETURN_CODE PDIID PDIMBR ZERRSM DIALOG DSNAME
 
SET SYSPROMPT = OFF                /* CONTROL NOPROMPT          */
SET SYSFLUSH  = OFF                /* CONTROL NOFLUSH           */
SET SYSASIS   = ON                 /* CONTROL ASIS - caps off   */
 
ISPEXEC CONTROL NONDISPL ENTER
ISPEXEC CONTROL ERRORS RETURN
 
/* ERROR ROUTINE */
ERROR DO
  SET RETURN_CODE = &LASTCC          /* SAVE LAST ERROR CODE */
  IF &LASTCC GE 16 THEN +
    WRITE &PGMNAME LASTCC = &LASTCC &ZERRLM
  RETURN
  END
 
/* *************************************** */
/* VARIABLES ARE PASSED TO THIS MACRO      */
/* CONSLIST                                */
/* COMLIST                                 */
/* SYMLIST                                 */
/* TERMMSGS                                */
/* *************************************** */
 
SET RETURN_CODE = 0
 
ISPEXEC VGET ( +
  CONSLIST     +
  COMLIST      +
  SYMLIST      +
  TERMMSGS     +
  PDIID        +
  DIALOG       +
  TABLEID      +
  TYPERUN      +
  ) ASIS
 
SET TM527VG  = &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 PDIID/&PDIID DIALOG/&DIALOG TABLEID/&TABLEID +
    TYPERUN/&TYPERUN
  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         */
 
ISREDIT (MBRNAME)  = MEMBER
ISREDIT (DSNAME)   = DATASET
ISREDIT (LASTLINE) = LINENUM .ZLAST
ISREDIT (DW) = DATA_WIDTH
 
ISREDIT FIND '&SYSUID' 1
ISREDIT (DATA) = LINE .ZCSR
SET CTYPE = &SUBSTR(32:39,&NRSTR(&DATA))
SET BLANK = &STR( )
SET SP = &STR(          )
SET SP = &STR(&SP&SP&SP&SP&SP&SP)
SET LP = &STR((
SET RP = )
 
ISREDIT CURSOR = 1 0
FIND_PROF: +
SET RETURN_CODE = 0
 
ISREDIT FIND 'PROFILE' 32
 
IF &RETURN_CODE GT 0 THEN GOTO FIND_PROF_END
 
ISREDIT (DATA) = LINE .ZCSR
ISREDIT (CNT) = CURSOR
 
DO LNTH = &DW TO 60 BY -1 +
  WHILE &SUBSTR(&LNTH,&STR(&DATA)) EQ &STR( )
END
IF &LNTH GT 57 THEN +
  SET DETAIL_LINE = &SUBSTR(57:&LNTH,&NRSTR(&DATA))
ELSE +
  SET DETAIL_LINE = &STR( )
SET A           = &SYSINDEX(&STR( ),&NRSTR(&DATA)) - 1
SET PROF_ACID   = &SUBSTR(1:&A,&NRSTR(&DATA))
SET PROF_ACID   = &STR(P&LP&PROF_ACID&RP)
 
ISREDIT CURSOR = 1 0
SET RETURN_CODE = 0
IF &STR(&DETAIL_LINE) NE &STR( ) THEN +
  DO WHILE &RETURN_CODE EQ 0
    ISREDIT FIND ' &STR(&PROF_ACID)' 40 &DW
    IF &RETURN_CODE EQ 0 THEN DO
      ISREDIT (DATA) = LINE .ZCSR
      SET LNTH = &LENGTH(&STR(&DATA))
      DO LNTH = &DW TO 41 BY -1 +
        WHILE &SUBSTR(&LNTH,&STR(&DATA)) EQ &STR( )
      END
      SET DATA1 = &STR(&DATA &DETAIL_LINE)
      SET DATA = &SUBSTR(1:&LNTH,&NRSTR(&DATA)) &STR(&DETAIL_LINE)
      ISREDIT LINE .ZCSR = (DATA)
      SET RETURN_CODE = 0
      END
    END
 
ISREDIT CURSOR = &CNT 55
 
GOTO FIND_PROF
 
 
FIND_PROF_END: +
ISREDIT SAVE
SET RETURN_CODE = 0
 
SET TBL = &STR(GROUP PROFILE DEPT DIV DIVISION ZONE )
 
SET A = 0
DO X = 1 TO &LENGTH(&STR(&TBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TBL),&X)
  SET FLD = &SUBSTR(&X:&Y-1,&STR(&TBL))
  ISREDIT EXCLUDE ALL '&SUBSTR(1:8,&STR(&FLD&SP))' 32
  ISREDIT (,B) = EXCLUDE_COUNTS
  SET A = &A + &B
  SET X = &Y
  END
 
ISREDIT DELETE ALL X
 
WRITE &PGMNAME &A lines deleted out of &LASTLINE..
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0740
SET DETAIL_SW = 0
SET CURLINE = 0
 
/* *************************************** */
/* READ LOOP                               */
/* *************************************** */
 
TSS0740: +
SET RETURN_CODE = 0
SET CURLINE = &CURLINE + 1
 
IF &CURLINE GT &LASTLINE THEN GOTO TSS0740_END
 
ISREDIT (DATA) = LINE &CURLINE
 
SET DETAIL_LINE = &SUBSTR(1:30,&NRSTR(&DATA))
 
SET USERID  = &SUBSTR(1:8,&NRSTR(&DATA))
SET NAME    = &SUBSTR(10:30,&NRSTR(&DATA))
 
SET CNT     = &CNT + 1
 
SET ERROR   = 0
IF &STR(&NAME)   EQ &STR( ) OR +
   &STR(&NAME)   GT &STR(9999999999) OR +
   &STR(&NAME)   EQ &STR(UNKNOWN ) THEN SET ERROR = &ERROR + 1
 
IF &ERROR EQ 0 THEN GOTO TSS0740
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(The following ACID&LP.s&RP does &LP.do&RP not +
    have the NAME field completed:)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET DETAIL_SW = &DETAIL_SW + 1
  END
 
SET AC = &STR(     &DETAIL_LINE)
 
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
GOTO TSS0740
 
 
TSS0740_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(All ACID&LP.s&RP have the NAME field completed.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: All ACID&LP.sRP must have +
    the users name specified.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
IF &NRSTR(&CTYPE) NE &STR(MSCA) THEN GOTO TSS0750_BYPASS
 
SET TBL = &STR(GROUP PROFILE DEPT DIV DIVISION ZONE )
 
SET A = 0
DO X = 1 TO &LENGTH(&STR(&TBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TBL),&X)
  SET FLD = &SUBSTR(&X:&Y-1,&STR(&TBL))
  ISREDIT EXCLUDE ALL '&SUBSTR(1:8,&STR(&FLD&SP))' 32
  ISREDIT (,B) = EXCLUDE_COUNTS
  SET A = &A + &B
  SET X = &Y
  END
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
ISREDIT DELETE ALL X
 
WRITE &PGMNAME &A lines deleted out of &LASTLINE..
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0750
SET DETAIL_SW = 0
SET CURLINE = 0
 
/* *************************************** */
/* READ LOOP                               */
/* *************************************** */
 
TSS0750: +
SET RETURN_CODE = 0
SET CURLINE = &CURLINE + 1
 
IF &CURLINE GT &LASTLINE THEN GOTO TSS0750_END
 
ISREDIT (DATA) = LINE &CURLINE
 
SET DETAIL_LINE = &SUBSTR(1:30,&NRSTR(&DATA))
 
/* Start here for additional changes */
SET USERID  = &SUBSTR(1:8,&NRSTR(&DATA))
SET NAME    = &SUBSTR(10:30,&NRSTR(&DATA))
SET PSWD    = &SUBSTR(40:47,&NRSTR(&DATA))
SET PSWD    = &SUBSTR(40,&NRSTR(&DATA))
SET PHRASE  = &SUBSTR(44,&NRSTR(&DATA))
 
SET CNT     = &CNT + 1
 
SET ERROR   = 0
/*IF &STR(&NAME)   EQ &STR( ) OR +
/*   &STR(&PSWD)   EQ &STR(*NOPW*) OR +
/*   &STR(&NAME)   GT &STR(9999999999) OR +
/*   &STR(&NAME)   EQ &STR(UNKNOWN ) THEN SET ERROR = &ERROR + 1
 
IF &STR(&NAME)   EQ &STR( ) OR +
  (&STR(&PSWD)   EQ &STR(*) AND +
   &STR(&PHRASE) EQ &STR(N)) OR +
   &STR(&NAME)   GT &STR(9999999999) OR +
   &STR(&NAME)   EQ &STR(UNKNOWN ) THEN SET ERROR = &ERROR + 1
 
IF &ERROR EQ 0 THEN GOTO TSS0750
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(The following interactive ACID&LP.s&RP have NOPW +
    option specified:) /* current default finding details */
  SET AC = &STR(The following ACID&LP.s&RP have NOPW option +
    specified:) /* default finding details for interactive and STC */
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET DETAIL_SW = &DETAIL_SW + 1
  END
 
SET AC = &STR(     &DETAIL_LINE)
 
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
GOTO TSS0750
 
 
TSS0750_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(All interactive ACID&LP.s&RP have a password +
    specified.) /* current default finding details */
  SET AC = &STR(All ACID&LP.s&RP have a password specified.)
    /* default finding details for interactive and STC */
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: All interactive ACID&LP.s&RP +
    must have a password specified.) /* current default finding details */
  SET AC = &STR(DISA recommendation: All ACID&LP.s&RP must have +
    a password specified.)
    /* default finding details for interactive and STC */
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
TSS0750_BYPASS: +
SET TBL = &STR(GROUP PROFILE DEPT DIV DIVISION ZONE )
 
SET A = 0
DO X = 1 TO &LENGTH(&STR(&TBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TBL),&X)
  SET FLD = &SUBSTR(&X:&Y-1,&STR(&TBL))
  ISREDIT EXCLUDE ALL '&SUBSTR(1:8,&STR(&FLD&SP))' 32
  ISREDIT (,B) = EXCLUDE_COUNTS
  SET A = &A + &B
  SET X = &Y
  END
 
ISREDIT EXCLUDE " F(STC) " ALL 56 &DW
ISREDIT (,B) = EXCLUDE_COUNTS
SET A = &A + &B
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
ISREDIT DELETE ALL X
 
WRITE &PGMNAME &A lines deleted out of &LASTLINE..
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0755
SET DETAIL_SW = 0
SET CURLINE = 0
SET GROUP = &STR(EMERAUDT FTPUSERS)
 
SET A = 1
DO WHILE &A LT &LENGTH(&STR(&GROUP))
  SET B = &SYSINDEX(&STR( ),&STR(&GROUP ),&A) - 1
  SET ATTR = &SUBSTR(&A:&B,&STR(&GROUP))
  SYSCALL DIALOG_RTN &ATTR
  SET A = &B + 2
  END
 
ISREDIT EXCLUDE ALL 'FTP' 10 31
 
 
/* *************************************** */
/* READ LOOP                               */
/* *************************************** */
 
TSS0755: +
SET RETURN_CODE = 0
SET CURLINE = &CURLINE + 1
 
IF &CURLINE GT &LASTLINE THEN GOTO TSS0755_END
 
ISREDIT (DATA) = LINE &CURLINE
ISREDIT (NX) = XSTATUS &CURLINE
 
SET DETAIL_LINE = &SUBSTR(1:30,&NRSTR(&DATA))
 
SET CNT     = &CNT + 1
 
SET ERROR   = 0
/* Test for Password interval LE 60 */
/* Test to ensure &STR(P() a PROFILE entry is specified */
/* Test to ensure TSOLPROC is not blank when F(TSO) is specified */
 
SET A = 1
SET JTN_ATTR =
SET FAC_TBL = &STR(BATCH TSO NCPASS)
DO WHILE &A LT &LENGTH(&STR(&FAC_TBL))
  SET B = &SYSINDEX(&STR( ),&STR(&FAC_TBL ),&A) - 1
  SET ATTR = &SUBSTR(&A:&B,&STR(&FAC_TBL))
  SET C = &SYSINDEX(&STR( F&LP&ATTR),&NRSTR(&DATA),56) + 1
  SET D = &SYSINDEX(&STR( M&LP&ATTR),&NRSTR(&DATA),56)
  IF &D EQ 0 THEN DO
    IF &C GT 1 THEN +
      SET JTN_ATTR = &NRSTR(&JTN_ATTR)+
        &SUBSTR(1,&NRSTR(&ATTR))
    ELSE +
      SET JTN_ATTR = &NRSTR(&JTN_ATTR)&STR( )
    SET A = &B + 2
    END
  ELSE DO
    SET A = &LENGTH(&FAC_TBL)
    SET JTN_ATTR = &STR(     )
    END
  END
 
IF &NRSTR(&JTN_ATTR) EQ &STR(B  ) OR +
   &NRSTR(&JTN_ATTR) EQ &STR(   ) THEN +
  GOTO TSS0755
 
SET PROF_IND = &SYSINDEX(&STR( P&LP),&NRSTR(&DATA))
SET INTERVAL = &SUBSTR(41:43,&NRSTR(&DATA&SP))
SET PHRASE = &SUBSTR(44,&NRSTR(&DATA&SP))
SET PHRINT = &SUBSTR(45:47,&NRSTR(&DATA&SP))
SET MISSMSG =
IF &STR(&INTERVAL) EQ &STR( ) AND +
   &STR(&PHRASE) EQ &STR(N) AND +
   &STR(&NX) EQ &STR(NX) THEN DO
  SET ERROR = &ERROR + 1
  IF &STR(&MISSMSG) NE &STR( ) THEN +
    SET MISSMSG = &STR(&MISSMSG&STR(,) )
  SET MISSMSG = &STR(&MISSMSG.PASSWORD_INTERVAL)
  END
IF &STR(&PHRINT) EQ &STR( ) AND +
   &STR(&PHRASE) EQ &STR( ) AND +
   &STR(&NX) EQ &STR(NX) THEN DO
  SET ERROR = &ERROR + 1
  IF &STR(&MISSMSG) NE &STR( ) THEN +
    SET MISSMSG = &STR(&MISSMSG&STR(,) )
  SET MISSMSG = &STR(&MISSMSG.PHRASE_INTERVAL)
  END
IF &STR(&MISSMSG) NE &STR( ) THEN +
  SET MISSMSG = &STR(&MISSMSG&STR( missing))
IF &DATATYPE(&INTERVAL) EQ &STR(NUM) AND +
   (&INTERVAL EQ 0 OR +
   &INTERVAL GT 60) AND +
   &STR(&NX) EQ &STR(NX) THEN DO
  SET ERROR = &ERROR + 1
  IF &STR(&MISSMSG) NE &STR( ) THEN +
    SET MISSMSG = &STR(&MISSMSG&STR( and) )
  SET MISSMSG = &STR(&MISSMSG.PASSWORD_INTERVAL &INTERVAL is invalid)
  END
IF &DATATYPE(&PHRINT) EQ &STR(NUM) AND +
   &STR(&PHRASE) EQ &STR( ) AND +
   (&PHRINT EQ 0 OR +
   &PHRINT GT 60) AND +
   &STR(&NX) EQ &STR(NX) THEN DO
  SET ERROR = &ERROR + 1
  IF &STR(&MISSMSG) NE &STR( ) THEN +
    SET MISSMSG = &STR(&MISSMSG&STR( and) )
  SET MISSMSG = &STR(&MISSMSG.PHRASE_INTERVAL &PHRINT is invalid)
  END
IF &SYSINDEX(&STR( NOSUSPEND ),&NRSTR(&DATA )) GT 0 THEN DO
  SET ERROR = &ERROR + 1
  IF &STR(&MISSMSG) NE &STR( ) THEN +
    SET MISSMSG = &STR(&MISSMSG&STR( and) )
  SET MISSMSG = &STR(&MISSMSG.NOSUSPEND is specified)
  END
IF &STR(&MISSMSG) NE &STR( ) THEN +
  SET MISSMSG = &STR(&MISSMSG&STR(.))
 
IF &ERROR EQ 0 THEN GOTO TSS0755
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(The following interactive ACID&LP.s&RP does +
    &LP.do&RP not have the required field&LP.s&RP completed:)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET DETAIL_SW = &DETAIL_SW + 1
  END
 
SET AC = &STR(     &DETAIL_LINE &JTN_ATTR &PROF_IND &INTERVAL +
  &MISSMSG)
SET AC = &STR(     &DETAIL_LINE &MISSMSG)
SET AC = &STR(     &DETAIL_LINE &JTN_ATTR &INTERVAL +
  &MISSMSG)
SET AC = &STR(     &DETAIL_LINE &INTERVAL &MISSMSG)
SET AC = &STR(     &DETAIL_LINE &MISSMSG)
 
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
GOTO TSS0755
 
 
TSS0755_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(All interactive ACID&LP.s&RP have the required +
    field&LP.s&RP completed.)
 
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: All interactive ACID&LP.s&RP +
    must have the required field&LP.s&RP specified.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0760
SET DETAIL_SW = 0
SET ASUBM_SW =
SET MULTIUSER_SW =
SET TSS0995_FACLIST =
SET SYSOUTTRAP = 999999
 
SET RETURN_CODE = 0
TSS WHOOWNS PROPCNTL(*)
SET SYSOUTTRAP = 0
 
IF &RETURN_CODE GT 0 THEN DO
  IF &DETAIL_SW EQ 0 THEN DO
    SET AC = &STR(The PROPCNTL resource class is not defined to +
      the security database.)
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET DETAIL_SW = &DETAIL_SW + 1
    END
  GOTO TSS0760_END
  END
 
ISPEXEC LMINIT DATAID(FACLIST) DDNAME(FACLIST)
 
SET LMINIT_FACLIST_RC = &RETURN_CODE
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMINIT_FACLIST_RC &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO TSS0760_END
  END
 
ISPEXEC LMOPEN DATAID(&FACLIST) OPTION(INPUT)
 
SET LMOPEN_FACLIST_RC = &RETURN_CODE
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMOPEN_FACLIST_RC &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO TSS0760_END
  END
 
TSS0760_GETFILE: +
SET RETURN_CODE = 0
 
ISPEXEC LMGET DATAID(&FACLIST) MODE(INVAR) DATALOC(INDATA) +
  DATALEN(INLNGTH) MAXLEN(300)
 
SET LMGET_FACLIST_RC = &RETURN_CODE
IF &RETURN_CODE EQ 8 THEN DO              /* END OF FILE */
  SET LMGET_FACLIST_RC = 0
  SET RETURN_CODE = 0
  WRITE &PGMNAME FACILITIES from FACLIST are &TSS0995_FACLIST.
  GOTO TSS0760_END
  END
 
IF &LMGET_FACLIST_RC GT 4 THEN DO
  WRITE &PGMNAME LMGET_FACLIST_RC &RETURN_CODE &ZERRSM
  GOTO TSS0760_END
  END
 
IF &SUBSTR(1:8,&NRSTR(&INDATA)) EQ &STR(TSS9550I) THEN DO
  SET A = &SYSINDEX(&STR( ),&NRSTR(&INDATA),31) - 1
  IF &A GE 31 THEN +
    SET FACNAME = &SUBSTR(31:&A,&NRSTR(&INDATA))
  IF &ASUBM_SW EQ &STR(X) AND +
     &MULTIUSER_SW EQ &STR(X) THEN DO
    GOTO TSS0760_PROCESS_DATA
    END
  SET OFACNAME = &STR(&FACNAME)
  END
 
IF &SYSINDEX(&STR( INITPGM=ARC ),&NRSTR(&INDATA)) GT 0 THEN +
  SET TSS0995_FACLIST = &STR(&TSS0995_FACLIST.#+
    &SUBSTR(1:8,&STR(&FACNAME&SP)))
 
IF &SYSINDEX(&STR(,ASUBM),&NRSTR(&INDATA)) GT 0 THEN +
  SET ASUBM_SW = X
 
IF &SYSINDEX(&STR(,MULTIUSER),&NRSTR(&INDATA)) GT 0 THEN +
  SET MULTIUSER_SW = X
 
GOTO TSS0760_GETFILE
 
 
TSS0760_PROCESS_DATA: +
SET RETURN_CODE = 0
 
SET ASUBM_SW =
SET MULTIUSER_SW =
SET ERROR   = 0
 
ISREDIT FIND 'M&LP.&OFACNAME.&RP' 40 &DW
 
IF &RETURN_CODE GT 0 THEN DO
  SET OFACNAME = &STR(&FACNAME)
  GOTO TSS0760_GETFILE
  END
 
ISREDIT (DATA) = LINE .ZCSR
 
SET ACID = &SUBSTR(1:8,&NRSTR(&DATA))
IF &SYSINDEX(&STR(F&LP.BATCH&RP),&NRSTR(&DATA)) EQ 0 THEN DO
  WRITE &PGMNAME &OFACNAME &ASUBM_SW &MULTIUSER_SW &ACID does not +
    have the FACILITY of BATCH.
  GOTO TSS0760_PROCESS_DATA
  END
 
WRITE &PGMNAME &OFACNAME &ASUBM_SW &MULTIUSER_SW &ACID has +
  the FACILITY of BATCH.
 
SET SYSOUTTRAP = 999999
 
SET RETURN_CODE = 0
TSS WHOOWNS PROPCNTL(&ACID)
SET SYSOUTTRAP = 0
 
IF &RETURN_CODE GT 0 THEN DO
  IF &DETAIL_SW EQ 0 THEN DO
    SET AC = &STR(The following ACID&LP.s&RP is &LP.are&RP not +
      in Propagation control:)
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET DETAIL_SW = &DETAIL_SW + 1
    END
 
  SET AC = &STR(     &ACID)
 
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SET OFACNAME = &STR(&FACNAME)
 
GOTO TSS0760_GETFILE
 
 
TSS0760_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(All special ACID&LP.s&RP have propagation control +
    in effect for batch jobs.)
 
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: That PROPCNTL be defined to +
    the security database and secure special ACID&LP.s&RP that +
    are not subject to automatic propagation of batch jobs.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0790
SET DETAIL_SW = 0
SET CURLINE = 0
SET STC0 = 0
SET SYSOUTTRAP = 999999
 
TSS LIST(STC)
SET B = &SYSOUTLINE
SET SYSOUTTRAP = 0
 
DO A = 1 TO &B
  SET DATA = &&SYSOUTLINE&A
  SET DATA = &STR(&DATA)
  IF &SUBSTR(1:8,&STR(&DATA)) EQ &STR(STC     ) THEN DO
    SET STC0 = &STC0 + 1
    SET STC&STC0 = &NRSTR(&DATA)
    END
  END
 
SET DEFAULT_DATA =
DO A = 0 TO &STC0
  SET DATA = &&STC&A
  SET DATA = &STR(&DATA)
  IF &SYSINDEX(&STR(*DEF*),&NRSTR(&DATA)) GT 0 THEN +
    SET DEFAULT_DATA = &NRSTR(&DATA)
  END
 
IF &SYSINDEX(&STR(ACID       = *FAIL*),+
  &NRSTR(&DEFAULT_DATA)) GT 0 THEN +
  GOTO TSS0790_END
 
 
/* *************************************** */
/* READ LOOP                               */
/* *************************************** */
 
TSS0790: +
SET DETAIL_SW = &DETAIL_SW + 1
 
SET L = &SYSINDEX(&STR( ),&NRSTR(&DEFAULT_DATA ),37)-1
SET DEFACID = &SUBSTR(37:&L,&NRSTR(&DEFAULT_DATA))
 
SET RETURN_CODE = 0
SET SYSOUTTRAP = 999999
 
TSS LIST(&DEFACID)DATA(ALL)
SET B = &SYSOUTLINE
SET DEF_RC = &RETURN_CODE
 
SET AC = &STR(Not Reviewed)
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
SET AC = &STR(The default ACID is improperly defined.)
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
SET AC = &STR( )
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
IF &DEF_RC GT 0 THEN DO
  SET AC = &STR(     &DEFACID is not defined to security product.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  GOTO TSS0790_END
  END
ELSE DO A = 1 TO &B
  SET DATA = &&SYSOUTLINE&A
  SET DATA = &STR(&DATA)
  IF &SYSINDEX(&STR(TSS LIST(&DEFACID)),&STR(&DATA)) EQ 0 THEN DO
    SET AC = &STR(     &DATA)
 
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    END
  END
 
 
TSS0790_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(&DEFAULT_DATA is specified.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: The DEFAULT STC is set +
    to FAIL in the STC record or the ACID will have no access +
    to resouces and no FACILITY entries specified and sourced +
    to the internal reader.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0810
SET DETAIL_SW = 0
SET CURLINE = 0
SET DEFAULT_DATA =
SET A = 0
 
TSS0810: +
SET A = &A + 1
IF &A GT &STC0 THEN GOTO TSS0810_END
SET DATA = &&STC&A
SET DATA = &STR(&DATA)
IF &SUBSTR(1:3,&NRSTR(&DATA)) NE &STR(STC) THEN GOTO TSS0810
SET PRC = &SUBSTR(14:21,&NRSTR(&DATA))
IF &SYSINDEX(&STR( *BYPASS* ),&STR(&DATA )) GT 0 THEN +
  SELECT &STR(&PRC)
    WHEN (ACFBKUP)   GOTO TSS0810
    WHEN (ACF2)      GOTO TSS0810
    WHEN (APSWPROA)  GOTO TSS0810
    WHEN (APSWPROB)  GOTO TSS0810
    WHEN (APSWPROC)  GOTO TSS0810
    WHEN (APSWPROM)  GOTO TSS0810
    WHEN (APSWPROT)  GOTO TSS0810
    WHEN (CATALOG)   GOTO TSS0810
    WHEN (CEA)       GOTO TSS0810
    WHEN (CONSOLE)   GOTO TSS0810
    WHEN (DFHSM)     GOTO TSS0810
    WHEN (DFSMSHSM)  GOTO TSS0810
    WHEN (DFS)       GOTO TSS0810
    WHEN (DUMPSRV)   GOTO TSS0810
    WHEN (GPMSERVE)  GOTO TSS0810
    WHEN (GSKSRVR)   GOTO TSS0810
    WHEN (IEEVMPCR)  GOTO TSS0810
    WHEN (IOSAS)     GOTO TSS0810
    WHEN (IXGLOGR)   GOTO TSS0810
    WHEN (JESXCF)    GOTO TSS0810
    WHEN (JES2)      GOTO TSS0810
    WHEN (JES3)      GOTO TSS0810
    WHEN (LLA)       GOTO TSS0810
    WHEN (NFS)       GOTO TSS0810
    WHEN (OMVS)      GOTO TSS0810
    WHEN (OMVSKERN)  GOTO TSS0810
    WHEN (RACF)      GOTO TSS0810
    WHEN (RMF)       GOTO TSS0810
    WHEN (RMFGAT)    GOTO TSS0810
    WHEN (SMF)       GOTO TSS0810
    WHEN (SMS)       GOTO TSS0810
    WHEN (SMSRESTN)  GOTO TSS0810
    WHEN (SMSRESTR)  GOTO TSS0810
    WHEN (SMSVSAM)   GOTO TSS0810
    WHEN (TCPIP)     GOTO TSS0810
    WHEN (TSS)       GOTO TSS0810
    WHEN (TSSB)      GOTO TSS0810
    WHEN (TSSBKUP)   GOTO TSS0810
    WHEN (TSSRESTN)  GOTO TSS0810
    WHEN (VLF)       GOTO TSS0810
    WHEN (VTAM)      GOTO TSS0810
    WHEN (XCFAS)     GOTO TSS0810
    WHEN (ZFS)       GOTO TSS0810
    END
ELSE GOTO TSS0810
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not Reviewed)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR(The following authorization to the BYPASS +
    attribute is inappropriate:)
  SET AC = &STR(The following STC PROCNAME&LP.s&RP have BYPASS +
    specified:)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET DETAIL_SW = &DETAIL_SW + 1
  END
 
 
SET AC = &STR(     &DATA)
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
GOTO TSS0810
 
TSS0810_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(All STCs that specify BYPASS are trusted or BYPASS +
    is not specified for any STCs.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: BYPASS may be specified +
    for Trusted Start Tasks.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
 
SET TBL = &STR(GROUP PROFILE DEPT DIV DIVISION ZONE )
 
SET A = 0
DO X = 1 TO &LENGTH(&STR(&TBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TBL),&X)
  SET FLD = &SUBSTR(&X:&Y-1,&STR(&TBL))
  ISREDIT EXCLUDE ALL '&SUBSTR(1:8,&STR(&FLD&SP))' 32
  ISREDIT (,B) = EXCLUDE_COUNTS
  SET A = &A + &B
  SET X = &Y
  END
 
ISREDIT DELETE ALL X
 
WRITE &PGMNAME &A lines deleted out of &LASTLINE..
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
ISREDIT EXCLUDE " F(STC) " ALL 56 &DW
SET PDIMBR = TSS0820
SET DETAIL_SW = 0
SET CURLINE = 0
SET DEFAULT_DATA =
SET STCACIDS = &STR(#)
DO A = 0 TO &STC0
  SET DATA = &&STC&A
  SET DATA = &STR(&DATA)
  SET STCACID = &SUBSTR(37:44,&NRSTR(&DATA&SP))
  SET STCACIDS = &NRSTR(&STCACIDS)&NRSTR(&STCACID)&STR(#)
  END
SET A = 0
SET ACIDSTC0 = 0 /* for 1)
SET STCTBLV0 = 0 /* for 2)
SET STCTBLF0 = 0 /* for 3)
SET ACIDSRC0 = 0 /* for 4)
ISREDIT CURSOR = 1 0
 
TSS0820_ACIDSTC: +
SET RETURN_CODE = 0
 
ISREDIT SEEK " F(STC) " 56 &DW
 
IF &RETURN_CODE GT 0 THEN GOTO TSS0820_STCACID
 
ISREDIT (DATA) = LINE .ZCSR
 
SET DETAIL_LINE = &SUBSTR(1:30,&NRSTR(&DATA))
SET ACID        = &SUBSTR(1:8,&NRSTR(&DATA))
 
IF &SYSINDEX(&STR(#&ACID.#),&NRSTR(&STCACIDS)#) EQ 0 THEN DO
  SET ACIDSTC0 = &ACIDSTC0 + 1
  SET ACIDSTC&ACIDSTC0 = &NRSTR(&DETAIL_LINE)
  END
 
IF &SYSINDEX(&STR( INTRDR ),&NRSTR(&DATA&SP)) EQ 0 THEN DO
  SET ACIDSRC0 = &ACIDSRC0 + 1
  SET ACIDSRC&ACIDSRC0 = &NRSTR(&DETAIL_LINE)
  END
 
GOTO TSS0820_ACIDSTC
 
 
TSS0820_STCACID: +
SET RETURN_CODE = 0
 
SET A = &A + 1
IF &A GT &STC0 THEN GOTO TSS0820_END
SET DATA = &&STC&A
SET DATA = &STR(&DATA)
IF &SUBSTR(1:3,&NRSTR(&DATA)) NE &STR(STC) OR +
   &SYSINDEX(&STR( *),&NRSTR(&DATA)) GT 0 THEN +
  GOTO TSS0820_STCACID
 
SET ACID = &SUBSTR(37:44,&NRSTR(&DATA&SP))
 
ISREDIT SEEK "&ACID" 1 FIRST
 
IF &RETURN_CODE GT 0 THEN DO
  SET STCTBLV0 = &STCTBLV0 + 1
  SET STCTBLV&STCTBLV0 = &NRSTR(&DATA)
  GOTO TSS0820_STCACID
  END
 
ISREDIT (STC) = XSTATUS .ZCSR
 
IF &STR(&STC) EQ NX THEN DO
  SET STCTBLF0 = &STCTBLF0 + 1
  SET STCTBLF&STCTBLF0 = &NRSTR(&DATA)
  END
 
GOTO TSS0820_STCACID
 
 
TSS0820_END: +
SET RETURN_CODE = 0
 
IF &ACIDSTC0 GT 0 THEN SET DETAIL_SW = &DETAIL_SW + 1 /* for 1)
IF &STCTBLV0 GT 0 THEN SET DETAIL_SW = &DETAIL_SW + 1 /* for 2)
IF &STCTBLF0 GT 0 THEN SET DETAIL_SW = &DETAIL_SW + 1 /* for 3)
IF &ACIDSRC0 GT 0 THEN SET DETAIL_SW = &DETAIL_SW + 1 /* for 4)
 
IF &DETAIL_SW GT 0 THEN DO
  SET AC = &STR(The following started task&LP.s&RP has +
    &LP.have&RP been improperly defined:)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SET NR = 1
IF &DETAIL_SW GT 1 THEN SET PD = &STR(&NR.&RP )
ELSE SET PD =
DO A = 1 TO &ACIDSTC0
  IF &A EQ 1 THEN DO
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &NRSTR(&PD.ACID&LP.s&RP with the STC Facility are +
      not defined in the STC record.)
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    END
  SET DATA = &&ACIDSTC&A
  SET DATA = &STR(&DATA)
  SET AC = &STR(     &DATA)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
DO A = 1 TO &ACIDSRC0
  IF &A EQ 1 THEN DO
    SET NR = &NR + 1
    IF &DETAIL_SW GT 1 THEN SET PD = &STR(&NR.&RP )
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &NRSTR(&PD.ACID&LP.s&RP with FACILITY of STC is +
      &LP.are&RP not sourced to the z/OS internal reader.)
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    END
  SET DATA = &&ACIDSRC&A
  SET DATA = &STR(&DATA)
  SET AC = &STR(     &DATA)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
DO A = 1 TO &STCTBLV0
  IF &A EQ 1 THEN DO
    SET NR = &NR + 1
    IF &DETAIL_SW GT 1 THEN SET PD = &STR(&NR.&RP )
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &NRSTR(&PD.ACID&LP.s&RP identified in the STC record +
      are not defined with a valid user ACID.)
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    END
  SET DATA = &&STCTBLV&A
  SET DATA = &STR(&DATA)
  SET AC = &STR(     &DATA)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
DO A = 1 TO &STCTBLF0
  IF &A EQ 1 THEN DO
    SET NR = &NR + 1
    IF &DETAIL_SW GT 1 THEN SET PD = &STR(&NR.&RP )
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &NRSTR(&PD.ACID&LP.s&RP identified in the STC record +
      does not have FACILITY of STC.)
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    END
  SET DATA = &&STCTBLF&A
  SET DATA = &STR(&DATA)
  SET AC = &STR(     &DATA)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
/* The following started task(s) has (have) been improperly defined:
/*
/* 1) ACID(s) with the STC Facility are not defined in the STC record.
/* 2) ACID(s) identified in the STC record are not defined with a valid user
/*    ACID.
/* 3) ACID(s) identified in the STC record does not have FACILITY of STC.
/* 4) ACID(s) with FACILITY of STC is (are) not sourced to the z/OS internal
/*    reader.
/*
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0890
SET DETAIL_SW = 0
 
SET GROUP = &STR(SYSPAUDT SECAAUDT)
 
SET A = 1
DO WHILE &A LT &LENGTH(&STR(&GROUP))
  SET B = &SYSINDEX(&STR( ),&STR(&GROUP ),&A) - 1
  SET ATTR = &SUBSTR(&A:&B,&STR(&GROUP))
  SYSCALL DIALOG_RTN &ATTR
  SET A = &B + 2
  END
 
ISREDIT CURSOR = 1 0
 
TSS0890: +
SET RETURN_CODE = 0
 
SET ERROR   = 0
 
ISREDIT SEEK ' CONSOLE ' 40 &DW
 
IF &RETURN_CODE GT 0 THEN GOTO TSS0890_END
 
ISREDIT (STAT) = XSTATUS .ZCSR
 
IF &STR(&STAT) EQ &STR(X) THEN GOTO TSS0890
 
ISREDIT (DATA) = LINE .ZCSR
 
IF &SUBSTR(32:39,&NRSTR(&DATA)) EQ &STR(MSCA) OR +
   &SUBSTR(32:39,&NRSTR(&DATA)) EQ &STR(SCA) THEN DO
  WRITE &PGMNAME &SUBSTR(1:8,&NRSTR(&DATA)) in not in SECAAUDT.
  GOTO TSS0890
  END
 
SET DETAIL_LINE = &SUBSTR(1:30,&NRSTR(&DATA))
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(The following authorization&LP.s&RP to the +
    CONSOLE attribute is &LP.are&RP inappropriate:)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET DETAIL_SW = &DETAIL_SW + 1
  END
 
SET AC = &STR(     &DETAIL_LINE)
 
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
GOTO TSS0890
 
 
TSS0890_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(All ACID&LP.s&RP that have the CONSOLE attribute +
    are SCA security administrators and/or system programmers.)
 
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: That the CONSOLE attribute +
    be given to SCA security administrators and/or system +
    programmers only.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
 
SET TBL = &STR(GROUP PROFILE DEPT DIV DIVISION ZONE USER )
 
SET A = 0
DO X = 1 TO &LENGTH(&STR(&TBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TBL),&X)
  SET FLD = &SUBSTR(&X:&Y-1,&STR(&TBL))
  ISREDIT EXCLUDE ALL '&SUBSTR(1:8,&STR(&FLD&SP))' 32
  ISREDIT (,B) = EXCLUDE_COUNTS
  SET A = &A + &B
  SET X = &Y
  END
 
ISREDIT EXCLUDE " NOATS " ALL 59 &DW
ISREDIT (,B) = EXCLUDE_COUNTS
SET A = &A + &B
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
ISREDIT DELETE ALL X
 
WRITE &PGMNAME &A lines deleted out of &LASTLINE..
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0900
SET DETAIL_SW = 0
 
SET CURLINE = 0
 
TSS0900: +
SET RETURN_CODE = 0
SET CURLINE = &CURLINE + 1
 
IF &CURLINE GT &LASTLINE THEN GOTO TSS0900_END
 
ISREDIT (DATA) = LINE &CURLINE
 
SET DETAIL_LINE = &SUBSTR(1:30,&NRSTR(&DATA))
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(The following security administrator ACID&LP.s&RP +
    does &LP.do&RP not have the NOATS attribute assigned:)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET DETAIL_SW = &DETAIL_SW + 1
  END
 
SET AC = &STR(     &DETAIL_LINE)
 
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
GOTO TSS0900
 
 
TSS0900_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(All security administrators ACID&LP.s&RP have the +
    NOATS attribute specified.)
 
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: That the NOATS attribute +
    be given to all security administrators ACID&LP.s&RP.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
SET TBL = &STR(GROUP PROFILE DEPT DIV DIVISION ZONE )
 
SET A = 0
DO X = 1 TO &LENGTH(&STR(&TBL))
  SET Y = &SYSINDEX(&STR( ),&STR(&TBL),&X)
  SET FLD = &SUBSTR(&X:&Y-1,&STR(&TBL))
  ISREDIT EXCLUDE ALL '&SUBSTR(1:8,&STR(&FLD&SP))' 32
  ISREDIT (,B) = EXCLUDE_COUNTS
  SET A = &A + &B
  SET X = &Y
  END
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
ISREDIT DELETE ALL X
 
WRITE &PGMNAME &A lines deleted out of &LASTLINE..
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0990
SET DETAIL_SW = 0
 
ISREDIT CURSOR = 1 0
SET CURLINE = 0
 
TSS0990: +
SET RETURN_CODE = 0
 
ISREDIT FIND 'F&LP.*ALL*&RP' 40 &DW
 
IF &RETURN_CODE GT 0 THEN DO
  GOTO TSS0990_END
  END
 
ISREDIT (DATA) = LINE .ZCSR
 
SET DETAIL_LINE = &SUBSTR(1:30,&NRSTR(&DATA))
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(The following ACID&LP.s&RP was &LP.were&RP found +
    with the authorization FACILITY&LP.*ALL*&RP:)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET DETAIL_SW = &DETAIL_SW + 1
  END
 
SET AC = &STR(     &DETAIL_LINE)
 
ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
GOTO TSS0990
 
 
TSS0990_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(No ACID&LP.s&RP have FACILITY of ALL specified.)
 
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: That the FACLITY of ALL +
    not be given to any ACID.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET PDIMBR = TSS0995
SET DETAIL_SW = 0
SET SYSOUTTRAP = 999999
 
TSS LIST(ALL)
SET B = &SYSOUTLINE
SET SYSOUTTRAP = 0
 
DO A = 1 TO &B
  SET DATA = &&SYSOUTLINE&A
  SET DATA = &STR(&DATA)
  IF &SUBSTR(1:8,&STR(&DATA)) EQ &STR(FACILITY) THEN DO
    SET FAC = &SUBSTR(14:21,&STR(&DATA)&SP)
    IF &SYSINDEX(&STR(#&FAC),&TSS0995_FACLIST) EQ 0 THEN DO
      IF &DETAIL_SW EQ 0 THEN DO
        SET AC = &STR(The ALL record was found with the +
          FACILITIES other than DFHSM or HSM:)
        ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
          DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
        SET AC = &STR( )
        ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
          DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
        SET DETAIL_SW = &DETAIL_SW + 1
        END
      SET AC = &STR(     &FAC)
      ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
      END
    END
  END
 
 
TSS0995_END: +
SET RETURN_CODE = 0
 
IF &DETAIL_SW EQ 0 THEN DO
  SET AC = &STR(Not a Finding )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(The ALL record does not use any other FACILITY +
    other than DFHSM or HSM.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
ELSE DO
  SET AC = &STR( )
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
 
  SET AC = &STR(DISA recommendation: The only FACILITY that +
    be given to the ALL record is the FACILITY of DFHSM or HSM.)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  END
 
SYSCALL ADD_MEMBER
 
 
/* *************************************** */
/* END of program                          */
/* *************************************** */
 
SET RETURN_CODE = 0
SET PDIMBR =
 
ISPEXEC LMMFIND DATAID(&TABLEID) MEMBER(CACTSTCS)
 
IF &RETURN_CODE GT 0 THEN DO
  WRITE &PGMNAME LMMFIND TABLE CACTSTCS &RETURN_CODE
  GOTO END_EXIT
  END
 
PROCESS_STC_LIST: +
SET RETURN_CODE = 0
 
ISPEXEC LMGET DATAID(&TABLEID) MODE(INVAR) DATALOC(TREC) +
  MAXLEN(80) DATALEN(LRECL)
 
IF &RETURN_CODE GT 0 THEN DO
  IF &ERR EQ 0 AND +
     &STR(&PDIMBR) NE &STR( ) THEN DO
    SET AC = &STR(Not a Finding )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    DO X = 1 TO &LENGTH(&LIST)
      SET Y = &SYSINDEX(&STR(@),&LIST,&X)
      SET AC = &SUBSTR(&X:&Y-1,&LIST)
      ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
      SET X = &Y
    END
    END
  SET LIST =
  SYSCALL ADD_MEMBER
  GOTO END_EXIT
  END
 
SET PDIM = &SUBSTR(1:8,&NRSTR(&TREC))
IF &PDIM NE &PDIMBR THEN DO
  IF &ERR EQ 0 AND +
     &STR(&PDIMBR) NE &STR( ) THEN DO
    SET AC = &STR(Not a Finding )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    DO X = 1 TO &LENGTH(&LIST)
      SET Y = &SYSINDEX(&STR(@),&LIST,&X)
      SET AC = &SUBSTR(&X:&Y-1,&LIST)
      ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
        DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
      SET X = &Y
    END
    END
  SET LIST =
  SYSCALL ADD_MEMBER
  SET PDIMBR EQ &PDIM
  SET ERR = 0
  END
 
SET STCMBR = &SUBSTR(9:16,&NRSTR(&TREC))
SET X = &SYSINDEX(&STR( ),&NRSTR(&STCMBR )) - 1
SET STCMBR = &SUBSTR(1:&X,&NRSTR(&STCMBR))
SET USERID = &SUBSTR(17:24,&NRSTR(&TREC))
SET X = &SYSINDEX(&STR( ),&NRSTR(&USERID )) - 1
SET USERID = &SUBSTR(1:&X,&NRSTR(&USERID))
 
SET FOUND =
DO A = 1 TO &STC0
  SET DATA = &&STC&A
  SET DATA = &STR(&DATA)
  IF &SUBSTR(1:12,&NRSTR(&DATA)) NE &STR(STC        =) THEN +
    GOTO BYPASS_PROCESS
  SET PROFILE = &SUBSTR(14:21,&NRSTR(&DATA))
  IF &SUBSTR(1,&NRSTR(&PROFILE)) EQ &STR(*) THEN +
    GOTO BYPASS_PROCESS
  SET USER    = &SUBSTR(37:44,&NRSTR(&DATA&SP))
  IF &SYSINDEX(&STR(&STCMBR ),&NRSTR(&PROFILE )) EQ 1 AND +
     &NRSTR(&USERID) EQ &NRSTR(&USER) THEN DO
    SET FOUND = X
    SET A = &STC0
    END
  ELSE DO
    SET FOUND = X
    DO X = 1 TO 8
      IF &SUBSTR(&X,&NRSTR(&PROFILE)) NE &STR(+) AND +
         &SUBSTR(&X,&NRSTR(&PROFILE)) NE &STR(*) THEN +
        IF &SUBSTR(&X,&NRSTR(&PROFILE)) NE +
           &SUBSTR(&X,&NRSTR(&STCMBR        )) THEN DO
          SET FOUND =
          SET X = 8
          END
      IF &SUBSTR(&X,&NRSTR(&PROFILE)) EQ &STR(*) THEN +
        SET X = 8
    END
    IF &FOUND EQ &STR(X) AND +
       &NRSTR(&USERID) EQ &NRSTR(&USER) THEN +
      SET A = &STC0
     ELSE +
       SET FOUND =
    END
  BYPASS_PROCESS: +
END
IF &STR(&FOUND) EQ &STR( ) THEN DO
  IF &ERR EQ 0 THEN DO
    SET AC = &STR(The Product started task(s) is(are) improperly +
      defined to the started task table:)
 
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
    END
  SET AC = &STR(     &STCMBR for user &USERID..)
  ISPEXEC LMPUT DATAID(&PDIID) MODE(INVAR) DATALOC(AC) +
    DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDIMBR)
  SET ERR = &ERR + 1
  END
SET LIST = &LIST&STR(Found &STCMBR for user &USERID..@)
 
GOTO PROCESS_STC_LIST
 
 
END_EXIT: +
SET RETURN_CODE = 0
 
ERR_EXIT: +
IF &MAXCC GE 16 OR +
   &RETURN_CODE GT 0 THEN DO
  ISPEXEC VGET (ZISPFRC) SHARED
  IF &MAXCC GT &ZISPFRC THEN +
    SET ZISPFRC = &MAXCC
  ELSE +
    SET ZISPFRC = &RETURN_CODE
  ISPEXEC VPUT (ZISPFRC) SHARED
  WRITE &PGMNAME ZISPFRC = &ZISPFRC
  END
 
SET TM527RC = &RETURN_CODE
 
ISPEXEC VPUT ( +
  TM527VG      +
  TM527RC      +
  ) ASIS
 
ISREDIT CANCEL
 
EXIT CODE(0)
 
 
/* *************************************** */
/*  SYSCALL SUBROUTINES                    */
/* *************************************** */
 
ADD_MEMBER: PROC 0
 
IF &PDIMBR EQ &STR( ) THEN +
  RETURN CODE(0)
SET ZEDSMSG = FINISHED
SET ZEDLMSG = &STR(Finished processing &PDIMBR.)
ISPEXEC LOG MSG(ISRZ000)
 
SET RETURN_CODE = 0
 
ISPEXEC LMMADD DATAID(&PDIID) MEMBER(&PDIMBR)
 
IF &RETURN_CODE EQ 4 THEN DO          /* MEMBER ALREADY EXISTS
  SET RETURN_CODE = 0
 
  ISPEXEC LMMREP DATAID(&PDIID) MEMBER(&PDIMBR)
 
  IF &RETURN_CODE NE 0 THEN DO
    WRITE &PGMNAME LMMREP_PDI_RCODE = &RETURN_CODE &PDIMBR  &ZERRSM
    END
  END
ELSE DO
  IF &RETURN_CODE NE 0 THEN +
    WRITE &PGMNAME LMMADD_PDI_RCODE = &RETURN_CODE &PDIMBR  &ZERRSM
  END
 
ISREDIT RESET
ISREDIT DELETE ALL NX
SET RETURN_CODE = 0
ISREDIT COPY '&DSNAME' AFTER .ZF
 
END
 
 
DIALOG_RTN: PROC 1 AUMBR
 
SET RETURN_CODE = 0
 
ISPEXEC LMMFIND DATAID(&DIALOG) MEMBER(&AUMBR)
 
SET LMMFIND_DIALOG_RC = &RETURN_CODE
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME Authorized user list &AUMBR not found.
  RETURN
  END
 
GET_NEXT_USR: +
SET RETURN_CODE = 0
 
ISPEXEC LMGET DATAID(&DIALOG) MODE(INVAR) DATALOC(URECORD) +
  MAXLEN(80) DATALEN(LRECL)
 
SET LMGET_DIALOG_RC = &RETURN_CODE
IF &RETURN_CODE EQ 8 THEN DO           /* END OF MEMBER */
   SET LMGET_DIALOG_RC = 0             /* SET RETURN CODE TO 0 */
   RETURN
   END
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMGET  DIALOG  RC = &RETURN_CODE  &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  RETURN
  END
 
IF &SUBSTR(1,&NRSTR(&URECORD)) EQ &STR(*) OR   +
   &SUBSTR(1,&NRSTR(&URECORD)) EQ &STR( ) THEN +
  GOTO GET_NEXT_USR
 
SET USR = &SUBSTR(1:8,&NRSTR(&URECORD))
 
ISREDIT EXCLUDE ALL '&USR' 1
 
GOTO GET_NEXT_USR
 
/*  ---------------   */
 
END