Learn how to control the RGZPFM operation.

This is the fifth in a series of articles on detecting that certain messages have been sent on your system and then making processing decisions based on those messages. The underlying technology being used is known as Watch support and became available with V5R4.

The first article, "One Approach to System Automation," introduced the Start Watch (STRWCH) command and provided the source for a user exit program to run when local system time changed due to Daylight Saving Time transitions. The second article, "Handling System Changes Automatically," discussed the internals of that user exit program. The third article, "Re-enable Disabled User Profiles," provided further examples of the automation capabilities available with watches. The fourth article, "Selectively Using RGZPFM on Files," introduced a watch exit program that runs when a file exceeds its specified DLTPCT value. If you have not previously read these articles, especially the fourth one, you should do so before reading the current article. In this article, we will look at how to process the control file maintained by the WCHCPF4653 exit program of the article "Selectively Using RGZPFM on Files" and conditionally run RGZPFM against selected file members.

To start, we introduce a new logical file, RGZPFMLST1, over the physical file RGZPFMLST. The DDS for RGZPFMLST1 is provided below:

                R RECORD                    PFILE(RGZPFMLST)

                K REORG                                     

To create the logical file RGZPFMLST1 into library VINING you would use the following CRTLF command:

CRTLF FILE(VINING/RGZPFMLST1) SRCFILE(QDDSSRC)

The RGZPFMLST1 logical file allows us to access, by key, only those control records indicating that a RGZPFM may be needed. This is accomplished by reading only those records in which REORG is set to the value 'Y'.

The source for the Purge Deleted Records (PRGDLTRCDS) program is provided below:

fRgzPFMLst1if   e           k disk                                  

fRgzPFMLst uf   e           k disk    rename(Record :UpdRcd)        

dPrgDltRcds       pr                  extpgm('PRGDLTRCDS')          

dPrgDltRcds       pi                                                 

dRtvMbrD          pr                  extpgm('QUSRMBRD')            

d RcvVar                         1    options(*varsize)             

d LenRcvVar                     10i 0 const                         

d Format                         8    const                         

d QualFileName                  20    const                         

d MbrName                       10    const                         

d Overrides                      1    const                         

d QUSEC                               likeds(QUSEC) options(*nopass)

d FndMbrPrc                      1    const options(*nopass)        

dCmdExc           pr                  extpgm('QCMDEXC')         

d Command                    65535    const                     

d LenCmd                        15  5 const                     

d IGC                            3    const options(*nopass)    

 /copy qsysinc/qrpglesrc,qusrmbrd                               

 /copy qsysinc/qrpglesrc,qusec                                  

dErrCde           ds                  qualified                 

d Base                                likeds(QUSEC)             

d MsgRplDta                    256                              

