440 pts.
 DLTOLDSPLF
Hi friends, it's me again !! I have Two CL's below First: 100- PGM PARM(&DIAS) 10/06/08 200- 10/06/08 300- DCLF FILE(DLTOLDSPLF) 10/06/08 QUALIFIED FILE NAME - RBORGES/DLTOLDSPLF RECORD FORMAT NAME - DLTOLDSPLF CL VARIABLE TYPE LENGTH PRECISION TEXT &SPLFNAM *CHAR 10 SUBSTR(WRKSPLF,2,10) &USRNAM *CHAR 10 SUBSTR(WRKSPLF,13,10) &PRTDEV *CHAR 10 SUBSTR(WRKSPLF,24,10) &USRDTA *CHAR 10 SUBSTR(WRKSPLF,35,10) &STATUS *CHAR 3 SUBSTR(WRKSPLF,46,3) &TOTPAG *CHAR 5 SUBSTR(WRKSPLF,51,5) &SPLDAT *CHAR 6 SUBSTR(WRKSPLF,89,2)|| SUBSTR(WRKSPLF,86 &SPLTIM *CHAR 8 SUBSTR(WRKSPLF,92,8) &SPLNBR *CHAR 5 SUBSTR(WRKSPLF,102,5) &JOBNAM *CHAR 10 SUBSTR(WRKSPLF,108,10) &JOBNBR *CHAR 6 SUBSTR(WRKSPLF,119,6) &QNAM *CHAR 10 SUBSTR(WRKSPLF,126,10) &QLIB *CHAR 10 SUBSTR(WRKSPLF,137,10) 400- DCL VAR(&DIAS) TYPE(*DEC) LEN(3 0) 10/06/08 500- DCL VAR(&DIF) TYPE(*DEC) LEN(5 0) 10/06/08 600- DCL VAR(&DIFX) TYPE(*CHAR) LEN(5) 10/06/08 700- DCL VAR(&SYSDATE) TYPE(*CHAR) LEN(6) 10/06/08 800- DCL VAR(&CTDLT) TYPE(*DEC) LEN(5 0) 10/06/08 900- DCL VAR(&SPLNBRAUX) TYPE(*DEC) LEN(5 0) 10/06/08 1000- DCL VAR(&CTDLTX) TYPE(*CHAR) LEN(5) 10/06/08 1100- WRKSPLF SELECT(*ALL) OUTPUT(*PRINT) 10/06/08 1200- CRTPF FILE(QTEMP/WRKSPLF) RCDLEN(170) SIZE(*NOMAX) 10/06/08 1300- MONMSG MSGID(CPF7302) 10/06/08 1400- CPYSPLF FILE(QPRTSPLF) TOFILE(QTEMP/WRKSPLF) + 10/06/08 1500 SPLNBR(*LAST) 10/06/08 1600- RUNQRY QRY(DLTOLDSPLF) 10/06/08 1700- 10/06/08 1800- RTVSYSVAL SYSVAL(QDATE) RTNVAR(&SYSDATE) 10/06/08 1900- CVTDAT DATE(&SYSDATE) TOVAR(&SYSDATE) TOFMT(*YMD) + 10/06/08 2000 TOSEP(*NONE) 10/06/08 2100- LER: RCVF 10/06/08 2200- MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(FIM)) 10/06/08 2300- CALL PGM(DIFDATA) PARM(&SYSDATE &SPLDAT &DIF) 10/06/08 2400- IF COND(&DIF *LE &DIAS) THEN(GOTO CMDLBL(LER)) 10/06/08 2500- CHGVAR VAR(&SPLNBRAUX) VALUE(&SPLNBR) 10/06/08 2600- CHGVAR VAR(&DIFX) VALUE(&DIF) 10/06/08 2700- DLTSPLF FILE(&SPLFNAM) JOB(&JOBNBR/&USRNAM/&JOBNAM) + 10/06/08 2800 SPLNBR(&SPLNBRAUX) 10/06/08 2900- MONMSG MSGID(CPF0000) 10/06/08 3000- SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + 10/06/08 3100 MSGDTA('(''HI)') MSGTYPE(*STATUS) 10/06/08 3200- CHGVAR VAR(&CTDLT) VALUE(&CTDLT + 1) 10/06/08 3300- GOTO CMDLBL(LER) 10/06/08 3400- 10/06/08 3500- ERROR: DMPCLPGM 10/06/08 3600- SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('ERRO NO + 10/06/08 3700 PROGRAMA. VERIFIQUE O JOBLOG') + 10/06/08 3800 MSGTYPE(*ESCAPE) 10/06/08 3900- RETURN 10/06/08 4000- 10/06/08 4100- FIM: CHGVAR VAR(&CTDLTX) VALUE(&CTDLT) 10/06/08 4200- SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&CTDLTX + 10/06/08 4300 *BCAT 'SPOOLFILES DELETADOS') MSGTYPE(*COMP) 10/06/08 4400- ENDPGM 10/06/08 * * * * * E N D O F S O U R C E * * * * * Second: 100- PGM PARM(&DATA1 &DATA2 &DIF) /* CALCULA + 10/06/08 200 DIFERENÇA ENTRE DATAS YYMMDD */ 10/06/08 300- DCL VAR(&DATA1) TYPE(*CHAR) LEN(6) 10/06/08 400- DCL VAR(&DATA2) TYPE(*CHAR) LEN(6) 10/06/08 500- DCL VAR(&DATA1J) TYPE(*CHAR) LEN(5) 10/06/08 600- DCL VAR(&DATA2J) TYPE(*CHAR) LEN(5) 10/06/08 700- DCL VAR(&DIF) TYPE(*DEC) LEN(5 0) 10/06/08 800- DCL VAR(&DIFDIA) TYPE(*DEC) LEN(5 0) 10/06/08 900- DCL VAR(&DIFANO) TYPE(*DEC) LEN(5 0) 10/06/08 1000- DCL VAR(&ANO1) TYPE(*DEC) LEN(4 0) 10/06/08 1100- DCL VAR(&DIA1) TYPE(*DEC) LEN(3 0) 10/06/08 1200- DCL VAR(&ANO2) TYPE(*DEC) LEN(4 0) 10/06/08 1300- DCL VAR(&DIA2) TYPE(*DEC) LEN(3 0) 10/06/08 1400- 10/06/08 1500- CVTDAT DATE(&DATA1) TOVAR(&DATA1J) FROMFMT(*YMD) + 10/06/08 1600 TOFMT(*JUL) TOSEP(*NONE) 10/06/08 1700- CVTDAT DATE(&DATA2) TOVAR(&DATA2J) FROMFMT(*YMD) + 10/06/08 1800 TOFMT(*JUL) TOSEP(*NONE) 10/06/08 1900- CHGVAR VAR(&ANO1) VALUE(%SST(&DATA1J 1 2)) 10/06/08 2000- CHGVAR VAR(&ANO2) VALUE(%SST(&DATA2J 1 2)) 10/06/08 2100- CHGVAR VAR(&DIA1) VALUE(%SST(&DATA1J 3 3)) 10/06/08 2200- CHGVAR VAR(&DIA2) VALUE(%SST(&DATA2J 3 3)) 10/06/08 2300- 10/06/08 2400- IF COND(%SST(&DATA1 1 1) *GE '8') THEN(CHGVAR + 10/06/08 2500 VAR(&ANO1) VALUE(&ANO1 + 1900)) 10/06/08 2600- ELSE CMD(CHGVAR VAR(&ANO1) VALUE(&ANO1 + 2000)) 10/06/08 2700- IF COND(%SST(&DATA2 1 1) *GE '8') THEN(CHGVAR + 10/06/08 2800 VAR(&ANO2) VALUE(&ANO2 + 1900)) 10/06/08 2900- ELSE CMD(CHGVAR VAR(&ANO2) VALUE(&ANO2 + 2000)) 10/06/08 3000- 10/06/08 3100- CHGVAR VAR(&DIFDIA) VALUE(&DIA1 - &DIA2) 10/06/08 3200- CHGVAR VAR(&DIFANO) VALUE(&ANO1 - &ANO2) 10/06/08 3300- IF COND(&DIFDIA *LT 0) THEN(DO) 10/06/08 3400- CHGVAR VAR(&DIFANO) VALUE(&DIFANO - 1) 10/06/08 3500- CHGVAR VAR(&DIFDIA) VALUE(&DIFDIA + 365) 10/06/08 3600- ENDDO 10/06/08 3700- CHGVAR VAR(&DIF) VALUE((&DIFANO * 365) + &DIFDIA) 10/06/08 3800- 10/06/08 3900- ENDPGM 10/06/08 The question is, Why occurs this error: DECIMAL DATA ERROR 4>> DLTOLDSPLF RETAINDAYS(99) 1100 - WRKSPLF SELECT(*ALL) OUTPUT(*PRINT) 1200 - CRTPF FILE(QTEMP/WRKSPLF) RCDLEN(170) SIZE(*NOMAX) File WRKSPLF created in library QTEMP. Member WRKSPLF added to file WRKSPLF in QTEMP. 1400 - CPYSPLF FILE(QPRTSPLF) TOFILE(QTEMP/WRKSPLF) SPLNBR(*LAST) 798 records copied to file WRKSPLF in QTEMP. 1600 - RUNQRY QRY(DLTOLDSPLF) File DLTOLDSPLF in RBORGES was replaced. 1800 - RTVSYSVAL SYSVAL(QDATE) RTNVAR(&SYSDATE) 1900 - CVTDAT DATE('100608') TOVAR(&SYSDATE) TOFMT(*YMD) TOSEP(*NONE) 2100 - RCVF DEV(*FILE) RCDFMT(*FILE) WAIT(*YES) OPNID(*NONE) /* File name is DLTOLDSPLF. */ 2300 - CALL PGM(DIFDATA) /* The CALL command contains parameters */ 1500 - CVTDAT DATE('080610') TOVAR(&DATA1J) FROMFMT(*YMD) TOFMT(*JUL) TOSEP(*NONE) 1700 - CVTDAT DATE('080116') TOVAR(&DATA2J) FROMFMT(*YMD) TOFMT(*JUL) TOSEP(*NONE) - RETURN /* RETURN due to end of CL program */ Decimal data error. Function check. MCH1202 unmonitored by DLTOLDSPLF at statement 2400, instruction X'0041'. MCH1202 received by DLTOLDSPLF at 2400. (C D I R) MCH1202 received by DLTOLDSPLF at 2400. (C D I R)

