× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Here you go Phil,  copied to the list for the archives.

command: RGZLIB LIBR(library) DELREC(10) DELPCT(1) LIST(Y)

file member is reorged if deleted records exceeds DELREC parm
file member is reorged if percentage of deleted to active exceeds DELPCT
parm
prints a list of all physical file members in library - and the status of
reorg attempt if LIST parm = "Y"

allocates file *excl, waits 10 secs - if successful, reorgs file.
Does not trap for any other errors during file reorg - it only reports that
it was unsuccessful.
reorgs KEYFILE(*FILE) if file is keyed.

Compile everything with default values

source file(member): QDDSSRC(RGZLIBPR)  SRCTYPE(PRTF)

                                            REF(QAFDMBR  )

                R PAGHDG
                                            SKIPB(002)
                                           1'Report:'
                                           9'RGZLIBR'
                                          38'Periodic Data File
Reorganization'
                                         110'Run Date:'
                                         120DATE
                                            EDTCDE(Y)
                                            SPACEA(001)

                                           1'Page#:'
                                           9PAGNBR EDTCDE(Z)
                                         110'Run Time:'
                                         120TIME
                                            SPACEA(002)

                                           1'Library:'
                  $LIB          10A       +2
                                          +6'Record Threshold:'
                  $DREC          9S 0     +1EDTCDE(Z)
                                          +6'Percentage Threshold:'
                  $DPCT          3S 0     +1EDTCDE(Z)
                                            SPACEA(002)

                                          30'Active'
                                          45'Deleted'
                                          54'Deleted'
                                            SPACEA(001)

                                           1'File Name'
                                          12'Member Name'
                                          30'Records'
                                          45'Records'
                                          54'Percent'
                                          63'Reorganization Status'
                                            SPACEA(001)

                                           1'---------'
                                          12'-----------'
                                          30'-------'
                                          45'-------'
                                          54'-------'
                                          63'---------------------'
                                            SPACEA(001)

                R DTLLIN
                  MBFILE    R        O     1
                  MBNAME    R        O    12
                  MBNRCD    R        O    24EDTCDE(J)
                  MBNDTR    R        O    39EDTCDE(J)
                  $PCT           3S 0O    56EDTCDE(J)
                  $MSG          60   O    63
                                            SPACEA(001)
--------End of source member----------

source file(member): QRPGLESRC(RGZLIBR)  SRCTYPE(RPGLE)

      *  RGZLIBR  - Read DSPFD outfile of file members in library,
      *             and reorg them based the number of deleted records
      *             or a percentage of total records deleted to active.
      *  Richard Baird

     FQAFDMBR   IP   E             DISK
     FRGZLIBPR  O    E             PRINTER infds(PrtFeedBack)

      * printer feedback (overflow)

     DPrtFeedBack      DS
     D $CurrLine             367    368I 0
     D $CurrPage             369    372I 0

      * Variable to build command for QCMDEXC

     D@Cmd             S            275A

      * Procedure interface for QCMDEXC

     D qCmdExc         PR                  EXTPGM('QCMDEXC')
     D   Cmd                        275A   OPTIONS(*VARSIZE) CONST
     D   CmdLen                      15P 5 CONST

      * input parameters

     D@Lib             S             10A
     D@DRec            S              9P 0
     D@DPct            S              3P 0
     D@List            S              1A
     D$overflow        S              2s 0 INZ(58)

     C     *Entry        plist
     C                   parm                    @Lib
     C                   parm                    @DRec
     C                   parm                    @DPct
     C                   parm                    @List

      * if physical file and *dta.

     C                   if        MBFTYP = 'P' and
     C                             MBDTAT = 'D'

      *    calculate percentage of deleted records.

     C                   select

     C                   when      MBNDTR > 0 and MBNRCD = 0
     C                   eval      $pct = 99

     C                   when      MBNDTR = 0 or  MBNRCD = 0
     C                   eval      $pct = 0

     C                   when      ((MBNDTR / MBNRCD) * 100) > 999
     C                   eval      $pct = 999

     C                   other
     C                   eval      $pct = ((MBNDTR / MBNRCD) * 100)

     C                   endsl

      *    decide if file has reached threashold to reorganize.

     C                   select

      *    file has no active records but has some deleted records.

     C                   when      MBNRCD  =  0          and
     C                             MBNDTR  >  0
     C                   exsr      $RgzPfm

      *    file has more deleted records than threashold

     C                   when      @DRec   >  0        and
     C                             MBNDTR  >= @DRec
     C                   exsr      $RgzPfm

      *    file has a percentage of deleted records greater than threashold

     C                   when      @DPct   >  0        and
     C                              MBNRCD >  0        and
     C                              $pct   >= @DPct
     C                   exsr      $RgzPfm

     C                   when      @List = 'Y'
     C                   exsr      $WrtNoReorg

     C                   endsl

     C                   end


*--------------------------------------------------------------------*
      * $RgzPfm - reorganize physical file member.

