*DECK     DCRETR
00001  IDENTIFICATION DIVISION.                                         09/26/78
       PROGRAM-ID. RETR.
*CALL COPYRIGHT 
      * PERFORM INITIAL EDITS OF STATEMENT TYPE AND SEQUENCE
      * PRINT QUERY REQUEST (ONE COMMAND) 
      * TABLE COMMAND AND TITTLE
00010  ENVIRONMENT DIVISION.                                               CL**2
00011  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
*CALL UPQRYSN 
00014  INPUT-OUTPUT SECTION.                                               CL**2
00015  FILE-CONTROL.                                                       CL**2
           SELECT SYSINPUT ASSIGN TO "INPUT". 
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
00018  DATA DIVISION.                                                      CL**2
00019  FILE SECTION.                                                       CL**2
00020  FD  SYSINPUT                                                        CL**2
00021      LABEL RECORDS ARE OMITTED                                       CL**2
00022      DATA RECORD IS TRANS-IN.                                        CL**2
00023  01  TRANS-IN.                                                       CL**2
00024      03  USER-STMT-IN            PICTURE X(72).                      CL**2
00025      03  STMT-SEQNO              PICTURE X(8).                       CL**2
00026                                                                    DCRETR 
*CALL     SYSPRTFD                                                         CL**2
00028                                                                    DCRETR 
*CALL QRYCSR
00029  WORKING-STORAGE SECTION.                                            CL**2
00030  77  ERROR-CODE                  PICTURE XX.                         CL**2
00031  77  STORE-SUB                   PICTURE 99.                         CL**2
00032  77  QRY-SUB                     PICTURE 9.                          CL**2
00033  77  SUB1    PICTURE 99 COMP.                                        CL**2
00034  77  SUB2    PICTURE 99 COMP.                                        CL**2
00035  77  SUB3    PICTURE 99 COMP.                                        CL**2
00036  77  END-STATE-FLAG   PICTURE X.                                     CL**2
00037  77  ON-LINE-SW              PICTURE X  VALUE "N".                   CL**2
00038  77  END-SW                      PICTURE X VALUE " ".                CL**2
00039  77  EXTRACT-SW                  PICTURE X VALUE " ".                CL**2
00041  77  ERROR-REQUEST               PICTURE X VALUE "N".                CL**2
00042                                                                    DCRETR 
00043 *                                                                    CL**2
00044 *    REQUEST TRANSACTION                                             CL**2
00045 *                                                                    CL**2
00046  01  TRANS-WORK.                                                     CL**2
00047      03  QUERY-TRANS.                                                CL**2
00048          05  FIRST-TEN.                                              CL**2
00049              07  FIRST-SEVEN.                                        CL**2
00050                  09  FIRST-SIX.                                      CL**2
00051                      11  FIRST-FIVE.                                 CL**2
00052                          13  FIRST-FOUR.                             CL**2
00053                              15  BYTE-1  PICTURE X.                  CL**2
00054                              15  FILLER  PICTURE XXX.                CL**2
00055                          13  FILLER      PICTURE X.                  CL**2
00056                      11  FILLER  PICTURE X.                          CL**2
00057                  09  FILLER      PICTURE X.                          CL**2
00058              07  FILLER          PICTURE XXX.                        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      03  ON-LINE-USAGE  REDEFINES  COUNT-TRANS.                      CL**2
00072          05  ON-LINE-SINGLE      PICTURE X OCCURS 72 TIMES.          CL**2
00073                                                                    DCRETR 
00074 *                                                                    CL**2
00075 *    MESSAGES TO APPEAR AT END OF PROCESSING                         CL**2
00076 *                                                                    CL**2
00077  01  TOTAL-MESSAGES.                                                 CL**2
00078      03  TOTAL-MESS-1.                                               CL**2
00079          05  FILLER              PICTURE X(36)   VALUE               CL**2
00080             "*** TOTAL QUERY COMMANDS ATTEMPTED= ".                  CL**2
00081          05  TOTAL-PROC          PICTURE ZZZ9.                       CL**2
00082      03  TOTAL-MESS-2.                                               CL**2
00083          05  FILLER              PICTURE X(15)   VALUE SPACES.       CL**2
00084          05  FILLER              PICTURE X(30)   VALUE               CL**2
00085             "*** TOTAL COMMANDS ACCEPTED=  ".                        CL**2
00086          05  TOTAL-ACC           PICTURE ZZZ9.                       CL**2
00087      03  TOTAL-MESS-3.                                               CL**2
00088          05  FILLER              PICTURE X(15)   VALUE SPACES.       CL**2
00089          05  FILLER              PICTURE X(30)   VALUE               CL**2
00090             "*** TOTAL COMMANDS REJECTED=  ".                        CL**2
00091          05  TOTAL-REJ           PICTURE ZZZ9.                       CL**2
00092      03  TOTAL-MESS-4            PICTURE X(44)   VALUE               CL**2
00093             "*** END DATA CATALOGUE RETRIEVAL REPORTS ***".          CL**2
           03  TOTAL-ACCUM             PICTURE S9(4) COMP-1 VALUE ZERO. 
           03  TOTAL-GOOD              PICTURE S9(4) COMP-1 VALUE ZERO. 
           03  TOTAL-BAD               PICTURE S9(4) COMP-1 VALUE ZERO. 
