/* ======================================================= */ /* ASK FOR THE "WORD" */ /* ======================================================= */ @@QUESTION PROMPT('Supply a word that describes WHAT this data en+ try program works with') ANSWER(@@CANS001) EXTEND('123+ 456789012345678' 'The word you specify here is used t+ o build messages that appear on the' 'data entry scree+ n panel. You should use ONE word only, use lowercase' + 'characters only and only use singular form (eg: "cust+ omer", "employee"' '"order"). Do NOT use more than 18 + characters in your answer.') /* ======================================================= */ /* GET NAME OF JUST ONE PHYSICAL FILE */ /* ======================================================= */ @@GET_FILS TO(1) PROMPT('Enter the name of the PHYSICAL file to b+ e used by this template') EXTEND('The file name may b+ e specified in full, partially (to cause a partial lis+ t' 'of available files to be displayed) or left blank + (to cause a full list of' 'available files to be displ+ ayed). When a list of files is displayed, the' 'file r+ equired may be selected from the list.') /* ======================================================= */ /* GET FIELDS OF CHOSEN FILE INTO LIST 1 */ /* ======================================================= */ @@CLR_LST NUMBER(1) @@RTV_FLDS FROM_FILE(1) INTO_LST(1) /* ======================================================= */ /* GET KEYS OF CHOSEN FILE INTO LIST 2 */ /* ======================================================= */ @@CLR_LST NUMBER(2) @@RTV_KEYS OF_FILE(1) INTO_LST(2) /* ======================================================= */ /* GET USER TO CHOOSE FIELDS TO APPEAR ON PANEL */ /* AND PUT RESULTS INTO LIST 4 */ /* ======================================================= */ @@CLR_LST NUMBER(3) @@CLR_LST NUMBER(4) @@MAK_LSTS FROM_LSTS(1) INTO_LSTS((3 'Fields to' 'Appear on' 'Ad+ d Panel' *SEQUENCE *ALL)) @@MAK_LSTS FROM_LSTS(1) FORCE_LSTS(2) INTO_LSTS((4 'Fields to' 'A+ ppear on' 'Chg Panel' *SEQUENCE *ALL)) @@CLR_LST NUMBER(5) @@MRG_LSTS FROM_LSTS((2 *NC) (4)) INTO_LST(5) /* ======================================================= */ /* ASK HOW THE PANEL IS TO BE DESIGNED */ /* ======================================================= */ @@QUESTION PROMPT('Design fields on the data entry panel DOWN th+ e screen or ACROSS the screen') ANSWER(@@CANS002) EXTE+ ND('Reply DOWN or ACROSS only.' 'If your data entry pa+ nel contains 17 (or less) fields, DOWN is the ' 'rec+ ommended value. If your data entry panel contains mor+ e than 17' 'fields, ACROSS is the recommended value.'+ ) LOWER(*NO) VALUES(DOWN ACROSS D A) SPCVAL((D DOWN) (+ A ACROSS)) /* ======================================================= */ /* 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: SBFMAINT v 1.0') @@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(#@UPCNT #@LSTFN) OPTION(A) CHANGE FIELD(#@LSTFN) TO(*FUNCTION) @@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(*DELETE) COND('#@OBMOD *EQ DELETE') COLHDG(*NO) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Browse or Working Lists(DEF_LIST statments)') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Screen Panel Groups(GROUP_BY statments)') @@COMMENT COMMENT('=============================================+ ==========') GROUP_BY NAME(#ADD$DATA) FIELDS(@@LST03) GROUP_BY NAME(#MNT$DATA) FIELDS(@@LST05) @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Initalization(CHANGE and CLR_LIST statments)') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT(' ') @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Function Mainline') @@COMMENT COMMENT('=============================================+ ==========') CASE OF_FIELD(#@OBMOD) WHEN VALUE_IS('= ADD') SET_MODE TO(*ADD) EXECUTE SUBROUTINE(ADDRCD) WHEN VALUE_IS('= CHANGE') SET_MODE TO(*CHANGE) EXECUTE SUBROUTINE(MAINTRCD) WHEN VALUE_IS('= DELETE') SET_MODE TO(*DELETE) EXECUTE SUBROUTINE(MAINTRCD) WHEN VALUE_IS('= DISPLAY') SET_MODE TO(*DISPLAY) EXECUTE SUBROUTINE(MAINTRCD) OTHERWISE RETURN ENDCASE @@COMMENT COMMENT(' ') EXCHANGE FIELDS(#IO$KEY) RETURN @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Subroutine ....: ADDRCD') @@COMMENT COMMENT('Description....: Add new data to @@FNAME01') @@COMMENT COMMENT('=============================================+ ==========') SUBROUTINE NAME(ADDRCD) @@COMMENT COMMENT('Issue initial data entry message') MESSAGE MSGID(XX00003) MSGF(SBMSGF) MSGDTA('''@@CANS001''') @@COMMENT COMMENT('Do data entry until terminated by CANCEL') BEGIN_LOOP @@COMMENT COMMENT('Change all fields to their defaults') CHANGE FIELD(#ADD$DATA) TO(*DEFAULT) @@COMMENT COMMENT('Request user inputs (or corrects) details') DISPLAY FIELDS((#ADD$DATA)) DESIGN(*@@CANS002) IDENTIFY(*LABEL+ ) MENU_KEY(*YES *RETURN) @@COMMENT COMMENT('Perform any function level validation here') BEGINCHECK ENDCHECK @@COMMENT COMMENT('Attempt to insert data into the data base') INSERT FIELDS((#ADD$DATA)) TO_FILE(@@FNAME01) CHANGE FIELD(#@UPCNT) TO('#@UPCNT + 1') MESSAGE MSGID(XX00004) MSGF(SBMSGF) MSGDTA('''@@CANS001''') END_LOOP ENDROUTINE @@COMMENT COMMENT('=============================================+ ==========') @@COMMENT COMMENT('Subroutine ....: MAINTRCD') @@COMMENT COMMENT('Description....: Maintain Record') @@COMMENT COMMENT('=============================================+ ==========') SUBROUTINE NAME(MAINTRCD) @@COMMENT COMMENT('Fetch file @@FNAME01 details') CHANGE FIELD(#MNT$DATA) TO(*NULL) FETCH FIELDS((#MNT$DATA)) FROM_FILE(@@FNAME01) WITH_RRN(#@RR+ NUM) @@COMMENT COMMENT('Set screen to correct mode') DOUNTIL COND('(#IO$MDE *NE DLT) *OR ((#IO$KEY *EQ ''22'') *AN+ D (#IO$MDE *EQ DLT))') IF_MODE IS(*DELETE) MESSAGE MSGID(XX00005) MSGF(SBMSGF) MSGDTA('''@@CANS001''') ENDIF @@COMMENT COMMENT('Display results to the user') DISPLAY FIELDS((#MNT$DATA)) DESIGN(*@@CANS002) IDENTIFY(*LABEL+ ) MENU_KEY(*YES *RETURN) USER_KEYS((22 'Delete' *NEXT + *DELETE)) IF_MODE IS(*CHANGE) BEGINCHECK ENDCHECK UPDATE FIELDS((#MNT$DATA)) IN_FILE(@@FNAME01) CHANGE FIELD(#@UPCNT) TO('#@UPCNT + 1') MESSAGE MSGID(XX00006) MSGF(SBMSGF) MSGDTA('''@@CANS001''') ENDIF IF_MODE IS(*DELETE) IF COND('#IO$KEY *EQ ''22''') DELETE FROM_FILE(@@FNAME01) CHANGE FIELD(#@UPCNT) TO('#@UPCNT + 1') MESSAGE MSGID(XX00007) MSGF(SBMSGF) MSGDTA('''@@CANS001''') ENDIF ENDIF ENDUNTIL ENDROUTINE