PDP-10 Archive: 43,50343/congen.cbl from decuslib10-04

Trailing-Edge - PDP-10 Archives - decuslib10-04 - 43,50343/congen.cbl
There is 1 other file named congen.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID.  CONGEN.
AUTHOR. GEORGE NEWTON.
DATE-WRITTEN.  14-APR-72.
DATE-COMPILED.
REMARKS.	CONGEN GENERATES A COBOL SOURCE PROGRAM THAT WILL CONTROL
	A FILE ON ANY DEVICE (BASED ON PARAMETERS GIVEN TO CONGEN)
	- PARAMETERS  ARE GIVEN OVER TTY
	- CONGEN IS SELF DOCUMENTING AT RUN TIME.


ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT FILE-OUT		ASSIGN TO DSK.
I-O-CONTROL.
DATA DIVISION.
FILE SECTION.

FD	FILE-OUT
	VALUE OF IDENTIFICATION IS OUT-FILE-NAME.

01	OUT-REC		PIC X(80) USAGE IS DISPLAY-7.

01	OUT-REC-A	PIC X	  USAGE IS DISPLAY-7.


WORKING-STORAGE SECTION.

77 ANSWER		PIC X.
77 NO-SUM		PIC X.

01 MONTH-TABLE		PIC X(36) VALUE IS
			"JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC".

01 THE-MONTH-REDEF REDEFINES MONTH-TABLE.
	02 THE-MONTH OCCURS 12 TIMES PIC X(3).



01 RECORD-SIZE	PIC 9(4).

01 SUM-SIZE	PIC 9(4).

01 OUT-FILE-NAME.
	02 OFN-FN	PIC X(6).
	02 OFN-EXT	PIC X(3) VALUE "CBL".

01 TODAYS-DATE.
	02 TD-DATE.
		03 TD-YY	PIC 99.
		03 TD-MM	PIC 99.
		03 TD-DD	PIC 99.
	02 TD-TIME	PIC X(6).


01 LINE-01	PIC X(24) VALUE "IDENTIFICATION DIVISION.".
01 LINE-02.
	02 02-FILLER	PIC X(13) VALUE "PROGRAM-ID.  ".
	02 02-ID	PIC X(6).
	02 02-PER	PIC X(1) VALUE ".".
01 LINE-03	PIC X(42) VALUE "AUTHOR.  CONGEN   VERSION #02.".
01 LINE-04.
	02 04-FILLER	PIC X(15) VALUE "DATE-WRITTEN.  ".
	02 04-DD	PIC 99.
	02 04-DUMMY	PIC X  VALUE "-".
	02 04-MM	PIC X(3).
	02 04-DUMMY	PIC X  VALUE "-".
	02 04-YY	PIC 99.
	02 04-PER	PIC X(1) VALUE ".".
01 LINE-05	PIC X(14) VALUE "DATE-COMPILED.".
01 LINE-06	PIC X(68) VALUE "REMARKS.  THIS PROGRAM WRITTEN BY -CONGEN-.".
01 LINE-07	PIC X(21) VALUE "ENVIRONMENT DIVISION.".
01 LINE-08	PIC X(22) VALUE "INPUT-OUTPUT SECTION. ".
01 LINE-09	PIC X(13) VALUE "FILE-CONTROL.".
01 LINE-10.
	02 10-FILLER	PIC X(37) VALUE "        SELECT FILE-IN     ASSIGN TO ".
	02 10-DEVICE	PIC X(3).
	02 10-PER	PIC X(1) VALUE ".".
01 LINE-10-A.
	02 10-A-FILLER	PIC X(37) VALUE "        SELECT FILE-OUT    ASSIGN TO ".
	02 10-A-DEVICE	PIC X(6)  VALUE IS "DEVOUT".
	02 10-A-PER	PIC X(1) VALUE ".".
01 LINE-11	PIC X(14) VALUE "DATA DIVISION.".
01 LINE-11-A	PIC X(13) VALUE "FILE SECTION.".
01 LINE-12	PIC X(12) VALUE "FD   FILE-IN".
01 LINE-12-A	PIC X(13) VALUE "FD   FILE-OUT".
01 LINE-13.
	02 13-FILLER	PIC X(20) VALUE "     BLOCK CONTAINS ".
	02 13-BLOCKING	PIC 9(3).
	02 13-FILLER	PIC X(8) VALUE " RECORDS".
01 13-A-BLOCKING	PIC 9(3).
	
01 LINE-14	PIC X(40) VALUE "     VALUE OF IDENTIFICATION IS IN-NAME.".
01 LINE-14-A	PIC X(41) VALUE "     VALUE OF IDENTIFICATION IS OUT-NAME.".
01 LINE-15.
	02 15-FILLER	PIC X(29) VALUE"01 IN-REC   USAGE IS DISPLAY-".
	02 15-MODE	PIC X.
	02 15-PER	PIC X  VALUE ".".
