Indicator Array

RPG has a built-in array of general purpose indicators. They range from 01-99. The indicators are usually referenced individually but may be addressed as an array. The example below shows a variable pointing to the address of the indicator array.

Free format
.
.
Dcl-S indPtr  pointer  inz( %addr(*in) )  ;

Dcl-DS indicators len(99) based( indPtr ) ;
 ScreenChange     ind      pos(22)        ;
 SflControl       ind      pos(50)        ;
 SflDisplay       ind      pos(51)        ;
 SflInitialize    ind      pos(52)        ;
 SflClear         ind      pos(53)        ;
 SflEnd           ind      pos(54)        ;
 SflDelete        ind      Pos(55)        ;
 SflNxtChange     ind      pos(58)        ;
 SflMSGQdisplay   ind      pos(59)        ;
End-DS ;
.
.
Fixed-format
.
.
     d indPtr          s               *   inz( %addr(*in) )

     d indicators      ds            99    based( indPtr )
     d  ScreenChange                   n   overlay( indicators : 22 )
     d  SflControl                     n   overlay( indicators : 50 )
     d  SflDisplay                     n   overlay( indicators : 51 )
     d  SflInitialize                  n   overlay( indicators : 52 )
     d  SflClear                       n   overlay( indicators : 53 )
     d  SflEnd                         n   overlay( indicators : 54 )
     d  SflDelete                      n   overlay( indicators : 55 )
     d  SflNxtChange                   n   overlay( indicators : 58 )
     d  SflMSGQdisplay...
     d                                 n   overlay( indicators : 59 )

The data structure (indicators) assigns a name to an indicator based on its position in the array. Note that in the fixed format example, the OVERLAY keyword is based on position. The example of the array on the right (Fig. 1) uses the special value of *NEXT rather than specifying a absolute position.

Runtime Arrays

Runtime arrays can be convenient for storing related values to use in calculations. Calculating and storing monthly sales, for instance. It is easy to define an array using the DIM (dimension) keyword with 12 elements instead of creating of 12 individual standalone variables to the monthly totals. 

Dcl-s SalesbyMonth Packed(11:2) Dim(12);

Exec SQL Declare Salescursor Cursor For
      Select sum(sales) From salesfile
      Where yearSold = current_year
      Order by monthSold
      Group by monthSold  
      For Read Only;

Exec SQL Open Statecursor;

For X = 1 to %Elem(SalesbyMonth);
  Exec SQL Fetch Salescursor Into :SalesbyMonth;
  Select;
    When Sqlstate = Endoffile;
     Leave;
    Other;
     SalesbyMonth(X) = sales;
Endsl;

Endfor;

Exec SQL Open Statecursor;

If you do not initialize an array, its initial elemental values will default to the element data type. Numeric fields will be set to zero. Character fields will default to blanks.

Element BIF

The IBM supplied built-in function (BIF) %ELEM will return the number of elements in an array, table, or multiple occurrence data structure. 

%ELEM(table_name)
%ELEM(array_name)
%ELEM(multiple_occurrence_data_structure_name)

RPG and Arrays

Array processing in RPG

Built-in function %SUBARR returns a section of the specified array starting at start-index. The number of elements returned is specified by the optional number-of-elements parameter. If not specified, the number-of-elements defaults to the remainder of the array. The first parameter of %SUBARR must be an array. That is, a standalone field, data structure, or subfield defined as an array. The first parameter must not be a table name or procedure call. The code below illustrates a three hundred element array of 138-byte entries. The first 31 bytes are going to be used to order the sequence of the array entries, after the data has been loaded. 

