Page History
[ 
|../../index.htm#lansa/l4wdev05_0180.htm]
現在地:
...
処理対象ファイル
DEMNACをキーとする物理ファイル「DEMNAME」(氏名と住所の対応ファイル)と、DEMNAMをキーとする論理ビュー「DEMNAMEN」。
フィールド | タイプ | 全桁数 | 説明 |
|---|---|---|---|
DEMNAC | A | 7 | 「氏名と住所」の組に対して与えるコード |
DEMNAM | A | 25 | 氏名 |
DEMAD1 | A | 25 | 住所1 |
DEMAD2 | A | 25 | 住所2 |
DEMAD3 | A | 25 | 住所3 |
DEMPCD | A | 4 | 郵便番号 |
...
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
No customer with name & address code exists') ENDCHECK
呼び出し元プログラムでは、ユーザーが入力したコード(#DEMNAC)がDEMNAMEファイルに存在するコードかどうか確認し、存在すれば次の処理に進みます。存在しない場合はREQUESTコマンドに制御を戻し、エラー・メッセージを表示します。
ユーザーがコードの代わりに「?」と入力した場合は、上述のファンクションを呼び出しています。画面には顧客リストが現れるので、ユーザーはこの中からいずれかの顧客を選択できます。
実際にユーザーがある氏名を選択すると、対応するコード(DEMNAC)の値が返されます。これをFILECHECKコマンドで確認しています。
一方、ユーザーがどの氏名も選択せず、ファンクション・キー24を押して検索終了を指示した場合は、DEMNACの値として「?」が返されます。この場合、FILECHECKコマンドではレコードが見つからないので、エラー処理が起動されることになります。
[ |../../index.htm#lansa/l4wdev05_0180.htm]