**********************************************************************************************
      * DBG193R4: Purge output queue of old spoolfiles
      * Copyright (C) 2000  Martin Rowe   <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **********************************************************************************************
     H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT)
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
     FDBG1860W  IF   E             DISK
      **********************************************************************************************
      * ARRAYS:
      **********************************************************************************************
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
     D SDS#DS         SDS
     D  SDS#Pgm                      10    OVERLAY(SDS#DS:1)
     D  SDS#User                     10    OVERLAY(SDS#DS:254)
      *
     D Command1        DS
     D  DLTSPLF                      80    INZ('DLTSPLF FILE(1234567890) -
     D                                     JOB(123456/1234567890/1234567890) -
     D                                     SPLNBR(12345)')
     D   DLTFile                     10    OVERLAY(DLTSPLF:14)
     D   DLTJob                      28    OVERLAY(DLTSPLF:30)
     D   DLTSplNbr                    5  0 OVERLAY(DLTSPLF:67)
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D CutOffDate      S               D   DATFMT(*ISO)
     D CutOffHeld      S               D   DATFMT(*ISO)
     D CutOffSave      S               D   DATFMT(*ISO)
     D DeleteRqd       S              1N
     D P#CmdString     S            256
     D P#CmdLength     S             15  5
     D P#Retain        S              5  0
     D P#RtnHld        S              5  0
     D P#RtnSav        S              5  0
     D SpoolDate       S               D   DATFMT(*ISO)
      **********************************************************************************************
      * CONSTANTS:
      **********************************************************************************************
      **********************************************************************************************
      * FIELD RENAMES:
      **********************************************************************************************
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    P#Retain
     C                   PARM                    P#RtnHld
     C                   PARM                    P#RtnSav
      **********************************************************************************************
      * KEY LISTS:
      **********************************************************************************************
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
      * Set cutoff date from current date minus retention days
     C     *ISO          MOVE      *DATE         CutOffDate
     C     *ISO          MOVE      *DATE         CutOffHeld
     C     *ISO          MOVE      *DATE         CutOffSave
      * Use default retention days for held spoolfiles if not specified
B001 C                   IF        P#RtnHld = -1
     C                   EVAL      P#RtnHld = P#Retain
E001 C                   ENDIF
      * Use default retention days for saved spoolfiles if not specified
B001 C                   IF        P#RtnSav = -1
     C                   EVAL      P#RtnSav = P#Retain
E001 C                   ENDIF
     C                   SUBDUR    P#Retain:*D   CutOffDate
     C                   SUBDUR    P#RtnHld:*D   CutOffHeld
     C                   SUBDUR    P#RtnSav:*D   CutOffSave
      * Loop through *OUTFILE for requested *OUTQ
     C     1             SETLL     DBG1860W
     C                   READ      DBG1860W
      *
B001 C                   DOW       NOT %EOF(DBG1860W)
     C     *YMD          MOVE      SPLDATE       SpoolDate
     C                   EVAL      DeleteRqd = *off
      *
B002 C                   SELECT
S002 C                   WHEN      SPLSTATUS = '*HELD'
B003 C                   IF        SpoolDate < CutOffHeld
     C                   EVAL      DeleteRqd = *on
E003 C                   ENDIF
S002 C                   WHEN      SPLSTATUS = '*SAVED'
B003 C                   IF        SpoolDate < CutOffSave
     C                   EVAL      DeleteRqd = *on
E003 C                   ENDIF
S002 C                   OTHER
B003 C                   IF        SpoolDate < CutOffDate
     C                   EVAL      DeleteRqd = *on
E003 C                   ENDIF
E002 C                   ENDSL
      *
B002 C                   IF        DeleteRqd
     C                   EVAL      DLTFile = SPLNAME
     C                   EVAL      DLTJob = SPLJOBNBR + '/' +
     C                             %TRIM(SPLUSERPRF) + '/' +
     C                             %TRIM(SPLJOBNAME)
     C                   EVAL      DLTSplNbr = SPLNBR
      * Delete the spoolfile
     C                   CALL (E)  'QCMDEXC'
     C                   PARM      DLTSPLF       P#CmdString
     C                   PARM      80            P#CmdLength
E002 C                   ENDIF
     C                   READ      DBG1860W
E001 C                   ENDDO
      *
     C                   EVAL      *INLR = *on
     C                   RETURN
      **********************************************************************************************