Software/Hardware used:
ASKED: June 11, 2008  12:37 AM
UPDATED: June 27, 2008  11:53 PM

Answer Wiki:
Hi Silvarb, I suggest you take an option D to get a dump of the variables in your CL program, then you can see what you have in &DATA1 and &ANO1 Regards, Martin Gilbert. Thanks Martin. See below the DUMP 5722SS1 V5R3M0 040528 CL Program Dump TDBSBC25 11/06/08 14:55:50 Page 1 Job name . . . . . . . . : QPADEV001K User name . . . . . . . . : RBDSILVA Job number . . . . . . . : 624292 Program name . . . . . . : DLTOLDSPLF Library . . . . . . . . . : RBORGES Statement . . . . . . . . : 2400 Messages Message Message From To Time ID Sev Type Text Program Inst Program Inst 145517 00 CMD 1100 - WRKSPLF SELECT QCADRV 0393 DLTOLDSPLF 000E (*ALL) OUTPUT(*PRINT) 145532 00 CMD 1200 - CRTPF FILE(QTE QCADRV 0393 DLTOLDSPLF 0013 MP/WRKSPLF) RCDLEN(170) SIZE(*NOMAX) 145533 CPC7301 00 COMP File WRKSPLF created in QDDCPF 055E DLTOLDSPLF 0013 library QTEMP. 145533 CPC7305 00 COMP Member WRKSPLF added to QDDCPFM 005B DLTOLDSPLF 0013 file WRKSPLF in QTEMP. 145533 00 CMD 1400 - CPYSPLF FILE(Q QCADRV 0393 DLTOLDSPLF 001A PRTSPLF) TOFILE(QTEMP/W RKSPLF) SPLNBR(*LAST) 145533 CPF3485 00 COMP 673 records copied to f QSPCPYF 0747 DLTOLDSPLF 001A ile WRKSPLF in QTEMP. 145533 00 CMD 1600 - RUNQRY QRY(DLT QCADRV 0393 DLTOLDSPLF 001E OLDSPLF) 145535 QRY5062 10 INFO File DLTOLDSPLF in RBOR QQUDA 0A64 DLTOLDSPLF 001E GES was replaced. 145535 00 CMD 1800 - RTVSYSVAL SYSV QCADRV 0393 DLTOLDSPLF 0024 AL(QDATE) RTNVAR(&SYSDA TE) 145535 00 CMD 1900 - CVTDAT DATE('1 QCADRV 0393 DLTOLDSPLF 002C 10608') TOVAR(&SYSDATE) TOFMT(*YMD) TOSEP(*NON E) 145535 00 CMD 2100 - RCVF DEV(*FILE QCLDMIO 026A DLTOLDSPLF 0034 ) RCDFMT(*FILE) WAIT(*Y ES) OPNID(*NONE) /* File name is DLTO LDSPLF. */ 145535 00 CMD 2300 - CALL PGM(DIFDA QCLCLCPR 045C DLTOLDSPLF 003F TA) /* The CAL L command contains para meters */ 145536 MCH1202 40 ESC Decimal data error. DLTOLDSPLF 0041 DLTOLDSPLF 0041 145536 CPF9999 40 ESC Function check. MCH1202 QMHUNMSG 0000 DLTOLDSPLF 0041 unmonitored by DLTOLDS PLF at statement 2400, instruction X'0041'. Variables Variable Type Length Value Value in Hexadecimal *...+....1....+....2....+ * . . . + . . . . 1 . . . . + . . . . 2 . . . . + &CTDLT *DEC 5 0 0 &CTDLTX *CHAR 5 ' ' 4040404040 &DIAS *DEC 3 0 '99' F9F9 5722SS1 V5R3M0 040528 CL Program Dump TDBSBC25 11/06/08 14:55:50 Page 2 Job name . . . . . . . . : QPADEV001K User name . . . . . . . . : RBDSILVA Job number . . . . . . . : 624292 Program name . . . . . . : DLTOLDSPLF Library . . . . . . . . . : RBORGES Statement . . . . . . . . : 2400 Variables Variable Type Length Value Value in Hexadecimal *...+....1....+....2....+ * . . . + . . . . 1 . . . . + . . . . 2 . . . . + &DIF *DEC 5 0 147 &DIFX *CHAR 5 ' ' 4040404040 &JOBNAM *CHAR 10 'QPADEV000V' D8D7C1C4C5E5F0F0F0E5 &JOBNBR *CHAR 6 '600861' F6F0F0F8F6F1 &PRTDEV *CHAR 10 'QPRINT ' D8D7D9C9D5E340404040 &QLIB *CHAR 10 'QGPL ' D8C7D7D3404040404040 &QNAM *CHAR 10 'QPRINT ' D8D7D9C9D5E340404040 &SPLDAT *CHAR 6 '080116' F0F8F0F1F1F6 &SPLFNAM *CHAR 10 'QPRINT ' D8D7D9C9D5E340404040 &SPLNBR *CHAR 5 ' 4' 40404040F4 &SPLNBRAUX *DEC 5 0 0 &SPLTIM *CHAR 8 '11:02:33' F1F17AF0F27AF3F3 &STATUS *CHAR 3 'RDY' D9C4E8 &SYSDATE *CHAR 6 '080611' F0F8F0F6F1F1 &TOTPAG *CHAR 5 ' 1' 40404040F1 &USRDTA *CHAR 10 'PBJ09 ' D7C2D1F0F94040404040 &USRNAM *CHAR 10 'WNINOMIA ' E6D5C9D5D6D4C9C14040 * * * * * E N D O F D U M P * * * * *
Last Wiki Answer Submitted:  June 11, 2008  7:00 pm  by  Gilly400   23,625 pts.
All Answer Wiki Contributors:  Gilly400   23,625 pts.
To see all answers submitted to the Answer Wiki: View Answer History.