00105                                                                    DCRETR 
00106 *                                                                    CL**2
00107 *    HOLD AREA FOR TITLE                                             CL**2
00108 *                                                                    CL**2
00109  01  HOLD-VALUE.                                                     CL**2
00110      03  WORK-VALUE              PICTURE X OCCURS 50 TIMES.          CL**2
00116  01  TITLE-HOLD-AREA.                                                CL**2
00117      03  QUERY-COMMAND-HOLD      PICTURE X(80).                      CL**2
00127                                                                    DCRETR 
00145                                                                    DCRETR 
00152                                                                    DCRETR 
00153  PROCEDURE DIVISION.                                                 CL**2
00154 **********************************************************           CL**2
00155 **********************************************************           CL**2
00156 *                                                                    CL**2
00157 *    INITIALIZATION                                                  CL**2
00158 *                                                                    CL**2
00159 **********************************************************           CL**2
00160 **********************************************************           CL**2
00161  0000-BEGIN.                                                         CL**2
           MOVE ZEROS TO RETURN-CODE. 
           IF INTERACTIVE MOVE "Y" TO ON-LINE-SW. 
00162      OPEN INPUT SYSINPUT.                                            CL**2
           OPEN OUTPUT SYSPRINT WITH NO REWIND. 
00164      MOVE SPACES TO QTBL-HDR-ENT.                                    CL**2
00165      MOVE SPACES TO PRINT-LINE.                                      CL**2
00166      MOVE SPACES TO ERROR-CODES.                                     CL**2
00167      MOVE ZERO TO ERROR-COUNT.                                       CL**2
           MOVE ZERO TO RETURN-CODE.
00168 *                                                                    CL**2
00169 *    READ 1ST STATEMENT MUST BE FUNCTION HEADER                      CL**2
00170 *                                                                    CL**2
00171  0100-READ-1ST.                                                      CL**2
           IF ON-LINE-SW EQUAL TO "Y" 
               PERFORM 5100-PRINT-INPUT THRU 5199-PRINT-INPUT-XIT.
00172      READ SYSINPUT AT END GO TO 1900-NO-INPUT-ERR.                   CL**2
00173      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF TRANS-WORK (1 : 6) IS EQUAL TO "$QUERY" 
           THEN 
              GO TO 1000-QRY-REQUEST
           ELSE 
              IF ON-LINE-SW IS EQUAL TO "Y" 
              THEN
                 MOVE "D" TO 8BY11-FLAG 
              END-IF
              PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT
              GO TO 1905-QUERY-SEQ-ERROR
           END-IF.
00181 **********************************************************           CL**2
00182 **********************************************************           CL**2
00183 *                                                                    CL**2
00184 *    PROCESS $QUERY REQUEST                                          CL**2
00185 *                                                                    CL**2
00186 **********************************************************           CL**2
00187 **********************************************************           CL**2
00188  1000-QRY-REQUEST.                                                   CL**2
00197      MOVE "N" TO ERROR-CHECK.                                        CL**2
00198      MOVE "N" TO EXTRACT-SW.                                         CL**2
00200      MOVE SPACES TO END-SW.                                          CL**2
00201      MOVE "Q" TO TYPE-OUTPUT-CODE.                                   CL**2
           CALL "QRY001". 
