処理対象ファイル
DEMNACをキーとする物理ファイル「DEMNAME」(氏名と住所の対応ファイル)と、DEMNAMをキーとする論理ビュー「DEMNAMEN」。
|
RDMLプログラム/サブルーチン
以下に示すプログラムは「検索」サブルーチンとして働き、他のプログラムから呼び出される形で処理を行います。
ユーザーが直接起動することは想定していません。このプログラムは、顧客の氏名を画面にリスト・ビューします。ユーザーがいずれかを選択すると、
該当するレコードの「コード」と氏名が呼び出し元プログラムに返されるので、これを使ってさらに別の処理を実行できます。
ユーザーはこのとき、画面をスクロールして「次の」ページを表示できるだけでなく、「前の」ページに戻ることもできます。さらに、任意のページに直接「ジャンプ」することも可能です。
********** 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
呼び出し元プログラムでは、ユーザーが入力したコード(#DEMNAC)がDEMNAMEファイルに存在するコードかどうか確認し、存在すれば次の処理に進みます。存在しない場合はREQUESTコマンドに制御を戻し、エラー・メッセージを表示します。
ユーザーがコードの代わりに「?」と入力した場合は、上述のファンクションを呼び出しています。画面には顧客リストが現れるので、ユーザーはこの中からいずれかの顧客を選択できます。
実際にユーザーがある氏名を選択すると、対応するコード(DEMNAC)の値が返されます。これをFILECHECKコマンドで確認しています。
一方、ユーザーがどの氏名も選択せず、ファンクション・キー24を押して検索終了を指示した場合は、DEMNACの値として「?」が返されます。この場合、FILECHECKコマンドではレコードが見つからないので、エラー処理が起動されることになります。
