*DECK     DCRETS
00001  IDENTIFICATION DIVISION.                                         06/26/78
       PROGRAM-ID.   RETS.
*CALL COPYRIGHT 
      * PERFORM INITIAL EDITS OF STATEMENT TYPE AND SEQUENCE
      * PRINT QUERY REQUEST (ONE COMMAND) 
      * TABLE COMMAND AND TITTLE
      * CALLS RPT001 FOR INITIALIZATION 
      * CALLS RPT010 TO EDIT REQUESTS 
      * CALLS RPT100 TO PROCESS COMMANDS
00010  ENVIRONMENT DIVISION.                                               CL**2
00011  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
*CALL OTHSN 
00014  INPUT-OUTPUT SECTION.                                               CL**2
00015  FILE-CONTROL.                                                       CL**2
           SELECT SYSINPUT ASSIGN TO "INPUT". 
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT REPORT-REQUESTS ASSIGN TO TEMP10 USE "RT=W".
00019  DATA DIVISION.                                                      CL**2
00020  FILE SECTION.                                                       CL**2
*CALL     RPTREQFD                                                         CL**2
00022  FD  SYSINPUT                                                        CL**2
00023      LABEL RECORDS ARE OMITTED                                       CL**2
00024      DATA RECORD IS TRANS-IN.                                        CL**2
00025  01  TRANS-IN.                                                       CL**2
00026      03  USER-STMT-IN            PICTURE X(72).                      CL**2
00027      03  STMT-SEQNO              PICTURE X(8).                       CL**2
*CALL     SYSPRTFD                                                         CL**2
*CALL RETSCS
00029  WORKING-STORAGE SECTION.                                            CL**2
00030  77  ERROR-CODE                  PICTURE XX.                         CL**2
00031  77  STORE-SUB                   PICTURE 99 COMP SYNC.               CL**2
00032  77  QRY-SUB                     PICTURE 9  COMP SYNC.               CL**2
00033  77  SUB1                        PICTURE 99 COMP SYNC.               CL**2
00034  77  SUB2                        PICTURE 99 COMP SYNC.               CL**2
00035  77  SUB3                        PICTURE 99 COMP SYNC.               CL**2
00036  77  END-SW                      PICTURE X VALUE " ".                CL**2
00037  77  EXTRACT-SW                  PICTURE X VALUE " ".                CL**2
00038  77  GENER-SWITCH                PICTURE X VALUE " ".                CL**2
00039  77  ERROR-REQUEST               PICTURE X VALUE "N".                CL**2
00040                                                                    DCRETS 
00041 *                                                                    CL**2
00042 *    REQUEST TRANSACTION                                             CL**2
00043 *                                                                    CL**2
00044  01  TRANS-WORK.                                                     CL**2
00045      03  QUERY-TRANS.                                                CL**2
00046          05  FIRST-TEN.                                              CL**2
00047            06  FIRST-EIGHT.                                          CL**2
00048              07  FIRST-SEVEN.                                        CL**2
00049                  09  FIRST-SIX.                                      CL**2
00050                      11  FIRST-FIVE.                                 CL**2
00051                          13  FIRST-FOUR.                             CL**2
00052                              15  BYTE-1  PICTURE X.                  CL**2
00053                              15  FILLER  PICTURE XXX.                CL**2
00054                          13  FILLER      PICTURE X.                  CL**2
00055                      11  FILLER          PICTURE X.                  CL**2
00056                  09  FILLER              PICTURE X.                  CL**2
00057              07  FILLER                  PICTURE X.                  CL**2
00058            06  FILLER                PICTURE XX.                     CL**2
00059          05  GENER-FILL              PICTURE X(62).                  CL**2
00060      03  CONTINUE-TRANS  REDEFINES  QUERY-TRANS.                     CL**2
00061          05  CONT-HEAD               PICTURE X.                      CL**2
00062          05  MOVE-CONT               PICTURE X(71).                  CL**2
00063      03  COMMAND-TRANS  REDEFINES  CONTINUE-TRANS.                   CL**2
00064          05  FILLER                  PICTURE X(5).                   CL**2
00065          05  BYTES6-72               PICTURE X(67).                  CL**2
00066          05  TITLE-WORK  REDEFINES  BYTES6-72                        CL**2
00067                                      PICTURE X OCCURS 67 TIMES.      CL**2
00068      03  COUNT-TRANS  REDEFINES  COMMAND-TRANS.                      CL**2
00069          05  FILLER                  PICTURE X(6).                   CL**2
00070          05  MOVE-C                  PICTURE X(66).                  CL**2
00071 *                                                                    CL**2
00072 *    MESSAGES TO APPEAR AT END OF PROCESSING                         CL**2
00073 *                                                                    CL**2
00074  01  TOTAL-MESSAGES.                                                 CL**2
00075      03  TOTAL-MESS-1.                                               CL**2
00076          05  FILLER              PICTURE X(36)   VALUE               CL**2
00077             "*** TOTAL QUERY COMMANDS ATTEMPTED= ".                  CL**2
00078          05  TOTAL-PROC          PICTURE ZZZ9.                       CL**2
00079      03  TOTAL-MESS-2.                                               CL**2
00080          05  FILLER              PICTURE X(15)   VALUE SPACES.       CL**2
00081          05  FILLER              PICTURE X(30)   VALUE               CL**2
00082             "*** TOTAL COMMANDS ACCEPTED=  ".                        CL**2
00083          05  TOTAL-ACC           PICTURE ZZZ9.                       CL**2
00084      03  TOTAL-MESS-3.                                               CL**2
00085          05  FILLER              PICTURE X(15)   VALUE SPACES.       CL**2
00086          05  FILLER              PICTURE X(30)   VALUE               CL**2
00087             "*** TOTAL COMMANDS REJECTED=  ".                        CL**2
00088          05  TOTAL-REJ           PICTURE ZZZ9.                       CL**2
00089      03  TOTAL-MESS-4            PICTURE X(44)   VALUE               CL**2
00090             "*** END DATA CATALOGUE RETRIEVAL REPORTS ***".          CL**2
00091      03  TOTAL-MESS-5.                                               CL**2
00092          05  FILLER              PICTURE X(41)   VALUE               CL**2
00093             "*** TOTAL GENERATION COMMANDS ATTEMPTED= ".             CL**2
00094          05  TOTAL-GENER         PICTURE ZZZ9.                       CL**2
00095      03  TOTAL-MESS-6.                                               CL**2
00096          05  FILLER              PICTURE X(37)   VALUE               CL**2
00097             "*** TOTAL REPORT REQUESTS ATTEMPTED= ".                 CL**2
00098          05  TOTAL-REPORT        PICTURE ZZZ9.                       CL**2
00099      03  TOTAL-MESS-7.                                               CL**2
00100          05  FILLER              PICTURE X(35)   VALUE               CL**2
00101             "*** TOTAL FILE REQUESTS ATTEMPTED= ".                   CL**2
00102          05  TOTAL-FILE          PICTURE ZZZ9.                       CL**2
00103      03  TOTAL-VALUES.                                               CL**2
               05  TOTAL-ACCUM         PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  TOTAL-GOOD          PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  TOTAL-BAD           PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  GENERS-GOOD         PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  GENERS-BAD          PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  GENERS-TOTAL        PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  REPORTS-TOTAL       PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  REPORTS-GOOD        PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  REPORTS-BAD         PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  FILE-TOTAL          PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  FILE-GOOD           PICTURE S9(4) COMP-1 VALUE ZEROS.
               05  FILE-BAD            PICTURE S9(4) COMP-1 VALUE ZEROS.
           03  RPTREQ-RECCNT PICTURE S9(4) COMP-1 VALUE ZEROS.
