IDENTIFICATION DIVISION. PROGRAM-ID. UIF340. AUTHOR. K.GAMBLE,W.KARZEN-SD.DIGITAL. INSTALLATION. FLEETWOOD ENTERPRISES, INC. DATE-WRITTEN. 16-APR-84. *************************************************************************** * * PROGRAM FUNCTIONS: User Interface Maintenance Program. This program * creates and maintains the master file, username file * and security file for the User Interface. * * PROGRAM OPTIONS: Addition, change, deletion, and display of records * in the Master and Username files. Automatic creation * of the Security file as needed. * * PROGRAM MODIFICATIONS: * * AUTHOR T. MOORE * DATE 05-AUG-86 * VERSION 2-B * * PROGRAM CHANGES: * Correct 'REWRITE ERROR' in change menu code. * *********************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. SPECIAL-NAMES. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT UIF-MASTER-FILE ASSIGN TO DISK ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC. SELECT UIF-USERNAME-FILE ASSIGN TO DISK ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC. SELECT UIF-SECURITY-FILE ASSIGN TO DISK ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC. SELECT UIF-LOG-FILE ASSIGN TO DISK. / DATA DIVISION. FILE SECTION. FD UIF-MASTER-FILE COPY "UIF-MASTER-FD" OF "LIB:UIFLIB". COPY "MASTER-RECORD" OF "LIB:UIFLIB". / FD UIF-USERNAME-FILE COPY "UIF-USERNAME-FD" OF "LIB:UIFLIB". COPY "USERNAME-RECORD" OF "LIB:UIFLIB". / FD UIF-SECURITY-FILE COPY "UIF-SECURITY-FD" OF "LIB:UIFLIB". COPY "SECURITY-RECORD" OF "LIB:UIFLIB". / FD UIF-LOG-FILE VALUE OF ID IS "UIF340.PR1". 01 LOG-RECORD. 05 LOG-MESSAGE PIC X(50). 05 LOG-REC PIC X(30). / WORKING-STORAGE SECTION. 01 PROG-ID PIC X(09) VALUE "UIF340-2B". COPY "SWITCH-RECORD" OF "LIB:UIFLIB". COPY "FORM-UIF340SC1" OF "LIB:UIFLIB". COPY "FORM-UIF340SC2" OF "LIB:UIFLIB". COPY "FORM-UIF340SC3" OF "LIB:UIFLIB". COPY "FORM-UIF340SC4" OF "LIB:UIFLIB". COPY "SCOPE-STATUS-RECORD" OF "LIB:SCPLIB". COPY "SCOPE-SCREEN-IMAGE" OF "LIB:SCPLIB". COPY "ABNORMAL-TERMINATION-RECORD" OF "LIB:UTLLIB". 01 WS-MASTER-RECORD. 05 WS-MASTER-PRIMARY-KEY. 10 WS-MASTER-RECORD-NAME PIC X(9). 10 WS-MASTER-RECORD-TYPE PIC X. 05 WS-MASTER-RECORD-ACCESS-COUNT PIC S9(4) COMP. 05 WS-MASTER-TRANSACTION. 10 WS-MASTER-TRANSACTION-DESC PIC X(60). 10 WS-MASTER-TRANSACTION-TYPE PIC X(1). 10 WS-MASTER-TRANSACTION-FORM PIC X(31). 10 WS-MASTER-TRANSACTION-SWITCH PIC X(31). 10 FILLER PIC X(139). 05 WS-MASTER-MENU REDEFINES WS-MASTER-TRANSACTION. 10 WS-MASTER-MENU-TITLE PIC X(20). 10 WS-MASTER-MENU-DESCRIPTION PIC X(60). 10 WS-MASTER-MENU-NODE-CNT PIC S9(4) COMP. 10 WS-MASTER-MENU-NODE PIC X(9) OCCURS 20 TIMES. 01 WS-MASTER-PRIMARY-KEY-SAVE. 10 WS-MASTER-RECORD-NAME-SAVE PIC X(9). 10 WS-MASTER-RECORD-TYPE-SAVE PIC X. 01 WS-USER-RECORD. 05 WS-USERNAME PIC X(12) VALUE SPACES. 05 WS-GENERIC-NAME PIC X(12) VALUE SPACES. 05 WS-TOP-LEVEL-MENU-NAME PIC X(09) VALUE SPACES. 01 WS-SECURITY-RECORD. 05 WS-GENERIC-USERNAME PIC X(12) VALUE SPACES. 05 WS-TRANSACTION-NAME PIC X(09) VALUE SPACES. 01 WS-HISTORY-SYMBOL PIC X(01). 01 TRACK-INDEX PIC 9(02). 01 TRACK-COUNT PIC 9(02). 01 MAX-TRACK-COUNT PIC 9(02) VALUE 50. 01 WS-TRACK-TRANSACTION-COUNT. 05 TRACK-TRANSACTION-COUNT OCCURS 50 TIMES. 10 TRANSACTION-NAME-TRACK PIC X(9). 10 TRANSACTION-TYPE-TRACK PIC X(01). 10 TRANSACTION-HISTORY-TRACK PIC X(01). 88 TRANSACTION-COUNT-INCREMENTED VALUE "I". 88 TRANSACTION-COUNT-DECREMENTED VALUE "D". 01 WS-DCL-COMMAND. 05 DCL PIC X(08) VALUE "$ RENAME". 05 FROM-FILENAME PIC X(13) VALUE " UIF_SECURITY". 05 TO-FILENAME PIC X(17) VALUE " UIF_SECURITY_REN". 01 RETURN-STATUS PIC S9(9) COMP. 01 IMAGE-NAME PIC X(06) VALUE "UIF340". COPY "WS-RECORD" OF "LIB:UIFLIB". 01 SCOPE-DATA-ITEMS. 05 MAIN-MENU-SCREEN PIC X(9) VALUE "UIF340SC1". 05 GENERIC-USER-SCREEN PIC X(9) VALUE "UIF340SC2". 05 TRANS-SCREEN PIC X(9) VALUE "UIF340SC3". 05 MENU-SCREEN PIC X(9) VALUE "UIF340SC4". 05 SCOPE-ERROR-MSG PIC X(80). 05 DISPLAY-MSG PIC X(80). 05 USER-ESCAPE PIC X. 88 USER-ABORT VALUE "A". 88 USER-MENU VALUE "M". 88 USER-VALID-ESCAPE VALUE "A","M"," ". 05 DISPLAY-HOLD PIC X VALUE "D". 88 KILL-DISPLAY VALUE "K". 88 GIVE-DISPLAY VALUE "D". 05 UIF-RESPONSE PIC X(2). 05 UIF-FIELD PIC X(2). 05 SCP-CLEAR-SCREEN COMP PIC S9(9) VALUE 1. 01 PROCESS-COUNT PIC 9(2). 01 MAX-TRANSACT-PER-MENU PIC 9(2) VALUE 20. 01 WS-MESSAGES. 05 INITIAL-PROMPT PIC X(23) VALUE "Enter Selection Number:". 05 STANDARD-PROMPT PIC X(27) VALUE "Enter: P=Process, #=Change:". 05 DISPLAY-PROMPT PIC X(15) VALUE "Enter: F=Finish". 05 MENU-PROMPT PIC X(43) VALUE "Press RETURN when finished entering options". 05 RECORD-ADDED PIC X(21) VALUE "Record has been added". 05 ADD-CANCELLED PIC X(13) VALUE "Add Cancelled". 05 DELETE-OK PIC X(24) VALUE "Record has been deleted". 05 DELETE-CAN PIC X(16) VALUE "Delete Canceled". 05 DELETE-QUESTION PIC X(28) VALUE "Delete this record? (Y or N)". 05 CHANGE-OK PIC X(24) VALUE "Record has been changed". 05 ACTION-ABORTED PIC X(29) VALUE "Transaction has been aborted". 05 ADD-TRANSACTION-QUERY PIC X(47) VALUE "Do You Wish To Add A New Transaction - Y or N ?". 05 ADD-MENU-QUERY PIC X(40) VALUE "Do You Wish To Add A New Menu - Y or N ?". 05 OPTION-VALID PIC X(25) VALUE "Option has been validated". 05 NO-CHANGE-ALLOWED PIC X(35) VALUE "Change of that field is not allowed". 05 TABLE-FULL-EXIT PIC X(46) VALUE "Transaction aborted Table full, Please exit". 05 TRACK-TABLE-FULL PIC X(52) VALUE "No more changes allowed to this menu, Please process". 05 INVALID-RESPONSE PIC X(28) VALUE "Invalid Response! Try again.". 05 RECORD-EXISTS PIC X(29) VALUE "Record already exists on file". 05 WRITE-ERROR PIC X(22) VALUE "Invalid Write Attempt!". 05 REWRITE-ERROR PIC X(23) VALUE "Error Rewriting Record!". 05 DELETE-ERROR PIC X(23) VALUE "Error DELETING Record!". 05 NO-SUCH-RECORD PIC X(29) VALUE "Record does not exist on file". 05 NO-TRAN PIC X(32) VALUE "Transaction Record Doesn't Exist". 05 NO-MENU PIC X(25) VALUE "Menu Record Doesn't Exist". 05 NO-CORR-RECORD PIC X(59) VALUE "No Corresponding Record for Menu Option (*), Please Remove!". 05 NO-VALID-TYPE PIC X(48) VALUE "Type entered is Invalid, Enter either 'M' or 'T'". 05 SCOPE-ERROR-ESCAPE PIC X(80) VALUE "Invalid Escape Entered, (A)bort or (M)enu valid". * AREA TO STORE MASTER FILE RECORDS * UP TO 50 RECORDS * USED DURING RECURSIVE TEST AND REBUILD OF SECURITY * 01 WS-LIST-RECORD-TBL. 03 WS-LIST-RECORD OCCURS 51 TIMES. 05 WS-LIST-PRIMARY-KEY. 10 WS-LIST-RECORD-NAME PIC X(9). 10 WS-LIST-RECORD-TYPE PIC X. 05 WS-LIST-RECORD-ACCESS-COUNT PIC S9(4) COMP. 05 WS-LIST-TRANSACTION. 10 WS-LIST-TRANSACTION-DESC PIC X(60). 10 FILLER PIC X(202). 05 WS-LIST-MENU REDEFINES WS-LIST-TRANSACTION. 10 WS-LIST-MENU-TITLE PIC X(20). 10 WS-LIST-MENU-DESCRIPTION PIC X(60). 10 WS-LIST-MENU-NODE-CNT PIC S9(4) COMP. 10 WS-LIST-MENU-NODE PIC X(9) OCCURS 20 TIMES. 05 WS-LIST-MENU-CUR-NODE PIC S9(4) COMP. 01 TABLE-MAX PIC S9(4) COMP VALUE 50. * USED TO VALIDATE USERNAMES AND MASTERFILE NAMES 01 WS-NAME-TABLE PIC X(12). 01 WS-NAME-TBL-01 REDEFINES WS-NAME-TABLE. 05 WS-NAME-TBL PIC X OCCURS 12 TIMES. 01 WS-NAME-SUB PIC S9(4) COMP. * TRACKS CHANGES TO THE SYSTEM REQUIRING VALIDATION. * FUNCTION A=ADD,D=DELETE TYPE U=USER,T=TRANSACTION * 01 WS-OTHER-CHANGE-TBL. 05 WS-OTHER-CHANGE-RECORD OCCURS 51 TIMES. 10 WS-OTHER-FUNCTION PIC X(1). 10 WS-OTHER-TYPE PIC X(1). 10 WS-OTHER-NAME PIC X(12). * THE FOLLOWING STORES INFORMATION TEMPORARILY WHILE PROCESSING SUB MENUS * 01 WS-STORE-UIF-INFORMATION. 05 WS-STORE-UIF OCCURS 25 TIMES. 10 WS-STORE-UIF-DATA-1 PIC X(118). 10 WS-STORE-INFO OCCURS 20 TIMES. 20 WS-STORE-UIF-OPTION PIC X(9). 20 WS-STORE-UIF-TYPE PIC X(1). 10 FILLER PIC X(79). 05 WS-STORE-OPTION PIC X(9). 05 WS-STORE-MESSAGE PIC X(60). 05 WS-STORE-UIF-FIELD-NUMERIC OCCURS 25 TIMES. 10 WS-TEMP-UIF-FIELD PIC 9(2). 05 WS-STORE-OPTION-INDEX OCCURS 25 TIMES. 10 WS-TEMP-OPT-IDX PIC 9(2). 05 WS-STORE-NODE-CNT OCCURS 25 TIMES. 10 WS-TEMP-NODE-CNT PIC 9(2). 05 WS-STORE-ACCESS-CNT OCCURS 25 TIMES. 10 WS-TEMP-ACCESS-CNT PIC 9(3). 05 WS-STORE-CORRECTION-SW OCCURS 25 TIMES. 10 WS-TEMP-CORR-SW PIC X(01). * USED TO SAVE TOP LEVEL MENU IN TEST FOR RECURSION * 01 WS-01-USER-MENU-TABLE. 05 WS-USER-MENU-TABLE OCCURS 100 TIMES. 10 WS-TMP-USR-MNU-TBL PIC X(9). 01 UMT-SUB PIC S9(4) COMP. 01 U-SUB PIC S9(4) COMP. 01 UMT-SW PIC X(01) VALUE "N". 88 ON-LIST VALUE IS "Y". * TEMPORARY STORAGE AREAS WHILE REORGANINZING NODES * 01 WS-STORE-NODE-INFO. 05 WS-TMP-NODE-INDEX PIC 9(2) VALUE ZEROS. 05 WS-CURR-NODE-END PIC 9(2) VALUE ZEROS. 05 WS-STORE-NODE-INDEX PIC 9(2) VALUE ZEROS. 05 WS-ORIG-NODE-CNT PIC 9(2) VALUE ZEROS. * SIGNALS CHANGES TO THE MENU STRUCTURE * 01 STRUCTURE-SW PIC X(01) VALUE "N". 88 STRUCTURE-CHANGES VALUE IS "Y". * SIGNALS CHANGES TO USER RECORDS * 01 USER-CHANGE-SW PIC X(01) VALUE "N". 88 OTHER-CHANGES VALUE IS "Y". * SWITCH TO CONTROL REBUILDING ONE OR ALL USERS FOR SECURITY * 01 FIX-SW PIC X(01) VALUE "N". 88 FROM-FIX-SECURITY VALUE IS "Y". 88 NOT-FROM-FIX-SECURITY VALUE IS "N". * INDICATES IF IN SUB MENU * 01 MENU-SW PIC X(01) VALUE "N". 88 FROM-MENU VALUE IS "Y". * INDICATES IF FROM CHANGE MENU * 01 CHANGE-MENU-SW PIC X(01) VALUE "N". 88 FROM-CHANGE-MENU VALUE IS "Y". * INDICATES IF IN SUB TRANSACTION * 01 TRANS-SW PIC X(01) VALUE "N". 88 TRANS-FROM-MENU VALUE IS "Y". * INDICATES IF PROCESSING OPTIONS WHILE WITHIN SUB MENU * 01 LEVEL-SW PIC X(01) VALUE "N". 88 NEXT-LEVEL VALUE "Y". 88 SAME-LEVEL VALUE "N". * SHOWS IF FIELD IS BEING CORRECTED * 01 CORRECTION-SW PIC X(01) VALUE "N". 88 CORRECTION VALUE "Y". * SHOWS IF CONTROL-M WAS REQUESTED IN SUB MENU * 01 CONTROL-M-INDICATOR PIC X(01) VALUE "N". 88 CONTROL-M VALUE "Y". * USED IN RECURSIVE AND REBUILD SECURITY , POINTERS TO * LAST MENU PLACED ON LIST AND NODE OF CURRENT MENU * 01 WS-STORE-RECURSION-POINTERS. 05 L-SUB PIC S9(4) COMP. 05 FIX-SUB PIC S9(4) COMP. 05 CHK-SUB PIC S9(4) COMP. * SHOWS OPTION ON MENU SCREEN * 01 OPTION-INDEX PIC 9(2) VALUE ZEROS. 01 NEXT-OPTION-NBR PIC 9(2) VALUE ZEROS. * MAINIPULATES OPTION STACK * 01 NODE-INDEX PIC 9(2) VALUE ZEROS. * WS FOR # OF OPTIONS/NODES ON MENU RECORD * 01 WS-NODE-CNT PIC 9(2) VALUE ZEROS. * MANIPULATES CHANGE TABLE * 01 CHG-TBL-IDX PIC 9(2) VALUE ZEROS. * SHOWS ACTIVE ITEM WITHIN MENU * 01 WS-UIF-FIELD-NUMERIC PIC 9(2) VALUE ZEROS. 01 WS-UIF-FIELD-ALPHA REDEFINES WS-UIF-FIELD-NUMERIC. 05 WS-UIF-FIELD PIC X(2). * BREAKS UP FIELD FOR DETERMINING IF OPTION OR TYPE PROCESSING * 01 WS-STORE-FIELD PIC 9(2) VALUE ZEROS. 01 WS-STORE-FIELD-ALT REDEFINES WS-STORE-FIELD. 05 FIELD-TENS-POSITION PIC 9(1). 05 FIELD-ONES-POSITION PIC 9(1). 88 ODD VALUE 1, 3, 5, 7, 9. 88 EVEN VALUE 0, 2, 4, 6, 8. / PROCEDURE DIVISION. ******************************************************************************* Initialization Section. ******************************************************************************* 000-INIT. MOVE "*" TO SCOPE-BUFFER-NAME. MOVE 0 TO SCOPE-BACKTAB-LIMIT. INITIALIZE ABNORMAL-TERMINATION-RECORD. PERFORM 800-OPEN-FILES THRU 800-OPEN-FILES-EXIT. INITIALIZE FORM-SC1, FORM-SC2, FORM-SC3, FORM-SC4. * * Move high values so Scope will not display the PROCESS prompt until desired * MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC3-UIF-PROMPT, SC4-UIF-PROMPT. MOVE PROG-ID TO SC1-UIF-PROGRAM-ID, SC2-UIF-PROGRAM-ID, SC3-UIF-PROGRAM-ID, SC4-UIF-PROGRAM-ID. INITIALIZE WS-OTHER-CHANGE-TBL, WS-STORE-UIF-INFORMATION, WS-STORE-NODE-INFO, WS-STORE-RECURSION-POINTERS. MOVE ZEROS TO L-SUB. / ******************************************************************************* Main Section. ******************************************************************************* 100-MAIN. PERFORM 205-MAIN-MENU THRU 205-MAIN-MENU-EXIT. EVALUATE SC1-UIF-SELECTION WHEN "1 " PERFORM 210-ADD-USER THRU 210-ADD-USER-EXIT WHEN "2 " PERFORM 220-CHANGE-USER THRU 220-CHANGE-USER-EXIT WHEN "3 " PERFORM 230-DELETE-USER THRU 230-DELETE-USER-EXIT WHEN "4 " PERFORM 240-DISPLAY-USER THRU 240-DISPLAY-USER-EXIT WHEN "5 " PERFORM 250-ADD-MENU THRU 250-ADD-MENU-EXIT WHEN "6 " PERFORM 260-CHANGE-MENU THRU 260-CHANGE-MENU-EXIT WHEN "7 " PERFORM 270-DELETE-MENU THRU 270-DELETE-MENU-EXIT WHEN "8 " PERFORM 280-DISPLAY-MENU THRU 280-DISPLAY-MENU-EXIT WHEN "9 " PERFORM 290-ADD-TRANSACTION THRU 290-ADD-TRANSACTION-EXIT WHEN "10" PERFORM 300-CHANGE-TRANSACTION THRU 300-CHANGE-TRANSACTION-EXIT WHEN "11" PERFORM 310-DELETE-TRANSACTION THRU 310-DELETE-TRANSACTION-EXIT WHEN "12" PERFORM 320-DISPLAY-TRANSACTION THRU 320-DISPLAY-TRANSACTION-EXIT WHEN "13" GO TO 900-RECUR-SECUR-ZERO-TESTS WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT END-EVALUATE. GO TO 100-MAIN. / ******************************************************************************* SUBROUTINE SECTION. ******************************************************************************* 205-MAIN-MENU. MOVE " Main Menu " TO SC1-UIF-TITLE. MOVE INITIAL-PROMPT TO SC1-UIF-PROMPT. MOVE SPACES TO SC1-UIF-SELECTION. MOVE "N" TO INVALID-KEY-SW, TRANS-SW, MENU-SW, CORRECTION-SW. MOVE MAIN-MENU-SCREEN TO SCOPE-FORM-NAME. MOVE FNO-SC1-UIF-SELECTION TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. * * All versions of user escape will go to the same place for this screen. * The following statements are here in case future needs require a different * branch. In that case, at least the lines will be here to help the * programmer realize that the user escape has to be handled. * IF USER-MENU GO TO 205-MAIN-MENU. IF USER-ABORT GO TO 205-MAIN-MENU. IF NOT USER-VALID-ESCAPE GO TO 205-MAIN-MENU. 205-MAIN-MENU-EXIT. EXIT. / 210-ADD-USER. INITIALIZE WS-USER-RECORD, FORM-SC2. MOVE "N" TO CORRECTION-SW. MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC2-UIF-RESPONSE. MOVE PROG-ID TO SC2-UIF-PROGRAM-ID. MOVE " Add User Record " TO SC2-UIF-TITLE. MOVE GENERIC-USER-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 210-ADD-GENERIC-NAME. MOVE FNO-SC2-UIF-GENERIC-NAME TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 210-ADD-USER-EXIT. IF USER-ABORT GO TO 210-ADD-USER. IF NOT USER-VALID-ESCAPE GO TO 210-ADD-GENERIC-NAME. * * CHECK THAT USERNAME IS IN A VALID VMS FILE SPEC FORMAT * MOVE SC2-UIF-GENERIC-NAME TO WS-NAME-TABLE. PERFORM 745-CHECK-NAME THRU 745-CHECK-NAME-EXIT. EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 210-USER-READ-CONT WHEN OTHER INITIALIZE SCOPE-ERROR-MSG GO TO 210-ADD-GENERIC-NAME END-EVALUATE. 210-USER-READ-CONT. MOVE SC2-UIF-GENERIC-NAME TO WS-USERNAME, WS-GENERIC-NAME. MOVE WS-USER-RECORD TO USERNAME-RECORD. PERFORM 660-READ-USER THRU 660-READ-USER-EXIT. * RECORD SHOULD NOT BE FOUND ON ADD * IF INVALID-KEY GO TO 210-GET-TOP-MENU ELSE MOVE RECORD-EXISTS TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 210-ADD-GENERIC-NAME. 210-GET-TOP-MENU. IF CORRECTION MOVE "N" TO CORRECTION-SW GO TO 210-GET-PROCESS-RESPONSE. MOVE "N" TO INVALID-KEY-SW. MOVE FNO-SC2-UIF-TOP-LEVEL-MENU TO SCOPE-NEXT-FIELD. MOVE GENERIC-USER-SCREEN TO SCOPE-FORM-NAME. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 210-ADD-USER-EXIT. IF USER-ABORT GO TO 210-ADD-USER. IF NOT USER-VALID-ESCAPE GO TO 210-GET-TOP-MENU. MOVE SC2-UIF-TOP-LEVEL-MENU TO WS-TOP-LEVEL-MENU-NAME. / 210-GET-PROCESS-RESPONSE. MOVE STANDARD-PROMPT TO SC2-UIF-PROMPT. MOVE FNO-SC2-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC2-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 210-ADD-USER-EXIT. IF USER-ABORT GO TO 210-ADD-USER. IF NOT USER-VALID-ESCAPE GO TO 210-GET-PROCESS-RESPONSE. STRING SC2-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC2-UIF-RESPONSE. EVALUATE UIF-RESPONSE WHEN "P ", GO TO 210-WRITE-USER WHEN "1 ", MOVE "Y" TO CORRECTION-SW GO TO 210-ADD-GENERIC-NAME WHEN "2 ", GO TO 210-GET-TOP-MENU WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 210-GET-PROCESS-RESPONSE END-EVALUATE. 210-WRITE-USER. ADD 1 TO CHG-TBL-IDX. * * If CHG-TBL-IDX is greater than or equal to table-max, give error * IF CHG-TBL-IDX NOT < TABLE-MAX MOVE TABLE-FULL-EXIT TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 210-ADD-USER-EXIT. PERFORM 665-WRITE-USER THRU 665-WRITE-USER-EXIT. IF INVALID-KEY MOVE WRITE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT MOVE "N" TO INVALID-KEY-SW GO TO 210-ADD-USER. MOVE RECORD-ADDED TO DISPLAY-MSG. PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT. * SET SWITCH TO INDICATE CHANGE TO USER FILE * MOVE "A" TO WS-OTHER-FUNCTION (CHG-TBL-IDX). MOVE "U" TO WS-OTHER-TYPE (CHG-TBL-IDX). MOVE WS-GENERIC-NAME TO WS-OTHER-NAME (CHG-TBL-IDX). MOVE "Y" TO USER-CHANGE-SW. GO TO 210-ADD-USER. 210-ADD-USER-EXIT. EXIT. / 220-CHANGE-USER. INITIALIZE WS-USER-RECORD, FORM-SC2. MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC2-UIF-RESPONSE. MOVE PROG-ID TO SC2-UIF-PROGRAM-ID. MOVE " Change User Record " TO SC2-UIF-TITLE. MOVE GENERIC-USER-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 220-DISPLAY-GENERIC-NAME. MOVE FNO-SC2-UIF-GENERIC-NAME TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 220-CHANGE-USER-EXIT. IF USER-ABORT GO TO 220-CHANGE-USER. IF NOT USER-VALID-ESCAPE GO TO 220-DISPLAY-GENERIC-NAME. MOVE SC2-UIF-GENERIC-NAME TO WS-USERNAME, WS-GENERIC-NAME. MOVE WS-USER-RECORD TO USERNAME-RECORD. PERFORM 660-READ-USER THRU 660-READ-USER-EXIT. IF INVALID-KEY MOVE NO-SUCH-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 220-DISPLAY-GENERIC-NAME ELSE MOVE WS-TOP-LEVEL-MENU-NAME TO SC2-UIF-TOP-LEVEL-MENU MOVE FNO-SC2-UIF-TOP-LEVEL-MENU TO SCOPE-NEXT-FIELD PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT END-IF. GO TO 220-GET-RESPONSE. 220-GET-TOP-MENU. MOVE "N" TO INVALID-KEY-SW. MOVE FNO-SC2-UIF-TOP-LEVEL-MENU TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 220-CHANGE-USER-EXIT. IF USER-ABORT GO TO 220-CHANGE-USER. IF NOT USER-VALID-ESCAPE GO TO 220-GET-TOP-MENU. MOVE SC2-UIF-TOP-LEVEL-MENU TO WS-TOP-LEVEL-MENU-NAME. 220-GET-RESPONSE. MOVE STANDARD-PROMPT TO SC2-UIF-PROMPT. MOVE FNO-SC2-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC2-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 220-CHANGE-USER-EXIT. IF USER-ABORT GO TO 220-CHANGE-USER. IF NOT USER-VALID-ESCAPE GO TO 220-GET-RESPONSE. STRING SC2-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC2-UIF-RESPONSE. EVALUATE UIF-RESPONSE WHEN "P " GO TO 220-REWRITE-IT WHEN "2 ", GO TO 220-GET-TOP-MENU WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 220-GET-RESPONSE END-EVALUATE. / 220-REWRITE-IT. ADD 1 TO CHG-TBL-IDX. * * If CHG-TBL-IDX is greater than or equal to table-max, give error * IF CHG-TBL-IDX NOT < TABLE-MAX MOVE TABLE-FULL-EXIT TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 220-CHANGE-USER-EXIT. PERFORM 667-REWRITE-USER THRU 667-REWRITE-USER-EXIT. IF INVALID-KEY MOVE REWRITE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT MOVE "N" TO INVALID-KEY-SW GO TO 220-CHANGE-USER. MOVE CHANGE-OK TO DISPLAY-MSG. PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT. * * CHANGE = DELETE + ADD * MOVE "D" TO WS-OTHER-FUNCTION (CHG-TBL-IDX). MOVE "U" TO WS-OTHER-TYPE (CHG-TBL-IDX). MOVE WS-GENERIC-NAME TO WS-OTHER-NAME (CHG-TBL-IDX). ADD 1 TO CHG-TBL-IDX. MOVE "A" TO WS-OTHER-FUNCTION (CHG-TBL-IDX). MOVE "U" TO WS-OTHER-TYPE (CHG-TBL-IDX). MOVE WS-GENERIC-NAME TO WS-OTHER-NAME (CHG-TBL-IDX). MOVE "Y" TO USER-CHANGE-SW. GO TO 220-CHANGE-USER. 220-CHANGE-USER-EXIT. EXIT. / 230-DELETE-USER. INITIALIZE WS-USER-RECORD, FORM-SC2. MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC2-UIF-RESPONSE. MOVE PROG-ID TO SC2-UIF-PROGRAM-ID. MOVE " Delete User Record " TO SC2-UIF-TITLE. MOVE GENERIC-USER-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 230-DISPLAY-GENERIC-NAME. MOVE FNO-SC2-UIF-GENERIC-NAME TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 230-DELETE-USER-EXIT. IF USER-ABORT GO TO 230-DELETE-USER. IF NOT USER-VALID-ESCAPE GO TO 230-DISPLAY-GENERIC-NAME. MOVE SC2-UIF-GENERIC-NAME TO WS-USERNAME, WS-GENERIC-NAME. MOVE WS-USER-RECORD TO USERNAME-RECORD. PERFORM 660-READ-USER THRU 660-READ-USER-EXIT. IF INVALID-KEY MOVE NO-SUCH-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 230-DISPLAY-GENERIC-NAME ELSE MOVE WS-TOP-LEVEL-MENU-NAME TO SC2-UIF-TOP-LEVEL-MENU MOVE FNO-SC2-UIF-TOP-LEVEL-MENU TO SCOPE-NEXT-FIELD PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT END-IF. 230-CONFIRM-DELETE-IT. MOVE DELETE-QUESTION TO SC2-UIF-PROMPT. MOVE FNO-SC2-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC2-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 230-DELETE-USER-EXIT. IF USER-ABORT GO TO 230-DELETE-USER. IF NOT USER-VALID-ESCAPE GO TO 230-CONFIRM-DELETE-IT. STRING SC2-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC2-UIF-RESPONSE. EVALUATE UIF-RESPONSE WHEN "Y" GO TO 230-DELETE-IT WHEN "N" MOVE DELETE-CAN TO DISPLAY-MSG PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT GO TO 230-DELETE-USER WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 230-CONFIRM-DELETE-IT END-EVALUATE. 230-DELETE-IT. ADD 1 TO CHG-TBL-IDX. * * If CHG-TBL-IDX is greater than or equal to table-max, give error * IF CHG-TBL-IDX NOT < TABLE-MAX MOVE TABLE-FULL-EXIT TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 230-DELETE-USER-EXIT. DELETE UIF-USERNAME-FILE RECORD INVALID KEY MOVE DELETE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT MOVE "N" TO INVALID-KEY-SW GO TO 230-DELETE-USER-EXIT. MOVE "Y" TO USER-CHANGE-SW. MOVE "D" TO WS-OTHER-FUNCTION (CHG-TBL-IDX). MOVE "U" TO WS-OTHER-TYPE (CHG-TBL-IDX). MOVE WS-GENERIC-NAME TO WS-OTHER-NAME (CHG-TBL-IDX). MOVE DELETE-OK TO DISPLAY-MSG. PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT GO TO 230-DELETE-USER. 230-DELETE-USER-EXIT. EXIT. / 240-DISPLAY-USER. INITIALIZE WS-USER-RECORD, FORM-SC2. MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC2-UIF-RESPONSE. MOVE PROG-ID TO SC2-UIF-PROGRAM-ID. MOVE "Display User Record " TO SC2-UIF-TITLE. MOVE GENERIC-USER-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 240-DISPLAY-GENERIC-NAME. MOVE FNO-SC2-UIF-GENERIC-NAME TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 240-DISPLAY-USER-EXIT. IF USER-ABORT GO TO 240-DISPLAY-USER. IF NOT USER-VALID-ESCAPE GO TO 240-DISPLAY-GENERIC-NAME. MOVE SC2-UIF-GENERIC-NAME TO WS-USERNAME, WS-GENERIC-NAME. MOVE WS-USER-RECORD TO USERNAME-RECORD. PERFORM 660-READ-USER THRU 660-READ-USER-EXIT. IF INVALID-KEY MOVE NO-SUCH-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 240-DISPLAY-GENERIC-NAME ELSE MOVE WS-TOP-LEVEL-MENU-NAME TO SC2-UIF-TOP-LEVEL-MENU MOVE FNO-SC2-UIF-TOP-LEVEL-MENU TO SCOPE-NEXT-FIELD PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT END-IF. 240-GET-DISPLAY-RESPONSE. MOVE DISPLAY-PROMPT TO SC2-UIF-PROMPT. MOVE FNO-SC2-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC2-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 240-DISPLAY-USER-EXIT. IF USER-ABORT GO TO 240-DISPLAY-USER. IF NOT USER-VALID-ESCAPE GO TO 240-GET-DISPLAY-RESPONSE. STRING SC2-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC2-UIF-PROMPT, SC2-UIF-RESPONSE. EVALUATE UIF-RESPONSE WHEN "F " GO TO 240-DISPLAY-USER WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 240-GET-DISPLAY-RESPONSE END-EVALUATE. 240-DISPLAY-USER-EXIT. EXIT. / 250-ADD-MENU. INITIALIZE WS-USER-RECORD, TRACK-COUNT, WS-TRACK-TRANSACTION-COUNT, FORM-SC4. MOVE HIGH-VALUES TO SC4-UIF-PROMPT, SC4-UIF-RESPONSE. MOVE PROG-ID TO SC4-UIF-PROGRAM-ID. MOVE " Add Menu Record " TO SC4-UIF-TITLE. MOVE MENU-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. MOVE ZEROS TO WS-NODE-CNT. MOVE "N" TO LEVEL-SW, CORRECTION-SW. PERFORM 410-ADD-MENU-NAME THRU 410-ADD-MENU-NAME-EXIT. IF USER-MENU GO TO 250-ADD-MENU-EXIT. IF USER-ABORT GO TO 250-ADD-MENU. 250-GET-TITLE. MOVE FNO-SC4-UIF-MENU-TITLE TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 250-ADD-MENU-EXIT. IF USER-ABORT GO TO 250-ADD-MENU. IF NOT USER-VALID-ESCAPE GO TO 250-GET-TITLE. 250-GET-DESCRIPTION. MOVE FNO-SC4-UIF-MENU-DESCRIPTION TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 250-ADD-MENU-EXIT. IF USER-ABORT GO TO 250-ADD-MENU. IF NOT USER-VALID-ESCAPE GO TO 250-GET-DESCRIPTION. MOVE 4 TO WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD. MOVE ZEROS TO OPTION-INDEX. COMPUTE NEXT-OPTION-NBR = OPTION-INDEX + 1. 250-GET-OPTION. MOVE WS-UIF-FIELD-NUMERIC TO WS-STORE-FIELD. IF CORRECTION MOVE WS-UIF-FIELD-NUMERIC TO NEXT-OPTION-NBR SUBTRACT 3 FROM NEXT-OPTION-NBR DIVIDE NEXT-OPTION-NBR BY 2 GIVING NEXT-OPTION-NBR IF EVEN ADD 1 TO NEXT-OPTION-NBR * * Keep track of the transaction just overridden for later decrement of * transaction node count. * IF (SC4-UIF-OPTION(NEXT-OPTION-NBR) NOT = " ") MOVE "D" TO WS-HISTORY-SYMBOL PERFORM 726-TRACK-TRANS-HIST THRU 726-TRACK-TRANS-HIST-EXIT END-IF END-IF END-IF. 250-EXECUTE-REQUEST. IF EVEN MOVE FNO-SC4-OPTION-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD ELSE MOVE FNO-SC4-TYPE-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 250-ADD-MENU-EXIT. IF USER-ABORT GO TO 250-ADD-MENU. IF NOT USER-VALID-ESCAPE GO TO 250-EXECUTE-REQUEST. * / * CHECK THAT MENU NAME OR OPTION IS IN PROPER FORMAT IF EVEN MOVE SC4-UIF-OPTION (NEXT-OPTION-NBR) TO WS-NAME-TABLE PERFORM 745-CHECK-NAME THRU 745-CHECK-NAME-EXIT EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 250-END-OPTIONS-CHECK WHEN OTHER INITIALIZE SCOPE-ERROR-MSG GO TO 250-EXECUTE-REQUEST END-EVALUATE. 250-END-OPTIONS-CHECK. IF SC4-UIF-OPTION (NEXT-OPTION-NBR) = SPACES INITIALIZE SC4-UIF-TYPE(NEXT-OPTION-NBR) MOVE FNO-SC4-TYPE-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT GO TO 250-PROCESS-RESPONSE. * * If EVEN, (WS-UIF-FIELD-NUMERIC) you have only processed the record name * go back and process the record type (M/T) * IF CORRECTION AND EVEN MOVE 3 TO WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD GO TO 250-EXECUTE-REQUEST ELSE IF EVEN MOVE 3 TO WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD GO TO 250-GET-OPTION END-IF END-IF. PERFORM 720-PROCESS-OPTION THRU 720-PROCESS-OPTION-EXIT. IF (SCOPE-ERROR-MSG = " ") MOVE "I" TO WS-HISTORY-SYMBOL PERFORM 726-TRACK-TRANS-HIST THRU 726-TRACK-TRANS-HIST-EXIT END-IF. IF NOT CORRECTION EVALUATE SCOPE-ERROR-MSG WHEN SPACES MOVE 4 TO WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD ADD 1 TO OPTION-INDEX COMPUTE NEXT-OPTION-NBR = OPTION-INDEX + 1 IF NEXT-OPTION-NBR > MAX-TRANSACT-PER-MENU GO TO 250-PROCESS-RESPONSE END-IF GO TO 250-GET-OPTION WHEN OTHER MOVE 4 TO WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD INITIALIZE SCOPE-ERROR-MSG INITIALIZE SC4-UIF-TYPE(NEXT-OPTION-NBR) MOVE FNO-SC4-TYPE-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT GO TO 250-EXECUTE-REQUEST END-EVALUATE ELSE EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 250-PROCESS-RESPONSE WHEN OTHER MOVE 4 TO WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD INITIALIZE SCOPE-ERROR-MSG INITIALIZE SC4-UIF-OPTION(NEXT-OPTION-NBR) INITIALIZE SC4-UIF-TYPE(NEXT-OPTION-NBR) MOVE FNO-SC4-TYPE-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT GO TO 250-EXECUTE-REQUEST END-EVALUATE END-IF. / 250-PROCESS-RESPONSE. MOVE STANDARD-PROMPT TO SC4-UIF-PROMPT. MOVE FNO-SC4-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. MOVE "R " TO WS-UIF-FIELD-ALPHA. MOVE FNO-SC4-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 250-ADD-MENU-EXIT. IF USER-ABORT GO TO 250-ADD-MENU. IF NOT USER-VALID-ESCAPE GO TO 250-PROCESS-RESPONSE. STRING SC4-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC4-UIF-RESPONSE, SC4-UIF-PROMPT. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. EVALUATE UIF-RESPONSE WHEN "P ", PERFORM 445-RESET-TRAN-COUNT THRU 445-RESET-TRAN-COUNT-EXIT GO TO 250-WRITE-MENU END-EVALUATE. 250-EVALUATE-RESPONSE. MOVE WS-STORE-FIELD TO WS-UIF-FIELD-NUMERIC. PERFORM 710-STORE-FIELD THRU 710-STORE-FIELD-EXIT. EVALUATE WS-UIF-FIELD-NUMERIC WHEN 1, PERFORM 410-ADD-MENU-NAME THRU 410-ADD-MENU-NAME-EXIT GO TO 250-PROCESS-RESPONSE WHEN 2, PERFORM 420-GET-TITLE THRU 420-GET-TITLE-EXIT GO TO 250-PROCESS-RESPONSE WHEN 3, PERFORM 430-GET-DESCRIPTION THRU 430-GET-DESCRIPTION-EXIT GO TO 250-PROCESS-RESPONSE WHEN 4 THRU 43, MOVE "Y" TO CORRECTION-SW GO TO 250-GET-OPTION WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 250-PROCESS-RESPONSE END-EVALUATE. 250-WRITE-MENU. PERFORM 440-BUILD-MENU-RECORD THRU 440-BUILD-MENU-RECORD-EXIT. EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 250-ADD-MENU WHEN OTHER INITIALIZE SCOPE-ERROR-MSG GO TO 250-PROCESS-RESPONSE END-EVALUATE. 250-ADD-MENU-EXIT. EXIT. / 260-CHANGE-MENU. MOVE "Y" TO MENU-SW, CHANGE-MENU-SW. MOVE 1 TO L-SUB. INITIALIZE WS-USER-RECORD, TRACK-COUNT, WS-TRACK-TRANSACTION-COUNT, FORM-SC4. MOVE HIGH-VALUES TO SC4-UIF-PROMPT, SC4-UIF-RESPONSE. MOVE PROG-ID TO SC4-UIF-PROGRAM-ID. MOVE " Change Menu Record " TO SC4-UIF-TITLE. MOVE MENU-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. PERFORM 280-DISPLAY-MENU-NAME THRU 280-DISPLAY-MENU-EXIT. IF USER-MENU GO TO 260-CHANGE-MENU-EXIT. IF USER-ABORT GO TO 260-CHANGE-MENU. * * STORE ORIGINAL INFORMATION FOR LATER COMPARISON * MOVE SC4-UIF-MENU TO WS-STORE-UIF (L-SUB). 260-GET-RESPONSE. MOVE STANDARD-PROMPT TO SC4-UIF-PROMPT. MOVE FNO-SC4-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. MOVE ZEROS TO OPTION-INDEX, WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD. MOVE "R " TO WS-UIF-FIELD-ALPHA. MOVE FNO-SC4-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. GO TO 260-EVALUATE-RESPONSE. 260-GET-OPTION. MOVE WS-UIF-FIELD-NUMERIC TO WS-STORE-FIELD, NEXT-OPTION-NBR. SUBTRACT 3 FROM NEXT-OPTION-NBR. DIVIDE NEXT-OPTION-NBR BY 2 GIVING NEXT-OPTION-NBR. IF EVEN ADD 1 TO NEXT-OPTION-NBR. 260-EXECUTE-REQUEST. IF EVEN * * Keep track of the transaction just overridden for later decrement of * transaction node count. * IF (SC4-UIF-OPTION(NEXT-OPTION-NBR) NOT = " ") MOVE "D" TO WS-HISTORY-SYMBOL PERFORM 726-TRACK-TRANS-HIST THRU 726-TRACK-TRANS-HIST-EXIT END-IF MOVE FNO-SC4-OPTION-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD ELSE MOVE FNO-SC4-TYPE-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD END-IF. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 260-CHANGE-MENU-EXIT. IF USER-ABORT GO TO 260-CHANGE-MENU. IF NOT USER-VALID-ESCAPE GO TO 260-EXECUTE-REQUEST. / * CHECK THAT MENU NAME OR OPTION IS IN PROPER FORMAT * IF EVEN MOVE SC4-UIF-OPTION (NEXT-OPTION-NBR) TO WS-NAME-TABLE PERFORM 745-CHECK-NAME THRU 745-CHECK-NAME-EXIT EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 260-END-OPTIONS-CHECK WHEN OTHER INITIALIZE SCOPE-ERROR-MSG GO TO 260-GET-OPTION END-EVALUATE. 260-END-OPTIONS-CHECK. IF SC4-UIF-OPTION (NEXT-OPTION-NBR) = SPACES INITIALIZE SC4-UIF-TYPE(NEXT-OPTION-NBR) MOVE FNO-SC4-TYPE-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT GO TO 260-GET-RESPONSE END-IF. * * If EVEN, (WS-UIF-FIELD-NUMERIC) you have only processed the record name * go back and process the record type (M/T) * IF EVEN MOVE 3 TO WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD GO TO 260-EXECUTE-REQUEST END-IF. PERFORM 720-PROCESS-OPTION THRU 720-PROCESS-OPTION-EXIT. IF (SCOPE-ERROR-MSG = " ") MOVE "I" TO WS-HISTORY-SYMBOL PERFORM 726-TRACK-TRANS-HIST THRU 726-TRACK-TRANS-HIST-EXIT END-IF. EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 260-GET-RESPONSE WHEN OTHER MOVE 4 TO WS-UIF-FIELD-NUMERIC, WS-STORE-FIELD INITIALIZE SCOPE-ERROR-MSG INITIALIZE SC4-UIF-OPTION(NEXT-OPTION-NBR) INITIALIZE SC4-UIF-TYPE(NEXT-OPTION-NBR) MOVE FNO-SC4-TYPE-ARRAY(NEXT-OPTION-NBR) TO SCOPE-NEXT-FIELD PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT GO TO 260-EXECUTE-REQUEST END-EVALUATE. 260-EVALUATE-RESPONSE. IF USER-MENU GO TO 260-CHANGE-MENU-EXIT. IF USER-ABORT GO TO 260-CHANGE-MENU. IF NOT USER-VALID-ESCAPE GO TO 260-GET-RESPONSE. STRING SC4-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC4-UIF-RESPONSE, SC4-UIF-PROMPT. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. EVALUATE UIF-RESPONSE WHEN "P ", PERFORM 445-RESET-TRAN-COUNT THRU 445-RESET-TRAN-COUNT-EXIT GO TO 260-REWRITE-MENU END-EVALUATE. MOVE WS-STORE-FIELD TO WS-UIF-FIELD-NUMERIC. PERFORM 710-STORE-FIELD THRU 710-STORE-FIELD-EXIT. EVALUATE WS-UIF-FIELD-NUMERIC WHEN 2, PERFORM 420-GET-TITLE THRU 420-GET-TITLE-EXIT IF USER-MENU GO TO 260-CHANGE-MENU-EXIT END-IF IF USER-ABORT GO TO 260-CHANGE-MENU END-IF GO TO 260-GET-RESPONSE WHEN 3, PERFORM 430-GET-DESCRIPTION THRU 430-GET-DESCRIPTION-EXIT IF USER-MENU GO TO 260-CHANGE-MENU-EXIT END-IF IF USER-ABORT GO TO 260-CHANGE-MENU END-IF GO TO 260-GET-RESPONSE WHEN 4 THRU 43, GO TO 260-GET-OPTION WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 260-GET-RESPONSE END-EVALUATE. 260-REWRITE-MENU. PERFORM 450-REBUILD-MENU-RECORD THRU 450-REBUILD-MENU-RECORD-EXIT. EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 260-CHANGE-MENU WHEN OTHER INITIALIZE SCOPE-ERROR-MSG GO TO 260-GET-RESPONSE END-EVALUATE. 260-CHANGE-MENU-EXIT. EXIT. / 270-DELETE-MENU. MOVE "Y" TO MENU-SW. INITIALIZE WS-MASTER-RECORD, FORM-SC4. MOVE HIGH-VALUES TO SC4-UIF-PROMPT, SC4-UIF-RESPONSE. MOVE PROG-ID TO SC4-UIF-PROGRAM-ID. MOVE " Delete Menu Record " TO SC4-UIF-TITLE. MOVE MENU-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. PERFORM 280-DISPLAY-MENU-NAME THRU 280-DISPLAY-MENU-EXIT. IF USER-MENU GO TO 270-DELETE-MENU-EXIT. IF USER-ABORT GO TO 270-DELETE-MENU. 270-CONFIRM-DELETE-IT. MOVE DELETE-QUESTION TO SC4-UIF-PROMPT. MOVE FNO-SC4-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC4-UIF-RESPONSE TO SCOPE-NEXT-FIELD. MOVE ZEROS TO NODE-INDEX. MOVE "R " TO WS-UIF-FIELD-ALPHA. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC4-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC4-UIF-PROMPT, SC4-UIF-RESPONSE. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. IF USER-MENU GO TO 270-DELETE-MENU-EXIT. IF USER-ABORT GO TO 270-DELETE-MENU. IF NOT USER-VALID-ESCAPE GO TO 270-CONFIRM-DELETE-IT. EVALUATE UIF-RESPONSE WHEN "Y " GO TO 270-DELETE-IT WHEN "N " MOVE DELETE-CAN TO DISPLAY-MSG PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT GO TO 270-DELETE-MENU WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 270-CONFIRM-DELETE-IT END-EVALUATE. / 270-DELETE-IT. ADD 1 TO NODE-INDEX. IF SC4-UIF-OPTION (NODE-INDEX) = SPACES NEXT SENTENCE ELSE MOVE SC4-UIF-OPTION (NODE-INDEX) TO WS-MASTER-RECORD-NAME MOVE SC4-UIF-TYPE (NODE-INDEX) TO WS-MASTER-RECORD-TYPE MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT IF INVALID-KEY MOVE NO-CORR-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 270-DELETE-IT ELSE SUBTRACT 1 FROM WS-MASTER-RECORD-ACCESS-COUNT PERFORM 655-REWRITE-MASTER THRU 655-REWRITE-MASTER-EXIT IF INVALID-KEY MOVE REWRITE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 270-DELETE-MENU ELSE GO TO 270-DELETE-IT. MOVE SC4-UIF-MENU-NAME TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. DELETE UIF-MASTER-FILE RECORD INVALID KEY MOVE DELETE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 270-DELETE-MENU. MOVE DELETE-OK TO DISPLAY-MSG. PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT. MOVE "Y" TO STRUCTURE-SW. GO TO 270-DELETE-MENU. 270-DELETE-MENU-EXIT. EXIT. / 280-DISPLAY-MENU. INITIALIZE WS-MASTER-RECORD, FORM-SC4. MOVE HIGH-VALUES TO SC4-UIF-PROMPT, SC4-UIF-RESPONSE. MOVE PROG-ID TO SC4-UIF-PROGRAM-ID. MOVE " Display Menu Record" TO SC4-UIF-TITLE. MOVE MENU-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 280-DISPLAY-MENU-NAME. MOVE FNO-SC4-UIF-MENU-NAME TO SCOPE-NEXT-FIELD. MOVE 1 TO WS-UIF-FIELD-NUMERIC. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 280-DISPLAY-MENU-EXIT. IF USER-ABORT GO TO 280-DISPLAY-MENU-NAME. IF NOT USER-VALID-ESCAPE GO TO 280-DISPLAY-MENU-NAME. MOVE SC4-UIF-MENU-NAME TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF INVALID-KEY MOVE NO-SUCH-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 280-DISPLAY-MENU-NAME ELSE IF L-SUB = 0 MOVE 1 TO L-SUB END-IF MOVE WS-MASTER-RECORD-ACCESS-COUNT TO WS-STORE-ACCESS-CNT (L-SUB) MOVE WS-MASTER-MENU-TITLE TO SC4-UIF-MENU-TITLE MOVE WS-MASTER-MENU-DESCRIPTION TO SC4-UIF-MENU-DESCRIPTION MOVE WS-MASTER-MENU-NODE-CNT TO UIF-FIELD, WS-ORIG-NODE-CNT MOVE ZEROS TO NODE-INDEX MOVE MASTER-MENU-NODE-CNT TO WS-NODE-CNT PERFORM 740-GET-OPTIONS THRU 740-GET-OPTIONS-EXIT. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 280-GET-DESCRIPTION-RESPONSE. IF FROM-MENU MOVE "N" TO MENU-SW GO TO 280-DISPLAY-MENU-EXIT. MOVE "R" TO WS-UIF-FIELD-ALPHA. MOVE DISPLAY-PROMPT TO SC4-UIF-PROMPT. MOVE FNO-SC4-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC4-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC4-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC4-UIF-PROMPT, SC4-UIF-RESPONSE. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. IF USER-MENU GO TO 280-DISPLAY-MENU-EXIT. IF USER-ABORT GO TO 280-DISPLAY-MENU. IF NOT USER-VALID-ESCAPE GO TO 280-GET-DESCRIPTION-RESPONSE. EVALUATE UIF-RESPONSE WHEN "F " GO TO 280-DISPLAY-MENU WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 280-GET-DESCRIPTION-RESPONSE END-EVALUATE. 280-DISPLAY-MENU-EXIT. EXIT. / 290-ADD-TRANSACTION. INITIALIZE WS-MASTER-RECORD, FORM-SC3. MOVE "N" TO CORRECTION-SW. MOVE HIGH-VALUES TO SC3-UIF-PROMPT, SC3-UIF-RESPONSE. MOVE PROG-ID TO SC3-UIF-PROGRAM-ID. MOVE " Add Transaction " TO SC3-UIF-TITLE. MOVE TRANS-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 290-ADD-TRANSACTION-NAME. * IF ADD TRANS FROM ADD MENU, ALREADY HAVE MENU NAME * IF TRANS-FROM-MENU IF CORRECTION MOVE "N" TO CORRECTION-SW MOVE INVALID-RESPONSE TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 290-GET-TRANS-RESPONSE ELSE MOVE WS-STORE-OPTION TO SC3-UIF-TRANSACTION-NAME GO TO 290-GET-DESCRIPTION. MOVE FNO-SC3-UIF-TRANSACTION-NAME TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 290-ADD-TRANSACTION-EXIT. IF USER-ABORT GO TO 290-ADD-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 290-ADD-TRANSACTION-NAME. MOVE SC3-UIF-TRANSACTION-NAME TO WS-NAME-TABLE. PERFORM 745-CHECK-NAME THRU 745-CHECK-NAME-EXIT. EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 290-TRANS-READ-CONT WHEN OTHER INITIALIZE SCOPE-ERROR-MSG GO TO 290-ADD-TRANSACTION-NAME END-EVALUATE. 290-TRANS-READ-CONT. MOVE SC3-UIF-TRANSACTION-NAME TO WS-MASTER-RECORD-NAME. MOVE "T" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. * SHOULD BE INVALID ON ADD * IF INVALID-KEY IF CORRECTION MOVE "N" TO CORRECTION-SW GO TO 290-GET-TRANS-RESPONSE ELSE GO TO 290-GET-DESCRIPTION END-IF ELSE MOVE RECORD-EXISTS TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 290-ADD-TRANSACTION-NAME. / 290-GET-DESCRIPTION. MOVE "N" TO INVALID-KEY-SW. MOVE FNO-SC3-UIF-TRANSACTION-DESC TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 290-ADD-TRANSACTION-EXIT. IF USER-ABORT GO TO 290-ADD-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 290-GET-DESCRIPTION. IF CORRECTION MOVE "N" TO CORRECTION-SW GO TO 290-GET-TRANS-RESPONSE END-IF. 290-GET-TYPE. MOVE FNO-SC3-UIF-TRANSACTION-TYPE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 290-ADD-TRANSACTION-EXIT. IF USER-ABORT GO TO 290-ADD-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 290-GET-TYPE. IF CORRECTION MOVE "N" TO CORRECTION-SW GO TO 290-GET-TRANS-RESPONSE END-IF. 290-GET-FORM. MOVE FNO-SC3-UIF-TRANSACTION-FORM TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 290-ADD-TRANSACTION-EXIT. IF USER-ABORT GO TO 290-ADD-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 290-GET-FORM. IF CORRECTION MOVE "N" TO CORRECTION-SW GO TO 290-GET-TRANS-RESPONSE END-IF. 290-GET-SWITCH. MOVE FNO-SC3-UIF-TRANSACTION-SWITCH TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 290-ADD-TRANSACTION-EXIT. IF USER-ABORT GO TO 290-ADD-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 290-GET-SWITCH. IF CORRECTION MOVE "N" TO CORRECTION-SW GO TO 290-GET-TRANS-RESPONSE END-IF. 290-GET-TRANS-RESPONSE. MOVE FNO-SC3-UIF-PROMPT TO SCOPE-NEXT-FIELD. MOVE STANDARD-PROMPT TO SC3-UIF-PROMPT. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC3-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC3-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC3-UIF-PROMPT, SC3-UIF-RESPONSE. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. IF USER-MENU GO TO 290-ADD-TRANSACTION-EXIT. IF USER-ABORT GO TO 290-ADD-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 290-GET-TRANS-RESPONSE. EVALUATE UIF-RESPONSE WHEN "P ", GO TO 290-WRITE-TRANSACTION WHEN "1 ", MOVE "Y" TO CORRECTION-SW GO TO 290-ADD-TRANSACTION-NAME WHEN "2 ", MOVE "Y" TO CORRECTION-SW GO TO 290-GET-DESCRIPTION WHEN "3 ", MOVE "Y" TO CORRECTION-SW GO TO 290-GET-TYPE WHEN "4 ", MOVE "Y" TO CORRECTION-SW GO TO 290-GET-FORM WHEN "5 ", MOVE "Y" TO CORRECTION-SW GO TO 290-GET-SWITCH WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 290-GET-TRANS-RESPONSE END-EVALUATE. 290-WRITE-TRANSACTION. MOVE SC3-UIF-TRANSACTION-NAME TO WS-MASTER-RECORD-NAME. MOVE "T" TO WS-MASTER-RECORD-TYPE. MOVE SPACES TO WS-MASTER-TRANSACTION. MOVE SC3-UIF-TRANSACTION-DESC TO WS-MASTER-TRANSACTION-DESC. MOVE SC3-UIF-TRANSACTION-TYPE TO WS-MASTER-TRANSACTION-TYPE. MOVE SC3-UIF-TRANSACTION-FORM TO WS-MASTER-TRANSACTION-FORM. MOVE SC3-UIF-TRANSACTION-SWITCH TO WS-MASTER-TRANSACTION-SWITCH. IF TRANS-FROM-MENU MOVE 1 TO WS-MASTER-RECORD-ACCESS-COUNT ELSE MOVE ZEROS TO WS-MASTER-RECORD-ACCESS-COUNT. PERFORM 650-WRITE-MASTER THRU 650-WRITE-MASTER-EXIT. IF INVALID-KEY MOVE WRITE-ERROR TO SCOPE-ERROR-MSG, WS-STORE-MESSAGE PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT MOVE "N" TO INVALID-KEY-SW GO TO 290-ADD-TRANSACTION. MOVE RECORD-ADDED TO DISPLAY-MSG, WS-STORE-MESSAGE. PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT IF TRANS-FROM-MENU GO TO 290-ADD-TRANSACTION-EXIT ELSE GO TO 290-ADD-TRANSACTION. 290-ADD-TRANSACTION-EXIT. EXIT. / 300-CHANGE-TRANSACTION. INITIALIZE WS-MASTER-RECORD, FORM-SC3. MOVE "N" TO CORRECTION-SW. MOVE HIGH-VALUES TO SC3-UIF-PROMPT, SC3-UIF-RESPONSE. MOVE PROG-ID TO SC3-UIF-PROGRAM-ID. MOVE " Change Transaction " TO SC3-UIF-TITLE. MOVE TRANS-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 300-ENTER-TRANSACTION-CHANGE. MOVE FNO-SC3-UIF-TRANSACTION-NAME TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC3-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. IF USER-MENU GO TO 300-CHANGE-TRANSACTION-EXIT. IF USER-ABORT GO TO 300-CHANGE-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 300-ENTER-TRANSACTION-CHANGE. MOVE SC3-UIF-TRANSACTION-NAME TO WS-MASTER-RECORD-NAME. MOVE "T" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF INVALID-KEY MOVE NO-SUCH-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 300-ENTER-TRANSACTION-CHANGE ELSE MOVE WS-MASTER-TRANSACTION-DESC TO SC3-UIF-TRANSACTION-DESC MOVE WS-MASTER-TRANSACTION-TYPE TO SC3-UIF-TRANSACTION-TYPE MOVE WS-MASTER-TRANSACTION-FORM TO SC3-UIF-TRANSACTION-FORM MOVE WS-MASTER-TRANSACTION-SWITCH TO SC3-UIF-TRANSACTION-SWITCH PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT END-IF. GO TO 300-GET-RESPONSE. 300-GET-DESC. MOVE "N" TO INVALID-KEY-SW. MOVE FNO-SC3-UIF-TRANSACTION-DESC TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC3-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. IF USER-MENU GO TO 300-CHANGE-TRANSACTION-EXIT. IF USER-ABORT GO TO 300-CHANGE-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 300-GET-DESC. GO TO 300-GET-RESPONSE. 300-GET-TYPE. MOVE FNO-SC3-UIF-TRANSACTION-TYPE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 300-CHANGE-TRANSACTION-EXIT. IF USER-ABORT GO TO 300-CHANGE-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 300-GET-TYPE. GO TO 300-GET-RESPONSE. 300-GET-FORM. MOVE FNO-SC3-UIF-TRANSACTION-FORM TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 300-CHANGE-TRANSACTION-EXIT. IF USER-ABORT GO TO 300-CHANGE-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 300-GET-FORM. GO TO 300-GET-RESPONSE. 300-GET-SWITCH. MOVE FNO-SC3-UIF-TRANSACTION-SWITCH TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 300-CHANGE-TRANSACTION-EXIT. IF USER-ABORT GO TO 300-CHANGE-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 300-GET-SWITCH. GO TO 300-GET-RESPONSE. 300-GET-RESPONSE. MOVE FNO-SC3-UIF-PROMPT TO SCOPE-NEXT-FIELD. MOVE STANDARD-PROMPT TO SC3-UIF-PROMPT. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC3-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC3-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC3-UIF-PROMPT, SC3-UIF-RESPONSE. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. IF USER-MENU GO TO 300-CHANGE-TRANSACTION-EXIT. IF USER-ABORT GO TO 300-CHANGE-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 300-GET-RESPONSE. EVALUATE UIF-RESPONSE WHEN "P ", GO TO 300-REWRITE-IT WHEN "2 ", GO TO 300-GET-DESC WHEN "3 ", GO TO 300-GET-TYPE WHEN "4 ", GO TO 300-GET-FORM WHEN "5 ", GO TO 300-GET-SWITCH WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 300-GET-RESPONSE END-EVALUATE. / 300-REWRITE-IT. MOVE SC3-UIF-TRANSACTION-DESC TO WS-MASTER-TRANSACTION-DESC. MOVE SC3-UIF-TRANSACTION-TYPE TO WS-MASTER-TRANSACTION-TYPE. MOVE SC3-UIF-TRANSACTION-FORM TO WS-MASTER-TRANSACTION-FORM. MOVE SC3-UIF-TRANSACTION-SWITCH TO WS-MASTER-TRANSACTION-SWITCH. ADD 1 TO CHG-TBL-IDX. IF CHG-TBL-IDX NOT < TABLE-MAX MOVE TABLE-FULL-EXIT TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 300-CHANGE-TRANSACTION-EXIT. PERFORM 655-REWRITE-MASTER THRU 655-REWRITE-MASTER-EXIT. IF INVALID-KEY MOVE REWRITE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT MOVE "N" TO INVALID-KEY-SW GO TO 300-CHANGE-TRANSACTION. MOVE CHANGE-OK TO DISPLAY-MSG. PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT. GO TO 300-CHANGE-TRANSACTION. 300-CHANGE-TRANSACTION-EXIT. EXIT. / 310-DELETE-TRANSACTION. INITIALIZE WS-MASTER-RECORD, FORM-SC3. MOVE HIGH-VALUES TO SC3-UIF-PROMPT, SC3-UIF-RESPONSE. MOVE PROG-ID TO SC3-UIF-PROGRAM-ID. MOVE " Delete Transaction " TO SC3-UIF-TITLE. MOVE TRANS-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 310-DELETE-TRANS-DISPLAY. MOVE FNO-SC3-UIF-TRANSACTION-NAME TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC3-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. IF USER-MENU GO TO 310-DELETE-TRANSACTION-EXIT. IF USER-ABORT GO TO 310-DELETE-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 310-DELETE-TRANS-DISPLAY. MOVE SC3-UIF-TRANSACTION-NAME TO WS-MASTER-RECORD-NAME. MOVE "T" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF INVALID-KEY MOVE NO-SUCH-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 310-DELETE-TRANS-DISPLAY ELSE MOVE WS-MASTER-TRANSACTION-DESC TO SC3-UIF-TRANSACTION-DESC MOVE WS-MASTER-TRANSACTION-TYPE TO SC3-UIF-TRANSACTION-TYPE MOVE WS-MASTER-TRANSACTION-FORM TO SC3-UIF-TRANSACTION-FORM MOVE WS-MASTER-TRANSACTION-SWITCH TO SC3-UIF-TRANSACTION-SWITCH PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT END-IF. 310-CONFIRM-DELETE-IT. MOVE DELETE-QUESTION TO SC3-UIF-PROMPT. MOVE FNO-SC3-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC3-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC3-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC3-UIF-PROMPT, SC3-UIF-RESPONSE. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. IF USER-MENU GO TO 310-DELETE-TRANSACTION-EXIT. IF USER-ABORT GO TO 310-DELETE-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 310-CONFIRM-DELETE-IT. EVALUATE UIF-RESPONSE WHEN "Y " GO TO 310-DELETE-IT WHEN "N " MOVE DELETE-CAN TO DISPLAY-MSG PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT GO TO 310-DELETE-TRANSACTION WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 310-CONFIRM-DELETE-IT END-EVALUATE. 310-DELETE-IT. ADD 1 TO CHG-TBL-IDX. * * If CHG-TBL-IDX is greater than or equal to table-max, give error * IF CHG-TBL-IDX NOT < TABLE-MAX MOVE TABLE-FULL-EXIT TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 310-DELETE-TRANSACTION-EXIT. DELETE UIF-MASTER-FILE RECORD INVALID KEY MOVE DELETE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT MOVE "N" TO INVALID-KEY-SW GO TO 310-DELETE-TRANSACTION. MOVE "D" TO WS-OTHER-FUNCTION (CHG-TBL-IDX). MOVE "T" TO WS-OTHER-TYPE (CHG-TBL-IDX). MOVE WS-TRANSACTION-NAME TO WS-OTHER-NAME (CHG-TBL-IDX). MOVE DELETE-OK TO DISPLAY-MSG. PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT. GO TO 310-DELETE-TRANSACTION. 310-DELETE-TRANSACTION-EXIT. EXIT. / 320-DISPLAY-TRANSACTION. INITIALIZE WS-MASTER-RECORD, FORM-SC3. MOVE HIGH-VALUES TO SC3-UIF-PROMPT, SC3-UIF-RESPONSE. MOVE PROG-ID TO SC3-UIF-PROGRAM-ID. MOVE "Display Transaction " TO SC3-UIF-TITLE. MOVE TRANS-SCREEN TO SCOPE-FORM-NAME. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. 320-DISPLAY-TRANSACTION-NAME. MOVE FNO-SC3-UIF-TRANSACTION-NAME TO SCOPE-NEXT-FIELD. MOVE "K" TO DISPLAY-HOLD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC3-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. IF USER-MENU GO TO 320-DISPLAY-TRANSACTION-EXIT. IF USER-ABORT GO TO 320-DISPLAY-TRANSACTION-NAME. IF NOT USER-VALID-ESCAPE GO TO 320-DISPLAY-TRANSACTION-NAME. MOVE SC3-UIF-TRANSACTION-NAME TO WS-MASTER-RECORD-NAME. MOVE "T" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF INVALID-KEY MOVE NO-SUCH-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 320-DISPLAY-TRANSACTION-NAME ELSE MOVE WS-MASTER-TRANSACTION-DESC TO SC3-UIF-TRANSACTION-DESC MOVE WS-MASTER-TRANSACTION-TYPE TO SC3-UIF-TRANSACTION-TYPE MOVE WS-MASTER-TRANSACTION-FORM TO SC3-UIF-TRANSACTION-FORM MOVE WS-MASTER-TRANSACTION-SWITCH TO SC3-UIF-TRANSACTION-SWITCH PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT END-IF. 320-GET-DESCRIPTION-RESPONSE. MOVE DISPLAY-PROMPT TO SC3-UIF-PROMPT. MOVE FNO-SC3-UIF-PROMPT TO SCOPE-NEXT-FIELD. PERFORM 692-CALL-SCPWF THRU 692-CALL-SCPWF-EXIT. MOVE FNO-SC3-UIF-RESPONSE TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. STRING SC3-UIF-RESPONSE DELIMITED BY SIZE INTO UIF-RESPONSE. MOVE HIGH-VALUES TO SC3-UIF-PROMPT, SC3-UIF-RESPONSE. PERFORM 691-CALL-SCPWR THRU 691-CALL-SCPWR-EXIT. IF USER-MENU GO TO 320-DISPLAY-TRANSACTION-EXIT. IF USER-ABORT GO TO 320-DISPLAY-TRANSACTION. IF NOT USER-VALID-ESCAPE GO TO 320-GET-DESCRIPTION-RESPONSE. EVALUATE UIF-RESPONSE WHEN "F ", GO TO 320-DISPLAY-TRANSACTION WHEN OTHER PERFORM 700-RESPONSE-ERROR THRU 700-RESPONSE-ERROR-EXIT GO TO 320-GET-DESCRIPTION-RESPONSE END-EVALUATE. 320-DISPLAY-TRANSACTION-EXIT. EXIT. / 410-ADD-MENU-NAME. * NAME CHANGE NOT ALLOWED AT SUB MENU IF FROM-MENU MOVE NO-CHANGE-ALLOWED TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 410-ADD-MENU-NAME-EXIT. MOVE FNO-SC4-UIF-MENU-NAME TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. IF USER-MENU GO TO 410-ADD-MENU-NAME-EXIT. IF USER-ABORT GO TO 410-ADD-MENU-NAME-EXIT. IF NOT USER-VALID-ESCAPE GO TO 410-ADD-MENU-NAME. MOVE SC4-UIF-MENU-NAME TO WS-NAME-TABLE. PERFORM 745-CHECK-NAME THRU 745-CHECK-NAME-EXIT. EVALUATE SCOPE-ERROR-MSG WHEN SPACES GO TO 410-MENU-READ-CONT WHEN OTHER INITIALIZE SCOPE-ERROR-MSG GO TO 410-ADD-MENU-NAME END-EVALUATE. 410-MENU-READ-CONT. MOVE SC4-UIF-MENU-NAME TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. * RECORD SHOULD NOT EXIST ON ADD IF INVALID-KEY GO TO 410-ADD-MENU-NAME-EXIT ELSE MOVE RECORD-EXISTS TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 410-ADD-MENU-NAME. 410-ADD-MENU-NAME-EXIT. EXIT. / 420-GET-TITLE. MOVE "N" TO INVALID-KEY-SW. IF FROM-MENU NEXT SENTENCE ELSE MOVE HIGH-VALUES TO SC4-UIF-PROMPT MOVE FNO-SC4-UIF-MENU-TITLE TO SCOPE-NEXT-FIELD PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. 420-GET-TITLE-EXIT. EXIT. 430-GET-DESCRIPTION. MOVE FNO-SC4-UIF-MENU-DESCRIPTION TO SCOPE-NEXT-FIELD. PERFORM 690-EXECUTE-REQUEST THRU 690-EXECUTE-REQUEST-EXIT. 430-GET-DESCRIPTION-EXIT. EXIT. / 440-BUILD-MENU-RECORD. * COMPRESES OPTIONS SO THERE ARE NO BLANK LINES BETWEEN * MOVE ZEROS TO WS-NODE-CNT, WS-CURR-NODE-END, WS-TMP-NODE-INDEX. MOVE 21 TO NODE-INDEX. PERFORM 725-REORG-NODES THRU 725-REORG-NODES-EXIT. PERFORM 727-COMPRESS-NODES THRU 727-COMPRESS-NODES-EXIT. MOVE SC4-UIF-MENU-NAME TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE SC4-UIF-MENU-TITLE TO WS-MASTER-MENU-TITLE. MOVE SC4-UIF-MENU-DESCRIPTION TO WS-MASTER-MENU-DESCRIPTION. IF FROM-MENU MOVE 1 TO WS-MASTER-RECORD-ACCESS-COUNT ELSE MOVE ZEROS TO WS-MASTER-RECORD-ACCESS-COUNT. MOVE WS-NODE-CNT TO WS-MASTER-MENU-NODE-CNT. MOVE ZEROS TO NODE-INDEX. PERFORM 730-GET-NODES THRU 730-GET-NODES-EXIT. PERFORM 650-WRITE-MASTER THRU 650-WRITE-MASTER-EXIT. IF INVALID-KEY MOVE WRITE-ERROR TO SCOPE-ERROR-MSG, WS-STORE-MESSAGE PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT MOVE "N" TO INVALID-KEY-SW ELSE MOVE "Y" TO STRUCTURE-SW MOVE RECORD-ADDED TO DISPLAY-MSG, WS-STORE-MESSAGE PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT. 440-BUILD-MENU-RECORD-EXIT. EXIT. 445-RESET-TRAN-COUNT. IF (TRACK-COUNT NOT = 0) PERFORM 446-RESET-COUNT THRU 446-RESET-COUNT-EXIT VARYING TRACK-INDEX FROM 1 BY 1 UNTIL TRACK-INDEX > TRACK-COUNT OR SCOPE-ERROR-MSG NOT = " ". 445-RESET-TRAN-COUNT-EXIT. 446-RESET-COUNT. MOVE TRANSACTION-NAME-TRACK(TRACK-INDEX) TO WS-MASTER-RECORD-NAME. MOVE TRANSACTION-TYPE-TRACK(TRACK-INDEX) TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF NO-INVALID-KEY * * If the user "P"rocessed this menu update, must go back and * increment (adds) or decrement (deletes) all transaction node counts * which were added/deleted. * IF TRANSACTION-COUNT-INCREMENTED(TRACK-INDEX) ADD 1 TO WS-MASTER-RECORD-ACCESS-COUNT ELSE SUBTRACT 1 FROM WS-MASTER-RECORD-ACCESS-COUNT END-IF END-IF. PERFORM 655-REWRITE-MASTER THRU 655-REWRITE-MASTER-EXIT. IF INVALID-KEY MOVE REWRITE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 446-RESET-COUNT-EXIT. 446-RESET-COUNT-EXIT. / 450-REBUILD-MENU-RECORD. * COMPRESSES NODES SO THERE ARE NO BLANKS BETWEEN THEM * MOVE ZEROS TO WS-NODE-CNT, WS-CURR-NODE-END, WS-TMP-NODE-INDEX. MOVE 21 TO NODE-INDEX. MOVE 1 TO L-SUB. PERFORM 725-REORG-NODES THRU 725-REORG-NODES-EXIT. IF SCOPE-ERROR-MSG NOT = SPACES GO TO 450-REBUILD-MENU-RECORD-EXIT. PERFORM 727-COMPRESS-NODES THRU 727-COMPRESS-NODES-EXIT. IF SCOPE-ERROR-MSG NOT = SPACES GO TO 450-REBUILD-MENU-RECORD-EXIT. MOVE SC4-UIF-MENU-NAME TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE SC4-UIF-MENU-TITLE TO WS-MASTER-MENU-TITLE. MOVE SC4-UIF-MENU-DESCRIPTION TO WS-MASTER-MENU-DESCRIPTION. MOVE WS-NODE-CNT TO WS-MASTER-MENU-NODE-CNT. MOVE WS-STORE-ACCESS-CNT (L-SUB) TO WS-MASTER-RECORD-ACCESS-COUNT. MOVE ZEROS TO NODE-INDEX. PERFORM 730-GET-NODES THRU 730-GET-NODES-EXIT. PERFORM 655-REWRITE-MASTER THRU 655-REWRITE-MASTER-EXIT. IF INVALID-KEY MOVE REWRITE-ERROR TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT ELSE MOVE "Y" TO STRUCTURE-SW MOVE CHANGE-OK TO DISPLAY-MSG PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT END-IF. 450-REBUILD-MENU-RECORD-EXIT. EXIT. / 600-READ-MASTER. MOVE "N" TO INVALID-KEY-SW. READ UIF-MASTER-FILE RECORD INTO WS-MASTER-RECORD INVALID KEY MOVE "Y" TO INVALID-KEY-SW. 600-READ-MASTER-EXIT. EXIT. 601-READ-MASTER-NEXT. MOVE "N" TO EXIT-SW. READ UIF-MASTER-FILE NEXT RECORD INTO WS-MASTER-RECORD AT END MOVE "Y" TO EXIT-SW. 601-READ-MASTER-NEXT-EXIT. EXIT. 650-WRITE-MASTER. MOVE "N" TO INVALID-KEY-SW. WRITE MASTER-RECORD FROM WS-MASTER-RECORD INVALID KEY MOVE "Y" TO INVALID-KEY-SW. 650-WRITE-MASTER-EXIT. EXIT. 655-REWRITE-MASTER. MOVE "N" TO INVALID-KEY-SW. REWRITE MASTER-RECORD FROM WS-MASTER-RECORD INVALID KEY MOVE "Y" TO INVALID-KEY-SW. 655-REWRITE-MASTER-EXIT. EXIT. 660-READ-USER. MOVE "N" TO INVALID-KEY-SW. READ UIF-USERNAME-FILE RECORD INTO WS-USER-RECORD INVALID KEY MOVE "Y" TO INVALID-KEY-SW. 660-READ-USER-EXIT. EXIT. 661-READ-USER-NEXT. MOVE "N" TO EXIT-SW. READ UIF-USERNAME-FILE NEXT RECORD INTO WS-USER-RECORD AT END MOVE "Y" TO EXIT-SW. 661-READ-USER-NEXT-EXIT. EXIT. / 665-WRITE-USER. MOVE "N" TO INVALID-KEY-SW. WRITE USERNAME-RECORD FROM WS-USER-RECORD INVALID KEY MOVE "Y" TO INVALID-KEY-SW. 665-WRITE-USER-EXIT. EXIT. 667-REWRITE-USER. MOVE "N" TO INVALID-KEY-SW. REWRITE USERNAME-RECORD FROM WS-USER-RECORD INVALID KEY MOVE "Y" TO INVALID-KEY-SW. 667-REWRITE-USER-EXIT. EXIT. 671-READ-SECURITY-NEXT. MOVE "N" TO EXIT-SW. READ UIF-SECURITY-FILE NEXT RECORD INTO WS-SECURITY-RECORD AT END MOVE "Y" TO EXIT-SW. 671-READ-SECURITY-NEXT-EXIT. EXIT. 675-WRITE-SECURITY. MOVE "N" TO INVALID-KEY-SW. WRITE SECURITY-RECORD FROM WS-SECURITY-RECORD INVALID KEY MOVE "Y" TO INVALID-KEY-SW. 675-WRITE-SECURITY-EXIT. EXIT. / 690-EXECUTE-REQUEST. EVALUATE SCOPE-FORM-NAME WHEN MAIN-MENU-SCREEN CALL "SCPRF" USING BY DESCRIPTOR FORM-SC1 WHEN GENERIC-USER-SCREEN CALL "SCPRF" USING BY DESCRIPTOR FORM-SC2 WHEN TRANS-SCREEN CALL "SCPRF" USING BY DESCRIPTOR FORM-SC3 WHEN MENU-SCREEN CALL "SCPRF" USING BY DESCRIPTOR FORM-SC4 END-EVALUATE. IF SCOPE-ERROR PERFORM 805-SCOPE-ERROR THRU 805-SCOPE-ERROR-EXIT. PERFORM 695-CHECK-ESCAPE THRU 695-CHECK-ESCAPE-EXIT. 690-EXECUTE-REQUEST-EXIT. EXIT. 691-CALL-SCPWR. MOVE 1 TO SCOPE-NEXT-FIELD. MOVE 0 TO SCOPE-END-FIELD. EVALUATE SCOPE-FORM-NAME WHEN MAIN-MENU-SCREEN CALL "SCPWR" USING BY DESCRIPTOR FORM-SC1 WHEN GENERIC-USER-SCREEN CALL "SCPWR" USING BY DESCRIPTOR FORM-SC2 WHEN TRANS-SCREEN CALL "SCPWR" USING BY DESCRIPTOR FORM-SC3 WHEN MENU-SCREEN CALL "SCPWR" USING BY DESCRIPTOR FORM-SC4 END-EVALUATE. IF SCOPE-ERROR PERFORM 805-SCOPE-ERROR THRU 805-SCOPE-ERROR-EXIT. 691-CALL-SCPWR-EXIT. 692-CALL-SCPWF. EVALUATE SCOPE-FORM-NAME WHEN MAIN-MENU-SCREEN CALL "SCPWF" USING BY DESCRIPTOR FORM-SC1 WHEN GENERIC-USER-SCREEN CALL "SCPWF" USING BY DESCRIPTOR FORM-SC2 WHEN TRANS-SCREEN CALL "SCPWF" USING BY DESCRIPTOR FORM-SC3 WHEN MENU-SCREEN CALL "SCPWF" USING BY DESCRIPTOR FORM-SC4 END-EVALUATE. IF SCOPE-ERROR PERFORM 805-SCOPE-ERROR THRU 805-SCOPE-ERROR-EXIT. 692-CALL-SCPWF-EXIT. EXIT. 695-CHECK-ESCAPE. INITIALIZE USER-ESCAPE. IF SCOPE-USER-ESCAPE STRING SCOPE-ESCAPE-WORD DELIMITED BY SIZE INTO USER-ESCAPE IF GIVE-DISPLAY EVALUATE TRUE WHEN SCOPE-MENU MOVE ACTION-ABORTED TO DISPLAY-MSG PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT WHEN SCOPE-ABORT MOVE ACTION-ABORTED TO DISPLAY-MSG PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT WHEN OTHER MOVE SCOPE-ERROR-ESCAPE TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT END-EVALUATE END-IF. MOVE "D" TO DISPLAY-HOLD. 695-CHECK-ESCAPE-EXIT. EXIT. 700-RESPONSE-ERROR. MOVE INVALID-RESPONSE TO SCOPE-ERROR-MSG. PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT. 700-RESPONSE-ERROR-EXIT. EXIT. / 710-STORE-FIELD. MOVE WS-UIF-FIELD-NUMERIC TO WS-STORE-FIELD. EVALUATE UIF-RESPONSE WHEN "1 " MOVE 1 TO WS-UIF-FIELD-NUMERIC WHEN "2 " MOVE 2 TO WS-UIF-FIELD-NUMERIC WHEN "3 " MOVE 3 TO WS-UIF-FIELD-NUMERIC WHEN "4 " MOVE 4 TO WS-UIF-FIELD-NUMERIC WHEN "5 " MOVE 5 TO WS-UIF-FIELD-NUMERIC WHEN "6 " MOVE 6 TO WS-UIF-FIELD-NUMERIC WHEN "7 " MOVE 7 TO WS-UIF-FIELD-NUMERIC WHEN "8 " MOVE 8 TO WS-UIF-FIELD-NUMERIC WHEN "9 " MOVE 9 TO WS-UIF-FIELD-NUMERIC WHEN "10" MOVE 10 TO WS-UIF-FIELD-NUMERIC WHEN "11" MOVE 11 TO WS-UIF-FIELD-NUMERIC WHEN "12" MOVE 12 TO WS-UIF-FIELD-NUMERIC WHEN "13" MOVE 13 TO WS-UIF-FIELD-NUMERIC WHEN "14" MOVE 14 TO WS-UIF-FIELD-NUMERIC WHEN "15" MOVE 15 TO WS-UIF-FIELD-NUMERIC WHEN "16" MOVE 16 TO WS-UIF-FIELD-NUMERIC WHEN "17" MOVE 17 TO WS-UIF-FIELD-NUMERIC WHEN "18" MOVE 18 TO WS-UIF-FIELD-NUMERIC WHEN "19" MOVE 19 TO WS-UIF-FIELD-NUMERIC WHEN "20" MOVE 20 TO WS-UIF-FIELD-NUMERIC WHEN "21" MOVE 21 TO WS-UIF-FIELD-NUMERIC WHEN "22" MOVE 22 TO WS-UIF-FIELD-NUMERIC WHEN "23" MOVE 23 TO WS-UIF-FIELD-NUMERIC WHEN "24" MOVE 24 TO WS-UIF-FIELD-NUMERIC WHEN "25" MOVE 25 TO WS-UIF-FIELD-NUMERIC WHEN "26" MOVE 26 TO WS-UIF-FIELD-NUMERIC WHEN "27" MOVE 27 TO WS-UIF-FIELD-NUMERIC WHEN "28" MOVE 28 TO WS-UIF-FIELD-NUMERIC WHEN "29" MOVE 29 TO WS-UIF-FIELD-NUMERIC WHEN "30" MOVE 30 TO WS-UIF-FIELD-NUMERIC WHEN "31" MOVE 31 TO WS-UIF-FIELD-NUMERIC WHEN "32" MOVE 32 TO WS-UIF-FIELD-NUMERIC WHEN "33" MOVE 33 TO WS-UIF-FIELD-NUMERIC WHEN "34" MOVE 34 TO WS-UIF-FIELD-NUMERIC WHEN "35" MOVE 35 TO WS-UIF-FIELD-NUMERIC WHEN "36" MOVE 36 TO WS-UIF-FIELD-NUMERIC WHEN "37" MOVE 37 TO WS-UIF-FIELD-NUMERIC WHEN "38" MOVE 38 TO WS-UIF-FIELD-NUMERIC WHEN "39" MOVE 39 TO WS-UIF-FIELD-NUMERIC WHEN "40" MOVE 40 TO WS-UIF-FIELD-NUMERIC WHEN "41" MOVE 41 TO WS-UIF-FIELD-NUMERIC WHEN "42" MOVE 42 TO WS-UIF-FIELD-NUMERIC WHEN "43" MOVE 43 TO WS-UIF-FIELD-NUMERIC END-EVALUATE. 710-STORE-FIELD-EXIT. EXIT. */ 720-PROCESS-OPTION. MOVE SC4-UIF-OPTION (NEXT-OPTION-NBR) TO WS-MASTER-MENU-NODE (NEXT-OPTION-NBR). ADD 1 TO WS-NODE-CNT. MOVE SC4-UIF-OPTION (NEXT-OPTION-NBR) TO WS-MASTER-RECORD-NAME. MOVE SC4-UIF-TYPE (NEXT-OPTION-NBR) TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF NO-INVALID-KEY MOVE OPTION-VALID TO DISPLAY-MSG PERFORM 808-CALL-SCPEN THRU 808-CALL-SCPEN-EXIT GO TO 720-PROCESS-OPTION-EXIT ELSE * * Record does not exist, notify user and return to same input field. * IF SC4-UIF-TYPE (NEXT-OPTION-NBR) = "T" MOVE NO-TRAN TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT ELSE MOVE NO-MENU TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT END-IF END-IF. 720-PROCESS-OPTION-EXIT. EXIT. 725-REORG-NODES. * LOCATES LAST OPTION ON MENU * SUBTRACT 1 FROM NODE-INDEX. IF NODE-INDEX = ZEROS GO TO 725-REORG-NODES-EXIT. IF SC4-UIF-OPTION (NODE-INDEX) = SPACES GO TO 725-REORG-NODES. MOVE NODE-INDEX TO WS-CURR-NODE-END, WS-NODE-CNT. MOVE ZEROS TO NODE-INDEX, WS-TMP-NODE-INDEX. 725-REORG-NODES-EXIT. EXIT. 726-TRACK-TRANS-HIST. * * Save the transaction just input in case the user ABORTS the add. * If abort (or menu) a procedure will be called which will determine * all transactions added before the abort and will decrement the node * count in the master data file. * ADD 1 TO TRACK-COUNT. IF (TRACK-COUNT < MAX-TRACK-COUNT) MOVE SC4-UIF-OPTION(NEXT-OPTION-NBR) TO TRANSACTION-NAME-TRACK(TRACK-COUNT) MOVE SC4-UIF-TYPE(NEXT-OPTION-NBR) TO TRANSACTION-TYPE-TRACK(TRACK-COUNT) MOVE WS-HISTORY-SYMBOL TO TRANSACTION-HISTORY-TRACK(TRACK-COUNT) ELSE MOVE TRACK-TABLE-FULL TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT END-IF. 726-TRACK-TRANS-HIST-EXIT. / 727-COMPRESS-NODES. * COMPRESSES BLANK LINES IN MENU * ADD 1 TO NODE-INDEX, WS-TMP-NODE-INDEX. IF NODE-INDEX > WS-CURR-NODE-END GO TO 727-COMPRESS-NODES-EXIT. IF SC4-UIF-OPTION (NODE-INDEX) NOT = SPACES GO TO 727-COMPRESS-NODES. MOVE NODE-INDEX TO WS-STORE-NODE-INDEX. SUBTRACT 1 FROM WS-STORE-NODE-INDEX, WS-NODE-CNT. 727-REMOVE-BLANK-LINES. ADD 1 TO NODE-INDEX. IF NODE-INDEX > WS-CURR-NODE-END MOVE WS-STORE-NODE-INDEX TO NODE-INDEX, WS-TMP-NODE-INDEX GO TO 727-COMPRESS-NODES. MOVE SC4-UIF-OPTION (NODE-INDEX) TO SC4-UIF-OPTION (WS-TMP-NODE-INDEX). ADD 1 TO WS-TMP-NODE-INDEX. GO TO 727-REMOVE-BLANK-LINES. 727-COMPRESS-NODES-EXIT. EXIT. 730-GET-NODES. * REBUILD OPTIONS IN MASTER RECORD * ADD 1 TO NODE-INDEX. IF NODE-INDEX > WS-NODE-CNT NEXT SENTENCE ELSE MOVE SC4-UIF-OPTION (NODE-INDEX) TO WS-MASTER-MENU-NODE (NODE-INDEX) GO TO 730-GET-NODES. 730-GET-NODES-EXIT. EXIT. / 740-GET-OPTIONS. * RETRIEVE OPTIONS FROM MASTER RECORD * ADD 1 TO NODE-INDEX. IF NODE-INDEX > WS-NODE-CNT NEXT SENTENCE ELSE MOVE WS-MASTER-MENU-NODE (NODE-INDEX) TO SC4-UIF-OPTION (NODE-INDEX) GO TO 740-GET-OPTIONS. MOVE ZEROS TO NODE-INDEX. 740-VERIFY-OPTIONS. ADD 1 TO NODE-INDEX. IF NODE-INDEX > WS-NODE-CNT GO TO 740-GET-OPTIONS-EXIT ELSE MOVE SC4-UIF-OPTION (NODE-INDEX) TO WS-MASTER-RECORD-NAME MOVE "T" TO WS-MASTER-RECORD-TYPE, SC4-UIF-TYPE (NODE-INDEX) MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT IF INVALID-KEY MOVE "M" TO WS-MASTER-RECORD-TYPE, SC4-UIF-TYPE (NODE-INDEX) MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT IF INVALID-KEY MOVE NO-CORR-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT MOVE "*" TO SC4-UIF-TYPE (NODE-INDEX). GO TO 740-VERIFY-OPTIONS. 740-GET-OPTIONS-EXIT. EXIT. / 745-CHECK-NAME. MOVE SPACES TO SCOPE-ERROR-MSG. MOVE 12 TO WS-NAME-SUB. 745-LAST-BLANK-LOOP. IF WS-NAME-TBL (WS-NAME-SUB) = SPACE SUBTRACT 1 FROM WS-NAME-SUB IF WS-NAME-SUB = ZERO GO TO 745-CHECK-NAME-EXIT END-IF GO TO 745-LAST-BLANK-LOOP. 745-EMBEDDED-BLANK. IF WS-NAME-TBL (WS-NAME-SUB) = SPACE MOVE "EMBEDDED BLANK" TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 745-CHECK-NAME-EXIT. IF WS-NAME-TBL (WS-NAME-SUB) NOT ALPHABETIC IF WS-NAME-TBL (WS-NAME-SUB) NOT < "0" AND WS-NAME-TBL (WS-NAME-SUB) NOT > "9" GO TO 745-CONTINUE END-IF IF WS-NAME-TBL (WS-NAME-SUB) = "$" MOVE "$ AND _ ARE NOT ALLOWED" TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 745-CONTINUE END-IF IF WS-NAME-TBL (WS-NAME-SUB) = "_" MOVE "$ AND _ ARE NOT ALLOWED" TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 745-CONTINUE END-IF MOVE "NOT (ALPHA NUMERIC OR $ OR _)" TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT. 745-CONTINUE. SUBTRACT 1 FROM WS-NAME-SUB. IF WS-NAME-SUB = ZERO GO TO 745-CHECK-NAME-EXIT. GO TO 745-EMBEDDED-BLANK. 745-CHECK-NAME-EXIT. EXIT. / 750-RECURSION. * READ USER FILE FOR STARTING MENUS, THESE ARE TOP LEVEL MENU'S * PERFORM 810-CLOSE-USER THRU 810-CLOSE-USER-EXIT. PERFORM 800-OPEN-USER THRU 800-OPEN-USER-EXIT. MOVE ZERO TO UMT-SUB. 750-READ-USER-NEXT. PERFORM 661-READ-USER-NEXT THRU 661-READ-USER-NEXT-EXIT. IF DONE GO TO 750-RECURSION-EXIT. IF WS-USERNAME NOT = WS-GENERIC-NAME GO TO 750-READ-USER-NEXT. IF WS-USERNAME = SPACES GO TO 750-READ-USER-NEXT. PERFORM 751-CHECK-MENU-TABLE THRU 751-CHECK-MENU-TABLE-EXIT. IF ON-LIST GO TO 750-READ-USER-NEXT. ADD 1 TO UMT-SUB. MOVE WS-TOP-LEVEL-MENU-NAME TO WS-USER-MENU-TABLE (UMT-SUB). MOVE WS-TOP-LEVEL-MENU-NAME TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF INVALID-KEY DISPLAY "MENU NAME IN USER RECORD NOT MENU ", WS-MASTER-RECORD-NAME MOVE "MENU NAME IN USER RECORD NOT MENU " TO LOG-MESSAGE MOVE WS-MASTER-RECORD-NAME TO LOG-REC WRITE LOG-RECORD GO TO 750-READ-USER-NEXT. MOVE 0 TO L-SUB. DISPLAY "TOP LEVEL MENU ", WS-MASTER-PRIMARY-KEY. MOVE "TOP LEVEL MENU " TO LOG-MESSAGE. MOVE WS-MASTER-PRIMARY-KEY TO LOG-REC. WRITE LOG-RECORD. 750-PUT-ON-LIST. ADD 1 TO L-SUB. IF L-SUB > TABLE-MAX DISPLAY "LIST GREATER 25 QUITING" MOVE "LIST GREATER 25 750-PUT-ON-LIST" TO LOG-MESSAGE MOVE SPACES TO LOG-REC WRITE LOG-RECORD MOVE "Y" TO STRUCTURE-SW GO TO 750-RECURSION-EXIT. MOVE WS-MASTER-RECORD TO WS-LIST-RECORD (L-SUB). MOVE WS-MASTER-MENU-NODE-CNT TO WS-LIST-MENU-CUR-NODE (L-SUB). / 750-NO-RIGHT-MOST. IF WS-LIST-MENU-CUR-NODE (L-SUB) = ZERO SUBTRACT 1 FROM L-SUB IF L-SUB = ZERO DISPLAY "PASSED RECURSIVE TEST ", WS-LIST-RECORD-NAME(1) MOVE "PASSED RECURSIVE TEST " TO LOG-MESSAGE MOVE WS-LIST-RECORD-NAME (1) TO LOG-REC WRITE LOG-RECORD GO TO 750-READ-USER-NEXT END-IF SUBTRACT 1 FROM WS-LIST-MENU-CUR-NODE (L-SUB) GO TO 750-NO-RIGHT-MOST. MOVE WS-LIST-MENU-NODE (L-SUB , WS-LIST-MENU-CUR-NODE (L-SUB)) TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF INVALID-KEY MOVE "T" TO WS-MASTER-RECORD-TYPE MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT IF INVALID-KEY DISPLAY "NON EXISTANT ", WS-MASTER-RECORD-NAME MOVE "NON EXISTANT" TO LOG-MESSAGE MOVE WS-MASTER-RECORD-NAME TO LOG-REC WRITE LOG-RECORD SUBTRACT 1 FROM WS-LIST-MENU-CUR-NODE (L-SUB) GO TO 750-NO-RIGHT-MOST. IF WS-MASTER-RECORD-TYPE = "T" SUBTRACT 1 FROM WS-LIST-MENU-CUR-NODE (L-SUB) GO TO 750-NO-RIGHT-MOST. IF WS-MASTER-RECORD-TYPE NOT = "M" SUBTRACT 1 FROM WS-LIST-MENU-CUR-NODE (L-SUB) GO TO 750-NO-RIGHT-MOST. MOVE SPACES TO LOG-MESSAGE. PERFORM 750-CHECK-IT VARYING CHK-SUB FROM 1 BY 1 UNTIL CHK-SUB > L-SUB. IF LOG-MESSAGE = "RECURSIVE " GO TO 750-RECURSION-EXIT. GO TO 750-PUT-ON-LIST. / 750-CHECK-IT. IF WS-MASTER-RECORD-NAME = WS-LIST-RECORD-NAME (CHK-SUB) DISPLAY " RECURSIVE ", WS-LIST-RECORD-NAME(L-SUB), WS-MASTER-RECORD-NAME MOVE "Y" TO STRUCTURE-SW MOVE "RECURSIVE " TO LOG-MESSAGE STRING "Menu " WS-LIST-RECORD-NAME(L-SUB) " Tran. " WS-MASTER-RECORD-NAME DELIMITED BY SIZE INTO LOG-REC WRITE LOG-RECORD MOVE ZERO TO L-SUB. 750-RECURSION-EXIT. EXIT. 751-CHECK-MENU-TABLE. MOVE ZERO TO U-SUB. MOVE "N" TO UMT-SW. 751-CHECK-LOOP. ADD 1 TO U-SUB. IF U-SUB NOT > UMT-SUB IF WS-USER-MENU-TABLE (U-SUB) = WS-TOP-LEVEL-MENU-NAME MOVE "Y" TO UMT-SW GO TO 751-CHECK-MENU-TABLE-EXIT ELSE GO TO 751-CHECK-LOOP. 751-CHECK-MENU-TABLE-EXIT. EXIT. / 760-REBUILD-SECURITY. PERFORM 810-CLOSE-SECURITY THRU 810-CLOSE-SECURITY-EXIT. PERFORM 810-CLOSE-USER THRU 810-CLOSE-USER-EXIT. PERFORM 800-OPEN-USER THRU 800-OPEN-USER-EXIT. PERFORM 801-OPEN-NEW-SECURITY THRU 801-OPEN-NEW-SECURITY-EXIT. 760-READ-USER. MOVE 0 TO L-SUB, CHK-SUB. IF FROM-FIX-SECURITY GO TO 760-REBUILD-SECURITY-EXIT. PERFORM 661-READ-USER-NEXT THRU 661-READ-USER-NEXT-EXIT. IF DONE DISPLAY "SECURITY FILE REBUILT" MOVE " SECURITY FILE REBUILT " TO LOG-MESSAGE MOVE SPACES TO LOG-REC WRITE LOG-RECORD GO TO 760-REBUILD-SECURITY-EXIT. IF WS-USERNAME NOT = WS-GENERIC-NAME GO TO 760-READ-USER. IF WS-USERNAME = SPACES DISPLAY "USERNAME = SPACES " GO TO 760-READ-USER. 760-GET-TOP-LEVEL-MENU. MOVE WS-TOP-LEVEL-MENU-NAME TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF INVALID-KEY DISPLAY "MENU NAME IN USER RECORD NOT MENU ", WS-MASTER-RECORD-NAME MOVE "MENU NAME IN USER RECORD NOT MENU " TO LOG-MESSAGE MOVE WS-MASTER-RECORD-NAME TO LOG-REC WRITE LOG-RECORD GO TO 760-READ-USER. / 760-PUT-ON-LIST. IF WS-MASTER-MENU-NODE-CNT < 0 DISPLAY "MASTER MENU NODE COUNT < 0 ", WS-MASTER-PRIMARY-KEY. IF WS-MASTER-MENU-NODE-CNT > 20 DISPLAY "MASTER MENU NODE COUNT > 20", WS-MASTER-PRIMARY-KEY MOVE "MASTER MENU NODE COUNT > 20 " TO LOG-MESSAGE MOVE WS-MASTER-RECORD-NAME TO LOG-REC WRITE LOG-RECORD MOVE WS-USERNAME TO LOG-REC WRITE LOG-RECORD GO TO 760-READ-USER. ADD 1 TO L-SUB. MOVE WS-MASTER-RECORD TO WS-LIST-RECORD (L-SUB). 760-GET-NEXT-NODE. ADD 1 TO CHK-SUB. IF CHK-SUB > WS-LIST-MENU-NODE-CNT (1) MOVE 1 TO CHK-SUB MOVE WS-LIST-RECORD (L-SUB) TO WS-LIST-RECORD (1) SUBTRACT 1 FROM L-SUB IF L-SUB < 1 GO TO 760-READ-USER. IF WS-LIST-MENU-NODE (1,CHK-SUB) = SPACES GO TO 760-GET-NEXT-NODE. MOVE WS-LIST-MENU-NODE (1,CHK-SUB) TO WS-MASTER-RECORD-NAME. MOVE "M" TO WS-MASTER-RECORD-TYPE. MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY. PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT. IF INVALID-KEY MOVE "T" TO WS-MASTER-RECORD-TYPE MOVE WS-MASTER-PRIMARY-KEY TO MASTER-PRIMARY-KEY PERFORM 600-READ-MASTER THRU 600-READ-MASTER-EXIT IF INVALID-KEY DISPLAY "NON EXISTANT ", WS-MASTER-RECORD-NAME MOVE "NON EXISTANT" TO LOG-MESSAGE MOVE WS-MASTER-RECORD-NAME TO LOG-REC WRITE LOG-RECORD GO TO 760-GET-NEXT-NODE. IF WS-MASTER-RECORD-TYPE = "T" MOVE WS-GENERIC-NAME TO WS-GENERIC-USERNAME MOVE WS-MASTER-RECORD-NAME TO WS-TRANSACTION-NAME PERFORM 675-WRITE-SECURITY THRU 675-WRITE-SECURITY-EXIT GO TO 760-GET-NEXT-NODE. GO TO 760-PUT-ON-LIST. 760-REBUILD-SECURITY-EXIT. EXIT. / 770-FIX-SECURITY. MOVE 0 TO FIX-SUB. 770-NEXT-CHANGE. ADD 1 TO FIX-SUB. IF FIX-SUB > TABLE-MAX DISPLAY "LIST GREATER 25 " GO TO 770-FIX-SECURITY-EXIT. EVALUATE WS-OTHER-FUNCTION (FIX-SUB), WS-OTHER-TYPE (FIX-SUB) WHEN "A", "U" PERFORM 770-ADD-USER-SECURITY THRU 770-ADD-USER-SECURITY-EXIT WHEN "D", "U" PERFORM 770-DELETE-USER-SECURITY THRU 770-DELETE-USER-SECURITY-EXIT WHEN "A", "T" GO TO 770-NEXT-CHANGE WHEN "D", "T" PERFORM 770-DELETE-TRAN-SECURITY THRU 770-DELETE-TRAN-SECURITY-EXIT WHEN OTHER GO TO 770-FIX-SECURITY-EXIT END-EVALUATE. GO TO 770-NEXT-CHANGE. 770-ADD-USER-SECURITY. MOVE 0 TO CHK-SUB, L-SUB. MOVE "Y" TO FIX-SW. MOVE WS-OTHER-NAME (FIX-SUB) TO WS-USERNAME. MOVE WS-USER-RECORD TO USERNAME-RECORD. PERFORM 660-READ-USER THRU 660-READ-USER-EXIT. IF INVALID-KEY GO TO 770-ADD-USER-SECURITY-EXIT. PERFORM 760-GET-TOP-LEVEL-MENU THRU 760-REBUILD-SECURITY-EXIT. MOVE "N" TO FIX-SW. 770-ADD-USER-SECURITY-EXIT. EXIT. 770-DELETE-USER-SECURITY. PERFORM 810-CLOSE-SECURITY THRU 810-CLOSE-SECURITY-EXIT. PERFORM 800-OPEN-SECURITY THRU 800-OPEN-SECURITY-EXIT. 770-READ-SECURITY. PERFORM 671-READ-SECURITY-NEXT THRU 671-READ-SECURITY-NEXT-EXIT. IF DONE GO TO 770-DELETE-USER-SECURITY-EXIT. IF WS-GENERIC-USERNAME = WS-OTHER-NAME (FIX-SUB) DELETE UIF-SECURITY-FILE INVALID KEY DISPLAY "NOT DELETED ", WS-SECURITY-RECORD. GO TO 770-READ-SECURITY. 770-DELETE-USER-SECURITY-EXIT. EXIT. / 770-DELETE-TRAN-SECURITY. PERFORM 810-CLOSE-SECURITY THRU 810-CLOSE-SECURITY-EXIT. PERFORM 800-OPEN-SECURITY THRU 800-OPEN-SECURITY-EXIT. 770-DELETE-TRAN-READ. PERFORM 671-READ-SECURITY-NEXT THRU 671-READ-SECURITY-NEXT-EXIT. IF DONE GO TO 770-DELETE-TRAN-SECURITY-EXIT. IF WS-TRANSACTION-NAME = WS-OTHER-NAME (FIX-SUB) DELETE UIF-SECURITY-FILE INVALID KEY DISPLAY "DELETED ", WS-SECURITY-RECORD. GO TO 770-DELETE-TRAN-READ. 770-DELETE-TRAN-SECURITY-EXIT. EXIT. 770-FIX-SECURITY-EXIT. EXIT. 780-ZERO-ACCESS-COUNT. PERFORM 810-CLOSE-MASTER THRU 810-CLOSE-MASTER-EXIT. PERFORM 800-OPEN-MASTER THRU 800-OPEN-MASTER-EXIT. 780-ZERO-READ. PERFORM 601-READ-MASTER-NEXT THRU 601-READ-MASTER-NEXT-EXIT. IF DONE GO TO 780-ZERO-ACCESS-COUNT-EXIT. IF MASTER-RECORD-ACCESS-COUNT = 0 DISPLAY "ZERO ACCESS COUNT ", WS-MASTER-PRIMARY-KEY MOVE " ZERO ACCESS COUNT " TO LOG-MESSAGE MOVE WS-MASTER-PRIMARY-KEY TO LOG-REC WRITE LOG-RECORD. GO TO 780-ZERO-READ. 780-ZERO-ACCESS-COUNT-EXIT. EXIT. / 800-OPEN-FILES. 800-OPEN-MASTER. OPEN I-O UIF-MASTER-FILE. 800-OPEN-MASTER-EXIT. EXIT. 800-OPEN-USER. OPEN I-O UIF-USERNAME-FILE. 800-OPEN-USER-EXIT. EXIT. 800-OPEN-SECURITY. OPEN I-O UIF-SECURITY-FILE. 800-OPEN-SECURITY-EXIT. EXIT. 800-OPEN-LOG. OPEN OUTPUT UIF-LOG-FILE. 800-OPEN-LOG-EXIT. EXIT. 800-OPEN-SCOPE. CALL "SCPIN" USING BY DESCRIPTOR SCOPE-STATUS-RECORD. IF SCOPE-ERROR PERFORM 805-SCOPE-ERROR THRU 805-SCOPE-ERROR-EXIT. 800-OPEN-FILES-EXIT. EXIT. 801-OPEN-NEW-SECURITY. OPEN OUTPUT UIF-SECURITY-FILE. 801-OPEN-NEW-SECURITY-EXIT. EXIT. 805-SCOPE-ERROR. CALL "SCPSS" USING BY DESCRIPTOR SCOPE-SCREEN-IMAGE. CALL "UTL587" USING ABNORMAL-TERMINATION-RECORD, SCOPE-ERROR-NO, SCOPE-SCREEN-IMAGE, PROG-ID. CALL "SCPRT". PERFORM 810-CLOSE-FILES THRU 810-CLOSE-FILES-EXIT. 805-SCOPE-ERROR-EXIT. 807-CALL-SCPER. CALL "SCPER" USING BY DESCRIPTOR SCOPE-ERROR-MSG. IF SCOPE-ERROR PERFORM 805-SCOPE-ERROR THRU 805-SCOPE-ERROR-EXIT. 807-CALL-SCPER-EXIT. 808-CALL-SCPEN. CALL "SCPEN" USING BY DESCRIPTOR DISPLAY-MSG. IF SCOPE-ERROR PERFORM 805-SCOPE-ERROR THRU 805-SCOPE-ERROR-EXIT. 808-CALL-SCPEN-EXIT. / 810-CLOSE-FILES. 810-CLOSE-MASTER. CLOSE UIF-MASTER-FILE. 810-CLOSE-MASTER-EXIT. EXIT. 810-CLOSE-USER. CLOSE UIF-USERNAME-FILE. 810-CLOSE-USER-EXIT. EXIT. 810-CLOSE-SECURITY. CLOSE UIF-SECURITY-FILE. 810-CLOSE-SECURITY-EXIT. EXIT. 810-CLOSE-LOG. CLOSE UIF-LOG-FILE. 810-CLOSE-LOG-EXIT. EXIT. 810-CLOSE-FILES-EXIT. EXIT. / ******************************************************************************** *CLOSING SECTION. ******************************************************************************** 900-RECUR-SECUR-ZERO-TESTS. CALL "SCPRT" USING BY DESCRIPTOR SCP-CLEAR-SCREEN. * IF A MENU HAS BEEN ADDED OR CHANGED THE WHOLE MASTER FILE MUST BE CHECKED * FOR RECURSION AND THE WHOLE SECURITY FILE REBUILT * IF STRUCTURE-CHANGES DISPLAY " " DISPLAY "STARTING RECURSIVE TEST " MOVE " STARTING RECURSIVE TEST " TO LOG-MESSAGE MOVE SPACES TO LOG-REC WRITE LOG-RECORD MOVE "N" TO STRUCTURE-SW PERFORM 750-RECURSION THRU 750-RECURSION-EXIT IF STRUCTURE-CHANGES CALL "SCPST" USING BY DESCRIPTOR SCP-CLEAR-SCREEN MOVE "Recursive Menu Found, Use Option 6 to Correct" TO LOG-MESSAGE MOVE LOG-RECORD TO SCOPE-ERROR-MSG PERFORM 807-CALL-SCPER THRU 807-CALL-SCPER-EXIT GO TO 100-MAIN END-IF DISPLAY "STARTING REBUILD SECURITY " MOVE " STARTING REBUILD SECURITY " TO LOG-MESSAGE MOVE SPACES TO LOG-REC WRITE LOG-RECORD PERFORM 760-REBUILD-SECURITY THRU 760-REBUILD-SECURITY-EXIT DISPLAY "STARTING ZERO ACCESS COUNT" MOVE " STARTING ZERO ACCESS COUNT " TO LOG-MESSAGE MOVE SPACES TO LOG-REC WRITE LOG-RECORD PERFORM 780-ZERO-ACCESS-COUNT THRU 780-ZERO-ACCESS-COUNT-EXIT GO TO 999-REAL-EXIT. * IF THERE ARE NO MENU CHANGES THEN WE DON'T NEED TO CHECK FOR RECURSION * AND ONLY NEED TO UPDATE THE SECURITY FILE * IF OTHER-CHANGES DISPLAY " " DISPLAY "STARTING SECURITY FIX" MOVE " STARTING SECURITY FIX" TO LOG-MESSAGE MOVE SPACES TO LOG-REC WRITE LOG-RECORD PERFORM 770-FIX-SECURITY THRU 770-FIX-SECURITY-EXIT DISPLAY "STARTING ZERO ACCESS COUNT" MOVE " STARTING ZERO ACCESS COUNT " TO LOG-MESSAGE MOVE SPACES TO LOG-REC WRITE LOG-RECORD PERFORM 780-ZERO-ACCESS-COUNT THRU 780-ZERO-ACCESS-COUNT-EXIT. 999-REAL-EXIT. CALL "SCPRT" USING BY DESCRIPTOR SCP-CLEAR-SCREEN. PERFORM 810-CLOSE-FILES THRU 810-CLOSE-LOG-EXIT. STOP RUN .