00203      IF ON-LINE-SW EQUAL "Y"                                         CL**2
00204         MOVE "D" TO 8BY11-FLAG.                                      CL**2
00205      MOVE ZERO TO SUB3.                                              CL**2
00206      MOVE TRANS-IN TO QUERY-COMMAND-HOLD.                            CL**2
00238 *************************************************************        CL**2
00239 *    PROCESS TITLE STATEMENT (IF PRESENT)                            CL**2
00240 *************************************************************        CL**2
00241  1100-QRY-TITLE.                                                     CL**2
00242      IF ON-LINE-SW EQUAL TO "Y"                                      CL**2
00243          PERFORM 5100-PRINT-INPUT THRU 5199-PRINT-INPUT-XIT.         CL**2
00244      READ SYSINPUT AT END                                            CL**2
00245          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT                  CL**2
00246          MOVE QUERY-COMMAND-HOLD TO USER-STMT                        CL**2
00247          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00248          GO TO 1950-NO-CMD-ERR.                                      CL**2
00249      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF TRANS-WORK (1 : 5) IS EQUAL TO "TITLE"
00251          GO TO 1111-HAVE-TITLE.                                      CL**2
00252          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT                  CL**2
00253      IF ON-LINE-SW EQUAL "N"                                         CL**2
00254          MOVE QUERY-COMMAND-HOLD TO USER-STMT                        CL**2
00255          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00256      GO TO 1300-BYPASS-COMM.                                         CL**2
00257  1111-HAVE-TITLE.                                                    CL**2
00258      PERFORM 6000-EXTRACT-VALUE THRU 6099-EXTRACT-VALUE-XIT.         CL**2
00259      IF EXTRACT-SW EQUAL TO "Y"                                      CL**2
00260          MOVE HOLD-VALUE TO USER-TITLE                               CL**2
00261          GO TO 1160-NEXT-TX.                                         CL**2
00262      PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                     CL**2
           IF ON-LINE-SW EQUAL "N"
               MOVE QUERY-COMMAND-HOLD TO USER-STMT 
               PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
00265      GO TO 1912-COMMON-ERR13.                                        CL**2
00266  1160-NEXT-TX.                                                       CL**2
           PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.
           IF ON-LINE-SW EQUAL "N"
               MOVE QUERY-COMMAND-HOLD TO USER-STMT 
               PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
00269      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00270  1200-NEXT-TX.                                                       CL**2
00271      IF ON-LINE-SW EQUAL "Y"                                         CL**2
00272          PERFORM 5100-PRINT-INPUT THRU 5199-PRINT-INPUT-XIT.         CL**2
00273      READ SYSINPUT AT END GO TO 1950-NO-CMD-ERR.                     CL**2
00274      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
00275                                                                    DCRETR 
00276 **********************************************************           CL**2
00277 *                                                                    CL**2
00278 *    PROCESS COUNT, LIST AND SHOW COMMANDS AND COMMENTS              CL**2
00279 *                                                                    CL**2
00280 *        PRINT COMMENTS                                              CL**2
00281 *        TABLE AND PRINT COMMAND AND CONTINUATION STMTS              CL**2
00282 *                                                                    CL**2
00283 *********************************************************            CL**2
00284  1300-BYPASS-COMM.                                                   CL**2
           IF TRANS-WORK (1 : 1) IS NOT EQUAL TO "*"
00286          GO TO 1310-CK-COMMAND.                                      CL**2
00287  1305-PRINT-COMM.                                                    CL**2
00288      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00289      GO TO 1200-NEXT-TX.                                             CL**2
00290  1310-CK-COMMAND.                                                    CL**2
00291      PERFORM 5200-END-STATE THRU 5200-END-STATE-XIT.                 CL**2
           IF TRANS-WORK (1 : 5) IS EQUAL TO "COUNT"
00295          GO TO 1350-COUNT-CMD.                                       CL**2
           IF TRANS-WORK (1 : 4) IS EQUAL TO "LIST" OR "SHOW" 
