処理対象ファイル

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コマンドではレコードが見つからないので、エラー処理が起動されることになります。