/* ======================================================= */ /* 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) /* ======================================================= */ /* ASK ABOUT DISPLAY PROCESSING */ /* ======================================================= */ @@QUESTION PROMPT('Do you want the DISPLAY functionality included+ ?') ANSWER(@@CANS003) EXTEND('Reply YES or NO only to + this question.') LOWER(*NO) VALUES(YES NO) /* ======================================================= */ /* ASK ABOUT CHANGE PROCESSING */ /* ======================================================= */ @@QUESTION PROMPT('Do you want the CHANGE functionality included?+ ') ANSWER(@@CANS004) EXTEND('Reply YES or NO only to t+ his question.') LOWER(*NO) VALUES(YES NO) /* ======================================================= */ /* ASK ABOUT DELETE PROCESSING */ /* ======================================================= */ @@QUESTION PROMPT('Do you want the DELETE functionality included?+ ') ANSWER(@@CANS005) EXTEND('Reply YES or NO only to t+ his question.') LOWER(*NO) VALUES(YES NO) /* ======================================================= */ /* WHAT IS NAME OF THE PROGRAM WHICH WILL BE MAINTAINING */ /* ======================================================= */ @@IF COND((*IF @@CANS002 *EQ NO) (*AND @@CANS003 *EQ NO) (*+ AND @@CANS004 *EQ NO) (*AND @@CANS005 *EQ NO)) GOTO(N0+ 1) @@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 FOR THE ANY USER DEFINED ROUTINES */ /* ======================================================= */ @@QUESTION PROMPT('How many USER DEFINED "work with" routines do + you want ?') ANSWER(@@NANS001) EXTEND('LANSA will auto+ matically prepare a number of standard "work with"' 'r+ outines. However, you can cause the RDML function to b+ e generated' 'with provision for up to 9 extra user de+ fined "work with"' 'routines and then fill in the actu+ al RDML code required later.') RANGE((0 9)) /* ======================================================= */ /* GET FULL DETAILS OF USER DEFINED ROUTINE */ /* ======================================================= */ @@SET_IDX IDX_NAME(UC) TO(1) @@SET_IDX IDX_NAME(UO) TO(20) @@SET_IDX IDX_NAME(UD) TO(30) L01: @@CMP_IDX IDX_NAME(UC) IDX_VALUE(@@NANS001) IF_GT(L02) @@QUESTION PROMPT('For your user defined routine, specify the ass+ ociated OPTION NUMBER') ANSWER(@@NANS0UO) EXTEND('Spec+ ify the option number that the user will have to ente+ r beside' 'an entry in the "work with" browse list to + invoke your user defined' 'routine.') RANGE((1 99)) @@QUESTION PROMPT('For option @@NANS0UO, specify the DESCRIPTION + to use') ANSWER(@@CANS0UD) EXTEND('Specify the descrip+ tion of option @@NANS0UO that will be shown on the' 'p+ anel instruction line(s).') @@INC_IDX IDX_NAME(UC) @@INC_IDX IDX_NAME(UO) @@INC_IDX IDX_NAME(UD) @@GOTO LABEL(L01) L02: @@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 IF YOU WANT THE USER TO SELECT VIEW */ /* ======================================================= */ @@QUESTION PROMPT('Do you want the user to select the initial vie+ w and sort?') ANSWER(@@CANS006) EXTEND('If you answer + YES to this question, the user will be asked which vie+ w' 'they want, if more than one view exists, and then + asked for a position' 'to value.' ' ' 'Answering NO t+ o this question will allow the program to execute usin+ g' 'the initial view of the physical file.') LOWER(*NO+ ) VALUES(YES NO) /* ======================================================= */ /* 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: SBFWW 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) EXCHANGE FIELDS(#@RRNUM) OPTION(A) @@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) DEF_COND NAME(*SHOW_F23) COND('#@OPCNT *GT #@OPLNS') COLHDG(*NO) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Browse or Working Lists(DEF_LIST statments)') @@COMMENT COMMENT('=============================================+ ==========') DEF_LIST NAME(#OPTLSTDET) FIELDS((#@OPNUM) (#@OPFTP) (#@OPPRC) + (#@OPFUN) (#@OPFDS)) TYPE(*WORKING) DEF_LIST NAME(#OPTLSTDT2) FIELDS((#@OPNUM) (#@OPFTP) (#@OPPRC) + (#@OPFUN) (#@OPFDS)) TYPE(*WORKING) DEF_LIST NAME(#PNTCLICK) FIELDS((#@OPNUM *HIDE) (#@OPFDS)) SEL_+ ENTRY(#@PTENT) DEF_LIST NAME(#OPTLSTNUM) FIELDS((#@OPNUM)) TYPE(*WORKING) DEF_LIST NAME(#OPTLSTLIN) FIELDS((#@OPLIN)) COUNTER(#@OPCNT) TY+ PE(*WORKING) SEL_ENTRY(#@OPENT) DEF_LIST NAME(#VEWLSTDET) FIELDS((#@VWNUM *HIDE) (#@VWDES *P4)+ ) COUNTER(#@VWCNT) SEL_ENTRY(#@VWENT) DEF_LIST NAME(#BRWOBJ) FIELDS((#@OPOPT *SELECT) (#@RRNUM *HIDDE+ N) @@LST02) COUNTER(#@LSCNT) PAGE_SIZE(#@LSPAG) TOP_EN+ TRY(#@LSTOP) SEL_ENTRY(#@LSENT) SCROLL_TXT(#@LSPOS) @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(K01) DEF_LIST NAME(#BRWDLTLST) FIELDS((#@OPSAV) (#@RRNUM *HIDE) @@LS+ T02) COUNTER(#@LSCNT3) K01: @@LABEL 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) DEF_LIST NAME(#OPTSAV) FIELDS((#@OPSAV) (#@RRSAV) @@LST81) COUN+ TER(#@LSCNT2) TYPE(*WORKING) ENTRYS(9999) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Screen Panel Groups(GROUP_BY statments)') @@COMMENT COMMENT('=============================================+ ==========') GROUP_BY NAME(#KEYFLDS) FIELDS(@@LST81) GROUP_BY NAME(#BRWHEAD) FIELDS((#@OPINS *OUTPUT *L3 *P2 *NOID) + (#@OPLN1 *OUTPUT *L4 *P4 *NOID) (#@OPLN2 *OUTPUT *L5 *+ P4 *NOID)) @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(K02) GROUP_BY NAME(#BRWDLTHED) FIELDS((#@OPINS2 *NC *L3 *P2 *NOID) (+ #@OPINS3 *NC *L4 *P2 *NOID)) K02: @@LABEL @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Initalization(CHANGE and CLR_LIST statments)') @@COMMENT COMMENT('=============================================+ ==========') CHANGE FIELD(#@OPINS) TO('''Type options, press Enter.''') @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(K05) CHANGE FIELD(#@OPINS2) TO('''Press F22=Delete to confirm you+ r choices for 4=Delete.''') CHANGE FIELD(#@OPINS3) TO('''Press F12 to return to change yo+ ur choices.''') K05: @@LABEL 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') 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(BLDOPT) EXECUTE SUBROUTINE(BLDVEW) @@IF COND((*IF @@CANS006 *EQ NO)) GOTO(N11) IF COND(*SHOW_F7) DOUNTIL COND('#IO$KEY *EQ RA') EXECUTE SUBROUTINE(SELVEW) IF_KEY WAS(*MENU) MENU ENDIF EXECUTE SUBROUTINE(SRTENT) ENDUNTIL ELSE EXECUTE SUBROUTINE(SRTENT) IF_KEY WAS(*MENU) MENU ENDIF ENDIF N11: @@LABEL 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) GET_ENTRY NUMBER(#@LSCNT) FROM_LIST(#BRWOBJ) LOC_ENTRY IN_LIST(#OPTSAV) WHERE('#@RRNUM *EQ #@RRSAV') IF_STATUS IS(*OKAY) CHANGE FIELD(#@OPOPT) TO(#@OPSAV) UPD_ENTRY IN_LIST(#BRWOBJ) WITH_MODE(*DISPLAY) DLT_ENTRY FROM_LIST(#OPTSAV) ENDIF IF COND('(#@ERROR *EQ Y) *AND (#@OPOPT *GT 0)') BEGINCHECK GET_ENTRY NUMBER(#@LSCNT) FROM_LIST(#BRWOBJ) LOC_ENTRY IN_LIST(#OPTLSTNUM) WHERE('#@OPOPT *EQ #@OPNUM') IF_STATUS IS_NOT(*OKAY) SET_ERROR FOR_FIELD(#@OPOPT) MSGID(XX00001) MSGF(SBMSGF) MSGDTA(+ #@OPOPT) UPD_ENTRY IN_LIST(#BRWOBJ) ELSE CONDCHECK FIELD(#@OPOPT) COND('A = A') UPD_ENTRY IN_LIST(#BRWOBJ) ENDIF ENDCHECK IF_ERROR(*NEXT) ENDIF @@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) DISPLAY FIELDS((#BRWHEAD)) DESIGN(*DOWN) BROWSELIST(#BRWOBJ) U+ SER_KEYS((*ROLLDOWN) (*ROLLUP)) CURSOR_LOC(*ATFIELD #@+ OPOPT) USE BUILTIN(DROP_EXTRA_USER_KEYS) @@COMMENT ('Save top key') IF COND('(#@LSTOP *GT 0) *AND (#@LSCNT *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 ('Save options selecte+ d ') EXECUTE SUBROUTINE(SAVOPT) @@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''') CLR_LIST NAMED(#OPTSAV) GET_ENTRY NUMBER(1) FROM_LIST(#SAVTOPKEY) CHANGE FIELD(#@REBLD) TO(Y) CHANGE FIELD(#@ERROR) TO(N) WHEN VALUE_IS('= ''06''') EXECUTE SUBROUTINE(MAINTOBJ) WITH_PARMS('ADD') 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) WHEN VALUE_IS('= ''23''') EXECUTE SUBROUTINE(FMTOPTLIN) OTHERWISE IF COND('(#@LSCNT2 *EQ 0) *AND (#@LSENT *GT 0)') EXECUTE SUBROUTINE(POINTCLICK) ELSE IF COND('#@LSCNT2 *GT 0') EXECUTE SUBROUTINE(CHKOPT) IF COND('#@ERROR *EQ Y') CHANGE FIELD(#@REBLD) TO(Y) ELSE EXECUTE SUBROUTINE(PRCOPT) GET_ENTRY NUMBER(1) FROM_LIST(#SAVTOPKEY) CHANGE FIELD(#@REBLD) TO(Y) CHANGE FIELD(#@ERROR) TO(N) ENDIF ENDIF 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''') IF COND(*SHOW_F23) USE (ALLOW_EXTRA_USER_KEY) (23 '''More Opt''') ENDIF @@COMMENT (+ ' + ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: BLDOPT') @@COMMENT ('Description....: Build options to select from') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(BLDOPT) @@COMMENT (' ') @@IF COND((*IF @@CANS004 *EQ NO)) GOTO(C01) IF COND(*SECCHG) EXECUTE (ADDOPT) (2 O @@CANS009 @@CANS008 '''Change''') ENDIF C01: @@LABEL @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(C02) IF COND(*SECDLT) EXECUTE (ADDOPT) (4 O @@CANS009 @@CANS008 '''Delete''') ENDIF C02: @@LABEL @@IF COND((*IF @@CANS003 *EQ NO)) GOTO(C03) EXECUTE (ADDOPT) (5 O @@CANS009 @@CANS008 '''View''') C03: @@LABEL /* ======================================================= */ /* ADD ADDITIONAL OPTIONS */ /* ======================================================= */ @@SET_IDX IDX_NAME(UC) TO(1) @@SET_IDX IDX_NAME(UO) TO(20) @@SET_IDX IDX_NAME(UD) TO(30) C04: @@CMP_IDX IDX_NAME(UC) IDX_VALUE(@@NANS001) IF_GT(C05) EXECUTE (ADDOPT) (@@NANS0UO O @@PROCESS @@FUNCTION '''@@CANS0U+ D''') @@INC_IDX IDX_NAME(UC) @@INC_IDX IDX_NAME(UO) @@INC_IDX IDX_NAME(UD) @@GOTO LABEL(C04) C05: @@LABEL @@COMMENT (' ') USE BUILTIN(BUILD_WORK_OPTIONS) WITH_ARGS(#OPTLSTDET 70) T+ O_GET(#OPTLSTLIN #OPTLSTNUM) EXECUTE SUBROUTINE(FMTOPTLIN) EXECUTE SUBROUTINE(BLDPNTCLK) @@COMMENT (' ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: FMTOPTLIN') @@COMMENT ('Description....: Format Option Lines') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(FMTOPTLIN) @@COMMENT (' ') CHANGE FIELD(#@OPLN1 #@OPLN2) TO(*NULL) @@COMMENT (' ') BEGIN_LOOP TO(#@OPLNS) CHANGE FIELD(#@OPENT) TO('#@OPENT + 1') GET_ENTRY NUMBER(#@OPENT) FROM_LIST(#OPTLSTLIN) IF COND('(#IO$STS *NE OK) *AND (#@OPLN1 *EQ *BLANKS)') CHANGE FIELD(#@OPENT) TO(1) GET_ENTRY NUMBER(#@OPENT) FROM_LIST(#OPTLSTLIN) ENDIF IF_STATUS IS(*OKAY) IF COND('#@OPLN1 *EQ *BLANKS') CHANGE FIELD(#@OPLN1) TO(#@OPLIN) ELSE IF COND('#@OPLN2 *EQ *BLANKS') CHANGE FIELD(#@OPLN2) TO(#@OPLIN) ENDIF ENDIF ENDIF END_LOOP @@COMMENT (' ') IF COND('#@OPCNT *GT #@OPLNS') IF COND('#@OPLN2 *NE *BLANKS') USE BUILTIN(BCONCAT) WITH_ARGS(#@OPLN2 '''...''') TO_GET(#+ @OPLN2) ELSE IF COND('#@OPLN1 *NE *BLANKS') USE BUILTIN(BCONCAT) WITH_ARGS(#@OPLN1 '''...''') TO_GET(#+ @OPLN1) ENDIF ENDIF ENDIF @@COMMENT (' ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: BLDPNTCLK') @@COMMENT ('Description....: Build Point and Click Subfile') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(BLDPNTCLK) @@COMMENT (' ') SELECTLIST NAMED(#OPTLSTDT2) CHANGE FIELD(#@SVNUM) TO(#@OPNUM) LOC_ENTRY IN_LIST(#OPTLSTNUM) WHERE('#@SVNUM *EQ #@OPNUM') RET_E+ NTRY(*NO) IF_STATUS IS_NOT(*OKAY) DLT_ENTRY FROM_LIST(#OPTLSTDT2) ENDIF ENDSELECT @@COMMENT (' ') SELECTLIST NAMED(#OPTLSTDT2) ADD_ENTRY TO_LIST(#PNTCLICK) SET_SELECT(*NO) ENDSELECT @@COMMENT (' ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: ADDOPT') @@COMMENT ('Description....: Add options to detail List') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(ADDOPT) PARMS((#@OPNUM *RECEIVED) (#@OPFTP *RECEI+ VED) (#@OPPRC *RECEIVED) (#@OPFUN *RECEIVED) (#@OPFDS + *RECEIVED)) @@COMMENT (' ') ADD_ENTRY TO_LIST(#OPTLSTDET) ADD_ENTRY TO_LIST(#OPTLSTDT2) @@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 ....: SAVOP+ T ') @@COMMENT ('Description....: Save options off of Browse Lis+ t ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(SAVOPT) @@COMMENT (+ ' + ') SELECTLIST NAMED(#BRWOBJ) LOC_ENTRY IN_LIST(#OPTSAV) WHERE('#@RRSAV *EQ #@RRNUM') IF_STATUS IS(*OKAY) IF COND('#@OPOPT *GT 0') CHANGE FIELD(#@OPSAV) TO(#@OPOPT) UPD_ENTRY IN_LIST(#OPTSAV) ELSE DLT_ENTRY FROM_LIST(#OPTSAV) ENDIF ELSE IF COND('#@OPOPT *GT 0') CHANGE FIELD(#@OPSAV) TO(#@OPOPT) CHANGE FIELD(#@RRSAV) TO(#@RRNUM) ADD_ENTRY TO_LIST(#OPTSAV) SET_SELECT(*NO) ENDIF ENDIF ENDSELECT @@COMMENT (+ ' + ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: CHKOP+ T ') @@COMMENT ('Description....: Check option entere+ d ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(CHKOPT) @@COMMENT (+ ' + ') CHANGE FIELD(#@ERROR) TO(N) @@COMMENT (+ ' + ') CASE OF_FIELD(#@VWSEL) /* ======================================================= */ /* CREATE STATMENTS FOR DIFFERENT VIEWS */ /* ======================================================= */ @@SET_IDX IDX_NAME(JA) TO(1) @@SET_IDX IDX_NAME(JB) TO(71) JDL: @@LABEL @@CMP_IDX IDX_NAME(JA) IDX_VALUE(AF) IF_GT(JDE) WHEN VALUE_IS('= V@@INDEXJA') SORT_LIST NAMED(#OPTSAV) BY_FIELDS(@@LSTJB) @@INC_IDX IDX_NAME(JA) @@INC_IDX IDX_NAME(JB) @@GOTO LABEL(JDL) JDE: @@LABEL ENDCASE @@COMMENT (+ ' + ') SELECTLIST NAMED(#OPTSAV) LOC_ENTRY IN_LIST(#OPTLSTNUM) WHERE('#@OPSAV *EQ #@OPNUM') IF_STATUS IS_NOT(*OKAY) CHANGE FIELD(#@ERROR) TO(Y) LEAVE ENDIF ENDSELECT @@COMMENT (+ ' + ') ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: PRCOP+ T ') @@COMMENT ('Description....: Process options on browse lis+ t ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(PRCOPT) @@COMMENT (+ ' + ') @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(K03) CLR_LIST NAMED(#BRWDLTLST) @@COMMENT (+ ' + ') K03: @@LABEL SELECTLIST NAMED(#OPTSAV) WHERE('#@OPSAV *GT 0') CHANGE FIELD(#@RRNUM) TO(#@RRSAV) CASE OF_FIELD(#@OPSAV) @@IF COND((*IF @@CANS003 *EQ NO)) GOTO(F01) WHEN VALUE_IS('= 5') EXECUTE SUBROUTINE(MAINTOBJ) WITH_PARMS('DISPLAY') F01: @@LABEL @@IF COND((*IF @@CANS004 *EQ NO)) GOTO(F02) WHEN VALUE_IS('= 2') EXECUTE SUBROUTINE(MAINTOBJ) WITH_PARMS('CHANGE') F02: @@LABEL @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(F03) WHEN VALUE_IS('= 4') FETCH FIELDS((#BRWDLTLST)) FROM_FILE(@@FNAME01) WITH_RRN(#@R+ RNUM) ADD_ENTRY TO_LIST(#BRWDLTLST) CONTINUE F03: @@LABEL /* ======================================================= */ /* ADD ADDITIONAL OPTIONS */ /* ======================================================= */ @@SET_IDX IDX_NAME(UC) TO(1) @@SET_IDX IDX_NAME(UO) TO(20) @@SET_IDX IDX_NAME(UD) TO(30) F04: @@CMP_IDX IDX_NAME(UC) IDX_VALUE(@@NANS001) IF_GT(F05) WHEN VALUE_IS('= @@NANS0UO') EXECUTE SUBROUTINE(EXEOPT@@NANS0UO) @@INC_IDX IDX_NAME(UC) @@INC_IDX IDX_NAME(UO) @@INC_IDX IDX_NAME(UD) @@GOTO LABEL(F04) F05: @@LABEL ENDCASE IF COND('#@OPSAV *NE 4') DLT_ENTRY FROM_LIST(#OPTSAV) ENDIF LEAVE IF('#IO$KEY *EQ ''12''') ENDSELECT @@COMMENT (+ ' + ') @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(K04) IF COND('#@LSCNT3 *GT 0') EXECUTE SUBROUTINE(PRCDLT) ENDIF @@COMMENT (+ ' + ') K04: @@LABEL ENDROUTINE @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: POINTCLICK') @@COMMENT ('Description....: Process Point and Click') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(POINTCLICK) @@COMMENT (' ') GET_ENTRY NUMBER(#@LSENT) FROM_LIST(#BRWOBJ) @@COMMENT (' ') POP_UP FIELDS(@@LST71) DESIGN(*DOWN) IDENTIFY(*LABEL) DOWN_SE+ P(001) ACROSS_SEP(001) AT_LOC(9 44) WITH_SIZE(34 13) P+ ANEL_TITL('Select Option') BROWSELIST(#PNTCLICK) EXIT_+ KEY(*NO) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO) STD_HE+ AD(*NO) BEGINCHECK IF COND('#@PTENT *GT 0') GET_ENTRY NUMBER(#@PTENT) FROM_LIST(#PNTCLICK) CASE OF_FIELD(#@OPNUM) @@IF COND((*IF @@CANS003 *EQ NO)) GOTO(G01) WHEN VALUE_IS('= 5') EXECUTE SUBROUTINE(MAINTOBJ) WITH_PARMS('DISPLAY') G01: @@LABEL @@IF COND((*IF @@CANS004 *EQ NO)) GOTO(G02) WHEN VALUE_IS('= 2') EXECUTE SUBROUTINE(MAINTOBJ) WITH_PARMS('CHANGE') G02: @@LABEL @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(G03) WHEN VALUE_IS('= 4') EXECUTE SUBROUTINE(MAINTOBJ) WITH_PARMS('DELETE') G03: @@LABEL /* ======================================================= */ /* ADD ADDITIONAL OPTIONS */ /* ======================================================= */ @@SET_IDX IDX_NAME(UC) TO(1) @@SET_IDX IDX_NAME(UO) TO(20) @@SET_IDX IDX_NAME(UD) TO(30) G04: @@CMP_IDX IDX_NAME(UC) IDX_VALUE(@@NANS001) IF_GT(G05) WHEN VALUE_IS('= @@NANS0UO') EXECUTE SUBROUTINE(EXEOPT@@NANS0UO) @@INC_IDX IDX_NAME(UC) @@INC_IDX IDX_NAME(UO) @@INC_IDX IDX_NAME(UD) @@GOTO LABEL(G04) G05: @@LABEL ENDCASE ELSE SET_ERROR FOR_FIELD(#@OPNUM) MSGID(XX00008) MSGF(SBMSGF) ENDIF ENDCHECK @@COMMENT (' ') ENDROUTINE @@IF COND((*IF @@CANS005 *EQ NO)) GOTO(J02) @@COMMENT ('====================================================+ ===') @@COMMENT ('Subroutine ....: PRCDL+ T ') @@COMMENT ('Description....: Process Delete of Record+ s ') @@COMMENT ('====================================================+ ===') SUBROUTINE NAME(PRCDLT) @@COMMENT (+ ' + ') IF COND('#@LSCNT3 *EQ 1') GET_ENTRY NUMBER(1) FROM_LIST(#BRWDLTLST) EXECUTE SUBROUTINE(MAINTOBJ) WITH_PARMS('DELETE') IF COND('#IO$KEY *NE ''12''') LOC_ENTRY IN_LIST(#OPTSAV) WHERE('#@RRSAV *EQ #@RRNUM') DLT_ENTRY FROM_LIST(#OPTSAV) ENDIF ELSE BEGIN_LOOP USE (ALLOW_EXTRA_USER_KEY) (22 '''Delete''') DISPLAY FIELDS((#BRWDLTHED)) DESIGN(*DOWN) BROWSELIST(#BRWDLTL+ ST) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO) USE BUILTIN(DROP_EXTRA_USER_KEYS) IF COND('#IO$KEY *EQ ''22''') SELECTLIST NAMED(#BRWDLTLST) DELETE FROM_FILE(@@FNAME01) WITH_RRN(#@RRNUM) LOC_ENTRY IN_LIST(#OPTSAV) WHERE('#@RRSAV *EQ #@RRNUM') DLT_ENTRY FROM_LIST(#OPTSAV) ENDSELECT LEAVE ENDIF END_LOOP ENDIF @@COMMENT (+ ' + ') ENDROUTINE J02: @@LABEL @@IF COND((*IF @@CANS002 *EQ NO) (*AND @@CANS003 *EQ NO) (*+ AND @@CANS004 *EQ NO) (*AND @@CANS005 *EQ NO)) GOTO(H0+ 1) @@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 /* ======================================================= */ /* GENERATE ALL REQUIRED USER DEFINED ROUTINES */ /* ======================================================= */ @@SET_IDX IDX_NAME(UC) TO(1) @@SET_IDX IDX_NAME(UO) TO(20) @@SET_IDX IDX_NAME(UD) TO(30) I01: @@CMP_IDX IDX_NAME(UC) IDX_VALUE(@@NANS001) IF_GT(I02) @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Subroutine ....: EXEOPT@@NANS0UO') @@COMMENT COMMENT('Description....: Handle "@@NANS0UO = @@CANS0U+ D" request') @@COMMENT COMMENT('=============================================+ ==========') SUBROUTINE NAME(EXEOPT@@NANS0UO) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('Fill in details of CALL to external function') @@COMMENT COMMENT('that will handle Option @@NANS0UO=@@CANS0UD') @@COMMENT COMMENT(' ') @@COMMENT COMMENT('Remove IF, ENDIF and MESSAGE commands') @@COMMENT COMMENT('Replace XXXXXXX with correct function name') @@COMMENT COMMENT('Add EXCHANGE before CALL (as needed by calle+ d function)') @@COMMENT COMMENT(' ') IF COND('A = B') CALL PROCESS(*DIRECT) FUNCTION(XXXXXXX) EXIT_USED(*NEXT) ME+ NU_USED(*NEXT) ENDIF MESSAGE MSGTXT('Option @@NANS0UO=@@CANS0UD subroutine EXEOPT@@+ NANS0UO invoked') ENDROUTINE @@INC_IDX IDX_NAME(UC) @@INC_IDX IDX_NAME(UO) @@INC_IDX IDX_NAME(UD) @@GOTO LABEL(I01) I02: @@LABEL