PROC 0                                               -
  CONSLIST(OFF)              /* DEFAULT IS OFF  */ -
  COMLIST(OFF)               /* DEFAULT IS OFF  */ -
  SYMLIST(OFF)               /* DEFAULT IS OFF  */ -
  TERMPRO(OFF)               /* DEFAULT IS OFF  */ -
  TERMMSGS(OFF)              /* DEFAULT IS OFF  */ -
  CACC1000(CACC1000)         /* PDI EDIT MACRO  */ -
  CATM1004(CATM1004)         /* TEMP EDIT MACRO */ -
  TRACE(OFF)                 /* TRACE ACTIONS AND ERRORS */
 
/********************************************************************/
/* This CLIST (CATC1002) reads a formated report from TSSCFILE      */
/* UTILITY and select ACIDS that have been unused for more than     */
/* the value of variable CHKDATE.  Those records that have been     */
/* unused will be written to the file OUTFILE.                      */
/********************************************************************/
/* CHANGE LOG                                                       */
/* 03/15/2011 CL Fenton Chgd evaluation from 35 to 30 days.
/* 05/25/2011 CL Fenton Reverted evaluation from 30 to 35 days.
/* 10/25/2019 CL Fenton Added automation for ACP00310 and
/*            generate finding details, STS-023407.
/* 08/19/2020 CL Fenton Chgs made to correct CC 900 and CC 856,
/*            STS-025132.
 
SET PGMNAME = &STR(CATC1002 08/19/20)
/* ERROR ROUTINE */
ERROR DO
  SET RETURN_CODE = &LASTCC         /* SAVE LAST ERROR CODE */
  IF &RETURN_CODE GE 16 AND +
     &RETURN_CODE NE 400 THEN +
    WRITE &PGMNAME LASTCC = &RETURN_CODE &ZERRLM
  RETURN
  END
 
ISPEXEC CONTROL NONDISPL ENTER
ISPEXEC CONTROL ERRORS RETURN
 
CONTROL NOFLUSH MSG
 
/*******************************************/
/* CONSLIST = CONLIST                      */
/* COMLIST = LIST                          */
/* SYMLIST = SYMLIST                       */
/* TERMPRO = PROMPT                        */
/* TERMMSGS = MESSAGES                     */
/* TRACE TURNS ON MESSAGING                */
/*******************************************/
 
IF &TRACE = ON THEN                         /* TURN TRACE ON */ -
  DO
    SET CONSLIST = ON
    SET COMLIST = ON
    SET SYMLIST = ON
    SET TERMPRO = ON
    SET TERMMSGS = ON
  END
 
 
MESSAGE_HOUSEKEEPING: -
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 ZISPFRC = 0
ISPEXEC VPUT (ZISPFRC) SHARED
 
SET RETURN_CODE = 0
 
ISPEXEC  VPUT ( -
  CONSLIST      -
  COMLIST       -
  SYMLIST       -
  TERMPRO       -
  TERMMSGS      -
  ) ASIS
 
SET VPUT_RC = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME VPUT_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
SET RETURN_CODE = 0
 
ISPEXEC SELECT CMD(&CACC1000 ACP)
 
IF &RETURN_CODE LE 4 THEN -
  ISPEXEC VGET (ACPNAME ACPVERS) ASIS
 
SET BYPTYPE = &STR( GRO PRO DEP DIV ZON )
SET CRDATE = &STR(00/00/00)
SET MODDATE = &STR(00/00/00)
SET LASTUSED = &STR(00/00/00)
SET COUNT = &STR(00000)
SET SUSPEND = &STR(        )
SET ASUSPEND = &STR(        )
 
NGLOBAL CRDATE,MODDATE,LASTUSED,COUNT,SUSPEND,ASUSPEND,OP
 
/*********************************************/
/* INITIALIZE DATE USING ZDATESTD (YYYYMMDD) */
/*********************************************/
 
ISPEXEC VGET ( -
  ZDATESTD -
  )
 
SET YEAR = &EVAL(&SUBSTR(1:4,&ZDATESTD))
 
SET MONTH = &EVAL(&SUBSTR(6:7,&ZDATESTD))
 
SET DAY = &EVAL(&SUBSTR(9:10,&ZDATESTD))
 
