Page History

The following RDML program generically searches for employees by surname.   The user specifies all or part of an employee's surname and a resulting list of employees with names matching the request is displayed.

********

...

   Define work variables and browse list to be used
DEFINE     FIELD(#L1COUNT) TYPE(*DEC) LENGTH(7) DECIMALS(0)
DEF_LIST   NAME(#L1) FIELDS((#SURNAME) (#GIVENAME) (#EMPNO)
#ADDRESS1)) COUNTER(#L1COUNT)
********

...

   Loop until terminated by EXIT or CANCEL
BEGIN_LOOP
********

...

   Get surname to search for
REQUEST    FIELDS(#SURNAME)
********

...

   Build list of generically identical names
CLR_LIST   NAMED(#L1)
SELECT     FIELDS(#L1) FROM_FILE(PSLMSTV1)
           WITH_KEY(#SURNAME) GENERIC(*YES)
ADD_ENTRY  TO_LIST(#L1)
ENDSELECT
********   If names found,

...

 display list to user
IF          COND('#L1COUNT *GT 0')
DISPLAY    BROWSELIST(#L1)
********

...

   else issue error indicating none found
ELSE
MESSAGE    MSGTXT('No employees have a surname matching request')
ENDIF
********

...

   Loop back and request next name to search for
END_LOOP

This program will work just fine, but what if the user inputs a search name of "D", and 800 employees working for the company have a surname that starts with "D".

...

New or modified commands are indicated by →.

    ********

...

   Define work variables and browse list to be used
    DEFINE     FIELD(#L1COUNT) TYPE(*DEC) LENGTH(7) DECIMALS(0)
--> DEFINE     FIELD(#L1PAGE) TYPE(*DEC) LENGTH(7) DECIMALS(0)
--> DEFINE     FIELD(#L1TOP) TYPE(*DEC) LENGTH(7) DECIMALS(0)
--> DEFINE     FIELD(#L1POS) TYPE(*CHAR) LENGTH(7)
--> DEF_LIST   NAME(#L1) FIELDS((#SURNAME) (#GIVENAME) (#EMPNO) (#ADDR+
               ESS1)) COUNTER(#L1COUNT) PAGE_SIZE(#L1PAGE) TOP_ENTRY(#+
               L1TOP) SCROLL_TXT(#L1POS)
    ********

...

   Loop until terminated by EXIT or CANCEL
    BEGIN_LOOP

...

    ********

...

   Get surname to search for
    REQUEST    FIELDS(#SURNAME)

...

    ********

...

   Build list of generically identical names
    CLR_LIST   NAMED(#L1)
--> CHANGE     FIELD(#IO$KEY) TO(UP)
--> CHANGE     FIELD(#L1TOP) TO(1)
--> SELECT     FIELDS(#L1) FROM_FILE(PSLMSTV1)
               WITH_KEY(#SURNAME) GENERIC(*YES)
-->            WHERE('#IO$KEY = UP') OPTIONS(*ENDWHERE)
--> EXECUTE    SUBROUTINE(DISPLAY) WITH_PARMS('''More...''')
    ADD_ENTRY  TO_LIST(#L1)
    ENDSELECT

...

     ********   If names found,

...

 display list to user
    IF        COND('#L1COUNT *GT 0')
--> EXECUTE    SUBROUTINE(DISPLAY) WITH_PARMS('''Bottom''')
     ********

...

   else issue error indicating none found
    ELSE
    MESSAGE    MSGTXT('No employees have a surname matching request')
    ENDIF
    ********

...

   Loop back and request next name to search for
    END_LOOP
    ********
    ********   Display names if page is full or list is complete
      ********
--> SUBROUTINE NAME(DISPLAY) PARMS(#L1POS)
--> DEFINE     FIELD(#L1REMN) TYPE(*DEC) LENGTH(5) DECIMALS(5)
--> CHANGE     FIELD(#L1REMN) TO('#L1COUNT / #L1PAGE')
--> IF        COND('(#L1COUNT *NE 0) *AND (#IO$KEY = UP) *AND ((#L1PO+
              S = ''Bottom'') *OR (#L1REMN *EQ 0.00000))')
--> DOUNTIL    COND('(#L1POS *NE ''Bottom'') *OR (#IO$KEY *NE UP)')
--> DISPLAY    BROWSELIST(#L1) USER_KEYS((*ROLLUP))
--> ENDUNTIL
--> CHANGE     FIELD(#L1TOP) TO('#L1TOP + #L1PAGE')
--> ENDIF
--> ENDROUTINE

The "page at a time" technique described here can be applied to just about any situation where a browse list is used and can considerably improve performance in most of them.

...