IDENTIFICATION DIVISION.
PROGRAM-ID.	RPGHHH.
DATE-WRITTEN.	APRIL 13, 1976.
AUTHOR.	HAL ROACH.
INSTALLATION.	CERRITOS COLLEGE.
REMARKS.	PROGRAM TO UPDATE H 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	NUM-IT-2		PIC 99.
77	ELE-9			PIC 99.
77	CLEAR-IT		PIC X(34)	VALUE SPACES.
77	CLEAR-3300		PIC X(26)	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 9(5)	COMP.
77	PROGRAM-KEY		PIC 9(5)	COMP.
77	NEXT-PROGRAM		PIC X(6).
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 XXX	OCCURS 14 TIMES.
01	THE-DATA.
	02 DATA-1	PIC X.
	02 DATA-2	PIC XX.
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 FIL-LER.
	  03 THE-STARE	PIC X.
	  03 FILLER	PIC XX.
	02 OBJ-OUT	PIC X.
	02 LIS-OPT	PIC X.
	02 COR-SIZ	PIC XXX.
	02 SIZ-COR REDEFINES COR-SIZ	PIC ZZ9.
	02 DEBUG	PIC X.
	02 FILLER	PIC X(5).
	02 INV-PRI	PIC X.
	02 FILLER	PIC X(4).
	02 ACT-COL	PIC X.
	02 FILLER	PIC X(10).
	02 INQ	PIC X.
	02 FILLER	PIC XXX.
	02 1P-FOR	PIC X.
	02 FILLER	PIC X.
	02 FIL-TRA	PIC X.
	02 PUN-MFC	PIC X.
	02 NON-CHA	PIC X.
	02 FILLER	PIC XX.
	02 SHA-I-O	PIC X.
	02 FILLER	PIC X(26).
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(34)	VALUE
	  " H DATA CARD".
	02 TUBE-LINE-1	PIC X(50)	VALUE
	"ELEMENT ELEMENT                         ELEMENT".
	02 TUBE-LINE-2	PIC X(50)	VALUE
	"NUMBER  DESCRIPTION                     [ENTRY]".
01	TUBE-DISPLAY.
	02 FILLER	PIC X(37)	VALUE
	"OBJECT OUTPUT                   [ ]".
	02 FILLER	PIC X(37)	VALUE
	"LISTING OPTIONS                 [ ]".
	02 FILLER	PIC X(37)	VALUE
	"CORE SIZE TO EXECUTE            [   ]".
	02 FILLER	PIC X(37)	VALUE
	"DEBUG                           [ ]".
	02 FILLER	PIC X(37)	VALUE
	"INVERTED PRINT                  [ ]".
	02 FILLER	PIC X(37)	VALUE
	"ALTERNATE COLLATING SEQUENCE    [ ]".
	02 FILLER	PIC X(37)	VALUE
	"INQUIRY                         [ ]".
	02 FILLER	PIC X(37)	VALUE
	"1P FORMS POSTION                [ ]".
	02 FILLER	PIC X(37)	VALUE
	"FILE TRANSLATION                [ ]".
	02 FILLER	PIC X(37)	VALUE
	"PUNCH MFCU ZEROS                [ ]".
	02 FILLER	PIC X(37)	VALUE
	"NONPRINT CHARACTERS             [ ]".
	02 FILLER	PIC X(37)	VALUE
	"SHARED I/O AREA                 [ ]".
01	DISPLAY-TUBE REDEFINES TUBE-DISPLAY.
	02 FILLER	OCCURS 12 TIMES.
	  03 THE-TUBE	PIC X(37).
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.
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.
	MOVE THE-FILE TO PROGRAM-NAME.
	IF THE-ACTION = "CHG"
		PERFORM FIND-REC THRU END-FIND-REC.
	PERFORM CLEAR-SCREEN.
	ENTER MACRO SETTY USING "NO CRLF".
	ENTER MACRO SETTY USING "WIDTH 80".
	ENTER MACRO SETTY USING "FORM".
	IF THE-STARE = "*"
		MOVE 1 TO K
		MOVE THE-STARE TO DATA-1
		MOVE FIL-LER TO DATA-A (1)
		GO TO COMMENT-CHECK.
	MOVE THE-PAGE TO DISPLAY-PAGE.
	MOVE THE-LINE TO DISPLAY-LINE.
	DISPLAY TUBE-LINE-0.
	DISPLAY TUBE-LINE-1.
	DISPLAY TUBE-LINE-2.
	MOVE 3 TO I.
LOOP-DISPLAY.
	ADD 1 TO I.
	IF I > 15 GO TO END-DISPLAY.
	SUBTRACT 3 FROM I GIVING K.
	MOVE K TO II.
	MOVE 1 TO J.
	PERFORM CURSOR.
	DISPLAY THE-NUMBER THE-TUBE (K) WITH NO ADVANCING.
	MOVE 42 TO J.
	PERFORM CURSOR.
	DISPLAY DATA-A (K).
	GO TO LOOP-DISPLAY.
