IDENTIFICATION DIVISION.
PROGRAM-ID.	RPGIII.
DATE-WRITTEN.	APRIL 13, 1976.
AUTHOR.	HAL ROACH.
INSTALLATION.	CERRITOS COLLEGE.
REMARKS.	PROGRAM TO UPDATE I DATA CARD.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER.	DECSYSTEM-10.
OBJECT-COMPUTER.	DECSYSTEM-10.
SPECIAL-NAMES.
	CONSOLE IS TTY.
	CHANNEL (1) IS HOF.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT PROGRAM-FILE ASSIGN TO DSK
	ACCESS MODE IS RANDOM
	ACTUAL KEY IS PROGRAM-KEY
	FILE LIMIT IS 99999.
DATA DIVISION.
FILE SECTION.
FD	PROGRAM-FILE
	BLOCK CONTAINS 8 RECORDS
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS PROGRAM-IDENTIFICATION
	DATA RECORD IS PROGRAM-RECORD.
01	PROGRAM-RECORD	PIC X(90).
WORKING-STORAGE SECTION.
77	HOLD-23				PIC XX.
77	SIDE-CHANGE-CHECK		PIC X.
77	NUM-IT-1			PIC 9.
77	NUM-IT-2			PIC 99.
77	NUM-IT-4			PIC 9(4).
77	NUM-IT-6		PIC 9(6).
77	ELE-9			PIC 99.
77	FINAL-VALUE		PIC 99.
77	CLEAR-IT		PIC X(32)	VALUE SPACES.
77	CLEAR-3300		PIC X(24)	VALUE SPACES.
77	ERROR-CODE		PIC X.
77	I			PIC S9(5)	COMP.
77	J			PIC S9(5)	COMP.
77	K			PIC S9(5)	COMP.
77	L			PIC S9(5)	COMP.
77	PROGRAM-KEY		PIC 9(5)	COMP.
77	NEXT-PROGRAM		PIC X(6).
01	END-SIDE	PIC X.
01	END-CHG REDEFINES END-SIDE.
	02 THE-SIDE	PIC 9.
01	ELEM-NO.
	02 ELE-NUM	PIC XX.
01	NO-ELEM REDEFINES ELEM-NO.
	02 NUM-ELE	PIC 99.
01	DATA-STORAGE.
	02 DATA-A	PIC X(8)	OCCURS 29 TIMES.
01	THE-DATA.
	02 DATA-17.
	  03 DATA-16.
	    04 DATA-14.
	      05 DATA-12.
	        06 DATA-1	PIC X.
	        06 DATA-2	PIC X.
	      05 DATA-3		PIC XX.
	    04 DATA-4		PIC XX.
	  03 DATA-5		PIC X.
	02 DATA-6		PIC X.
01	A-DATA REDEFINES THE-DATA.
	02 DATA-18	PIC 9(8).
01	PROGRAM-ZERO.
	02 FILLER		PIC X(80).
	02 PROGRAM-REC-NO	PIC 9(5).
	02 PROGRAM-LAST-REC	PIC 9(5).
01	PROGRAM-MAIN.
	02 PROGRAM-PAGE		PIC 99.
	02 PROGRAM-LINE		PIC 999.
	02 PROGRAM-FORM		PIC X.
	02 PROGRAM-INFO.
	  03 FILLER	PIC X.
	  03 STAR-COMMENT	PIC X(67).
	02 PROGRAM-IDENT	PIC X(6).
	02 PROGRAM-ACT-REC	PIC 9(5).
	02 PROGRAM-FILL		PIC 9(5).
01	PROG-INFO.
	02 FILENAME.
	  03 OA-BLANK.
	    04 THE-STARE	PIC X.
	    04 FILLER		PIC X(6).
	  03 OA-CHECK	PIC X.
	02 SEQUENCE	PIC XX.
	02 NUMBER-IT	PIC X.
	02 OPTION	PIC X.
	02 REC-IDE	PIC XX.
	02 IDE-REC REDEFINES REC-IDE	PIC 99.
	02 POS-1	PIC X(4).
	02 SOP-1 REDEFINES POS-1	PIC ZZZ9.
	02 NOT-N-1	PIC X.
	02 CZD-1	PIC X.
	02 CHAR-1	PIC X.
	02 POS-2	PIC X(4).
	02 SOP-2 REDEFINES POS-2	PIC ZZZ9.
	02 NOT-N-2	PIC X.
	02 CZD-2	PIC X.
	02 CHAR-2	PIC X.
	02 POS-3	PIC X(4).
	02 SOP-3 REDEFINES POS-3	PIC ZZZ9.
	02 NOT-N-3	PIC X.
	02 CZD-3	PIC X.
	02 CHAR-3	PIC X.
	02 STA-SEL	PIC X.
	02 PAC-BIN	PIC X.
	02 FIE-LOC-FR	PIC X(4).
	02 LOC-FIE-FR REDEFINES FIE-LOC-FR	PIC ZZZ9.
	02 FIE-LOC-TO	PIC X(4).
	02 LOC-FIE-TO REDEFINES FIE-LOC-TO	PIC ZZZ9.
	02 DEC-POS	PIC X.
	02 FIE-NAM	PIC X(6).
	02 CON-LEV	PIC XX.
	02 MAT-FIE	PIC XX.
	02 FIE-REC	PIC XX.
	02 REC-FIE REDEFINES FIE-REC	PIC Z9.
	02 PLUS-IT	PIC XX.
	02 IT-PLUS REDEFINES PLUS-IT	PIC Z9.
	02 MINUS	PIC XX.
	02 SUNIM REDEFINES MINUS	PIC Z9.
	02 ZER-BLA	PIC XX.
	02 BLA-ZER REDEFINES ZER-BLA	PIC Z9.
	02 FILLER	PIC X(4).
01	PROG-COMMENT.
	02 THE-STAR	PIC X	VALUE "*".
	02 THE-COMMENT	PIC X(67).
