*DECK     DCPLC300
00001  IDENTIFICATION DIVISION.                                         11/06/78
       PROGRAM-ID. PLC300.
*CALL COPYRIGHT 
      *    THIS MODULE CONTROLS THE CALLING OF THE COBOL GENERATION 
      *    MODULES AND DOES I/O FOR THE PRINTER AND CARD OUTPUT FILE
00010  ENVIRONMENT DIVISION.                                            DCPLC300
00011  CONFIGURATION SECTION.                                           DCPLC300
00012  SOURCE-COMPUTER. IBM-370.                                        DCPLC300
00013  OBJECT-COMPUTER. IBM-370.                                        DCPLC300
*CALL OTHSN 
00014  INPUT-OUTPUT SECTION.                                            DCPLC300
00015  FILE-CONTROL.                                                    DCPLC300
           SELECT MAST1 ASSIGN TO "MAST1" 
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS DATA-KEY-2.
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CON-KEY
               USE "PRUF = YES".
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT PUNCH-FILE ASSIGN TO PNCHFIL
               USE "RT=Z".
00024  DATA DIVISION.                                                   DCPLC300
00025  FILE SECTION.                                                    DCPLC300
*CALL     MAST1FD2
*CALL     MAST3FD 
*CALL     SYSPRTFD
*CALL     SYSPUNFD
*CALL GENCS 
*CALL     WRKSTG77
*CALL     MAST3DD1
00033  01  CBLGEN-WORK-AREAS.                                              CL**2
00034      03  LINE-SUB                  PICTURE S99 COMP SYNC.            CL**2
00039      03  COLUMN-LINE1.                                               CL**2
00040          05  FILLER              PICTURE X(107)                      CL**2
00041          VALUE "                                        1  1  2  2   CL**2
00042 -        "       3        4          5        6           7          CL**2
00043 -        "8".                                                        CL**2
00044      03  COLUMN-LINE2.                                               CL**2
00045          05 FILLER               PICTURE X(107)                      CL**2
00046          VALUE "          CARD IMAGE       1....6.......4..7..0..3   CL**2
00047 -        ".......1........0..........1........0...........2.......   CL**2
00048 -        "0".                                                        CL**2
00049      03  FIRST-TIME-SW           PICTURE X VALUE "Y".                CL**2
00050      03  COMMENT-1.                                                  CL**2
00051          05  FILLER              PICTURE XX VALUE "/*".              CL**2
00052          05  DSNAME-COMMENT      PICTURE X(32).                      CL**2
00053          05  FILLER              PICTURE X(29) VALUE                 CL**2
00054      "*DEFINITION CREATED FROM DC2 ".                                CL**2
00055      03  COMMENT-2.                                                  CL**2
00056          05  FILLER              PICTURE X(21) VALUE                 CL**2
00057      "*DATE OF GENERATION: ".                                        CL**2
00058          05  DATE-TODAY          PICTURE X(10).                      CL**2
00059      03  COMMENT-3.                                                  CL**2
00060          05  FILLER              PICTURE X(30) VALUE                 CL**2
00061      "*MASTER FILE REVISION NUMBER= ".                               CL**2
00062          05  REV-NUM             PICTURE X(5).                       CL**2
00063      03  COMMENT-4.                                                  CL**2
00064          05  FILLER              PICTURE X(24) VALUE                 CL**2
00065      "*DATE OF LAST REVISION= ".                                     CL**2
00066          05  REV-DATE-LAST       PICTURE X(8).                       CL**2
00067      03  COMMENT-5.                                                  CL**2
00068          05  FILLER              PICTURE XX VALUE "*/".              CL**2
00069      03  HOLD-COMMENT-IMAGE.                                         CL**2
00070          05  FILLER              PICTURE X(26).                      CL**2
00071          05  CARD-IMAGE.                                             CL**2
00072              07  MSG-SEQNO       PICTURE X(5).                       CL**2
00073              07  COMMENT-SAVE    PICTURE X(67).                      CL**2
00074              07  MSG-IDEN        PICTURE X(8).                       CL**2
00077      03  MAST1-ERR-MSG           PICTURE X(36) VALUE                 CL**2
00078         "DCGEN-900-F ERROR * MAST1 READ ERROR".                      CL**2
00079      03  MAST3-ERR-MSG           PICTURE X(45) VALUE                 CL**2
00080         "DCGEN-950-F ERROR * MAST3 READ CLIENT RECORD".              CL**2
00081      03  ERROR-PRINT-LINES.                                          CL**2
00082          05  CONSTANT-PRINT      PICTURE X(37).                      CL**2
00083          05  CONSTANT-NAME-PRINT PICTURE X(32).                      CL**2
00084  01  START-HOLD-NUMBER.                                              CL**2
00085      03  INCREMENT-START         PICTURE 9(6).                       CL**2
*CALL CURDATE 
00092  PROCEDURE DIVISION.                                              DCPLC300
00094 ********************************************************          DCPLC300
00095 ********************************************************          DCPLC300
00096 *                                                                 DCPLC300
00097 *     INITIALIZE                                                  DCPLC300
00098 *                                                                 DCPLC300
00099 ********************************************************          DCPLC300
00100 ********************************************************          DCPLC300
00101  0000-START.                                                      DCPLC300
00102      OPEN INPUT MAST1.                                               CL**2
00103      OPEN INPUT MAST3.                                               CL**2
00104      OPEN OUTPUT SYSPRINT.                                        DCPLC300
           OPEN EXTEND PUNCH-FILE.
           MOVE "N" TO FIRST-PREFIX-SW. 