00117 *                                                                    CL**2
00118 *    HOLD AREA FOR TITLE                                             CL**2
00119 *                                                                    CL**2
00120  01  HOLD-VALUE.                                                     CL**2
00121      03  WORK-VALUE              PICTURE X OCCURS 50 TIMES.          CL**2
00122 *                                                                    CL**2
00123 *    QUERY REQUEST HOLD AREA                                         CL**2
00124 *                                                                    CL**2
00127  01  TITLE-HOLD-AREA.                                                CL**2
00128      03  QUERY-COMMAND-HOLD      PICTURE X(80).                      CL**2
00139                                                                    DCRETS 
00141                                                                    DCRETS 
00167                                                                    DCRETS 
00168  PROCEDURE DIVISION.                                                 CL**2
00169 **********************************************************           CL**2
00170 **********************************************************           CL**2
00171 *                                                                    CL**2
00172 *    INITIALIZATION                                                  CL**2
00173 *                                                                    CL**2
00174 **********************************************************           CL**2
00175 **********************************************************           CL**2
00176  0000-BEGIN.                                                         CL**2
00177      OPEN INPUT SYSINPUT.                                            CL**2
00178      OPEN OUTPUT SYSPRINT.                                           CL**2
00179      OPEN OUTPUT REPORT-REQUESTS.                                    CL**2
00180      MOVE SPACES TO RPT-REQ-SEL-WA.                                  CL**2
00181      MOVE ZEROES TO RPT-REQ-COUNT.                                   CL**2
00182      MOVE SPACES TO QTBL-HDR-ENT.                                    CL**2
00183      MOVE SPACES TO PRINT-LINE.                                      CL**2
00184      MOVE SPACES TO ERROR-CODES.                                     CL**2
00185      MOVE ZERO TO ERROR-COUNT.                                       CL**2
00186      MOVE ZERO TO LINKAGE-COUNT.                                     CL**2
           MOVE "0" TO RETURN-CODE. 
00187 *                                                                    CL**2
00188 *    READ 1ST STATEMENT MUST BE FUNCTION HEADER                      CL**2
00189 *                                                                    CL**2
00190  0100-READ-1ST.                                                      CL**2
00191      READ SYSINPUT AT END GO TO 1900-NO-INPUT-ERR.                   CL**2
00192      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF FIRST-EIGHT EQUAL TO "$REPORT " 
00194          GO TO 1020-RPT-REQUEST.                                     CL**2
           IF FIRST-SIX EQUAL TO "$FILE " 
00196          GO TO 1030-FILE-REQUEST.                                    CL**2
           CALL "RET001". 
00198      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00199      GO TO 1905-QUERY-SEQ-ERROR.                                     CL**2
00200 *******************************************************              CL**2
00201 *                                                                    CL**2
00202 *    PROCESS $REPORT REQUEST                                         CL**2
00203 *                                                                    CL**2
00204 *******************************************************              CL**2
00205  1020-RPT-REQUEST.                                                   CL**2
00206      MOVE "N" TO ERROR-CHECK.                                        CL**2
00207      MOVE "N" TO EXTRACT-SW.                                         CL**2
00208      MOVE "R" TO GENER-SWITCH.                                       CL**2
00209      MOVE SPACES TO END-SW.                                          CL**2
00210      MOVE "R" TO TYPE-OUTPUT-CODE.                                   CL**2
           CALL "RET001". 
00212      MOVE ZERO TO SUB3.                                              CL**2
00213      MOVE TRANS-IN TO QUERY-COMMAND-HOLD.                            CL**2
00214      GO TO 1100-QRY-TITLE.                                           CL**2
00215 *                                                                    CL**2
00216 *    PROCESS $FILE REQUEST                                           CL**2
00217 *                                                                    CL**2
00218  1030-FILE-REQUEST.                                                  CL**2
00219      MOVE "N" TO ERROR-CHECK.                                        CL**2
00220      MOVE "N" TO EXTRACT-SW.                                         CL**2
00221      MOVE "F" TO GENER-SWITCH.                                       CL**2
00222      MOVE SPACES TO END-SW.                                          CL**2
00223      MOVE "F" TO TYPE-OUTPUT-CODE.                                   CL**2
           CALL "RET001". 
00225      MOVE ZERO TO SUB3.                                              CL**2
00226      MOVE TRANS-IN TO QUERY-COMMAND-HOLD.                            CL**2
00227 **********************************************************           CL**2
00228 *                                                                    CL**2
00229 *    PROCESS TITLE STATEMENT (IF PRESENT)                            CL**2
00230 *                                                                    CL**2
00231 *************************************************************        CL**2
00232  1100-QRY-TITLE.                                                     CL**2
00233      READ SYSINPUT AT END                                            CL**2
00234          MOVE SPACES TO USER-TITLE                                   CL**2
00235          MOVE SPACES TO TITLE-LINK-HOLD                              CL**2
00236          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT                  CL**2
00237          MOVE QUERY-COMMAND-HOLD TO USER-STMT                        CL**2
00238          MOVE QUERY-COMMAND-HOLD TO QRY-HOLD (1)                     CL**2
00239          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00240          GO TO 1120-TEST-REPORT.                                     CL**2
00241      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF FIRST-FIVE EQUAL TO "TITLE" 
00243          GO TO 1150-HAVE-TITLE.                                      CL**2
00244      MOVE SPACES TO USER-TITLE.                                      CL**2
00245      MOVE SPACES TO TITLE-LINK-HOLD.                                 CL**2
00246      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00247      MOVE QUERY-COMMAND-HOLD TO QRY-HOLD (1).                        CL**2
00248      IF GENER-SWITCH EQUAL TO "R"                                    CL**2
00249          MOVE "R" TO EXTRACT-SW.                                     CL**2
00250      IF GENER-SWITCH EQUAL TO "F"                                    CL**2
00251          MOVE "F" TO EXTRACT-SW.                                     CL**2
00252      MOVE QUERY-COMMAND-HOLD TO USER-STMT.                           CL**2
00253      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
           IF BYTE-1 EQUAL TO " " 
