*COMDECK  PL1SUB
00001 *                                                                 11/08/78
00002 *    PLACE EITHER A SEMI-COLON OR A COMMA AT END OF LINE          PL1SUB
00003 *                                                                    LV002
00004  FLOAT-SEMI.                                                         CL**2
00005      MOVE 80 TO LEN-P.                                               CL**2
00006  FLOAT-LOOP.                                                         CL**2
00007      IF SCAN-FIELD (LEN-P) NOT EQUAL SPACE                           CL**2
00008          ADD 1 TO LEN-P                                           PL1SUB
00009          MOVE ";" TO SCAN-FIELD (LEN-P)                              CL**2
00010          GO TO FLOAT-COMMA.                                          CL**2
00011      SUBTRACT 1 FROM LEN-P.                                       PL1SUB
00012      IF LEN-P GREATER THAN 0 GO TO FLOAT-LOOP.                       CL**2
00013      GO TO FLOAT-SEMI-XIT.                                           CL**2
00014  FLOAT-COMMA.                                                        CL**2
00015      IF COMMA-SW EQUAL TO "Y"                                        CL**2
00016          MOVE "," TO SCAN-FIELD (LEN-P).                             CL**2
00017      IF COMMA-SW EQUAL TO "X"                                        CL**2
00018          MOVE "Y" TO COMMA-SW                                        CL**2
00019          MOVE RIGHTPAREN TO SCAN-FIELD (LEN-P).                      CL**2
00020  FLOAT-SEMI-XIT.                                                     CL**2
00021      EXIT.                                                        PL1SUB
00022 *                                                                    CL**2
00023 *    CLEAR EXCESS SPACES FROM PRINT LINE                             CL**2
00024 *                                                                    CL**2
00025  CLEAR-SPACES.                                                       CL**2
00026      MOVE 1 TO SUB1, SUB2.                                           CL**2
00027      MOVE SPACES TO CHARACTER-OUT.                                   CL**2
00028  FIND-CHARACTER.                                                     CL**2
00029      IF SCAN-FIELD (SUB1) EQUAL TO SPACES                            CL**2
00030          MOVE SCAN-FIELD (SUB1) TO OUT-CHAR (SUB2)                   CL**2
00031          ADD 1 TO SUB1, SUB2                                         CL**2
00032          GO TO FIND-CHARACTER.                                       CL**2
00033  FIND-SPACE-LOOP.                                                    CL**2
00034      MOVE SCAN-FIELD (SUB1) TO OUT-CHAR (SUB2).                      CL**2
00035      ADD 1 TO SUB1, SUB2.                                            CL**2
00036      IF SUB1 GREATER THAN 80                                         CL**2
00037          MOVE CHARACTER-OUT TO SCAN-AREA                             CL**2
00038          GO TO CLEAR-SPACES-XIT.                                     CL**2
00039      IF SCAN-FIELD (SUB1) EQUAL TO "("                               CL**2
00040          MOVE SCAN-FIELD (SUB1) TO OUT-CHAR (SUB2)                   CL**2
00041          GO TO CLEAR-ADD.                                            CL**2
00042      IF SCAN-FIELD (SUB1) NOT EQUAL TO SPACES                        CL**2
00043          GO TO FIND-SPACE-LOOP.                                      CL**2
00044      MOVE SCAN-FIELD (SUB1) TO OUT-CHAR (SUB2).                      CL**2
00045  CLEAR-ADD.                                                          CL**2
00046      ADD 1 TO SUB1, SUB2.                                            CL**2
00047      IF SUB1 GREATER THAN 80                                         CL**2
00048          MOVE CHARACTER-OUT TO SCAN-AREA                             CL**2
00049          GO TO CLEAR-SPACES-XIT.                                     CL**2
00050  CLEAR-SPACES-LOOP.                                                  CL**2
00051      IF SCAN-FIELD (SUB1) NOT EQUAL TO SPACES                        CL**2
00052          GO TO FIND-SPACE-LOOP.                                      CL**2
00053      ADD 1 TO SUB1.                                                  CL**2
00054      IF SUB1 GREATER THAN 80                                         CL**2
00055          MOVE CHARACTER-OUT TO SCAN-AREA                             CL**2
00056          GO TO CLEAR-SPACES-XIT.                                     CL**2
00057      GO TO CLEAR-SPACES-LOOP.                                        CL**2
00058  CLEAR-SPACES-XIT.                                                   CL**2
00059      EXIT.                                                           CL**2
00060 *                                                                    CL**2
00061 *    PLACE OCCUR TO AND OCCUR FROM CLAUSES IN DECLARE                CL**2
00062 *                                                                    CL**2
00063  MOVE-OCCUR.                                                         CL**2
00064      MOVE 1 TO SUB1.                                                 CL**2
00065      MOVE 80 TO LEN-P.                                               CL**2
00066  MOVE-OCCUR-SPACE.                                                   CL**2
00067      IF SCAN-FIELD (LEN-P) EQUAL TO SPACE                            CL**2
00068          SUBTRACT 1 FROM LEN-P                                       CL**2
00069          GO TO MOVE-OCCUR-SPACE.                                     CL**2
00070  MOVE-OCCUR-LOOP.                                                    CL**2
00071      ADD 2 TO LEN-P.                                                 CL**2
00072      MOVE OUT-CHAR (SUB1) TO SCAN-FIELD (LEN-P).                     CL**2
00073  SPACE-CHAR-LOOP.                                                    CL**2
00074      ADD 1 TO SUB1.                                                  CL**2
           IF SUB1 > 11 