dCommand          s            256                              

 /free                                                          

  monitor;      

  // Turn off API escape messages as some errors are to be expected   

  // and there is no reason to go through exception handling          

  ErrCde.Base.QUSBPRV = %size(ErrCde);                                

  setll 'Y' Record;                                                   

  reade 'Y' Record;                                                    

  dow not %eof(RgzPFMLst1);                                           

      // Verify that library/file/mbr can be found                    

      // (use MBRD0300 for test as we may need it for DltPctSts anyway)

      RtvMbrD(QUSM0300 :%size(QUSM0300) :'MBRD0300'                   

              :(File + Library) :Member :'0' :ErrCde);                

      if ErrCde.Base.QUSBAVL > 0;           // Error getting Mbr Info?

         select;                                                      

            when ((ErrCde.Base.QUSEI = 'CPF9810') or   // no lib      

                  (ErrCde.Base.QUSEI = 'CPF9812') or   // no file     

                  (ErrCde.Base.QUSEI = 'CPF9815'));    // no mbr     

                  // If not found, just change REORG to 'N'            

                  // and get next control record at endsl            

                  chain(e) (Library :File :Member) UpdRcd;            

                  select;                                             

                     when %error;           

                          dsply ('PRGDLTRCDS: Environment error 1A: ' +

                                 %char(%status));                                                 

                     when not %found(RgzPFMLst);                      

                          dsply 'PRGDLTRCDS: Environment error 2A';   

                     when %found(RgzPFMLst);                          

                          Reorg = 'N';                                

                          update UpdRcd;                              

                     other;                                           

                          dsply 'PRGDLTRCDS: Environment error 3A';   

                  endsl;                                              

            when ((ErrCde.Base.QUSEI = 'CPF3C22') or                 

                  (ErrCde.Base.QUSEI = 'CPF3C27'));                  

                  // If info not available, try again next time.  

                  // For now, just get the next control rcd at endsl  

            other;                                                   

                  // Unusual error encountered, report it but        

                  // try again next time. For now, just get the      

                  // next control record at endsl                    

                  dsply ('PRGDLTRCDS received ' +                     

                         ErrCde.Base.QUSEI);                         

                  dsply ('   for ' + %trimr(Library) + '/' +         

                         %trimr(File) + ',' + Member);               

         endsl;                                                       

         // Get the next control record and re-enter DOW loop        

         reade *Key Record;                                           

         iter;                                                       

      endif;                                                         

      // Is REORG conditioned by current percentage of deleted rcds? 

      if DltPctSts = 'C';                                            

         // check if DLTPCT still > *NONE                            

         if QUSMPDR > 0;                                             

            // if less than DLTPCT, then set REORG to 'N' and get     

            // next control record                                    

            if (((QUSNDRU01/(QUSNDRU01 + QUSNCRU00)) * 100) <=       

                  QUSMPDR);                                          

               chain(e) (Library :File :Member) UpdRcd;               

               select;                                                

                  when %error;                              

                       dsply ('PRGDLTRCDS: Environment error 1B: ' + 

                              %char(%status));                                  

                  when not %found(RgzPFMLst);                         

                       dsply 'PRGDLTRCDS: Environment error 2B';      

                  when %found(RgzPFMLst);                             

                       Reorg = 'N';                                   

                       update UpdRcd;                                 

                  other;                                              

                       dsply 'PRGDLTRCDS: Environment error 3B';      

               endsl;                                                 

               reade *KEY Record;                                    

               iter;                                                 

            else;                                                    

               // Continue to RGZPFM                                

            endif;                                                  

         else;                                                      

            // Continue to RGZPFM                                   

         endif;                                                     

      endif;                                                        

      // Everything is go for RGZPFM                                

      monitor;                                                      

         // Try for 10 seconds to get exclusive allocate on member  

         Command = 'ALCOBJ OBJ((' + %trimr(Library) + '/' +         

                   %trimr(File) + ' *FILE *EXCL ' +                 

                   %trimr(Member) + ')) WAIT(10)';                   

         CmdExc(Command :%len(%trimr(Command)));                    

         monitor;                                                      

            Command = 'RGZPFM FILE(' + %trimr(Library) + '/' +         

                      %trimr(File) + ') MBR(' + %trimr(Member) + ')';  

            CmdExc(Command :%len(%trimr(Command)));                    

            chain(e) (Library :File :Member) UpdRcd;              

            select;                                               

               when %error;                               

                    dsply ('PRGDLTRCDS: Environment error 1C: ' +  

                           %char(%status));                                 

               when not %found(RgzPFMLst);                        

                    dsply 'PRGDLTRCDS: Environment error 2C';     

               when %found(RgzPFMLst);                            

                    Reorg = 'N';                                  

                    update UpdRcd;                                

               other;                                             

                    dsply 'PRGDLTRCDS: Environment error 3C';     

            endsl;                                                              

         on-error;                          // RGZPFM failed           

            // Need to DCLOBJ as previous ALCOBJ was OK, which is       

            //   done by falling through to following code             

            // Error output: Try again next time by no update to UpdRcd

         endmon;                                                      

         Command = 'DLCOBJ OBJ((' + %trimr(Library) + '/' +           

                   %trimr(File) + ' *FILE *EXCL ' +                   

                   %trimr(Member) + '))';                             

         CmdExc(Command :%len(%trimr(Command)));                      

      on-error;                             // ALCOBJ or DLCOBJ failed

         // Try again next time, for now just go to next control rcd  

         //   after showing full object name that failed              

         // Assumption is that it's ALCOBJ that failed                

         dsply ('Allocation failure: ' +                              

                %trimr(Library) + '/' + %trimr(File) + ',' + Member); 

      endmon;                                                         

      reade *KEY Record;                                              

  enddo;                                                              

  *inlr = *on;        

  return;             

  on-error;                                       

     dsply 'PRGDLTRCDS: Unexpected failure';      

     dsply 'See job log for previous messages';   

     *inlr = *on;                                  

     return;                                      

  endmon;                                         

 /end-free            