01	TUBE-TITLE.
	02 TUBE-LINE-0.
	  03 FILLER		PIC X(4)	VALUE "PAGE".
	  03 DISPLAY-PAGE	PIC ZZZ.
	  03 FILLER		PIC X(5)	VALUE " LINE".
	  03 DISPLAY-LINE	PIC Z(4).
	  03 FILLER		PIC X(19)	VALUE
	" I DATA CARD - SIDE".
	  03 DISPLAY-SIDE	PIC ZZ.
	02 TUBE-LINE-1	PIC X(51)	VALUE
	"ELEMENT ELEMENT                          ELEMENT".
	02 TUBE-LINE-2	PIC X(51)	VALUE
	"NUMBER  DESCRIPTION                      [ENTRY]".
01	TUBE-DISPLAY.
	02 FILLER	PIC X(43)	VALUE
	"FILENAME                         [        ]".
	02 FILLER	PIC X(43)	VALUE
	"SEQUENCE                         [  ]".
	02 FILLER	PIC X(43)	VALUE
	"NUMBER                           [ ]".
	02 FILLER	PIC X(43)	VALUE
	"OPTION                           [ ]".
	02 FILLER	PIC X(43)	VALUE
	"RECORD IDENTIFYING INDICATOR, ** [  ]".
	02 FILLER	PIC X(43)	VALUE
	"POSITION - 1                     [    ]".
	02 FILLER	PIC X(43)	VALUE
	"NOT (N) - 1                      [ ]".
	02 FILLER	PIC X(43)	VALUE
	"C/Z/D - 1                        [ ]".
	02 FILLER	PIC X(43)	VALUE
	"CHARACTER - 1                    [ ]".
	02 FILLER	PIC X(43)	VALUE
	"POSITION - 2                     [    ]".
	02 FILLER	PIC X(43)	VALUE
	"NOT (N) - 2                      [ ]".
	02 FILLER	PIC X(43)	VALUE
	"C/Z/D - 2                        [ ]".
	02 FILLER	PIC X(43)	VALUE
	"CHARACTER - 2                    [ ]".
	02 FILLER	PIC X(43)	VALUE
	"POSITION - 3                     [    ]".
	02 FILLER	PIC X(43)	VALUE
	"NOT (N) - 3                      [ ]".
	02 FILLER	PIC X(43)	VALUE
	"C/Z/D - 3                        [ ]".
	02 FILLER	PIC X(43)	VALUE
	"CHARACTER - 3                    [ ]".
	02 FILLER	PIC X(43)	VALUE
	"STACKER SELECT                   [ ]".
	02 FILLER	PIC X(43)	VALUE
	"PACKED OR BINARY FIELD           [ ]".
	02 FILLER	PIC X(43)	VALUE
	"FIELD LOCATION FROM              [    ]".
	02 FILLER	PIC X(43)	VALUE
	"FIELD LOCATION TO                [    ]".
	02 FILLER	PIC X(43)	VALUE
	"DECIMAL POSITION                 [ ]".
	02 FILLER	PIC X(43)	VALUE
	"FIELD NAME                       [      ]".
	02 FILLER	PIC X(43)	VALUE
	"CONTROL LEVEL                    [  ]".
	02 FILLER	PIC X(43)	VALUE
	"MATCHING FIELDS                  [  ]".
	02 FILLER	PIC X(43)	VALUE
	"FIELD RECORD RELATION            [  ]".
	02 FILLER	PIC X(43)	VALUE
	"PLUS                             [  ]".
	02 FILLER	PIC X(43)	VALUE
	"MINUS                            [  ]".
	02 FILLER	PIC X(43)	VALUE
	"ZERO OR BLANK                    [  ]".
01	DISPLAY-TUBE REDEFINES TUBE-DISPLAY.
	02 FILLER	OCCURS 29 TIMES.
	  03 THE-TUBE	PIC X(43).
01	THE-NUMBER.
	02 II		PIC Z(5).
	02 FILLER	PIC XXX.
01	PROGRAM-IDENTIFICATION.
	02 PROGRAM-NAME		PIC X(6).
	02 PROGRAM-EXT		PIC XXX		VALUE "TMP".
01	PASS-IT.
	02 THE-FILE	PIC X(6).
	02 THE-TERM	PIC X.
	02 THE-ACTION	PIC XXX.
	02 THE-PAGE	PIC 99.
	02 THE-LINE	PIC 999.
	02 THE-FORM	PIC X.
	02 R-TYPE	PIC X.
01	ALL-DATA.
	02 ALL-1	PIC X.
	02 ALL-23.
	  03 ALL-2	PIC X.
	  03 ALL-3	PIC X.
	02 FILLER	PIC X(5).
PROCEDURE DIVISION.
START SECTION.
BEGIN.
	ENTER MACRO TRAP.
	MOVE SPACES TO PASS-IT.
*	DISPLAY "PASS-IT = " WITH NO ADVANCING ACCEPT PASS-IT.
	ENTER MACRO GTPRMS USING PASS-IT "X".
	IF THE-TERM = "A" OR "D" OR "V" OR "3" OR "B"
		GO TO CONT-PROG.
	DISPLAY "THE DRIVER PROGRAM WAS NOT USED".
	STOP RUN.
CONT-PROG.
	PERFORM CLEAR-SCREEN.
	ENTER MACRO SETTY USING "NO CRLF".
	ENTER MACRO SETTY USING "WIDTH 80".
	MOVE THE-FILE TO PROGRAM-NAME.
	MOVE ZERO TO THE-SIDE.
	IF THE-ACTION = "CHG"
		PERFORM FIND-REC THRU END-FIND-REC
		PERFORM FIND-SIDE THRU END-FIND-SIDE
		GO TO CONT-SIDE.
NEW-SIDE.
	ADD 1 TO THE-SIDE.
	IF THE-SIDE = 1
		MOVE 3 TO I
		MOVE 17 TO FINAL-VALUE.
	IF THE-SIDE = 2
		MOVE 17 TO I
		MOVE 32 TO FINAL-VALUE.
	IF THE-SIDE > 2
		GO TO END-DISPLAY.