01 LINE-15-A.
	02 15-A-FILLER	PIC X(29) VALUE "01 OUT-REC  USAGE IS DISPLAY-".
	02 15-A-MODE	PIC X.
	02 15-A-FILLER	PIC X(8) VALUE "  PIC X(".
	02 15-A-REC-SIZE	PIC 9(4).
	02 15-A-FILLER	PIC X(2) VALUE ").".
01 LINE-16.
	02 16-FILLER	PIC X(24) VALUE "     02 FILLER   PIC  X(".
	02 16-CHAR	PIC 9(4).
	02 16-FILLER	PIC X(2)  VALUE ").".
01 LINE-17.
	02 17-FILLER	PIC X(24) VALUE "     02 IR-SUM   PIC S9(".
	02 17-CON-CHAR	PIC 9(4).
	02 17-FILLER	PIC X(2)  VALUE ").".
01 LINE-18	PIC X(24) VALUE "WORKING-STORAGE SECTION.".
01 LINE-19.
	02 19-FILLER	PIC X(33) VALUE "77 IN-NAME       PIC X(9) VALUE ".
	02 19-FILLER	PIC X     VALUE QUOTE.
	02 19-IN-NAME	PIC X(9).
	02 19-FILLER	PIC X     VALUE QUOTE.
	02 19-FILLER	PIC X(1)  VALUE ".".
01 LINE-19-A.
	02 19-A-FILLER	PIC X(33) VALUE "77 OUT-NAME      PIC X(9) VALUE ".
	02 19-A-FILLER	PIC X     VALUE QUOTE.
	02 19-A-OUT-NAME	PIC X(9).
	02 19-A-FILLER	PIC X     VALUE QUOTE.
	02 19-A-FILLER	PIC X	  VALUE ".".
01 LINE-20	PIC X(23) VALUE "77 NO-RECS       INDEX.".
01 LINE-22	PIC X(19) VALUE "PROCEDURE DIVISION.".

01 LINE-21	PIC X(42) VALUE "77 CONTROL-TOTAL PIC S9(18) USAGE IS COMP.".
01 LINE-23	PIC X(6) VALUE "START.".
01 LINE-24	PIC X(25) VALUE "     OPEN INPUT  FILE-IN.".
01 LINE-24-A	PIC X(26) VALUE "     OPEN OUTPUT FILE-OUT.".
01 LINE-25	PIC X(25) VALUE "     SET NO-RECS TO ZERO.".
01 LINE-26	PIC X(31) VALUE "     SET CONTROL-TOTAL TO ZERO.".
01 LINE-27	PIC X(5)  VALUE "LOOP.".
01 LINE-28	PIC X(40) VALUE "     READ FILE-IN AT END GO TO ALL-DONE.".
01 LINE-28-A	PIC X(28) VALUE "     MOVE IN-REC TO OUT-REC.".
01 LINE-28-B	PIC X(19) VALUE "     WRITE OUT-REC.".
01 LINE-29	PIC X(25) VALUE "     SET NO-RECS UP BY 1.".
01 LINE-30	PIC X(36) VALUE "     SET CONTROL-TOTAL UP BY IR-SUM.".
01 LINE-31	PIC X(16) VALUE "     GO TO LOOP.".
01 LINE-32	PIC X(9)  VALUE "ALL-DONE.".
01 LINE-33	PIC X(19) VALUE "     CLOSE FILE-IN.".
01 LINE-33-A	PIC X(20) VALUE "     CLOSE FILE-OUT.".
01 LINE-34.
	02 34-FILLER	PIC X(22) VALUE "     DISPLAY NO-RECS, ".
	02 34-FILLER	PIC X     VALUE QUOTE.
	02 34-FILLER	PIC X(8)  VALUE " RECORDS".
	02 34-FILLER	PIC X     VALUE QUOTE.
	02 34-FILLER	PIC X     VALUE ".".
01 LINE-35.
	02 35-FILLER	PIC X(28) VALUE "     DISPLAY CONTROL-TOTAL, ".
	02 35-FILLER	PIC X     VALUE QUOTE.
	02 35-FILLER	PIC X(7)     VALUE " TOTAL ".
	02 35-TOTAL-DESCR	PIC X(25).
	02 35-FILLER	PIC X     VALUE QUOTE.
	02 35-FILLER	PIC X     VALUE ".".
01 LINE-36	PIC X(14) VALUE "     STOP RUN.".
PROCEDURE DIVISION.

