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.