CONT-SIDE.
	PERFORM CLEAR-SCREEN.
	IF END-CHG = "E"
		CLOSE PROGRAM-FILE
		GO TO END-IT.
	IF THE-STARE = "*"
		MOVE 1 TO K
		MOVE THE-STARE TO DATA-1
		GO TO COMMENT-CHECK.
	MOVE THE-PAGE TO DISPLAY-PAGE.
	MOVE THE-LINE TO DISPLAY-LINE.
	MOVE THE-SIDE TO DISPLAY-SIDE.
	DISPLAY TUBE-LINE-0.
	DISPLAY TUBE-LINE-1.
	DISPLAY TUBE-LINE-2.
LOOP-DISPLAY.
	ADD 1 TO I.
	IF I > FINAL-VALUE GO TO END-DISPLAY.
	SUBTRACT 3 FROM I GIVING K.
	MOVE K TO L.
	MOVE L TO II.
	MOVE 1 TO J.
	IF THE-SIDE = 2
		SUBTRACT 14 FROM I.
	PERFORM CURSOR.
	DISPLAY THE-NUMBER THE-TUBE (K) WITH NO ADVANCING.
	MOVE 43 TO J.
	PERFORM CURSOR.
	DISPLAY DATA-A (K).
	IF THE-SIDE = 2
		ADD 14 TO I.
	GO TO LOOP-DISPLAY.
END-DISPLAY.
	IF THE-ACTION = "CHG"
		GO TO FIND-NUMBER.
	IF THE-ACTION = "ADD" AND THE-SIDE = 1
		MOVE 3 TO I
		MOVE 17 TO FINAL-VALUE.
	IF THE-ACTION = "ADD" AND THE-SIDE = 2
		MOVE 17 TO I
		MOVE 32 TO FINAL-VALUE.
	IF THE-ACTION = "ADD" AND THE-SIDE < 3
		GO TO ADD-IT.
	IF THE-ACTION = "ADD" AND THE-SIDE > 2
		PERFORM CLEAR-SCREEN
		PERFORM WRITE-ADD THRU END-WRITE-ADD
		GO TO END-IT.
FIND-NUMBER.
	MOVE 23 TO I.
	MOVE 1 TO J.
	PERFORM CURSOR.
	DISPLAY "ELEMENT NUMBER = " WITH NO ADVANCING.
	MOVE SPACES TO ELE-NUM.
	DISPLAY ELE-NUM WITH NO ADVANCING.
	MOVE 18 TO J.
	PERFORM CURSOR.
	ACCEPT ELE-NUM.
	IF ELE-NUM = "EN"
		PERFORM CHG-REC THRU END-CHG-REC
		PERFORM CLEAR-SCREEN
		PERFORM FIND-SIDE THRU END-FIND-SIDE
		GO TO CONT-SIDE.
	MOVE NUM-ELE TO ELE-9.
	EXAMINE ELE-NUM REPLACING ALL SPACES BY ZERO.
	IF ELE-NUM IS NOT NUMERIC
		PERFORM BAD-NUMBER
		GO TO FIND-NUMBER.
	IF (THE-SIDE = 1) AND
		(ELE-9 < 1 OR ELE-9 > 14)
		PERFORM BAD-NUMBER
		GO TO FIND-NUMBER.
	IF (THE-SIDE = 2) AND
		(ELE-9 < 15 OR ELE-9 > 29)
		PERFORM BAD-NUMBER
		GO TO FIND-NUMBER.
	MOVE 23 TO I.
	MOVE 20 TO J.
	PERFORM CURSOR.
	PERFORM CLEAR-LINE.
	MOVE ELE-9 TO I.
	ADD 3 TO I.
BY-NUM.
	MOVE 43 TO J.
	SUBTRACT 3 FROM I GIVING K.
	MOVE K TO II.
	IF THE-SIDE = 2
		SUBTRACT 14 FROM I.
ACCEPT-CHG.
	PERFORM CURSOR.
	IF SIDE-CHANGE-CHECK = "X"
		MOVE SPACE TO SIDE-CHANGE-CHECK
		GO TO CHECK-SLASH.
	ACCEPT DATA-A (K).
	IF THE-ACTION = "ADD"
		MOVE DATA-A (K) TO ALL-DATA.
	IF ALL-1 = "/"
		MOVE SPACE TO DATA-A (K)
		GO TO CHECK-SLASH.
	IF K = 1 GO TO COMMENT-CHECK.
EDIT-IT.
	PERFORM THE-EDIT THRU END-THE-EDIT.
	IF ERROR-CODE = "X"
		MOVE SPACE TO ERROR-CODE
		MOVE 43 TO J
		PERFORM CURSOR
		GO TO ACCEPT-CHG.
	PERFORM CLEAN-IT.
	MOVE 43 TO J.
	PERFORM CURSOR.
	DISPLAY DATA-A (K).
	IF THE-ACTION = "ADD" GO TO LOOP-VALUE.
	GO TO FIND-NUMBER.
CHECK-SLASH.
	IF ALL-2 = "E"
		MOVE 2 TO THE-SIDE
		GO TO END-VALUE.
	IF ALL-23 = "S1"
		PERFORM CLEAN-IT
		MOVE ZERO TO THE-SIDE
		GO TO END-VALUE.
	IF ALL-23 = "S2"
		PERFORM CLEAN-IT
		MOVE 1 TO THE-SIDE
		GO TO END-VALUE.
	MOVE ALL-23 TO NUM-IT-2, HOLD-23.
	EXAMINE ALL-23 REPLACING ALL SPACES BY ZEROS.
	IF ALL-23 NOT NUMERIC
		GO TO BAD-ERROR.
	IF NUM-IT-2 < 1 OR NUM-IT-2 > 29
		GO TO BAD-ERROR.
	IF (THE-SIDE = 1) AND
		(NUM-IT-2 > 14 AND NUM-IT-2 < 30)
		MOVE HOLD-23 TO ALL-23
		MOVE "X" TO SIDE-CHANGE-CHECK
		MOVE 1 TO THE-SIDE
		GO TO END-VALUE.
	IF (THE-SIDE = 2) AND
		(NUM-IT-2 > 0 AND NUM-IT-2 < 15)
		MOVE HOLD-23 TO ALL-23
		MOVE "X" TO SIDE-CHANGE-CHECK
		MOVE ZERO TO THE-SIDE
		GO TO END-VALUE.
	MOVE NUM-IT-2 TO L.
	ADD 2 TO L.
	PERFORM CLEAN-IT.
	GO TO LOOP-VALUE.
