Files Involved
Physical file DEMNAME (demonstration name and address file) keyed by DEMNAC and an associated logical view called DEMNAMEN (keyed by DEMNAM).
Field | Type | Length | Description |
|---|---|---|---|
DEMNAC | A | 7 | Name and address code |
DEMNAM | A | 25 | Full name |
DEMAD1 | A | 25 | Address line 1 |
DEMAD2 | A | 25 | Address line 2 |
DEMAD3 | A | 25 | Address line 3 |
DEMPCD | A | 4 | Post/zip code |
RDML Program / Subroutine
The following program is intended to act as a "search" subroutine for any caller program.
It is not intended that it be invoked directly by a user. Any caller program that asks the user to specify a name and address "code" can call this subroutine to allow the user to search through the name and address file by customer name and select the one required.
The selected customer "code" and name are then exchanged back into the caller program's fields for subsequent processing.
The particularly useful thing about this program is that not only can it roll forwards a "page at a time", it can roll backwards a "page at a time" (even past the original starting point), and it allows the user to "jump around" anywhere in the file at any time.
********** Define work variables and constants
DEFINE #PAGESIZE REFFLD(#LISTCOUNT) DEFAULT(14)
DEFINE #LISTSIZE REFFLD(#LISTCOUNT)
DEFINE #WORKSIZE REFFLD(#LISTCOUNT)
DEFINE FIELD(#SEARCHNAM) REFFLD(#DEMNAM)
LABEL('Search for')
DEFINE FIELD(#TOPPAGNAM) REFFLD(#DEMNAM) DEFAULT(X'FF')
DEFINE FIELD(#BOTPAGNAM) REFFLD(#DEMNAM) DEFAULT(*BLANKS)
********** Define identical list to display and list to work with
DEF_LIST NAME(#LIST01) FIELDS((#SELECTOR
*SELECT)(#DEMNAC)(#DEMNAM)(#DEMAD1)(#DEMPCD))
COUNTER(#LISTSIZE)
DEF_LIST NAME(#WORK01)
FIELDS((#DEMNAC)(#DEMNAM)(#DEMAD1)(#DEMPCD))
COUNTER(#WORKSIZE) TYPE(*WORKING) ENTRYS(14)
********** Define a permanent exchange list and file open options
EXCHANGE FIELDS(#DEMNAC #DEMNAM) OPTION(*ALWAYS)
OPEN FILE(DEMNAMEN) USE_OPTION(*ONDEMAND)
********** Process search requests until a name is selected or
********** function key 24 is used to end the program
BEGIN_LOOP
REQUEST FIELDS((#SEARCHNAM)) BROWSELIST(#LIST01)
EXIT_KEY(*NO) MENU_KEY(*NO) USER_KEYS((*ROLLUP
'Up')(*ROLLDOWN 'Down') (24 'End'))
CASE OF_FIELD(#IO$KEY)
WHEN ('= UP') /* Roll up key */
EXECUTE ROLL (UP #BOTPAGNAM)
WHEN ('= DN') /* Roll down key */
EXECUTE ROLL (DOWN #TOPPAGNAM)
WHEN ('= ''24''') /* Fnc key 24 */
CHANGE FIELD(#DEMNAC) TO('''?''')
CHANGE FIELD(#DEMNAM) TO(*BLANKS)
RETURN
OTHERWISE /* Enter key */
SELECTLIST #LIST01 GET_ENTRYS(*SELECT)
RETURN
ENDSELECT
EXECUTE ROLL (UP #SEARCHNAM)
ENDCASE
END_LOOP
********** ROLL : Roll page backwards/forwards
********** DIRECTION : Direction to roll (UP/DN)
********** STARTNAM : Name at which to start roll
SUBROUTINE ROLL PARMS((#DIRECTION *RECEIVED)
(#STARTNAM *RECEIVED))
DEFINE FIELD(#DIRECTION) TYPE(*CHAR) LENGTH(4)
DEFINE FIELD(#STARTNAM) REFFLD(#DEMNAM)
CLR_LIST NAMED(#WORK01)
********* Handle a roll up request
IF COND('#DIRECTION = UP')
SELECT FIELDS((#WORK01)) FROM_FILE(DEMNAMEN)
WHERE('#WORKSIZE *LT #PAGESIZE')
WITH_KEY(#STARTNAM) OPTIONS(*STARTKEY
*ENDWHERE)
ADD_ENTRY TO_LIST(#WORK01)
ENDSELECT
********* Handle a roll down request
ELSE
SELECT FIELDS((#WORK01)) FROM_FILE(DEMNAMEN)
WHERE('#WORKSIZE *LT #PAGESIZE')
WITH_KEY(#STARTNAM)
OPTIONS(*STARTKEY *ENDWHERE *BACKWARDS)
ADD_ENTRY TO_LIST(#WORK01)
ENDSELECT
SORT_LIST NAMED(#WORK01) BY_FIELDS((#DEMNAM)) /* Important */
ENDIF
********* Map work list to browse list for display
CLR_LIST NAMED(#LIST01)
SELECTLIST NAMED(#WORK01)
ADD_ENTRY TO_LIST(#LIST01)
ENDSELECT
********* Set/save pointers to top and bottom of displayed page
IF COND('#WORKSIZE = 0')
CHANGE FIELD(#TOPPAGNAM) TO(X'FF')
CHANGE FIELD(#BOTPAGNAM) TO(*BLANKS)
MESSAGE MSGTXT('Search request is beyond start or end of names
file')
ELSE
GET_ENTRY NUMBER(1) FROM_LIST(#WORK01)
CHANGE FIELD(#TOPPAGNAM) TO(#DEMNAM)
GET_ENTRY NUMBER(#WORKSIZE) FROM_LIST(#WORK01)
CHANGE FIELD(#BOTPAGNAM) TO(#DEMNAM)
ENDIF
ENDROUTINE
The type of RDML program that calls this program would probably include code like this:
********* Ask user to input a customer name code
REQUEST FIELDS((#DEMNAC) .... etc, etc)
********* Validate name code (with optional search allowed)
BEGINCHECK
IF COND('#DEMNAC = ''?''')
CALL PROCESS(XXXXXXXXXX) FUNCTION(YYYYYYY)
ENDIF
FILECHECK FIELD(#DEMNAC) WITH_FILE(DEMNAME)
MSGTXT('No customer with name & address
code exists')
ENDCHECK
If the user enters a name and address code, it is immediately validated against file DEMNAME. If it is valid, the program continues. If it is not, control is returned to the REQUEST command and the error message appears.
If however, the user enters a "?" as the name and address code the previously described function is called. It allows the user to search the name and address file.
If the user selects a name the associated DEMNAC value is returned into this program, thus the FILECHECK will work.
If the user does not select a name (i.e.: uses function key 24 to end the search) the DEMNAC value returned into this program is a "?", which will cause the FILECHECK command to fail to find a record, thus triggering a validation error.