00255          MOVE ZERO TO SUB1                                           CL**2
00256          MOVE "63" TO ERROR-CODE                                     CL**2
00257          PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT              CL**2
00258          GO TO 2100-BYPASS-REPORTS.                                  CL**2
00259      GO TO 1200-BYPASS-COMM.                                         CL**2
00260  1120-TEST-REPORT.                                                   CL**2
00261      IF TYPE-OUTPUT-CODE EQUAL TO "R"                                CL**2
00262          MOVE 1 TO STORE-SUB                                         CL**2
00263          MOVE "R" TO EXTRACT-SW                                      CL**2
00264          GO TO 1600-LAST-COMMAND.                                    CL**2
00265      IF TYPE-OUTPUT-CODE EQUAL TO "F"                                CL**2
00266          MOVE 1 TO STORE-SUB                                         CL**2
00267          MOVE "F" TO EXTRACT-SW                                      CL**2
00268          GO TO 1600-LAST-COMMAND.                                    CL**2
00269      GO TO 1950-NO-CMD-ERR.                                          CL**2
00270  1150-HAVE-TITLE.                                                    CL**2
00271      PERFORM 6000-EXTRACT-VALUE THRU 6099-EXTRACT-VALUE-XIT.         CL**2
00272      IF EXTRACT-SW EQUAL TO "Y"                                      CL**2
00273          MOVE HOLD-VALUE TO USER-TITLE                               CL**2
00274          MOVE HOLD-VALUE TO TITLE-LINK-HOLD                          CL**2
00275          GO TO 1160-NEXT-TX.                                         CL**2
00276      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00277      MOVE QUERY-COMMAND-HOLD TO QRY-HOLD (1).                        CL**2
00278      MOVE QUERY-COMMAND-HOLD TO USER-STMT.                           CL**2
00279      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00280      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00281      IF GENER-SWITCH EQUAL TO "R"                                    CL**2
00282          MOVE "R" TO EXTRACT-SW                                      CL**2
00283          MOVE ZEROS TO TITLE-LINK-HOLD                               CL**2
00284          GO TO 1170-NEXT-READ.                                       CL**2
00285      IF GENER-SWITCH EQUAL TO "F"                                    CL**2
00286          MOVE "F" TO EXTRACT-SW                                      CL**2
00287          MOVE ZEROS TO TITLE-LINK-HOLD                               CL**2
00288          GO TO 1170-NEXT-READ.                                       CL**2
00289      MOVE "01" TO ERROR-CODE.                                        CL**2
00290      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00291      GO TO 1925-BYPASS.                                              CL**2
00292  1160-NEXT-TX.                                                       CL**2
00293      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00294      MOVE QUERY-COMMAND-HOLD TO QRY-HOLD (1).                        CL**2
00295      MOVE QUERY-COMMAND-HOLD TO USER-STMT.                           CL**2
00296      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00297      IF GENER-SWITCH EQUAL TO "R"                                    CL**2
00298          MOVE "R" TO EXTRACT-SW.                                     CL**2
00299      IF GENER-SWITCH EQUAL TO "F"                                    CL**2
00300          MOVE "F" TO EXTRACT-SW.                                     CL**2
00301  1170-NEXT-READ.                                                     CL**2
00302      READ SYSINPUT AT END GO TO 1120-TEST-REPORT.                    CL**2
00303      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF BYTE-1 EQUAL TO " " 
00305          GO TO 1460-SWITCH-ERRORS.                                   CL**2
00306                                                                    DCRETS 
00307 **********************************************************           CL**2
00308 *                                                                    CL**2
00309 *    PROCESS COUNT, LIST AND SHOW COMMANDS AND COMMENTS              CL**2
00310 *                                                                    CL**2
00311 *        PRINT COMMENTS                                              CL**2
00312 *        TABLE AND PRINT COMMAND AND CONTINUATION STMTS              CL**2
00313 *                                                                    CL**2
00314 *********************************************************            CL**2
00315  1200-BYPASS-COMM.                                                   CL**2
           IF BYTE-1 NOT EQUAL TO "*" 
00317          GO TO 1275-CK-COMMAND.                                      CL**2
00318  1250-PRINT-COMM.                                                    CL**2
00319      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00320      READ SYSINPUT AT END GO TO 1120-TEST-REPORT.                    CL**2
00321      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
00322      GO TO 1200-BYPASS-COMM.                                         CL**2
00323  1275-CK-COMMAND.                                                    CL**2
00324      IF GENER-SWITCH EQUAL TO "Y"                                    CL**2
00325          GO TO 1300-GENER-SELECT.                                    CL**2
00326      IF GENER-SWITCH EQUAL TO "R" OR "F"                             CL**2
00327          GO TO 1510-OPTION-REPORT-EXTRACT.                           CL**2
           IF FIRST-SIX EQUAL TO "COUNT " 
00329          GO TO 1325-COUNT-CMD.                                       CL**2
           IF FIRST-FIVE EQUAL TO "LIST " OR "SHOW "
00331          GO TO 1350-OTHER-CMD.                                       CL**2
00332      GO TO 1910-STMT-SEQ-ERR.                                        CL**2
00333 *                                                                    CL**2
00334 *    PROCESS NEXT CARD---MUST BE A SELECT CARD                       CL**2
00335 *                                                                    CL**2
00336  1300-GENER-SELECT.                                                  CL**2
           IF FIRST-SEVEN EQUAL TO "SELECT "
00338          MOVE 1 TO STORE-SUB                                         CL**2
00339          GO TO 1560-FOUND-SELECT.                                    CL**2
           IF FIRST-FOUR EQUAL TO "SEL "
00341          MOVE 1 TO STORE-SUB                                         CL**2
00342          GO TO 1560-FOUND-SELECT.                                    CL**2
00343      GO TO 1915-GENER-SEQ-ERR.                                       CL**2
00344 *                                                                    CL**2
00345 *      PROCESS COMMAND HEADER                                        CL**2
00346 *                                                                    CL**2
00347  1325-COUNT-CMD.                                                     CL**2
00348      MOVE MOVE-C TO QRY-HOLD (1).                                    CL**2
00349      GO TO 1375-FINI-HDR.                                            CL**2
00350  1350-OTHER-CMD.                                                     CL**2
00351      MOVE BYTES6-72 TO QRY-HOLD (1).                                 CL**2
00352  1375-FINI-HDR.                                                      CL**2
00353      MOVE BYTE-1 TO QRYTYPE-1.                                       CL**2
00354      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00355      MOVE 1 TO STORE-SUB.                                            CL**2
00356 *                                                                    CL**2
00357 *    TABLE CONTINUATION STATMENTS/ BYPASS COMMENTS                   CL**2
00358 *             UNTIL NEXT $ STATMENT                                  CL**2
00359 *                                                                    CL**2
00360  1400-FIND-CONT.                                                     CL**2
00361      READ SYSINPUT AT END GO TO 1600-LAST-COMMAND.                   CL**2
00362      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
00363  1450-EXIT-REPORT.                                                   CL**2
00364      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F" OR "G"                  CL**2
00365          GO TO 1455-CHECK-LEGAL.                                     CL**2
           IF BYTE-1 EQUAL TO "$" OR "S" OR "C" OR "L"
00367          GO TO 1625-GOOD-COMMAND.                                    CL**2
           IF BYTE-1 EQUAL TO "*" 
00369          GO TO 1625-GOOD-COMMAND.                                    CL**2
           IF BYTE-1 EQUAL TO " " 
00371          GO TO 1460-SWITCH-ERRORS.                                   CL**2
00372      ADD 1 TO STORE-SUB.                                             CL**2
00373      IF STORE-SUB GREATER THAN 3                                     CL**2
00374          GO TO 1965-CONT-ERR.                                        CL**2
00375      MOVE MOVE-CONT TO QRY-HOLD (STORE-SUB).                         CL**2
00376      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00377      GO TO 1400-FIND-CONT.                                           CL**2
00378  1455-CHECK-LEGAL.                                                   CL**2
           IF BYTE-1 EQUAL TO "$" 
00380          GO TO 1625-GOOD-COMMAND.                                    CL**2
           IF BYTE-1 EQUAL TO "*" 