START.
	DISPLAY " ".
	MOVE TODAY TO TODAYS-DATE.
	MOVE TD-YY TO 04-YY.
	MOVE TD-DD TO 04-DD.
	IF TD-MM IS GREATER THAN 12 OR LESS THAN 1
		MOVE "QQQ" TO 04-MM
	ELSE
		MOVE THE-MONTH(TD-MM) TO 04-MM.
	MOVE TD-TIME TO 02-ID.
	MOVE TD-TIME TO OFN-FN.
	DISPLAY " ".
	DISPLAY "  * BEGIN BUILD COBOL PROGRAM *  (V2)".
	DISPLAY " ".

BACK-A.
	DISPLAY "INPUT FILE IS ON DSK, SYS, OR MTA ? ", WITH NO ADVANCING.
	ACCEPT 10-DEVICE.
	IF 10-DEVICE = "DSK", OR "SYS", OR "MTA"  NEXT SENTENCE
	ELSE   DISPLAY "?"    GO TO BACK-A.

BACK-AA.
	DISPLAY "FILE NAME: (ALL 9 CHAR NO PERIOD) ? ", WITH NO ADVANCING.
	ACCEPT 19-IN-NAME.

BACK-B.
	DISPLAY "MODE IS:  A = ASCII,  S = SIXBIT  ? ", WITH NO ADVANCING.
	ACCEPT 15-MODE.
	IF 15-MODE = "A"  OR  "S"     NEXT SENTENCE
	ELSE   DISPLAY "?"   GO TO BACK-B.
	IF 15-MODE = "A"    MOVE "7" TO 15-MODE.
	IF 15-MODE = "S"    MOVE "6" TO 15-MODE.

BACK-C.
	DISPLAY "BLOCKING FACTOR: 0-999 (0 = UNBLOCKED) ? ", WITH NO ADVANCING.
	ACCEPT 13-BLOCKING.

BACK-D.
	DISPLAY "RECORD LENGTH: (CHARACTERS) ?", WITH NO ADVANCING.
	ACCEPT RECORD-SIZE.
	MOVE RECORD-SIZE TO 15-A-REC-SIZE.

	DISPLAY "DO YOU WANT TO COPY THE ABOVE FILE? (Y-N)  ", WITH NO ADVANCING.
	ACCEPT ANSWER.
	DISPLAY " ".
	IF ANSWER = "N"
		MOVE SPACE TO 15-A-MODE
		GO TO BACK-DA.
BACK-D1.
	DISPLAY "OUTPUT FILE NAME: (ALL 9 CHAR NO PERIOD) ? ", WITH NO ADVANCING.
	ACCEPT 19-A-OUT-NAME.
BACK-D2.
	DISPLAY "MODE IS :  A = ASCII,  S = SIXBIT  ? ", WITH NO ADVANCING.
	ACCEPT 15-A-MODE.
	IF 15-A-MODE = "A"   OR  "S"   NEXT SENTENCE
	ELSE	DISPLAY "?"   GO TO BACK-D2.
	IF 15-A-MODE = "A" MOVE "7" TO 15-A-MODE
	ELSE               MOVE "6" TO 15-A-MODE.
BACK-D3.
	DISPLAY "BLOCKING FACTOR:  0-999  (0 = UNBLOCKED) ? ", WITH NO ADVANCING.
	ACCEPT 13-A-BLOCKING.

BACK-DA.
	DISPLAY " ".
	DISPLAY "RECORD COUNT IS AUTOMATIC;  HOWEVER, IN ADDITION, ".
	DISPLAY "DO YOU WANT TO CONTROL ON SPECIFIC FIELD  (Y-N) ? ", WITH NO ADVANCING.
	ACCEPT ANSWER.
	IF ANSWER = "N"  MOVE "N" TO NO-SUM   GO TO OPEN-IT.
	DISPLAY "DESCRIBE THE FIELD TO BE ACCUMULATED (IN 25 CHAR OR LESS)".
	DISPLAY "*", WITH NO ADVANCING.
	ACCEPT 35-TOTAL-DESCR.
	MOVE SPACE TO NO-SUM.

BACK-E.
	DISPLAY "LEFT POSITION OF FIELD TO BE CONTROLLED ? ", WITH NO ADVANCING.
	ACCEPT 16-CHAR.
	IF 16-CHAR IS GREATER THAN RECORD-SIZE
		DISPLAY "? OUT-SIDE OF RECORD ?"
		GO TO BACK-E.
	SUBTRACT 1 FROM 16-CHAR.

BACK-F.
	DISPLAY "NUMBER OF POSITIONS IN FIELD ? ", WITH NO ADVANCING.
	ACCEPT 17-CON-CHAR.
	ADD 17-CON-CHAR, 16-CHAR GIVING SUM-SIZE.
	IF SUM-SIZE IS GREATER THAN RECORD-SIZE
		DISPLAY "? CONTROL FIELD GOES OFF END OF RECORD?" 
		GO TO BACK-F.
