IDENTIFICATION DIVISION. PROGRAM-ID. REMTAB. AUTHOR. BOB RIBOKAS. INSTALLATION. TERADYNE, INC. DATE-WRITTEN. 19-JUNE-1984. DATE-COMPILED. TODAY. *REMARKS. REMOTE TABLE MAINTENANCE - VERSION 2. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TABLE-DEFINITIONS ASSIGN TO "REMOTE$TABLES:" ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL FILE STATUS IS TABLE-FILE-STATUS. SELECT TABLE-DATA ASSIGN TO "REMOTE$TABLES:" ORGANIZATION IS RELATIVE ACCESS MODE IS DYNAMIC RELATIVE KEY IS TABLE-KEY FILE STATUS IS TABLE-FILE-STATUS. SELECT SORT-FILE ASSIGN TO "SYS$DISK:". SELECT IMPORT-FILE ASSIGN TO "SYS$DISK:" ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL FILE STATUS IS TABLE-FILE-STATUS. SELECT COMMAND-FILE ASSIGN TO "SYS$DISK:" ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL FILE STATUS IS TABLE-FILE-STATUS. DATA DIVISION. FILE SECTION. FD TABLE-DEFINITIONS LABEL RECORDS ARE STANDARD VALUE OF ID IS "REMTAB.DEF" DATA RECORD IS TABLE-DEF-RECORD. 01 TABLE-DEF-RECORD. 02 TABLE-DEFINITION-CODE PIC X(1). 88 TABLE-DEF VALUE "*". 88 TABLE-COMMENT VALUE "!". 02 TABLE-REST PIC X(79). FD TABLE-DATA LABEL RECORDS ARE STANDARD VALUE OF ID IS TABLE-FILE-ID RECORD IS VARYING IN SIZE FROM 1 TO 405 CHARACTERS DEPENDING ON RECORD-LENGTH DATA RECORDS ARE TABLE-TAB-RECORD, TABLE-DAT-RECORD. 01 TABLE-TAB-RECORD. 02 TABLE-TAB-CODE PIC X(6). 02 FILLER PIC X(1). 02 TABLE-TAB-NAME PIC X(5). 02 FILLER PIC X(1). 02 TABLE-TAB-KEY PIC 9(4). 02 FILLER PIC X(1). 02 TABLE-TAB-COUNT PIC 9(4). 01 TABLE-DAT-RECORD. 02 TABLE-DAT-CODE PIC X(5). 02 TABLE-DAT-REST PIC X(400). SD SORT-FILE. 01 SORT-RECORD PIC X(405). FD IMPORT-FILE LABEL RECORDS ARE STANDARD VALUE OF ID IS IMPORT-FILE-ID RECORD IS VARYING IN SIZE FROM 1 TO 405 CHARACTERS DEPENDING ON IMPORT-LENGTH DATA RECORD IS IMPORT-RECORD. 01 IMPORT-RECORD PIC X(405). FD COMMAND-FILE LABEL RECORDS ARE STANDARD VALUE OF ID IS COMMAND-FILE-ID RECORD IS VARYING IN SIZE FROM 1 TO 80 CHARACTERS DEPENDING ON COMMAND-LENGTH DATA RECORD IS COMMAND-RECORD. 01 COMMAND-RECORD PIC X(80). WORKING-STORAGE SECTION. 01 TABLE-FILE-STATUS PIC X(2). 88 TABLE-FILE-NOT-FOUND VALUE "97". 88 TABLE-FILE-CANT-BE-OPENED VALUE "30". 01 TABLE-FILE-RETRY-FLAG PIC 9(1), COMP. 88 TABLE-FILE-OK VALUE 0. 88 TABLE-FILE-RETRY VALUE 1. 01 TABLE-KEY PIC 9(4), COMP. 01 END-OF-FILE-FLAG PIC 9(1), COMP. 88 VALID-READ VALUE 0. 88 END-OF-FILE VALUE 1. 01 TABLE-INDEX PIC 9(3), COMP. 01 TABLE-MAX PIC 9(3), COMP. 01 ELEMENT-INDEX PIC 9(3), COMP. 01 START-POS PIC 9(3), COMP. 01 HOLD-AREA. 02 HOLD-NAME PIC X(30). 02 HOLD-TYPE PIC X(1). 02 HOLD-LENGTH PIC 9(2). 02 HOLD-OTHER PIC X(3). 02 HOLD-DECIMAL PIC 9(2). 02 HOLD-KEY PIC X(3). 88 KEY-ELEMENT VALUE "KEY". 01 TABLE-DEF-TABLE VALUE SPACES. 02 TABLE-DEF-ENTRY OCCURS 200 TIMES INDEXED BY TABLE-DEF-IDX. 03 TABLE-DEF-NAME PIC X(40). 03 TABLE-DEF-CODE PIC X(5). 03 TABLE-DEF-KEYS PIC 9(1). 03 TABLE-DEF-ELEMENT-IDX PIC 9(3). 03 TABLE-DEF-FILE-KEY PIC 9(4). 03 TABLE-DEF-ENTRY-COUNT PIC 9(4). 01 TABLE-LIMIT PIC 9(4), COMP, VALUE 200. 01 ELEMENT-DEF-TABLE VALUE SPACES. 02 ELEMENT-DEF-ENTRY OCCURS 500 TIMES INDEXED BY ELEMENT-DEF-IDX. 03 ELEMENT-DEF-NAME PIC X(30). 03 ELEMENT-DEF-TYPE PIC X(1). 88 ELEMENT-DEF-CHARACTER VALUE "C", "c". 88 ELEMENT-DEF-NUMERIC VALUE "N", "n". 03 ELEMENT-DEF-START PIC 9(3). 03 ELEMENT-DEF-LENGTH PIC 9(2). 03 ELEMENT-DEF-DECIMAL PIC 9(2). 03 ELEMENT-DEF-TABLE-IDX PIC 9(3). 01 ELEMENT-LIMIT PIC 9(4), COMP, VALUE 500. 01 DATA-TABLE. 02 DATA-ENTRY OCCURS 5000 TIMES INDEXED BY DATA-IDX. 03 DATA-TABLE-CODE PIC X(5). 03 DATA-TABLE-DATA PIC X(400). 01 DATA-TABLE-LIMIT PIC 9(4), COMP, VALUE 5000. 01 DATA-TABLE-MAX PIC 9(4), COMP, VALUE ZERO. 01 INPUT-LINE PIC X(10). 88 INPUT-NULL VALUE SPACES. 88 INPUT-ADD VALUE "A" "ADD". 88 INPUT-CHANGE VALUE "C" "CHANGE". 88 INPUT-DELETE VALUE "D" "DELETE". 88 INPUT-INQUIRE VALUE "I" "INQUIRE". 88 INPUT-LIST VALUE "L" "LIST". 88 INPUT-HELP VALUE "H" "HELP". 88 INPUT-VALID VALUE "V" "VALID". 88 INPUT-TABLES VALUE "T" "TABLES". 88 INPUT-END VALUE "E" "END". 88 INPUT-QUIT VALUE "Q" "QUIT". 88 INPUT-IMPORT VALUE "IM" "IMPORT". 88 INPUT-EXPORT VALUE "EX" "EXPORT". 88 INPUT-ERASE VALUE "ER" "ERASE". 01 INPUT-CODE PIC X(5). 01 INPUT-PROMPT PIC X(33). 01 INPUT-VALUE PIC X(80). 01 BUILD-ENTRY PIC X(400). 01 GOOD-KEY-FLAG PIC 9(1), COMP. 88 GOOD-KEY VALUE 1. 88 NOT-GOOD-KEY VALUE 0. 01 YES-NO-RES PIC X(3). 88 YES-RES VALUE "Y" "YE" "YES" "y" "ye" "yes". 88 NO-RES VALUE "N" "NO" "n" "no". 88 VALID-YES-NO-RES VALUE "Y" "YE" "YES" "N" "NO" "y" "ye" "yes" "n" "no". 01 HOLD-FRONT PIC X(10). 01 HOLD-BACK PIC X(10). 01 FRONT-COUNT PIC 9(2). 01 BACK-COUNT PIC 9(2). 01 KEY-LEN PIC 9(3). 01 WS-COUNT PIC 9(4). 01 WS-COUNT-OUT PIC ZZZ9. 01 HOLD-KEYS PIC X(400). 01 IMPORT-FILE-ID PIC X(12). 01 TABLE-FILE-ID PIC X(80) VALUE "REMOTE$TABLES:REMTAB.DAT". 01 TABLE-FILE-ID-LENGTH PIC 9(2), COMP, VALUE 15. 01 TEMP-TABLE-FILE-ID PIC X(80). 01 SAVE-TABLE-FILE-ID PIC X(80). 01 RECORD-LENGTH PIC 9(3), COMP. 01 STAT PIC S9(9), COMP. 01 RMS$__FNF PIC S9(9), COMP, VALUE 98962. 01 IMPORT-LENGTH PIC 9(3), COMP. 01 WS-TALLY PIC 9(3), COMP. 01 WS-THIS-END PIC 9(6), COMP. 01 WS-MAX-END PIC 9(6), COMP, VALUE ZERO. 01 WS-RECNO PIC 9(6), COMP, VALUE ZERO. 01 WS-PCT PIC 9(3), COMP, VALUE ZERO. 01 WS-LAST-PCT PIC 9(3), COMP, VALUE 999. 01 WS-REMTAB-PROCESS-NAME PIC X(128) VALUE "REMTAB". 01 WS-PROGRAM-BEING-RUN-FLAG PIC S9(4), COMP. 88 WS-PROGRAM-BEING-RUN VALUES 1 THRU 9999. 88 WS-PROGRAM-NOT-BEING-RUN VALUE 0. 01 WS-INPUT-FILE-ID PIC X(80), VALUE SPACES. 01 WS-CONTEXT PIC 9(8), COMP. 01 COMMAND-FILE-ID PIC X(80). 01 COMMAND-LENGTH PIC 9(2), COMP. 01 WS-INPUT-FROM-FILE-FLAG PIC 9(1), COMP, VALUE ZERO. 88 WS-INPUT-FROM-FILE VALUE 1. 88 WS-INPUT-FROM-TERMINAL VALUE 0. 01 WS-INPUT-LINE PIC X(80). 01 I PIC 9(2), COMP. 01 J PIC 9(2), COMP. 01 WS-NEW-PROCESS-NAME. 02 FILLER PIC X(7) VALUE "REMTAB_". 02 WS-PROCESS-FILE PIC X(8). ******************************************************************************** * * * Data structures used to boost / restore processes' priority * * * ******************************************************************************** 01 WS-PID PIC S9(9), COMP, VALUE ZERO. 01 WS-ITEM-LIST. 02 FILLER PIC S9(4), COMP, VALUE 4. 02 FILLER PIC S9(4), COMP, VALUE EXTERNAL JPI$_PRIB. 02 FILLER POINTER, VALUE REFERENCE WS-ORIGINAL-PRI. 02 FILLER PIC S9(9), COMP, VALUE ZERO. 02 FILLER PIC S9(4), COMP, VALUE 15. 02 FILLER PIC S9(4), COMP, VALUE EXTERNAL JPI$_PRCNAM. 02 FILLER POINTER, VALUE REFERENCE WS-ORIGINAL-PROCESS-NAME. 02 FILLER POINTER, VALUE REFERENCE WS-ORIGINAL-PROCESS-SIZE. 02 FILLER PIC S9(9), COMP, VALUE ZERO. 01 WS-ORIGINAL-PRI PIC S9(9), COMP, VALUE ZERO. 01 WS-ORIGINAL-PROCESS-NAME PIC X(15), VALUE SPACES. 01 WS-ORIGINAL-PROCESS-SIZE PIC S9(9), COMP. 01 WS-NEW-PRI PIC S9(9), COMP, VALUE ZERO. 01 WS-RELEASE-COUNT PIC 9(6), COMP, VALUE ZERO. 01 WS-COMMAND-LINE PIC X(80). 01 WS-START PIC 9(3), COMP. 01 WS-SWITCH-NAME PIC X(80). 01 WS-FOUND-FLAG PIC X(1). 88 WS-NOT-FOUND VALUE "*". 88 WS-ENTRIES-FOUND VALUE SPACE. 01 WS-EMPTY-FLAG PIC 9(1), COMP. 88 WS-NONE-EMPTY VALUE 0. 88 WS-SOME-EMPTY VALUE 1. 01 WS-CREATE-FILE-FLAG PIC 9(1), COMP, VALUE ZERO. 88 WS-CREATE-FILE VALUE 1. PROCEDURE DIVISION. DECLARATIVES. TABLE-DEFINTION-ERROR SECTION. USE AFTER STANDARD ERROR PROCEDURE ON TABLE-DEFINITIONS. TABLE-DEFINITION-DECODE. IF TABLE-FILE-NOT-FOUND SET TABLE-FILE-RETRY TO TRUE. TABLE-DATA-ERROR SECTION. USE AFTER STANDARD ERROR PROCEDURE ON TABLE-DATA. TABLE-DATA-DECODE. IF TABLE-FILE-NOT-FOUND SET TABLE-FILE-RETRY TO TRUE. IMPORT-FILE-ERROR SECTION. USE AFTER STANDARD ERROR PROCEDURE ON IMPORT-FILE. IMPORT-FILE-DECODE. IF TABLE-FILE-NOT-FOUND SET TABLE-FILE-RETRY TO TRUE. END DECLARATIVES. 000-REMTAB SECTION. 001-INIT. CALL "LIB$GET_FOREIGN" USING BY DESCRIPTOR WS-COMMAND-LINE. PERFORM 11000-PARSE-COMMAND-LINE. MOVE ZERO TO I, J. PERFORM VARYING I FROM 80 BY -1 UNTIL (TABLE-FILE-ID (I : 1) = "]" OR ":") OR I = 1 CONTINUE END-PERFORM. PERFORM VARYING J FROM 80 BY -1 UNTIL TABLE-FILE-ID (J : 1) = "." OR J = 1 CONTINUE END-PERFORM. MOVE TABLE-FILE-ID (I + 1 : J - I - 1) TO WS-PROCESS-FILE. MOVE WS-NEW-PROCESS-NAME TO WS-REMTAB-PROCESS-NAME. CALL "CHECKSYS" USING "P", WS-REMTAB-PROCESS-NAME, WS-PROGRAM-BEING-RUN-FLAG. IF WS-PROGRAM-BEING-RUN-FLAG > ZERO DISPLAY "%REMTAB-F-INUSE, " "Already in use by someone else, try again later..." STOP RUN. IF WS-INPUT-FILE-ID NOT = SPACES CALL "LIB$FIND_FILE" USING BY DESCRIPTOR WS-INPUT-FILE-ID, COMMAND-FILE-ID, BY REFERENCE WS-CONTEXT, BY DESCRIPTOR "SYS$DISK:REMTAB.CCL" GIVING STAT IF STAT IS FAILURE CALL "LIB$STOP" USING BY VALUE STAT ELSE OPEN INPUT COMMAND-FILE SET WS-INPUT-FROM-FILE TO TRUE. DISPLAY " ". DISPLAY "[REMTAB] Remote Table Maintenance Program". DISPLAY " ". PERFORM 900-SET-PROCESS-NAME. PERFORM 100-LOAD-DEFINITIONS. IF WS-CREATE-FILE OPEN OUTPUT TABLE-DATA CLOSE TABLE-DATA ELSE PERFORM 200-LOAD-TABLES. PERFORM 300-EDIT-TABLES UNTIL INPUT-END OR INPUT-QUIT. IF INPUT-END PERFORM 400-SAVE-TABLES. DISPLAY " ". PERFORM 910-RESET-PROCESS-NAME. STOP RUN. 100-LOAD-DEFINITIONS. SET TABLE-FILE-OK TO TRUE. OPEN INPUT TABLE-DEFINITIONS. IF TABLE-FILE-RETRY DISPLAY "?Could not OPEN Table Definition File... Aborting..." STOP RUN. MOVE ZERO TO TABLE-INDEX, ELEMENT-INDEX. SET VALID-READ TO TRUE. PERFORM 105-READ-DEF. IF VALID-READ PERFORM 110-PROCESS-DEFINITIONS UNTIL END-OF-FILE. ADD 1 TO ELEMENT-INDEX. MOVE 999 TO ELEMENT-DEF-TABLE-IDX (ELEMENT-INDEX). MOVE TABLE-INDEX TO TABLE-MAX. CLOSE TABLE-DEFINITIONS. 105-READ-DEF. MOVE SPACES TO TABLE-DEF-RECORD. READ TABLE-DEFINITIONS AT END SET END-OF-FILE TO TRUE. INSPECT TABLE-DEF-RECORD REPLACING ALL " " BY " ". MOVE ZERO TO WS-TALLY. INSPECT TABLE-DEF-RECORD TALLYING WS-TALLY FOR CHARACTERS BEFORE INITIAL "!". MOVE SPACES TO TABLE-DEF-RECORD ( WS-TALLY + 1 : 80 - WS-TALLY ). 110-PROCESS-DEFINITIONS. IF TABLE-COMMENT CONTINUE ELSE IF TABLE-DEF PERFORM 120-DEFINE-TABLE ELSE IF TABLE-DEF-RECORD NOT = SPACES AND TABLE-INDEX > ZERO PERFORM 130-DEFINE-ELEMENT. PERFORM 105-READ-DEF. 120-DEFINE-TABLE. ADD 1 TO TABLE-INDEX. IF TABLE-INDEX > TABLE-LIMIT DISPLAY "%REMTAB-F-TABCAP, TABLE capacity exceeded" STOP RUN. UNSTRING TABLE-REST DELIMITED BY "," INTO TABLE-DEF-NAME (TABLE-INDEX), TABLE-DEF-CODE (TABLE-INDEX). MOVE ZERO TO TABLE-DEF-KEYS (TABLE-INDEX). COMPUTE TABLE-DEF-ELEMENT-IDX (TABLE-INDEX) = ELEMENT-INDEX + 1. MOVE ZERO TO TABLE-DEF-FILE-KEY (TABLE-INDEX), TABLE-DEF-ENTRY-COUNT (TABLE-INDEX). MOVE 1 TO START-POS. 130-DEFINE-ELEMENT. ADD 1 TO ELEMENT-INDEX. IF ELEMENT-INDEX > ELEMENT-LIMIT DISPLAY "%REMTAB-F-ELEMAP, ELEMENT capacity exceeded" STOP RUN. MOVE SPACES TO HOLD-AREA. UNSTRING TABLE-DEF-RECORD DELIMITED BY "," OR ALL SPACES INTO HOLD-NAME, HOLD-TYPE, HOLD-LENGTH, HOLD-OTHER, HOLD-KEY. IF HOLD-OTHER = "KEY" OR "key" OR "Key" MOVE "0" TO HOLD-OTHER MOVE "KEY" TO HOLD-KEY. IF HOLD-OTHER = SPACES MOVE "0" TO HOLD-OTHER. UNSTRING HOLD-OTHER DELIMITED BY ALL SPACES INTO HOLD-DECIMAL. MOVE START-POS TO ELEMENT-DEF-START (ELEMENT-INDEX). MOVE HOLD-NAME TO ELEMENT-DEF-NAME (ELEMENT-INDEX). MOVE HOLD-TYPE TO ELEMENT-DEF-TYPE (ELEMENT-INDEX). MOVE HOLD-LENGTH TO ELEMENT-DEF-LENGTH (ELEMENT-INDEX). MOVE HOLD-DECIMAL TO ELEMENT-DEF-DECIMAL (ELEMENT-INDEX). MOVE TABLE-INDEX TO ELEMENT-DEF-TABLE-IDX (ELEMENT-INDEX). IF KEY-ELEMENT ADD 1 TO TABLE-DEF-KEYS (TABLE-INDEX). ADD HOLD-LENGTH TO START-POS. 200-LOAD-TABLES. SET TABLE-FILE-OK TO TRUE. OPEN INPUT TABLE-DATA. IF TABLE-FILE-RETRY DISPLAY "?Could not OPEN Table Data File... Aborting..." STOP RUN. MOVE ZERO TO DATA-TABLE-MAX, WS-RECNO. MOVE 999 TO WS-LAST-PCT. SET VALID-READ TO TRUE. DISPLAY "Loading... " WITH NO ADVANCING. PERFORM 205-READ-DATA. IF VALID-READ PERFORM 210-LOAD-TABLE UNTIL END-OF-FILE. DISPLAY " ". CLOSE TABLE-DATA. 205-READ-DATA. MOVE SPACES TO TABLE-DAT-RECORD. READ TABLE-DATA NEXT RECORD AT END SET END-OF-FILE TO TRUE. ADD 1 TO WS-RECNO. 210-LOAD-TABLE. IF TABLE-TAB-CODE = "/TABLE" COMPUTE WS-THIS-END = TABLE-TAB-KEY + TABLE-TAB-COUNT - 1 IF WS-THIS-END > WS-MAX-END MOVE WS-THIS-END TO WS-MAX-END END-IF ELSE ADD 1 TO DATA-TABLE-MAX IF DATA-TABLE-MAX > DATA-TABLE-LIMIT DISPLAY "%REMTAB-F-DATACAP, DATA capacity exceeded" STOP RUN END-IF MOVE TABLE-DAT-RECORD TO DATA-ENTRY (DATA-TABLE-MAX) COMPUTE WS-PCT = (WS-RECNO / WS-MAX-END) * 100 IF WS-PCT NOT = WS-LAST-PCT DISPLAY " Loading... " WS-PCT WITH CONVERSION "%..." WITH NO ADVANCING MOVE WS-PCT TO WS-LAST-PCT. PERFORM 205-READ-DATA. 300-EDIT-TABLES. DISPLAY " ". DISPLAY "Option (H for Help)? " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO INPUT-LINE. IF END-OF-FILE SET INPUT-END TO TRUE. CALL "STR$UPCASE" USING BY DESCRIPTOR INPUT-LINE, INPUT-LINE. EVALUATE TRUE WHEN INPUT-ADD PERFORM 310-ADD WHEN INPUT-CHANGE PERFORM 320-CHANGE WHEN INPUT-DELETE PERFORM 330-DELETE WHEN INPUT-INQUIRE PERFORM 340-INQUIRE WHEN INPUT-LIST PERFORM 350-LIST WHEN INPUT-HELP PERFORM 360-HELP WHEN INPUT-VALID OR INPUT-TABLES PERFORM 370-VALID WHEN INPUT-IMPORT PERFORM 600-IMPORT-FILE WHEN INPUT-EXPORT PERFORM 700-EXPORT-FILE WHEN INPUT-ERASE PERFORM 800-ERASE. 310-ADD. IF DATA-TABLE-MAX = DATA-TABLE-LIMIT DISPLAY "%REMTAB-E-DATACAP, DATA capacity exceeded" ELSE PERFORM 500-GET-KEY-INFO COMPUTE KEY-LEN = START-POS - 1 IF GOOD-KEY PERFORM 311-CHECK-KEY END-IF IF GOOD-KEY PERFORM 313-CONTINUE-ADD. 311-CHECK-KEY. SET DATA-IDX TO 1. SEARCH DATA-ENTRY AT END CONTINUE WHEN DATA-IDX > DATA-TABLE-MAX CONTINUE WHEN DATA-TABLE-CODE (DATA-IDX) = INPUT-CODE AND DATA-TABLE-DATA (DATA-IDX) ( 1 : KEY-LEN ) = BUILD-ENTRY ( 1 : KEY-LEN ) MOVE SPACES TO YES-NO-RES PERFORM 312-ASK-OK UNTIL VALID-YES-NO-RES. 312-ASK-OK. DISPLAY "%Key value exists in table...". DISPLAY "%Add it anyway? " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO YES-NO-RES. IF END-OF-FILE SET NO-RES TO TRUE. IF NOT VALID-YES-NO-RES DISPLAY "?Enter YES or NO". IF NO-RES SET NOT-GOOD-KEY TO TRUE. 313-CONTINUE-ADD. PERFORM 520-GET-VALUE UNTIL ELEMENT-DEF-TABLE-IDX (ELEMENT-INDEX) NOT = TABLE-DEF-IDX. MOVE SPACES TO YES-NO-RES. PERFORM 314-ASK-OK UNTIL VALID-YES-NO-RES. IF YES-RES ADD 1 TO DATA-TABLE-MAX MOVE INPUT-CODE TO DATA-TABLE-CODE (DATA-TABLE-MAX) MOVE BUILD-ENTRY TO DATA-TABLE-DATA (DATA-TABLE-MAX). 314-ASK-OK. DISPLAY "OK to Add? " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO YES-NO-RES. IF END-OF-FILE SET NO-RES TO TRUE. IF NOT VALID-YES-NO-RES DISPLAY "?Enter YES or NO". 320-CHANGE. PERFORM 500-GET-KEY-INFO. MOVE BUILD-ENTRY TO HOLD-KEYS. COMPUTE KEY-LEN = START-POS - 1. PERFORM 321-FIND-ENTRY VARYING DATA-IDX FROM 1 BY 1 UNTIL DATA-IDX > DATA-TABLE-MAX. 321-FIND-ENTRY. IF DATA-TABLE-CODE (DATA-IDX) = INPUT-CODE AND DATA-TABLE-DATA (DATA-IDX) ( 1 : KEY-LEN ) = HOLD-KEYS ( 1 : KEY-LEN ) PERFORM 322-VERIFY-ENTRY. 322-VERIFY-ENTRY. DISPLAY " ". MOVE TABLE-DEF-ELEMENT-IDX (TABLE-DEF-IDX) TO ELEMENT-INDEX. PERFORM 323-SHOW-FIELDS UNTIL ELEMENT-DEF-TABLE-IDX (ELEMENT-INDEX) NOT = TABLE-DEF-IDX. MOVE SPACES TO YES-NO-RES. PERFORM 324-ASK-CHANGE UNTIL VALID-YES-NO-RES. IF YES-RES PERFORM 325-DO-CHANGE. 323-SHOW-FIELDS. MOVE ELEMENT-DEF-NAME (ELEMENT-INDEX) TO INPUT-PROMPT. INSPECT INPUT-PROMPT REPLACING ALL " " BY ".". DISPLAY INPUT-PROMPT " " DATA-TABLE-DATA (DATA-IDX) ( ELEMENT-DEF-START (ELEMENT-INDEX) : ELEMENT-DEF-LENGTH (ELEMENT-INDEX) ) " ". ADD 1 TO ELEMENT-INDEX. 324-ASK-CHANGE. DISPLAY "Change this entry? " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO YES-NO-RES. IF END-OF-FILE SET NO-RES TO TRUE. IF NOT VALID-YES-NO-RES DISPLAY "?Enter YES or NO". 325-DO-CHANGE. MOVE TABLE-DEF-ELEMENT-IDX (TABLE-DEF-IDX) TO ELEMENT-INDEX. MOVE DATA-TABLE-DATA (DATA-IDX) TO BUILD-ENTRY. MOVE 1 TO START-POS. PERFORM 326-CHANGE-FIELDS UNTIL ELEMENT-DEF-TABLE-IDX (ELEMENT-INDEX) NOT = TABLE-DEF-IDX. MOVE BUILD-ENTRY TO DATA-TABLE-DATA (DATA-IDX). 326-CHANGE-FIELDS. MOVE ELEMENT-DEF-NAME (ELEMENT-INDEX) TO INPUT-PROMPT. INSPECT INPUT-PROMPT REPLACING ALL " " BY ".". DISPLAY INPUT-PROMPT " " BUILD-ENTRY ( ELEMENT-DEF-START (ELEMENT-INDEX) : ELEMENT-DEF-LENGTH (ELEMENT-INDEX) ) " (" ELEMENT-DEF-LENGTH (ELEMENT-INDEX) "): " WITH NO ADVANCING. MOVE ELEMENT-DEF-START (ELEMENT-INDEX) TO START-POS. PERFORM 530-GET-INPUT. ADD 1 TO ELEMENT-INDEX. 330-DELETE. PERFORM 500-GET-KEY-INFO. COMPUTE KEY-LEN = START-POS - 1. MOVE ZERO TO WS-COUNT. PERFORM 331-FIND-ENTRIES VARYING DATA-IDX FROM 1 BY 1 UNTIL DATA-IDX > DATA-TABLE-MAX. MOVE WS-COUNT TO WS-COUNT-OUT. DISPLAY WS-COUNT-OUT " deletions". 331-FIND-ENTRIES. IF DATA-TABLE-CODE (DATA-IDX) = INPUT-CODE AND DATA-TABLE-DATA (DATA-IDX) ( 1 : KEY-LEN ) = BUILD-ENTRY ( 1 : KEY-LEN ) PERFORM 332-DELETE-ENTRY. 332-DELETE-ENTRY. MOVE SPACES TO DATA-ENTRY (DATA-IDX). ADD 1 TO WS-COUNT. 340-INQUIRE. PERFORM 500-GET-KEY-INFO. IF GOOD-KEY COMPUTE KEY-LEN = START-POS - 1 PERFORM 341-FIND-ENTRIES VARYING DATA-IDX FROM 1 BY 1 UNTIL DATA-IDX > DATA-TABLE-MAX. 341-FIND-ENTRIES. IF DATA-TABLE-CODE (DATA-IDX) = INPUT-CODE AND DATA-TABLE-DATA (DATA-IDX) ( 1 : KEY-LEN ) = BUILD-ENTRY ( 1 : KEY-LEN ) PERFORM 342-DISPLAY-ENTRY. 342-DISPLAY-ENTRY. DISPLAY " ". MOVE TABLE-DEF-ELEMENT-IDX (TABLE-DEF-IDX) TO ELEMENT-INDEX. PERFORM 343-LIST-FIELDS UNTIL ELEMENT-DEF-TABLE-IDX (ELEMENT-INDEX) NOT = TABLE-DEF-IDX. 343-LIST-FIELDS. MOVE ELEMENT-DEF-NAME (ELEMENT-INDEX) TO INPUT-PROMPT. INSPECT INPUT-PROMPT REPLACING ALL " " BY ".". DISPLAY INPUT-PROMPT " " DATA-TABLE-DATA (DATA-IDX) ( ELEMENT-DEF-START (ELEMENT-INDEX) : ELEMENT-DEF-LENGTH (ELEMENT-INDEX) ) " ". ADD 1 TO ELEMENT-INDEX. 350-LIST. DISPLAY " ". DISPLAY "Table Code: " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO INPUT-CODE. IF END-OF-FILE MOVE SPACES TO INPUT-CODE. CALL "STR$UPCASE" USING BY DESCRIPTOR INPUT-CODE, INPUT-CODE. IF INPUT-CODE NOT = SPACES SET TABLE-DEF-IDX TO 1 SEARCH TABLE-DEF-ENTRY AT END DISPLAY "?Invalid Table Code" WHEN TABLE-DEF-ENTRY (TABLE-DEF-IDX ) = SPACES DISPLAY "?Invalid Table Code" WHEN TABLE-DEF-CODE (TABLE-DEF-IDX) = INPUT-CODE DISPLAY " " MOVE ZERO TO WS-COUNT PERFORM 351-LIST-ENTRIES VARYING TABLE-INDEX FROM 1 BY 1 UNTIL TABLE-INDEX > DATA-TABLE-MAX MOVE WS-COUNT TO WS-COUNT-OUT DISPLAY " " DISPLAY WS-COUNT-OUT " entries". 351-LIST-ENTRIES. IF DATA-TABLE-CODE (TABLE-INDEX) = INPUT-CODE ADD 1 TO WS-COUNT PERFORM 352-LIST-ENTRY. 352-LIST-ENTRY. MOVE TABLE-DEF-ELEMENT-IDX (TABLE-DEF-IDX) TO ELEMENT-INDEX. PERFORM 353-LIST-FIELDS UNTIL ELEMENT-DEF-TABLE-IDX (ELEMENT-INDEX) NOT = TABLE-DEF-IDX. DISPLAY " ". 353-LIST-FIELDS. DISPLAY DATA-TABLE-DATA (TABLE-INDEX) ( ELEMENT-DEF-START (ELEMENT-INDEX) : ELEMENT-DEF-LENGTH (ELEMENT-INDEX) ) " " WITH NO ADVANCING. ADD 1 TO ELEMENT-INDEX. 360-HELP. DISPLAY " ". DISPLAY "Enter one of the following:". DISPLAY " ". DISPLAY "A or ADD to add an element to a table". DISPLAY "C or CHANGE to change an element in a table". DISPLAY "D or DELETE to delete an element from a table". DISPLAY "I or INQUIRE to look at a table element". DISPLAY " " DISPLAY "L or LIST to list all elements for a table". DISPLAY "IM or IMPORT to import from a RMS file". DISPLAY "EX or EXPORT to export to a RMS file". DISPLAY "ER or ERASE to erase all elements for a table". DISPLAY " " DISPLAY "H or Help to get this list". DISPLAY "V or Valid to list valid table codes and descriptons". DISPLAY "T or Tables to list only those that exist in this file". DISPLAY " ". DISPLAY "E or End to end this program and write new table file". DISPLAY "Q or Quit to end this program without writing new file". DISPLAY " ". 370-VALID. DISPLAY " ". IF INPUT-VALID DISPLAY "Valid Table Codes are:" ELSE DISPLAY "Tables contained in " TABLE-FILE-ID (1 : TABLE-FILE-ID-LENGTH). DISPLAY " ". SET WS-NONE-EMPTY TO TRUE. PERFORM 375-LIST-TABLES VARYING TABLE-INDEX FROM 1 BY 1 UNTIL TABLE-INDEX > 200 OR TABLE-DEF-ENTRY (TABLE-INDEX) = SPACES. DISPLAY " ". IF WS-SOME-EMPTY DISPLAY "* is used to indicate tables that have no entries" DISPLAY " in this file" DISPLAY " ". 375-LIST-TABLES. MOVE SPACE TO WS-FOUND-FLAG. SET DATA-IDX TO 1. SEARCH DATA-ENTRY AT END SET WS-NOT-FOUND TO TRUE WHEN DATA-IDX > DATA-TABLE-MAX SET WS-NOT-FOUND TO TRUE WHEN DATA-TABLE-CODE (DATA-IDX) = TABLE-DEF-CODE (TABLE-INDEX) CONTINUE. IF INPUT-VALID OR WS-ENTRIES-FOUND IF WS-NOT-FOUND SET WS-SOME-EMPTY TO TRUE END-IF DISPLAY WS-FOUND-FLAG TABLE-DEF-CODE (TABLE-INDEX) " " TABLE-DEF-NAME (TABLE-INDEX). 400-SAVE-TABLES SECTION. 401-INIT. DISPLAY " ". DISPLAY "Writing Output File..." WITH NO ADVANCING. SORT SORT-FILE ON ASCENDING KEY SORT-RECORD INPUT PROCEDURE IS 410-DUMP-TABLE OUTPUT PROCEDURE IS 430-WRITE-FILE. DISPLAY " ". 410-DUMP-TABLE SECTION. 411-INIT. PERFORM 420-DUMP-ENTRY VARYING TABLE-INDEX FROM 1 BY 1 UNTIL TABLE-INDEX > DATA-TABLE-MAX. 420-DUMP-ENTRY SECTION. 421-INIT. IF DATA-ENTRY (TABLE-INDEX) NOT = SPACES RELEASE SORT-RECORD FROM DATA-ENTRY (TABLE-INDEX) ADD 1 TO WS-RELEASE-COUNT. 430-WRITE-FILE SECTION. 431-INIT. SET TABLE-FILE-OK TO TRUE. MOVE TABLE-FILE-ID TO TEMP-TABLE-FILE-ID. PERFORM VARYING WS-TALLY FROM 80 BY -1 UNTIL WS-TALLY = 1 OR TABLE-FILE-ID (WS-TALLY : 1) = "." CONTINUE END-PERFORM. MOVE ".NEW" TO TABLE-FILE-ID (WS-TALLY : 81 - WS-TALLY). PERFORM VARYING WS-TALLY FROM 80 BY -1 UNTIL WS-TALLY = 1 OR TEMP-TABLE-FILE-ID (WS-TALLY : 1) = ";" CONTINUE END-PERFORM. IF WS-TALLY > 1 MOVE SPACES TO TEMP-TABLE-FILE-ID (WS-TALLY : 81 - WS-TALLY). OPEN OUTPUT TABLE-DATA. IF TABLE-FILE-RETRY AND TABLE-FILE-CANT-BE-OPENED DISPLAY " " DISPLAY "?Could not OPEN TABLE-DATA for OUTPUT... Aborting..." STOP RUN. MOVE ZERO TO TABLE-KEY. PERFORM VARYING TABLE-DEF-IDX FROM 1 BY 1 UNTIL TABLE-DEF-IDX > TABLE-MAX SET DATA-IDX TO 1 SEARCH DATA-ENTRY AT END CONTINUE WHEN DATA-IDX > DATA-TABLE-MAX CONTINUE WHEN DATA-TABLE-CODE (DATA-IDX) = TABLE-DEF-CODE (TABLE-DEF-IDX) ADD 1 TO TABLE-KEY END-SEARCH END-PERFORM. MOVE ZERO TO WS-RECNO. MOVE 999 TO WS-LAST-PCT. SET VALID-READ TO TRUE. MOVE SPACES TO SORT-RECORD. RETURN SORT-FILE AT END SET END-OF-FILE TO TRUE. IF VALID-READ PERFORM 440-WRITE-RECORDS UNTIL END-OF-FILE. MOVE ZERO TO TABLE-KEY. PERFORM VARYING TABLE-DEF-IDX FROM 1 BY 1 UNTIL TABLE-DEF-IDX > TABLE-MAX IF TABLE-DEF-ENTRY-COUNT (TABLE-DEF-IDX) > ZERO ADD 1 TO TABLE-KEY MOVE SPACES TO TABLE-TAB-RECORD MOVE "/TABLE" TO TABLE-TAB-CODE MOVE TABLE-DEF-CODE (TABLE-DEF-IDX) TO TABLE-TAB-NAME MOVE TABLE-DEF-FILE-KEY (TABLE-DEF-IDX) TO TABLE-TAB-KEY MOVE TABLE-DEF-ENTRY-COUNT (TABLE-DEF-IDX) TO TABLE-TAB-COUNT MOVE 22 TO RECORD-LENGTH WRITE TABLE-TAB-RECORD INVALID KEY DISPLAY "%Invalid Key on WRITE to " TABLE-FILE-ID (1 : TABLE-FILE-ID-LENGTH) END-WRITE END-IF END-PERFORM. CLOSE TABLE-DATA. CALL "LIB$RENAME_FILE" USING BY DESCRIPTOR TABLE-FILE-ID, TEMP-TABLE-FILE-ID GIVING STAT. 439-EXIT. EXIT. 440-WRITE-RECORDS SECTION. 441-INIT. ADD 1 TO WS-RECNO. COMPUTE WS-PCT = (WS-RECNO / WS-RELEASE-COUNT) * 100. IF WS-PCT NOT = WS-LAST-PCT DISPLAY " Writing Output File... " WS-PCT WITH CONVERSION "%..." WITH NO ADVANCING MOVE WS-PCT TO WS-LAST-PCT. MOVE SORT-RECORD TO TABLE-DAT-RECORD. PERFORM VARYING RECORD-LENGTH FROM 405 BY -1 UNTIL RECORD-LENGTH = 1 OR TABLE-DAT-RECORD (RECORD-LENGTH : 1) NOT = SPACE CONTINUE END-PERFORM. ADD 1 TO TABLE-KEY. WRITE TABLE-DAT-RECORD. SET TABLE-DEF-IDX TO 1. SEARCH TABLE-DEF-ENTRY AT END CONTINUE WHEN TABLE-DEF-IDX > TABLE-MAX CONTINUE WHEN TABLE-DEF-CODE (TABLE-DEF-IDX) = TABLE-DAT-CODE AND TABLE-DEF-FILE-KEY (TABLE-DEF-IDX) NOT = ZERO ADD 1 TO TABLE-DEF-ENTRY-COUNT (TABLE-DEF-IDX) WHEN TABLE-DEF-CODE (TABLE-DEF-IDX) = TABLE-DAT-CODE AND TABLE-DEF-FILE-KEY (TABLE-DEF-IDX) = ZERO MOVE TABLE-KEY TO TABLE-DEF-FILE-KEY (TABLE-DEF-IDX) MOVE 1 TO TABLE-DEF-ENTRY-COUNT (TABLE-DEF-IDX). MOVE SPACES TO SORT-RECORD. RETURN SORT-FILE INTO TABLE-DAT-RECORD AT END SET END-OF-FILE TO TRUE. 449-EXIT. EXIT. 500-DATA-INPUT-ROUTINES SECTION. 500-GET-KEY-INFO. MOVE 1 TO START-POS. MOVE SPACES TO BUILD-ENTRY. SET NOT-GOOD-KEY TO TRUE. DISPLAY " ". DISPLAY "Table Code: " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO INPUT-CODE. IF END-OF-FILE MOVE SPACES TO INPUT-CODE. CALL "STR$UPCASE" USING BY DESCRIPTOR INPUT-CODE, INPUT-CODE. IF INPUT-CODE NOT = SPACES AND NOT INPUT-ERASE SET TABLE-DEF-IDX TO 1 SEARCH TABLE-DEF-ENTRY AT END DISPLAY "?Invalid Table Code" WHEN TABLE-DEF-ENTRY (TABLE-DEF-IDX ) = SPACES DISPLAY "?Invalid Table Code" WHEN TABLE-DEF-CODE (TABLE-DEF-IDX) = INPUT-CODE PERFORM 510-GET-KEYS. IF BUILD-ENTRY NOT = SPACES SET GOOD-KEY TO TRUE. 510-GET-KEYS. MOVE TABLE-DEF-ELEMENT-IDX (TABLE-DEF-IDX) TO ELEMENT-INDEX. PERFORM 520-GET-VALUE TABLE-DEF-KEYS (TABLE-DEF-IDX) TIMES. 520-GET-VALUE. MOVE ELEMENT-DEF-NAME (ELEMENT-INDEX) TO INPUT-PROMPT. INSPECT INPUT-PROMPT REPLACING ALL " " BY ".". DISPLAY INPUT-PROMPT " " WITH NO ADVANCING. DISPLAY "(" ELEMENT-DEF-LENGTH (ELEMENT-INDEX) "): " WITH NO ADVANCING. PERFORM 530-GET-INPUT. ADD ELEMENT-DEF-LENGTH (ELEMENT-INDEX) TO START-POS. ADD 1 TO ELEMENT-INDEX. 530-GET-INPUT. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO INPUT-VALUE. IF END-OF-FILE MOVE SPACES TO INPUT-VALUE. IF ELEMENT-DEF-NUMERIC (ELEMENT-INDEX) AND INPUT-VALUE NOT = SPACES PERFORM 540-REFORMAT-DATA. IF INPUT-VALUE NOT = SPACES IF INPUT-VALUE = '" "' OR "' '" MOVE SPACES TO BUILD-ENTRY ( START-POS : ELEMENT-DEF-LENGTH (ELEMENT-INDEX) ) ELSE MOVE INPUT-VALUE ( 1 : ELEMENT-DEF-LENGTH (ELEMENT-INDEX) ) TO BUILD-ENTRY ( START-POS : ELEMENT-DEF-LENGTH (ELEMENT-INDEX) ). 540-REFORMAT-DATA. MOVE SPACES TO HOLD-FRONT, HOLD-BACK. MOVE ZERO TO FRONT-COUNT, BACK-COUNT. UNSTRING INPUT-VALUE DELIMITED BY "." OR ALL SPACES INTO HOLD-FRONT COUNT IN FRONT-COUNT, HOLD-BACK COUNT IN BACK-COUNT. IF FRONT-COUNT > ELEMENT-DEF-LENGTH (ELEMENT-INDEX) - ELEMENT-DEF-DECIMAL (ELEMENT-INDEX) OR BACK-COUNT > ELEMENT-DEF-DECIMAL (ELEMENT-INDEX) DISPLAY "%Numeric Overflow...". MOVE SPACES TO INPUT-VALUE. MOVE HOLD-FRONT ( 1 : FRONT-COUNT ) TO INPUT-VALUE ( ELEMENT-DEF-LENGTH (ELEMENT-INDEX) - ELEMENT-DEF-DECIMAL (ELEMENT-INDEX) - FRONT-COUNT + 1 : FRONT-COUNT ). MOVE HOLD-BACK ( 1 : BACK-COUNT ) TO INPUT-VALUE ( ELEMENT-DEF-LENGTH (ELEMENT-INDEX) - ELEMENT-DEF-DECIMAL (ELEMENT-INDEX) + 1 : BACK-COUNT ). INSPECT INPUT-VALUE REPLACING ALL SPACE BY ZERO. 600-IMPORT-FILE. DISPLAY " ". DISPLAY "File ID: " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO IMPORT-FILE-ID. IF END-OF-FILE MOVE "REMTAB.SEQ" TO IMPORT-FILE-ID. SET TABLE-FILE-OK TO TRUE. OPEN INPUT IMPORT-FILE. IF TABLE-FILE-RETRY DISPLAY "?Could not OPEN Import File " IMPORT-FILE-ID ELSE PERFORM 610-DO-IMPORT. 610-DO-IMPORT. MOVE ZERO TO WS-COUNT. SET VALID-READ TO TRUE. PERFORM 620-READ-IMPORT. IF VALID-READ PERFORM 630-PROCESS-IMPORT UNTIL END-OF-FILE. MOVE WS-COUNT TO WS-COUNT-OUT. DISPLAY WS-COUNT-OUT " additions". CLOSE IMPORT-FILE. 620-READ-IMPORT. MOVE SPACES TO IMPORT-RECORD. READ IMPORT-FILE AT END SET END-OF-FILE TO TRUE. IF VALID-READ ADD 1 TO WS-COUNT. 630-PROCESS-IMPORT. ADD 1 TO DATA-TABLE-MAX. IF DATA-TABLE-MAX > DATA-TABLE-LIMIT DISPLAY "%REMTAB-F-DATACAP, DATA capacity exceeded" STOP RUN. MOVE IMPORT-RECORD TO DATA-ENTRY (DATA-TABLE-MAX). PERFORM 620-READ-IMPORT. 700-EXPORT-FILE. DISPLAY " ". DISPLAY "Table Code: " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO INPUT-CODE. IF END-OF-FILE MOVE "XXXXX" TO INPUT-CODE. CALL "STR$UPCASE" USING BY DESCRIPTOR INPUT-CODE, INPUT-CODE. DISPLAY "File ID: " WITH NO ADVANCING. PERFORM 10000-GET-INPUT. MOVE WS-INPUT-LINE TO IMPORT-FILE-ID. IF END-OF-FILE MOVE SPACES TO IMPORT-FILE-ID. IF IMPORT-FILE-ID = SPACES MOVE INPUT-CODE TO IMPORT-FILE-ID. OPEN OUTPUT IMPORT-FILE. MOVE ZERO TO WS-COUNT. PERFORM 710-FIND-ENTRIES VARYING DATA-IDX FROM 1 BY 1 UNTIL DATA-IDX > DATA-TABLE-MAX. CLOSE IMPORT-FILE. MOVE WS-COUNT TO WS-COUNT-OUT. DISPLAY WS-COUNT-OUT " records written to " IMPORT-FILE-ID. 710-FIND-ENTRIES. IF DATA-TABLE-CODE (DATA-IDX) = INPUT-CODE MOVE DATA-ENTRY (DATA-IDX) TO IMPORT-RECORD PERFORM VARYING IMPORT-LENGTH FROM 405 BY -1 UNTIL IMPORT-LENGTH = 1 OR IMPORT-RECORD (IMPORT-LENGTH : 1) NOT = SPACE CONTINUE END-PERFORM WRITE IMPORT-RECORD ADD 1 TO WS-COUNT. 800-ERASE. PERFORM 500-GET-KEY-INFO. MOVE ZERO TO WS-COUNT. PERFORM 810-FIND-ENTRIES VARYING DATA-IDX FROM 1 BY 1 UNTIL DATA-IDX > DATA-TABLE-MAX. MOVE WS-COUNT TO WS-COUNT-OUT. DISPLAY WS-COUNT-OUT " deletions". 810-FIND-ENTRIES. IF DATA-TABLE-CODE (DATA-IDX) = INPUT-CODE PERFORM 820-DELETE-ENTRY. 820-DELETE-ENTRY. MOVE SPACES TO DATA-ENTRY (DATA-IDX). ADD 1 TO WS-COUNT. ******************************************************************************** * * * Routines to set / reset process name * * * ******************************************************************************** 900-SET-PROCESS-NAME. CALL "SYS$GETJPIW" USING BY VALUE 0, BY REFERENCE WS-PID, BY VALUE 0, BY REFERENCE WS-ITEM-LIST, BY VALUE 0, BY VALUE 0, BY VALUE 0 GIVING STAT. IF STAT IS FAILURE CALL "LIB$STOP" USING BY VALUE STAT. CALL "SYS$SETPRN" USING BY DESCRIPTOR WS-NEW-PROCESS-NAME GIVING STAT. IF STAT IS FAILURE CALL "LIB$STOP" USING BY VALUE STAT. 910-RESET-PROCESS-NAME. CALL "SYS$SETPRN" USING BY DESCRIPTOR WS-ORIGINAL-PROCESS-NAME (1 : WS-ORIGINAL-PROCESS-SIZE) GIVING STAT. IF STAT IS FAILURE CALL "LIB$STOP" USING BY VALUE STAT. 10000-GET-INPUT SECTION. 10001-INIT. IF WS-INPUT-FROM-FILE SET VALID-READ TO TRUE READ COMMAND-FILE AT END CLOSE COMMAND-FILE SET END-OF-FILE TO TRUE SET WS-INPUT-FROM-TERMINAL TO TRUE END-READ IF VALID-READ DISPLAY COMMAND-RECORD (1 : COMMAND-LENGTH) MOVE COMMAND-RECORD (1 : COMMAND-LENGTH) TO WS-INPUT-LINE END-IF. IF WS-INPUT-FROM-TERMINAL SET VALID-READ TO TRUE ACCEPT WS-INPUT-LINE AT END SET END-OF-FILE TO TRUE. 10999-EXIT. EXIT. 11000-PARSE-COMMAND-LINE SECTION. 11001-INIT. MOVE ZERO TO WS-TALLY. PERFORM 11100-REMOVE-SWITCHES UNTIL WS-TALLY = 80. MOVE ZERO TO WS-TALLY. INSPECT WS-COMMAND-LINE TALLYING WS-TALLY FOR LEADING SPACES. IF WS-TALLY < 80 ADD 1 TO WS-TALLY UNSTRING WS-COMMAND-LINE DELIMITED BY ALL SPACES INTO WS-INPUT-FILE-ID WITH POINTER WS-TALLY. 11099-EXIT. EXIT. 11100-REMOVE-SWITCHES SECTION. 11101-INIT. MOVE ZERO TO WS-TALLY. INSPECT WS-COMMAND-LINE TALLYING WS-TALLY FOR CHARACTERS BEFORE INITIAL "/". IF WS-TALLY < 80 COMPUTE WS-START = WS-TALLY + 1 ADD 2 TO WS-TALLY PERFORM UNTIL WS-TALLY > 80 OR WS-COMMAND-LINE (WS-TALLY : 1) NOT = SPACE CONTINUE END-PERFORM IF WS-TALLY > 80 MOVE SPACES TO WS-COMMAND-LINE (WS-START : 81 - WS-START) ELSE PERFORM 11200-PARSE-SWITCH. 11199-EXIT. EXIT. 11200-PARSE-SWITCH SECTION. 11201-INIT. MOVE SPACES TO WS-SWITCH-NAME. UNSTRING WS-COMMAND-LINE DELIMITED BY "=" OR ":" OR "/" OR ALL SPACES INTO WS-SWITCH-NAME WITH POINTER WS-TALLY. EVALUATE WS-SWITCH-NAME WHEN "TABLE" PERFORM 11300-GET-TABLE-FILE-NAME WHEN "TABLE_FILE" PERFORM 11300-GET-TABLE-FILE-NAME WHEN OTHER DISPLAY "%REMTAB-E-INVQUAL, " "Invalid command qualifier: " WS-SWITCH-NAME STOP RUN. 11299-EXIT. EXIT. 11300-GET-TABLE-FILE-NAME SECTION. 11301-INIT. MOVE SPACES TO WS-INPUT-FILE-ID. UNSTRING WS-COMMAND-LINE DELIMITED BY "=" OR ":" OR "/" OR ALL SPACES INTO WS-INPUT-FILE-ID WITH POINTER WS-TALLY. CALL "LIB$FIND_FILE" USING BY DESCRIPTOR WS-INPUT-FILE-ID, TABLE-FILE-ID, BY REFERENCE WS-CONTEXT, BY DESCRIPTOR "REMOTE$TABLES:REMTAB.DAT" GIVING STAT. IF STAT = RMS$__FNF PERFORM 11400-NOT-FOUND. CALL "LIB$FIND_FILE_END" USING BY REFERENCE WS-CONTEXT GIVING STAT. IF STAT IS FAILURE CALL "LIB$STOP" USING BY VALUE STAT. MOVE SPACES TO WS-INPUT-FILE-ID. MOVE SPACES TO WS-COMMAND-LINE (WS-START : WS-TALLY - WS-START). MOVE ZERO TO TABLE-FILE-ID-LENGTH. INSPECT TABLE-FILE-ID TALLYING TABLE-FILE-ID-LENGTH FOR CHARACTERS BEFORE INITIAL SPACE. 11399-EXIT. EXIT. 11400-NOT-FOUND SECTION. 11401-INIT. DISPLAY "Table file not found, create it? " WITH NO ADVANCING. ACCEPT YES-NO-RES AT END STOP RUN. IF NO-RES STOP RUN. SET WS-CREATE-FILE TO TRUE. 11499-EXIT. EXIT.