Discuss This Question:
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _


 

I’m using this parameters to the first CL

DELETE OLD SPOOLED FILES (DLTOLDSPLF)

Type choices, press Enter.

DAYS TO RETAIN SPOOLED FILES . . > 99 Character value

 440 pts.

 

Display System Value

System value . . . . . : QDATE
Description . . . . . : System date

Date . . . . . . . . . : 11/06/08 DD/MM/YY

 440 pts.

 

Hi Silvarb,

First thing I notice is field &DIAS *DEC 3 0 ’99′ F9F9 – This is invalid, try calling the program like this :-

DLTOLDSPLF X’099F’

I don’t think this is the solution to all your problems, so let me know how this goes. If it crashes, take another dump for us.

Regards,

Martin Gilbert.

 23,625 pts.

 

Martin my friend,

Thanks for all your Help, now it’s works, so, How can i do after this help (rsrsrs), see the log.

Display All Messages
System: TDBSBC25
Job . . : QPADEV001K User . . : RBDSILVA Number . . . : 624429

1700 – CVTDAT DATE(’080612′) TOVAR(&DATA2J) FROMFMT(*YMD) TOFMT(*JUL)
TOSEP(*NONE)
– RETURN /* RETURN due to end of CL program */
2100 – RCVF DEV(*FILE) RCDFMT(*FILE) WAIT(*YES) OPNID(*NONE) /*
File name is DLTOLDSPLF. */
2300 – CALL PGM(DIFDATA) /* The CALL command contains
parameters */
1500 – CVTDAT DATE(’080612′) TOVAR(&DATA1J) FROMFMT(*YMD) TOFMT(*JUL)
TOSEP(*NONE)
1700 – CVTDAT DATE(’080612′) TOVAR(&DATA2J) FROMFMT(*YMD) TOFMT(*JUL)
TOSEP(*NONE)
– RETURN /* RETURN due to end of CL program */
2100 – RCVF DEV(*FILE) RCDFMT(*FILE) WAIT(*YES) OPNID(*NONE) /*
File name is DLTOLDSPLF. */
4200 – SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(’00351 SPOOLFILES
DELETADOS’) MSGTYPE(*COMP)
– RETURN /* RETURN due to end of CL program */
> DSPJOB
> DSPJOB
/* */
>> DSPJOB

 440 pts.

 