00382          GO TO 1625-GOOD-COMMAND.                                    CL**2
00383  1460-SWITCH-ERRORS.                                                 CL**2
00384      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F"                         CL**2
00385          MOVE "63" TO ERROR-CODE                                     CL**2
00386          PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT              CL**2
00387          GO TO 2100-BYPASS-REPORTS.                                  CL**2
00388      GO TO 1910-STMT-SEQ-ERR.                                        CL**2
00389                                                                    DCRETS 
00390 ******************************************************************   CL**2
00391 *                                                                    CL**2
00392 *    GENERATION REQUEST---OPTION CARD SEARCH                         CL**2
00393 *                                                                    CL**2
00394 ******************************************************************   CL**2
00395  1500-OPTION-EXTRACT.                                                CL**2
00396      READ SYSINPUT AT END GO TO 1950-NO-CMD-ERR.                     CL**2
00397      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
00398  1510-OPTION-REPORT-EXTRACT.                                         CL**2
00399      MOVE ZERO TO SUB1.                                              CL**2
           IF FIRST-FOUR EQUAL TO "OPT "
00401          GO TO 1525-CK-FULL-OPTION.                                  CL**2
           IF FIRST-SEVEN NOT EQUAL TO "OPTIONS"
00403          GO TO 1540-SELECT-SUB.                                      CL**2
00404  1525-CK-FULL-OPTION.                                                CL**2
00405      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00406      MOVE QUERY-TRANS TO QRY-HOLD (2).                               CL**2
00407      MOVE 3 TO STORE-SUB.                                            CL**2
00408 *                                                                    CL**2
00409 *    PROCESS CONTINUATION CARDS                                      CL**2
00410 *                                                                    CL**2
00411  1530-CONTINUE-EXTRACT.                                              CL**2
00412      READ SYSINPUT AT END GO TO 1535-TEST-OPTION.                    CL**2
00413      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF BYTE-1 NOT EQUAL TO " " 
00415          GO TO 1545-COMMENTS-EXIST.                                  CL**2
00416      MOVE QUERY-TRANS TO QRY-HOLD (STORE-SUB).                       CL**2
00417      ADD 1 TO STORE-SUB.                                             CL**2
00418      IF STORE-SUB GREATER THAN 5                                     CL**2
00419          GO TO 1965-CONT-ERR.                                        CL**2
00420      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00421      GO TO 1530-CONTINUE-EXTRACT.                                    CL**2
00422  1535-TEST-OPTION.                                                   CL**2
00423      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F"                         CL**2
00424          SUBTRACT 1 FROM STORE-SUB                                   CL**2
00425          GO TO 1600-LAST-COMMAND.                                    CL**2
00426      GO TO 1950-NO-CMD-ERR.                                          CL**2
00427 *                                                                    CL**2
00428 *    PROCESS COMMENTS                                                CL**2
00429 *                                                                    CL**2
00430  1540-SELECT-SUB.                                                    CL**2
00431      MOVE 2 TO STORE-SUB.                                            CL**2
00432  1545-COMMENTS-EXIST.                                                CL**2
           IF BYTE-1 NOT EQUAL TO "*" 
00434          GO TO 1550-SELECT-EXTRACT.                                  CL**2
00435      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00436      READ SYSINPUT AT END GO TO 1535-TEST-OPTION.                    CL**2
00437      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
00438      GO TO 1545-COMMENTS-EXIST.                                      CL**2
00439                                                                    DCRETS 
00440 ***************************************************************      CL**2
00441 *                                                                    CL**2
00442 *    EXTRACT FIELD---LOOKING FOR A SELECT OR AN OUTPUT CARD          CL**2
00443 *                                                                    CL**2
00444 ***************************************************************      CL**2
00445  1550-SELECT-EXTRACT.                                                CL**2
           IF FIRST-SEVEN EQUAL TO "SELECT "
00447          GO TO 1560-FOUND-SELECT.                                    CL**2
           IF FIRST-FOUR EQUAL TO "SEL "
00449          GO TO 1560-FOUND-SELECT.                                    CL**2
           IF FIRST-FOUR EQUAL TO "OUT "
00451          MOVE ZERO TO SUB1                                           CL**2
00452          GO TO 1590-FOUND-OUTPUT.                                    CL**2
           IF FIRST-SEVEN EQUAL TO "OUTPUT "
00454          MOVE ZERO TO SUB1                                           CL**2
00455          GO TO 1590-FOUND-OUTPUT.                                    CL**2
00456      SUBTRACT 1 FROM STORE-SUB.                                      CL**2
00457      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F"                         CL**2
00458          GO TO 1450-EXIT-REPORT.                                     CL**2
00459      MOVE "13" TO ERROR-CODE.                                        CL**2
00460      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00461      GO TO 1925-BYPASS.                                              CL**2
00462 *                                                                    CL**2
00463 *    FOUND A SELECT MUST---TABLE IT, PRINT IT, READ NEXT CARD        CL**2
00464 *                                                                    CL**2
00465  1560-FOUND-SELECT.                                                  CL**2
00466      MOVE ZERO TO SUB2.                                              CL**2
00467      MOVE QUERY-TRANS TO QRY-HOLD (STORE-SUB).                       CL**2
00468      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00469      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F"                         CL**2
00470          GO TO 1565-ADD-COUNTER.                                     CL**2
00471      GO TO 1400-FIND-CONT.                                           CL**2
00472  1565-ADD-COUNTER.                                                   CL**2
00473      ADD 1 TO SUB1.                                                  CL**2
00474      IF SUB1 GREATER THAN 9                                          CL**2
00475          MOVE "05" TO ERROR-CODE                                     CL**2
00476          PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT              CL**2
00477          GO TO 2100-BYPASS-REPORTS.                                  CL**2
00478      ADD 1 TO STORE-SUB.                                             CL**2
00479  1570-READ-SELECT.                                                   CL**2
00480      READ SYSINPUT AT END                                            CL**2
00481          SUBTRACT 1 FROM STORE-SUB                                   CL**2
00482          GO TO 1600-LAST-COMMAND.                                    CL**2
00483      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF BYTE-1 NOT EQUAL TO " " 
00485          GO TO 1550-SELECT-EXTRACT.                                  CL**2
00486      MOVE QUERY-TRANS TO QRY-HOLD (STORE-SUB).                       CL**2
00487      ADD 1 TO STORE-SUB.                                             CL**2
00488      ADD 1 TO SUB2.                                                  CL**2
00489      IF SUB2 GREATER THAN 2                                          CL**2
00490          MOVE "08" TO ERROR-CODE                                     CL**2
00491          PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT              CL**2
00492          GO TO 2100-BYPASS-REPORTS.                                  CL**2
00493      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00494      GO TO 1570-READ-SELECT.                                         CL**2
00495                                                                    DCRETS 
00496 *                                                                    CL**2
00497 *    CHECK FOR (OPTIONAL) OUTPUT CARD                                CL**2
00498 *                                                                    CL**2
00499  1580-CK-OUTPUT.                                                     CL**2
           IF FIRST-FOUR EQUAL TO "OUT "
00501          GO TO 1590-FOUND-OUTPUT.                                    CL**2
           IF FIRST-SEVEN EQUAL TO "OUTPUT "
