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)

...