00297          GO TO 1360-OTHER-CMD.                                       CL**2
00298      GO TO 1910-STMT-SEQ-ERR.                                        CL**2
00299 *                                                                    CL**2
00300 *    PROCESS NEXT CARD---MUST BE A SELECT CARD                       CL**2
00301 *                                                                    CL**2
00310 *                                                                    CL**2
00311 *      PROCESS COMMAND HEADER                                        CL**2
00312 *                                                                    CL**2
00313  1350-COUNT-CMD.                                                     CL**2
00314      MOVE MOVE-C TO QRY-HOLD (1).                                    CL**2
00315      GO TO 1370-FINI-HDR.                                            CL**2
00316  1360-OTHER-CMD.                                                     CL**2
00317      MOVE BYTES6-72 TO QRY-HOLD (1).                                 CL**2
00318  1370-FINI-HDR.                                                      CL**2
00319      MOVE BYTE-1 TO QRYTYPE-1.                                       CL**2
00320      MOVE "01" TO STORE-SUB.                                         CL**2
00321 *                                                                    CL**2
00322 *    TABLE CONTINUATION STATMENTS/ BYPASS COMMENTS                   CL**2
00323 *             UNTIL NEXT $ STATMENT                                  CL**2
00324 *                                                                    CL**2
00325  1400-FIND-CONT.                                                     CL**2
00326      PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.               CL**2
00327      IF END-STATE-FLAG EQUAL "Y"                                     CL**2
00328         GO TO 1610-GOOD-COMMAND.                                     CL**2
00329      IF ON-LINE-SW EQUAL TO "Y"                                      CL**2
00330          PERFORM 5100-PRINT-INPUT THRU 5199-PRINT-INPUT-XIT.         CL**2
00331      READ SYSINPUT AT END GO TO 1600-LAST-COMMAND.                   CL**2
00332      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF TRANS-WORK (1 : 1) IS EQUAL TO "$" OR "S" OR "C" OR "L" 
00334          GO TO 1610-GOOD-COMMAND.                                    CL**2
           IF TRANS-WORK (1 : 1) IS EQUAL TO "*"
00336          GO TO 1610-GOOD-COMMAND.                                    CL**2
           IF TRANS-WORK (1 : 1) IS NOT EQUAL TO SPACE
00338          GO TO 1910-STMT-SEQ-ERR.                                    CL**2
00339      ADD 1 TO STORE-SUB.                                             CL**2
00340      IF STORE-SUB GREATER THAN 3                                     CL**2
00341          GO TO 1960-CONT-ERR.                                        CL**2
00342      PERFORM 5200-END-STATE THRU 5200-END-STATE-XIT.                 CL**2
00343      MOVE MOVE-CONT TO QRY-HOLD (STORE-SUB).                         CL**2
00344      GO TO 1400-FIND-CONT.                                           CL**2
00345                                                                    DCRETR 
00406                                                                    DCRETR 
00407 **********************************************************           CL**2
00408 *                                                                    CL**2
00409 *    END INITIAL EDIT OF COMMAND - CALL EDIT02                       CL**2
00410 *                                                                    CL**2
00411 ********************************************************             CL**2
00412  1600-LAST-COMMAND.                                                  CL**2
00413      MOVE "Y" TO END-SW.                                             CL**2
00414  1610-GOOD-COMMAND.                                                  CL**2
           CLOSE SYSPRINT WITH NO REWIND. 
00421  1630-CALL-EDIT.                                                     CL**2
           CALL "QRY010". 
00424                                                                    DCRETR 
00425 *******************************************************              CL**2
00426 *    PROCESSING RETURNS FROM OUTSIDE EDITS TO HERE                   CL**2
00427 *******************************************************              CL**2
00428  1700-PROCESS-OVER.                                                  CL**2
00429      MOVE SPACES TO QTBL-HDR-ENT.                                    CL**2
00432      IF EXTRACT-SW EQUAL TO SPACES                                   CL**2
00433          MOVE "Y" TO ERROR-REQUEST                                   CL**2
00434          GO TO 1730-RETURN-PROCESSING.                               CL**2
00435      ADD 1 TO TOTAL-ACCUM.                                           CL**2
00436      IF ERROR-COUNT EQUAL TO ZERO                                    CL**2
00437          ADD 1 TO TOTAL-GOOD                                         CL**2
00438          GO TO 1730-RETURN-PROCESSING.                               CL**2
00439      ADD 1 TO TOTAL-BAD.                                             CL**2
00440      GO TO 1720-SET-FLAG.                                            CL**2
00447  1720-SET-FLAG.                                                      CL**2
00448      MOVE "Y" TO ERROR-REQUEST.                                      CL**2
00449  1730-RETURN-PROCESSING.                                             CL**2
00450 ******************************************************               CL**2
00451 *                                                                    CL**2
00452 *    PROCESS NEXT COMMAND (UPON RETURN FROM PROCESSING)              CL**2
00453 *                                                                    CL**2
00454 *******************************************************              CL**2
00455      IF END-SW EQUAL TO "Y"                                          CL**2
00456          GO TO 1800-EOJ.                                             CL**2
00457      IF ERROR-CHECK EQUAL TO "Y"                                     CL**2
00458          MOVE "E" TO END-SW.                                         CL**2
00459      MOVE SPACES TO ERROR-CODES.                                     CL**2
00460      MOVE ZERO TO ERROR-COUNT.                                       CL**2
           OPEN OUTPUT SYSPRINT WITH NO REWIND. 