00503          GO TO 1590-FOUND-OUTPUT.                                    CL**2
00504      SUBTRACT 1 FROM STORE-SUB.                                      CL**2
00505      GO TO 1450-EXIT-REPORT.                                         CL**2
00506  1590-FOUND-OUTPUT.                                                  CL**2
00507      MOVE QUERY-TRANS TO QRY-HOLD (STORE-SUB).                       CL**2
00508      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00509      ADD 1 TO STORE-SUB.                                             CL**2
00510      ADD 1 TO SUB1.                                                  CL**2
00511      IF SUB1 GREATER THAN 9                                          CL**2
00512          MOVE "06" TO ERROR-CODE                                     CL**2
00513          PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT              CL**2
00514          GO TO 2100-BYPASS-REPORTS.                                  CL**2
00515      READ SYSINPUT AT END                                            CL**2
00516          SUBTRACT 1 FROM STORE-SUB                                   CL**2
00517          GO TO 1600-LAST-COMMAND.                                    CL**2
00518      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
00519      GO TO 1580-CK-OUTPUT.                                           CL**2
00520                                                                    DCRETS 
00521 **********************************************************           CL**2
00522 *                                                                    CL**2
00523 *    END INITIAL EDIT OF COMMAND - CALL EDIT02                       CL**2
00524 *                                                                    CL**2
00525 ********************************************************             CL**2
00526  1600-LAST-COMMAND.                                                  CL**2
00527      MOVE "Y" TO END-SW.                                             CL**2
00528  1625-GOOD-COMMAND.                                                  CL**2
00529      CLOSE SYSPRINT.                                                 CL**2
00530      MOVE STORE-SUB TO LINKAGE-COUNT.                                CL**2
00531      IF EXTRACT-SW EQUAL TO "R" OR "F"                               CL**2
               GO TO 1675-CALL-REPORT 
           ELSE 
               GO TO 1700-PROCESS-OVER
           END-IF 
00542  1675-CALL-REPORT.                                                   CL**2
           CALL "RPT010". 
00545 ********************************************************             CL**2
00546 *    END OF REPORT/FILE REQUEST PROCESSING                           CL**2
00547 ********************************************************             CL**2
00548 *                                                                    CL**2
00549 *    WRITE REPORT REQUEST FILE                                       CL**2
00550 *        RPT-REQ-WA CONTAINS THE RECORD TO BE WRITTEN                CL**2
00551 *        OR SPACES IF REQUEST WAS IN ERROR OR ALL RECORDS            CL**2
00552 *        HAVE BEEN WRITTEN FOR THE REQUEST.                          CL**2
00553 *                                                                    CL**2
00554      IF RPT-REQ-SEL-WA EQUAL TO SPACES                               CL**2
00555          GO TO 1700-PROCESS-OVER.                                    CL**2
00556      IF RPT-REQ-RECTYPE EQUAL TO 1                                   CL**2
00557          ADD 21 TO RPTREQ-RECCNT                                     CL**2
00558          WRITE RPT-HDR-REC FROM RPT-REQ-HDR-WA                       CL**2
00559          GO TO 1675-CALL-REPORT.                                     CL**2
00560      IF RPT-REQ-RECTYPE EQUAL TO 2                                   CL**2
00561          WRITE RPT-OPTIONS-REC FROM RPT-REQ-HDR-WA                   CL**2
00562          GO TO 1675-CALL-REPORT.                                     CL**2
00563      IF RPT-REQ-RECTYPE EQUAL TO 3                                   CL**2
00564          WRITE RPT-SELECT1-REC FROM RPT-REQ-SEL-WA                   CL**2
00565          GO TO 1675-CALL-REPORT.                                     CL**2
00566      IF RPT-REQ-RECTYPE EQUAL TO 4                                   CL**2
00567          WRITE RPT-OUTPUT-REC FROM RPT-REQ-OUT-WA                    CL**2
00568          GO TO 1675-CALL-REPORT.                                     CL**2
00569      WRITE RPT-PARAM-REC FROM RPT-REQ-PARAM-WA.                      CL**2
00570      ADD 1 TO RPTREQ-RECCNT.                                         CL**2
00571      GO TO 1675-CALL-REPORT.                                         CL**2
00572                                                                    DCRETS 
00573 *******************************************************              CL**2
00574 *    PROCESSING RETURNS FROM OUTSIDE EDITS TO HERE                   CL**2
00575 *******************************************************              CL**2
00576  1700-PROCESS-OVER.                                                  CL**2
00577      MOVE SPACES TO QTBL-HDR-ENT.                                    CL**2
00578      IF EXTRACT-SW EQUAL TO "A"                                      CL**2
00579          GO TO 1710-GENER-EOJ-TOTALS.                                CL**2
00580      IF EXTRACT-SW EQUAL TO "R"                                      CL**2
00581          GO TO 1720-REPORT-EOJ-TOTALS.                               CL**2
00582      IF EXTRACT-SW EQUAL TO "F"                                      CL**2
00583          GO TO 1725-FILE-EOJ-TOTALS.                                 CL**2
00584      IF EXTRACT-SW EQUAL TO SPACES                                   CL**2
00585          MOVE "Y" TO ERROR-REQUEST                                   CL**2
00586          GO TO 1730-RETURN-PROCESSING.                               CL**2
00587      ADD 1 TO TOTAL-ACCUM.                                           CL**2
00588      IF ERROR-COUNT EQUAL TO ZERO                                    CL**2
00589          ADD 1 TO TOTAL-GOOD                                         CL**2
00590          GO TO 1730-RETURN-PROCESSING.                               CL**2
00591      ADD 1 TO TOTAL-BAD.                                             CL**2
00592      MOVE "Y" TO ERROR-REQUEST.                                      CL**2
00593      GO TO 1730-RETURN-PROCESSING.                                   CL**2
00594  1710-GENER-EOJ-TOTALS.                                              CL**2
00595      ADD 1 TO GENERS-TOTAL.                                          CL**2
00596      IF ERROR-COUNT EQUAL TO ZERO                                    CL**2
00597          ADD 1 TO GENERS-GOOD                                        CL**2
00598          GO TO 1730-RETURN-PROCESSING.                               CL**2
00599      ADD 1 TO GENERS-BAD.                                            CL**2
00600      MOVE "Y" TO ERROR-REQUEST.                                      CL**2
00601      GO TO 1730-RETURN-PROCESSING.                                   CL**2
00602  1720-REPORT-EOJ-TOTALS.                                             CL**2
00603      ADD 1 TO REPORTS-TOTAL.                                         CL**2
00604      IF ERROR-CHECK EQUAL TO "Y"                                     CL**2
00605          ADD 1 TO REPORTS-BAD                                        CL**2
00606          MOVE "N" TO ERROR-CHECK                                     CL**2
00607          MOVE "Y" TO ERROR-REQUEST                                   CL**2
00608          GO TO 1730-RETURN-PROCESSING.                               CL**2
00609      ADD 1 TO REPORTS-GOOD.                                          CL**2
00610      GO TO 1730-RETURN-PROCESSING.                                   CL**2
00611  1725-FILE-EOJ-TOTALS.                                               CL**2
00612      ADD 1 TO FILE-TOTAL.                                            CL**2
00613      IF ERROR-CHECK EQUAL TO "Y"                                     CL**2
00614          ADD 1 TO FILE-BAD                                           CL**2
00615          MOVE "N" TO ERROR-CHECK                                     CL**2
00616          MOVE "Y" TO ERROR-REQUEST                                   CL**2
00617          GO TO 1730-RETURN-PROCESSING.                               CL**2
00618      ADD 1 TO FILE-GOOD.                                             CL**2
00619  1730-RETURN-PROCESSING.                                             CL**2
00620 ******************************************************               CL**2
00621 *                                                                    CL**2
00622 *    PROCESS NEXT COMMAND (UPON RETURN FROM PROCESSING)              CL**2
00623 *                                                                    CL**2
00624 *******************************************************              CL**2
00625      IF END-SW EQUAL TO "Y"                                          CL**2
00626          GO TO 1800-EOJ.                                             CL**2
00627      IF ERROR-CHECK EQUAL TO "Y"                                     CL**2
00628          MOVE "E" TO END-SW.                                         CL**2
00629      MOVE SPACES TO ERROR-CODES.                                     CL**2
00630      MOVE ZERO TO ERROR-COUNT.                                       CL**2
00631      MOVE ZERO TO LINKAGE-COUNT.                                     CL**2
00632      OPEN OUTPUT SYSPRINT.                                           CL**2
00633      IF END-SW EQUAL TO "C"                                          CL**2
00634          MOVE 99 TO LINE-CT                                          CL**2
00635          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT                  CL**2
00636          GO TO 1915-GENER-SEQ-ERR.                                   CL**2
           IF FIRST-EIGHT EQUAL TO "$REPORT " 
