/* ======================================================= */ /* ASK FOR THE "OBJECT" */ /* ======================================================= */ @@QUESTION PROMPT('Supply a word that describes what "object" thi+ s function will work with') ANSWER(@@CANS001) EXTEND('+ 123456789012345' 'The word you specify here is used t+ o build messages that appear on the' 'screen panels. Y+ ou should use ONE word only, use upper and lower case+ ' 'characters, and only use singular form (eg: "Custom+ er", "Employee",' '"Order"). Do NOT use more than 15 c+ haracters in your answer.') /* ======================================================= */ /* ASK ABOUT ABOUT MORE VIEWS OF THE SAME FILE */ /* ======================================================= */ @@SET_IDX IDX_NAME(AF) TO(0) @@CLR_LST NUMBER(71) @@CLR_LST NUMBER(72) @@CLR_LST NUMBER(73) @@CLR_LST NUMBER(74) @@CLR_LST NUMBER(75) @@CLR_LST NUMBER(76) @@CLR_LST NUMBER(77) @@CLR_LST NUMBER(78) @@CLR_LST NUMBER(79) @@CLR_LST NUMBER(81) /* FILE NAME INPUT LOOP */ AFA: @@LABEL @@CMP_IDX IDX_NAME(AF) IDX_VALUE(0) IF_EQ(N02) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(@@TFMX) IF_LT(N02) IF_EQ(N02) @@DEC_IDX IDX_NAME(AF) N02: @@LABEL @@CMP_IDX IDX_NAME(AF) IDX_VALUE(9) IF_EQ(AFZ) @@INC_IDX IDX_NAME(AF) AFE: @@LABEL @@CMP_IDX IDX_NAME(AF) IDX_VALUE(1) IF_EQ(AF1) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(2) IF_EQ(AF2) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(3) IF_EQ(AF3) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(4) IF_EQ(AF4) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(5) IF_EQ(AF5) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(6) IF_EQ(AF6) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(7) IF_EQ(AF7) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(8) IF_EQ(AF8) @@CMP_IDX IDX_NAME(AF) IDX_VALUE(9) IF_EQ(AF9) @@GOTO LABEL(AFZ) /* FILE NUMBER 1 */ AF1: @@LABEL @@GET_FILS FROM(1) TO(1) PHY_ONLY(*YES) SGL_ONLY(*YES) PROMPT('En+ ter the name of the 1st search file to be used by thi+ s application.') EXTEND('The file name may be specifie+ d in full, partially (to cause a partial list' 'of ava+ ilable files to be displayed) or left blank (to cause + a full list of' 'available files to be displayed). Whe+ n a list of files is displayed, the' 'file required ma+ y be selected from the list.') @@CLR_LST NUMBER(71) @@RTV_KEYS OF_FILE(1) INTO_LST(71) @@SET_IDX IDX_NAME(WK) TO(@@LNE71) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF1) @@MRG_LSTS FROM_LSTS((71)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 1 be described as ?') ANSWER(@@CANS071) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME01 on ' 'generated screen + panels, please provide a brief description that uses' + 'upper and lowercase characters and does not contain a+ ny quote ('') symbols' 'For example : by Name, by Depa+ rtment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* FILE NUMBER 2 */ AF2: @@LABEL @@GET_FILS FROM(2) TO(2) PHY_ONLY(*NO) SGL_ONLY(*YES) PROMPT('Ent+ er the name of the 2nd search file to be used by this + application.') EXTEND('The file name you specify here + may be a physical or logical file, but it' 'MUST shar+ e the same underlying data set as ALL other files alre+ ady chosen.') @@CLR_LST NUMBER(72) @@RTV_KEYS OF_FILE(2) INTO_LST(72) @@SET_IDX IDX_NAME(WK) TO(@@LNE72) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF2) @@MRG_LSTS FROM_LSTS((72)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 2 be described as ?') ANSWER(@@CANS072) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME02 on ' 'generated screen + panels, please provide a brief desrcription that uses+ ' 'upper and lowercase characters and does not contai+ n any quote ('') symbols' 'For example : by Name, by D+ epartment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* FILE NUMBER 3 */ AF3: @@LABEL @@GET_FILS FROM(3) TO(3) PHY_ONLY(*NO) SGL_ONLY(*YES) PROMPT('Ent+ er the name of the 3rd search file to be used by this + application.') EXTEND('The file name you specify here + may be a physical or logical file, but it' 'MUST shar+ e the same underlying data set as ALL other files alre+ ady chosen.') @@CLR_LST NUMBER(73) @@RTV_KEYS OF_FILE(3) INTO_LST(73) @@SET_IDX IDX_NAME(WK) TO(@@LNE73) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF3) @@MRG_LSTS FROM_LSTS((73)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 3 be described as ?') ANSWER(@@CANS073) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME03 on ' 'generated screen + panels, please provide a brief desrcription that uses+ ' 'upper and lowercase characters and does not contai+ n any quote ('') symbols' 'For example : by Name, by D+ epartment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* FILE NUMBER 4 */ AF4: @@LABEL @@GET_FILS FROM(4) TO(4) PHY_ONLY(*NO) SGL_ONLY(*YES) PROMPT('Ent+ er the name of the 4th search file to be used by this + application.') EXTEND('The file name you specify here + may be a physical or logical file, but it' 'MUST shar+ e the same underlying data set as ALL other files alre+ ady chosen.') @@CLR_LST NUMBER(74) @@RTV_KEYS OF_FILE(4) INTO_LST(74) @@SET_IDX IDX_NAME(WK) TO(@@LNE74) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF4) @@MRG_LSTS FROM_LSTS((74)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 4 be described as ?') ANSWER(@@CANS074) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME04 on ' 'generated screen + panels, please provide a brief desrcription that uses+ ' 'upper and lowercase characters and does not contai+ n any quote ('') symbols' 'For example : by Name, by D+ epartment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* FILE NUMBER 5 */ AF5: @@LABEL @@GET_FILS FROM(5) TO(5) PHY_ONLY(*NO) SGL_ONLY(*YES) PROMPT('Ent+ er the name of the 5th search file to be used by this + application.') EXTEND('The file name you specify here + may be a physical or logical file, but it' 'MUST shar+ e the same underlying data set as ALL other files alre+ ady chosen.') @@CLR_LST NUMBER(75) @@RTV_KEYS OF_FILE(5) INTO_LST(75) @@SET_IDX IDX_NAME(WK) TO(@@LNE75) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF5) @@MRG_LSTS FROM_LSTS((75)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 5 be described as ?') ANSWER(@@CANS075) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME05 on ' 'generated screen + panels, please provide a brief desrcription that uses+ ' 'upper and lowercase characters and does not contai+ n any quote ('') symbols' 'For example : by Name, by D+ epartment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* FILE NUMBER 6 */ AF6: @@LABEL @@GET_FILS FROM(6) TO(6) PHY_ONLY(*NO) SGL_ONLY(*YES) PROMPT('Ent+ er the name of the 6th search file to be used by this + application.') EXTEND('The file name you specify here + may be a physical or logical file, but it' 'MUST shar+ e the same underlying data set as ALL other files alre+ ady chosen.') @@CLR_LST NUMBER(76) @@RTV_KEYS OF_FILE(6) INTO_LST(76) @@SET_IDX IDX_NAME(WK) TO(@@LNE76) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF6) @@MRG_LSTS FROM_LSTS((76)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 6 be described as ?') ANSWER(@@CANS076) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME06 on ' 'generated screen + panels, please provide a brief desrcription that uses+ ' 'upper and lowercase characters and does not contai+ n any quote ('') symbols' 'For example : by Name, by D+ epartment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* FILE NUMBER 7 */ AF7: @@LABEL @@GET_FILS FROM(7) TO(7) PHY_ONLY(*NO) SGL_ONLY(*YES) PROMPT('Ent+ er the name of the 7th search file to be used by this + application.') EXTEND('The file name you specify here + may be a physical or logical file, but it' 'MUST shar+ e the same underlying data set as ALL other files alre+ ady chosen.') @@CLR_LST NUMBER(77) @@RTV_KEYS OF_FILE(7) INTO_LST(77) @@SET_IDX IDX_NAME(WK) TO(@@LNE77) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF7) @@MRG_LSTS FROM_LSTS((77)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 7 be described as ?') ANSWER(@@CANS077) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME07 on ' 'generated screen + panels, please provide a brief desrcription that uses+ ' 'upper and lowercase characters and does not contai+ n any quote ('') symbols' 'For example : by Name, by D+ epartment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* FILE NUMBER 8 */ AF8: @@LABEL @@GET_FILS FROM(8) TO(8) PHY_ONLY(*NO) SGL_ONLY(*YES) PROMPT('Ent+ er the name of the 8th search file to be used by this + application.') EXTEND('The file name you specify here + may be a physical or logical file, but it' 'MUST shar+ e the same underlying data set as ALL other files alre+ ady chosen.') @@CLR_LST NUMBER(78) @@RTV_KEYS OF_FILE(8) INTO_LST(78) @@SET_IDX IDX_NAME(WK) TO(@@LNE78) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF8) @@MRG_LSTS FROM_LSTS((78)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 8 be described as ?') ANSWER(@@CANS078) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME08 on ' 'generated screen + panels, please provide a brief desrcription that uses+ ' 'upper and lowercase characters and does not contai+ n any quote ('') symbols' 'For example : by Name, by D+ epartment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* FILE NUMBER 9 */ AF9: @@LABEL @@GET_FILS FROM(9) TO(9) PHY_ONLY(*NO) SGL_ONLY(*YES) PROMPT('Ent+ er the name of the 9th search file to be used by this + application.') EXTEND('The file name you specify here + may be a physical or logical file, but it' 'MUST shar+ e the same underlying data set as ALL other files alre+ ady chosen.') @@CLR_LST NUMBER(79) @@RTV_KEYS OF_FILE(9) INTO_LST(79) @@SET_IDX IDX_NAME(WK) TO(@@LNE79) @@CMP_IDX IDX_NAME(WK) IDX_VALUE(1) IF_LT(AF9) @@MRG_LSTS FROM_LSTS((79)) INTO_LST(81) @@QUESTION PROMPT('What should selecting @@CANS001s via @@FNAME0+ 9 be described as ?') ANSWER(@@CANS079) EXTEND('123456+ 78901234567890' 'To identify the selection of @@CANS00+ 1s by using the file @@FNAME09 on ' 'generated screen + panels, please provide a brief desrcription that uses+ ' 'upper and lowercase characters and does not contai+ n any quote ('') symbols' 'For example : by Name, by D+ epartment, by Customer.') LOWER(*YES) @@GOTO LABEL(AFN) /* NEXT FILE */ AFN: @@LABEL @@QUESTION PROMPT('Do you want to use another view of the same un+ derlying physical data ?') ANSWER(@@CANS007) EXTEND('R+ eply YES or NO only to this question.' 'This template + has been specially constructed to support "work withs+ " by' 'multiple logical views of the same set of under+ lying physical data.') LOWER(*NO) VALUES(YES NO) @@IF COND((*IF @@CANS007 *NE YES)) GOTO(AFZ) @@GOTO LABEL(AFA) /* END OF FILE INPUTTING LOOP */ AFZ: @@LABEL @@CMP_IDX IDX_NAME(AF) IDX_VALUE(@@TFMX) IF_LT(N03) IF_EQ(N03) @@DEC_IDX IDX_NAME(AF) /* ======================================================= */ /* ASK ABOUT ADD PROCESSING */ /* ======================================================= */ N03: @@LABEL @@QUESTION PROMPT('Do you want the ADD functionality included?') + ANSWER(@@CANS002) EXTEND('Reply YES or NO only to thi+ s question.') LOWER(*NO) VALUES(YES NO) /* ======================================================= */ /* WHAT IS NAME OF THE PROGRAM WHICH WILL BE MAINTAINING */ /* ======================================================= */ @@IF COND((*IF @@CANS002 *EQ NO)) GOTO(N01) @@QUESTION PROMPT('What is the name of the maintenance function t+ o be called?') ANSWER(@@CANS008) EXTEND('1234567') LOW+ ER(*NO) RANGE((A000000 ZZZZZZZ)) @@QUESTION PROMPT('What process does function @@CANS008 reside?'+ ) ANSWER(@@CANS009) EXTEND('1234567890') LOWER(*NO) RA+ NGE((A000000000 ZZZZZZZZZZ)) N01: @@LABEL /* ======================================================= */ /* ASK WHAT FIELDS TO DISPLAY IN BROWSE AREA */ /* ======================================================= */ @@CLR_LST NUMBER(01) @@CLR_LST NUMBER(02) @@RTV_FLDS FROM_FILE(1) INTO_LST(1) @@MAK_LSTS FROM_LSTS(1) INTO_LSTS((2 'Fields to' 'Display in' 'Br+ owse Lst' *SEQUENCE)) @@MRG_LSTS FROM_LSTS((81 *HIDE)) INTO_LST(02) /* ======================================================= */ /* ASK WHAT FIELDS TO EXCHANGE */ /* ======================================================= */ @@CLR_LST NUMBER(09) @@MAK_LSTS FROM_LSTS(1) INTO_LSTS((9 *N 'Fields to' 'Exchange' *Y+ ESNO)) @@MRG_LSTS FROM_LSTS((9 *HIDE)) INTO_LST(02) /* ======================================================= */ /* GENERATE THE RDML PROGRAM */ /* ======================================================= */ @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Copyright ...: (C) @@COMPANY, 1998') @@COMMENT COMMENT('Process .....: @@PROCESS') @@COMMENT COMMENT('Function ....: @@FUNCTION') @@COMMENT COMMENT('Created by ..: @@USER ') @@COMMENT COMMENT('Created on ..: @@DATE at @@TIME') @@COMMENT COMMENT('Description .: @@FUNCDES') @@COMMENT COMMENT('Template Used: SBFPROMPT v 1.1') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('FUNCTION, OPEN and EXCHANGE(*ALWAYS) statment+ s') @@COMMENT COMMENT('=============================================+ ==========') FUNCTION OPTIONS(*DEFERWRITE *DIRECT) OPEN FILE(*ALL) USE_OPTION(*ONDEMAND) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Working fields(DEFINE statments)') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Conditions(DEF_COND statments)') @@COMMENT COMMENT('=============================================+ ==========') DEF_COND NAME(*SHOW_F7) COND('#@VWCNT *GT 1') COLHDG(*NO) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Browse or Working Lists(DEF_LIST statments)') @@COMMENT COMMENT('=============================================+ ==========') DEF_LIST NAME(#VEWLSTDET) FIELDS((#@VWNUM *HIDE) (#@VWDES *P4)+ ) COUNTER(#@VWCNT) SEL_ENTRY(#@VWENT) DEF_LIST NAME(#BRWOBJ) FIELDS((#@RRNUM *HIDDEN) @@LST02) COUNTE+ R(#@LSCNT) PAGE_SIZE(#@LSPAG) TOP_ENTRY(#@LSTOP) SEL_E+ NTRY(#@LSENT) SCROLL_TXT(#@LSPOS) DEF_LIST NAME(#BRWOBJSAV) FIELDS((#@RRNUM) @@LST02) TYPE(*WORKI+ NG) ENTRYS(1) DEF_LIST NAME(#SAVTOPKEY) FIELDS(@@LST81) TYPE(*WORKING) ENTRYS+ (1) DEF_LIST NAME(#SAVBOTKEY) FIELDS(@@LST81) TYPE(*WORKING) ENTRYS+ (1) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Screen Panel Groups(GROUP_BY statments)') @@COMMENT COMMENT('=============================================+ ==========') GROUP_BY NAME(#KEYFLDS) FIELDS(@@LST81) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Initalization(CHANGE and CLR_LIST statments)') @@COMMENT COMMENT('=============================================+ ==========') CHANGE FIELD(#@VWSEL) TO(V01) @@COMMENT COMMENT(' ') @@COMMENT ('====================================================+ ===') @@COMMENT ('Get Security Fields from Security Progra+ m ') @@COMMENT ('====================================================+ ===') CHANGE FIELD(#ASOBNM) TO(*FUNCTION) EXCHANGE FIELDS(#ASOBNM) CALL PROCESS(*DIRECT) FUNCTION(XXI0101) EXIT_USED(*NEXT) ME+ NU_USED(*NEXT) DEF_COND NAME(*SECDSP) COND('#ASECDP *EQ Y') DEF_COND NAME(*SECADD) COND('(#ASECAD *EQ Y) *AND (#@LSTFN *NE + @@CANS008)') DEF_COND NAME(*SECCHG) COND('#ASECCH *EQ Y') DEF_COND NAME(*SECDLT) COND('#ASECDL *EQ Y') IF COND('#ASECDP *NE Y') MESSAGE MSGID(XX00028) MSGF(SBMSGF) MENU ENDIF @@COMMENT (' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Function Mainline') @@COMMENT COMMENT('=============================================+ ==========') EXECUTE SUBROUTINE(BLDVEW) EXECUTE SUBROUTINE(BLDBRWLST) EXECUTE SUBROUTINE(DSPOBJ) RETURN @@COMMENT (' ') @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: BLDBRWLS+ T ') @@COMMENT ('Description....: Build Browse List (page at a time+ ) ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(BLDBRWLST) @@COMMENT (+ ' + ') CLR_LIST NAMED(#BRWOBJ) @@COMMENT (+ ' + ') CASE OF_FIELD(#@VWSEL) /* ======================================================= */ /* START CREATING SELECT VIEWS */ /* ======================================================= */ @@SET_IDX IDX_NAME(BA) TO(1) @@SET_IDX IDX_NAME(BB) TO(71) BDL: @@LABEL @@CMP_IDX IDX_NAME(BA) IDX_VALUE(AF) IF_GT(BDE) @@COMMENT COMMENT('Select records from file @@FNAMEBA') WHEN VALUE_IS('= V@@INDEXBA') SELECT FIELDS((#BRWOBJ)) FROM_FILE(@@FNAMEBA) WHERE('#@LSCNT + *LT #@LSPAG') WITH_KEY(@@LSTBB) NBR_KEYS(*COMPUTE) RET+ URN_RRN(#@RRNUM) OPTIONS(*ENDWHERE *STARTKEY) EXECUTE SUBROUTINE(STROBJ) ENDSELECT @@INC_IDX IDX_NAME(BA) @@INC_IDX IDX_NAME(BB) @@GOTO LABEL(BDL) BDE: @@LABEL ENDCASE IF_STATUS IS(*ENDFILE) CHANGE FIELD(#KEYFLDS) TO(*HIVAL) CHANGE FIELD(#@LSPOS) TO('''Bottom''') ELSE CHANGE FIELD(#@LSPOS) TO('''More...''') ENDIF INZ_LIST NAMED(#SAVBOTKEY) IF COND('#@LSCNT = 0') MESSAGE MSGID(XX00009) MSGF(SBMSGF) ENDIF @@COMMENT (+ ' + ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: STROBJ') @@COMMENT ('Description....: Add a new entry to object list') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(STROBJ) @@COMMENT (+ ' + ') ADD_ENTRY TO_LIST(#BRWOBJ) WITH_MODE(*DISPLAY) @@COMMENT (+ ' + ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: DSPOB+ J ') @@COMMENT ('Description....: Browse File Page at a Tim+ e ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(DSPOBJ) @@COMMENT (+ ' + ') @@COMMENT ('Display if at bottom of list or on a page boundar+ y ') SET_MODE TO(*DISPLAY) BEGIN_LOOP IF COND('#@REBLD *EQ Y') EXECUTE SUBROUTINE(BLDBRWLST) ENDIF CHANGE FIELD(#@REBLD) TO(N) EXECUTE SUBROUTINE(ALWUSRKEYS) POP_UP DESIGN(*DOWN) AT_LOC(9 3) BROWSELIST(#BRWOBJ) EXIT_KEY+ (*NO) PROMPT_KEY(*NO) USER_KEYS((*ROLLDOWN) (*ROLLUP)) USE BUILTIN(DROP_EXTRA_USER_KEYS) @@COMMENT ('Save top key') IF COND('#@LSTOP *GT 0') GET_ENTRY NUMBER(#@LSTOP) FROM_LIST(#BRWOBJ) IF_STATUS IS_NOT(*OKAY) CHANGE FIELD(#SAVTOPKEY) TO(*NULL) ENDIF INZ_LIST NAMED(#SAVTOPKEY) ENDIF @@COMMENT ('Handle ADD key (if used+ ) ') CASE OF_FIELD(#IO$KEY) WHEN VALUE_IS('= UP') IF COND('#@LSPOS *EQ ''Bottom''') MESSAGE MSGID(XX00027) MSGF(SBMSGF) ELSE EXECUTE SUBROUTINE(ROLLUP) CHANGE FIELD(#@REBLD) TO(Y) ENDIF WHEN VALUE_IS('= DN') EXECUTE SUBROUTINE(ROLLDOWN) IF COND('(#IO$STS *EQ BF) *AND (#@PGCNT *LE 1)') MESSAGE MSGID(XX00027) MSGF(SBMSGF) ELSE CHANGE FIELD(#@REBLD) TO(Y) ENDIF WHEN VALUE_IS('= ''05''') GET_ENTRY NUMBER(1) FROM_LIST(#SAVTOPKEY) CHANGE FIELD(#@REBLD) TO(Y) CHANGE FIELD(#@ERROR) TO(N) @@IF COND((*IF @@CANS002 *EQ NO)) GOTO(N11) WHEN VALUE_IS('= ''06''') EXECUTE SUBROUTINE(MAINTOBJ) WITH_PARMS('ADD') N11: @@LABEL WHEN VALUE_IS('= ''07''') CHANGE FIELD(#@SVVEW) TO(#@VWSEL) EXECUTE SUBROUTINE(SELVEW) IF COND('#IO$KEY *NE ''12''') EXECUTE SUBROUTINE(SRTENT) IF COND('#IO$KEY *NE ''12''') CHANGE FIELD(#@REBLD) TO(Y) ELSE CHANGE FIELD(#@VWSEL) TO(#@SVVEW) ENDIF ELSE CHANGE FIELD(#@VWSEL) TO(#@SVVEW) ENDIF WHEN VALUE_IS('= ''16''') EXECUTE SUBROUTINE(SRTENT) IF COND('#IO$KEY *NE ''12''') CHANGE FIELD(#@REBLD) TO(Y) ENDIF WHEN VALUE_IS('= ''17''') CLR_LIST NAMED(#BRWOBJ) CHANGE FIELD(#KEYFLDS) TO(*LOVAL) INZ_LIST NAMED(#SAVBOTKEY) EXECUTE SUBROUTINE(ROLLUP) CHANGE FIELD(#@REBLD) TO(Y) WHEN VALUE_IS('= ''18''') CLR_LIST NAMED(#BRWOBJ) CHANGE FIELD(#KEYFLDS) TO(*HIVAL) INZ_LIST NAMED(#SAVTOPKEY) EXECUTE SUBROUTINE(ROLLDOWN) CHANGE FIELD(#@REBLD) TO(Y) OTHERWISE IF COND('(#@LSCNT2 *EQ 0) *AND (#@LSENT *GT 0)') EXECUTE SUBROUTINE(POINTCLICK) ENDIF ENDCASE END_LOOP ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: ROLLU+ P ') @@COMMENT ('Description....: Process Rollu+ p ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(ROLLUP) @@COMMENT (+ ' + ') GET_ENTRY NUMBER(1) FROM_LIST(#SAVBOTKEY) CASE OF_FIELD(#@VWSEL) /* ======================================================= */ /* CREATE STATMENTS FOR DIFFERENT VIEWS */ /* ======================================================= */ @@SET_IDX IDX_NAME(EA) TO(1) @@SET_IDX IDX_NAME(EB) TO(71) EDL: @@LABEL @@CMP_IDX IDX_NAME(EA) IDX_VALUE(AF) IF_GT(EDE) WHEN VALUE_IS('= V@@INDEXEA') SELECT FIELDS((#BRWOBJ)) FROM_FILE(@@FNAMEEA) WITH_KEY(@@LSTE+ B) NBR_KEYS(*COMPUTE) LEAVE ENDSELECT @@INC_IDX IDX_NAME(EA) @@INC_IDX IDX_NAME(EB) @@GOTO LABEL(EDL) EDE: @@LABEL ENDCASE @@COMMENT (+ ' + ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: ROLLDOW+ N ') @@COMMENT ('Description....: Process Rolldow+ n ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(ROLLDOWN) @@COMMENT (+ ' + ') IF COND('#@LSCNT *GT 0') CHANGE FIELD(#@PGCNT) TO(*NULL) ELSE CHANGE FIELD(#@PGCNT) TO(1) ENDIF GET_ENTRY NUMBER(1) FROM_LIST(#SAVTOPKEY) CASE OF_FIELD(#@VWSEL) /* ======================================================= */ /* CREATE STATMENTS FOR DIFFERENT VIEWS */ /* ======================================================= */ @@SET_IDX IDX_NAME(HA) TO(1) @@SET_IDX IDX_NAME(HB) TO(71) HDL: @@LABEL @@CMP_IDX IDX_NAME(HA) IDX_VALUE(AF) IF_GT(HDE) WHEN VALUE_IS('= V@@INDEXHA') SELECT FIELDS((#BRWOBJ)) FROM_FILE(@@FNAMEHA) WHERE('#@PGCNT + *LT #@LSPAG') WITH_KEY(@@LSTHB) NBR_KEYS(*COMPUTE) OPT+ IONS(*STARTKEY *BACKWARDS *ENDWHERE) CHANGE FIELD(#@PGCNT) TO('#@PGCNT + 1') ENDSELECT @@INC_IDX IDX_NAME(HA) @@INC_IDX IDX_NAME(HB) @@GOTO LABEL(HDL) HDE: @@LABEL ENDCASE @@COMMENT (+ ' + ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: ALWUSRKEY+ S ') @@COMMENT ('Description....: Allow Extra User Key+ s ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(ALWUSRKEYS) @@COMMENT (+ ' + ') USE (ALLOW_EXTRA_USER_KEY) (5 '''Refresh''') @@IF COND((*IF @@CANS002 *EQ NO)) GOTO(N10) IF COND(*SECADD) USE (ALLOW_EXTRA_USER_KEY) (6 '''Add''') ENDIF N10: @@LABEL IF COND(*SHOW_F7) USE (ALLOW_EXTRA_USER_KEY) (7 '''Chg View''') ENDIF USE (ALLOW_EXTRA_USER_KEY) (16 '''Posn to''') USE (ALLOW_EXTRA_USER_KEY) (17 '''Top''') USE (ALLOW_EXTRA_USER_KEY) (18 '''Bottom''') @@COMMENT (+ ' + ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: BLDVEW') @@COMMENT ('Description....: Build View Options') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(BLDVEW) @@COMMENT (' ') /* ======================================================= */ /* ADD VIEWS */ /* ======================================================= */ @@SET_IDX IDX_NAME(DA) TO(1) @@SET_IDX IDX_NAME(DB) TO(71) DDL: @@LABEL @@CMP_IDX IDX_NAME(DA) IDX_VALUE(AF) IF_GT(DDE) EXECUTE (ADDVEW) (V@@INDEXDA '''View @@CANS0DB''') @@INC_IDX IDX_NAME(DA) @@INC_IDX IDX_NAME(DB) @@GOTO LABEL(DDL) DDE: @@LABEL @@COMMENT (' ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: ADDVEW') @@COMMENT ('Description....: Add View to list') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(ADDVEW) PARMS((#@VWNUM *RECEIVED) (#@VWDES)) @@COMMENT (' ') ADD_ENTRY TO_LIST(#VEWLSTDET) @@COMMENT (' ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: SELVEW') @@COMMENT ('Description....: Select View') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(SELVEW) @@COMMENT (' ') POP_UP DESIGN(*ACROSS) IDENTIFY(*LABEL) DOWN_SEP(001) ACROSS_+ SEP(001) AT_LOC(4 14) WITH_SIZE(40 15) PANEL_TITL('Sel+ ect View') BROWSELIST(#VEWLSTDET) EXIT_KEY(*NO) MENU_K+ EY(*YES *RETURN) CURSOR_LOC(*ATFIELD #@VWDES) @@COMMENT (' ') BEGINCHECK IF COND('#@VWENT *EQ 0') SET_ERROR FOR_FIELD(#@VWNUM) MSGID(XX00008) MSGF(SBMSGF) ENDIF ENDCHECK GET_ENTRY NUMBER(#@VWENT) FROM_LIST(#VEWLSTDET) IF_STATUS IS(*OKAY) CHANGE FIELD(#@VWSEL) TO(#@VWNUM) ENDIF @@COMMENT (' ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: SRTENT') @@COMMENT ('Description....: Sort Entry') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(SRTENT) SET_MODE TO(*DISPLAY) CASE OF_FIELD(#@VWSEL) /* ======================================================= */ /* START CREATING SELECT VIEWS */ /* ======================================================= */ @@SET_IDX IDX_NAME(CA) TO(1) @@SET_IDX IDX_NAME(CB) TO(71) CDL: @@LABEL @@CMP_IDX IDX_NAME(CA) IDX_VALUE(AF) IF_GT(CDE) @@COMMENT COMMENT('Get search values for @@FNAMECA') WHEN VALUE_IS('= V@@INDEXCA') CHANGE FIELD(@@LSTCB) TO(*NULL) @@CLR_LST NUMBER(99) @@MRG_LSTS FROM_LSTS((CB *IN)) INTO_LST(99) POP_UP FIELDS(@@LST99) DESIGN(*DOWN) IDENTIFY(*DESC) AT_LOC(1+ 0 6) WITH_SIZE(70 11) PANEL_TITL('Select @@CANS0CB') E+ XIT_KEY(*NO) MENU_KEY(*YES *RETURN) @@INC_IDX IDX_NAME(CA) @@INC_IDX IDX_NAME(CB) @@GOTO LABEL(CDL) CDE: @@LABEL ENDCASE @@COMMENT (' ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: POINTCLICK') @@COMMENT ('Description....: Process Point and Click') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(POINTCLICK) @@COMMENT (' ') GET_ENTRY NUMBER(#@LSENT) FROM_LIST(#BRWOBJ) EXCHANGE FIELDS(@@LST09) MENU @@COMMENT (' ') ENDROUTINE @@IF COND((*IF @@CANS002 *EQ NO)) GOTO(H01) @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: MAINTOBJ') @@COMMENT ('Description....: Maintain File data') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(MAINTOBJ) PARMS((#@OBMOD *RECEIVED)) @@COMMENT (' ') CHANGE FIELD(#@UPCNT) TO(*NULL) EXCHANGE FIELDS(#@OBMOD) OPTION(*NOW) CALL PROCESS(*DIRECT) FUNCTION(@@CANS008) MENU_USED(*NEXT) IF COND('#@UPCNT *GT 0') GET_ENTRY NUMBER(1) FROM_LIST(#SAVTOPKEY) CHANGE FIELD(#@REBLD) TO(Y) ENDIF @@COMMENT (' ') ENDROUTINE H01: @@LABEL