Page History
...
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 +
...
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)
...
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+
...
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)
/*
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)
...
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 */
...
/
/* 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)