&<img src="../resources/images/opentocr.png" title="Open Contents list" border="0"&>
You are here:
4.5.3.2 Header/Detail Style Inquiry Template
This is an example of a fairly complex application template for a header/detail style inquiry program:
/ ======================================================= /
/ GET NAMES OF UP TO 50 RELATED FILES /
/ Note that the user can select up to 50 physical or /
/ logical files including 1:n relationships. /
/ ======================================================= /
@@GET_FILS TO(50) PHY_ONLY(*NO) SGL_ONLY(*NO)+
PROMPT('Enter the name of the base+
file to be used by this template')+
EXTEND('The file name may be speci+
fied partially (to cause a partia+
l' 'list of available files to be +
displayed), or in left blank (to c+
ause a full list' 'of available fi+
les to be displayed). When a list+
of files is displayed,' 'the file +
required may be selected from the +
list.' ' ' 'Use the HELP function +
key for more details about this te+
mplate and' 'examples of the type+
of RDML applications it can create+
.') HELPIDS(HELP010 HELP020 HELP03+
0 HELP040)
/ ======================================================= /
/ LOAD DETAILS OF FIELDS OF "HEADER" INTO LIST 1 /
/ LOAD DETAILS OF FIELDS OF "BROWSE" INTO LIST 2 /
/ Use special variable @@FAREAnn to separate fields in /
/ the header and browse portions of the panel. /
/ Note the use of an index to control the loading of /
/ multiple file information. /
/ ======================================================= /
@@CLR_LST NUMBER(1)
@@CLR_LST NUMBER(2)
@@SET_IDX IDX_NAME(CF) TO(1)
A10: @@LABEL
@@CMP_IDX IDX_NAME(CF) IDX_VALUE(@@TFMX) IF_GT(A20)
@@IF COND((*IF @@FAREACF *NE B)) GOTO(A12)
@@RTV_FLDS FROM_FILE(CF) INTO_LST(2)
@@GOTO LABEL(A14)
A12: @@RTV_FLDS FROM_FILE(CF) INTO_LST(1)
A14: @@INC_IDX IDX_NAME(CF)
@@GOTO LABEL(A10)
A20: @@LABEL
/ ====================================================/
/ ASK THE USER TO SELECT THE HEADER FIELDS REQUIRED /
/ ====================================================/
@@CLR_LST NUMBER(11)
@@MAK_LSTS FROM_LSTS(1) INTO_LSTS((11 'Fields in'+
'Header' 'Area' *SEQUENCE *ALL)) HELPI+
DS(HELP010 HELP020 HELP030 HELP040)
/ ===================================================/
/ ASK THE USER TO SELECT THE BROWSE FIELDS REQUIRED /
/ ===================================================/
@@CLR_LST NUMBER(22)
@@MAK_LSTS FROM_LSTS(2) INTO_LSTS((22 'Fields in'+
'Detail/List' 'Area' *SEQUENCE *ALL)) +
HELPIDS(HELP010 HELP020 HELP030 HELP0 +
40)
/ ===================================================/
/ ASK THE USER HOW TO DESIGN THE PANELS /
/ ===================================================/
@@QUESTION PROMPT('Design fields in the header a +
rea DOWN the screen or ACROSS the scre+
en') ANSWER(@@CANS002) EXTEND('Reply D+
OWN or ACROSS only.' 'If your header a+
rea contains 10 (or less) fields, DOWN+
is the ' 'recommended value.+
If your header area contains more than+
10' 'fields, ACROSS is the recommended+
value.' 'Use the HELP function key for+
more information and examples.') LOWER+
(*NO) VALUES(DOWN ACROSS) HELPIDS(HELP+
010 HELP020 HELP030 HELP040)
/ ======================================================= /
/ MERGE ALL RELATED KEY FIELDS INTO LIST 11 OR LIST 22 /
/ AS *HIDDEN FIELDS. LIST 3 IS A WORKING LIST ONLY /
/ Note the use of @@RTV_RELN command to get the keys of /
/ the secondary files. /
/ ======================================================= /
@@SET_IDX IDX_NAME(CF) TO(2)
A30: @@LABEL
@@CMP_IDX IDX_NAME(CF) IDX_VALUE(@@TFMX) +
IF_GT(A40)
@@CLR_LST NUMBER(3)
@@RTV_RELN OF_FILE(CF) INTO_LST(3)
@@IF COND((*IF @@FAREACF *NE B)) +
GOTO(A34)
@@IF COND((*IF @@FRELRCF *EQ M)) +
GOTO(A34)
@@MRG_LSTS FROM_LSTS((3 *HIDDEN)) INTO_LST(22)
@@GOTO LABEL(A36)
A34: @@MRG_LSTS FROM_LSTS((3 *HIDDEN)) INTO_LST(11)
A36: @@INC_IDX IDX_NAME(CF)
@@GOTO LABEL(A30)
A40: @@LABEL
/ ======================================================= /
/ GENERATION OF RDML CODE STARTS HERE /
/ ======================================================= /
FUNCTION OPTIONS(*NOMESSAGES *DEFERWRITE)
GROUP_BY NAME(#HEADER) FIELDS(@@LST11)
DEF_LIST NAME(#LIST)
FIELDS((#LISTDUMMY *HIDDEN) @@LST22)
@@COMMENT 'Loop until user EXITs or CANCELs'
BEGIN_LOOP
/ ======================================================= /
/ REQUEST KEYS OF THE BASE FILE BE INPUT AND GET DATA /
/ ======================================================= /
@@CLR_LST NUMBER(3)
@@RTV_KEYS OF_FILE(1) INTO_LST(3)
R10: REQUEST FIELDS(@@LST03) DESIGN(*@@CANS002) +
IDENTIFY(*LABEL)
/ ======================================================= /
/ GENERATE FETCH TO THE PRIMARY FILE /
/ ======================================================= /
@@COMMENT COMMENT('Fetch file @@FNAME01 details ')
FETCH FIELDS((#HEADER)) +
FROM_FILE(@@FNAME01) +
WITH_KEY(@@LST03) NOT_FOUND(R10) +
ISSUE_MSG(*YES)
/ ======================================================= /
/ GENERATE FETCHES TO ALL FILES IN THE HEADER AREA /
/ ======================================================= /
@@SET_IDX IDX_NAME(CF) TO(2)
H10: @@LABEL
@@CMP_IDX IDX_NAME(CF) IDX_VALUE(@@TFMX) +
IF_GT(H20)
@@IF COND((*IF @@FAREACF *EQ B)) GOTO(H15)
@@CLR_LST NUMBER(3)
@@RTV_RELN OF_FILE(CF) INTO_LST(3)
@@COMMENT COMMENT('Fetch file @@FNAMECF details ')
FETCH FIELDS((#HEADER)) FROM_FILE(@@FNAMECF) +
WITH_KEY(@@LST03)
H15: @@INC_IDX IDX_NAME(CF)
@@GOTO LABEL(H10)
H20: @@LABEL
/ ======================================================= /
/ NOW EXTRACT DATA TO BE PLACED INTO THE BROWSE LIST /
/ ======================================================= /
@@SET_IDX IDX_NAME(CF) TO(2)
@@SET_IDX IDX_NAME(SC) TO(0)
A50: @@LABEL
@@CMP_IDX IDX_NAME(CF) IDX_VALUE(@@TFMX) +
IF_GT(A80)
@@IF COND((*IF @@FAREACF *NE B)) GOTO(A78)
@@CLR_LST NUMBER(3)
@@RTV_RELN OF_FILE(CF) INTO_LST(3)
@@IF COND((*IF @@FRELRCF *EQ M)) GOTO(A55)
/ FETCH INTO THE LIST ENTRY /
@@COMMENT COMMENT('Fetch file @@FNAMECF details ')
FETCH FIELDS((#LIST)) FROM_FILE(@@FNAMECF) +
WITH_KEY(@@LST03)
@@GOTO LABEL(A78)
/ THE ONE AND ONLY SELECT COMMAND /
A55: @@COMMENT COMMENT('Select all file @@FNAMECF details')
@@INC_IDX IDX_NAME(SC)
SELECT FIELDS((#LIST)) FROM_FILE(@@FNAMECF) +
WITH_KEY(@@LST03)
@@GOTO LABEL(A78)
/ INC INDEX AND LOOP AROUND /
A78: @@INC_IDX IDX_NAME(CF)
@@GOTO LABEL(A50)
A80: @@LABEL
/ ======================================================= /
/ ADD_ENTRY AND ENDSELECT FOR THE LIST (IF SELECT USED) /
/ ======================================================= /
@@CMP_IDX IDX_NAME(SC) IDX_VALUE(0) IF_EQ(A90)
ADD_ENTRY TO_LIST(#LIST)
ENDSELECT
A90: @@LABEL
/ ======================================================= /
/ DISPLAY DETAILS TO THE USER /
/ ======================================================= /
@@COMMENT COMMENT('Display results to the user')
DISPLAY FIELDS(#HEADER) DESIGN(*@@CANS002)+
IDENTIFY(*LABEL)+
BROWSELIST(#LIST)
@@COMMENT COMMENT('Clear header and list and +
loop around ')
CHANGE FIELD(#HEADER) TO(*DEFAULT)
@@CMP_IDX IDX_NAME(SC) IDX_VALUE(0) IF_EQ(A95)
CLR_LIST NAMED(#LIST)
A95: @@LABEL
END_LOOP
/ ======================================================= /
/ CLEAR ALL LISTS USED /
/ ======================================================= /
@@CLR_LST NUMBER(1)
@@CLR_LST NUMBER(2)
@@CLR_LST NUMBER(3)
@@CLR_LST NUMBER(11)
@@CLR_LST NUMBER(12)
&<img src="../resources/images/opentoc-dark.png" title="Open Contents List" border="0"&>