15.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)