SET YR400 = &EVAL(&YEAR/400*400)
SET YR4   = &EVAL(&YEAR/4*4)
SET FEB = 28
 
IF &SUBSTR(3:4,&YEAR) EQ &STR(00) THEN +
  IF &YEAR EQ &YR400 THEN +
    SET FEB = 29
ELSE +
  IF &YEAR EQ &YR4 THEN +
    SET FEB = 29
 
SET MONDAYS = &STR(31&FEB.31303130313130313031)
 
DO UNTIL &DAY GT 35
  SET MONTH = &MONTH - 1
 
  IF &MONTH EQ 0 THEN DO
    SET MONTH = 12
    SET YEAR = &YEAR - 1
    END
 
  SET X = (&MONTH * 2) - 1
  SET MDAYS = &SUBSTR(&X:&X+1,&MONDAYS)
  SET MDAYS = &EVAL(&MDAYS)
  SET DAY = &DAY + &MDAYS
END
 
SET DAY = &DAY - 35
 
SET MONTH = &STR(X00&MONTH)
 
SET DAY = &STR(X00&DAY)
 
SET LMONTH = &LENGTH(&STR(&MONTH))
 
SET LDAY = &LENGTH(&STR(&DAY))
 
SET MONTH = &SUBSTR(&LMONTH-1:&LMONTH,&STR(&MONTH))
 
SET DAY = &SUBSTR(&LDAY-1:&LDAY,&STR(&DAY))
 
SET CHKDATE = &STR(&YEAR&MONTH&DAY)
 
 
/*******************************************/
/* INITIALIZE LIBRARY MANAGEMENT           */
/*******************************************/
 
SET RETURN_CODE = 0
 
OPENFILE INFILE
 
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME OPEN of file INFILE failed +
    RC = &RETURN_CODE &ZERRMSG &ZERRSM
  GOTO ERR_EXIT
  END
 
ISPEXEC LMINIT DATAID(TEMP) DDNAME(OUTDATA)
 
SET LMINIT_TEMP_RC = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMINIT_TEMP_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMOPEN DATAID(&TEMP) OPTION(OUTPUT)
 
SET LMOPEN_TEMP_RC = &RETURN_CODE
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME LMOPEN_TEMP_RC = &RETURN_CODE &ZERRSM
  WRITE &PGMNAME &ZERRLM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
/********************************************************************/
/* MAIN PROCESS LOOP                                                */
/********************************************************************/
 
GETFILE: GETFILE INFILE
 
IF &RETURN_CODE = 400 THEN DO
  SYSCALL CHECKREC &STR(&CHKDATE)
  IF &LASTCC = 4 THEN DO
    IF &ASUSPEND EQ  THEN +
      IF &SUSPEND EQ  THEN +
        SET TYP = 0
      ELSE +
        SET TYP = 1
    ELSE +
      SET TYP = 2
    IF &SYSINDEX(&STR(INTRDR ),&SOURCES) EQ 0 THEN DO
      SET OUTDATA = &NRSTR(&TYP&ACID&NAME&ACIDTYP&CRDATE+
        &MODDATE&LASTUSED&COUNT  &SOURCES)
      ISPEXEC LMPUT DATAID(&TEMP) MODE(INVAR) +
        DATALOC(OUTDATA) DATALEN(&LENGTH(&NRSTR(&OUTDATA)))
      END
    END
  GOTO JOBDONE
  END
 
IF &SUBSTR(15:22,&INFILE) NE  THEN  /* CHECK RECORD FOR AN ACID */ +
  IF &STR(&ACID) NE &SUBSTR(15:22,&INFILE) THEN +
    IF &STR(&ACID) EQ  THEN +
      SET ACID = &SUBSTR(15:22,&INFILE)
    ELSE DO
      SYSCALL CHECKREC &STR(&CHKDATE)
      IF &LASTCC = 4 THEN DO
        IF &ASUSPEND EQ  THEN +
          IF &SUSPEND EQ  THEN +
            SET TYP = 0
          ELSE +
            SET TYP = 1
        ELSE +
          SET TYP = 2
        IF &SYSINDEX(&STR(INTRDR ),&SOURCES) EQ 0 THEN DO
          SET OUTDATA = &NRSTR(&TYP&ACID&NAME&ACIDTYP&CRDATE+
            &MODDATE&LASTUSED&COUNT  &SOURCES)
          ISPEXEC LMPUT DATAID(&TEMP) MODE(INVAR) +
            DATALOC(OUTDATA) DATALEN(&LENGTH(&NRSTR(&OUTDATA)))
          END
        END
      SET ACID = &SUBSTR(15:22,&INFILE)
      SET CRDATE = &STR(00/00/00)
      SET MODDATE = &STR(00/00/00)
      SET LASTUSED = &STR(00/00/00)
      SET COUNT = &STR(00000)
      SET SUSPEND = &STR(        )
      SET ASUSPEND = &STR(        )
      SET OP =
      SET SOURCES =
      END
 
