IDENTIFICATION DIVISION. PROGRAM-ID. UIF330. AUTHOR. B. Wallis. INSTALLATION. FLEETWOOD ENTERPRISES, INC. DATE-WRITTEN. 16-Apr-84. *********************************************************************** * * PROGRAM FUNCTIONS: * This program will maintain the User List file of the User Interface * System. This program has been written so that it can easily be run as * part of a command procedure or interactively. * * PROGRAM OPTIONS: * * PROGRAM MODIFICATIONS: * * AUTHOR B. Wallis * DATE 16-Apr-84 * VERSION 1-A * * PROGRAM CHANGES: * *********************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. SPECIAL-NAMES. C01 IS TOP-OF-PAGE. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT MASTER-FILE ASSIGN TO DISK ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC. SELECT USERNAME-FILE ASSIGN TO DISK ORGANIZATION IS INDEXED ACCESS MODE IS RANDOM. DATA DIVISION. FILE SECTION. FD MASTER-FILE COPY "UIF_MASTER_FD" OF "UIFLIB". COPY "CDD_UIF.MASTER_RECORD" FROM DICTIONARY. FD USERNAME-FILE COPY "UIF_USERNAME_FD" OF "UIFLIB" REPLACING ==USER-USERNAME== BY ==USER-USERNAME OF USERNAME-RECORD==, ==USER-GENERIC-NAME== BY ==USER-GENERIC-NAME OF USERNAME-RECORD==. COPY "CDD_UIF.USERNAME_RECORD" FROM DICTIONARY. WORKING-STORAGE SECTION. 01 PROG-ID PIC X(9) VALUE "UIF330-1A". 01 CHOICE PIC X(1). 88 ADD-A-USER VALUE "A", "a". 88 CHANGE-A-USER VALUE "C", "c". 88 DELETE-A-USER VALUE "D", "d". 88 INQUIRE-A-USER VALUE "I", "i". 88 END-OF-JOB VALUE "E", "e". 01 DISPLAY-VARIABLES. 05 DISPLAY-AREA PIC X(80). 05 DISPLAY-POINTER PIC S9(9) COMP. COPY "CDD_UIF.USERNAME_RECORD" FROM DICTIONARY REPLACING ==USERNAME_RECORD== BY ==HOLD-USERNAME-RECORD==. 01 SWITCHES. 05 ABORT-SWITCH PIC X(1). 88 ABORT VALUE "T". 88 NOT-ABORT VALUE "F". 05 INVALID-KEY-SWITCH PIC X(1). 88 INVALID-KEY VALUE "T". 88 NOT-INVALID-KEY VALUE "F". 05 TERMINATION-SWITCH PIC X(1). 88 NORMAL-TERMINATION VALUE "N". 88 ABNORMAL-TERMINATION VALUE "A". 05 VALID-GENERIC-NAME-SWITCH PIC X(1). 88 VALID-GENERIC-NAME VALUE "T". 88 NOT-VALID-GENERIC-NAME VALUE "F". 05 VALID-TOP-LEVEL-MENU-SWITCH PIC X(1). 88 VALID-TOP-LEVEL-MENU VALUE "T". 88 NOT-VALID-TOP-LEVEL-MENU VALUE "F". 05 Y-OR-N-SWITCH PIC X(1). 88 Y VALUE "Y", "y". 88 N VALUE "N", "n". PROCEDURE DIVISION. INITIALIZATION SECTION. 000-INITIALIZATION. DISPLAY PROG-ID, " Update User List File". SET NORMAL-TERMINATION TO TRUE. OPEN INPUT MASTER-FILE ALLOWING ALL. OPEN I-O USERNAME-FILE ALLOWING ALL. GO TO MAIN. MAIN SECTION. 100-MAIN. PERFORM WITH TEST AFTER UNTIL END-OF-JOB OR ABNORMAL-TERMINATION DISPLAY " " DISPLAY "Type A to add, C to change, D to delete, I to inquire, ", "or E to end: " WITH NO ADVANCING ACCEPT CHOICE SET NOT-ABORT TO TRUE EVALUATE TRUE WHEN ADD-A-USER PERFORM 300-ADD-A-USER THRU 300-EXIT WHEN CHANGE-A-USER PERFORM 400-CHANGE-A-USER THRU 400-EXIT WHEN DELETE-A-USER PERFORM 500-DELETE-A-USER THRU 500-EXIT WHEN INQUIRE-A-USER PERFORM 600-INQUIRE-A-USER THRU 600-EXIT WHEN END-OF-JOB CONTINUE WHEN OTHER DISPLAY "Invalid choice, try again..." END-EVALUATE IF ABORT DISPLAY "Transaction has been aborted" END-IF END-PERFORM. CLOSE MASTER-FILE. CLOSE USERNAME-FILE. IF NORMAL-TERMINATION DISPLAY PROG-ID, " NORMAL TERMINATION" ELSE CALL "UTL550" USING PROG-ID, "F" END-IF. STOP RUN. SUBROUTINE SECTION. 300-ADD-A-USER. * * We get valid information from the user and build the record to add in * HOLD-USERNAME-RECORD. * INITIALIZE USERNAME-RECORD. DISPLAY "Enter user's name or to abort: " WITH NO ADVANCING. ACCEPT USER-USERNAME OF USERNAME-RECORD. IF USER-USERNAME OF USERNAME-RECORD = SPACES SET ABORT TO TRUE ELSE MOVE USERNAME-RECORD TO HOLD-USERNAME-RECORD PERFORM 800-READ-USERNAME-FILE THRU 800-EXIT IF INVALID-KEY PERFORM 320-GET-VALID-GENERIC-NAME THRU 320-EXIT IF NOT ABORT PERFORM 330-GET-VALID-TOP-LEVEL-MENU THRU 330-EXIT IF NOT ABORT MOVE HOLD-USERNAME-RECORD TO USERNAME-RECORD PERFORM 810-WRITE-USERNAME-RECORD THRU 810-EXIT IF INVALID-KEY DISPLAY ">>>> Internal error - Duplicate username <<<<" SET ABNORMAL-TERMINATION TO TRUE ELSE DISPLAY "Record has been added" END-IF END-IF END-IF ELSE DISPLAY "Record already exists on file" END-IF END-IF. 300-EXIT. 320-GET-VALID-GENERIC-NAME. PERFORM WITH TEST AFTER UNTIL VALID-GENERIC-NAME OR ABORT DISPLAY "Enter user's generic name or to abort: " WITH NO ADVANCING ACCEPT USER-GENERIC-NAME OF HOLD-USERNAME-RECORD IF USER-GENERIC-NAME OF HOLD-USERNAME-RECORD = SPACES SET ABORT TO TRUE ELSE MOVE USER-GENERIC-NAME OF HOLD-USERNAME-RECORD TO USER-USERNAME OF USERNAME-RECORD PERFORM 800-READ-USERNAME-FILE THRU 800-EXIT IF INVALID-KEY OR USER-GENERIC-NAME OF USERNAME-RECORD NOT = USER-USERNAME OF USERNAME-RECORD SET NOT-VALID-GENERIC-NAME TO TRUE DISPLAY "Record does not exist on file" ELSE SET VALID-GENERIC-NAME TO TRUE END-IF END-IF END-PERFORM. 320-EXIT. 330-GET-VALID-TOP-LEVEL-MENU. PERFORM WITH TEST AFTER UNTIL VALID-TOP-LEVEL-MENU OR ABORT DISPLAY "Enter user's top level menu or to abort: " WITH NO ADVANCING ACCEPT USER-TOP-LEVEL-MENU-NAME OF HOLD-USERNAME-RECORD IF USER-TOP-LEVEL-MENU-NAME OF HOLD-USERNAME-RECORD = SPACES SET ABORT TO TRUE ELSE MOVE USER-TOP-LEVEL-MENU-NAME OF HOLD-USERNAME-RECORD TO MASTER-RECORD-NAME INITIALIZE MASTER-RECORD-TYPE PERFORM 820-READ-MASTER-FILE THRU 820-EXIT IF INVALID-KEY OR MASTER-RECORD-NAME NOT = USER-TOP-LEVEL-MENU-NAME OF HOLD-USERNAME-RECORD SET NOT-VALID-TOP-LEVEL-MENU TO TRUE DISPLAY "Record does not exist on file" ELSE SET VALID-TOP-LEVEL-MENU TO TRUE END-IF END-IF END-PERFORM. 330-EXIT. 400-CHANGE-A-USER. DISPLAY "Enter user's name or to abort: " WITH NO ADVANCING. ACCEPT USER-USERNAME OF USERNAME-RECORD. IF USER-USERNAME OF USERNAME-RECORD = SPACES SET ABORT TO TRUE ELSE PERFORM 800-READ-USERNAME-FILE THRU 800-EXIT IF INVALID-KEY DISPLAY "Record does not exist on file" ELSE PERFORM 410-GET-NEW-GENERIC-USER-NAME THRU 410-EXIT PERFORM 420-GET-NEW-TOP-LEVEL-MENU THRU 420-EXIT PERFORM 430-CONFIRM-CHANGE THRU 430-EXIT END-IF END-IF. 400-EXIT. 410-GET-NEW-GENERIC-USER-NAME. MOVE USERNAME-RECORD TO HOLD-USERNAME-RECORD. INITIALIZE DISPLAY-AREA. MOVE 1 TO DISPLAY-POINTER. STRING "Enter new generic name or to leave it " DELIMITED BY SIZE, USER-GENERIC-NAME OF USERNAME-RECORD DELIMITED BY SPACE, ": " DELIMITED BY SIZE INTO DISPLAY-AREA WITH POINTER DISPLAY-POINTER. DISPLAY DISPLAY-AREA (1:DISPLAY-POINTER - 1) WITH NO ADVANCING. ACCEPT USER-GENERIC-NAME OF USERNAME-RECORD. IF USER-GENERIC-NAME OF USERNAME-RECORD = SPACES MOVE USER-GENERIC-NAME OF HOLD-USERNAME-RECORD TO USER-GENERIC-NAME OF USERNAME-RECORD END-IF. 410-EXIT. 420-GET-NEW-TOP-LEVEL-MENU. INITIALIZE DISPLAY-AREA. MOVE 1 TO DISPLAY-POINTER. STRING "Enter top level menu or to leave it " DELIMITED BY SIZE USER-TOP-LEVEL-MENU-NAME OF USERNAME-RECORD DELIMITED BY SPACE, ": " DELIMITED BY SIZE INTO DISPLAY-AREA WITH POINTER DISPLAY-POINTER. DISPLAY DISPLAY-AREA (1:DISPLAY-POINTER - 1) WITH NO ADVANCING. ACCEPT USER-TOP-LEVEL-MENU-NAME OF USERNAME-RECORD. IF USER-TOP-LEVEL-MENU-NAME OF USERNAME-RECORD = SPACES MOVE USER-TOP-LEVEL-MENU-NAME OF HOLD-USERNAME-RECORD TO USER-TOP-LEVEL-MENU-NAME OF USERNAME-RECORD END-IF. 420-EXIT. 430-CONFIRM-CHANGE. PERFORM WITH TEST AFTER UNTIL Y OR N DISPLAY "Change This Record? (Y or N): " WITH NO ADVANCING ACCEPT Y-OR-N-SWITCH EVALUATE TRUE WHEN Y PERFORM 840-REWRITE-RECORD THRU 840-EXIT IF INVALID-KEY DISPLAY ">>>> Internal error - ", "Illegal rewrite<<<<" SET ABNORMAL-TERMINATION TO TRUE ELSE DISPLAY "Record has been changed" END-IF WHEN N DISPLAY "Transaction has been aborted" WHEN OTHER DISPLAY "Please answer Y for yes or N for no" END-EVALUATE END-PERFORM. 430-EXIT. 500-DELETE-A-USER. DISPLAY "Enter user's name or to abort: " WITH NO ADVANCING. ACCEPT USER-USERNAME OF USERNAME-RECORD. IF USER-USERNAME OF USERNAME-RECORD = SPACES SET ABORT TO TRUE ELSE PERFORM 800-READ-USERNAME-FILE THRU 800-EXIT IF INVALID-KEY DISPLAY "Record does not exist on file" ELSE DISPLAY "Generic name => ", USER-GENERIC-NAME OF USERNAME-RECORD DISPLAY "Top level menu => ", USER-TOP-LEVEL-MENU-NAME OF USERNAME-RECORD PERFORM 510-CONFIRM-DELETE THRU 510-EXIT END-IF END-IF. 500-EXIT. 510-CONFIRM-DELETE. PERFORM WITH TEST AFTER UNTIL Y OR N DISPLAY "Delete This Record? (Y or N): " WITH NO ADVANCING ACCEPT Y-OR-N-SWITCH EVALUATE TRUE WHEN Y PERFORM 830-DELETE-RECORD THRU 830-EXIT IF INVALID-KEY DISPLAY ">>>> Internal error - ", "Illegal deletion <<<<" SET ABNORMAL-TERMINATION TO TRUE ELSE DISPLAY "Record has been deleted" END-IF WHEN N DISPLAY "Transaction has been aborted" WHEN OTHER DISPLAY "Please answer Y for yes or N for no" END-EVALUATE END-PERFORM. 510-EXIT. 600-INQUIRE-A-USER. DISPLAY "Enter user's name: " WITH NO ADVANCING. ACCEPT USER-USERNAME OF USERNAME-RECORD. PERFORM 800-READ-USERNAME-FILE THRU 800-EXIT. IF INVALID-KEY DISPLAY "Record does not exist on file" ELSE DISPLAY "Generic name => ", USER-GENERIC-NAME OF USERNAME-RECORD DISPLAY "Top level menu => ", USER-TOP-LEVEL-MENU-NAME OF USERNAME-RECORD END-IF. 600-EXIT. 800-READ-USERNAME-FILE. SET NOT-INVALID-KEY TO TRUE. READ USERNAME-FILE INVALID KEY SET INVALID-KEY TO TRUE END-READ. 800-EXIT. 810-WRITE-USERNAME-RECORD. SET NOT-INVALID-KEY TO TRUE. WRITE USERNAME-RECORD INVALID KEY SET INVALID-KEY TO TRUE END-WRITE. 810-EXIT. 820-READ-MASTER-FILE. SET NOT-INVALID-KEY TO TRUE. START MASTER-FILE KEY NOT < MASTER-PRIMARY-KEY INVALID KEY SET INVALID-KEY TO TRUE END-START. IF NOT-INVALID-KEY READ MASTER-FILE NEXT RECORD AT END SET INVALID-KEY TO TRUE END-READ END-IF. 820-EXIT. 830-DELETE-RECORD. SET NOT-INVALID-KEY TO TRUE. DELETE USERNAME-FILE RECORD INVALID KEY SET INVALID-KEY TO TRUE END-DELETE. 830-EXIT. 840-REWRITE-RECORD. SET NOT-INVALID-KEY TO TRUE. REWRITE USERNAME-RECORD INVALID KEY SET INVALID-KEY TO TRUE END-REWRITE. 840-EXIT.