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.