Assuming that the target library you used when creating the files RGZPFMLST and RGZPFMLST1 is in your current library list, you can create the program PRGDLTRCDS into library VINING using the CRTBNDRPG command:

CRTBNDRPG PGM(VINING/PRGDLTRCDS)

As there are no parameters for PRGDLTRCDS, calling it is quite straightforward. The actual call, in a production environment, would most likely be done through a job scheduler set to run PRGDLTRCDS during off hours. Note, though, that I do not consider this level of PRGDLTRCDS to be production-ready. In the previous article of this series, several areas were called out that need functional improvement. The provided level of WCHCPF4653 and PRGDLTRCDS is sufficient to demonstrate how watches might be applied within your business, but you should certainly add more to the programs also.

Looking at the flow of PRGDLTRCDS, the program first begins a global monitor group. The PRGDLTRCDS program, as you will see, does check for and handle specific and anticipated errors. This global monitor is to catch any unanticipated errors that may occur.

After enabling the monitor group, PRGDLTRCDS then sets the Bytes provided field of the API error code structure, ErrCde.Base.QUSBPRV, to the size of the error code structure ErrCde. ErrCde is previously defined as being likeds(QUSEC) with an additional 256 bytes of storage allocated for any possible error message replacement data that an API might return. This setting of Bytes provided to a non-zero value is to avoid the overhead associated with exception handling. The program anticipates that some errors may be encountered during subsequent API calls and is simply turning off exception handling whenever the ErrCde error code data structure is used when calling an API.

PRGDLTRCDS then positions the input file RGZPFMLST1 to the first record of the file with a REORG value of 'Y' (REORG is the key field for RGZPFMLST1) and reads the record. The program now enters into a DOW loop, which is conditioned by a record with a REORG value of 'Y' having been successfully read.

The RGZPFMLST1 file is defined as being input-only so that a record lock will not be held by PRGDLTRCDS while processing the control record. A concern that I have is that the member being referenced may very well be open in another job. If this is true, then we do not want the WCHCPF4653 exit program having to wait for a record lock if the other job closes the member and message CPF4653 is sent as part of close processing while PRGDLTRCDS still holds a lock on the member record. Using an input-only file avoids this situation.

PRGDLTRCDS could have opened RGZPFMLST1 as update-capable and then read the record with an 'N' (no lock) extender, but then we have the problem when we do need to update the record that there is no RPG support for explicitly reading the same record. And the key for RGZPFMLST1 is not unique so we cannot be sure of re-reading the same record if we reposition the file. The physical file RGZPFMLST, however, does provide a unique key, which is why this file is also used by PRGDLTRCDS and is opened as update-capable. We will see how it is used shortly.

Within the DOW loop, the program first verifies that the library, file, and member names read from the RGZPFMLST1 record are still valid--that is, that the library hasn't been deleted, the file renamed, the member removed, etc. since the WCHCPF4653 exit program had written or updated the control record. This verification is done by calling the Retrieve Member Description (QUSRMBRD) API. This API is documented here and is a standard Retrieve type of API, so we will not go into the details of calling it.

The QUSRMBRD API supports a variety of formats. While format MBRD0100 is the fastest to retrieve, PRGDLTRCDS is using format MBRD0300 for this verification. MBRD0300 is being used as this format returns the current value of the DLTPCT attribute for the file and this value may be used later in the program. An alternative, and one that I seriously considered, was to use format MBRD0100 at this point in the program in order to validate the library, file, and member name and then only go through the additional processing required for format MBRD0300 if and when the program actually needed to determine the current DLTPCT value. Either approach will work. The performance question is whether the expense of using format MBRD0300 all of the time is better or worse than calling MBRD0100 all of the time and then, for those control records with field DLTPCTSTS set to a value of 'C', also calling the QUSRMBRD API a second time using format MBRD0300. The answer is going to vary based on how many DLTPCTSTS 'C' values are encountered in the RGZPFMLST1 file. I decided to simplify the program and just call the API one time per the RGZPFMLST1 record being processed.

After calling the QUSRMBRD API, the program determines if any error-related information was returned (that is, ErrCde.Base.QUSBAVL is greater than 0). If so, PRGDLTRCDS enters a select group in order to handle the various errors. At the conclusion of this error-related select group, the program unconditionally reads the next record from RGZPFMLST1 and re-enters the DOW loop to process the next member record.