00638          GO TO 1020-RPT-REQUEST.                                     CL**2
           IF FIRST-SIX EQUAL TO "$FILE " 
00640          GO TO 1030-FILE-REQUEST.                                    CL**2
00641      IF EXTRACT-SW EQUAL TO "R" OR "F"                               CL**2
00642          MOVE "E" TO END-SW.                                         CL**2
00643      IF END-SW EQUAL TO "E"                                          CL**2
00644          GO TO 1928-BYPASS-STMTS.                                    CL**2
00645      MOVE 99 TO LINE-CT.                                             CL**2
00646      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00647      GO TO 1200-BYPASS-COMM.                                         CL**2
00648                                                                    DCRETS 
00649 *********************************************************            CL**2
00650 *                                                                    CL**2
00651 *    END OF JOB PROCESSING                                           CL**2
00652 *                                                                    CL**2
00653 **************************************************                   CL**2
00654  1800-EOJ.                                                           CL**2
00655      OPEN OUTPUT SYSPRINT.                                           CL**2
00656      MOVE 99 TO LINE-CT.                                             CL**2
00657      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00658      IF ERROR-REQUEST EQUAL TO "N"                                   CL**2
00659          MOVE ZERO TO RETURN-CODE ELSE                               CL**2
00660          MOVE "08" TO RETURN-CODE.                                   CL**2
00661      MOVE SPACES TO STMT-LINE.                                       CL**2
00662      IF TOTAL-ACCUM EQUAL TO ZERO                                    CL**2
00663          GO TO 1801-TEST-TOTAL-GENS.                                 CL**2
00664      MOVE TOTAL-ACCUM TO TOTAL-PROC.                                 CL**2
00665      PERFORM 7000-FIRST-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.        CL**2
00666      MOVE TOTAL-GOOD TO TOTAL-ACC.                                   CL**2
00667      PERFORM 7300-SECOND-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.       CL**2
00668      MOVE TOTAL-BAD TO TOTAL-REJ.                                    CL**2
00669      PERFORM 7400-THIRD-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.        CL**2
00670  1801-TEST-TOTAL-GENS.                                               CL**2
00671      IF GENERS-TOTAL EQUAL TO ZERO                                   CL**2
00672          GO TO 1802-TEST-TOTAL-REPORTS.                              CL**2
00673      MOVE GENERS-TOTAL TO TOTAL-GENER.                               CL**2
00674      PERFORM 7100-FIRST-LINEA-PRINT THRU 7600-PRINT-EOJ-LINES.       CL**2
00675      MOVE GENERS-GOOD TO TOTAL-ACC.                                  CL**2
00676      PERFORM 7300-SECOND-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.       CL**2
00677      MOVE GENERS-BAD TO TOTAL-REJ.                                   CL**2
00678      PERFORM 7400-THIRD-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.        CL**2
00679  1802-TEST-TOTAL-REPORTS.                                            CL**2
00680      IF REPORTS-TOTAL EQUAL TO ZERO                                  CL**2
00681          GO TO 1805-TEST-TOTAL-FILES.                                CL**2
00682      MOVE REPORTS-TOTAL TO TOTAL-REPORT.                             CL**2
00683      PERFORM 7200-FIRST-LINEB-PRINT THRU 7600-PRINT-EOJ-LINES.       CL**2
00684      MOVE REPORTS-GOOD TO TOTAL-ACC.                                 CL**2
00685      PERFORM 7300-SECOND-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.       CL**2
00686      MOVE REPORTS-BAD TO TOTAL-REJ.                                  CL**2
00687      PERFORM 7400-THIRD-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.        CL**2
00688  1805-TEST-TOTAL-FILES.                                              CL**2
00689      IF FILE-TOTAL EQUAL TO ZERO                                     CL**2
00690          GO TO 1810-END-OF-JOB.                                      CL**2
00691      MOVE FILE-TOTAL TO TOTAL-FILE.                                  CL**2
00692      PERFORM 7250-FIRST-LINEC-PRINT THRU 7600-PRINT-EOJ-LINES.       CL**2
00693      MOVE FILE-GOOD TO TOTAL-ACC.                                    CL**2
00694      PERFORM 7300-SECOND-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.       CL**2
00695      MOVE FILE-BAD TO TOTAL-REJ.                                     CL**2
00696      PERFORM 7400-THIRD-LINE-PRINT THRU 7600-PRINT-EOJ-LINES.        CL**2
00697 *                                                                    CL**2
00698 *    FINAL END OF JOB MESSAGE IS PRINTED--JOB ENDED                  CL**2
00699 *                                                                    CL**2
00700  1810-END-OF-JOB.                                                    CL**2
00701      MOVE 99 TO LINE-CT.                                             CL**2
00702      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00703      MOVE TOTAL-MESS-4 TO STMT-LINE.                                 CL**2
00704      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00705      CLOSE SYSPRINT.                                                 CL**2
00706      CLOSE SYSINPUT.                                                 CL**2
00707      CLOSE REPORT-REQUESTS.                                          CL**2
00708      IF REPORTS-GOOD NOT EQUAL TO ZERO                               CL**2
               CALL "RPT100"
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT
00710          STOP RUN.                                                   CL**2
00711      IF FILE-GOOD NOT EQUAL TO ZERO                                  CL**2
           CALL "RPT100". 
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
00713      STOP RUN.                                                       CL**2
*CALL RETCODE 
00714                                                                    DCRETS 
00715 **********************************************************           CL**2
00716 *                                                                    CL**2
00717 *    QUERY REQUEST ERROR ROUTINES                                    CL**2
00718 *    COME HERE WHEN NO COMMAND INPUT IS SUBMITTED                    CL**2
00719 *                                                                    CL**2
00720 ******************************************************************   CL**2
00721  1900-NO-INPUT-ERR.                                                  CL**2
00722      MOVE "02" TO ERROR-CODE.                                        CL**2
00723      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
           CALL "RET001". 
