Tweet
IBM gave this to me!
This program reads thru all the files on the iseries lookin for errors.
you can change the library to a single library or '*ALL'
with V5R4 there is a new command to fix IFS errors
you can change the library to a single library or '*ALL'
with V5R4 there is a new command to fix IFS errors
PHP Code:
RCLLNK QSYS Reclaim Object Links
Code:
/* THE CHKPF COMMAND WILL USE CPYF TO READ EVERY RECORD OF EVERY */
/* PHYSICAL FILE OR TABLE OF A LIBRARY OR ALL LIBRARIES ON THE */
/* SYSTEM. UPON COMPLETION ANY PF'S WITH DATA ERRORS WILL BE */
/* IDENTIFIED. THESE PF'S SHOULD BE REVIEWED FOR POSSIBLE INVALID */
/* DATA CONTENTS OR DAMAGE. */
/*=======================================================================*/
/* */
/* Create a source member (CRTSRCPF) called CHKPF in source file */
/* QTXTSRC of library QGPL. Update the source member with the */
/* following statement: */
/* */
/* CREATE TABLE QGPL/CHKPF (DBXLIB CHAR (10) NOT NULL WITH DEFAULT, */
/* DBXFIL CHAR (10) NOT NULL WITH DEFAULT) */
/* */
/* */
/* Create table CHKPF in library QGPL by running the SQL statement */
/* entered into source member CHKPF: */
/* */
/* RUNSQLSTM SRCFILE(QGPL/QTXTSRC) SRCMBR(CHKPF) COMMIT(*NONE) */
/* */
/* */
/* Create a source member called CHKPF in source file QCLSRC of */
/* library QGPL. Update the source member with the following */
/* statements: */
/* */
/*=======================================================================*/
PGM
/* DCL VAR(&LIBRARY) TYPE(*CHAR) LEN(10) VALUE('*ALL') */
DCL VAR(&LIBRARY) TYPE(*CHAR) LEN(10) +
VALUE('SPYFOLDERS')
DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(512)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4) VALUE('9999')
DCL VAR(&MSGTXT1) TYPE(*CHAR) LEN(256)
DCL VAR(&PFCNT) TYPE(*DEC) LEN(9 0)
DCL VAR(&PFCNTA) TYPE(*CHAR) LEN(9)
DCL VAR(&PFERR) TYPE(*DEC) LEN(9 0)
DCL VAR(&PFERRA) TYPE(*CHAR) LEN(9)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
/* FILE CHKPF MUST BE CREATED PRIOR TO COMPILING THIS CL PROGRAM. */
DCLF FILE(CHKPF)
/* MESSAGES OF FAILING FILES ARE SENT TO THE JOB'S USER PROFILE. */
RTVJOBA USER(&USER)
/* VALIDATE THE LIBRARY NAME. */
IF COND(&LIBRARY *NE '*ALL') THEN(DO)
CHKOBJ OBJ(&LIBRARY) OBJTYPE(*LIB)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&MSGTXT) VALUE('Library ' *CAT &LIBRARY +
*BCAT 'not found or not available.')
SNDPGMMSG MSG(&MSGTXT) TOPGMQ(*PRV) TOMSGQ(*TOPGMQ) +
MSGTYPE(*COMP)
GOTO CMDLBL(ENDOFPGM)
ENDDO
ENDDO
/* OPEN THE SYSTEM CROSS REFERENCE FILE FOR PROCESSING OF PF'S. */
OVRDBF FILE(QaDBXREF)
IF COND(&LIBRARY *EQ '*ALL') THEN(DO)
OPNQRYF FILE((QSYS/QaDBXREF)) OPTION(*INP) +
FORMAT(QGPL/CHKPF) QRYSLT('DBXATR = +
%VALUES("PF" "TB")') KEYFLD(*FILE)
ENDDO
ELSE CMD(DO)
OPNQRYF FILE((QSYS/QaDBXREF)) OPTION(*INP) +
FORMAT(QGPL/CHKPF) QRYSLT('DBXLIB = ''' +
*CAT &LIBRARY *CAT ''' *AND DBXATR= +
%VALUES("PF" "TB")') KEYFLD(*FILE)
ENDDO
/* OUTPUT THE PF'S TO BE CHECKED TO THE CHKPF FILE. */
DLTF FILE(QTEMP/CHKPF)
MONMSG MSGID(CPF0000)
CRTDUPOBJ OBJ(CHKPF) FROMLIB(QGPL) OBJTYPE(*FILE) +
TOLIB(QTEMP)
CPYFRMQRYF FROMOPNID(QaDBXREF) TOFILE(QTEMP/CHKPF) +
MBROPT(*REPLACE)
CLOF OPNID(QaDBXREF)
DLTOVR FILE(QaDBXREF)
/* PROCESS THE RECORDS IN THE CHKPF FILE. */
OVRDBF FILE(CHKPF) TOFILE(QTEMP/CHKPF)
READ: RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(ENDREAD))
CHGVAR VAR(&PFCNT) VALUE(&PFCNT + 1)
IF COND(&DBXFIL *EQ 'CHKPF') THEN(GOTO +
CMDLBL(READ))
/* DELETE THE FILE IN QTEMP IF IT EXISTS. */
DLTF FILE(QTEMP/&DBXFIL)
MONMSG MSGID(CPF2105)
/* CHECK THE PF BY COPYING IT TO A NEW FILE IN QTEMP. */
CPYF FROMFILE(&DBXLIB/&DBXFIL) +
TOFILE(QTEMP/&DBXFIL) FROMMBR(*ALL) +
TOMBR(*FROMMBR) MBROPT(*REPLACE) +
CRTFILE(*YES) FROMRCD(1) INCCHAR(*RCD 1 +
*EQ '@#$%') ERRLVL(0)
/* ACCEPT EXPECTED ERROR CONDITIONS AND CONTINUE. */
MONMSG MSGID(CPF2817) EXEC(DO)
RCVMSG MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY)
/* +
Message CPF2817. */
RECEIVE: RCVMSG MSGTYPE(*PRV) MSGKEY(&MSGKEY) +
KEYVAR(&MSGKEY) MSG(&MSGTXT1) +
MSGID(&MSGID) /* Actual failing message +
ID. */
IF COND(&MSGID *EQ 'CPF2868') THEN(GOTO +
CMDLBL(READ)) /* No members in file. */
IF COND(&MSGID *EQ 'CPF2883') THEN(GOTO +
CMDLBL(RECEIVE)) /* Generic create error.*/
IF COND(&MSGID *EQ 'CPF320B') THEN(GOTO +
CMDLBL(READ)) /* Data dictionary file. */
IF COND(&MSGID *EQ 'CPF2833') THEN(GOTO +
CMDLBL(TEST1)) /* Record length < 4. */
IF COND(&MSGID *EQ 'CPF2869') THEN(GOTO +
CMDLBL(READ)) /* Empty member. */
GOTO CMDLBL(SNDERROR)
ENDDO
MONMSG MSGID(CPF2952) EXEC(DO)
RCVMSG MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY)
/*Message CPF2952. */
RCVMSG MSGTYPE(*PRV) MSGKEY(&MSGKEY) +
KEYVAR(&MSGKEY) MSG(&MSGTXT1) +
MSGID(&MSGID) /* Actual failing message id */
IF COND(&MSGID *EQ 'CPF4234') THEN(GOTO +
CMDLBL(READ)) /* I/O not allowed. */
GOTO CMDLBL(SNDERROR)
ENDDO
/* REPORT PF ERROR FOR ALL OTHER MESSAGE ID'S. */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
GOTO CMDLBL(READ)
/* RETEST CPYF IF RECORD LENGTH IS LESS THAN 4. */
TEST1: CPYF FROMFILE(&DBXLIB/&DBXFIL) +
TOFILE(QTEMP/&DBXFIL) FROMMBR(*ALL) +
TOMBR(*FROMMBR) MBROPT(*REPLACE) +
CRTFILE(*YES) FROMRCD(1) INCCHAR(*RCD 1 +
*EQ '@') ERRLVL(0)
/* REPORT PF ERROR FOR ANY ERROR MESSAGE. */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
GOTO CMDLBL(READ)
/* DETERMINE FAILING ERROR MESSAGE. */
ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY)
RCVMSG MSGTYPE(*PRV) MSGKEY(&MSGKEY) +
KEYVAR(&MSGKEY) MSG(&MSGTXT1) MSGID(&MSGID)
/* SEND PF ERROR MESSAGE TO THE JOB'S USER PROFILE MESSAGE QUEUE */
SNDERROR: CHGVAR VAR(&MSGTXT) VALUE('Error on file ' *CAT +
&DBXFIL *BCAT 'in library ' *CAT &DBXLIB +
*TCAT '. Failing message is ' *CAT &MSGID +
*BCAT ': ' *CAT &MSGTXT1)
SNDMSG MSG(&MSGTXT) TOUSR(&USER)
MONMSG MSGID(CPF0000)
/* SEND PF ERROR MESSAGE TO THE JOB'S PROGRAM MESSAGE QUEUE. */
CHGVAR VAR(&PFERR) VALUE(&PFERR + 1)
CHGVAR VAR(&MSGTXT) VALUE('File ' *CAT &DBXFIL +
*BCAT 'in library ' *CAT &DBXLIB *BCAT +
'in error.')
SNDPGMMSG MSG(&MSGTXT) TOPGMQ(*PRV) TOMSGQ(*TOPGMQ) +
MSGTYPE(*DIAG)
GOTO CMDLBL(READ)
/* SEND FILE COUNT MESSAGES TO THE JOB'S PROGRAM MESSAGE Q */
ENDREAD: CHGVAR VAR(&PFCNTA) VALUE(&PFCNT)
CHGVAR VAR(&MSGTXT) VALUE(&PFCNTA *BCAT 'physical +
files processed for library ' *CAT +
&LIBRARY *TCAT '.')
SNDPGMMSG MSG(&MSGTXT) TOPGMQ(*PRV) TOMSGQ(*TOPGMQ) +
MSGTYPE(*COMP)
IF COND(&PFERR *EQ 0) THEN(DO)
CHGVAR VAR(&MSGTXT) VALUE('No errors found.')
SNDPGMMSG MSG(&MSGTXT) TOPGMQ(*PRV) TOMSGQ(*TOPGMQ) +
MSGTYPE(*COMP)
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&PFERRA) VALUE(&PFERR)
CHGVAR VAR(&MSGTXT) VALUE(&PFERRA *BCAT 'physical +
files were in error for library ' *CAT +
&LIBRARY *TCAT '. Review the previous +
job log messages for additional +
information.')
SNDPGMMSG MSG(&MSGTXT) TOPGMQ(*PRV) TOMSGQ(*TOPGMQ) +
MSGTYPE(*COMP)
ENDDO
ENDOFPGM: DLTOVR FILE(CHKPF)
ENDPGM
Comment