Save Outq to tape command change from V4R5 to V5R2.
San
We are heading a problem of converting a old pgm that used for save an
entire outq to tape for archiving. Due to the value of QSPGETSP not
API and will no longer be reference by time, since there is solution
out there induce cost, we tend to change existing V4R5 cmd to fit new
change of QSPGETSP(V5R2) input spec. and change of QMAXSPL file no.
increase from 4 digits to 6 digits on V5R2.
That might includes intensive pgm effort and I believe expert here
might have similar cmd to save the entire outq to tape on OS/400 V5R2,
might I have your expert advise here or dump script is more helpful.
Otherwise as a new take up guy like me, I'm not confidence to follow
the 5 pages long command src as dump here for your kindly ref.
Highly appreciated for your assistant.
==================================
MEMBER . . . . . . . . . SAVOUTQP
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6
...+... 7 ...+... 8 ...+... 9 ...+... 0
100 /********************************************************************/
200 /*
*/
300 /* 5769SS1 V4R5M0 000526 RTVCLSRC Output 08/03/04
16:06:20 */
400 /*
*/
500 /* Program name . . . . . . . . . . . . . . : SAVOUTQP
PN*/
600 /* Library name . . . . . . . . . . . . . . : JFDEV
PL*/
700 /* Original source file . . . . . . . . . . : SAVOUTQSRC
SN*/
800 /* Library name . . . . . . . . . . . . . . : SAVOUTQ
SL*/
900 /* Original source member . . . . . . . . . : SAVOUTQP
SM*/
1000 /* Source file change
*/
1100 /* date/time . . . . . . . . . . . . . . : 26/01/00
14:13:59 SC*/
1200 /* Patch option . . . . . . . . . . . . . . : *NOPATCH
PO*/
1300 /* User profile . . . . . . . . . . . . . . : *OWNER
UP*/
1400 /* Text . . . : Save / clear output queue
TX*/
1500 /* Owner . . . . . . . . . . . . . . . . . : QSECOFR
OW*/
1600 /* Patch change ID . . . . . . . . . . . . : 00001
PC*/
1700 /* Patch APAR ID . . . . . . . . . . . . . : GP1
PA*/
1800 /* User mod flag . . . . . . . . . . . . . : *YES
UM*/
1900 /*
ED*/
2000 /********************************************************************/
2100 PGM PARM(&OUTQS &SAVE &DATE &XNUM &DEL &TAPE &INZTAP
&ENDOPT -
2200 &NEWVOL &SEQ)
2300 DCL VAR(&OUTQS) TYPE(*CHAR) LEN(202)
2400 DCL VAR(&TAPE) TYPE(*CHAR) LEN(10)
2500 DCL VAR(&SAVE) TYPE(*CHAR) LEN(1)
2600 DCL VAR(&DATE) TYPE(*CHAR) LEN(8)
2700 DCL VAR(&XNUM) TYPE(*CHAR) LEN(4)
2800 DCL VAR(&DEL) TYPE(*CHAR) LEN(1)
2900 DCL VAR(&INZTAP) TYPE(*CHAR) LEN(1)
3000 DCL VAR(&ENDOPT) TYPE(*CHAR) LEN(7)
3100 DCL VAR(&NEWVOL) TYPE(*CHAR) LEN(6)
3200 DCL VAR(&SEQ) TYPE(*CHAR) LEN(4)
3300 DCL VAR(&NBR) TYPE(*CHAR) LEN(6)
3400 DCL VAR(&NUMBER) TYPE(*DEC) LEN(4 0)
3500 DCL VAR(&HEXNO) TYPE(*CHAR) LEN(2)
3600 DCL VAR(&XNBR) TYPE(*CHAR) LEN(4)
3700 DCL VAR(&RDATE) TYPE(*CHAR) LEN(10)
3800 DCL VAR(&XDATE) TYPE(*CHAR) LEN(16)
3900 DCL VAR(&NUM) TYPE(*DEC) LEN(4 0) VALUE(0)
4000 DCL VAR(&QUIT) TYPE(*CHAR) LEN(1) VALUE('0')
4100 DCL VAR(&HEADEROK) TYPE(*CHAR) LEN(1) VALUE('0')
4200 DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10)
4300 DCL VAR(&LIBN) TYPE(*CHAR) LEN(10)
4400 DCL VAR(&TEMPFILE) TYPE(*CHAR) LEN(20)
4500 DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(26)
4600 DCL VAR(&POS) TYPE(*DEC) LEN(3 0)
4700 DCL VAR(&RPY) TYPE(*CHAR) LEN(10)
4800 DCL VAR(&HEX) TYPE(*CHAR) LEN(10)
VALUE(X'0102030405060708090A')
4900 DCL VAR(&LCOUNTX) TYPE(*DEC) LEN(1 0) VALUE(0)
5000 DCL VAR(&CHAR1) TYPE(*CHAR) LEN(1)
5100 DCL VAR(&MSG) TYPE(*CHAR) LEN(80)
5200 DCL VAR(&FNUM) TYPE(*DEC) LEN(2 0)
5300 DCL VAR(&FCHAR) TYPE(*CHAR) LEN(10) VALUE('JABCDEFGHI')
5769PW1 V4R4M0 990521 SEU SOURCE LISTING
11/03/04 16:34:01 PAGE 2
SOURCE FILE . . . . . . . JFTSLIB/QCLSRC
MEMBER . . . . . . . . . SAVOUTQP
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6
...+... 7 ...+... 8 ...+... 9 ...+... 0
5400 DCLF FILE(QTEMP/HEADER)
5500 DLTF FILE(QTEMP/QPRTSPLQ)
5600 MONMSG MSGID(CPF2105)
5700 DLTF FILE(QTEMP/HEADER)
5800 MONMSG MSGID(CPF2105)
5900 CRTPF FILE(QTEMP/QPRTSPLQ) RCDLEN(133) SIZE(*NOMAX)
AUT(*ALL)
6000 IF COND(&DATE = '*TODAY ') THEN(DO)
6100 RTVSYSVAL SYSVAL(QDATE) RTNVAR(&NBR)
6200 CVTDAT DATE(&NBR) TOVAR(&RDATE) TOFMT(*MDYY) TOSEP('/')
6300 ENDDO
6400 ELSE CMD(IF COND(&DATE = '*JOBDATE') THEN(DO))
6500 RTVJOBA DATE(&NBR)
6600 CVTDAT DATE(&NBR) TOVAR(&RDATE) TOFMT(*MDYY) TOSEP('/')
6700 ENDDO
6800 ELSE CMD(IF COND(&DATE = '*ALLDAY ') THEN(CHGVAR
VAR(&RDATE) -
6900 VALUE('12/31/9999')))
7000 ELSE CMD(CVTDAT DATE(&DATE) TOVAR(&RDATE) FROMFMT(*YYMD)
-
7100 TOFMT(*MDYY) TOSEP('/'))
7200 CHGVAR VAR(&XDATE) VALUE('''' || &RDATE || '''')
7300 OUT:
7400 CHGVAR VAR(&POS) VALUE(&NUM * 20 + 3)
7500 CHGVAR VAR(&OUTQ) VALUE(%SST(&OUTQS &POS 10))
7600 CHGVAR VAR(&POS) VALUE(&POS + 10)
7700 CHGVAR VAR(&LIBN) VALUE(%SST(&OUTQS &POS 10))
7800 CHGVAR VAR(&NUM) VALUE(&NUM + 1)
7900 WRKOUTQ OUTQ(&LIBN/&OUTQ) OUTPUT(*PRINT)
8000 MONMSG MSGID(CPF3357) EXEC(GOTO CMDLBL(CHKOUT))
8100 CPYSPLF FILE(QPRTSPLQ) TOFILE(QTEMP/QPRTSPLQ)
SPLNBR(*LAST) -
8200 MBROPT(*ADD)
8300 DLTSPLF FILE(QPRTSPLQ) SPLNBR(*LAST)
8400 CHKOUT: +
8500 IF COND(%SST(&OUTQS 2 1) *NE %SST(&HEX &NUM 1)) THEN(GOTO
-
8600 CMDLBL(OUT))
8700 STRQMQRY QMQRY(SELECTFILE) OUTPUT(*OUTFILE)
OUTFILE(QTEMP/HEADER-
8800 ) SETVAR((TODAY &XDATE))
8900 DLTF FILE(QTEMP/QPRTSPLQ)
9000 CHGMSGD MSGID(CPA5305) MSGF(QCPFMSG) DFT('I')
9100 IF COND(&SAVE = '0') THEN(GOTO CMDLBL(NOTSAVE))
9200 CRTLIB:
9300 CHGVAR VAR(&CHAR1) VALUE(&LCOUNTX)
9400 CHGVAR VAR(&LIBN) VALUE('SAVESPOOL' || &CHAR1)
9500 CRTLIB LIB(&LIBN) TEXT('Temp library for SAVOUTQ to store
PF') -
9600 AUT(*ALL)
9700 MONMSG MSGID(CPF2111) EXEC(DO)
9800 IF COND(&LCOUNTX = 9) THEN(DO)
9900 CHGVAR VAR(&MSG) VALUE('** Too many incomplete SAVOUTQ
process -
10000 found, job ended. Please call support')
10100 SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) MSGDTA(&MSG)
-
10200 MSGTYPE(*ESCAPE)
10300 ENDDO
10400 ELSE CMD(CHGVAR VAR(&LCOUNTX) VALUE(&LCOUNTX + 1))
10500 GOTO CMDLBL(CRTLIB)
10600 ENDDO
5769PW1 V4R4M0 990521 SEU SOURCE LISTING
11/03/04 16:34:01 PAGE 3
SOURCE FILE . . . . . . . JFTSLIB/QCLSRC
MEMBER . . . . . . . . . SAVOUTQP
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6
...+... 7 ...+... 8 ...+... 9 ...+... 0
10700 IF COND(&HEADEROK = '0') THEN(CRTDUPOBJ OBJ(HEADER) -
10800 FROMLIB(QTEMP) OBJTYPE(*FILE) TOLIB(&LIBN) DATA(*YES))
10900 CHGVAR VAR(&NUM) VALUE(&XNUM)
11000 RUN:
11100 RCVF
11200 MONMSG MSGID(CPF0864) EXEC(DO)
11300 CHGVAR VAR(&QUIT) VALUE('1')
11400 GOTO CMDLBL(SAVE)
11500 ENDDO
11600 CHGVAR VAR(&NUM) VALUE(&NUM - 1)
11700 CHGVAR VAR(&NUMBER) VALUE(&SEL6)
11800 CHGVAR VAR(&XNBR) VALUE(&NUMBER)
11900 CHGVAR VAR(&FNUM) VALUE(%SST(&SEL8 1 1))
12000 CHGVAR VAR(&FNUM) VALUE(&FNUM + 1)
12100 CHGVAR VAR(&TEMPFILE) VALUE(%SST(&FCHAR &FNUM 1) ||
%SST(&SEL8 2-
12200 5) || &XNBR || &LIBN)
12300 CHGVAR VAR(&JOBNAME) VALUE(&SEL7 || &SEL2 || &SEL8)
12400 CVTDECBIN FROMDEC(&NUMBER) TOBIN(&HEXNO) SETLR(*ON)
12500 CHGJOB INQMSGRPY(*DFT)
12600 CHGVAR VAR(&MSG) VALUE('*** Process ' || &SEL1 *TCAT ' '
|| -
12700 &SEL8 || '/' || &SEL2 *TCAT '/' || &SEL7 *TCAT ' SPLNBR(' ||
&XNBR ||-
12800 ')')
12900 SNDPGMMSG MSG(&MSG)
13000 CALL PGM(QSPGETF) PARM(&SEL1 &TEMPFILE &JOBNAME &HEXNO
&SEL1)
13100 MONMSG MSGID(CPF3344 CPF3482 CPF3342)
13200 CHGJOB INQMSGRPY(*RQD)
13300 DTL: +
13400 IF COND(&DEL = '1') THEN(DO)
13500 DEL: +
13600 DLTSPLF FILE(&SEL1) JOB(&SEL8/&SEL2/&SEL7)
SPLNBR(&NUMBER)
13700 MONMSG MSGID(CPF3330) EXEC(GOTO CMDLBL(DEL))
13800 MONMSG MSGID(CPF3342 CPF3344)
13900 ENDDO
14000 IF COND(&NUM > 0) THEN(GOTO CMDLBL(RUN))
14100 SAVE: +
14200 CHGVAR VAR(&NUMBER) VALUE(&XNUM)
14300 IF COND(&NUM = &NUMBER) THEN(DO)
14400 DLTLIB LIB(&LIBN)
14500 IF COND(&SAVE *NE '2') THEN(DO)
14600 CHGVAR VAR(&MSG) VALUE('**** No Report Needed To Save!')
14700 SNDPGMMSG MSG(&MSG)
14800 RTVJOBA JOB(&OUTQ)
14900 SNDMSG MSG(&OUTQ || &MSG) TOUSR(*SYSOPR)
15000 ENDDO
15100 CHKTAP DEV(&TAPE) ENDOPT(&ENDOPT)
15200 GOTO CMDLBL(ENDP)
15300 ENDDO
15400 RENAME: +
15500 RNMOBJ OBJ(&LIBN) OBJTYPE(*LIB) NEWOBJ(SAVESPOOL)
15600 MONMSG MSGID(CPF2111) EXEC(DO)
15700 CHGVAR VAR(&MSG) VALUE('**** Wait for another SAVOUTQ job
-
15800 complete...')
15900 SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) MSGDTA(&MSG)
-
5769PW1 V4R4M0 990521 SEU SOURCE LISTING
11/03/04 16:34:01 PAGE 4
SOURCE FILE . . . . . . . JFTSLIB/QCLSRC
MEMBER . . . . . . . . . SAVOUTQP
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6
...+... 7 ...+... 8 ...+... 9 ...+... 0
16000 TOPGMQ(*EXT) MSGTYPE(*STATUS)
16100 SNDPGMMSG MSG(&MSG)
16200 DLYJOB DLY(300)
16300 GOTO CMDLBL(RENAME)
16400 ENDDO
16500 ASK: +
16600 IF COND(&HEADEROK = '0') THEN(DO)
16700 IF COND(&TAPE = ' ') THEN(DO)
16800 CHGVAR VAR(&MSG) VALUE('Mount SAVOUTQ tape and enter TAPE
drive -
16900 name, or C to cancel')
17000 SNDUSRMSG MSG(&MSG) MSGRPY(&TAPE)
17100 IF COND(&TAPE = 'C') THEN(GOTO CMDLBL(END))
17200 ENDDO
17300 CHGVAR VAR(&MSG) VALUE('Tape drive for SAVOUTQ is ' ||
&TAPE -
17400 *TCAT ' (G C)')
17500 SNDUSRMSG MSG(&MSG) VALUES(G C) DFT(G) MSGRPY(&RPY)
17600 IF COND(&RPY = 'C') THEN(GOTO CMDLBL(XXX))
17700 ELSE CMD(DO)
17800 CHKTAP DEV(&TAPE) ENDOPT(*REWIND)
17900 MONMSG MSGID(CPF9814 CPF6760) EXEC(DO)
18000 XXX: +
18100 CHGVAR VAR(&TAPE) VALUE(' ')
18200 GOTO CMDLBL(ASK)
18300 ENDDO
18400 ENDDO
18500 IF COND(&INZTAP = '1') THEN(INZTAP DEV(&TAPE)
NEWVOL(&NEWVOL) -
18600 CHECK(*NO) ENDOPT(*REWIND))
18700 SAVOBJ OBJ(HEADER) LIB(SAVESPOOL) DEV(&TAPE) SEQNBR(&SEQ)
-
18800 ENDOPT(*LEAVE) CLEAR(*ALL) DTACPR(*YES) COMPACT(*DEV)
18900 CHGVAR VAR(&HEADEROK) VALUE('1')
19000 DLTF FILE(SAVESPOOL/HEADER)
19100 ENDDO
19200 SAVOBJ OBJ(*ALL) LIB(SAVESPOOL) DEV(&TAPE) ENDOPT(*LEAVE)
-
19300 ACCPTH(*YES) DTACPR(*YES) COMPACT(*DEV)
19400 MONMSG MSGID(CPF3770)
19500 CHGVAR VAR(&SAVE) VALUE('2')
19600 IF COND(&QUIT = '1') THEN(DO)
19700 CHKTAP DEV(&TAPE) ENDOPT(&ENDOPT)
19800 MONMSG MSGID(CPF6768)
19900 DLTLIB LIB(SAVESPOOL)
20000 GOTO CMDLBL(END)
20100 ENDDO
20200 DLTLIB LIB(SAVESPOOL)
20300 GOTO CMDLBL(CRTLIB)
20400 NOTSAVE:
20500 RCVF
20600 MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(ENDP))
20700 CHGVAR VAR(&NUMBER) VALUE(&SEL6)
20800 IF COND(&DEL = '1') THEN(DO)
20900 DLTSPLF FILE(&SEL1) JOB(&SEL8/&SEL2/&SEL7)
SPLNBR(&NUMBER)
21000 MONMSG MSGID(CPF3330 CPF3342 CPF3344)
21100 ENDDO
21200 GOTO CMDLBL(NOTSAVE)
5769PW1 V4R4M0 990521 SEU SOURCE LISTING
11/03/04 16:34:01 PAGE 5
SOURCE FILE . . . . . . . JFTSLIB/QCLSRC
MEMBER . . . . . . . . . SAVOUTQP
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6
...+... 7 ...+... 8 ...+... 9 ...+... 0
21300 END:
21400 DLTLIB LIB(SAVESPOOL)
21500 MONMSG MSGID(CPF2110)
21600 ENDP:
21700 DLTF FILE(QTEMP/HEADER)
21800 ENDPGM
* * * * E N D O F S O U R C E *
* * *
==============================================