|
I have done something similar using CL + COBOL. It can be done entirely in CL but that would take time. I have attached my CL, COBOL, and DDS source. There used to be an RPG version in TAATOOLS called DLTOLDSPLF. At 05:50 PM 4/20/97 -0400, you wrote: >NEED TO WRITE A CL PROGRAM THAT WILL COPY THE CONTENTS OF AN OUPUTQ >THAN COMPARE ITS CONTENS TO A CERTAIN DATE IN ORDER TO DECIDE WETHER OR >NOT TO DELETE. IS THERE A WAY TO GET THIS TASK ACOMPLISHED. >* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * >* This is the Midrange System Mailing List! To submit a new message, * >* send your mail to "MIDRANGE-L@midrange.com". To unsubscribe from * >* this list send email to MAJORDOMO@midrange.com and specify * >* 'unsubscribe MIDRANGE-L' in the body of your message. Questions * >* should be directed to the list owner / operator: david@midrange.com * >* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * > >
midrange.com
IDENTIFICATION DIVISION.
PROGRAM-ID. CHGALLSPLL.
AUTHOR. PETER LUNDE.
DATE-WRITTEN. APRIL 4, 1997.
*‚
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
*‚
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*‚
SELECT WRKSPLFP ASSIGN TO DATABASE-WRKSPLFP.
*‚
DATA DIVISION.
*‚
FILE SECTION.
FD WRKSPLFP
LABEL RECORD OMITTED.
01 WRKSPLFP-RECORD.
COPY DD-ALL-FORMATS OF WRKSPLFP.
/‚***************************************************************
WORKING-STORAGE SECTION.
*‚***************************************************************
01 WS-AREA.
05 WS-FILE-LIB.
10 WS-FILE PIC X(10).
10 WS-LIB PIC X(10).
05 WS-EOF PIC 9 VALUE 0.
/‚***************************************************************
LINKAGE SECTION.
*‚***************************************************************
01 LS-MAXPAGES PIC 9(5) COMP-3.
01 LS-TOOUTQ PIC X(10).
01 LS-SAVE PIC X(5).
*‚===============================================================
PROCEDURE DIVISION USING LS-MAXPAGES LS-TOOUTQ LS-SAVE.
*‚===============================================================
*‚
*‚--------------------------------------------------------------*
A000-MAINLINE.
*‚--------------------------------------------------------------*
*‚
*‚ This paragraph controls the processing order for the program
*‚ and sequences the required events.
*‚
*‚ Open the Field Description file and find policy number NOCNT
OPEN INPUT WRKSPLFP.
MOVE 0 TO WS-EOF.
PERFORM B100-PROCESS UNTIL WS-EOF = 1.
CLOSE WRKSPLFP.
GOBACK.
*‚--------------------------------------------------------------*
B100-PROCESS.
*‚--------------------------------------------------------------*
READ WRKSPLFP
AT END
MOVE 1 TO WS-EOF
NOT AT END
INSPECT TOTPAGES REPLACING LEADING SPACES BY ZEROS
INSPECT JOBNBR REPLACING LEADING SPACES BY ZEROS
INSPECT SPLFNBR REPLACING LEADING SPACES BY ZEROS
IF TOTPAGES IS NUMERIC
IF TOTPAGES > 0
*‚ If spool file is writing, we can't change it.
IF SPLFSTATUS NOT = "WTR"
IF (SPLF NOT = "QPJOBLOG") OR TOTPAGES < 21
CALL "CHGSPLFC" USING SPLF JOB USER JOBNBR
SPLFNBR LS-TOOUTQ LS-SAVE
END-IF
END-IF
END-IF
END-IF
END-READ.
/*‚-----------------------------------------------------------------€*/
/*‚Program Name: ChgAllSplC - Change All Spool Files CLP €*/
/*‚ €*/
/*‚Calls: ChgAllSplL - Change All Spool Files CBL €*/
/*‚ ChgSplfC - Change Spool Files CLP €*/
/*‚ €*/
/*‚Date: 1997/04/08 €*/
/*‚ €*/
/*‚Author: Peter Lunde (telsci@interlog.com) €*/
/*‚ €*/
/*‚Description: This program changes all the spool files for a €*/
/*‚ specific user. It moves them all to another output€*/
/*‚ queue and releases them all. €*/
/*‚ €*/
/*‚Parameters: €*/
/*‚ User - whose files to move €*/
/*‚ €*/
/*‚Additional Parameters (Use must press F10): €*/
/*‚ Date - select only files created since a specified €*/
/*‚ date. Defaults to *TODAY, but you can also €*/
/*‚ specify *YESTERDAY or any other date. €*/
/*‚ Time - select only files created since a specified €*/
/*‚ time of day. Defaults to 18:00:00. €*/
/*‚ MaxPages - We only want to print small job logs, so this €*/
/*‚ parameter lets us specifiy the maximum size joblog €*/
/*‚ to print. €*/
/*‚ ToOutQ - The output queue to move the jobs to. €*/
/*‚ Save - Save the spool files? €*/
/*‚-----------------------------------------------------------------€*/
/*‚Modifications: €*/
/*‚-----------------------------------------------------------------€*/
/*‚ €*/
PGM PARM(&USER &DATE &TIME &MAXPAGES &TOOUTQ &SAVE)
DCL &USER *CHAR 10
DCL &DATE *CHAR 7
DCL &TIME *CHAR 6
DCL &MAXPAGES *DEC 5
DCL &TOOUTQ *CHAR 10
DCL &SAVE *CHAR 5
DCL &qdatfmt *CHAR 3
/*‚-----------------------------------------------------------------€*/
/*‚First, turn on the job log. €*/
CHGJOB LOG(*SAME *SAME *MSG) LOGCLPGM(*YES)
/*‚-----------------------------------------------------------------€*/
/*‚Add the Canadian Surety Canada West General Purpose Library to €*/
/*‚the library list. €*/
ADDLIBLE CSCWGPL
MONMSG CPF2103 /*‚Already on library list.€*/
/*‚-----------------------------------------------------------------€*/
/*‚What date format is the system using? €*/
RTVSYSVAL SYSVAL(QDATFMT) RTNVAR(&QDATFMT)
/*‚-----------------------------------------------------------------€*/
/*‚Get a list of the user's spool files. One way to do this is to €*/
/*‚print the user's spool files and then process that print. €*/
WRKSPLF SELECT(&USER) OUTPUT(*PRINT)
/*‚-----------------------------------------------------------------€*/
/*‚Create a database file to hold the list of spool files. €*/
CRTDUPOBJ OBJ(WRKSPLFP) FROMLIB(CSCWGPL) OBJTYPE(*FILE) TOLIB(QTEMP)
MONMSG CPF2130 /*‚File exists€*/
/*‚-----------------------------------------------------------------€*/
/*‚Copy the list of spool files to the database. €*/
CPYSPLF FILE(QPRTSPLF) TOFILE(QTEMP/WRKSPLFP) SPLNBR(*LAST)
/*‚-----------------------------------------------------------------€*/
/*‚Delete the list after we have copied it. €*/
DLTSPLF FILE(QPRTSPLF) SPLNBR(*LAST)
/*‚-----------------------------------------------------------------€*/
/*‚Get ready to use our temporary version of the SPLF database. €*/
OVRDBF FILE(WRKSPLFP) TOFILE(QTEMP/WRKSPLFP)
/*‚-----------------------------------------------------------------€*/
/*‚Call a COBOL program to read the database and do the rest of the €*/
/*‚work. €*/
CALL CSCWGPL/CHGALLSPLL PARM(&DATE &TIME &MAXPAGES &TOOUTQ &SAVE +
&qdatfmt)
ENDPGM
CMD PROMPT('Change All Spool Files')
PARM KWD(USER) TYPE(*NAME) LEN(10) DFT(OPERPRD) +
CHOICE('OPERPRD OPERACT') +
PROMPT('User')
PARM KWD(MAXPAGES) TYPE(*DEC) LEN(5) DFT(20) +
PMTCTL(*PMTRQS) PROMPT('Maximum QPJOBLOG +
pages')
PARM KWD(TOOUTQ) TYPE(*NAME) LEN(10) DFT(GENICOM) +
PMTCTL(*PMTRQS) PROMPT('To Output Queue')
PARM KWD(SAVE) TYPE(*CHAR) LEN(5) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO *SAME) +
PMTCTL(*PMTRQS) PROMPT('Save Spool File')
/*‚-----------------------------------------------------------------€*/
/*‚Program Name: ChgSplFC - Change Spool Files CLP €*/
/*‚ €*/
/*‚Date: 1997/04/08 €*/
/*‚ €*/
/*‚Author: Peter Lunde (telsci@interlog.com) €*/
/*‚ €*/
/*‚Description: This program changes all the spool files for a €*/
/*‚ specific user. It moves them all to another output€*/
/*‚ queue and releases them all. €*/
/*‚ €*/
/*‚Parameters: €*/
/*‚ SplF - spool file name €*/
/*‚ Job - spool file job €*/
/*‚ User - spool file user €*/
/*‚ JobNbr - spool file job number €*/
/*‚ SplfNbr- spool file sequence number €*/
/*‚ ToOutQ - The output queue to move the spool file to €*/
/*‚ Save - Save the spool files? €*/
/*‚-----------------------------------------------------------------€*/
/*‚Modifications: €*/
/*‚-----------------------------------------------------------------€*/
/*‚ €*/
PGM PARM(&SPLF &JOB &USER &JOBNBR &SPLFNBR &TOOUTQ &SAVE)
DCL &SPLF *CHAR 10
DCL &JOB *CHAR 10
DCL &USER *CHAR 10
DCL &JOBNBR *CHAR 6
DCL &SPLFNBR *CHAR 4
DCL &TOOUTQ *CHAR 10
DCL &SAVE *CHAR 5
/*‚Print the job logs first (priority 1) €*/
IF (&SPLF *EQ 'QPJOBLOG') THEN(DO)
CHGSPLFA FILE(&SPLF) JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLFNBR) +
OUTQ(&TOOUTQ) SAVE(&SAVE) OUTPTY(1)
MONMSG CPF3341 /*‚cannot change€*/
ENDDO
ELSE DO
CHGSPLFA FILE(&SPLF) JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLFNBR) +
OUTQ(&TOOUTQ) SAVE(&SAVE)
MONMSG CPF3341 /*‚cannot change€*/
ENDDO
/*‚Release the spool file €*/
RLSSPLF FILE(&SPLF) JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLFNBR)
MONMSG CPF3322 /*‚Not released€*/
ENDPGM
R WRKSPLFR
1 FILLER1 1
2 SPLF 10
12 FILLER2 1
13 USER 10
23 FILLER3 1
24 DEVICE 10
34 FILLER4 1
35 USERDATA 10
45 FILLER5 1
46 SPLFSTATUS 3
49 FILLER6 2
51 TOTPAGES 5S 0
56 FILLER7 1
57 CURPAGE 5S 0
62 FILLER8 1
63 COPY 4S 0
67 FILLER9 1
68 FORMTYPE 10
78 FILLER10 2
80 PRIORITY 1S 0
81 FILLER11 2
83 SPLFDATE 8
91 FILLER12 1
92 SPLFTIME 8
100 FILLER13 1
101 SPLFNBR 4S 0
105 FILLER14 1
106 JOB 10
116 FILLER15 1
117 JOBNBR 6S 0
123 FILLER16 1
124 OUTQ 10
125 FILLER17 1
135 LIBRARY 10
Peter Lunde
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