00462      IF END-SW EQUAL TO "C"                                          CL**2
00463          MOVE 99 TO LINE-CT                                          CL**2
00464          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT                  CL**2
00465          GO TO 1912-GENER-SEQ-ERR.                                   CL**2
00466      IF ON-LINE-SW EQUAL TO "Y"                                      CL**2
00467          PERFORM 5100-PRINT-INPUT THRU 5199-PRINT-INPUT-XIT.         CL**2
00468      READ SYSINPUT AT END                                            CL**2
00469          GO TO 1801-EOJ.                                             CL**2
00470      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF TRANS-WORK (1 : 6) IS EQUAL TO "$QUERY" 
00472           GO TO 1000-QRY-REQUEST.                                    CL**2
00475      IF END-SW EQUAL TO "E"                                          CL**2
00476          GO TO 1920-BYPASS-STMTS.                                    CL**2
00477          MOVE 99 TO LINE-CT                                          CL**2
00478          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                 CL**2
00479      GO TO 1300-BYPASS-COMM.                                         CL**2
00480                                                                    DCRETR 
00481 *********************************************************            CL**2
00482 *                                                                    CL**2
00483 *    END OF JOB PROCESSING                                           CL**2
00484 *                                                                    CL**2
00485 **************************************************                   CL**2
00486  1800-EOJ.                                                           CL**2
           OPEN OUTPUT SYSPRINT WITH NO REWIND. 
00488  1801-EOJ.                                                           CL**2
00489          MOVE 99 TO LINE-CT                                          CL**2
00490          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                 CL**2
00491      IF ERROR-REQUEST EQUAL TO "N"                                   CL**2
00492          MOVE ZERO TO RETURN-CODE ELSE                               CL**2
00493          MOVE "08" TO RETURN-CODE.                                   CL**2
00494      MOVE SPACES TO STMT-LINE.                                       CL**2
00497      MOVE TOTAL-ACCUM TO TOTAL-PROC.                                 CL**2
00498      PERFORM FIRST-LINE-PRINT THRU PRINT-EOJ-LINES.                  CL**2
00499      MOVE TOTAL-GOOD TO TOTAL-ACC.                                   CL**2
00500      PERFORM SECOND-LINE-PRINT THRU PRINT-EOJ-LINES.                 CL**2
00501      MOVE TOTAL-BAD TO TOTAL-REJ.                                    CL**2
00502      PERFORM THIRD-LINE-PRINT THRU PRINT-EOJ-LINES.                  CL**2
00512 *                                                                    CL**2
00513 *    FINAL END OF JOB MESSAGE IS PRINTED--JOB ENDED                  CL**2
00514 *                                                                    CL**2
00515  1810-END-OF-JOB.                                                    CL**2
00516          MOVE 99 TO LINE-CT                                          CL**2
00517          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT.                 CL**2
00518      MOVE TOTAL-MESS-4 TO STMT-LINE.                                 CL**2
00519      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
           CLOSE SYSPRINT WITH NO REWIND. 