BAD-ERROR.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " BAD SWITCH".
	MOVE 43 TO J.
	PERFORM CURSOR.
	GO TO ACCEPT-CHG.
CLEAN-IT.
	MOVE 49 TO J.
	PERFORM CURSOR.
	PERFORM CLEAR-LINE.
	MOVE 1 TO J.
	PERFORM CURSOR.
	DISPLAY THE-NUMBER THE-TUBE (K) WITH NO ADVANCING.
COMMENT-CHECK.
	MOVE DATA-A (K) TO THE-DATA.
	IF DATA-1 NOT = "*" GO TO EDIT-IT.
	PERFORM CLEAR-SCREEN.
	IF THE-ACTION = "CHG"
		DISPLAY "OLD COM" STAR-COMMENT.
	DISPLAY "         1    1    2    2    3    3    4    4    5    5    6    6    7   7".
	DISPLAY "       8901234567890123456789012345678901234567890123456789012345678901234".
	DISPLAY "NEW COM" WITH NO ADVANCING ACCEPT THE-COMMENT.
	MOVE PROG-COMMENT TO PROG-INFO.
	IF THE-ACTION = "CHG"
		PERFORM CHG-REC THRU END-CHG-REC
		PERFORM CLEAR-SCREEN
		CLOSE PROGRAM-FILE
		GO TO END-IT.
	MOVE 2 TO THE-SIDE.
	GO TO NEW-SIDE.
BAD-NUMBER.
	MOVE 23 TO I.
	MOVE 20 TO J.
	PERFORM CURSOR.
	DISPLAY " BAD NUMBER " ELE-NUM.
FIND-REC.
	OPEN I-O PROGRAM-FILE.
	MOVE 1 TO PROGRAM-KEY.
	READ PROGRAM-FILE INVALID KEY
	DISPLAY "BAD READ CHG FILE " PROGRAM-KEY STOP RUN.
	MOVE PROGRAM-RECORD TO PROGRAM-ZERO.
LOOP-CHG.
	ADD 1 TO PROGRAM-KEY.
	IF PROGRAM-KEY > PROGRAM-LAST-REC
		DISPLAY "LOGIC ERROR IN PROGRAM" STOP RUN.
	READ PROGRAM-FILE INVALID KEY
	DISPLAY "BAD READ CHG FILE " PROGRAM-KEY STOP RUN.
	MOVE PROGRAM-RECORD TO PROGRAM-MAIN.
	IF PROGRAM-PAGE NOT = THE-PAGE GO TO LOOP-CHG.
	IF PROGRAM-LINE NOT = THE-LINE GO TO LOOP-CHG.
	MOVE PROGRAM-INFO TO PROG-INFO.
	MOVE FILENAME TO DATA-A (1).
	MOVE SEQUENCE TO DATA-A (2).
	MOVE NUMBER-IT TO DATA-A (3).
	MOVE OPTION TO DATA-A (4).
	MOVE REC-IDE TO DATA-A (5).
	MOVE POS-1 TO DATA-A (6).
	MOVE NOT-N-1 TO DATA-A (7).
	MOVE CZD-1 TO DATA-A (8).
	MOVE CHAR-1 TO DATA-A (9).
	MOVE POS-2 TO DATA-A (10).
	MOVE NOT-N-2 TO DATA-A (11).
	MOVE CZD-2 TO DATA-A (12).
	MOVE CHAR-2 TO DATA-A (13).
	MOVE POS-3 TO DATA-A (14).
	MOVE NOT-N-3 TO DATA-A (15).
	MOVE CZD-3 TO DATA-A (16).
	MOVE CHAR-3 TO DATA-A (17).
	MOVE STA-SEL TO DATA-A (18).
	MOVE PAC-BIN TO DATA-A (19).
	MOVE FIE-LOC-FR TO DATA-A (20).
	MOVE FIE-LOC-TO TO DATA-A (21).
	MOVE DEC-POS TO DATA-A (22).
	MOVE FIE-NAM TO DATA-A (23).
	MOVE CON-LEV TO DATA-A (24).
	MOVE MAT-FIE TO DATA-A (25).
	MOVE FIE-REC TO DATA-A (26).
	MOVE PLUS-IT TO DATA-A (27).
	MOVE MINUS TO DATA-A (28).
	MOVE ZER-BLA TO DATA-A (29).
END-FIND-REC.
	EXIT.
FIND-SIDE.
	DISPLAY "SIDE = " WITH NO ADVANCING ACCEPT END-SIDE.
	IF END-SIDE = "E" GO TO END-FIND-SIDE.
	IF THE-SIDE = 1
		MOVE 3 TO I
		MOVE 17 TO FINAL-VALUE
		GO TO END-FIND-SIDE.
	IF THE-SIDE = 2
		MOVE 17 TO I
		MOVE 32 TO FINAL-VALUE
		GO TO END-FIND-SIDE.
	DISPLAY "BAD SIDE " THE-SIDE GO TO FIND-SIDE.
END-FIND-SIDE.
	EXIT.
CHG-REC.
	MOVE PROG-INFO TO PROGRAM-INFO.
	MOVE PROGRAM-MAIN TO PROGRAM-RECORD.
	WRITE PROGRAM-RECORD INVALID KEY
	DISPLAY "BAD WRITE CHG " PROGRAM-KEY STOP RUN.
END-CHG-REC.
	EXIT.
ADD-IT.
	MOVE I TO L.
LOOP-VALUE.
	ADD 1 TO L.
	IF L > FINAL-VALUE GO TO END-VALUE.
	MOVE L TO I.
	GO TO BY-NUM.
END-VALUE.
	PERFORM CLEAR-SCREEN.
	GO TO NEW-SIDE.
CURSOR.
	IF THE-TERM = "A" ENTER MACRO CURSER USING I,J.
	IF THE-TERM = "D" ENTER MACRO CA1520 USING I,J.
	IF THE-TERM = "V" ENTER MACRO CAVT52 USING I,J.
	IF THE-TERM = "3" ENTER MACRO CA3300 USING I,J.
	IF THE-TERM = "B" ENTER MACRO CAB100 USING I,J.