00106 *                                                                    CL**2
00107 *     GET DATA FILE PRIME NUMBER                                     CL**2
00108 *                                                                    CL**2
00113      MOVE GTBL-OPT-STARTSEQNO TO INCREMENT-START.                    CL**2
00114 *                                                                    CL**2
00115 *      OUTPUT HEADINGS FOR GENERATION REPORT                         CL**2
00116 *                                                                    CL**2
00117  0100-START-REQ.                                                     CL**2
00118      MOVE "Y" TO FIRST-TIME-SW.                                      CL**2
00119      MOVE 99 TO LINE-CT.                                             CL**2
00120      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00121      MOVE SPACES TO PRINT-LINE.                                   DCPLC300
00122      IF GTBL-OPT-LIST EQUAL "Y"                                      CL**2
00123          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00124          GO TO 0150-INIT-TABLE.                                      CL**2
00125          IF GTBL-OPT-PUNCH EQUAL "Y"                                 CL**2
00126          PERFORM CREATION-COMMENT THRU CREATION-COMMENT-XIT.         CL**2
00127  0150-INIT-TABLE.                                                    CL**2
00128 *      INITIALIZE TABLE AND COUNT                                 DCPLC300
00129      MOVE ZERO TO GTBL-COUNT.                                        CL**2
00130      MOVE ZERO TO GTBL-MOD-REQ.                                   DCPLC300
00131      MOVE SPACES TO GTBL-OUTPUT-TABLE.                               CL**2
00132 ***********************************************************       DCPLC300
00133 *                                                                 DCPLC300
00134 *    PROCESS RECORD LEVEL GENERATION REQUEST                      DCPLC300
00135 *                                                                 DCPLC300
00136 **********************************************************        DCPLC300
00137  0500-RECORD-REQ.                                                 DCPLC300
00138      MOVE ZERO TO GTBL-MOD-REQ.                                   DCPLC300
00139  0510-RECORD-RETURN.                                              DCPLC300
           CALL "PLC315". 