END-DISPLAY.
	IF THE-ACTION = "ADD"
		GO TO ADD-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
		GO TO END-IT.
	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 ELE-9 < 1 OR ELE-9 > 12
		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 42 TO J.
	PERFORM CURSOR.
	SUBTRACT 3 FROM I GIVING K.
	MOVE K TO II.
ACCEPT-CHG.
	ACCEPT DATA-A (K).
	IF THE-ACTION = "ADD"
		MOVE DATA-A (K) TO ALL-DATA.
	IF ALL-1 = "/"
		GO TO CHECK-SLASH.
	IF K = 1
		GO TO COMMENT-CHECK.
EDIT-IT.
	PERFORM THE-EDIT.
	IF ERROR-CODE = "X"
		MOVE SPACE TO ERROR-CODE
		MOVE 42 TO J
		PERFORM CURSOR
		GO TO ACCEPT-CHG.
	PERFORM CLEAN-IT.
	MOVE 42 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"
		GO TO END-VALUE.
	MOVE ALL-23 TO NUM-IT-2.
	EXAMINE ALL-23 REPLACING ALL SPACES BY ZEROS.
	IF (ALL-23 NOT NUMERIC) OR (NUM-IT-2 > 12) OR (NUM-IT-2 = ZERO)
		MOVE 50 TO J
		PERFORM CURSOR
		DISPLAY " BAD SWITCH"
		MOVE 42 TO J
		PERFORM CURSOR
		GO TO ACCEPT-CHG.
	MOVE NUM-IT-2 TO L.
	ADD 2 TO L.
	PERFORM CLEAN-IT.
	GO TO LOOP-VALUE.
CLEAN-IT.
	MOVE 45 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
		GO TO END-IT.
	GO TO END-VALUE.
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 OBJ-OUT TO DATA-A (1).
	MOVE LIS-OPT TO DATA-A (2).
	MOVE COR-SIZ TO DATA-A (3).
	MOVE DEBUG TO DATA-A (4).
	MOVE INV-PRI TO DATA-A (5).
	MOVE ACT-COL TO DATA-A (6).
	MOVE INQ TO DATA-A (7).
	MOVE 1P-FOR TO DATA-A (8).
	MOVE FIL-TRA TO DATA-A (9).
	MOVE PUN-MFC TO DATA-A (10).
	MOVE NON-CHA TO DATA-A (11).
	MOVE SHA-I-O TO DATA-A (12).
END-FIND-REC.
	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.
	CLOSE PROGRAM-FILE.
END-CHG-REC.
	EXIT.
ADD-IT.
	MOVE 3 TO I.
	MOVE I TO L.
LOOP-VALUE.
	ADD 1 TO L.
	IF L > 15 GO TO END-VALUE.
	MOVE L TO I.
	GO TO BY-NUM.
END-VALUE.
	PERFORM CLEAR-SCREEN.
	PERFORM WRITE-ADD THRU END-WRITE-ADD.
	GO TO END-IT.
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.
THE-EDIT.
	IF K = 1 PERFORM EDIT-1 THRU END-EDIT-1.
	IF K = 2 PERFORM EDIT-2 THRU END-EDIT-2.
	IF K = 3 PERFORM EDIT-3 THRU END-EDIT-3.
	IF K = 4 PERFORM EDIT-4 THRU END-EDIT-4.
	IF K = 5 PERFORM EDIT-5 THRU END-EDIT-5.
	IF K = 6 PERFORM EDIT-6 THRU END-EDIT-6.
	IF K = 7 PERFORM EDIT-7 THRU END-EDIT-7.
	IF K = 8 PERFORM EDIT-8 THRU END-EDIT-8.
	IF K = 9 PERFORM EDIT-9 THRU END-EDIT-9.
	IF K = 10 PERFORM EDIT-10 THRU END-EDIT-10.
	IF K = 11 PERFORM EDIT-11 THRU END-EDIT-11.
	IF K = 12 PERFORM EDIT-12 THRU END-EDIT-12.
EDIT-1.
	MOVE DATA-A (1) TO THE-DATA.
	IF DATA-1 = SPACE OR "D" OR "C" OR "P" OR "R" OR "T" OR "B"
		MOVE DATA-1 TO OBJ-OUT
		MOVE OBJ-OUT TO DATA-A (1)
		GO TO END-EDIT-1.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,D,C,P,R,T, OR B".
	MOVE "X" TO ERROR-CODE.
END-EDIT-1.
	EXIT.
EDIT-2.
	MOVE DATA-A (2) TO THE-DATA.
	IF DATA-1 = SPACE OR "B" OR "P"
		MOVE DATA-1 TO LIS-OPT
		MOVE LIS-OPT TO DATA-A (2)
		GO TO END-EDIT-2.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,B, OR P".
	MOVE "X" TO ERROR-CODE.