CLEAR-SCREEN.
	IF THE-TERM = "A" OR "D"
		ENTER MACRO TTYOUT USING 14.
	IF THE-TERM = "V"
		ENTER MACRO CLVT52.
	IF THE-TERM = "3"
		ENTER MACRO TTYOUT USING 35,37,37,37,37.
	IF THE-TERM = "B"
		ENTER MACRO CLB100.
CLEAR-LINE.
	IF THE-TERM = "A" OR "V" OR "B"
		DISPLAY CLEAR-IT WITH NO ADVANCING.
	IF THE-TERM = "D"
		ENTER MACRO TTYOUT USING 35.
	IF THE-TERM = "3"
		DISPLAY CLEAR-3300 WITH NO ADVANCING.
SIDE-2.
	IF THE-SIDE = 2
		ADD 14 TO I.
THE-EDIT.
	IF K = 1 PERFORM EDIT-1 THRU END-EDIT-1 GO TO END-THE-EDIT.
	IF K = 2 PERFORM EDIT-2 THRU END-EDIT-2 GO TO END-THE-EDIT.
	IF K = 3 PERFORM EDIT-3 THRU END-EDIT-3 GO TO END-THE-EDIT.
	IF K = 4 PERFORM EDIT-4 THRU END-EDIT-4 GO TO END-THE-EDIT.
	IF K = 5 PERFORM EDIT-5 THRU END-EDIT-5 GO TO END-THE-EDIT.
	IF K = 6 PERFORM EDIT-6 THRU END-EDIT-6 GO TO END-THE-EDIT.
	IF K = 7 PERFORM EDIT-7 THRU END-EDIT-7 GO TO END-THE-EDIT.
	IF K = 8 PERFORM EDIT-8 THRU END-EDIT-8 GO TO END-THE-EDIT.
	IF K = 9 PERFORM EDIT-9 THRU END-EDIT-9 GO TO END-THE-EDIT.
	IF K = 10 PERFORM EDIT-10 THRU END-EDIT-10 GO TO END-THE-EDIT.
	IF K = 11 PERFORM EDIT-11 THRU END-EDIT-11 GO TO END-THE-EDIT.
	IF K = 12 PERFORM EDIT-12 THRU END-EDIT-12 GO TO END-THE-EDIT.
	IF K = 13 PERFORM EDIT-13 THRU END-EDIT-13 GO TO END-THE-EDIT.
	IF K = 14 PERFORM EDIT-14 THRU END-EDIT-14 GO TO END-THE-EDIT.
	IF K = 15 PERFORM EDIT-15 THRU END-EDIT-15 GO TO END-THE-EDIT.
	IF K = 16 PERFORM EDIT-16 THRU END-EDIT-16 GO TO END-THE-EDIT.
	IF K = 17 PERFORM EDIT-17 THRU END-EDIT-17 GO TO END-THE-EDIT.
	IF K = 18 PERFORM EDIT-18 THRU END-EDIT-18 GO TO END-THE-EDIT.
	IF K = 19 PERFORM EDIT-19 THRU END-EDIT-19 GO TO END-THE-EDIT.
	IF K = 20 PERFORM EDIT-20 THRU END-EDIT-20 GO TO END-THE-EDIT.
	IF K = 21 PERFORM EDIT-21 THRU END-EDIT-21 GO TO END-THE-EDIT.
	IF K = 22 PERFORM EDIT-22 THRU END-EDIT-22 GO TO END-THE-EDIT.
	IF K = 23 PERFORM EDIT-23 THRU END-EDIT-23 GO TO END-THE-EDIT.
	IF K = 24 PERFORM EDIT-24 THRU END-EDIT-24 GO TO END-THE-EDIT.
	IF K = 25 PERFORM EDIT-25 THRU END-EDIT-25 GO TO END-THE-EDIT.
	IF K = 26 PERFORM EDIT-26 THRU END-EDIT-26 GO TO END-THE-EDIT.
	IF K = 27 PERFORM EDIT-27 THRU END-EDIT-27 GO TO END-THE-EDIT.
	IF K = 28 PERFORM EDIT-28 THRU END-EDIT-28 GO TO END-THE-EDIT.
	IF K = 29 PERFORM EDIT-29 THRU END-EDIT-29 GO TO END-THE-EDIT.
END-THE-EDIT.
	EXIT.
EDIT-1.
	MOVE DATA-A (1) TO THE-DATA.
	MOVE THE-DATA TO FILENAME.
	MOVE FILENAME TO DATA-A (1).
END-EDIT-1.
	EXIT.
EDIT-2.
	MOVE DATA-A (2) TO THE-DATA.
	IF DATA-1 = "N"
		GO TO N-CHECK.
	IF DATA-1 = "R"
		GO TO R-CHECK.
	MOVE DATA-12 TO SEQUENCE.
	MOVE SEQUENCE TO DATA-A (2).
	GO TO END-EDIT-2.
N-CHECK.
	IF (OA-BLANK = SPACE AND OA-CHECK = "A") AND DATA-2 = "D"
		MOVE DATA-12 TO SEQUENCE
		MOVE SEQUENCE TO DATA-A (2)
		GO TO END-EDIT-2.
	GO TO NR-ERROR.
R-CHECK.
	IF (OA-BLANK = SPACE AND OA-CHECK = "O") AND DATA-2 = SPACE
		MOVE DATA-12 TO SEQUENCE
		MOVE SEQUENCE TO DATA-A (2)
		GO TO END-EDIT-2.
NR-ERROR.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY "'OR' OR 'AND' CONFUSION"
	MOVE "X" TO ERROR-CODE.
END-EDIT-2.
	EXIT.
EDIT-3.
	MOVE DATA-A (3) TO THE-DATA.
	IF DATA-1 = SPACE OR "1" OR "N"
		MOVE DATA-1 TO NUMBER-IT
		MOVE NUMBER-IT TO DATA-A (3)
		GO TO END-EDIT-3.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,1, OR N".
	MOVE "X" TO ERROR-CODE.
END-EDIT-3.
	EXIT.