00141 *                                                                 DCPLC300
00142 *       RESPOND TO MODULE REQUESTS                                DCPLC300
00143 *                                                                 DCPLC300
00144      IF GTBL-MOD-REQ EQUAL TO "9"                                 DCPLC300
00145          MOVE 4 TO GTBL-MOD-REQ                                      CL**2
00146          PERFORM 5000-OUTPUT-REQ THRU 5599-OUTPUT-REQ-XIT            CL**2
00147          GO TO 1000-REQ-FINI.                                     DCPLC300
00148      IF GTBL-MOD-REQ EQUAL TO "8"                                 DCPLC300
00149          MOVE 4 TO GTBL-MOD-REQ                                      CL**2
00150          PERFORM 5000-OUTPUT-REQ THRU 5599-OUTPUT-REQ-XIT            CL**2
00151          GO TO 8000-ABORT.                                        DCPLC300
00152      PERFORM 5000-OUTPUT-REQ THRU 5599-OUTPUT-REQ-XIT.               CL**2
00153      GO TO 0510-RECORD-RETURN.                                    DCPLC300
00154 *                                                                 DCPLC300
00155 *    COBOL STRUCTURE GENERATED-CHECK FOR MULTIPLE COPIES          DCPLC300
00156 *                                                                 DCPLC300
00157  1000-REQ-FINI.                                                   DCPLC300
00158      IF GTBL-OPT-SUFFIX1 NOT EQUAL TO SPACES                         CL**2
00159          GO TO 1075-REQUEST-FINI.                                    CL**2
00160      IF GTBL-OPT-SUFFIX2 NOT EQUAL TO SPACES                         CL**2
00161          GO TO 1075-REQUEST-FINI.                                    CL**2
00162      IF GTBL-OPT-PREFIX2 EQUAL SPACES                             DCPLC300
00163          GO TO 1050-CHANGE-PREFIX.                                   CL**2
00164      MOVE GTBL-OPT-PREFIX1 TO HOLD-FIRST-PREFIX.                     CL**2
00165      MOVE "Y" TO FIRST-PREFIX-SW.                                    CL**2
00166      MOVE GTBL-OPT-PREFIX2 TO GTBL-OPT-PREFIX1.                      CL**2
00167      MOVE SPACES TO GTBL-OPT-PREFIX2.                                CL**2
00168      MOVE INCREMENT-START TO GTBL-OPT-STARTSEQNO.                    CL**2
00169      GO TO 0100-START-REQ.                                           CL**2
00170  1050-CHANGE-PREFIX.                                                 CL**2
00171      IF FIRST-PREFIX-SW EQUAL "N"                                    CL**2
00172          GO TO 1100-END-GENERATION.                                  CL**2
00173      MOVE "N" TO FIRST-PREFIX-SW.                                    CL**2
00174      MOVE GTBL-OPT-PREFIX1 TO GTBL-OPT-PREFIX2.                      CL**2
00175      MOVE HOLD-FIRST-PREFIX TO GTBL-OPT-PREFIX1.                     CL**2
00176      MOVE SPACES TO HOLD-FIRST-PREFIX.                               CL**2
00177      GO TO 1100-END-GENERATION.                                      CL**2
00178  1075-REQUEST-FINI.                                                  CL**2
00179      IF GTBL-OPT-SUFFIX2 EQUAL TO SPACES                             CL**2
00180          GO TO 1090-CHANGE-SUFFIX.                                   CL**2
00181      MOVE GTBL-OPT-SUFFIX1 TO HOLD-FIRST-PREFIX.                     CL**2
00182      MOVE "Y" TO FIRST-PREFIX-SW.                                    CL**2
00183      MOVE GTBL-OPT-SUFFIX2 TO GTBL-OPT-SUFFIX1.                      CL**2
00184      MOVE SPACES TO GTBL-OPT-SUFFIX2.                                CL**2
00185      MOVE INCREMENT-START TO GTBL-OPT-STARTSEQNO.                    CL**2
00186      GO TO 0100-START-REQ.                                           CL**2
00187  1090-CHANGE-SUFFIX.                                                 CL**2
00188      IF FIRST-PREFIX-SW EQUAL TO "N"                                 CL**2
00189          GO TO 1100-END-GENERATION.                                  CL**2
00190      MOVE "N" TO FIRST-PREFIX-SW.                                    CL**2
00191      MOVE GTBL-OPT-SUFFIX1 TO GTBL-OPT-SUFFIX2.                      CL**2
00192      MOVE HOLD-FIRST-PREFIX TO GTBL-OPT-SUFFIX1.                     CL**2
00193      MOVE SPACES TO HOLD-FIRST-PREFIX.                               CL**2
00194 **************************************************                   CL**2
00195 **************************************************                   CL**2
00196 *                                                                    CL**2
00197 *     END OF REQUEST PROCESSING                                      CL**2
00198 *                                                                    CL**2
00199 ****************************************************                 CL**2
00200 ****************************************************                 CL**2
00201  1100-END-GENERATION.                                             DCPLC300
00202      CLOSE MAST1.                                                    CL**2
00203      CLOSE MAST3.                                                    CL**2
00204      CLOSE SYSPRINT.                                              DCPLC300
00205      CLOSE PUNCH-FILE.                                            DCPLC300
           EXIT PROGRAM.