*--------------------------------------------------------------------*

     C     $RgzPfm       begsr

      *    attempt to allocate object

     C                   eval      @Cmd = 'ALCOBJ OBJ(('  +
     C                                     %trim(MBLIB  ) + '/'      +
     C                                     %trim(MBFILE ) +
     C                                     ' *FILE *EXCL '  +
     C                                     %trim(MBNAME ) + ')) +
     C                                     WAIT(10)'

     C                   callp(e)  QCmdExc(@Cmd : %size(@Cmd))

      *    attempt failed.  write error to report and skip file.

     C                   if        %error
     C                   exsr      $WrtError1
     C                   else

      *    build command to reorganize member.

     C                   eval      @Cmd = 'RGZPFM FILE('  +
     C                                     %trim(MBLIB  ) + '/'      +
     C                                     %trim(MBFILE ) + ') MBR(' +
     C                                     %trim(MBNAME ) + ')'

      *    if file is keyed, reorg by primary key.

     C                   if        MBACCP = 'K'
     C                   eval      @Cmd = %trim(@Cmd) +
     C                                    ' KEYFILE(*FILE)'
     C                   end

      *    execute reorg command

     C                   callp(e)  QCmdExc(@Cmd : %size(@Cmd))

      *    reorg unsuccessful or successful - write to report.

     C                   if        %error
     C                   exsr      $WrtError2
     C                   else
     C                   exsr      $WrtSuccess
     C                   end

      *    regardless of reorg success - de-allocate object.

     C                   eval      @Cmd = 'DLCOBJ OBJ(('  +
     C                                     %trim(MBLIB  ) + '/'      +
     C                                     %trim(MBFILE ) +
     C                                     ' *FILE *EXCL '  +
     C                                     %trim(MBNAME ) + '))'

     C                   callp(e)  QCmdExc(@Cmd : %size(@Cmd))
     C                   end

     C                   endsr


*--------------------------------------------------------------------*
      * $WrtError1 - allocate object failed.

*--------------------------------------------------------------------*

     C     $WrtError1    begsr

     C                   eval      $Msg = 'Could not allocate file. +
     C                                     File could be in use or +
     C                                     authority problem.'
     C                   write     DTLLIN

     C                   exsr      $ovrflw

     C                   endsr


*--------------------------------------------------------------------*
      * $WrtError2 - reorg of phys file member failed.

*--------------------------------------------------------------------*

     C     $WrtError2    begsr

     C                   eval      $Msg = 'Could not reorg file. +
     C                                     Possible authority problem.'
     C                   write     DTLLIN

     C                   exsr      $ovrflw

     C                   endsr


*--------------------------------------------------------------------*
      * $WrtSuccess - reorg of phys file member was successful.

*--------------------------------------------------------------------*

     C     $WrtSuccess   begsr

     C                   eval      $Msg = 'File was reorganized +
     C                                     successfully.'
     C                   write     DTLLIN

     C                   exsr      $ovrflw

     C                   endsr


*--------------------------------------------------------------------*
      * $WrtNoReorg - if requested, list even lines that weren't selected.

*--------------------------------------------------------------------*

     C     $WrtNoReorg   begsr

     C                   eval      $Msg = 'File reorg was not needed +
     C                                     for this file.'
     C                   write     DTLLIN

     C                   exsr      $ovrflw

     C                   endsr


*--------------------------------------------------------------------*
      * $ovrflw - check for printer overflow

*--------------------------------------------------------------------*

     C     $ovrflw       begsr

     C                   if        $CurrLine > $overflow
     C                   write     PAGHDG
     C                   end

     C                   endsr


*--------------------------------------------------------------------*
      * *inzsr - runs once at very beginning of program

*--------------------------------------------------------------------*

     C     *inzsr        begsr

     C                   eval      $lib  = @lib
     C                   eval      $DRec = @DRec
     C                   eval      $DPct = @DPct

     C                   write     PAGHDG

     C                   endsr
--------End of source member----------

source file(member): QCLSRC(RGZLIBCL) SRCTYPE(CLP)

             PGM        PARM(&LIB &DREC &DPCT &LIST)

             DCL        VAR(&LIB    )  TYPE(*CHAR) LEN(10)
             DCL        VAR(&DREC   )  TYPE(*DEC)  LEN(9 0)
             DCL        VAR(&DPCT   )  TYPE(*DEC)  LEN(3 0)
             DCL        VAR(&LIST   )  TYPE(*CHAR) LEN(1)

             CHKOBJ     OBJ(&LIB) OBJTYPE(*LIB)
             MONMSG     MSGID(CPF0000) EXEC(DO)
                 SNDPGMMSG  MSG('Library does not exist. Command +
                          Cancelled')
                 GOTO       CMDLBL(EXIT)
             ENDDO

             DSPFD      FILE(&LIB/*ALL) TYPE(*MBR) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/QAFDMBR)
             OVRDBF     FILE(QAFDMBR) TOFILE(QTEMP/QAFDMBR)

             CALL       PGM(RGZLIBR) PARM(&LIB &DREC &DPCT &LIST)

             DLTOVR     FILE(QAFDMBR)
             DLTF       FILE(QTEMP/QAFDMBR)

 EXIT:       ENDPGM
--------End of source member----------

source file(member): QCMDSRC(RGZLIB) SRCTYPE(CMD)

             CMD        PROMPT('Reorg Files in Library')
             PARM       KWD(LIBR) TYPE(*NAME) LEN(10) MIN(1) +
                          PROMPT('Library Name:')
             PARM       KWD(DELREC) TYPE(*DEC) LEN(9 0) +
                          PROMPT('Deleted Records threshold')
             PARM       KWD(DELPCT) TYPE(*DEC) LEN(3 0) +
                          PROMPT('Deleted Pct threshold')
             PARM       KWD(LIST) TYPE(*CHAR) LEN(1) DFT(N) +
                          PROMPT('List files reorged? Y/N')
--------End of source member----------



As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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.