EDIT-4.
	MOVE DATA-A (4) TO THE-DATA.
	IF DATA-1 = SPACE OR "O"
		MOVE DATA-1 TO OPTION
		MOVE OPTION TO DATA-A (4)
		GO TO END-EDIT-4.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR O".
	MOVE "X" TO ERROR-CODE.
END-EDIT-4.
	EXIT.
EDIT-5.
	MOVE DATA-A (5) TO THE-DATA.
	IF DATA-12 = SPACE OR "LR" OR "TR" OR "**"
		GO TO MOVE-5.
	IF DATA-1 = "L" OR "H"
		GO TO CHECK-NUM-5.
	MOVE DATA-12 TO NUM-IT-2.
	EXAMINE DATA-12 REPLACING ALL SPACES BY ZEROS.
	IF DATA-12 NOT NUMERIC GO TO ERROR-5.
	IF (NUM-IT-2 > 0) AND (NUM-IT-2 < 100)
		MOVE  NUM-IT-2 TO IDE-REC
		MOVE REC-IDE TO DATA-A (5)
		GO TO END-EDIT-5.
CHECK-NUM-5.
	MOVE DATA-2 TO NUM-IT-1.
	IF DATA-2 NOT NUMERIC GO TO ERROR-5.
	IF (NUM-IT-1 > ZERO) AND (NUM-IT-1 < 10)
		GO TO MOVE-5.
ERROR-5.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,1-99,L1-L9,LR,H1-H9,**, OR TR".
	MOVE "X" TO ERROR-CODE.
	GO TO END-EDIT-5.
MOVE-5.
	MOVE DATA-12 TO REC-IDE.
	MOVE REC-IDE TO DATA-A (5).
END-EDIT-5.
	EXIT.
EDIT-6.
	MOVE DATA-A (6) TO THE-DATA.
	IF DATA-14 = SPACES
		MOVE DATA-14 TO POS-1
		MOVE POS-1 TO DATA-A (6)
		GO TO END-EDIT-6.
	MOVE DATA-14 TO NUM-IT-4.
	EXAMINE DATA-14 REPLACING ALL SPACES BY ZEROS.
	IF DATA-14 NOT NUMERIC GO TO ERROR-6.
	IF (NUM-IT-4 > ZERO) AND (NUM-IT-4 < 10000)
		MOVE NUM-IT-4 TO SOP-1
		MOVE POS-1 TO DATA-A (6)
		GO TO END-EDIT-6.
ERROR-6.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1-9999".
	MOVE "X" TO ERROR-CODE.
END-EDIT-6.
	EXIT.
EDIT-7.
	MOVE DATA-A (7) TO THE-DATA.
	IF DATA-1 = SPACE OR "N"
		MOVE DATA-1 TO NOT-N-1
		MOVE NOT-N-1 TO DATA-A (7)
		GO TO END-EDIT-7.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR N".
	MOVE "X" TO ERROR-CODE.
END-EDIT-7.
	EXIT.
EDIT-8.
	MOVE DATA-A (8) TO THE-DATA.
	IF DATA-1 = SPACE OR "C" OR "Z" OR "D"
		MOVE DATA-1 TO CZD-1
		MOVE CZD-1 TO DATA-A (8)
		GO TO END-EDIT-8.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,C,Z, OR D".
	MOVE "X" TO ERROR-CODE.
END-EDIT-8.
	EXIT.
EDIT-9.
	MOVE DATA-A (9) TO THE-DATA.
	MOVE DATA-1 TO CHAR-1.
	MOVE CHAR-1 TO DATA-A (9).
END-EDIT-9.
	EXIT.
EDIT-10.
	MOVE DATA-A (10) TO THE-DATA.
	IF DATA-14 = SPACES
		MOVE DATA-14 TO POS-2
		MOVE POS-2 TO DATA-A (10)
		GO TO END-EDIT-10.
	MOVE DATA-14 TO NUM-IT-4.
	EXAMINE DATA-14 REPLACING ALL SPACES BY ZEROS.
	IF DATA-14 NOT NUMERIC GO TO ERROR-10.
	IF (NUM-IT-4 > ZERO) AND (NUM-IT-4 < 10000)
		MOVE NUM-IT-4 TO SOP-2
		MOVE POS-2 TO DATA-A (10)
		GO TO END-EDIT-10.
ERROR-10.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1-9999".
	MOVE "X" TO ERROR-CODE.
END-EDIT-10.
	EXIT.
EDIT-11.
	MOVE DATA-A (11) TO THE-DATA.
	IF DATA-1 = SPACE OR "N"
		MOVE DATA-1 TO NOT-N-2
		MOVE NOT-N-2 TO DATA-A (11)
		GO TO END-EDIT-11.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR N".
	MOVE "X" TO ERROR-CODE.
END-EDIT-11.
	EXIT.
EDIT-12.
	MOVE DATA-A (12) TO THE-DATA.
	IF DATA-1 = SPACE OR "C" OR "Z" OR "D"
		MOVE DATA-1 TO CZD-2
		MOVE CZD-2 TO DATA-A (12)
		GO TO END-EDIT-12.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,C,Z, OR D".
	MOVE "X" TO ERROR-CODE.
END-EDIT-12.
	EXIT.
EDIT-13.
	MOVE DATA-A (13) TO THE-DATA.
	MOVE DATA-1 TO CHAR-2.
	MOVE CHAR-2 TO DATA-A (13).
END-EDIT-13.
	EXIT.
EDIT-14.
	MOVE DATA-A (14) TO THE-DATA.
	IF DATA-14 = SPACES
		MOVE DATA-14 TO POS-3
		MOVE POS-3 TO DATA-A (14)
		GO TO END-EDIT-14.
	MOVE DATA-14 TO NUM-IT-4.
	EXAMINE DATA-14 REPLACING ALL SPACES BY ZEROS.
	IF DATA-14 NOT NUMERIC GO TO ERROR-14.
	IF (NUM-IT-4 > ZERO) AND (NUM-IT-4 < 10000)
		MOVE NUM-IT-4 TO SOP-3
		MOVE POS-3 TO DATA-A (14)
		GO TO END-EDIT-14.
ERROR-14.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1-9999".
	MOVE "X" TO ERROR-CODE.
END-EDIT-14.
	EXIT.