Hi Silvarb,

I’m afraid I don’t understand the question. Can you explain what you mean?

Regards,

Martin.

 23,625 pts.

 

Ok Martin, I’m try to explicate:

When I use my CL with this parameter DLTOLDSPLF ’099’ or ’99′ or other with 2 or 3 characters, I receive that error on the DUMP.

When use your sugestion with this parameter DLTOLDSPLF X’099F’ the process works normally.

Now I don’t know what I do, cause I know where this CL is wrong, or a help to implement this CL to run normally all days.

Thanks again and sorry , my english is not good.

Regards,
silvarb

 440 pts.

 

ooops…..Martin

change
I know where this CL is wrong

to
I DON’T know where this CL is wrong

 440 pts.

 

Silvarb,

I think what it is, you have created a command called DLTOLDSPLF.

This command uses your CL program.

Your CL program has a number-of-days parameter &DIAS which is defined as decimal, 3 digits.

BUT, I suspect that the command declares this parameter as a character value of length 3.

Change the command source to declare the parameter as :

PARM KWD(DIAS) TYPE(*DEC) LEN(3)….

….and now the comand will match up with the CL.

Regards,

Sloopy

 2,195 pts.

 

Hi Silvarb,

Now I know what you mean.

I suggest you add an extra variable for your parameter :-
DCL VAR(&DIASIN) TYPE(*CHAR) LEN(3)