BYPASS: +
SET RECID = &SUBSTR(5:8,&INFILE)
 
IF &RECID = 0001 THEN  /* TSS COMMAND TEXT */ +
  GOTO GETFILE
 
IF &RECID = 0100 THEN  /* NAME        = */ +
  SET NAME = &SUBSTR(33:64,&INFILE)
 
IF &RECID = 0200 THEN  /* TYPE        = */ DO
  SET ACIDTYP = &SUBSTR(33:40,&INFILE)
  SET ACIDSZ = &SUBSTR(41:48,&INFILE)
  /* TEST TO BYPASS NON-USER RECORDS */
  IF &SYSINDEX(&STR( &SUBSTR(1:3,&ACIDTYP)),&BYPTYPE) GT 0 THEN DO
    DO UNTIL &STR(&ACID) NE &SUBSTR(15:22,&INFILE)
      GETFILE INFILE   /* LOOP UNTIL NEW ACID OR EOF OCCURS */
      IF &RETURN_CODE = 400 THEN +
        GOTO JOBDONE
      END
    SET ACID = &SUBSTR(15:22,&INFILE)
    GOTO BYPASS
    END
  END
 
IF &RECID = 0500 THEN  /* CREATED     = */ DO
  SET CRDATE = &SUBSTR(33:40,&INFILE)
  SET CRTIME = &SUBSTR(54:58,&INFILE)
  SET MODDATE = &SUBSTR(41:48,&INFILE)
  SET MODTIME = &SUBSTR(49:53,&INFILE)
  END
 
IF &RECID = 0700 THEN  /* ATTRIBUTES  = */ DO
  SET ASUSPEND = &SUBSTR(153:160,&INFILE)
  SET SUSPEND = &SUBSTR(81:88,&INFILE)
  END
 
IF &RECID = 0900 THEN  /* LAST USED   = */ DO
  SET LASTUSED = &SUBSTR(33:40,&INFILE)
  SET LASTTIME = &SUBSTR(41:45,&INFILE)
  SET LASTCPU  = &SUBSTR(46:49,&INFILE)
  SET LASTFAC  = &SUBSTR(50:57,&INFILE)
  SET COUNT = &SUBSTR(58:62,&INFILE)
  END
 
IF &RECID = 2200 THEN  /* SOURCES     = */ +
  DO X = 33 TO 57 BY 8
    SET SOURCES = &SOURCES&SUBSTR(&X:&X+7,&INFILE)&STR( )
  END
 
GOTO GETFILE
 
JOBDONE: +
CLOSFILE INFILE
 
SET RETURN_CODE = 0
ISPEXEC LMCLOSE DATAID(&TEMP)
 
SET LMCLOSE_TEMP_RC = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMCLOSE_TEMP_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMINIT DATAID(TEMP) DDNAME(OUTDATA)
 
SET LMINIT2_TEMP_RC = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMINIT2_TEMP_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMINIT DATAID(PDIDD) DDNAME(PDIDD)
 
SET LMINIT_PDIDD_RC = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMINIT_PDIDD_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC LMOPEN DATAID(&PDIDD) OPTION(OUTPUT)
 
SET LMOPEN_PDIDD_RC = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME LMOPEN_PDIDD_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
SET RETURN_CODE = 0
ISPEXEC VPUT ( +
  PDIDD        +
  CHKDATE)
 