00725      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00726      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00727      MOVE "Y" TO END-SW.                                             CL**2
00728      GO TO 1625-GOOD-COMMAND.                                        CL**2
00729 *                                                                    CL**2
00730 *    COME HERE WHEN NO FUNCTION HEADER FOUND AT START                CL**2
00731 *                                                                    CL**2
00732  1905-QUERY-SEQ-ERROR.                                               CL**2
00733      MOVE "36" TO ERROR-CODE.                                        CL**2
00734      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00735      GO TO 1925-BYPASS.                                              CL**2
00736 *                                                                    CL**2
00737 *    STATEMENT MISSING OR OUT OF ORDER                               CL**2
00738 *        BYPASS UNTIL NEXT FUNCTION HEADER                           CL**2
00739 *                                                                    CL**2
00740  1910-STMT-SEQ-ERR.                                                  CL**2
00741      IF TYPE-OUTPUT-CODE EQUAL TO "G"                                CL**2
00742          GO TO 1980-ILLEGAL-CARD.                                    CL**2
00743      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F"                         CL**2
00744          MOVE "04" TO ERROR-CODE                                     CL**2
00745          PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT              CL**2
00746          GO TO 2100-BYPASS-REPORTS.                                  CL**2
00747  1915-GENER-SEQ-ERR.                                                 CL**2
00748      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F"                         CL**2
00749          GO TO 2300-REPORT-SEQ-ERROR.                                CL**2
00750      IF TYPE-OUTPUT-CODE NOT EQUAL TO "G"                            CL**2
00751          GO TO 1920-STMT-SEQ-ERR-QRY.                                CL**2
00752      MOVE "13" TO ERROR-CODE.                                        CL**2
00753      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00754      GO TO 1925-BYPASS.                                              CL**2
00755  1920-STMT-SEQ-ERR-QRY.                                              CL**2
00756      MOVE "29" TO ERROR-CODE.                                        CL**2
00757      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00758  1925-BYPASS.                                                        CL**2
00759      IF TYPE-OUTPUT-CODE NOT EQUAL TO "G"                            CL**2
00760          GO TO 1927-BYPASS-QRY.                                      CL**2
00761      MOVE "14" TO ERROR-CODE.                                        CL**2
00762  1926-CONT.                                                          CL**2
00763      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00764      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00765      MOVE "E" TO END-SW.                                             CL**2
00766      READ SYSINPUT AT END GO TO 1600-LAST-COMMAND.                   CL**2
00767      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
00768      GO TO 1625-GOOD-COMMAND.                                        CL**2
00769  1927-BYPASS-QRY.                                                    CL**2
00770      MOVE "33" TO ERROR-CODE.                                        CL**2
00771      GO TO 1926-CONT.                                                CL**2
00772  1928-BYPASS-STMTS.                                                  CL**2
00773      MOVE SPACES TO STMT-LINE.                                       CL**2
00774      MOVE "3" TO PRT-CTL.                                            CL**2
00775      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00776      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00777      MOVE SPACE TO END-SW.                                           CL**2
00778  1930-SKIPPED-LINES.                                                 CL**2
00779      READ SYSINPUT AT END                                            CL**2
00780          CLOSE SYSPRINT                                              CL**2
00781          GO TO 1800-EOJ.                                             CL**2
00782      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF FIRST-EIGHT EQUAL TO "$REPORT " 
00784          GO TO 1020-RPT-REQUEST.                                     CL**2
           IF FIRST-SIX EQUAL TO "$FILE " 
