|
midrange.com
--
>Carel
>Seeing that you offered :o) this is the right place to describe your DUPSPLF
>command and how you constructed it.
>
>I am interested.
>
>Thanks,
>
>Norm,
Her is the code. herman Krebbs already supplied the code for the CDO of
QSPPUTF and QSPGETF utilities. The command works as he describes but with
the possibility to copy to maximum 10 outqueues and changing the USRDTa
parameter.
First the CDO:
CMD PROMPT('Copy spool-file extra')
PARM KWD(FILE) TYPE(*NAME) MIN(1) +
PROMPT('Spool-file')
PARM KWD(TOOUTQ) TYPE(ELEM1) MIN(1) MAX(10) +
PROMPT('Output to')
ELEM1: ELEM TYPE(Q1) PROMPT('Target Output Queue(s)')
ELEM TYPE(*CHAR) LEN(10) DFT(*SAME) PROMPT('User +
data')
Q1: QUAL TYPE(*NAME)
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +
(*CURLIB)) PROMPT('Library')
PARM KWD(JOB) TYPE(Q2) DFT(*) SNGVAL((*)) +
PROMPT('Name job')
Q2: QUAL TYPE(*NAME)
QUAL TYPE(*NAME) PROMPT('User')
QUAL TYPE(*CHAR) LEN(6) PROMPT('Number')
PARM KWD(SPLNBR) TYPE(*DEC) LEN(4 0) DFT(*ONLY) +
SPCVAL((*ONLY 0) (*LAST -1)) +
CHOICE('1-9999, *ONLY,
*LAST') +
PROMPT('Number spool-file')
The source for the CPP - a CL programme:
PGM PARM(&FILE &TOOUTQ &QJOB &SPLNBR)
INPUT: DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&TOOUTQ) TYPE(*CHAR) LEN(342)
DCL VAR(&QJOB) TYPE(*CHAR) LEN(26)
DCL VAR(&SPLNBR) TYPE(*DEC) LEN(4 0)
JOB: DCL VAR(&QTOOUTQ) TYPE(*CHAR) LEN(30)
DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&USRDATA) TYPE(*CHAR) LEN(10)
DCL VAR(&COUNT) TYPE(*DEC) LEN(5 0)
DCL VAR(&POS) TYPE(*DEC) LEN(3 0) /* Position of +
list in list */
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
DCL VAR(&SPL#) TYPE(*CHAR) LEN(5)
DCL VAR(&OFFSET) TYPE(*DEC) LEN(3 0) VALUE(1)
OOPS: DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(200)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
INIT: IF COND(&QJOB *EQ '*') THEN(DO)
RTVJOBA JOB(&JOBNAME) USER(&USER) NBR(&JOBNBR)
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&JOBNAME) VALUE(%SST(&QJOB 1 10))
CHGVAR VAR(&USER) VALUE(%SST(&QJOB 11 10))
CHGVAR VAR(&JOBNBR) VALUE(%SST(&QJOB 21 6))
ENDDO
IF COND(&SPLNBR = -1) THEN(DO)
CHGVAR VAR(&SPL#) VALUE('*LAST')
ENDDO
IF COND(&SPLNBR = 0) THEN(DO)
CHGVAR VAR(&SPL#) VALUE('*ONLY')
ENDDO
IF COND(&SPLNBR > 0) THEN(DO)
CHGVAR VAR(&SPL#) VALUE(&SPLNBR)
ENDDO
CHKOBJ OBJ(QTEMP/SPOOLPF) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(DO)
CRTPF FILE(QTEMP/SPOOLPF) RCDLEN(4083) +
TEXT('Created by DUPSPLF')
MAXMBRS(*NOMAX)
ENDDO
CLRPFM FILE(QTEMP/SPOOLPF)
GETSPLF FILE(&FILE) TOFILE(QTEMP/SPOOLPF) +
JOB(&JOBNBR/&USER/&JOBNAME) SPLNBR(&SPL#)
CHGVAR VAR(&COUNT) VALUE(%BIN(&TOOUTQ 1 2))
LOOP: IF COND(&COUNT *GT 0) THEN(DO)
/* DETERMING STARTPOSITION OF A LIST */
CHGVAR VAR(&OFFSET) VALUE(&OFFSET + 2)
CHGVAR VAR(&POS) VALUE(%BINARY(&TOOUTQ &OFFSET 2))
CHGVAR VAR(&POS) VALUE(&POS + 3)
CHGVAR VAR(&QTOOUTQ) VALUE(%SST(&TOOUTQ &POS 30))
CHGVAR VAR(&OUTQ) VALUE(%SST(&QTOOUTQ 1 10))
CHGVAR VAR(&LIB) VALUE(%SST(&QTOOUTQ 11 10))
CHGVAR VAR(&USRDATA) VALUE(%SST(&QTOOUTQ 21 10))
IF COND(&USRDATA *NE '*SAME') THEN(DO)
HLDOUTQ OUTQ(&LIB/&OUTQ)
ENDDO
PUTSPLF FROMFILE(QTEMP/SPOOLPF) OUTQ(&LIB/&OUTQ)
IF COND(&USRDATA *NE '*SAME') THEN(DO)
CHGSPLFA FILE(&FILE)
JOB(&JOBNBR/&USER/&JOBNAME) +
SPLNBR(*LAST) USRDTA(&USRDATA)
RLSOUTQ OUTQ(&LIB/&OUTQ)
ENDDO
CHGVAR VAR(&COUNT) VALUE(&COUNT - 1)
GOTO CMDLBL(LOOP)
ENDDO
RETURN
ERROR: RCVMSG MSGTYPE(*EXCP) RMV(*NO) KEYVAR(&KEYVAR) +
MSGDTA(&MSGDTA)
MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA)
TOPGMQ(*PRV) +
MSGTYPE(*ESCAPE)
KEYVAR(&KEYVAR)
MONMSG MSGID(CPF0000)
ENDPGM
I hope the code explain itself.
Regards,
Carel Teijgeler
--
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