00076          GO TO MOVE-OCCUR-XIT.                                       CL**2
00077      IF OUT-CHAR (SUB1) EQUAL TO SPACES                              CL**2
00078          GO TO SPACE-CHAR-LOOP.                                      CL**2
00079      ADD 1 TO LEN-P.                                                 CL**2
00080      MOVE OUT-CHAR (SUB1) TO SCAN-FIELD (LEN-P).                     CL**2
00081      GO TO SPACE-CHAR-LOOP.                                          CL**2
00082  MOVE-OCCUR-XIT.                                                     CL**2
00083      EXIT.                                                           CL**2
00084 *                                                                    CL**2
00085 *    PLACE QUOTE AROUND THE INITIAL VALUE                            CL**2
00086 *                                                                    CL**2
00087  FLOAT-QUOTE.                                                        CL**2
00088      MOVE 80 TO LEN-P.                                               CL**2
00089  FLOAT-LOOP-QUOTE.                                                   CL**2
00090      IF SCAN-FIELD (LEN-P) EQUAL TO SPACE                            CL**2
00091          SUBTRACT 1 FROM LEN-P                                       CL**2
00092          GO TO FLOAT-LOOP-QUOTE.                                     CL**2
00093      ADD 1 TO LEN-P.                                                 CL**2
00094      IF GTBL-OPT-QUOTE EQUAL TO "Y"                                  CL**2
00095          MOVE LITERAL-1 TO SCAN-FIELD (LEN-P)                        CL**2
00096      ELSE                                                            CL**2
00097          MOVE QUOTE TO SCAN-FIELD (LEN-P).                           CL**2
00098  FLOAT-QUOTE-XIT.                                                    CL**2
00099      EXIT.                                                           CL**2
00100 *                                                                    CL**2
00101 *    CHANGE A DASH TO AN UNDERSCORE CHARACTER                        CL**2
00102 *                                                                    CL**2
00103  REMOVE-HYPHEN.                                                      CL**2
00104      MOVE 1 TO LEN-P.                                                CL**2
00105  HYPHEN-LOOP.                                                        CL**2
00106      IF SCAN-FIELD (LEN-P) EQUAL TO "-"                              CL**2
00107          MOVE "_" TO SCAN-FIELD (LEN-P).                             CL**2
00108      ADD 1 TO LEN-P.                                                 CL**2
00109      IF LEN-P GREATER THAN 80                                        CL**2
00110          GO TO REMOVE-HYPHEN-XIT.                                    CL**2
00111      GO TO HYPHEN-LOOP.                                              CL**2
00112  REMOVE-HYPHEN-XIT.                                                  CL**2
00113      EXIT.                                                           CL**2
00114 *                                                                    CL**2
00115 *    CLEAR LEADING ZERO FROM LEVEL NUMBER                            CL**2
00116 *                                                                    CL**2
00117  CLEAR-LEAD-ZERO.                                                    CL**2
00118      MOVE 1 TO LEN-P.                                                CL**2
00119  ZERO-LOOP.                                                          CL**2
00120      IF SCAN-FIELD (LEN-P) EQUAL TO SPACES                           CL**2
00121          ADD 1 TO LEN-P                                              CL**2
00122          GO TO ZERO-LOOP.                                            CL**2
00123  NUMBER-LOOP.                                                        CL**2
00124      IF SCAN-FIELD (LEN-P) NOT NUMERIC                               CL**2
00125          ADD 1 TO LEN-P                                              CL**2
00126          GO TO NUMBER-LOOP.                                          CL**2
00127      IF SCAN-FIELD (LEN-P) NOT EQUAL TO ZERO                         CL**2
00128          GO TO CLEAR-LEAD-ZERO-XIT.                                  CL**2
00129      ADD 1 TO LEN-P.                                                 CL**2
00130      MOVE SCAN-FIELD (LEN-P) TO OUT-CHAR (1).                        CL**2
00131      MOVE SPACE TO SCAN-FIELD (LEN-P).                               CL**2
00132      SUBTRACT 1 FROM LEN-P.                                          CL**2
00133      MOVE OUT-CHAR (1) TO SCAN-FIELD (LEN-P).                        CL**2
00134      MOVE SPACES TO OUT-CHAR (1)                                     CL**2
00135      MOVE SPACE TO HOLD-PUSE.                                        CL**2
00136  CLEAR-LEAD-ZERO-XIT.                                                CL**2
00137      EXIT.                                                           CL**2
00138 *****************************************************************    CL**2
00139 *     INSERT PREFIX IF INDICATED                                     CL**2
00140 ****************************************************************     CL**2
00141  INSERT-PREFIX.                                                      CL**2
00142      MOVE SPACES TO WORK-DATA-NAME.                                  CL**2
00143      IF GTBL-OPT-SUFFIX1 NOT EQUAL TO SPACES                         CL**2
00144          MOVE 0 TO SUB1, SUB2                                        CL**2
00145          MOVE GTBL-OPT-SUFFIX1 TO WORK-DATA-NAME                     CL**2
00146          GO TO INSERT-SUFFIX.                                        CL**2
00147      IF GTBL-OPT-PREFIX1 EQUAL TO SPACES                             CL**2
00148          MOVE WS-DATA-NAME TO WORK-DATA-NAME                         CL**2
00149          GO TO INSERT-PREFIX-XIT.                                    CL**2
00150      MOVE GTBL-OPT-PREFIX1 TO WORK-DATA-NAME.                        CL**2
00151      MOVE 01 TO SUB1.                                                CL**2
00152  PREFIX-LOOP.                                                        CL**2
00153      ADD 1 TO SUB1.                                                  CL**2
00154      IF SUB1 GREATER THAN 9                                          CL**2
00155          GO TO DATA-NAME-BUILD.                                      CL**2
00156      IF WS-DN (SUB1) NOT EQUAL TO SPACE                              CL**2
00157          GO TO PREFIX-LOOP.                                          CL**2
00158  DATA-NAME-BUILD.                                                    CL**2
00159      SUBTRACT 1 FROM SUB1.                                           CL**2
00160      MOVE 01 TO SUB2.                                                CL**2
00161  BUILD-LOOP.                                                         CL**2
00162      ADD 1 TO SUB1.                                                  CL**2
00163      IF SUB1 GREATER THAN 32                                         CL**2
00164          GO TO INSERT-PREFIX-XIT.                                    CL**2
00165      MOVE WORK-DN (SUB2) TO WS-DN (SUB1).                            CL**2
00166      ADD 1 TO SUB2.                                                  CL**2
00167      IF WORK-DN (SUB2) NOT EQUAL TO SPACES                           CL**2
00168          GO TO BUILD-LOOP.                                           CL**2
00169      GO TO INSERT-PREFIX-XIT.                                        CL**2
00170  INSERT-SUFFIX.                                                      CL**2
00171      ADD 1 TO SUB1.                                                  CL**2
00172      IF WORK-DN (SUB1) NOT EQUAL TO SPACES                           CL**2
00173          GO TO INSERT-SUFFIX.                                        CL**2
00174  SUFFIX-LENGTH.                                                      CL**2
00175      ADD 1 TO SUB2.                                                  CL**2
00176      IF WS-DN (SUB2) NOT EQUAL TO SPACES                             CL**2
00177          GO TO SUFFIX-LENGTH.                                        CL**2
00178      SUBTRACT 1 FROM SUB1, SUB2.                                     CL**2
00179  CALC-TOTAL-LENGTH.                                                  CL**2
00180      ADD SUB1 TO SUB2.                                               CL**2
00181      IF SUB2 GREATER THAN 32                                         CL**2
00182          MOVE 0 TO SUB2                                              CL**2
00183          SUBTRACT 1 FROM SUB1                                        CL**2
00184          GO TO CALC-TOTAL-LENGTH.                                    CL**2
00185      MOVE 1 TO SUB2.                                                 CL**2
00186  SUFFIX-LOOP.                                                        CL**2
00187      ADD 1 TO SUB1.                                                  CL**2
00188      MOVE WS-DN (SUB2) TO WORK-DN (SUB1).                            CL**2
00189      ADD 1 TO SUB2.                                                  CL**2
00190      IF WS-DN (SUB2) EQUAL TO SPACES                                 CL**2
00191          MOVE WS-DATA-NAME TO WORK-DATA-NAME                         CL**2
00192          GO TO INSERT-PREFIX-XIT.                                    CL**2
00193      GO TO SUFFIX-LOOP.                                              CL**2
00194  INSERT-PREFIX-XIT.                                                  CL**2
00195      EXIT.                                                           CL**2
00196 *****************************************************************    CL**2
00197 *     READ AND PROCESS COMMENT LINES                                 CL**2
00198 ******************************************************************   CL**2
00199  CHECK-COMMENT.                                                      CL**2
00200      IF CAT-COMMENT NOT EQUAL "*"                                    CL**2
00201          GO TO CHECK-COMMENT-XIT.                                    CL**2
00202      IF DATA-ENTRY-CAT NOT EQUAL "300"                               CL**2
00203          GO TO GET-NEXT-LINE.                                        CL**2
00204      IF DES-NOTES-SWITCH EQUAL TO "Y"                                CL**2
00205          GO TO GET-NEXT-LINE.                                        CL**2
00206      IF GTBL-OPT-COMMENT NOT EQUAL "Y"                               CL**2
00207          GO TO GET-NEXT-LINE.                                        CL**2
00208      IF SCAN-AREA NOT EQUAL SPACES                                   CL**2
00209          PERFORM FLOAT-SEMI THRU FLOAT-SEMI-XIT                      CL**2
00210          PERFORM PERFORM-STATE4 THRU PERFORM-STATE-XIT.              CL**2
00211      MOVE MINUS-ASTER TO COMMENT-AREA2.                              CL**2
00212      MOVE DESCRIPT-COMMENTS TO SCAN-AREA.                            CL**2
00213      PERFORM CLEAR-SPACES THRU CLEAR-SPACES-XIT.                     CL**2
00214      PERFORM PERFORM-STATE4 THRU PERFORM-STATE-XIT.                  CL**2
00215  GET-NEXT-LINE.                                                      CL**2
00216      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00217      IF DATA-RETURN-CODE EQUAL TO 0                                  CL**2
00218          GO TO CHECK-COMMENT.                                        CL**2
00219  CHECK-COMMENT-XIT.                                                  CL**2
00220      EXIT.                                                           CL**2
00221 *                                                                    CL**2
00222 *    TEST RETURN CODE---CHECK FOR COMMENT                            CL**2
00223 *                                                                    CL**2
00224  TEST-RETURN-CODE.                                                   CL**2
00225      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00226          GO TO TEST-RETURN-CODE-XIT.                                 CL**2
00227      PERFORM CHECK-COMMENT THRU CHECK-COMMENT-XIT.                   CL**2
00228  TEST-RETURN-CODE-XIT.                                               CL**2
00229      EXIT.                                                           CL**2
00230 *****************************************************************    CL**2
00231 *     INITIALIZE COBOL LEEEL NUMBERS                                 CL**2
00232 *****************************************************************    CL**2
00233  LEVEL-INIT.                                                         CL**2
00234      MOVE GTBL-OPT-LEVEL TO LEVEL-1.                                 CL**2
00235      ADD GTBL-OPT-INCLEV LEVEL-1 GIVING LEVEL-2.                     CL**2
00236      ADD GTBL-OPT-INCLEV LEVEL-2 GIVING LEVEL-3.                     CL**2
00237      ADD GTBL-OPT-INCLEV LEVEL-3 GIVING LEVEL-4.                     CL**2
00238      ADD GTBL-OPT-INCLEV LEVEL-4 GIVING LEVEL-5.                     CL**2
00239      ADD GTBL-OPT-INCLEV LEVEL-5 GIVING LEVEL-6.                     CL**2
00240      ADD GTBL-OPT-INCLEV LEVEL-6 GIVING LEVEL-7.                     CL**2
00241      ADD GTBL-OPT-INCLEV LEVEL-7 GIVING LEVEL-8.                     CL**2
00242      ADD GTBL-OPT-INCLEV LEVEL-8 GIVING LEVEL-9.                     CL**2
00243      ADD GTBL-OPT-INCLEV LEVEL-9 GIVING LEVEL-10.                    CL**2
00244  LEVEL-INIT-XIT.                                                     CL**2
00245      EXIT.                                                           CL**2
00246 *****************************************************************    CL**2
00247 *     INDENT LEVEL NO AND NAME FOR CURRENT LEVEL                     CL**2
00248 *****************************************************************    CL**2
00249  LAYOUT-PCH-CARD.                                                    CL**2
00250      MOVE SPACES TO LEVEL-CARD-IMAGE.                                CL**2
00251      IF GROUP-SUB EQUAL TO 0                                         CL**2
00252          MOVE WORK-DATA-NAME TO PLC-NAME2                            CL**2
00253          MOVE LEVEL-2 TO PLC-02.                                     CL**2
00254      IF GROUP-SUB EQUAL TO 1                                         CL**2
00255          MOVE WORK-DATA-NAME TO PLC-NAME3                            CL**2
00256          MOVE LEVEL-3 TO PLC-03.                                     CL**2
00257      IF GROUP-SUB EQUAL TO 2                                         CL**2
00258          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00259          MOVE LEVEL-4 TO PLC-04.                                     CL**2
00260      IF GROUP-SUB EQUAL TO 3                                         CL**2
00261          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00262          MOVE LEVEL-5 TO PLC-04.                                     CL**2
00263      IF GROUP-SUB EQUAL TO 4                                         CL**2
00264          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00265          MOVE LEVEL-6 TO PLC-04.                                     CL**2
00266      IF GROUP-SUB EQUAL TO 5                                         CL**2
00267          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00268          MOVE LEVEL-7 TO PLC-04.                                     CL**2
00269      IF GROUP-SUB EQUAL TO 6                                         CL**2
00270          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00271          MOVE LEVEL-8 TO PLC-04.                                     CL**2
00272      IF GROUP-SUB EQUAL TO 7                                         CL**2
00273          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00274          MOVE LEVEL-9 TO PLC-04.                                     CL**2
00275      IF GROUP-SUB EQUAL TO 8                                         CL**2
00276          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00277          MOVE LEVEL-10 TO PLC-04.                                    CL**2
00278      IF GROUP-SUB EQUAL TO 9                                         CL**2
00279          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00280          MOVE LEVEL-11 TO PLC-04.                                    CL**2
00281      IF GROUP-SUB EQUAL TO 10                                        CL**2
00282          MOVE WORK-DATA-NAME TO PLC-NAME4                            CL**2
00283          MOVE LEVEL-12 TO PLC-04.                                    CL**2
00284  LAYOUT-PCH-CARD-XIT.                                                CL**2
00285      EXIT.                                                           CL**2
00286 *****************************************************************    CL**2
00287 *     PROCESS FILLER STATEMENT                                       CL**2
00288 *     FORMATS LEVEL NUMBERS AND PICTURE                              CL**2
00289 *****************************************************************    CL**2
00290  PROC-FILLER.                                                        CL**2
00291      ADD 1 TO FILLER-NUMBER.                                         CL**2
00292      IF GROUP-SUB EQUAL TO 0                                         CL**2
00293          MOVE FILLER-FORM TO PLC-NAME2                               CL**2
00294          MOVE LEVEL-2 TO PLC-02.                                     CL**2
00295      IF GROUP-SUB EQUAL TO 1                                         CL**2
00296          MOVE FILLER-FORM TO PLC-NAME3                               CL**2
00297          MOVE LEVEL-3 TO PLC-03.                                     CL**2
00298      IF GROUP-SUB EQUAL TO 2                                         CL**2
00299          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00300          MOVE LEVEL-4 TO PLC-04.                                     CL**2
00301      IF GROUP-SUB EQUAL TO 3                                         CL**2
00302          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00303          MOVE LEVEL-5 TO PLC-04.                                     CL**2
00304      IF GROUP-SUB EQUAL TO 4                                         CL**2
00305          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00306          MOVE LEVEL-6 TO PLC-04.                                     CL**2
00307      IF GROUP-SUB EQUAL TO 5                                         CL**2
00308          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00309          MOVE LEVEL-7 TO PLC-04.                                     CL**2
00310      IF GROUP-SUB EQUAL TO 6                                         CL**2
00311          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00312          MOVE LEVEL-8 TO PLC-04.                                     CL**2
00313      IF GROUP-SUB EQUAL TO 7                                         CL**2
00314          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00315          MOVE LEVEL-9 TO PLC-04.                                     CL**2
00316      IF GROUP-SUB EQUAL TO 8                                         CL**2
00317          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00318          MOVE LEVEL-10 TO PLC-04.                                    CL**2
00319      IF GROUP-SUB EQUAL TO 9                                         CL**2
00320          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00321          MOVE LEVEL-11 TO PLC-04.                                    CL**2
00322      IF GROUP-SUB EQUAL TO 10                                        CL**2
00323          MOVE FILLER-FORM TO PLC-NAME4                               CL**2
00324          MOVE LEVEL-12 TO PLC-04.                                    CL**2
           IF STC-FILL-LEN EQUAL ZERO OR SPACES 
