|
midrange.com
This is a utility we use to reorganize all files. We got back 5+GB. We
have also changed physical files to REUSEDLT(*YES).
Command RGZALLPFM:
/* */
/* RGZALLPFM - REORGANIZE ALL PHYSICAL FILES */
/* COMMAND PROCCESSING PROGRAM - RGZALLPFMC */
/* 21 MAR 90 - CLM */
/* */
/* COPYRIGHT 1990 ALL RIGHTS RESERVED */
/* MPH, INC., OKEMOS, MI USA */
/* */
CMD PROMPT('Reorganize all physical files')
PARM KWD(LIB) TYPE(*NAME) LEN(10) MIN(1) +
PROMPT('Library')
PARM KWD(FILE) TYPE(*GENERIC) LEN(10) DFT(*ALL) +
SPCVAL((*ALL)) PROMPT('Files')
CL program RGZALLPFMC:
/* */
/* RGZALLPFMC - REORGANIZE ALL PHYSICAL FILES */
/* 21 MAR 90 - CHARLES L. MASSOGLIA */
/* */
/* COPYRIGHT 1990, ALL RIGHTS RESERVED */
/* MPH, INC., OKEMOS, MI USA */
/* */
RGZALLPFMC: PGM PARM(&LIB &FILE)
/* DEFINE INCOMING VARIABLES */
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
/* DECLARE DSPFD *MBR *PF OUTFILE */
DCLF FILE(QAFDMBR)
/* DECLARE PROGRAM VARIABLES */
DCL VAR(©RIGHT) TYPE(*CHAR) LEN(80) +
VALUE('Copyright 1990, MPH, Inc., Okemos, +
MI USA, All Rights Reserved')
DCL VAR(&ERROR ) TYPE(*CHAR) LEN(1)
DCL VAR(&GOTSOME) TYPE(*CHAR) LEN(1)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
/* GET JOB TYPE */
RTVJOBA USER(&USER) TYPE(&TYPE)
/* INSURE FROM LIBRARY EXISTS */
CHKOBJ OBJ(&LIB) OBJTYPE(*LIB)
MONMSG MSGID(CPF9801) EXEC(DO) /* Library Not Found */
RCVMSG MSGTYPE(*EXCP)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('From +
Library ' *CAT &LIB *TCAT ' not +
found') MSGTYPE(*DIAG)
CHGVAR VAR(&ERROR) VALUE('Y')
ENDDO
/* INSURE FROM LIBRARY IS NOT QSYS */
IF COND(&LIB *EQ 'QSYS') THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('QSYS +
library not valid for this utility') +
MSGTYPE(*DIAG)
CHGVAR VAR(&ERROR) VALUE('Y')
ENDDO
/* DONE IF ERRORS ENCOUNTERED */
IF COND(&ERROR *EQ 'Y') THEN(DO)
SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) +
MSGDTA(RGZALLPFM) MSGTYPE(*COMP)
GOTO CMDLBL(END)
ENDDO
/* DELETE WORK FILE IF PRESENT */
DLTF FILE(QTEMP/RGZALLPFMF)
MONMSG MSGID(CPF2105) /* File does not exist */
/* GET FILE NAMES */
IF COND(&TYPE *EQ '1') THEN(DO) /* +
'1'=INTERACTIVE */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Retrieving file names in' *BCAT +
&LIB) TOPGMQ(*EXT) MSGTYPE(*STATUS)
ENDDO
ELSE CMD(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Retrieving file names in' *BCAT +
&LIB) MSGTYPE(*DIAG)
ENDDO
DSPFD FILE(&LIB/&FILE) TYPE(*MBR) OUTPUT(*OUTFILE) +
FILEATR(*PF) OUTFILE(QTEMP/RGZALLPFMF)
MONMSG MSGID(CPF3020 CPF3012) EXEC(DO) /* +
CPF3020=file with specified attributes +
does not exist, i.e. no physical files; +
CPF3012=file not found */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No +
physical files found in library ' *CAT +
&LIB) MSGTYPE(*DIAG)
SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) +
MSGDTA(RGZALLPFM) MSGTYPE(*COMP)
GOTO CMDLBL(END)
ENDDO
/* OVERRIDE TO TEMPORARY FILE */
OVRDBF FILE(QAFDMBR) TOFILE(QTEMP/RGZALLPFMF) +
SECURE(*YES)
/* LOOP THROUGH OBJECTS */
READOBJ: RCVF
MONMSG MSGID(CPF0864) EXEC(DO) /* CPF0864=End of +
file */
RCVMSG MSGTYPE(*EXCP)
GOTO CMDLBL(ENDFILE)
ENDDO
/* SKIP IF NOT LOCAL PHYSICAL FILE */
IF COND(&MBFTYP *NE 'P') THEN(GOTO CMDLBL(READOBJ))
/* SKIP IF NOT DATA FILE */
IF COND(&MBDTAT *NE 'D') THEN(GOTO CMDLBL(READOBJ))
/* SKIP IF NO DELETED RECORDS */
IF COND(&MBNDTR *LE 0) THEN(GOTO CMDLBL(READOBJ))
/* SKIP IF NO DATA RECORDS */
IF COND(&MBNRCD *LE 0) THEN(GOTO CMDLBL(READOBJ))
/* REORGANIZE FILE */
IF COND(&TYPE *EQ '1') THEN(DO) /* +
'1'=INTERACTIVE */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Reorganizing file' *BCAT &MBLIB +
*TCAT '/' *CAT &MBFILE *BCAT 'member' +
*BCAT &MBNAME) TOPGMQ(*EXT) MSGTYPE(*STATUS)
ENDDO
ELSE CMD(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Reorganizing file' *BCAT &MBLIB +
*TCAT '/' *CAT &MBFILE *BCAT 'member' +
*BCAT &MBNAME) MSGTYPE(*DIAG)
ENDDO
RGZPFM FILE(&MBLIB/&MBFILE) MBR(&MBNAME)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('Error occurred. PF' *BCAT &MBLIB *TCAT +
'/' *CAT &MBFILE *BCAT 'member' *BCAT +
&MBNAME *BCAT 'not reorganized') +
MSGTYPE(*COMP)
GOTO CMDLBL(READOBJ)
ENDDO
CHGVAR VAR(&GOTSOME) VALUE(Y)
IF COND(&TYPE *EQ '0') THEN(DO) /* +
'0'=BATCH */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('File' +
*BCAT &MBLIB *TCAT '/' *CAT &MBFILE *BCAT +
'member' *BCAT &MBNAME *BCAT +
'reorganized') MSGTYPE(*DIAG)
ENDDO
/* GO GET NEXT OBJECT */
GOTO CMDLBL(READOBJ)
ENDFILE:
/* SEND MESSAGE IF NO PHYSICAL FILES */
IF COND(&GOTSOME *NE Y) THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No +
physical files with deleted records found +
in library ' *CAT &LIB) MSGTYPE(*DIAG)
IF COND(&TYPE *EQ '0') THEN(DO) /* '0'=Batch */
SNDUSRMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No +
physical files with deleted records found +
in library ' *CAT &LIB) MSGTYPE(*INFO) +
TOUSR(&USER)
ENDDO
ENDDO
/* DELETE WORKFILES */
DLTF FILE(QTEMP/RGZALLPFMF)
MONMSG MSGID(CPF0000)
/* DONE */
END: RETURN
CHGVAR VAR(©RIGHT) VALUE(©RIGHT)
ENDPGM
+---
| This is the JBA Software Users Mailing List!
| To submit a new message send your mail to JBAUSERS-L@midrange.com.
| To subscribe to this list send email to JBAUSERS-L-SUB@midrange.com.
| To unsubscribe from this list send email to JBAUSERS-L-UNSUB@midrange.com.
| Questions should be directed to the list owner: doug333@aol.com.
+---
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.
