A demonstration spool to web page
Program . . . . . . . . . . . . . . . . . . . : DBG186CL
Library . . . . . . . . . . . . . . . . . . : DBG400NS
Source file . . . . . . . . . . . . . . . . . : QCLSRC
Library . . . . . . . . . . . . . . . . . . : DBG400
Source member name . . . . . . . . . . . . . : DBG186CL 09/09/00 03:58:38
Source printing options . . . . . . . . . . . : *SOURCE *XREF *GEN *NOSECLVL *NOSRCDBG
Program generation options . . . . . . . . . : *NOLIST *NOXREF *NOPATCH
User profile . . . . . . . . . . . . . . . . : *USER
Program logging . . . . . . . . . . . . . . . : *JOB
Allow RTVCLSRC command . . . . . . . . . . . : *YES
Replace program . . . . . . . . . . . . . . . : *YES
Target release . . . . . . . . . . . . . . . : V4R4M0
Authority . . . . . . . . . . . . . . . . . . : *LIBCRTAUT
Sort sequence . . . . . . . . . . . . . . . . : *HEX
Language identifier . . . . . . . . . . . . . : *JOBRUN
Text . . . . . . . . . . . . . . . . . . . . : Work with user output queue
Compiler . . . . . . . . . . . . . . . . . . : IBM AS/400 Control Language Compiler
Control Language Source
SEQNBR *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+. DATE
100- /* ************************************************************************** */
200- /* DBG186CL: WRKUSROUTQ CPP - Work with User Outque */
300- /* Copyright (C) 2000 Martin Rowe */
400- /* */
500- /* This program is free software; you can redistribute it and/or modify */
600- /* it under the terms of the GNU General Public License as published by */
700- /* the Free Software Foundation; either version 2 of the License, or */
800- /* (at your option) any later version. */
900- /* */
1000- /* This program is distributed in the hope that it will be useful, */
1100- /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
1200- /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
1300- /* GNU General Public License for more details. */
1400- /* */
1500- /* You should have received a copy of the GNU General Public License */
1600- /* along with this program; if not, write to the Free Software */
1700- /* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */
1800- /* ************************************************************************** */
1900- PGM PARM(&QUALOUTQ &OVRUSER)
2000- DCL VAR(&EMPTY) TYPE(*CHAR) LEN(10) VALUE(' ')
2100- DCL VAR(&LIBRARY) TYPE(*CHAR) LEN(10)
2200- DCL VAR(&LMTCPB) TYPE(*CHAR) LEN(10)
2300- DCL VAR(&MBROPT) TYPE(*CHAR) LEN(8)
2400- DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10)
2500- DCL VAR(&OVRUSER) TYPE(*CHAR) LEN(10)
2600- DCL VAR(&OUTQLIST) TYPE(*CHAR) LEN(275)
2700- DCL VAR(&OUTQNAME) TYPE(*CHAR) LEN(10)
2800- DCL VAR(&QUALOUTQ) TYPE(*CHAR) LEN(20)
2900- DCL VAR(&QUALOUTQ2) TYPE(*CHAR) LEN(20)
3000- DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10)
3100- DCL VAR(&STARTPOS) TYPE(*DEC) LEN(3 0) VALUE(1)
3200- DCL VAR(&USER) TYPE(*CHAR) LEN(10)
5769SS1 V4R4M0 990521 Control Language DBG400NS/DBG186CL 09/09/00 14:25:46 Page 2
Control Language Source
SEQNBR *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+. DATE
3300- DCLF FILE(DBGUOL00) RCDFMT(PFUOL)
QUALIFIED FILE NAME - DBG400NS/DBGUOL00
RECORD FORMAT NAME - PFUOL USER *OUTQ LIST
CL VARIABLE TYPE LENGTH PRECISION TEXT
&ULUSER *CHAR 10 USER
&ULOUTQ *CHAR 10 *OUTQ NAME
&ULOUTL *CHAR 10 *OUTQ LIBRARY
3400- /* ************************************************************************** */
3500- /* GLOBAL MESSAGE MONITOR */
3600- /* ************************************************************************** */
3700- MONMSG MSGID(CPF0000 RPG0000 QRG0000 RSF0000 +
3800 MCH0000) EXEC(GOTO CMDLBL(##ERROR))
3900- GOTO CMDLBL(##NOERROR)
4000- ##ERROR:
4100- /* MOVDIAGMSG (c) Tom Liotta http://zap.to/tl400 Used with permission */
4200- MOVDIAGMSG
4300- MONMSG MSGID(CPF0000)
4400- /* RSNESCMSG (c) Tom Liotta http://zap.to/tl400 Used with permission */
4500- RSNESCMSG
4600- MONMSG MSGID(CPF0000)
4700- RETURN
4800- ##NOERROR:
4900- /* ************************************************************************** */
5000- /* START OF MAINLINE CODE */
5100- /* ************************************************************************** */
5200- /* Parse command parameter */
5300- CHGVAR VAR(&OUTQ) VALUE(%SST(&QUALOUTQ 1 10))
5400- CHGVAR VAR(&LIBRARY) VALUE(%SST(&QUALOUTQ 11 10))
5500- /* Set CPYSPLF option initially so existing data is flushed first */
5600- CHGVAR VAR(&MBROPT) VALUE('*REPLACE')
5700- /* Get user level (determines if F21=Cmd & swapping *OUTQs enabled */
5800- RTVUSRPRF LMTCPB(&LMTCPB)
5900- RTVJOBA USER(&USER)
6000- /* Drag in user's default *OUTQ if required */
6100- IF (&OUTQ *EQ '*JOB') THEN(DO)
6200- RTVJOBA OUTQ(&OUTQ) OUTQLIB(&LIBRARY)
6300- CHGVAR VAR(%SST(&QUALOUTQ 1 10)) VALUE(&OUTQ)
6400- CHGVAR VAR(%SST(&QUALOUTQ 11 10)) VALUE(&LIBRARY)
6500- ENDDO
6600- /* First time through? Create required runtime objects in QTEMP */
6700- /* DBG1860W holds the data from the QUSLSPL API */
6800- CHKOBJ OBJ(QTEMP/DBG1860W) OBJTYPE(*FILE)
6900- MONMSG MSGID(CPF9801) EXEC(DO)
7000- RTVOBJD OBJ(DBG1860W) OBJTYPE(*FILE) RTNLIB(&RTNLIB)
7100- CRTDUPOBJ OBJ(DBG1860W) FROMLIB(&RTNLIB) +
7200 OBJTYPE(*FILE) TOLIB(QTEMP)
7300- ENDDO
7400- OVRDBF FILE(DBG1860W) TOFILE(QTEMP/DBG1860W)
7500- /* DBG1871W holds the output from the CPYSPLF command */
5769SS1 V4R4M0 990521 Control Language DBG400NS/DBG186CL 09/09/00 14:25:46 Page 3
Control Language Source
SEQNBR *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+. DATE
7600- CHKOBJ OBJ(QTEMP/DBG1871W) OBJTYPE(*FILE)
7700- MONMSG MSGID(CPF9801) EXEC(DO)
7800- CRTPF FILE(QTEMP/DBG1871W) RCDLEN(259) +
7900 SIZE(500000 10000)
8000- ENDDO
8100- /* DBG1872W holds the formatted data after processing DBG1871W */
8200- CHKOBJ OBJ(QTEMP/DBG1872W) OBJTYPE(*FILE)
8300- MONMSG MSGID(CPF9801) EXEC(DO)
8400- CRTPF FILE(QTEMP/DBG1872W) RCDLEN(255) +
8500 SIZE(500000 10000)
8600- ENDDO
8700- /* QTEMP/FTPSRC Holds the batch FTP instructions */
8800- CHKOBJ OBJ(QTEMP/FTPSRC) OBJTYPE(*FILE)
8900- MONMSG MSGID(CPF9801) EXEC(DO)
9000- CRTSRCPF FILE(QTEMP/FTPSRC) RCDLEN(132)
9100- ADDPFM FILE(QTEMP/FTPSRC) MBR(FTPIN)
9200- ADDPFM FILE(QTEMP/FTPSRC) MBR(FTPOUT)
9300- ENDDO
9400- /* If dealing with user's spool files only */
9500- IF COND(&OUTQ *EQ '*USRSPLF') THEN(DO)
9600- /* If no overriding profile specified, use current */
9700- IF COND(&OVRUSER *EQ '*CURRENT') THEN(CHGVAR +
9800 VAR(&OVRUSER) VALUE(&USER))
9900- /* Build file from selected user's spool files */
10000- CALL PGM(DBG188R4) PARM(&OVRUSER '*ALL' &MBROPT)
10100- GOTO CMDLBL(WRKUSROUTQ)
10200- ENDDO
10300- /* If dealing with multiple *OUTQs */
10400- IF COND(&OUTQ *EQ '*OUTQLIST') THEN(DO)
10500- OVRDBF FILE(DBGUOL00) POSITION(*KEYAE 1 PFUOL &USER)
10600- /* Loop through the 25 *OUTQ slots in the data area */
10700- TOPOFLOOP:
10800- RCVF RCDFMT(PFUOL)
10900- MONMSG MSGID(CPF0864 CPF4137) EXEC(GOTO +
11000 CMDLBL(WRKUSROUTQ))
11100- /* Quit when all user's records read */
11200- IF COND(&ULUSER *NE &USER) THEN(GOTO +
11300 CMDLBL(WRKUSROUTQ))
11400- /* Load outfile with spoolfile lists of the *OUTQ in the current slot */
11500- CHGVAR VAR(&QUALOUTQ2) VALUE(&ULOUTQ || &ULOUTL)
11600- CALL PGM(DBG188R4) PARM('*ALL' &QUALOUTQ2 &MBROPT)
11700- NEXTOUTQ:
11800- CHGVAR VAR(&MBROPT) VALUE('*ADD')
11900- GOTO CMDLBL(TOPOFLOOP)
12000- ENDDO
12100- /* Load outfile with the spoolfile in the single *OUTQ requested */
12200- ONEOUTQ:
12300- CHGVAR VAR(&QUALOUTQ2) VALUE(&OUTQ || &LIBRARY)
12400- CALL PGM(DBG188R4) PARM('*ALL' &QUALOUTQ2 &MBROPT)
12500- /* Bring up the screen display */
12600- WRKUSROUTQ:
12700- DLTOVR FILE(DBGUOL00)
12800- MONMSG MSGID(CPF9841)
5769SS1 V4R4M0 990521 Control Language DBG400NS/DBG186CL 09/09/00 14:25:46 Page 4
Control Language Source
SEQNBR *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+. DATE
12900- CALL PGM(DBG186R4) PARM(&QUALOUTQ &LMTCPB &OVRUSER)
13000- DLTOVR FILE(DBG1860W)
13100- RETURN
13200- ENDPGM
* * * * * E N D O F S O U R C E * * * * *
5769SS1 V4R4M0 990521 Control Language DBG400NS/DBG186CL 09/09/00 14:25:46 Page 5
Cross Reference
Declared Variables
Name Defined Type Length References
&EMPTY 2000 *CHAR 10
* CPD0726 10 Variable '&EMPTY ' declared but not referred to.
&LIBRARY 2100 *CHAR 10 5400 6200 6400 12300
&LMTCPB 2200 *CHAR 10 5800 12900
&MBROPT 2300 *CHAR 8 5600 10000 11600 11800 12400
&OUTQ 2400 *CHAR 10 5300 6100 6200 6300 9500 10400 12300
&OUTQLIST 2600 *CHAR 275
* CPD0726 10 Variable '&OUTQLIST ' declared but not referred to.
&OUTQNAME 2700 *CHAR 10
* CPD0726 10 Variable '&OUTQNAME ' declared but not referred to.
&OVRUSER 2500 *CHAR 10 1900 9700 9700 10000 12900
&QUALOUTQ 2800 *CHAR 20 1900 5300 5400 6300 6400 12900
&QUALOUTQ2 2900 *CHAR 20 11500 11600 12300 12400
&RTNLIB 3000 *CHAR 10 7000 7100
&STARTPOS 3100 *DEC 3 0
* CPD0726 10 Variable '&STARTPOS ' declared but not referred to.
&ULOUTL 3300 *CHAR 10 10800 11500
&ULOUTQ 3300 *CHAR 10 10800 11500
&ULUSER 3300 *CHAR 10 10800 11200
&USER 3200 *CHAR 10 5900 9700 10500 11200
Defined Labels
Label Defined References
##ERROR 4000 3700
##NOERROR 4800 3900
NEXTOUTQ 11700
ONEOUTQ 12200
TOPOFLOOP 10700 11900
WRKUSROUTQ 12600 10100 10900 11200
* * * * * E N D O F C R O S S R E F E R E N C E * * * * *
5769SS1 V4R4M0 990521 Control Language DBG400NS/DBG186CL 09/09/00 14:25:46 Page 6
Message Summary
Severity
Total 0-9 10-19 20-29 30-39 40-49 50-59 60-69 70-79 80-89 90-99
4 0 4 0 0 0 0 0 0 0 0
Program DBG186CL created in library DBG400NS on 09/09/00 at 14:25:50.
Program DBG186CL created in library DBG400NS. Maximum error severity 10.
* * * * * E N D O F M E S S A G E S U M M A R Y * * * * *
* * * * * E N D O F C O M P I L A T I O N * * * * *