00326          MOVE "1" TO STC-SR-FILL-LEN.                                CL**2
           MOVE SAVE-ELE-STC-FILL-LEN TO STR-FILLER-LEN.
00328      MOVE CHARACTER-KW TO FORMAT-MOVE.                               CL**2
00329      PERFORM CLEAR-LEAD-ZERO THRU CLEAR-LEAD-ZERO-XIT.               CL**2
00330      PERFORM MOVE-RIGHT-PAREN THRU MOVE-RIGHT-PAREN-XIT.             CL**2
00331      PERFORM SQUEEZE-LENGTH THRU SQUEEZE-LENGTH-XIT.                 CL**2
00332  PROC-FILLER-XIT.                                                    CL**2
00333      EXIT.                                                           CL**2
00334 *                                                                    CL**2
00335 *    CHECK FORMAT CODES AND PROCESS ACCORDINGLY                      CL**2
00336 *                                                                    CL**2
00337  FORMAT-FIELD.                                                       CL**2
00338      IF ELE-FORMAT EQUAL TO "C" OR "H" OR "O"                        CL**2
00339          MOVE "CHAR(" TO FILL-CHAR                                   CL**2
00340          MOVE ELE-LENGTH TO FILL-CHAR-LENGTH                         CL**2
00341          MOVE HOLD-FORMAT TO FORMAT-MOVE                             CL**2
00342          PERFORM MOVE-RIGHT-PAREN THRU MOVE-RIGHT-PAREN-XIT          CL**2
00343          GO TO FORMAT-FIELD-XIT.                                     CL**2
00344      IF ELE-FORMAT EQUAL TO "F"                                      CL**2
00345          MOVE ELE-LENGTH TO FLENGTH                                  CL**2
00346          GO TO FORMAT-LENGTH-MOVE.                                   CL**2
00347      IF ELE-FORMAT EQUAL TO "N"                                      CL**2
00348          MOVE ELE-LENGTH TO PICTURE-VALUE                            CL**2
00349          MOVE PICTURE-KW TO FORMAT-MOVE                              CL**2
00350          MOVE "X" TO COMMA-SW                                        CL**2
00351          PERFORM FLOAT-SEMI THRU FLOAT-SEMI-XIT                      CL**2
00352          PERFORM FLOAT-QUOTE THRU FLOAT-QUOTE-XIT                    CL**2
00353          GO TO FORMAT-FIELD-XIT.                                     CL**2
00354      IF ELE-FORMAT EQUAL TO "B"                                      CL**2
00355          MOVE ELE-LENGTH TO BLENGTH                                  CL**2
00356          GO TO FORMAT-LENGTH-MOVE.                                   CL**2
00357      IF ELE-FORMAT EQUAL TO "P"                                      CL**2
00358          MOVE ELE-LENGTH TO PLENGTH.                                 CL**2
00359  FORMAT-LENGTH-MOVE.                                                 CL**2
00360      IF ELE-FORMAT EQUAL TO "F"                                      CL**2
00361          MOVE FLOAT-DECIMALKW TO FORMAT-MOVE.                        CL**2
00362      IF ELE-FORMAT EQUAL TO "B"                                      CL**2
00363          MOVE BINARY-KW TO FORMAT-MOVE.                              CL**2
00364      IF ELE-FORMAT EQUAL TO "P"                                      CL**2
00365          MOVE PACKED-DECIMALKW TO FORMAT-MOVE.                       CL**2
00366      IF ELE-FORMAT EQUAL TO "N"                                      CL**2
00367          MOVE PICTURE-KW TO FORMAT-MOVE.                             CL**2
00368      IF ELE-FORMAT EQUAL TO "F" OR "B" OR "P"                        CL**2
00369          PERFORM MOVE-RIGHT-PAREN THRU MOVE-RIGHT-PAREN-XIT.         CL**2
00370  FORMAT-FIELD-XIT.                                                   CL**2
00371      EXIT.                                                           CL**2
00372 *                                                                    CL**2
00373 *    PLACE RIGHT PARENTHESIS AROUND APPROPRIATE FIELDS               CL**2
00374 *                                                                    CL**2
00375  MOVE-RIGHT-PAREN.                                                   CL**2
00376      MOVE "X" TO COMMA-SW.                                           CL**2
00377      PERFORM FLOAT-SEMI THRU FLOAT-SEMI-XIT.                         CL**2
00378      MOVE "Y" TO COMMA-SW.                                           CL**2
00379  MOVE-RIGHT-PAREN-XIT.                                               CL**2
00380      EXIT.                                                           CL**2
00381 *                                                                    CL**2
00382 *    CALCULATE THE LENGTH OF ANY FIELD                               CL**2
00383 *                                                                    CL**2
00384  GET-PIC-LENGTH.                                                     CL**2
00385      IF SCAN-SW EQUAL TO "Y"                                         CL**2
00386          MOVE "N" TO SCAN-SW                                         CL**2
00387          GO TO GET-PIC-LENGTH2.                                      CL**2
00388      IF SCAN-FIELD (LEN-P) EQUAL TO SPACES                           CL**2
00389          SUBTRACT 1 FROM LEN-P                                       CL**2
00390          GO TO GET-PIC-LENGTH.                                       CL**2
00391      GO TO GET-PIC-LENGTH-XIT.                                       CL**2
00392  GET-PIC-LENGTH2.                                                    CL**2
00393      IF SCAN-FIELD2 (LEN-P) EQUAL TO SPACES                          CL**2
00394          SUBTRACT 1 FROM LEN-P                                       CL**2
00395          GO TO GET-PIC-LENGTH2.                                      CL**2
00396  GET-PIC-LENGTH-XIT.                                                 CL**2
00397      EXIT.                                                           CL**2
00398 *                                                                    CL**2
00399 *    PROCESS INITIAL VALUE---TEST IF EQUAL TO SPACES OR ZEROS        CL**2
00400 *        OR HIGH-VALUES OR LOW-VALUES--ALSO CHECK FOR INITIAL        CL**2
00401 *        VALUE BEING LONGER THAN 25 CHARACTERS                       CL**2
00402 *                                                                    CL**2
00403  VALUE-CLAUSE.                                                       CL**2
00404      MOVE ELE-INT-VALUE TO INITIAL-VALUE-IMAGE.                      CL**2
00405      IF WORD-1 NOT EQUAL TO "NEXT"                                   CL**2
00406          GO TO TEST-SPECIFICS.                                       CL**2
00407      IF WORD-3 NOT EQUAL TO "LINES DEFINE"                           CL**2
00408          GO TO TEST-SPECIFICS.                                       CL**2
00409      GO TO INITIAL-ALPHA.                                            CL**2
00410  TEST-SPECIFICS.                                                     CL**2
00411      MOVE SPACES TO SCAN-AREA2.                                      CL**2
00412      MOVE 1 TO SUB1, SUB2.                                           CL**2
00413      MOVE ELE-INT-VALUE TO SCAN-AREA2.                               CL**2
00414      PERFORM FIND-NUMERIC THRU FIND-NUMERIC-XIT.                     CL**2
00415      IF XKW EQUAL TO "Y"                                             CL**2
00416          MOVE "A" TO INIT-SW                                         CL**2
00417          GO TO TEST-INIT-ZERO.                                       CL**2
00418      IF ELE-INT-VALUE EQUAL TO "SPACES" OR "SPACE"                   CL**2
00419          MOVE "X" TO INIT-SW                                         CL**2
00420          GO TO TEST-INIT-ZERO.                                       CL**2
00421      IF ELE-INT-VALUE EQUAL TO "ZERO" OR "ZEROS" OR "ZEROES"         CL**2
00422          GO TO TEST-INIT-ZERO.                                       CL**2
00423      IF ELE-INT-VALUE EQUAL TO "HIGH-VALUE" OR "HIGH-VALUES"         CL**2
00424          MOVE "X" TO INIT-SW                                         CL**2
00425          GO TO TEST-INIT-HIGH.                                       CL**2
00426      IF ELE-INT-VALUE EQUAL TO "LOW-VALUE" OR "LOW-VALUES"           CL**2
00427          GO TO TEST-INIT-HIGH.                                       CL**2
00428      IF ELE-INT-VALUE EQUAL TO "QUOTE" OR "QUOTES"                   CL**2
00429          GO TO TEST-INIT-QUOTE.                                      CL**2
00430      GO TO INITIAL-ALPHA.                                            CL**2
00431  TEST-INIT-ZERO.                                                     CL**2
00432      IF SAVE-ELE-STC-OCC-TO NOT EQUAL TO SPACES                      CL**2
00433          GO TO MOVE-ZERO-SPACE.                                      CL**2
00434      IF INIT-SW EQUAL TO "A"                                         CL**2
00435          MOVE ELE-INT-VALUE TO INITIALVAL                            CL**2
00436          PERFORM MOVE-RIGHT-PAREN THRU MOVE-RIGHT-PAREN-XIT          CL**2
00437          GO TO VALUE-CLAUSE-XIT.                                     CL**2
00438      IF INIT-SW EQUAL TO "X"                                         CL**2
00439          MOVE INITIAL-SPACE TO INITIALVAL                            CL**2
00440      ELSE                                                            CL**2
00441          MOVE "0" TO INITIALVAL.                                     CL**2
00442      PERFORM MOVE-RIGHT-PAREN THRU MOVE-RIGHT-PAREN-XIT.             CL**2
00443      MOVE "A" TO INIT-SW.                                            CL**2
00444      GO TO VALUE-CLAUSE-XIT.                                         CL**2
00445  MOVE-ZERO-SPACE.                                                    CL**2
00446      IF INIT-SW EQUAL TO "X"                                         CL**2
00447          MOVE OCCURTOKW TO INIT-OCC-TO                               CL**2
00448          MOVE INITIAL-OCC-SPACE TO SCAN-AREA2                        CL**2
00449      ELSE                                                            CL**2
00450          MOVE OCCURTOKW TO INIT-TO                                   CL**2
00451          MOVE INITIAL-ZERO TO SCAN-AREA2.                            CL**2
00452      PERFORM CLEAR-LINE-SPACE THRU CLEAR-LINE-SPACE-XIT.             CL**2
00453      MOVE SCAN-AREA2 TO INITIALVAL.                                  CL**2
00454      MOVE "A" TO INIT-SW.                                            CL**2
00455      GO TO VALUE-CLAUSE-XIT.                                         CL**2
00456  TEST-INIT-HIGH.                                                     CL**2
00457      MOVE SPACES TO INITIALKW.                                       CL**2
00458      IF INIT-SW EQUAL TO "X"                                         CL**2
00459          MOVE "FFFFFFFF" TO FILLER-HIGH                              CL**2
00460      ELSE                                                            CL**2
00461          MOVE "00000000" TO FILLER-HIGH.                             CL**2
00462      MOVE HIGH-BIT-KW TO INIT-HIGH-KW.                               CL**2
00463      MOVE "A" TO INIT-SW.                                            CL**2
00464      GO TO VALUE-CLAUSE-XIT.                                         CL**2
00465  TEST-INIT-QUOTE.                                                    CL**2
00466      MOVE SPACES TO INITIALKW.                                       CL**2
00467      MOVE QUOTE-INIT-VALUE TO INIT-HIGH-KW.                          CL**2
00468      MOVE "A" TO INIT-SW.                                            CL**2
00469      GO TO VALUE-CLAUSE-XIT.                                         CL**2
00470  INITIAL-ALPHA.                                                      CL**2
00471      IF SAVE-ELE-STC-OCC-TO EQUAL TO SPACES                          CL**2
00472          MOVE ELE-INT-VALUE TO ALPHA-INIT                            CL**2
00473          MOVE INITIAL-ALPHA-CHAR TO INITIALVAL                       CL**2
00474          PERFORM FLOAT-QUOTE THRU FLOAT-QUOTE-XIT                    CL**2
00475      PERFORM MOVE-RIGHT-PAREN THRU MOVE-RIGHT-PAREN-XIT              CL**2
00476          MOVE "A" TO INIT-SW                                         CL**2
00477          GO TO VALUE-CLAUSE-XIT.                                     CL**2
00478      MOVE SAVE-ELE-STC-OCC-TO TO INIT-OCC-ALPHA.                     CL**2
00479      MOVE ELE-INT-VALUE TO INIT-OCC-CHAR.                            CL**2
00480      MOVE INITIAL-OCC-ANY TO INITIALVAL.                             CL**2
00481      PERFORM FLOAT-QUOTE THRU FLOAT-QUOTE-XIT.                       CL**2
00482      PERFORM MOVE-RIGHT-PAREN THRU MOVE-RIGHT-PAREN-XIT.             CL**2
00483      MOVE "A" TO INIT-SW.                                            CL**2
00484  VALUE-CLAUSE-XIT.                                                   CL**2
00485      EXIT.                                                           CL**2
00486  FIND-NUMERIC.                                                       CL**2
00487      MOVE "X" TO XKW.                                                CL**2
00488      IF SCAN-FIELD2 (SUB1) NOT EQUAL TO SPACES                       CL**2
00489          ADD 1 TO SUB1                                               CL**2
00490          GO TO FIND-NUMERIC.                                         CL**2
00491      ADD 1 TO SUB1.                                                  CL**2
00492      IF SCAN-FIELD2 (SUB1) EQUAL TO SPACES                           CL**2
00493          SUBTRACT 2 FROM SUB1                                        CL**2
00494          GO TO NUMERIC-LOOP.                                         CL**2
00495      GO TO FIND-NUMERIC-XIT.                                         CL**2
00496  NUMERIC-LOOP.                                                       CL**2
00497      IF SCAN-FIELD2 (SUB2) NOT NUMERIC                               CL**2
00498          GO TO FIND-NUMERIC-XIT.                                     CL**2
00499      ADD 1 TO SUB2.                                                  CL**2
00500      IF SUB2 GREATER THAN SUB1                                       CL**2
00501          MOVE "Y" TO XKW                                             CL**2
00502          GO TO FIND-NUMERIC-XIT.                                     CL**2
00503      GO TO NUMERIC-LOOP.                                             CL**2
00504  FIND-NUMERIC-XIT.                                                   CL**2
00505      EXIT.                                                           CL**2
00506 *                                                                    CL**2
00507 *    CLEAR ALL SPACES FROM A FIELD                                   CL**2
00508 *                                                                    CL**2
00509  CLEAR-LINE-SPACE.                                                   CL**2
00510      MOVE 1 TO SUB1, SUB2.                                           CL**2
00511      MOVE SPACES TO CHARACTER-OUT.                                   CL**2
00512  CLEAR-LINE-LOOP.                                                    CL**2
00513      IF SUB1 GREATER THAN 80                                         CL**2
00514          MOVE CHARACTER-OUT TO SCAN-AREA2                            CL**2
00515          GO TO CLEAR-LINE-SPACE-XIT.                                 CL**2
00516      IF SCAN-FIELD2 (SUB1) EQUAL TO QUOTE                            CL**2
00517          MOVE SCAN-FIELD2 (SUB1) TO OUT-CHAR (SUB2)                  CL**2
00518          ADD 1 TO SUB1, SUB2                                         CL**2
00519          GO TO CLEAR-QUOTE.                                          CL**2
00520      IF SCAN-FIELD2 (SUB1) NOT EQUAL TO SPACES                       CL**2
00521          MOVE SCAN-FIELD2 (SUB1) TO OUT-CHAR (SUB2)                  CL**2
00522          ADD 1 TO SUB1, SUB2                                         CL**2
00523          GO TO CLEAR-LINE-LOOP.                                      CL**2
00524      ADD 1 TO SUB1.                                                  CL**2
00525      GO TO CLEAR-LINE-LOOP.                                          CL**2
00526  CLEAR-QUOTE.                                                        CL**2
00527      IF SUB1 GREATER THAN 80                                         CL**2
00528          MOVE CHARACTER-OUT TO SCAN-AREA2                            CL**2
00529          GO TO CLEAR-LINE-SPACE-XIT.                                 CL**2
00530      IF SCAN-FIELD2 (SUB1) EQUAL TO QUOTE                            CL**2
00531          MOVE SCAN-FIELD2 (SUB1) TO OUT-CHAR (SUB2)                  CL**2
00532          ADD 1 TO SUB1, SUB2                                         CL**2
00533          GO TO CLEAR-LINE-LOOP.                                      CL**2
00534      MOVE SCAN-FIELD2 (SUB1) TO OUT-CHAR (SUB2).                     CL**2
00535      ADD 1 TO SUB1, SUB2.                                            CL**2
00536      GO TO CLEAR-QUOTE.                                              CL**2
00537  CLEAR-LINE-SPACE-XIT.                                               CL**2
00538      EXIT.                                                           CL**2
00539 ******************************************************************   CL**2
00540 *                                                                    CL**2
00541 *    GENERATION OF DESCRIPTION CATEGORY COMMENTS                     CL**2
00542 *    IF NOTESFROM OR NOTESTO OR NOTESFOR OPTION USED                 CL**2
00543 *        THEN GENERATION FROM DESCRIPTION CATEGORY IS WANTED         CL**2
00544 *                                                                    CL**2
00545 ******************************************************************   CL**2
00546  CHECK-DESCRIPTION.                                                  CL**2
00547      MOVE SPACES TO HOLD-CARD-IMAGE.                                 CL**2
00548      MOVE "N" TO DES-NOTES-SWITCH.                                   CL**2
00549      IF GTBL-OPT-COMMENT EQUAL TO "N"                                CL**2
00550          GO TO CHECK-DESCRIPTION-XIT.                                CL**2
00551      IF GTBL-OPT-NOTESFROM NOT EQUAL TO ZERO                         CL**2
00552          GO TO INITIAL-NOTES.                                        CL**2
00553      IF GTBL-OPT-NOTESTO NOT EQUAL TO ZERO                           CL**2
00554          GO TO INITIAL-NOTES.                                        CL**2
00555      IF GTBL-OPT-NOTESFOR NOT EQUAL TO ZERO                          CL**2
00556          GO TO INITIAL-NOTES.                                        CL**2
00557      GO TO CHECK-DESCRIPTION-XIT.                                    CL**2
00558  INITIAL-NOTES.                                                      CL**2
00559      MOVE "Y" TO DES-NOTES-SWITCH.                                   CL**2
00560      IF GTBL-OPT-NOTESFROM EQUAL TO ZEROS                            CL**2
00561          MOVE 1 TO NOTES-FROM-HOLD       ELSE                        CL**2
00562          MOVE GTBL-OPT-NOTESFROM TO NOTES-FROM-HOLD.                 CL**2
00563      IF GTBL-OPT-NOTESTO EQUAL TO ZEROS                              CL**2
00564          MOVE 9999 TO NOTES-TO-HOLD       ELSE                       CL**2
00565          MOVE GTBL-OPT-NOTESTO TO NOTES-TO-HOLD.                     CL**2
00566      IF GTBL-OPT-NOTESFOR EQUAL TO ZEROS                             CL**2
00567          MOVE 9999 TO NOTES-FOR-HOLD       ELSE                      CL**2
00568          MOVE GTBL-OPT-NOTESFOR TO NOTES-FOR-HOLD.                   CL**2
00569      MOVE 1 TO CAT-LINE-COUNTER.                                     CL**2
00570      MOVE DES-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00571      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00572  RETURN-CODE-INITIAL.                                                CL**2
00573      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00574          GO TO CHECK-DESC-SW.                                        CL**2
00575 *                                                                    CL**2
00576 *    CHECK DESCRIPTION LINE NUMBER FOR QUALIFICATION                 CL**2
00577 *                                                                    CL**2
00578      IF CAT-LINE LESS THAN NOTES-FROM-HOLD                           CL**2
00579          GO TO READ-NEXT-DESC-LINE.                                  CL**2
00580      IF CAT-LINE-COUNTER GREATER THAN NOTES-FOR-HOLD                 CL**2
00581          GO TO CHECK-DESC-SW.                                        CL**2
00582      IF CAT-LINE GREATER THAN NOTES-TO-HOLD                          CL**2
00583          GO TO CHECK-DESC-SW.                                        CL**2
00584      PERFORM PLC-OUT THRU PLC-OUT-XIT.                               CL**2
00585      MOVE CAT-DETAIL TO COMMENT-AREA2.                               CL**2
00586      MOVE DESCRIPT-COMMENTS TO SCAN-AREA.                            CL**2
00587      PERFORM CLEAR-SPACES THRU CLEAR-SPACES-XIT.                     CL**2
00588      MOVE SCAN-AREA TO HOLD-CARD-IMAGE.                              CL**2
00589      PERFORM PLC-OUT THRU PLC-OUT-XIT.                               CL**2
00590      MOVE "N" TO ON-COND.                                            CL**2
00591      ADD 1 TO CAT-LINE-COUNTER.                                      CL**2
00592  READ-NEXT-DESC-LINE.                                                CL**2
00593      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00594      GO TO RETURN-CODE-INITIAL.                                      CL**2
00595  CHECK-DESC-SW.                                                      CL**2
00596      IF ON-COND EQUAL TO "N"                                         CL**2
00597          MOVE "Y" TO ON-COND                                         CL**2
00598          MOVE SPACES TO HOLD-CARD-IMAGE                              CL**2
00599          PERFORM PLC-OUT THRU PLC-OUT-XIT.                           CL**2
00600  CHECK-DESCRIPTION-XIT.                                              CL**2
00601      EXIT.                                                           CL**2
00602  FLOAT-PERIOD.                                                       CL**2
00603  FLOAT-PERIOD-XIT.                                                   CL**2
00604  SQUEEZE-LENGTH.                                                     CL**2
00605      MOVE FORMAT-MOVE TO SCAN-AREA2.                                 CL**2
00606      MOVE SPACES TO CHARACTER-OUT.                                   CL**2
00607      MOVE 1 TO SUB1 SUB2.                                            CL**2
00608  FIND-PAREN.                                                         CL**2
00609      IF SCAN-FIELD2 (SUB1) NOT EQUAL "("                             CL**2
00610          MOVE SCAN-FIELD2 (SUB1) TO OUT-CHAR (SUB2)                  CL**2
00611          ADD 1 TO SUB1 SUB2                                          CL**2
00612          GO TO FIND-PAREN.                                           CL**2
00613      MOVE SCAN-FIELD2 (SUB1) TO OUT-CHAR (SUB2).                     CL**2
00614      ADD 1 TO SUB1, SUB2.                                            CL**2
00615  ZERO-OUT.                                                           CL**2
           IF SCAN-FIELD2 (SUB1) EQUAL ZERO OR SPACES 
00617          ADD 1 TO SUB1                                               CL**2
00618          GO TO ZERO-OUT.                                             CL**2
00619  FINISH-IT.                                                          CL**2
00620      MOVE SCAN-FIELD2 (SUB1) TO OUT-CHAR (SUB2).                     CL**2
00621      ADD 1 TO SUB1 SUB2.                                             CL**2
           IF SUB1 > 27 
00623          MOVE CHARACTER-OUT TO FORMAT-MOVE                           CL**2
00624          GO TO SQUEEZE-LENGTH-XIT.                                   CL**2
00625      GO TO FINISH-IT.                                                CL**2
00626  SQUEEZE-LENGTH-XIT.                                                 CL**2
00627      EXIT.                                                           CL**2
00628                                                                    PL1SUB 