Then at the start of your program :-
CHGVAR VAR(&DIAS) VALUE(&DIASIN)

This should then take the alphanumeric parameter and put it into the decimal variable &DIAS.

Regards,

Martin.

 23,625 pts.

 

Hi,

I see our friend Sloopy has also just answered. Thinking about it, his answer is probably a better option, then you shouldn’t need to change your CL program.

Regards,

Martin.

 23,625 pts.

 

It’s not what you asked for, but did you know there is already a DLTOLDSPLF command written that has worked for many years ? Check out http://www.hkrebs.dk/dltoldsplf.html

 3,115 pts.

 

Friends, I would like to thank you both, I am very grateful for the help.

PS: “Sharing we generate knowledge”

Regards,
Roberto

 440 pts.

 

Hi,
Works great, I just put an app together where you set the number of days back you want to delete old files and it only deletes those files that are contained in my table containing outq and user.

 120 pts.

 

Friends,
Now I know the reason that the program was not operational…this syntaxe below was missing in the program DIFDATA
CHGVAR VAR(&DIF) VALUE((&DIFANO * 365) + &DIFDIA)

The corrects program are:

***** The COMMAND – called DLTOLDSPLF *****
CMD PROMPT(‘Delete OLD Spool Files’)
PARM KWD(DIAS) TYPE(*DEC) LEN(3) MIN(1) +
PROMPT(‘Dias Para Reter Spool Files’)

