14.23.2 ヘッダー/明細スタイルの問い合わせプログラム

LANSA

14.23.2 ヘッダー/明細スタイルの問い合わせプログラム


ヘッダー/明細のスタイルで問い合わせる、やや複雑なアプリケーション・テンプレート例を示します。

 /* ======================================================= */
 /* 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)