EDIT-15.
	MOVE DATA-A (15) TO THE-DATA.
	IF DATA-1 = SPACE OR "N"
		MOVE DATA-1 TO NOT-N-3
		MOVE NOT-N-3 TO DATA-A (15)
		GO TO END-EDIT-15.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR N".
	MOVE "X" TO ERROR-CODE.
END-EDIT-15.
	EXIT.
EDIT-16.
	MOVE DATA-A (16) TO THE-DATA.
	IF DATA-1 = SPACE OR "C" OR "Z" OR "D"
		MOVE DATA-1 TO CZD-3
		MOVE CZD-3 TO DATA-A (16)
		GO TO END-EDIT-16.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER C,Z, OR D".
	MOVE "X" TO ERROR-CODE.
END-EDIT-16.
	EXIT.
EDIT-17.
	MOVE DATA-A (17) TO THE-DATA.
	MOVE DATA-1 TO CHAR-3.
	MOVE CHAR-3 TO DATA-A (17).
END-EDIT-17.
	EXIT.
EDIT-18.
	MOVE DATA-A (18) TO THE-DATA.
	IF DATA-1 = SPACE OR "2" OR "4" OR "5"
		MOVE DATA-1 TO STA-SEL
		MOVE STA-SEL TO DATA-A (18)
		GO TO END-EDIT-18.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,2,4, OR 5".
	MOVE "X" TO ERROR-CODE.
END-EDIT-18.
	EXIT.
EDIT-19.
	MOVE DATA-A (19) TO THE-DATA.
	IF DATA-1 = SPACE OR "P" OR "B"
		MOVE DATA-1 TO PAC-BIN
		MOVE PAC-BIN TO DATA-A (19)
		GO TO END-EDIT-19.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,P OR B".
	MOVE "X" TO ERROR-CODE.
END-EDIT-19.
	EXIT.
EDIT-20.
	MOVE DATA-A (20) TO THE-DATA.
	IF DATA-14 = SPACES
		MOVE DATA-14 TO FIE-LOC-FR
		MOVE FIE-LOC-FR TO DATA-A (20)
		GO TO END-EDIT-20.
	MOVE DATA-14 TO NUM-IT-4.
	EXAMINE DATA-14 REPLACING ALL SPACES BY ZEROS.
	IF DATA-14 NOT NUMERIC GO TO ERROR-20.
	IF (NUM-IT-4 > ZERO) AND (NUM-IT-4 < 10000)
		MOVE NUM-IT-4 TO LOC-FIE-FR
		MOVE FIE-LOC-FR TO DATA-A (20)
		GO TO END-EDIT-20.
ERROR-20.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1-9999".
	MOVE "X" TO ERROR-CODE.
END-EDIT-20.
	EXIT.
EDIT-21.
	MOVE DATA-A (21) TO THE-DATA.
	IF DATA-14 = SPACES
		MOVE DATA-14 TO FIE-LOC-TO
		MOVE FIE-LOC-TO TO DATA-A (21)
		GO TO END-EDIT-21.
	MOVE DATA-14 TO NUM-IT-4.
	EXAMINE DATA-14 REPLACING ALL SPACES BY ZEROS.
	IF DATA-14 NOT NUMERIC GO TO ERROR-21.
	IF (NUM-IT-4 > ZERO) AND (NUM-IT-4 < 10000)
		MOVE NUM-IT-4 TO LOC-FIE-TO
		MOVE FIE-LOC-TO TO DATA-A (21)
		GO TO END-EDIT-21.
ERROR-21.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1-9999".
	MOVE "X" TO ERROR-CODE.
END-EDIT-21.
	EXIT.
EDIT-22.
	MOVE DATA-A (22) TO THE-DATA.
	IF DATA-1 = SPACE OR NUMERIC
		MOVE DATA-1 TO DEC-POS
		MOVE DEC-POS TO DATA-A (22)
		GO TO END-EDIT-22.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1-9".
	MOVE "X" TO ERROR-CODE.
END-EDIT-22.
	EXIT.
EDIT-23.
	MOVE DATA-A (23) TO THE-DATA.
	MOVE DATA-16 TO FIE-NAM.
	MOVE FIE-NAM TO DATA-A (23).
END-EDIT-23.
	EXIT.
EDIT-24.
	MOVE DATA-A (24) TO THE-DATA.
	IF DATA-12 = SPACES GO TO MOVE-24.
	IF DATA-1 NOT = "L"
		GO TO ERROR-24.
	IF DATA-2 NOT NUMERIC
		GO TO ERROR-24.
	IF DATA-2 = ZERO
	GO TO ERROR-24.
MOVE-24.
	MOVE DATA-12 TO CON-LEV.
	MOVE CON-LEV TO DATA-A (24).
	GO TO END-EDIT-24.
ERROR-24.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR L1-L9".
	MOVE "X" TO ERROR-CODE.
END-EDIT-24.
	EXIT.
EDIT-25.
	MOVE DATA-A (25) TO THE-DATA.
	IF DATA-12 = SPACES GO TO MOVE-25.
	IF DATA-1 NOT = "M"
		GO TO ERROR-25.
	IF DATA-2 NOT NUMERIC
		GO TO ERROR-25.
	IF DATA-2 = ZERO
		GO TO ERROR-25.
MOVE-25.
	MOVE DATA-12 TO MAT-FIE.
	MOVE MAT-FIE TO DATA-A (25).
	GO TO END-EDIT-25.
ERROR-25.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR M1-M9".
	MOVE "X" TO ERROR-CODE.
END-EDIT-25.
	EXIT.
EDIT-26.
	MOVE DATA-A (26) TO THE-DATA.
	IF DATA-12 = SPACES OR "MR"
		GO TO MOVE-26.
	IF DATA-1 = "L" OR "U" OR "H"
		GO TO CHECK-NUM-26.
	MOVE DATA-12 TO NUM-IT-2.
	EXAMINE DATA-12 REPLACING ALL SPACES BY ZEROS.
	IF DATA-12 = ZERO GO TO ERROR-26.
	IF DATA-12 NOT NUMERIC GO TO ERROR-26.
	IF (NUM-IT-2 > ZERO) AND (NUM-IT-2 < 100)
		MOVE NUM-IT-2 TO FIE-REC
		MOVE FIE-REC TO DATA-A (26)
		GO TO END-EDIT-26.