***** The first CL – called DLTOLDSPLF *****
PGM PARM(&DIAS)
DCLF FILE(DLTOLDSPLF)
DCL VAR(&DIAS) TYPE(*DEC) LEN(3 0)
DCL VAR(&DIF) TYPE(*DEC) LEN(5 0)
DCL VAR(&DIFX) TYPE(*CHAR) LEN(5)
DCL VAR(&SYSDATE) TYPE(*CHAR) LEN(6)
DCL VAR(&CTDLT) TYPE(*DEC) LEN(5 0)
DCL VAR(&SPLNBRAUX) TYPE(*DEC) LEN(5 0)
DCL VAR(&CTDLTX) TYPE(*CHAR) LEN(5)
WRKSPLF SELECT(*ALL) OUTPUT(*PRINT)
CRTPF FILE(QTEMP/WRKSPLF) RCDLEN(170) SIZE(*NOMAX)
MONMSG MSGID(CPF7302)
CPYSPLF FILE(QPRTSPLF) TOFILE(QTEMP/WRKSPLF) +
SPLNBR(*LAST)
RUNQRY QRY(DLTOLDSPLF)
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&SYSDATE)
CVTDAT DATE(&SYSDATE) TOVAR(&SYSDATE) TOFMT(*YMD) +
TOSEP(*NONE)
LER: RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(FIM))
OVRDBF FILE(DLTOLDSPLF) TOFILE(QGPL/DLTOLDSPLF)
CALL PGM(DIFDATA) PARM(&SYSDATE &SPLDAT &DIF)
CHGVAR VAR(&DIFX) VALUE(&DIF)
IF COND(&DIF *LE &DIAS) THEN(GOTO CMDLBL(LER))
CHGVAR VAR(&SPLNBRAUX) VALUE(&SPLNBR)
DLTSPLF FILE(&SPLFNAM) JOB(&JOBNBR/&USRNAM/&JOBNAM) +
SPLNBR(&SPLNBRAUX)
MONMSG MSGID(CPF0000)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA(‘Deletando o Spool ‘ *BCAT &JOBNAM +
*TCAT ‘/’ *TCAT &USRNAM *TCAT ‘/’ *TCAT +
&JOBNBR *BCAT ‘de’ *BCAT &SPLDDMMYY *BCAT +
‘No Sistema por mais de’ *BCAT &DIFX +
*BCAT ‘dias’) TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGVAR VAR(&CTDLT) VALUE(&CTDLT + 1)
GOTO CMDLBL(LER)
ERROR: DMPCLPGM
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(‘Erro No +
Programa, verifique O JobLog’) +
MSGTYPE(*ESCAPE)
RETURN
FIM: CHGVAR VAR(&CTDLTX) VALUE(&CTDLT)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&CTDLTX +
*BCAT ‘Spoolfiles Deletados’) MSGTYPE(*COMP)
ENDPGM