00208 *******************************************************           DCPLC300
00209 *******************************************************           DCPLC300
00210 *                                                                 DCPLC300
00211 *                                                                    CL**2
00212 *     RESPOND TO I/O REQUESTS                                        CL**2
00213 *                                                                    CL**2
00214 *                                                                 DCPLC300
00215 *******************************************************           DCPLC300
00216 *******************************************************           DCPLC300
00217  5000-OUTPUT-REQ.                                                 DCPLC300
00218      IF GTBL-MOD-REQ EQUAL "1"                                       CL**2
00219          GO TO 5200-MAST1-READ.                                      CL**2
00220 *                                                                    CL**2
00221 *    OUTPUT COBOL STATEMENTS AND ERROR MESSAGES                      CL**2
00222 *                                                                    CL**2
00223      IF GTBL-COUNT EQUAL ZERO                                        CL**2
00224          GO TO 5599-OUTPUT-REQ-XIT.                                  CL**2
00225      MOVE 1 TO LINE-SUB.                                          DCPLC300
00226  5010-NEXT-LINE.                                                  DCPLC300
00227      IF GTBL-OUTPUT-IND (LINE-SUB) NOT EQUAL "E"                     CL**2
00228          GO TO 5015-OUT-COBOL.                                       CL**2
00229      IF GTBL-OPT-LIST EQUAL "N"                                      CL**2
00230          GO TO 5100-CHECK-END                                        CL**2
00231      ELSE                                                            CL**2
00232          MOVE GTBL-OUTPUT-ENTRY (LINE-SUB) TO STD-REPORT-REC         CL**2
00233          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCPLC300
00234          GO TO 5100-CHECK-END.                                    DCPLC300
00235 *                                                                 DCPLC300
00236 *        OUTPUT COBOL STATMENTS                                   DCPLC300
00237 *                                                                 DCPLC300
00238  5015-OUT-COBOL.                                                     CL**2
00239      IF GTBL-OPT-LIST EQUAL "Y"                                   DCPLC300
00240          MOVE GTBL-OUTPUT-ENTRY (LINE-SUB) TO STD-REPORT-REC         CL**2
00241          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.              DCPLC300
00242      IF GTBL-OPT-PUNCH EQUAL "Y"                                  DCPLC300
00243          MOVE GTBL-CARD-IMAGE (LINE-SUB) TO PUNCH-CARD            DCPLC300
00244          WRITE PUNCH-CARD.                                        DCPLC300
00245  5100-CHECK-END.                                                  DCPLC300
00246      IF LINE-SUB EQUAL GTBL-COUNT                                 DCPLC300
00247          GO TO 5150-OUTPUT-RESET.                                 DCPLC300
00248      ADD 1 TO LINE-SUB.                                           DCPLC300
00249      GO TO 5010-NEXT-LINE.                                        DCPLC300
00250  5150-OUTPUT-RESET.                                               DCPLC300
00251      MOVE SPACES TO GTBL-OUTPUT.                                  DCPLC300
00252      GO TO 5599-OUTPUT-REQ-XIT.                                      CL**2
00253  5200-MAST1-READ.                                                    CL**2
00254 *                                                                    CL**2
00255 *      PHYSICAL READ OF DATA FILE (PASS INFO IN LINKAGE)             CL**2
00256 *                                                                    CL**2
           MOVE DATA-KEY TO DATA-KEY-2. 