CHECK-NUM-26.
	IF DATA-2 = ZERO
		GO TO ERROR-26.
	IF DATA-2 NOT NUMERIC
		GO TO ERROR-26.
	IF DATA-1 = "U" AND DATA-2 = "9"
		GO TO ERROR-26.
MOVE-26.
	MOVE DATA-12 TO FIE-REC.
	MOVE FIE-REC TO DATA-A (26).
	GO TO END-EDIT-26.
ERROR-26.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,01-99,L1-L9,MR,U1-U8, OR H1-H9".
	MOVE "X" TO ERROR-CODE.
END-EDIT-26.
	EXIT.
EDIT-27.
	MOVE DATA-A (27) TO THE-DATA.
	IF DATA-12 = SPACES GO TO MOVE-27.
	IF DATA-1 = "H"
		GO TO CHECK-NUM-27.
	MOVE DATA-12 TO NUM-IT-2.
	EXAMINE DATA-12 REPLACING ALL SPACES BY ZEROS
	IF DATA-12 NOT NUMERIC GO TO ERROR-27.
	IF (NUM-IT-2 > ZERO) AND (NUM-IT-2 < 100)
		MOVE NUM-IT-2 TO IT-PLUS
		MOVE PLUS-IT TO DATA-A (27)
		GO TO END-EDIT-27.
	GO TO ERROR-27.
CHECK-NUM-27.
	IF DATA-2 NOT NUMERIC
		GO TO ERROR-27.
	IF DATA-2 = ZERO
		GO TO ERROR-27.
MOVE-27.
	MOVE DATA-12 TO PLUS-IT.
	MOVE PLUS-IT TO DATA-A (27).
	GO TO END-EDIT-27.
ERROR-27.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,1-99, OR H1-H9".
	MOVE "X" TO ERROR-CODE.
END-EDIT-27.
	EXIT.
EDIT-28.
	MOVE DATA-A (28) TO THE-DATA.
	IF DATA-12 = SPACES GO TO MOVE-28.
	IF DATA-1 = "H"
		GO TO CHECK-NUM-28.
	MOVE DATA-12 TO NUM-IT-2.
	EXAMINE DATA-12 REPLACING ALL SPACES BY ZEROS.
	IF DATA-12 NOT NUMERIC GO TO ERROR-28.
	IF (NUM-IT-2 > ZERO) AND (NUM-IT-2 < 100)
		MOVE NUM-IT-2 TO SUNIM
		MOVE MINUS TO DATA-A (28)
		GO TO END-EDIT-28.
CHECK-NUM-28.
	IF DATA-2 NOT NUMERIC
		GO TO ERROR-28.
	IF DATA-2 = ZERO
		GO TO ERROR-28.
MOVE-28.
	MOVE DATA-12 TO MINUS.
	MOVE MINUS TO DATA-A (28).
	GO TO END-EDIT-28.
ERROR-28.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,1-99, OR H1-H9".
	MOVE "X" TO ERROR-CODE.
END-EDIT-28.
	EXIT.
EDIT-29.
	MOVE DATA-A (29) TO THE-DATA.
	IF DATA-12 = SPACES GO TO MOVE-29.
	IF DATA-1 = "H" GO TO CHECK-NUM-29.
	MOVE DATA-12 TO NUM-IT-2.
	EXAMINE DATA-12 REPLACING ALL SPACES BY ZEROS.
	IF DATA-12 NOT NUMERIC GO TO ERROR-29.
	IF (NUM-IT-2 > ZERO) AND (NUM-IT-2 < 100)
		MOVE NUM-IT-2 TO BLA-ZER
		MOVE ZER-BLA TO DATA-A (29)
		GO TO END-EDIT-29.
CHECK-NUM-29.
	IF DATA-2 NOT NUMERIC
		GO TO ERROR-29.
	IF DATA-2 = ZERO
		GO TO ERROR-29.
MOVE-29.
	MOVE DATA-12 TO ZER-BLA.
	MOVE ZER-BLA TO DATA-A (29).
	GO TO END-EDIT-29.
ERROR-29.
	MOVE 52 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,1-99, OR H1-H9".
	MOVE "X" TO ERROR-CODE.
END-EDIT-29.
	EXIT.
WRITE-ADD.
	OPEN I-O PROGRAM-FILE.
	MOVE 1 TO PROGRAM-KEY.
	READ PROGRAM-FILE INVALID KEY
	DISPLAY "BAD READ " PROGRAM-KEY STOP RUN.
	MOVE PROGRAM-RECORD TO PROGRAM-ZERO.
	MOVE PROGRAM-LAST-REC TO PROGRAM-REC-NO PROGRAM-ACT-REC.
	ADD 1 TO PROGRAM-LAST-REC.
	MOVE PROGRAM-LAST-REC TO PROGRAM-KEY.
	MOVE THE-FILE TO PROGRAM-IDENT.
	MOVE THE-PAGE TO PROGRAM-PAGE.
	MOVE THE-LINE TO PROGRAM-LINE.
	MOVE THE-FORM TO PROGRAM-FORM.
	MOVE PROG-INFO TO PROGRAM-INFO.
	MOVE PROGRAM-MAIN TO PROGRAM-RECORD.
WRITE-ADD-A.
	WRITE PROGRAM-RECORD INVALID KEY
	DISPLAY "BAD WRITE " PROGRAM-KEY STOP RUN.
	MOVE 1 TO PROGRAM-KEY.
	MOVE PROGRAM-ZERO TO PROGRAM-RECORD.
	WRITE PROGRAM-RECORD INVALID KEY
	DISPLAY "BAD WRITE " PROGRAM-KEY STOP RUN.
	CLOSE PROGRAM-FILE.
END-WRITE-ADD.
	EXIT.
END-IT.
	MOVE PROGRAM-NAME TO THE-FILE.
	MOVE "RPGSYS" TO NEXT-PROGRAM.
	ENTER MACRO SYSPRG USING NEXT-PROGRAM, PASS-IT.
END-PROGRAM.
	STOP RUN.