***** The second CL – called DIFDATA *****
PGM PARM(&DATA1 &DATA2 &DIF)
DCL VAR(&DATA1) TYPE(*CHAR) LEN(6)
DCL VAR(&DATA2) TYPE(*CHAR) LEN(6)
DCL VAR(&DATA1J) TYPE(*CHAR) LEN(5)
DCL VAR(&DATA2J) TYPE(*CHAR) LEN(5)
DCL VAR(&DIF) TYPE(*DEC) LEN(5 0)
DCL VAR(&DIFDIA) TYPE(*DEC) LEN(5 0)
DCL VAR(&DIFANO) TYPE(*DEC) LEN(5 0)
DCL VAR(&ANO1) TYPE(*DEC) LEN(4 0)
DCL VAR(&DIA1) TYPE(*DEC) LEN(3 0)
DCL VAR(&ANO2) TYPE(*DEC) LEN(4 0)
DCL VAR(&DIA2) TYPE(*DEC) LEN(3 0)
CVTDAT DATE(&DATA1) TOVAR(&DATA1J) FROMFMT(*YMD) +
TOFMT(*JUL) TOSEP(*NONE)
CVTDAT DATE(&DATA2) TOVAR(&DATA2J) FROMFMT(*YMD) +
TOFMT(*JUL) TOSEP(*NONE)
CHGVAR VAR(&ANO1) VALUE(%SST(&DATA1J 1 2))
CHGVAR VAR(&ANO2) VALUE(%SST(&DATA2J 1 2))
CHGVAR VAR(&DIA1) VALUE(%SST(&DATA1J 3 3))
CHGVAR VAR(&DIA2) VALUE(%SST(&DATA2J 3 3))
IF COND(%SST(&DATA1 1 1) *GE ’8′) THEN(CHGVAR +
VAR(&ANO1) VALUE(&ANO1 + 1900))
ELSE CMD(CHGVAR VAR(&ANO1) VALUE(&ANO1 + 2000))
IF COND(%SST(&DATA2 1 1) *GE ’8′) THEN(CHGVAR +
VAR(&ANO2) VALUE(&ANO2 + 1900))
ELSE CMD(CHGVAR VAR(&ANO2) VALUE(&ANO2 + 2000))
CHGVAR VAR(&DIFDIA) VALUE(&DIA1 – &DIA2)
CHGVAR VAR(&DIFANO) VALUE(&ANO1 – &ANO2)
IF COND(&DIFDIA *LT 0) THEN(DO)
CHGVAR VAR(&DIFANO) VALUE(&DIFANO – 1)
CHGVAR VAR(&DIFDIA) VALUE(&DIFDIA + 365)
ENDDO
CHGVAR VAR(&DIF) VALUE((&DIFANO * 365) + &DIFDIA)
ENDPGM

