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