Fig. 1
.
.
D                 DS                  INZ
     D trlArry                      138a   DIM(300)
     D   traSRT                      31a   Overlay(trlArry)

     D lodArry                        4s 0 DIM(300)

     D                 DS                  INZ
     D trlData                      138a
     D   trxEBD                       8s 0 Overlay(trlData)
     D   trxEBT                       6s 0 Overlay(trlData:*next)
     D   trxGRP                       5s 0 Overlay(trlData:*next)
     D   trxLDT                       8s 0 Overlay(trlData:*next)
     D   trxLDN                       4s 0 Overlay(trlData:*next)
     D   trxTRL                       4a   Overlay(trlData:*next)
     D   trxKDL                      18a   Overlay(trlData:*next)
     D   trxPRD                      12a   Overlay(trlData:*next)
     D   trxLBD                       8s 0 Overlay(trlData:*next)
     D   trxLBT                       6s 0 Overlay(trlData:*next)
     D   trxLPD                       8s 0 Overlay(trlData:*next)
     D   trxLPT                       6s 0 Overlay(trlData:*next)
     D   trxVCD                       8s 0 Overlay(trlData:*next)
     D   trxVCT                       6s 0 Overlay(trlData:*next)
     D   trxEPD                       8s 0 Overlay(trlData:*next)
     D   trxEPT                       6s 0 Overlay(trlData:*next)
     D   trxSCD                       8s 0 Overlay(trlData:*next)
     D   trxSCT                       6s 0 Overlay(trlData:*next)
     D   trxIND                       1a   Overlay(trlData:*next)
     D   trxSTS                       2a   Overlay(trlData:*next)

The code below represents the process--the data structures are cleared (resetting the elements of the array). And an SQL cursor is opened to loop through the data records to load the data structure fields. 

Fig. 2 
.
.                    
          Exec SQL Open TrlCursor;

          TrlCsrOpn = *On;
          CLEAR trlcDS   ;
          CLEAR trlData;
          CLEAR prvData;
          CLEAR CurSchedule;
          CLEAR prvSchedule;
          CLEAR previousSts;

          Dou SQLSTT = SQLstsEOF OR trls > 299;

             Exec SQL
                 Fetch TrlCursor Into :SelectedTRL, :SelectedLOD;

             If SQLSTT =  SQLstsOK;

	 // load trailer data into the data structure     	
	 // When the data fields have been populated
	 // increment the count and move the contents 
         // of the array to the data structure

               TRLS += 1;
                trlArry(trls) = trlData;
            EndIf;

         EndDO;

          // Once the array has been loaded, sort the array
          // and load the subfile using the array elements

          If trls > 0;
             SORTA %subarr(traSRT:1:trls);
          EndIf;

Once the data has been moved to the DS fields, the resulting 138-bytes are pushed to the array. Then the array is sorted, based on the first 31-bytes rather than the entire array element using %SUBARR in conjunction with the SORTA Op code. This will be used to load a subfile for presentation, in the sequence required by the user. How the data is retrived and the sequence in which it was retrieved may be completely different than how the data is displayed.

Array as a Stack

The routines here were developed to mimic a push down stack. Commands entered from a command line were pushed to the stack, then when requested retrieved from the stack. The array served as a repository to push down the command entries as they were entered, then pop the top entry from the stack when requested. The code is archaic but the concept is valid. 

Fig. 3
.
.
      * An array is used for the command stack. This array is
      * defined as 100 elements, each 150 bytes in length.
     D STK             S            150    DIM(100)                             COMMAND STACK
      *---------------------------------------------------------------------
      * BEGIN of work fields added by CONNECTIONS 2000's CVTILERPG utility
      *---------------------------------------------------------------------
     D N               S              3  0
     D R               S              3  0
      *---------------------------------------------------------------------
      * END of work fields added by CONNECTIONS 2000's CVTILERPG utility
      *---------------------------------------------------------------------
      *================================================================
      * @PUSH - ADD TO STACK
      * Move previously executed command to stack. Check the  stack
      * index (SI) and if the entry is greater than the top of the
      * stack (100) restack the array, else increment the index and
      * add the command to the top of the stack. Set the Retreival
      * Index (RI) to equal the SI.
      *================================================================
     C     @PUSH         BEGSR