***** The Query – called DLTOLDSPLF *****
5722QU1 V5R3M0 040528 IBM Query for AS/400 18:50:53 Page 1
Query . . . . . . . . . . . . . . . . . DLTOLDSPLF
Library . . . . . . . . . . . . . . . QGPL
Query text . . . . . . . . . . . . . . Extrai dados de WRKSPLF *ALL
Query CCSID . . . . . . . . . . . . . . 65535
Query language id . . . . . . . . . . . ENU
Query country or region id . . . . . . US
*** . is the decimal separator character for this query ***
Collating sequence . . . . . . . . . . Hexadecimal
Processing options
Use rounding . . . . . . . . . . . . Yes (default)
Ignore decimal data errors . . . . . No (default)
Ignore substitution warnings . . . . Yes
Use collating for all compares . . . Yes
Selected files
ID File Library Member Record Format
T01 WRKSPLF QTEMP *FIRST WRKSPLF
Result fields
Name Expression Column Heading Len Dec
SPLFNAM SUBSTR(WRKSPLF,2,10)
USRNAM SUBSTR(WRKSPLF,13,10)
PRTDEV SUBSTR(WRKSPLF,24,10)
USRDTA SUBSTR(WRKSPLF,35,10)
STATUS SUBSTR(WRKSPLF,46,3)
TOTPAG SUBSTR(WRKSPLF,51,5)
SPLDAT SUBSTR(WRKSPLF,89,2)||
SUBSTR(WRKSPLF,86,2)||
SUBSTR(WRKSPLF,83,2)
SPLTIM SUBSTR(WRKSPLF,92,8)
SPLNBR SUBSTR(WRKSPLF,102,5)
JOBNAM SUBSTR(WRKSPLF,108,10)
JOBNBR SUBSTR(WRKSPLF,119,6)
QNAM SUBSTR(WRKSPLF,126,10)
QLIB SUBSTR(WRKSPLF,137,10)
SPLDDMMYY SUBSTR(WRKSPLF,83,2)|| ‘/’ ||
SUBSTR(WRKSPLF,86,2)|| ‘/20′ ||
SUBSTR(WRKSPLF,89,2)
IBM Query for AS/400 27/06/08 18:50:53 Page 2
Select record tests
AND/OR Field Test Value (Field, Numbers, or ‘Characters’)
SPLFNAM NLIST ’5722SS1 V’ ‘File ‘
AND SPLFNAM NLIST ‘ * ‘ ‘ ‘
Ordering of selected fields
Field Sort Ascending/ Break Field
Name Priority Descending Level Text
SPLFNAM
USRNAM
PRTDEV
USRDTA
STATUS
TOTPAG
SPLDAT 10 A
SPLTIM
SPLNBR
JOBNAM
JOBNBR
QNAM
QLIB
SPLDDMMYY
Report column formatting and summary functions
Summary functions: 1-Total, 2-Average, 3-Minimum, 4-Maximum, 5-Count Overrides
Field Summary Column Dec Null Dec Numeric
Name Functions Spacing Column Headings Len Pos Cap Len Pos Editing
SPLFNAM 0 SPLFNAM 10
USRNAM 2 USRNAM 10
PRTDEV 2 PRTDEV 10
USRDTA 2 USRDTA 10
STATUS 2 STATUS 3
TOTPAG 2 TOTPAG 5
SPLDAT 2 SPLDAT 6
SPLTIM 2 SPLTIM 8
SPLNBR 2 SPLNBR 5
JOBNAM 2 JOBNAM 10
JOBNBR 2 JOBNBR 6
QNAM 2 QNAM 10
QLIB 2 QLIB 10
SPLDDMMYY 2 SPLDDMMYY 10
IBM Query for AS/400 27/06/08 18:50:53 Page 3
Selected output attributes
Output type . . . . . . . . . . . . . . Database file
Form of output . . . . . . . . . . . . Detail
Line wrapping . . . . . . . . . . . . . No
Database file output
File . . . . . . . . . . . . . . . . . DLTOLDSPLF
Library . . . . . . . . . . . . . . . QGPL
Member . . . . . . . . . . . . . . . . *FILE
Data in file . . . . . . . . . . . . . Replace file
For a new file:
Authority . . . . . . . . . . . . . . *ALL
Text about
the file . . . . . . . . . . . . . Extrai dados de WRKSPLF *ALL
Print definition . . . . . . . . . . . No
Output file record format
Output record length . . . . . . . . . 113
Field list:
Field Begin Len Dec Null Data Type Text
SPLFNAM 1 10 Character SUBSTR(WRKSPLF,2,10)
USRNAM 11 10 Character SUBSTR(WRKSPLF,13,10)
PRTDEV 21 10 Character SUBSTR(WRKSPLF,24,10)
USRDTA 31 10 Character SUBSTR(WRKSPLF,35,10)
STATUS 41 3 Character SUBSTR(WRKSPLF,46,3)
TOTPAG 44 5 Character SUBSTR(WRKSPLF,51,5)
SPLDAT 49 6 Character SUBSTR(WRKSPLF,89,2)|| SUBSTR(WRKSPLF,86
SPLTIM 55 8 Character SUBSTR(WRKSPLF,92,8)
SPLNBR 63 5 Character SUBSTR(WRKSPLF,102,5)
JOBNAM 68 10 Character SUBSTR(WRKSPLF,108,10)
JOBNBR 78 6 Character SUBSTR(WRKSPLF,119,6)
QNAM 84 10 Character SUBSTR(WRKSPLF,126,10)
QLIB 94 10 Character SUBSTR(WRKSPLF,137,10)
SPLDDMMYY 104 10 Character SUBSTR(WRKSPLF,83,2)|| ‘/’ || SUBSTR(WRKSPLF,86
* * * * * E N D O F Q U E R Y P R I N T * * * * *

 440 pts.