*COMDECK  BALSUB
00001 *                                                                 09/27/78
00002 *    ROUTINE SETS UP A "DC" LINE FOR A FIELD WITH INIT VALUES     BALSUB
00003 *                                                                    LV002
00004  SET-DC.                                                             CL**2
00005      MOVE "DC" TO OPERATION-CODE.                                    CL**2
00006      MOVE ELE-FORMAT TO LETTER-C.                                    CL**2
00007      MOVE "L" TO LETTER-L.                                           CL**2
00008      MOVE SPACES TO FILLER-NUM-B.                                    CL**2
00009      MOVE FILLER-AREA-B TO OPERAND-COMMENT.                          CL**2
00010      MOVE ZERO TO SUB-A SUB-B.                                       CL**2
00011      PERFORM FIND-SPACES THRU FIND-SPACES-XIT.                       CL**2
00012      SUBTRACT 1 FROM SUB-A.                                          CL**2
00013      PERFORM MOVE-VALID-LENGTH THRU MOVE-VALID-LENGTH-XIT.           CL**2
00014      ADD 1 TO SUB-A.                                                 CL**2
00015      MOVE QUOTE TO SINGLE-OPERAND (SUB-A).                           CL**2
00016      IF ELE-INT-VALUE EQUAL TO SPACES                                CL**2
00017          ADD 1 TO SUB-A                                              CL**2
00018          MOVE SPACE TO SINGLE-OPERAND (SUB-A)                        CL**2
00019          GO TO SET-DC-QUOTE.                                         CL**2
00020      IF ELE-INT-VALUE EQUAL TO "0"                                   CL**2
00021          ADD 1 TO SUB-A                                              CL**2
00022          MOVE "0" TO SINGLE-OPERAND (SUB-A)                          CL**2
00023          GO TO SET-DC-QUOTE.                                         CL**2
00024      IF ELE-INT-VALUE EQUAL TO "00" OR "00000000"                    CL**2
00025          MOVE "Y" TO ZERO-SW                                         CL**2
00026          MOVE ELE-INT-VALUE TO SCAN-AREA                             CL**2
00027          PERFORM 7485-MOVE-LENGTH THRU 7485-MOVE-LENGTH-XIT          CL**2
00028          GO TO SET-DC-QUOTE.                                         CL**2
00029      MOVE ELE-INT-VALUE TO SCAN-AREA.                                CL**2
00030      MOVE 25 TO SUB-C.                                               CL**2
00031      PERFORM 7485-MOVE-LENGTH THRU 7485-MOVE-LENGTH-XIT.             CL**2
00032      MOVE 0 TO SUB-A.                                                CL**2
00033      PERFORM FIND-SPACES THRU FIND-SPACES-XIT.                       CL**2
00034      SUBTRACT 1 FROM SUB-A.                                          CL**2
00035  SET-DC-QUOTE.                                                       CL**2
00036      ADD 1 TO SUB-A.                                                 CL**2
00037      MOVE QUOTE TO SINGLE-OPERAND (SUB-A).                           CL**2
00038  SET-DC-XIT.                                                         CL**2
00039      EXIT.                                                           CL**2
00040 *                                                                    CL**2
00041 *    FORMAT TYPE REQUIRES STORAGE BE RESERVED BY A "DS"              CL**2
00042 *        BEFORE THE "DC" STATEMENT IS WRITTEN                        CL**2
00043 *                                                                    CL**2
00044  START-DOUBLE-LINE.                                                  CL**2
00045      IF HOLD-SW EQUAL TO "Y"                                         CL**2
00046          MOVE "N" TO HOLD-SW                                         CL**2
00047          GO TO START-DOUBLE-LINE-XIT.                                CL**2
00048      IF GROUP-OCCUR-SW EQUAL TO "Y"                                  CL**2
00049          GO TO START-DOUBLE-LINE-XIT.                                CL**2
00050      MOVE "DS" TO OPERATION-CODE.                                    CL**2
00051      MOVE "0" TO NUM-A.                                              CL**2
00052      MOVE "C" TO FILLER-A.                                           CL**2
00053      MOVE "L" TO FILLER-L.                                           CL**2
00054      MOVE SPACES TO FILLER-NUM.                                      CL**2
00055      MOVE FILLER-AREA TO OPERAND-COMMENT.                            CL**2
00056      MOVE ZERO TO SUB-A SUB-B.                                       CL**2
00057      PERFORM FIND-SPACES THRU FIND-SPACES-XIT.                       CL**2
00058      SUBTRACT 1 FROM SUB-A.                                          CL**2
00059      PERFORM MOVE-VALID-LENGTH THRU MOVE-VALID-LENGTH-XIT.           CL**2
00060      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00061      MOVE SPACES TO FILLER-AREA.                                     CL**2
00062  START-DOUBLE-LINE-XIT.                                              CL**2
00063      EXIT.                                                           CL**2
00064 *                                                                    CL**2
00065 *    ROUTINE PRINTS THE "DC" THAT ACCOMPANIES THE ABOVE "DS"         CL**2
00066 *                                                                    CL**2
00067  SET-SECOND.                                                         CL**2
00068      MOVE "DC" TO OPERATION-CODE.                                    CL**2
00069      MOVE ZERO TO SUB-A SUB-B.                                       CL**2
00070      PERFORM MOVE-VALID-LENGTH THRU MOVE-VALID-LENGTH-XIT.           CL**2
00071      ADD 1 TO SUB-A.                                                 CL**2
00072      MOVE ELE-FORMAT TO SINGLE-OPERAND (SUB-A).                      CL**2
00073      ADD 1 TO SUB-A.                                                 CL**2
00074      MOVE "L" TO SINGLE-OPERAND (SUB-A).                             CL**2
00075      ADD 1 TO SUB-A.                                                 CL**2
00076      MOVE "1" TO SINGLE-OPERAND (SUB-A).                             CL**2
00077      ADD 1 TO SUB-A.                                                 CL**2
00078      MOVE QUOTE TO SINGLE-OPERAND (SUB-A).                           CL**2
00079  SET-SECOND-XIT.                                                     CL**2
00080      EXIT.                                                           CL**2
00081 *                                                                    CL**2
00082 *    FORMAT FIELD IS A FLOATING POINT FIELD                          CL**2
00083 *                                                                    CL**2
00084  FLOAT-LEVEL.                                                        CL**2
00085      MOVE "DC" TO OPERATION-CODE.                                    CL**2
00086      MOVE 1 TO SUB-A.                                                CL**2
00087      IF ELE-LENGTH EQUAL TO 4                                        CL**2
00088          MOVE "E" TO SINGLE-OPERAND (SUB-A)                          CL**2
00089          GO TO FLOAT-LEVEL-XIT.                                      CL**2
00090      IF ELE-LENGTH LESS THAN 4                                       CL**2
00091          PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT          CL**2
00092          MOVE "E" TO SINGLE-OPERAND (SUB-A)                          CL**2
00093          GO TO FLOAT-LEVEL-XIT.                                      CL**2
00094      IF ELE-LENGTH EQUAL TO 8                                        CL**2
00095          MOVE "D" TO SINGLE-OPERAND (SUB-A)                          CL**2
00096          GO TO FLOAT-LEVEL-XIT.                                      CL**2
00097      IF ELE-LENGTH LESS THAN 8                                       CL**2
00098          PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT          CL**2
00099          MOVE "D" TO SINGLE-OPERAND (SUB-A)                          CL**2
00100          GO TO FLOAT-LEVEL-XIT.                                      CL**2
00101      IF ELE-LENGTH LESS THAN 16                                      CL**2
00102          PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT.         CL**2
00103  FLOAT-LEVEL-XIT.                                                    CL**2
00104      EXIT.                                                           CL**2
00105 *                                                                    CL**2
00106 *    FORMAT FIELD IS EQUAL TO A WORD LEVEL TYPE                      CL**2
00107 *                                                                    CL**2
00108  WORD-LEVEL.                                                         CL**2
00109      MOVE "DC" TO OPERATION-CODE.                                    CL**2
00110      MOVE 1 TO SUB-A.                                                CL**2
00111      IF ELE-LENGTH EQUAL TO 2                                        CL**2
00112          MOVE "H" TO SINGLE-OPERAND (SUB-A)                          CL**2
00113          GO TO WORD-LEVEL-XIT.                                       CL**2
00114      IF ELE-LENGTH LESS THAN 2                                       CL**2
00115          PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT          CL**2
00116          MOVE "H" TO SINGLE-OPERAND (SUB-A)                          CL**2
00117          GO TO WORD-LEVEL-XIT.                                       CL**2
00118      IF ELE-LENGTH EQUAL TO 4                                        CL**2
00119          MOVE "F" TO SINGLE-OPERAND (SUB-A)                          CL**2
00120          GO TO WORD-LEVEL-XIT.                                       CL**2
00121      IF ELE-LENGTH LESS THAN 4                                       CL**2
00122          PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT          CL**2
00123          MOVE "F" TO SINGLE-OPERAND (SUB-A)                          CL**2
00124          GO TO WORD-LEVEL-XIT.                                       CL**2
00125      IF ELE-LENGTH EQUAL TO 8                                        CL**2
00126          MOVE "D" TO SINGLE-OPERAND (SUB-A)                          CL**2
00127          GO TO WORD-LEVEL-XIT.                                       CL**2
00128      IF ELE-LENGTH LESS THAN 8                                       CL**2
00129          MOVE "D" TO SINGLE-OPERAND (SUB-A)                          CL**2
00130          PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT.         CL**2
00131  WORD-LEVEL-XIT.                                                     CL**2
00132      EXIT.                                                           CL**2
00133                                                                    BALSUB 
00134 *                                                                    CL**2
00135 *    MOVE QUOTE AROUND INITIAL VALUE ON PRINT LINE                   CL**2
00136 *                                                                    CL**2
00137  MOVE-QUOTE-ZERO.                                                    CL**2
00138      MOVE QUOTE TO SINGLE-OPERAND (2)                                CL**2
00139      MOVE "0" TO SINGLE-OPERAND (3).                                 CL**2
00140      MOVE QUOTE TO SINGLE-OPERAND (4).                               CL**2
00141  MOVE-QUOTE-ZERO-XIT.                                                CL**2
00142      EXIT.                                                           CL**2
00143 *                                                                    CL**2
00144 *    VALIDATE THAT LENGTH OF FIELD NOT GREATER THAN 16               CL**2
00145 *                                                                    CL**2
00146  SIXTEEN-LENGTH.                                                     CL**2
00147      IF ELE-LENGTH GREATER THAN 16                                   CL**2
00148          PERFORM LENGTH-ERROR-MSSG THRU LENGTH-ERROR-MSSG-XIT        CL**2
00149          GO TO 7600-RETURN.                                          CL**2
00150  SIXTEEN-LENGTH-XIT.                                                 CL**2
00151      EXIT.                                                           CL**2
00152 *                                                                    CL**2
00153 *    VALIDATE THAT LENGTH OF FIELD NOT GREATER THAN 256              CL**2
00154 *                                                                    CL**2
00155  TWO-FIFTY-SIX.                                                      CL**2
00156      IF ELE-LENGTH GREATER THAN 256                                  CL**2
00157          PERFORM LENGTH-ERROR-MSSG THRU LENGTH-ERROR-MSSG-XIT        CL**2
00158          GO TO 7600-RETURN.                                          CL**2
00159  TWO-FIFTY-SIX-XIT.                                                  CL**2
00160      EXIT.                                                           CL**2
00161 *                                                                    CL**2
00162 *    PRINT INVALID LENGTH ERROR MESSAGES                             CL**2
00163 *                                                                    CL**2
00164  LENGTH-ERROR-MSSG.                                                  CL**2
00165      PERFORM 9025-INFORM-ERROR THRU 9025-INFORM-ERROR-XIT.           CL**2
00166      PERFORM 9070-LENGTH-MSSG-ERR THRU 9070-LENGTH-MSSG-ERR-XIT.     CL**2
00167  LENGTH-ERROR-MSSG-XIT.                                              CL**2
00168      EXIT.                                                           CL**2
00169 *                                                                    CL**2
00170 *    PRINT INVALID FORMAT ERROR MESSAGES                             CL**2
00171 *                                                                    CL**2
00172  SELECT-ERROR-MSSG.                                                  CL**2
00173      PERFORM 9025-INFORM-ERROR THRU 9025-INFORM-ERROR-XIT.           CL**2
00174      PERFORM 9065-INITIAL-FORMAT THRU 9065-INITIAL-FORMAT-XIT.       CL**2
00175  SELECT-ERROR-MSSG-XIT.                                              CL**2
00176      EXIT.                                                           CL**2
00177 *                                                                    CL**2
00178 *    ROUTINE FINDS FIRST OPEN SPACE IN OPERAND FIELD OF PRINT        CL**2
00179 *                                                                    CL**2
00180  FIND-SPACES.                                                        CL**2
00181      ADD 1 TO SUB-A.                                                 CL**2
00182      IF SINGLE-OPERAND (SUB-A) NOT EQUAL TO SPACES                   CL**2
00183          GO TO FIND-SPACES.                                          CL**2
00184  FIND-SPACES-XIT.                                                    CL**2
00185      EXIT.                                                           CL**2
00186                                                                    BALSUB 
00187 *                                                                    CL**2
00188 *    ROUTINE LEFT JUSTIFIES A FIELD IN THE OPERAND OF PRINT LINE     CL**2
00189 *                                                                    CL**2
00190  MOVE-VALID-LENGTH.                                                  CL**2
00191      ADD 1 TO SUB-B.                                                 CL**2
00192      IF ELE-LENGTHA (SUB-B) EQUAL TO SPACES OR ZERO                  CL**2
00193          GO TO MOVE-VALID-LENGTH.                                    CL**2
00194  MOVE-LETTER.                                                        CL**2
00195      ADD 1 TO SUB-A.                                                 CL**2
00196      MOVE ELE-LENGTHA (SUB-B) TO SINGLE-OPERAND (SUB-A).             CL**2
00197      ADD 1 TO SUB-B.                                                 CL**2
00198      IF SUB-B GREATER THAN 4                                         CL**2
00199          MOVE ZERO TO SUB-B                                          CL**2
00200          GO TO MOVE-VALID-LENGTH-XIT.                                CL**2
00201      GO TO MOVE-LETTER.                                              CL**2
00202  MOVE-VALID-LENGTH-XIT.                                              CL**2
00203      EXIT.                                                           CL**2
00204 *****************************************************************    CL**2
00205 *     INSERT PREFIX IF INDICATED                                     CL**2
00206 ****************************************************************     CL**2
00207  INSERT-PREFIX.                                                      CL**2
00208      MOVE SPACES TO WORK-DATA-NAME.                                  CL**2
00209      IF GTBL-OPT-SUFFIX1 NOT EQUAL TO SPACES                         CL**2
00210          MOVE 0 TO SUB1, SUB2                                        CL**2
00211          MOVE GTBL-OPT-SUFFIX1 TO WORK-DATA-NAME                     CL**2
00212          GO TO INSERT-SUFFIX.                                        CL**2
00213      IF GTBL-OPT-PREFIX1 EQUAL SPACES                                CL**2
00214          MOVE WS-DATA-NAME TO WORK-DATA-NAME                         CL**2
00215          GO TO INSERT-PREFIX-XIT.                                    CL**2
00216      MOVE GTBL-OPT-PREFIX1 TO WORK-DATA-NAME.                        CL**2
00217  PROC-DATA-NAME.                                                     CL**2
00218      MOVE 01 TO SUB1.                                                CL**2
00219  PREFIX-LOOP.                                                        CL**2
00220      ADD 1 TO SUB1.                                                  CL**2
00221      IF SUB1 GREATER THAN 2                                          CL**2
00222          GO TO DATA-NAME-BUILD.                                      CL**2
00223      IF WS-DN (SUB1) NOT EQUAL TO SPACE                              CL**2
00224          GO TO PREFIX-LOOP.                                          CL**2
00225  DATA-NAME-BUILD.                                                    CL**2
00226      SUBTRACT 1 FROM SUB1.                                           CL**2
00227      MOVE 01 TO SUB2.                                                CL**2
00228  BUILD-LOOP.                                                         CL**2
00229      ADD 1 TO SUB1.                                                  CL**2
00230      IF SUB1 GREATER THAN 8                                          CL**2
00231          GO TO INSERT-PREFIX-XIT.                                    CL**2
00232      MOVE WORK-DN (SUB2) TO WS-DN (SUB1).                            CL**2
00233      ADD 1 TO SUB2.                                                  CL**2
00234      IF WORK-DN (SUB2) NOT EQUAL TO SPACES                           CL**2
00235          GO TO BUILD-LOOP.                                           CL**2
00236      GO TO INSERT-PREFIX-XIT.                                        CL**2
00237  INSERT-SUFFIX.                                                      CL**2
00238      ADD 1 TO SUB1.                                                  CL**2
00239      IF WORK-DN (SUB1) NOT EQUAL TO SPACES                           CL**2
00240          GO TO INSERT-SUFFIX.                                        CL**2
00241  SUFFIX-LENGTH.                                                      CL**2
00242      ADD 1 TO SUB2.                                                  CL**2
00243      IF SUB2 GREATER THAN 2                                          CL**2
00244          SUBTRACT 1 FROM SUB1, SUB2                                  CL**2
00245          GO TO CALC-TOTAL-LENGTH.                                    CL**2
00246      IF WS-DN (SUB2) NOT EQUAL TO SPACES                             CL**2
00247          GO TO SUFFIX-LENGTH.                                        CL**2
00248      SUBTRACT 1 FROM SUB1, SUB2.                                     CL**2
00249  CALC-TOTAL-LENGTH.                                                  CL**2
00250      ADD SUB1 TO SUB2.                                               CL**2
00251      IF SUB2 GREATER THAN 8                                          CL**2
00252          MOVE 0 TO SUB2                                              CL**2
00253          SUBTRACT 1 FROM SUB1                                        CL**2
00254          GO TO CALC-TOTAL-LENGTH.                                    CL**2
00255      MOVE 1 TO SUB2.                                                 CL**2
00256      ADD 1 TO SUB1.                                                  CL**2
00257      MOVE WS-DN (SUB2) TO WORK-DN (SUB1).                            CL**2
00258      ADD 1 TO SUB2, SUB1.                                            CL**2
00259      MOVE WS-DN (SUB2) TO WORK-DN (SUB1).                            CL**2
00260  INSERT-PREFIX-XIT.                                                  CL**2
00261      EXIT.                                                           CL**2
00262                                                                    BALSUB 
00263 *****************************************************************    CL**2
00264 *     READ AND PROCESS COMMENT LINES                                 CL**2
00265 *****************************************************************    CL**2
00266  CHECK-COMMENT.                                                      CL**2
00267      IF CAT-COMMENT NOT EQUAL "*"                                    CL**2
00268          GO TO CHECK-COMMENT-XIT.                                    CL**2
00269      IF DATA-ENTRY-CAT NOT EQUAL "300"                               CL**2
00270          GO TO GET-NEXT-LINE.                                        CL**2
00271      IF GTBL-OPT-COMMENT EQUAL "Y"                                   CL**2
00272          MOVE SPACES TO HOLD-CARD-IMAGE                              CL**2
00273          MOVE CAT-DETAIL TO HOLD-COMMENT-IMAGE                       CL**2
00274          PERFORM BAL-OUT THRU BAL-OUT-XIT.                           CL**2
00275  GET-NEXT-LINE.                                                      CL**2
00276      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00277      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00278          GO TO CHECK-COMMENT-XIT.                                    CL**2
00279      GO TO CHECK-COMMENT.                                            CL**2
00280  CHECK-COMMENT-XIT.                                                  CL**2
00281      EXIT.                                                           CL**2
00282 *****************************************************************    CL**2
00283 *     PROCESS FILLER STATEMENT                                       CL**2
00284 *****************************************************************    CL**2
00285  PROC-FILLER.                                                        CL**2
00286      MOVE SPACES TO HOLD-BAL-IMAGE.                                  CL**2
00287      MOVE "DS" TO OPERATION-CODE.                                    CL**2
00288      IF STC-SR-FILL-LEN EQUAL TO SPACES OR 0                         CL**2
00289          MOVE "C" TO LETTER-C                                        CL**2
00290          MOVE "L" TO LETTER-L                                        CL**2
00291          MOVE 1 TO NUMBER-A                                          CL**2
00292          MOVE SPACES TO NUMBER-LEN                                   CL**2
00293          MOVE FILLER-AREA-B TO OPERAND-COMMENT                       CL**2
00294          GO TO PROC-FILLER-XIT.                                      CL**2
00295      MOVE "C" TO SINGLE-OPERAND (1).                                 CL**2
00296      MOVE "L" TO SINGLE-OPERAND (2).                                 CL**2
00297      MOVE ZERO TO SUB-B.                                             CL**2
00298      MOVE 2 TO SUB-A.                                                CL**2
00299      MOVE STC-SR-FILL-LEN TO SCAN-AREA.                              CL**2
00300      MOVE 4 TO SUB-C.                                                CL**2
00301      PERFORM 7485-MOVE-LENGTH THRU 7485-MOVE-LENGTH-XIT.             CL**2
00302  PROC-FILLER-XIT.                                                    CL**2
00303      EXIT.                                                           CL**2
00304                                                                    BALSUB 
