RPG IV Examples

2011-07-04T23:10:00.000-07:00

Welcome to my RPG examples Blog. This is intended as a way for the common, real world RPG programmer to exchange programming examples, techniques and stories about work related problems and solutions.

Mostly you will find free format RPG (RPG IV) code. These examples are for the ILE compilers. I no longer use subruotines but only procedures in a highly modular environment.

The days of programs with 8000 lines of code are gone forever.   We now create programs with a simple main program entry point to set the environment and then calls to multiple modules as necessary.

Consider the following code for the main entry point of program UPC060:

      * +-----------------------------------------------------------------+
      * + Program Id.......: UPC060                                       +
      * + Module...........: UPC060                                      +
      * + Date Written.....: 09/25/2007                                   +
      * + Author...........: Daniel Batista                               +
      * + Platform.........: OS/400                                       +
      * + OS Version.......: V5R3M0 or Later                              +
      * + Description......: UPC Invoice Item Recoding Program.           +
      * +                       Program Main Entry Point Module.          +
      * +                                                                 +
      * + Compile Inst.....:                                              +
      * +    CRTRPGMOD MODULE(lib/UPC060) SRCFILE(/QRPGLESRC)            +
      * +    CRTPGM PGM(lib/UPC060) BNDDIR(EDITBNDDIR) ACTGRP(QILE)       +
      * +       ALWLIBUPD(*YES)                                           +
      * +                                                                 +
      * + Message File.....: N/A                                          +
      * +    Prefix........:                                              +
      * +                                                                 +
      * + Service Programs Used:                                          +
      * +                                                                 +
      * +-----------------------------------------------------------------+
      * + Indicator Usage..:                                              +
      * +                                                                 +
      * +    Standard to All Interactive programs and modules:            +
      * +       35   = Subfile Next Changed Indicator                     +
      * +       36-38= Reserved for Subfile Usage (Available)             +
      * +       39   = FRCDTA Display Keyword                             +
      * +       40-48= Reserved for Program Wide (Non Session Dependend) +
      * +       49   = Program called in Inquiry Mode                     +
      * +       88   = Color White for All Subfile Records                +
      * +                                                                 +
      * +    Specific to this module:                                     +
      * +       None                                                      +
      * +                                                                 +
      * +-----------------------------------------------------------------+
      * + Modification Log.:                                              +
      * +    09/25/2007: Daniel Batista                                  +
      * +       - Created Original Version                                +
      * +                                                                 +
      * +-----------------------------------------------------------------+
      * -----------------> Compiler Directives <-------------------
     H Thread(*Serialize)
     H AlwNull(*USRCTL)
     H Copyright('Program UPC060. +
     H           Copyright(c) DB Consulting. 2001-2008. +
     H           UPC Invoice Item Recoding. Main Entry Point Module. +
     H           Version 1.0. Version Date 11/01/2007.        ')



      * ----------------> Data Definition Area <------------------
      * --> Main Program Prototype
     D/Copy UPC060_P

      * --> Subfile Driver Module
     D/Copy UPC060M1_P

      * --> Prototype for UPC060C
     D/Copy UPC060C_P

      * ----> Locally Defined Prototyped Functions and Procedures
      * ------> Module Level Constants
      * ------> Module Level Date, Time and TimeStamp Variables
      * ------> Module Level Numeric Variables

      * ------> Module Level Character Variables

      * ------> Module Level Boolean Variables
     D True            S               N   Inz(*On)
     D False           S               N   Inz(*Off)

      * ------> Module Arrays
      * ------> Module Level Data Structures

      * Main Program Interface Definition
     D UPC060          PI
     D piExitKey                     2A
     D piSortType                    1A   Const Options(*NoPass)

      /Free

         // Set Program Overrides
         UPC060C(True);

         // Calls Subfile Driver. Display All Files List
         If %Parms() >= 2;
            UPC060M1(piExitKey: piSortType);
         Else;
            UPC060M1(piExitKey);
         EndIf;

         // Remove Program Overrides
         UPC060C(False);

         // End Program
         *InLr = True;

      /End-Free

Setting a Range of Indicators Using a FOR Loop

2011-07-04T07:36:00.000-07:00

Ok. Let's talk about indicators. No matter what you do you still need indicators in RPG. In fact, if you are using SDA and green screens you still need them.

Over many years I found that I need more precision when dealing with indicators for green screens. Normally I reserve indicators 1-39 for display files usage. I also dedicate indicators 40-49 to store session independent status. We can now use boolean variables of course but still it is nice to have indicators. Usually indicators 50-89 are reserved for field attributes.

In order to have more control over the setting of indicators I created the following sub-procedure SetInds:

      * +----------------------------------------------------------------+
      * + Function/Proc...: SetInds                                     +
      * + Type............: SubProcedure                                +
      * + Author..........: Daniel Batista (DB Consulting)              +
      * + Version.........: 1.0                                         +
      * + Date Written....: 06/25/2004                                  +
      * + Description.....: Sets Indicators to True or False            +
      * +                                                                +
      * + Modification Log:                                              +
      * +    06/25/2004. Daniel Batista (DB Consulting)                 +
      * +       - Created Original Version                               +
      * +                                                                +
      * +----------------------------------------------------------------+

     P SetInds         B
     D SetInds         PI
     D lpiFrmInd                     3U 0 Const
     D lpiToInd                      3U 0 Const
     D lpiSetOnOff                    N   Const
     D lpiUseNamInd                   N   Const Options(*NoPass)

      * ------> Local Variables
     D lIx            S              3U 0

      /Free
         // --> Proceed To set Indicator Status
         For lIx = lpiFrmInd to lpiToInd;
            *In(lIx) = lpiSetOnOff;
            If %Parms() = 4;
               If lpiUseNamInd;
                  AllIndics(lIx) = lpiSetOnOff;
               EndIf;
            EndIf;
         EndFor;
      /End-Free

The prototype for this procedure is:

     D SetInds         PR
     D FrmInd                        3U 0 Const
     D ToInd                         3U 0 Const
     D SetOnOff                       N   Const
     D UseNamedInds                   N   Const Options(*NoPass)

Please note the 4th parameter which is optional. If passed the procedure will also set the status of the named indicators area. I always create a named indicator area with the module level array name AllIndics. The named indicators area is defined like this:

      * Display File
     FDspFile   CF   E             WorkStn
     F                                     UsrOpn
     F                                     InfDs(dsWsFbck)
     F                                     IndDs(NamedIndics)
     F                                     Sfile(Sfl01:mS1RecNum)
     F                                     Sfil(SflD1:mD1RecNum)
      * ------> Module Level Arrays
     D NamedIndics     DS
     D AllIndics                      N   Overlay(NamedIndics: 1) Dim(99)
     D* Subfile Record and Control Indicators
     D in30_SflClr                     N   Overlay(NamedIndics: 30)
     D in33_SflDsp                     N   Overlay(NamedIndics: 33)
     D in34_SflEnd                     N   Overlay(NamedIndics: 34)
     D in35_SflNxtChgd...
     D                                 N   Overlay(NamedIndics: 35)
     D in36_SflMode                    N   Overlay(NamedIndics: 36)
     D
     D in39_ForceDisplay...
     D                                 N   Overlay(NamedIndics: 39)

This is how you use this:
         SetInds(50: 99: False: True);     // Clear Attribute Indicators

In this case we are setting indicators 50 through 99 to *OFF and we are also setting the named indicators area.

Converting a Date (Even If Invalid) To The Proper Format in RPG IV

2011-07-03T22:09:00.000-07:00

So you are dealing with an old file and in that file there is a date field. All cool but then you realize that this file is getting to you via a flat file and the customer that is sending it has no idea how to create a valid date and most of the times the dates are correct but sometimes they are not. They could be blank or contain the month, day or year in the wrong place.

The thing is your company wants a display program to allow the correction of the data the customers are sending. So you have a problem. You cannnot use a proper date field because the date in the file could be invalid. You cannot use the %DATE or the %DEC to play with the date because they won't work. So what do you do?

Well I had this exact problem. I had to display these fields on the screen and then allow correction into a proper date. So I created these functions. I added them to a service program but they can be used as internal functions in OPM mode (Non-ILE) as long as you use RPG IV:

Here they are:

      // +----------------------------------------------------------------+
      // + Procedure CvtDteToMDYY. Convert Date from YYYYMMDD to MMDDYYYY +
      // +     Note: Must Do it This way because date could be invalid    +
      // + Author.: Daniel Batista                                       +
      // + Version: 1.0                                                  +
      // + Date...: 12/14/2006                                           +
      // +                                                                +
      // + Modification Log:                                              +
      // +    12/14/2006. Daniel Batista (DB Consulting)                 +
      // +       - Created Original Version                               +
      // +----------------------------------------------------------------+
     P CvtDteToMDYY    B
     D CvtDteToMDYY    PI             8S 0
     D piDteInYYMD                   8S 0 Const

      * -----> Locally Defined Variables
     D laWkInDte       S              8A
     D laWkOutDte      S              8A

      /Free
         // Convert Date from YYYYMMDD to MMDDYYYY
         laWkInDte = %EditC(piDteInYYMD: 'X');    // Convert Date to String
         laWkOutDte = %SubSt(laWkInDte: 5: 2) + %SubSt(laWkInDte: 7: 2) +
                      %SubSt(laWkInDte: 1: 4);

         Return %Dec(laWkOutDte: 8: 0);
      /End-Free

     P CvtDteToMDYY    E

      // +----------------------------------------------------------------+
      // + Procedure CvtDteToYYMD. Convert Date from MMDDYYYY to YYYYMMDD +
      // +     Note: Must Do it This way because date could be invalid    +
      // +                                                                +
      // + Author.: Daniel Batista                                       +
      // + Version: 1.0                                                  +
      // + Date...: 12/14/2006                                           +
      // +                                                                +
      // + Modification Log:                                              +
      // +    12/14/2006. Daniel Batista (DB Consulting)                 +
      // +       - Created Original Version                               +
      // +                                                                +
      // +----------------------------------------------------------------+
     P CvtDteToYYMD    B
     D CvtDteToYYMD    PI             8S 0
     D piDteInMDYY                   8S 0 Const

      * -----> Locally Defined Variables
     D laWkInDte       S              8A
     D laWkOutDte      S              8A

      /Free
         // Convert Date from MMDDYYYY to YYYYMMDD
         laWkInDte = %EditC(piDteInMDYY: 'X');    // Convert Date to String
         laWkOutDte = %SubSt(laWkInDte: 5: 4) + %SubSt(laWkInDte: 1: 2) +
                      %SubSt(laWkInDte: 3: 2);

         Return %Dec(laWkOutDte: 8: 0);
      /End-Free

     P CvtDteToYYMD    E

Here are the prototypes for the functions:
     D CvtDteToMDYY    PR             8S 0
     D DteInYYMD                     8S 0 Const

     D CvtDteToYYMD    PR             8S 0
     D DteInMDYY                     8S 0 Const

This example converts a date field into YYYYMMDD format:
      /Free
         If ScInvDte <> *Zero;
            HInvDt = CvtDteToYYMD(ScInvDte);
         EndIf;
      /End-Free