SET VPUT_PDIDD_RC = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME VPUT_PDIDD_RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC EDIT DATAID(&TEMP) MACRO(&CATM1004)
SET EDIT_TEMP_RC = &RETURN_CODE
 
SET RETURN_CODE = 0
ISPEXEC VGET ( +
  TM4VGE)
 
SET RETURN_CODE = 0
ISPEXEC LMCLOSE DATAID(&PDIDD)
SET LMCLOSE_PDIDD_RC = &RETURN_CODE
 
SET RETURN_CODE = 0
ISPEXEC LMFREE DATAID(&TEMP)
SET LMFREE_TEMP_RC = &RETURN_CODE
 
SET RETURN_CODE = 0
ISPEXEC LMFREE DATAID(&PDIDD)
SET LMFREE_PDIDD_RC = &RETURN_CODE
 
 
ERR_EXIT: +
IF (&MAXCC GE 16 AND +
   &MAXCC NE 400) 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
 
IF &TERMMSGS = ON THEN DO
WRITE ===============================================================
WRITE &PGMNAME VPUT_RC                         -
  &VPUT_RC
WRITE &PGMNAME LMINIT_TEMP_RC                  -
  &LMINIT_TEMP_RC
WRITE &PGMNAME LMOPEN_TEMP_RC                  -
  &LMOPEN_TEMP_RC
WRITE &PGMNAME LMCLOSE_TEMP_RC                 -
  &LMCLOSE_TEMP_RC
WRITE &PGMNAME LMINIT2_TEMP_RC                 -
  &LMINIT2_TEMP_RC
WRITE &PGMNAME LMINIT_PDIDD_RC                 -
  &LMINIT_PDIDD_RC
WRITE &PGMNAME LMOPEN_PDIDD_RC                 -
  &LMOPEN_PDIDD_RC
WRITE &PGMNAME VPUT_PDIDD_RC                   -
  &VPUT_PDIDD_RC
WRITE &PGMNAME EDIT_TEMP_RC                    -
  &EDIT_TEMP_RC
WRITE &PGMNAME &CATM1004 TM4VGE                 -
  &TM4VGE
WRITE &PGMNAME LMFREE_TEMP_RC                  -
  &LMFREE_TEMP_RC
WRITE &PGMNAME LMCLOSE_PDIDD_RC                -
  &LMCLOSE_PDIDD_RC
WRITE &PGMNAME LMFREE_PDIDD_RC                 -
  &LMFREE_PDIDD_RC
WRITE ===============================================================
END
 
EXIT CODE(0)
END
 
CHECKREC: PROC 1 CDATE
 
IF &COUNT EQ &STR(00000) THEN GOTO NEXTTEST
 
SET DATE1 = &SUBSTR(7:8,&LASTUSED)&SUBSTR(1:2,&LASTUSED)+
  &SUBSTR(4:5,&LASTUSED)
IF &SUBSTR(1:2,&STR(&DATE1)) LE &STR(50) THEN +
  SET DATE1 = &STR(20&DATE1)
ELSE +
  SET DATE1 = &STR(19&DATE1)
 
SET OP = &STR(LASTUSED)
IF &DATE1 GT &CDATE THEN +
  RETURN CODE(0)
 
NEXTTEST:                                                         -
SET DATE2 = &SUBSTR(7:8,&CRDATE)&SUBSTR(1:2,&CRDATE)+
  &SUBSTR(4:5,&CRDATE)
IF &SUBSTR(1:2,&STR(&DATE2)) LE &STR(50) THEN +
  SET DATE2 = &STR(20&DATE2)
ELSE +
  SET DATE2 = &STR(19&DATE2)
 
SET OP = &STR(CREATED)
IF &DATE2 GT &CDATE THEN +
  RETURN CODE(0)
 
SET DATE2 = &SUBSTR(7:8,&MODDATE)&SUBSTR(1:2,&MODDATE)+
  &SUBSTR(4:5,&MODDATE)
IF &SUBSTR(1:2,&STR(&DATE2)) LE &STR(50) THEN +
  SET DATE2 = &STR(20&DATE2)
ELSE +
  SET DATE2 = &STR(19&DATE2)
 
SET OP = &STR(MODIFIED)
IF &DATE2 GT &CDATE THEN +
  RETURN CODE(0)
 
RETURN CODE(4)
 
END