B001 C                   IF        SI >= #TOP
 001 C                   EXSR      @RESTK
 001 C                   MOVE      COMAND        STK(SI)
X001 C                   ELSE
 001 C                   EVAL      SI = SI + #ONE
 001 C                   MOVEL     COMAND        STK(SI)
E001 C                   ENDIF
     C                   EVAL      RI = SI
     C                   ENDSR
.
.
.
      *================================================================
      * @POP - GET STACK DATA
      * Retrieve the last command from the stack. Retreive the last
      * stack entry and move it to the command field using the
      * Retreival Index (RI). Decrement the RI by one.
      *================================================================
     C     @POP          BEGSR
B001 C                   IF        RI > *ZERO
 001 C                   MOVE      STK(RI)       Z$CMD
 001 C                   EVAL      RI = RI - #ONE
E001 C                   ENDIF
     C                   ENDSR
.
.
.
      *================================================================
      * @RESTK -  RESET STACK ARRARY
      * Move array elements by 1, to make room for addtional entry
      *================================================================
     C     @RESTK        BEGSR
     C                   EVAL      N = 2
     C                   EVAL      R = 1
B001 C                   DOW       N <= #TOP
 001 C                   MOVE      STK(N)        STK(R)
 001 C                   EVAL      R = R + #ONE
 001 C                   EVAL      N = N + #ONE
E001 C                   ENDDO
     C                   ENDSR

Requests to retrieve the entries work from the top down. The first index is decremented until the desired stack entry is found.

Array by Index

