15.23.2 Header/Detail style inquiry program
The following 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)