You are here:
DBG/400
>
DBG400 Web
>
SourceCodeList
>
RpgleSource
>
RpgleDBG193R4
(26 May 2005,
MartinRowe
)
(raw view)
E
dit
A
ttach
<verbatim> ********************************************************************************************** * 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 ********************************************************************************************** </verbatim>
E
dit
|
A
ttach
|
P
rint version
|
H
istory
: r1
|
B
acklinks
|
V
iew topic
|
Edit
w
iki text
|
M
ore topic actions
Topic revision: r1 - 26 May 2005 - 19:47:19 -
MartinRowe
DBG400
Log In
DBG400 Web
Index
Search
Changes
Notifications
Statistics
Site Map
Downloads
Webs
DBG400
Jamaro
Main
Sandbox
Sandtub
System
Send a link to this page
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400?
Send feedback