00786          GO TO 1030-FILE-REQUEST.                                    CL**2
00787      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00788      IF EXTRACT-SW EQUAL TO "R" OR "F"                               CL**2
00789          GO TO 1930-SKIPPED-LINES.                                   CL**2
00790      IF EXTRACT-SW NOT EQUAL TO "A"                                  CL**2
00791          GO TO 1940-CK-QUERY-ADD.                                    CL**2
00792      ADD 1 TO GENERS-TOTAL.                                          CL**2
00793      ADD 1 TO GENERS-BAD.                                            CL**2
00794      GO TO 1945-BYPASS-CONTINUED.                                    CL**2
00795  1940-CK-QUERY-ADD.                                                  CL**2
00796      IF EXTRACT-SW EQUAL TO SPACES                                   CL**2
00797          GO TO 1945-BYPASS-CONTINUED.                                CL**2
00798      ADD 1 TO TOTAL-ACCUM.                                           CL**2
00799      ADD 1 TO TOTAL-BAD.                                             CL**2
00800  1945-BYPASS-CONTINUED.                                              CL**2
00801      IF END-SW EQUAL TO SPACE                                        CL**2
00802          GO TO 1930-SKIPPED-LINES.                                   CL**2
00803  1950-NO-CMD-ERR.                                                    CL**2
00804      IF TYPE-OUTPUT-CODE EQUAL TO "G"                                CL**2
00805          GO TO 1960-GEN-CMD-ERR.                                     CL**2
00806      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F"                         CL**2
00807          GO TO 2000-REPORT-ERRORS.                                   CL**2
00808      MOVE "35" TO ERROR-CODE.                                        CL**2
00809      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00810  1955-COMM-ERR.                                                      CL**2
00811      MOVE "Y" TO END-SW.                                             CL**2
00812      GO TO 1625-GOOD-COMMAND.                                        CL**2
00813  1960-GEN-CMD-ERR.                                                   CL**2
00814      MOVE "16" TO ERROR-CODE.                                        CL**2
00815      GO TO 1955-COMM-ERR.                                            CL**2
00816  1965-CONT-ERR.                                                      CL**2
00817      IF TYPE-OUTPUT-CODE EQUAL TO "G"                                CL**2
00818         MOVE "15" TO ERROR-CODE                                      CL**2
00819         GO TO 1970-PROCESS-ERR.                                      CL**2
00820      IF TYPE-OUTPUT-CODE EQUAL TO "R" OR "F"                         CL**2
00821          GO TO 2200-CONTINUE-ERROR.                                  CL**2
00822      MOVE "34" TO ERROR-CODE.                                        CL**2
00823  1970-PROCESS-ERR.                                                   CL**2
00824      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00825      GO TO 1925-BYPASS.                                              CL**2
00826  1980-ILLEGAL-CARD.                                                  CL**2
00827      MOVE "C" TO END-SW.                                             CL**2
00828      GO TO 1625-GOOD-COMMAND.                                        CL**2
00829  1985-BAD-SYNTAX.                                                    CL**2
00830      MOVE "13" TO ERROR-CODE.                                        CL**2
00831      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00832      MOVE SPACE TO END-SW.                                           CL**2
00833      MOVE 99 TO LINE-CT.                                             CL**2
00834      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
00835      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00836      GO TO 1400-FIND-CONT.                                           CL**2
00837 *                                                                    CL**2
00838 *    NO INPUT SUBMITTED AFTER THE $REPORT CARD                       CL**2
00839 *                                                                    CL**2
00840  2000-REPORT-ERRORS.                                                 CL**2
00841      MOVE "01" TO ERROR-CODE.                                        CL**2
00842      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00843      MOVE "Y" TO END-SW.                                             CL**2
00844      GO TO 1625-GOOD-COMMAND.                                        CL**2
00845 *                                                                    CL**2
00846 *    STATEMENT MISSING, OUT OF ORDER, OR ILLEGAL                     CL**2
00847 *         BYPASS REST OF $REPORT REQUEST                             CL**2
00848 *         UNTIL A NEW FUNCTION HEADER IS FOUND                       CL**2
00849 *                                                                    CL**2
00850  2100-BYPASS-REPORTS.                                                CL**2
00851      MOVE "03" TO ERROR-CODE.                                        CL**2
00852      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00853      IF SUB1 LESS THAN 10                                            CL**2
00854          PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.           CL**2
00855      MOVE "E" TO END-SW.                                             CL**2
00856      READ SYSINPUT AT END GO TO 1600-LAST-COMMAND.                   CL**2
00857      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
00858      GO TO 1625-GOOD-COMMAND.                                        CL**2
00859 *                                                                    CL**2
00860 *    OPTION CONTINUATION ERROR  (REPORTS)                            CL**2
00861 *                                                                    CL**2
00862  2200-CONTINUE-ERROR.                                                CL**2
00863      MOVE "07" TO ERROR-CODE.                                        CL**2
00864      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00865      GO TO 2100-BYPASS-REPORTS.                                      CL**2
00866 *                                                                    CL**2
00867 *    CARD SEQUENCE ERROR                                             CL**2
00868 *                                                                    CL**2
00869  2300-REPORT-SEQ-ERROR.                                              CL**2
00870      MOVE "04" TO ERROR-CODE.                                        CL**2
00871      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00872      GO TO 2100-BYPASS-REPORTS.                                      CL**2
00873 *                                                                    CL**2
00874 *    UNRECOGNIZABLE CARD OR SEQUENCE ERROR                           CL**2
00875 *                                                                    CL**2
00876  2400-ILLEGAL-CARD.                                                  CL**2
00877       MOVE "C" TO END-SW.                                            CL**2
00878       GO TO 1625-GOOD-COMMAND.                                       CL**2
00879                                                                    DCRETS 
00880 *******************************************************              CL**2
00881 *******************************************************              CL**2
00882 *                                                                    CL**2
00883 *     SUBROUTINES                                                    CL**2
00884 *                                                                    CL**2
00885 *          EXTRACT VALUE SUBROUTINE                                  CL**2
00886 *                                                                    CL**2
00887 ********************************************************             CL**2
00888 ********************************************************             CL**2
00889  6000-EXTRACT-VALUE.                                                 CL**2
00890      MOVE SPACES TO HOLD-VALUE.                                      CL**2
00891      MOVE "N" TO EXTRACT-SW.                                         CL**2
00892      MOVE 01 TO SUB1.                                                CL**2
00893      MOVE 01 TO SUB2.                                                CL**2
00894  6010-TITLE-LOOP-1.                                                  CL**2
00895      IF TITLE-WORK (SUB1) NOT EQUAL TO SPACES                        CL**2
00896          GO TO 6020-TITLE-QUOTE.                                     CL**2
00897      ADD 1 TO SUB1.                                                  CL**2
00898      IF SUB1 LESS THAN 65                                            CL**2
00899          GO TO 6010-TITLE-LOOP-1.                                    CL**2
00900      GO TO 6099-EXTRACT-VALUE-XIT.                                   CL**2
00901  6020-TITLE-QUOTE.                                                   CL**2
00902      IF TITLE-WORK (SUB1) NOT EQUAL TO QUOTE                         CL**2
00903          GO TO 6099-EXTRACT-VALUE-XIT.                               CL**2
00904      ADD 1 TO SUB1.                                                  CL**2
00905  6030-TITLE-LOOP-2.                                                  CL**2
00906      IF TITLE-WORK (SUB1) EQUAL TO QUOTE                             CL**2
00907          MOVE "Y" TO EXTRACT-SW                                      CL**2
00908          GO TO 6099-EXTRACT-VALUE-XIT.                               CL**2
00909      IF SUB2 GREATER THAN 50                                         CL**2
00910          GO TO 6099-EXTRACT-VALUE-XIT.                               CL**2
00911      IF SUB1 GREATER THAN 65                                         CL**2
00912          GO TO 6099-EXTRACT-VALUE-XIT.                               CL**2
00913      MOVE TITLE-WORK (SUB1) TO WORK-VALUE (SUB2).                    CL**2
00914      ADD 1 TO SUB2.                                                  CL**2
00915      ADD 1 TO SUB1.                                                  CL**2
00916      GO TO 6030-TITLE-LOOP-2.                                        CL**2
00917  6099-EXTRACT-VALUE-XIT.                                             CL**2
00918      EXIT.                                                           CL**2
00919                                                                    DCRETS 
00920 ******************************************************               CL**2
00921 *                                                                    CL**2
00922 *    TABLE ERROR CODE SUBROUTINE                                     CL**2
00923 *                                                                    CL**2
00924 ******************************************************               CL**2
00925  6100-ERROR-RTN.                                                     CL**2
00926      ADD 1 TO ERROR-COUNT.                                           CL**2
00927      IF ERROR-COUNT IS GREATER THAN 20                               CL**2
00928          GO TO 6199-ERROR-RTN-XIT.                                   CL**2
00929      MOVE ERROR-CODE TO ERROR-BUILD (ERROR-COUNT).                   CL**2
00930  6199-ERROR-RTN-XIT.                                                 CL**2
00931      EXIT.                                                           CL**2
00932 **********************************************************           CL**2
00933 *                                                                    CL**2
00934 *    PRINT REQUEST ROUTINE                                           CL**2
00935 *                                                                    CL**2
00936 **********************************************************           CL**2
00937  6200-PRINT-STMT.                                                    CL**2
00938      MOVE TRANS-IN TO USER-STMT.                                     CL**2
00939      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00940  6299-PRINT-STMT-XIT.                                                CL**2
00941      EXIT.                                                           CL**2
00942 *                                                                    CL**2
00943 *    OUTPUT REPORT HEADING                                           CL**2
00944 *                                                                    CL**2
00945  6300-PRT-HDG.                                                       CL**2
00946      MOVE SPACES TO PRINT-LINE.                                      CL**2
00947      MOVE SPACES TO ERROR-CODES.                                     CL**2
00948      MOVE ZERO TO ERROR-COUNT.                                       CL**2
00949      MOVE SPACES TO QUERY-REQUEST.                                   CL**2
00950      MOVE 1 TO PRT-CTL.                                              CL**2
00951      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00952      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00953  6399-PRT-HDG-XIT.                                                   CL**2
00954      EXIT.                                                           CL**2
00955 *                                                                    CL**2
00956 *    END OF REPORT SUMMARY LINES                                     CL**2
00957 *                                                                    CL**2
00958  7000-FIRST-LINE-PRINT.                                              CL**2
00959      MOVE TOTAL-MESS-1 TO USER-STMT.                                 CL**2
00960      GO TO 7500-ALL-LINES-PRINT.                                     CL**2
00961  7100-FIRST-LINEA-PRINT.                                             CL**2
00962      MOVE TOTAL-MESS-5 TO USER-STMT.                                 CL**2
00963      GO TO 7500-ALL-LINES-PRINT.                                     CL**2
00964  7200-FIRST-LINEB-PRINT.                                             CL**2
00965      MOVE TOTAL-MESS-6 TO USER-STMT.                                 CL**2
00966      GO TO 7500-ALL-LINES-PRINT.                                     CL**2
00967  7250-FIRST-LINEC-PRINT.                                             CL**2
00968      MOVE TOTAL-MESS-7 TO USER-STMT.                                 CL**2
00969      GO TO 7500-ALL-LINES-PRINT.                                     CL**2
00970  7300-SECOND-LINE-PRINT.                                             CL**2
00971      MOVE TOTAL-MESS-2 TO USER-STMT.                                 CL**2
00972      GO TO 7500-ALL-LINES-PRINT.                                     CL**2
00973  7400-THIRD-LINE-PRINT.                                              CL**2
00974      MOVE TOTAL-MESS-3 TO USER-STMT.                                 CL**2
00975  7500-ALL-LINES-PRINT.                                               CL**2
00976      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00977      MOVE SPACES TO STMT-LINE.                                       CL**2
00978      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00979  7600-PRINT-EOJ-LINES.                                               CL**2
00980      EXIT.                                                           CL**2
       USER-ROUTINE.
           GO TO USER-ROUTINE-XIT.
       USER-ROUTINE-XIT.
           EXIT.
*CALL     DISPLAYLN                                                        CL**2
*CALL     WRITELN                                                          CL**2