END-EDIT-2.
	EXIT.
EDIT-3.
	MOVE DATA-A (3) TO THE-DATA.
	IF THE-DATA = SPACES
		MOVE THE-DATA TO COR-SIZ
		MOVE COR-SIZ TO DATA-A (3)
		GO TO END-EDIT-3.
	IF DATA-1 = SPACE OR ZERO OR "Q" OR "H" OR "T" GO TO CHECK-CORE.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,0,Q,H, OR T".
	MOVE "X" TO ERROR-CODE.
	GO TO END-EDIT-3.
CHECK-CORE.
	MOVE DATA-2 TO NUM-IT-2.
	EXAMINE DATA-2 REPLACING ALL SPACES BY ZEROS.
	IF DATA-2 NOT NUMERIC GO TO ERROR-3.
	IF (NUM-IT-2 > ZERO) AND (NUM-IT-2 < 62)
		MOVE NUM-IT-2 TO SIZ-COR
		MOVE COR-SIZ TO DATA-A (3)
		GO TO END-EDIT-3.
ERROR-3.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER > ZERO AND < 61".
	MOVE "X" TO ERROR-CODE.
END-EDIT-3.
	EXIT.
EDIT-4.
	MOVE DATA-A (4) TO THE-DATA.
	IF DATA-1 = SPACE OR "1"
		MOVE DATA-1 TO DEBUG
		MOVE DEBUG TO DATA-A (4)
		GO TO END-EDIT-4.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1".
	MOVE "X" TO ERROR-CODE.
END-EDIT-4.
	EXIT.
EDIT-5.
	MOVE DATA-A (5) TO THE-DATA.
	IF DATA-1 = SPACE OR "I" OR "J" OR "D"
		MOVE DATA-1 TO INV-PRI
		MOVE INV-PRI TO DATA-A (5)
		GO TO END-EDIT-5.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,I,J, OR D".
	MOVE "X" TO ERROR-CODE.
END-EDIT-5.
	EXIT.
EDIT-6.
	MOVE DATA-A (6) TO THE-DATA.
	IF DATA-1 = SPACE OR "S"
		MOVE DATA-1 TO ACT-COL
		MOVE ACT-COL TO DATA-A (6)
		GO TO END-EDIT-6.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR S".
	MOVE "X" TO ERROR-CODE.
END-EDIT-6.
	EXIT.
EDIT-7.
	MOVE DATA-A (7) TO THE-DATA.
	IF DATA-1 = SPACE OR "B" OR "I"
		MOVE DATA-1 TO INQ
		MOVE INQ TO DATA-A (7)
		GO TO END-EDIT-7.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , ,B, OR I".
	MOVE "X" TO ERROR-CODE.
END-EDIT-7.
	EXIT.
EDIT-8.
	MOVE DATA-A (8) TO THE-DATA.
	IF DATA-1 = SPACE OR "1"
		MOVE DATA-1 TO 1P-FOR
		MOVE 1P-FOR TO DATA-A (8)
		GO TO END-EDIT-8.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1".
	MOVE "X" TO ERROR-CODE.
END-EDIT-8.
	EXIT.
EDIT-9.
	MOVE DATA-A (9) TO THE-DATA.
	IF DATA-1 = SPACE OR "F"
		MOVE DATA-1 TO FIL-TRA
		MOVE FIL-TRA TO DATA-A (9)
		GO TO END-EDIT-9.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR F".
	MOVE "X" TO ERROR-CODE.
END-EDIT-9.
	EXIT.
EDIT-10.
	MOVE DATA-A (10) TO THE-DATA.
	IF DATA-1 = SPACE OR "1"
		MOVE DATA-1 TO PUN-MFC
		MOVE PUN-MFC TO DATA-A (10)
		GO TO END-EDIT-10.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTER , , OR 1".
	MOVE "X" TO ERROR-CODE.
END-EDIT-10.
	EXIT.
EDIT-11.
	MOVE DATA-A (11) TO THE-DATA.
	IF DATA-1 = SPACE OR "1"
		MOVE DATA-1 TO NON-CHA
		MOVE NON-CHA TO DATA-A (11)
		GO TO END-EDIT-11.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTRY NOT , , OR 1".
	MOVE "X" TO ERROR-CODE.
END-EDIT-11.
	EXIT.
EDIT-12.
	MOVE DATA-A (12) TO THE-DATA.
	IF DATA-1 = SPACE OR "1"
		MOVE DATA-1 TO SHA-I-O
		MOVE SHA-I-O TO DATA-A (12)
		GO TO END-EDIT-12.
	MOVE 50 TO J.
	PERFORM CURSOR.
	DISPLAY " ENTRY NOT , , OR 1".
	MOVE "X" TO ERROR-CODE.
END-EDIT-12.
	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 "H" 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.