Fig. 4
.
.
     P DateText        B                   export
     D DateText        PI            30A
     D  DateType                      1    CONST
     D   DateIn                       8S 0 CONST options(*nopass)

     D  DateAlpha      S              8
     D  DateCode       S              1
     D  DateString     S             30
     D  DateValue      S              8S 0
     D  Date6E         S              8
     D  Date8E         S             10
     D  DayName        S             10
     D  InvalidDate    S               n
     D  MonthName      S             10
     D  ThisMonth      S              2s 0
     D  WeekDay        S              3s 0
     D                 DS
     D DayTable                      70A   Inz('Monday    +
     D                                          Tuesday   +
     D                                          Wednesday +
     D                                          Thursday  +
     D                                          Friday    +
     D                                          Saturday  +
     D                                          Sunday    ')
     D Days                          10A   Dim(7) Overlay(DayTable)
     D                 DS
     D MonthTable                   120    Inz('January   +
     D                                          February  +
     D                                          March     +
     D                                          April     +
     D                                          May       +
     D                                          June      +
     D                                          July      +
     D                                          August    +
     D                                          September +
     D                                          October   +
     D                                          November  +
     D                                          December  ')
     D  Months                       10A   DIM(12) overlay(MonthTable)
     D
      /free
         InvalidDate = *off                                          ;
         IF %parms < 2                                               ;
            DateAlpha = %char(%date():*iso0)                         ;
         ELSE                                                        ;
            DateValue = DateIn                                       ;
            InvalidDate = CheckDate(DateValue:'*ISO')                ;
            IF not InvalidDate                                       ;
               DateAlpha = %editc(DateValue:'X')                     ;
            ENDIF                                                    ;
         ENDIF                                                       ;
         IF not InvalidDate                                          ;
            ThisMonth = %dec(%subst(DateAlpha:5:2):2:0)              ;
            WeekDay   = DayofWeek(%date(DateAlpha:*iso0))            ;
            DayName = Days(WeekDay)                                  ;
            MonthName = Months(ThisMonth)                            ;
            DateString = *blanks                                     ;
            DateCode = UpperCase(DateType:%size(DateType))           ;
            SELECT                                                   ;
               WHEN DateCode = 'D'                                   ;
                  DateString = DayName                               ;
               WHEN DateCode = 'F'                                   ;
                  DateString = %trim(DayName) + ', '                 +
                               %trim(MonthName) + ' '                +
                               %trim(%subst(DateAlpha:7:2)) + ', '   +
                               %trim(%subst(DateAlpha:1:4))          ;
               WHEN DateCode = 'I'                                   ;
                  Date8E = %char(%date():*iso)                       ;
                  DateString = %trim(DayName) + ', ' + Date8E        ;
               WHEN DateCode = 'M'                                   ;
                  DateString = MonthName                             ;
               WHEN DateCode = 'T'                                   ;
                  Date6E = %char(%date():*mdy)                       ;
                  DateString = %trim(DayName) + ', ' + Date6E        ;
               OTHER                                                 ;
                  DateString = 'Unrecognized format.'                ;
            ENDSL                                                    ;
         ELSE                                                        ;
               DateString = 'Invalid date requested.'                ;
         ENDIF                                                       ;
         RETURN DateString                                           ;
      /end-free
     P DateText        E

Array Look Up BIFs

IBM offers an array of built-in functions (BIFs) in RPG to examine arrays. 


%LOOKUP(arg : array | keyed_array_DS {: start_index {: number_of_elements}})
%LOOKUPLT(arg : array  {: start_index {: number_of_elements}})
%LOOKUPGE(arg : array  {: start_index {: number_of_elements}})
%LOOKUPGT(arg : array  {: start_index {: number_of_elements}})
%LOOKUPLE(arg : array  {: start_index {: number_of_elements}})

%LOOKUP
An exact match.
%LOOKUPLT
The value that is closest to arg but less than arg.
%LOOKUPLE
An exact match, or the value that is closest to arg but less than arg.
%LOOKUPGT
The value that is closest to arg but greater than arg.
%LOOKUPGE
An exact match, or the value closest to arg but greater than arg.

LOOKUPxx

Examples from IBM 7.2 

   arr(1) = 'Cornwall';
   arr(2) = 'Kingston';
   arr(3) = 'London';
   arr(4) = 'Paris';
   arr(5) = 'Scarborough';
   arr(6) = 'York';

   n = %LOOKUP('Paris':arr);
   // n = 4

   n = %LOOKUP('Thunder Bay':arr);
   // n = 0 (not found)

   n = %LOOKUP('Kingston':arr:3);
   // n = 0 (not found after start index)

   n = %LOOKUPLE('Paris':arr);
   // n = 4

   n = %LOOKUPLE('Milton':arr);
   // n = 3

   n = %LOOKUPGT('Sudbury':arr);
   // n = 6

   n = %LOOKUPGT('Yorks':arr:2:4);
   // n = 0 (not found between elements 2 and 5)

A note of caution: result BIFs do not react the same as they do for op codes such as CHAIN or READ. The Built-in functions %FOUND and %EQUAL are not set following a %LOOKUP operation. The %LOOKUPxx functions return the array index of the item in the array that matches that matches argument. The value returned is in the form of an unsigned integer (data type U). If no value matches the specified condition, zero is returned.

Array by Index

The array sample in Fig. 4 is simple. The DIM statement is not going to vary--since the Gregorian Calendar, there have always been seven days and twelve months. The procedure is DATETEXT is defined to be exported as one of the procedures in a service program. In this example there is no need to use the %LOOKUPxx BIF. Once the week day and month are derived from the date those numeric variables serve as the index to their respective arrays (DAYS and MONTHS). 

.
.
.
     D  ThisMonth      S              2s 0
     D  WeekDay        S              3s 0
.
.
.
IF not InvalidDate                                          ;
   ThisMonth = %dec(%subst(DateAlpha:5:2):2:0)              ;
   WeekDay   = DayofWeek(%date(DateAlpha:*iso0))            ;
   DayName = Days(WeekDay)                                  ;
   MonthName = Months(ThisMonth)                            ;
   DateString = *blanks                                     ;
   DateCode = UpperCase(DateType:%size(DateType))           ;

Once the procedure has determined there is a valid date, the month and the day of the week are converted to a numeric value. The date text returned as a formatted string. DATESTRING will contain the day name, the month name, or the full text string of the date based on the parameters provided.