00258      READ MAST1 INVALID KEY                                          CL**2
00259          GO TO 9010-MAST1-READ-ERROR.                                CL**2
00260      MOVE MAST1-RECORD TO DATA-RECORD.                               CL**2
00261  5599-OUTPUT-REQ-XIT.                                                CL**2
00262      EXIT.                                                        DCPLC300
00263 ********************************************************             CL**2
00264 ********************************************************             CL**2
00265 *                                                                    CL**2
00266 *     ERROR ROUTINES                                                 CL**2
00267 *                                                                    CL**2
00268 ********************************************************             CL**2
00269 ********************************************************             CL**2
00270  8000-ABORT.                                                         CL**2
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
00271      STOP RUN.                                                       CL**2
00272 *                                                                    CL**2
00273 *   CONTROL FILE READ ERROR                                          CL**2
00274 *                                                                    CL**2
00275  9000-MAST3-READ-ERROR.                                              CL**2
00276      MOVE MAST3-ERR-MSG TO STD-REPORT-REC.                           CL**2
00277      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00278      GO TO 8000-ABORT.                                               CL**2
00279 *                                                                    CL**2
00280 *   DATA FILE READ ERROR                                             CL**2
00281 *                                                                    CL**2
00282  9010-MAST1-READ-ERROR.                                              CL**2
00283      MOVE "4" TO GTBL-MOD-REQ.                                       CL**2
00284      PERFORM 5000-OUTPUT-REQ THRU 5599-OUTPUT-REQ-XIT.               CL**2
00285      MOVE MAST1-ERR-MSG TO CONSTANT-PRINT.                           CL**2
00286      MOVE MAST1-REC-ID TO CONSTANT-NAME-PRINT.                       CL**2
00287      MOVE ERROR-PRINT-LINES TO STD-REPORT-REC.                       CL**2
00288      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00289      GO TO 8000-ABORT.                                               CL**2
00291 *******************************************************              CL**2
00292 *******************************************************              CL**2
00293 *                                                                    CL**2
00294 *     COMMON SUBROUTINES                                             CL**2
00295 *                                                                    CL**2
00296 ********************************************************             CL**2
00297 ********************************************************             CL**2
00298 *                                                                    CL**2
00299 *   OUTPUT GENERATION CARD COLUMN SUB HEADINGS                       CL**2
00300 *      ROUTINE IS ENTERED FROM DISPLAY-LINE                          CL**2
00301 *                                                                    CL**2
00302  USER-ROUTINE.                                                       CL**2
00303      MOVE COLUMN-LINE1 TO PRINT-LINE.                                CL**2
00304      MOVE 2 TO PRT-CTL.                                              CL**2
00305      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00306      MOVE COLUMN-LINE2 TO PRINT-LINE.                                CL**2
00307      MOVE 1 TO PRT-CTL.                                              CL**2
00308      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00309      MOVE SPACES TO PRINT-LINE.                                      CL**2
00310      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00311      ADD 4 TO LINE-CT.                                               CL**2
00312      IF FIRST-TIME-SW NOT EQUAL "Y"                                  CL**2
00313          GO TO USER-ROUTINE-XIT.                                     CL**2
00314      MOVE "N" TO FIRST-TIME-SW.                                      CL**2
00315      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00316      PERFORM CREATION-COMMENT THRU CREATION-COMMENT-XIT.             CL**2
00317  USER-ROUTINE-XIT.                                                   CL**2
00318      EXIT.                                                           CL**2
00319  CREATION-COMMENT.                                                   CL**2
00320      MOVE SPACES TO HOLD-COMMENT-IMAGE.                              CL**2
00321      MOVE GTBL-SEL-CNAME TO DSNAME-COMMENT.                          CL**2
00322      MOVE COMMENT-1 TO COMMENT-SAVE.                                 CL**2
00323      PERFORM MSG-OUT THRU MSG-OUT-XIT.                               CL**2
*CALL ACCEPTDT
00324      MOVE CURRENT-DATE TO DATE-TODAY.                                CL**2
00325      MOVE COMMENT-2 TO COMMENT-SAVE.                                 CL**2
00326      PERFORM MSG-OUT THRU MSG-OUT-XIT.                               CL**2
00327      MOVE REVISION-NUMBER TO REV-NUM.                                CL**2
00328      MOVE COMMENT-3 TO COMMENT-SAVE.                                 CL**2
00329      PERFORM MSG-OUT THRU MSG-OUT-XIT.                               CL**2
00330      MOVE DATE-LAST-REVISION TO REV-DATE-LAST.                       CL**2
00331      MOVE COMMENT-4 TO COMMENT-SAVE.                                 CL**2
00332      PERFORM MSG-OUT THRU MSG-OUT-XIT.                               CL**2
00333      MOVE COMMENT-5 TO COMMENT-SAVE.                                 CL**2
00334      PERFORM MSG-OUT THRU MSG-OUT-XIT.                               CL**2
00335  CREATION-COMMENT-XIT.                                               CL**2
00336      EXIT.                                                           CL**2
00337  MSG-OUT.                                                            CL**2
00338      MOVE GTBL-OPT-STARTSEQNO TO MSG-IDEN.                           CL**2
00339      MOVE SPACES TO MSG-SEQNO.                                       CL**2
00340      ADD GTBL-OPT-INCSEQNO TO GTBL-OPT-STARTSEQNO.                   CL**2
00341  MSG-OUT-LIST.                                                       CL**2
00342      IF GTBL-OPT-LIST EQUAL "Y"                                      CL**2
00343          MOVE HOLD-COMMENT-IMAGE TO PRINT-DATA                       CL**2
00344          MOVE 1 TO PRT-CTL                                           CL**2
00345         ADD 1 TO LINE-CT                                             CL**2
00346          PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                     CL**2
00347      IF GTBL-OPT-PUNCH EQUAL "Y"                                     CL**2
00348          MOVE CARD-IMAGE TO PUNCH-CARD                               CL**2
00349          WRITE PUNCH-CARD.                                           CL**2
00350      MOVE SPACES TO HOLD-COMMENT-IMAGE.                              CL**2
00351  MSG-OUT-XIT.                                                        CL**2
00352      EXIT.                                                           CL**2
*CALL     DISPLAYLN 
*CALL     WRITELN 
*CALL RETCODE 