00521      CLOSE SYSINPUT.                                                 CL**2
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
00522      STOP RUN.                                                       CL**2
*CALL RETCODE 
00523                                                                    DCRETR 
00524 **********************************************************           CL**2
00525 *                                                                    CL**2
00526 *    QUERY REQUEST ERROR ROUTINES                                    CL**2
00527 *    COME HERE WHEN NO COMMAND INPUT IS SUBMITTED                    CL**2
00528 *                                                                    CL**2
00529 ******************************************************************   CL**2
00530  1900-NO-INPUT-ERR.                                                  CL**2
00531      MOVE "02" TO ERROR-CODE.                                        CL**2
00532      IF ON-LINE-SW EQUAL TO "N"                                      CL**2
00533          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00534      GO TO 1600-LAST-COMMAND.                                        CL**2
00535 *                                                                    CL**2
00536 *    COME HERE WHEN NO FUNCTION HEADER FOUND AT START                CL**2
00537 *                                                                    CL**2
00538  1905-QUERY-SEQ-ERROR.                                               CL**2
00539      MOVE "36" TO ERROR-CODE.                                        CL**2
00540      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
           MOVE "33" TO ERROR-CODE. 
           PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.
           PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.
           MOVE "E" TO END-SW.
           GO TO 1610-GOOD-COMMAND. 
00542 *                                                                    CL**2
00543 *    STATEMENT MISSING OR OUT OF ORDER                               CL**2
00544 *        BYPASS UNTIL NEXT FUNCTION HEADER                           CL**2
00545 *                                                                    CL**2
00546  1910-STMT-SEQ-ERR.                                                  CL**2
00547      IF TYPE-OUTPUT-CODE EQUAL TO "G"                                CL**2
00548          GO TO 1980-ILLEGAL-CARD.                                    CL**2
00549  1912-GENER-SEQ-ERR.                                                 CL**2
00550      IF TYPE-OUTPUT-CODE NOT EQUAL TO "G"                            CL**2
               GO TO 1911-INVALID-COMMAND.
00552  1912-COMMON-ERR13.                                                  CL**2
           MOVE "01" TO ERROR-CODE. 
00554      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00555      GO TO 1915-BYPASS.                                              CL**2
       1911-INVALID-COMMAND.
           MOVE "37" TO ERROR-CODE. 
           PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.
       1915-BYPASS. 
           PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.
           MOVE SPACES TO END-SW. 
           GO TO 1610-GOOD-COMMAND. 
00575  1920-BYPASS-STMTS.                                                  CL**2
00576      MOVE SPACES TO STMT-LINE.                                       CL**2
00577      MOVE "3" TO PRT-CTL.                                            CL**2
00578      IF ON-LINE-SW EQUAL TO "N"                                      CL**2
00579          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00580          PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.           CL**2
00581      MOVE SPACE TO END-SW.                                           CL**2
00582  1925-SKIPPED-LINES.                                                 CL**2
00583      IF ON-LINE-SW EQUAL TO "Y"                                      CL**2
00584          PERFORM 5100-PRINT-INPUT THRU 5199-PRINT-INPUT-XIT.         CL**2
00585      READ SYSINPUT AT END                                            CL**2
           CLOSE SYSPRINT WITH NO REWIND
00587          GO TO 1800-EOJ.                                             CL**2
00588      MOVE TRANS-IN TO TRANS-WORK.                                    CL**2
           IF TRANS-WORK (1 : 6) IS EQUAL TO "$QUERY" 
00590          GO TO 1000-QRY-REQUEST.                                     CL**2
00593          PERFORM 6200-PRINT-STMT THRU 6299-PRINT-STMT-XIT.           CL**2
00599  1933-CK-QUERY-ADD.                                                  CL**2
00600      IF EXTRACT-SW EQUAL TO SPACES                                   CL**2
00601          GO TO 1935-BYPASS-CONTINUED.                                CL**2
00602      ADD 1 TO TOTAL-ACCUM.                                           CL**2
00603      ADD 1 TO TOTAL-BAD.                                             CL**2
00604  1935-BYPASS-CONTINUED.                                              CL**2
00605      IF END-SW EQUAL TO SPACE                                        CL**2
00606          GO TO 1925-SKIPPED-LINES.                                   CL**2
00607  1950-NO-CMD-ERR.                                                    CL**2
00610      MOVE "35" TO ERROR-CODE.                                        CL**2
00611      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00612  1953-COMM-ERR.                                                      CL**2
00613      GO TO 1600-LAST-COMMAND.                                        CL**2
00617  1960-CONT-ERR.                                                      CL**2
00621      MOVE "34" TO ERROR-CODE.                                        CL**2
00622  1961-PROCESS-ERR.                                                   CL**2
00623      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00624      GO TO 1915-BYPASS.                                              CL**2
00625  1980-ILLEGAL-CARD.                                                  CL**2
00626      MOVE "C" TO END-SW.                                             CL**2
00627      GO TO 1610-GOOD-COMMAND.                                        CL**2
00628  1985-BAD-SYNTAX.                                                    CL**2
00629      MOVE "13" TO ERROR-CODE.                                        CL**2
00630      PERFORM 6100-ERROR-RTN THRU 6199-ERROR-RTN-XIT.                 CL**2
00631      MOVE SPACE TO END-SW.                                           CL**2
00632          MOVE 99 TO LINE-CT                                          CL**2
00633          PERFORM 6300-PRT-HDG THRU 6399-PRT-HDG-XIT                  CL**2
00634      GO TO 1400-FIND-CONT.                                           CL**2
00635                                                                    DCRETR 
00636 *******************************************************              CL**2
00637 *******************************************************              CL**2
00638 *                                                                    CL**2
00639 *     SUBROUTINES                                                    CL**2
00640 *                                                                    CL**2
00641 ********************************************************             CL**2
00642 ********************************************************             CL**2
00666 *                                                                    CL**2
00667 *    ROUTINE TO PRINT THE WORD "INPUT?" IN CMS/TSO SYSTEM            CL**2
00668 *                                                                    CL**2
00669  5100-PRINT-INPUT.                                                   CL**2
           MOVE "INPUT?" TO USER-STMT.
           MOVE "D" TO 8BY11-FLAG.
