Re: Auto RGZPFM clp

[Martin Rowe <martin@xxxxxxxxxx>]

On Mon, 2004-09-06 at 09:55, Jan.Rockstedt@xxxxxxxxxxxx wrote:
> Hi !
> 
> I am looking for cl program that help my with auto RGZPFM.
> 
> Any sugestion?

Hi Jan

This little CMD/CL routine is (slightly amended from) what I use.

RGZLIBPFM command
-------------------------------------8<----------------------------------
  CMD        PROMPT('Reorganize library''s PFMs')          
  PARM       KWD(LIB) TYPE(*SNAME) MIN(1) PROMPT('Library +
               name')                                      
  PARM       KWD(MINDLTPCT) TYPE(*DEC) LEN(5 2) DFT(2) +   
               PROMPT('Minimum deleted %')                 
------------------------------------->8----------------------------------
RGZLIBCPP - command processor
-------------------------------------8<----------------------------------
PGM PARM(&LIBRARY &MINDLTPCT)                   
  DCL        VAR(&LIBRARY) TYPE(*CHAR) LEN(10)  
  DCL        VAR(&LIBRARY) TYPE(*CHAR) LEN(10)  
  DCL        VAR(&MINDLTPCT) TYPE(*DEC) LEN(5 2)
  DCL        VAR(&DLTPCT) TYPE(*DEC) LEN(10 2)  
  DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)      
  DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(512)  
  DCL        VAR(&RECORDS) TYPE(*CHAR) LEN(10)  
  DCL        VAR(&DELETED) TYPE(*CHAR) LEN(10)  
  DCLF       FILE(MEMBERLIST) RCDFMT(QWHFDML)   

  MONMSG     MSGID(CPF0000)

/********************************************************************/
/* START OF MAINLINE CODE                                           */ 
/********************************************************************/
  RTVJOBA    TYPE(&TYPE)                                              
/* If the job isn't in batch, submit it and exit */                   
  IF (&TYPE *EQ '1') THEN(DO)                                         
    SBMJOB     CMD(RGZLIBPFM LIB(&LIBRARY) +                          
                 MINDLTPCT(&MINDLTPCT)) JOB(&LIBRARY)                 
    GOTO       CMDLBL(ENDPGM)                                         
  ENDDO                                                               
/* Drop the list of files into a temporary outfile for processing */  
  DSPFD      FILE(&LIBRARY/*ALL) TYPE(*MBRLIST) +                     
               OUTPUT(*OUTFILE) FILEATR(*PF) +                        
               OUTFILE(QTEMP/MEMBERLIST)                              
TOPOFLOOP:                                                            
  RCVF       RCDFMT(QWHFDML)                                          
  MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ENDPGM))                 
/* Reorganize this file member if it has deleted records */           
  IF         COND(&MLNDTR *GT 0) THEN(DO)                     
    IF         COND(&MLNRCD *GT 0) THEN(CHGVAR VAR(&DLTPCT) + 
                 VALUE((&MLNDTR / &MLNRCD) * 100))            
    IF         COND(&MLNRCD *EQ 0) THEN(CHGVAR VAR(&DLTPCT) + 
                 VALUE(100))                                  
  ENDDO                                                       
  IF         COND(&MLNDTR *EQ 0) THEN(CHGVAR VAR(&DLTPCT) +   
               VALUE(0))                                      
  IF         COND(&DLTPCT *GE &MINDLTPCT) THEN(DO)            
    CHGVAR     VAR(&RECORDS) VALUE(&MLNRCD)                   
    CHGVAR     VAR(&DELETED) VALUE(&MLNDTR)                   
    CHGVAR     VAR(&MSGDTA) VALUE('Reorganized' |> &MLFILE +  
                 |> '(' |> &RECORDS |> 'active records, +     
                 (' |< &DELETED |> 'deleted records)')        
    RGZPFM     FILE(&MLLIB/&MLFILE) MBR(&MLNAME)              
    MONMSG     MSGID(CPF0000) EXEC(CHGVAR VAR(&MSGDTA) +      
                 VALUE('Errors encountered during +           
                 reorganize of' |> &MLFILE |< '. Check +      
                 joblog for details.'))                       
    SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSGDTA) + 
                 TOPGMQ(*PRV) MSGTYPE(*INFO)
  ENDDO                                     
  GOTO       CMDLBL(TOPOFLOOP)              
ENDPGM:                                     
  RETURN                                    
ENDPGM                                      
------------------------------------->8----------------------------------
Regards, Martin
-- 
martin@xxxxxxxxxx  AIM/Gaim: DBG400dotNet  http://www.dbg400.net       /"\
DBG/400 - DataBase Generation utilities - AS/400 / iSeries Open        \ /
Source free test environment tools and others (file/spool/misc)         X 
[this space for hire]  ASCII Ribbon Campaign against HTML mail & news  / \