OPEN-IT.
	OPEN OUTPUT FILE-OUT.
	MOVE LINE-01 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-02 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-03 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-04 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-05 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-06 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-07 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-08 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-09 TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-10 TO OUT-REC.
	WRITE OUT-REC.
	IF 15-A-MODE IS NOT EQUAL SPACE
		MOVE LINE-10-A TO OUT-REC
		WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-11 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-11-A TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-12 TO OUT-REC.
	WRITE OUT-REC.
	IF 13-BLOCKING = ZEROES    GO TO S-A.
	MOVE LINE-13 TO OUT-REC.
	WRITE OUT-REC.

S-A.
	MOVE LINE-14 TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-15 TO OUT-REC.
	WRITE OUT-REC.
	IF NO-SUM = "N"
		MOVE RECORD-SIZE TO 16-CHAR
		MOVE LINE-16 TO OUT-REC
		WRITE OUT-REC
		GO TO S-C.
	IF 16-CHAR = ZEROES   GO TO S-B.
	MOVE LINE-16 TO OUT-REC.
	WRITE OUT-REC.

S-B.
	MOVE LINE-17 TO OUT-REC.
	WRITE OUT-REC.
	ADD 16-CHAR, 17-CON-CHAR GIVING SUM-SIZE.
	SUBTRACT SUM-SIZE FROM RECORD-SIZE GIVING 16-CHAR.
	IF 16-CHAR = ZEROES    GO TO S-C.
	MOVE LINE-16 TO OUT-REC.
	WRITE OUT-REC.

S-C.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	IF 15-A-MODE = SPACE GO TO S-D.
	MOVE LINE-12-A TO OUT-REC.
	WRITE OUT-REC.
	IF 13-A-BLOCKING = ZEROES NEXT SENTENCE
	ELSE
	MOVE 13-A-BLOCKING TO 13-BLOCKING
	MOVE LINE-13 TO OUT-REC 
	WRITE OUT-REC.
	MOVE LINE-14-A TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-15-A TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC
	WRITE OUT-REC-A.
S-D.
	MOVE LINE-18 TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-19 TO OUT-REC.
	WRITE OUT-REC.
	IF 15-A-MODE IS NOT EQUAL TO SPACE
		MOVE LINE-19-A TO OUT-REC
		WRITE OUT-REC.
	MOVE LINE-20 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-21 TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-22 TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-23 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-24 TO OUT-REC.
	WRITE OUT-REC.
	IF 15-A-MODE IS NOT EQUAL TO SPACE
		MOVE LINE-24-A TO OUT-REC
		WRITE OUT-REC.
	MOVE LINE-25 TO OUT-REC.
	WRITE OUT-REC.
	IF NO-SUM = "N"
		NEXT SENTENCE     ELSE
	MOVE LINE-26 TO OUT-REC
	WRITE OUT-REC.
	MOVE SPACE TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-27 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-28 TO OUT-REC.
	WRITE OUT-REC.
	IF 15-A-MODE IS NOT EQUAL TO SPACE
		MOVE LINE-28-A TO OUT-REC
		WRITE OUT-REC
		MOVE LINE-28-B TO OUT-REC
		WRITE OUT-REC.
	MOVE LINE-29 TO OUT-REC.
	WRITE OUT-REC.
	IF NO-SUM = "N"
		NEXT SENTENCE     ELSE
	MOVE LINE-30 TO OUT-REC
	WRITE OUT-REC.
	MOVE LINE-31 TO OUT-REC.
	WRITE OUT-REC.
	MOVE SPACES TO OUT-REC.
	WRITE OUT-REC-A.
	MOVE LINE-32 TO OUT-REC.
	WRITE OUT-REC.
	MOVE LINE-33 TO OUT-REC.
	WRITE OUT-REC.
	IF 15-A-MODE IS NOT EQUAL TO SPACE
		MOVE LINE-33-A TO OUT-REC
		WRITE OUT-REC.
	MOVE LINE-34 TO OUT-REC.
	WRITE OUT-REC.
	IF NO-SUM = "N"
		NEXT SENTENCE    ELSE
	MOVE LINE-35 TO OUT-REC
	WRITE OUT-REC.
	MOVE LINE-36 TO  OUT-REC.
	WRITE OUT-REC.
	CLOSE FILE-OUT.
	IF 10-DEVICE = "MTA"
		DISPLAY " "
		DISPLAY "NOTE:  INPUT FILE WILL BE ON  MTA" 
		DISPLAY " ".
	IF 15-A-MODE IS NOT EQUAL TO SPACE
		DISPLAY " "
		DISPLAY "NOTE:  OUTPUT FILE WILL GO TO  DEVOUT"
		DISPLAY " ".
	DISPLAY "EXECUTE ", OFN-FN.
	DISPLAY "- - - - WHEN JOB IS DONE - - -   DELETE ", OFN-FN, ".*".
	STOP RUN.