00671      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00672  5199-PRINT-INPUT-XIT.                                               CL**2
00673      EXIT.                                                           CL**2
00674 *                                                                    CL**2
00675 *    ROUTINE TO EXTRACT THE TITLE FROM A QUERY                       CL**2
00676 *                                                                    CL**2
00677  5200-END-STATE.                                                     CL**2
00678      MOVE "Y" TO END-STATE-FLAG.                                     CL**2
00679      MOVE 72 TO SUB1.                                                CL**2
00680  5200-END-STATE-LOOP.                                                CL**2
00681      IF ON-LINE-SINGLE (SUB1) NOT EQUAL SPACE                        CL**2
00682            GO TO 5200-END-STATE-COMMA.                               CL**2
00683      SUBTRACT 1 FROM SUB1.                                           CL**2
00684      IF SUB1 GREATER THAN 1                                          CL**2
00685           GO TO 5200-END-STATE-LOOP.                                 CL**2
00686  5200-END-STATE-XIT.                                                 CL**2
00687      EXIT.                                                           CL**2
00688  5200-END-STATE-COMMA.                                               CL**2
00689      IF ON-LINE-SINGLE (SUB1) EQUAL ","                              CL**2
00690          MOVE SPACE TO ON-LINE-SINGLE (SUB1)                         CL**2
00691          MOVE "N" TO END-STATE-FLAG.                                 CL**2
00692      GO TO 5200-END-STATE-XIT.                                       CL**2
00693  6000-EXTRACT-VALUE.                                                 CL**2
00694      MOVE SPACES TO HOLD-VALUE.                                      CL**2
00695      MOVE "N" TO EXTRACT-SW.                                         CL**2
00696      MOVE 01 TO SUB1.                                                CL**2
00697      MOVE 01 TO SUB2.                                                CL**2
00698  6010-TITLE-LOOP-1.                                                  CL**2
00699      IF TITLE-WORK (SUB1) NOT EQUAL TO SPACES                        CL**2
00700          GO TO 6020-TITLE-QUOTE.                                     CL**2
00701      ADD 1 TO SUB1.                                                  CL**2
00702      IF SUB1 LESS THAN 65                                            CL**2
00703          GO TO 6010-TITLE-LOOP-1.                                    CL**2
00704      GO TO 6099-EXTRACT-VALUE-XIT.                                   CL**2
00705  6020-TITLE-QUOTE.                                                   CL**2
00706      IF TITLE-WORK (SUB1) NOT EQUAL TO QUOTE                         CL**2
00707          GO TO 6099-EXTRACT-VALUE-XIT.                               CL**2
00708      ADD 1 TO SUB1.                                                  CL**2
00709  6030-TITLE-LOOP-2.                                                  CL**2
00710      IF TITLE-WORK (SUB1) EQUAL TO QUOTE                             CL**2
00711          MOVE "Y" TO EXTRACT-SW                                      CL**2
00712          GO TO 6099-EXTRACT-VALUE-XIT.                               CL**2
00713      IF SUB2 GREATER THAN 50                                         CL**2
00714          GO TO 6099-EXTRACT-VALUE-XIT.                               CL**2
00715      IF SUB1 GREATER THAN 65                                         CL**2
00716          GO TO 6099-EXTRACT-VALUE-XIT.                               CL**2
00717      MOVE TITLE-WORK (SUB1) TO WORK-VALUE (SUB2).                    CL**2
00718      ADD 1 TO SUB2.                                                  CL**2
00719      ADD 1 TO SUB1.                                                  CL**2
00720      GO TO 6030-TITLE-LOOP-2.                                        CL**2
00721  6099-EXTRACT-VALUE-XIT.                                             CL**2
00722      EXIT.                                                           CL**2
00723                                                                    DCRETR 
00724 ******************************************************               CL**2
00725 *                                                                    CL**2
00726 *    TABLE ERROR CODE SUBROUTINE                                     CL**2
00727 *                                                                    CL**2
00728 ******************************************************               CL**2
00729  6100-ERROR-RTN.                                                     CL**2
00730      ADD 1 TO ERROR-COUNT.                                           CL**2
00731      IF ERROR-COUNT IS GREATER THAN 20                               CL**2
00732          GO TO 6199-ERROR-RTN-XIT.                                   CL**2
00733      MOVE ERROR-CODE TO ERROR-BUILD (ERROR-COUNT).                   CL**2
00734  6199-ERROR-RTN-XIT.                                                 CL**2
00735      EXIT.                                                           CL**2
00736 **********************************************************           CL**2
00737 *                                                                    CL**2
00738 *    PRINT REQUEST ROUTINE                                           CL**2
00739 *                                                                    CL**2
00740 **********************************************************           CL**2
00741  6200-PRINT-STMT.                                                    CL**2
00742      IF ON-LINE-SW EQUAL TO "Y"                                      CL**2
00743          GO TO 6299-PRINT-STMT-XIT.                                  CL**2
00744      MOVE TRANS-IN TO USER-STMT.                                     CL**2
00745      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00746  6299-PRINT-STMT-XIT.                                                CL**2
00747      EXIT.                                                           CL**2
00748 *                                                                    CL**2
00749 *    OUTPUT REPORT HEADING                                           CL**2
00750 *                                                                    CL**2
00751  6300-PRT-HDG.                                                       CL**2
00752      MOVE SPACES TO PRINT-LINE.                                      CL**2
00753      MOVE SPACES TO ERROR-CODES.                                     CL**2
00754      MOVE ZERO TO ERROR-COUNT.                                       CL**2
00755      MOVE SPACES TO QUERY-REQUEST.                                   CL**2
00756      MOVE 1 TO PRT-CTL.                                              CL**2
00757      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00758      IF ON-LINE-SW EQUAL "N"                                         CL**2
00759      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00760  6399-PRT-HDG-XIT.                                                   CL**2
00761      EXIT.                                                           CL**2
00762 *                                                                    CL**2
00763 *    END OF REPORT SUMMARY LINES                                     CL**2
00764 *                                                                    CL**2
00765  FIRST-LINE-PRINT.                                                   CL**2
00766      MOVE TOTAL-MESS-1 TO USER-STMT.                                 CL**2
00767      GO TO ALL-LINES-PRINT.                                          CL**2
00771  SECOND-LINE-PRINT.                                                  CL**2
00772      MOVE TOTAL-MESS-2 TO USER-STMT.                                 CL**2
00773      GO TO ALL-LINES-PRINT.                                          CL**2
00774  THIRD-LINE-PRINT.                                                   CL**2
00775      MOVE TOTAL-MESS-3 TO USER-STMT.                                 CL**2
00776  ALL-LINES-PRINT.                                                    CL**2
00777      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00778      MOVE SPACES TO STMT-LINE.                                       CL**2
00779      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00780  PRINT-EOJ-LINES.                                                    CL**2
00781      EXIT.                                                           CL**2
*CALL     DISPLAYLN                                                        CL**2
*CALL     WRITELN                                                          CL**2
00784  USER-ROUTINE.                                                       CL**2
00785      GO TO USER-ROUTINE-XIT.                                         CL**2
00786  USER-ROUTINE-XIT.                                                   CL**2
00787      EXIT.                                                           CL**2