The first when operation covers errors that are related to the library, file, or member not being found; those errors are addressed by changing the RGZPFMLST control field REORG to 'N', indicating the reorganization of the member is no longer needed. The assumption is that if and when the member ever shows up on the system again, at that time the WCHCPF4653 exit program will be in a position to set REORG back to 'Y' if necessary. In terms of performing the update to the REORG field, PRGDLTRCDS randomly reads the RGZPFMLST file based on the Library, File, and Member values found in the current RGZPFMLST1 record, sets REORG to 'N', and then updates the RGZPFMLST file. Similar to the WCHCPF4653 program, if the random read to RGZPFMLST fails, a message specific to the chain attempt is displayed. Given how WCHCPF4653 and PRGDLTRCDS never hold an update lock on a RGZPFMLST record longer than the time to set REORG to the appropriate value, the program should never find the %error condition to be true. But a developer should consider even the "never happen" conditions, and having these checks in the code show that they have been considered and dictate how they will be handled.

The second when operation covers errors related to the member existing but the member information not being retrieved; they are addressed by doing nothing. The member may well still need reorganization, but we cannot access it. So the program will just leave the REORG field set to 'Y', and the next time PRGDLTRCDS runs, it will try to access the member information again. As this type of error is most likely timing-related and of a very short duration, an alternative to this would be to run through the current DOW loop a second time--that is, process all of the RGZPFMLST1 records that can be processed, and when done, reposition RGZPFMLST1 back to the first of the remaining REORG = 'Y' records and attempt to process them again. The current program simply waits until the next scheduled run of PRGDLTRCDS.

The other operation of the select group handles the error situation in the same manner as the previous when operation; the program will retry the member the next time it runs. The difference is that here the program also displays what error was returned, the assumption being that these errors are less likely to correct themselves in time; an operator or developer may be needed.

As mentioned earlier, independent of the type of error encountered, PRGDLTRCDS will do no further processing of the current RGZPFMLST1 record. Upon completing the error-related select group, the program reads the next REORG = 'Y' record and re-enters the DOW loop.

If no error was returned by the QUSRMBRD API, the program examines DLTPCTSTS to determine if the current percentage of deleted records should be used as the basis for reorganizing the member (DltPctSts = 'C') or if just the fact that message CPF4653 was sent at some point in the past is sufficient. If the reorganization is to be based on the current percentage, the program checks to make sure the DLTPCT attribute has not been changed to the special value *NONE (represented as the value 0). If DLTPCT is not 0, PRGDLTRCDS calculates the current percentage of deleted records within the file. If this is less than DLTPCT, PRGDLTRCDS updates RGZPFMLST to set the REORG field to 'N', reads the next RGZPFMLST1 control record, and re-enters the DOW loop in order to process the next member.

Having completed all checks for the current control record member, PRGDLTRCDS is now ready to purge the deleted records from the current member. We are, unfortunately, also out of space for this month's column. Next month, we'll look at the rest of the PRGDLTRCDS program. In addition, we'll look at some of the considerations when using watches.

Meanwhile, if you have other API questions, send them to me at This email address is being protected from spambots. You need JavaScript enabled to view it.. I'll see what I can do about answering your burning questions in future columns.

Bruce Vining is president and co-founder of Bruce Vining Services, LLC, a firm providing contract programming and consulting services to the System i community. He began his career in 1979 as an IBM Systems Engineer in St. Louis, Missouri, and then transferred to Rochester, Minnesota, in 1985, where he continues to reside. From 1992 until leaving IBM in 2007, Bruce was a member of the System Design Control Group responsible for OS/400 and i5/OS areas such as System APIs, Globalization, and Software Serviceability. He is also the designer of Control Language for Files (CLF).A frequent speaker and writer, Bruce can be reached at This email address is being protected from spambots. You need JavaScript enabled to view it.. 

---

MC Press books written by Bruce Vining available now on the MC Press Bookstore.

		IBM System i APIs at Work Leverage the power of APIs with this definitive resource. List Price $89.95 Now On Sale

Also Read

The API Corner: Moving Jobs Within and Across Job Queues

The API Corner: What Time Zone Do You Want That Date and Time In?

The API Corner: How Do You Want That Date and Time?