*DECK     DCQRY200
00001  IDENTIFICATION DIVISION.                                         08/07/78
       PROGRAM-ID. QRY200.
*CALL COPYRIGHT 
      *    THIS SEGMENT FORMATS THE QUERY RESPONSE REPORT FOR 
      *    THE LIST AND COUNT FUNCTIONS.
      * 
00009  ENVIRONMENT DIVISION.                                            DCQRY200
00010  CONFIGURATION SECTION.                                           DCQRY200
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
*CALL UPQRYSN 
00013  INPUT-OUTPUT SECTION.                                            DCQRY200
00014  FILE-CONTROL.                                                    DCQRY200
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CON-KEY
               USE "PRUF = YES".
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
00022  DATA DIVISION.                                                   DCQRY200
00023  FILE SECTION.                                                    DCQRY200
*CALL     MAST3FD                                                          CL**5
*CALL     SYSPRTFD                                                         CL**5
*CALL QRYCS 
00026  WORKING-STORAGE SECTION.                                         DCQRY200
00027  01  MODULE-WORK-AREAS.                                           DCQRY200
00028      03  WORK-FIELDS.                                             DCQRY200
00029          05  HIT-WORK-REC.                                        DCQRY200
00030              07  HIT-WORK-NAME   PICTURE X(32).                   DCQRY200
00031              07  HIT-WORK-ENTTYPE    PICTURE XX.                  DCQRY200
00032              07  HIT-WORK-TIMES PICTURE 999 .                      DCQRY20
               05  HIT-TBL-LIMIT           PICTURE 9999 VALUE 1000. 
00034          05  HIT-TBL-LIMIT-PLUS1 PICTURE 99  VALUE  26.           DCQRY200
00035          05  1ST-HIT-OVER-SW     PICTURE X   VALUE  "X".          DCQRY200
00036          05  HIT-COUNTER         PICTURE 9(5) VALUE  0.           DCQRY200
00037          05  HITS-PER-RECORD PICTURE 99 VALUE 86.                    CL**2
               05  CON-KEY PICTURE 999. 
               05  SUB1               PICTURE 9(4) COMP-1.
00040          05  SUB2                PICTURE S99   COMP SYNC.         DCQRY200
00041          05  SUB3                PICTURE S99   COMP SYNC.         DCQRY200
00042          05  SUB4                PICTURE S99   COMP SYNC.         DCQRY200
00043          05  SUB5                PICTURE S99   COMP SYNC.         DCQRY200
00044          05  SUB6                PICTURE S99   COMP SYNC.         DCQRY200
00045      03  QUERY-MESSAGES.                                          DCQRY200
00046          05  SINGLE-COUNT-MSG.                                    DCQRY200
00047              07  FILLER          PICTURE XX VALUE SPACES.         DCQRY200
00048              07  S-COUNT         PICTURE ZZZZZ9.                  DCQRY200
00049              07  FILLER          PICTURE X VALUE SPACE.           DCQRY200
00050              07  S-CONST PICTURE X(16) VALUE                         CL**2
00051              "ENTRY QUALIFIES.".                                  DCQRY200
00052              07  FILLER          PICTURE X(33) VALUE SPACES.      DCQRY200
00053          05  MULTI-COUNT-MSG.                                     DCQRY200
00054              07  FILLER          PICTURE XX VALUE SPACES.         DCQRY200
00055              07  M-COUNT         PICTURE ZZZZZ9.                  DCQRY200
00056              07  FILLER          PICTURE X VALUE SPACE.           DCQRY200
00057              07  M-CONST         PICTURE X(16) VALUE              DCQRY200
00058             "ENTRIES QUALIFY.".                                   DCQRY200
00059              07  FILLER          PICTURE X(31) VALUE SPACES.      DCQRY200
00060          05  NO-QUALIFY-MSG.                                      DCQRY200
00061              07  FILLER          PICTURE XX  VALUE SPACES.        DCQRY200
00062              07  FILLER          PICTURE X(19) VALUE              DCQRY200
00063             "NO ENTRIES QUALIFY".                                 DCQRY200
00064              07  FILLER          PICTURE X(35) VALUE SPACES.      DCQRY200
00065          05  LIST-LINE-MSG.                                       DCQRY200
00066              07  FILLER          PICTURE XX  VALUE SPACES.        DCQRY200
00067              07  LIST-LINE-NAME  PICTURE X(32).                   DCQRY200
00068              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
                  07 LIST-LINE-ENTTYPE   PICTURE X(9).
00070              07  LIST-LINE-END PICTURE X(18).                        CL**2
00071          05  OCCURS-MSG.                                             CL**2
00072              07  USE-WORD PICTURE X(6).                              CL**2
00073              07  USED-TIMES PICTURE ZZ9.                             CL**2
00074              07  FILLER PICTURE X(7) VALUE " TIMES.".                CL**2
00075          05  PROGRAM-PROBLEM-MSG.                                 DCQRY200
00076              07  FILLER          PICTURE XX VALUE SPACES.         DCQRY200
00077              07  FILLER          PICTURE X(30)   VALUE            DCQRY200
00078             "DCQRY-099-F * PROGRAM PROBLEM-".                        CL**2
00079              07  PROBLEM-NO      PICTURE X.                       DCQRY200
00080              07  FILLER          PICTURE X(23) VALUE SPACES.      DCQRY200
00081          05  CERR-110.                                            DCQRY200
00082              07  FILLER          PICTURE X(48) VALUE              DCQRY200
00083             "DCQRY-110-F *ERROR MAST3 CLIENT RECORD NOT FOUND".   DCQRY200
00084              07  FILLER          PICTURE X(8) VALUE SPACES.       DCQRY200
00085          05  CERR-120.                                            DCQRY200
00086              07  FILLER          PICTURE X(45) VALUE              DCQRY200
00087             "DCQRY-120-F *ERROR MAST3 HIT RECORD NOT FOUND".      DCQRY200
00088              07  FILLER          PICTURE X(11) VALUE SPACES.      DCQRY200
00089          05  CERR-130.                                            DCQRY200
00090              07  FILLER          PICTURE X(47) VALUE              DCQRY200
00091             "DCQRY-130-F *ERROR MAST3 ENTRY RECORD NOT FOUND".    DCQRY200
00092              07  FILLER          PICTURE X(9)  VALUE SPACES.      DCQRY200
00093          05  ERR-800.                                                CL**2
00094              07  FILLER          PICTURE XX      VALUE SPACE.        CL**2
00095              07  FILLER          PICTURE X(31)   VALUE               CL**2
00096             "DCQRY-800-S ERROR * MAST1 READ ".                       CL**2
00097              07  ENT-NAME1       PICTURE X(32)   VALUE               CL**2
00098             "                                ".                      CL**2
00099              07  FILLER          PICTURE X(67)   VALUE SPACE.        CL**2
00100          05  ERR-805.                                                CL**2
00101              07  FILLER          PICTURE XX      VALUE SPACE.        CL**2
00102              07  FILLER          PICTURE X(31)   VALUE               CL**2
00103             "DCQRY-805-S ERROR * MAST2 READ ".                       CL**2
00104              07  ENT-NAME2       PICTURE X(32)   VALUE               CL**2
00105             "                                ".                      CL**2
00106              07  FILLER          PICTURE X(67)   VALUE SPACE.        CL**2
00107          05  ERR-970.                                                CL**2
00108              07  FILLER          PICTURE XX      VALUE SPACE.        CL**2
00109              07  FILLER          PICTURE X(41)   VALUE               CL**2
00110             "DCQRY-970-F ERROR * MAST3 READ HIT RECORD".             CL**2
00111              07  FILLER          PICTURE X(91)   VALUE SPACE.        CL**2
00112          05  ERR-965.                                                CL**2
00113              07  FILLER          PICTURE XX      VALUE SPACE.        CL**2
00114              07  FILLER          PICTURE X(43)   VALUE               CL**2
00115             "DCQRY-965-F ERROR * MAST3 READ FIELD RECORD".           CL**2
00116              07  FILLER          PICTURE X(89)   VALUE SPACE.        CL**2
00117          05  EXCESS-COUNT-MSG.                                       CL**2
00118              07  FILLER          PICTURE XX VALUE SPACE.             CL**2
00119              07  FILLER          PICTURE X(43)    VALUE              CL**2
00120             "DCQRY-565-S ERROR * TO MANY ENTRIES QUALIFY".           CL**2
00121              07  FILLER          PICTURE X(11) VALUE SPACE.          CL**2
00122  01  TBL-RECORD-3.                                                   CL**2
           03  TBL-ENTRY OCCURS 17 TIMES. 
00125          05  TBL-ENTRY-NAME   PICTURE X(15).                         CL**2
00126          05  TBL-ENTRY-ID     PICTURE XX.                            CL**2
           03  FILLER               PICTURE X(2906).
00135                                                                    DCQRY20
00136  PROCEDURE DIVISION.                                                 CL**2
00139  0000-BEGIN.                                                      DCQRY200
00140 ***************************************************************** DCQRY200
00141 ***************************************************************** DCQRY200
00142 *    INITIALIZATION                                               DCQRY200
00143 ***************************************************************** DCQRY200
00144 ***************************************************************** DCQRY200
00145      OPEN INPUT MAST3.                                            DCQRY200
           OPEN OUTPUT SYSPRINT WITH NO REWIND. 
00147      MOVE SPACES TO STD-REPORT-REC.                               DCQRY200
00148      MOVE SPACES TO PRINT-LINE.                                      CL**2
00149      MOVE 99 TO LINE-CT.                                             CL**2
00150      MOVE 1 TO PRT-CTL.                                              CL**2
00151      IF QTBL-HDR-REQTYPE NOT EQUAL TO SPACE                          CL**2
00152          PERFORM ERROR-PRINT THRU ERROR-PRINT-XIT.                   CL**2
00153      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00154 *                                                                 DCQRY200
00155 *    IF NO ENTRIES QUALIFY-DISPLAY MSG AND EXIT                   DCQRY200
00156 *                                                                 DCQRY200
00157      IF HIT-COUNT EQUAL TO ZEROS                                  DCQRY200
00158          MOVE NO-QUALIFY-MSG TO STD-RPT-MESSAGE                   DCQRY200
00159          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCQRY200
00160          GO TO 6000-QUERY-END.                                    DCQRY200
00161                                                                    DCQRY20
00162 ***************************************************************** DCQRY200
00163 ***************************************************************** DCQRY200
00164                                                                    DCQRY20
00165 *    COUNT COMMAND PROCESSING                                     DCQRY200
00166 *    DISPLAY THE NUMBER OF QUALIFYING ENTRIES FOR                 DCQRY200
00167 ***************************************************************** DCQRY200
00168 ***************************************************************** DCQRY200
00169  1000-COUNT-COMMAND.                                              DCQRY200
00170      IF HIT-COUNT EQUAL TO 1                                      DCQRY200
00171          MOVE HIT-COUNT TO S-COUNT                                DCQRY200
00172          MOVE SINGLE-COUNT-MSG TO STD-RPT-MESSAGE                 DCQRY200
00173      ELSE                                                         DCQRY200
00174          MOVE HIT-COUNT TO M-COUNT                                DCQRY200
00175          MOVE MULTI-COUNT-MSG TO STD-RPT-MESSAGE.                 DCQRY200
00176      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCQRY200
00177      IF QRYTYPE-1 EQUAL TO "C"                                    DCQRY200
00178          GO TO 6000-QUERY-END.                                    DCQRY200
00179                                                                    DCQRY20
00180 ***************************************************************** DCQRY200
00181 ***************************************************************** DCQRY200
00182 *    LIST COMMAND PROCESSING                                      DCQRY200
00183 *    DISPLAY A LIST OF THE NAMES OF QUALIFYING ENTRIES            DCQRY200
00184 *            LIST AND SHOW COMMANDS                               DCQRY200
00185 ***************************************************************** DCQRY200
00186 ***************************************************************** DCQRY200
00187  2000-LIST-COMMAND.                                               DCQRY200
00188 *                                                                 DCQRY200
00189 *    RETRIEVE ENTRY TYPE TABLE                                    DCQRY200
00190 *                                                                 DCQRY200
           MOVE 3 TO CON-KEY. 
00192      READ MAST3 INVALID KEY                                       DCQRY200
00193          MOVE  CERR-130 TO  STD-RPT-MESSAGE                       DCQRY200
00194          GO TO 6500-ABORT-RUN.                                    DCQRY200
00195      MOVE CTL-RECORD-3 TO TBL-RECORD-3.                              CL**2
00196 *                                                                 DCQRY200
00197 *    SET ENTRY TYPE HIT PRESENT SWITCHES TO N-S                   DCQRY200
00198 *                                                                 DCQRY200
00199      MOVE ALL "N" TO HIT-SW1.                                        CL**2
00200 *                                                                 DCQRY200
00201 *    RETRIEVE HITS AND LIST CATNAME AND ENTRY TYPE                DCQRY200
00202 *                                                                 DCQRY200
00203  2010-FIRST-HIT.                                                  DCQRY200
00204      MOVE 1 TO SUB1.                                              DCQRY200
00205  2020-NEXT-HIT.                                                   DCQRY200
00206      PERFORM 2900-FETCH-HIT THRU 2990-FETCH-HIT-XIT.              DCQRY200
00207      IF HIT-WORK-NAME EQUAL TO SPACES                             DCQRY200
00208          GO TO 2050-NO-MORE-HITS.                                 DCQRY200
00209      MOVE HIT-WORK-NAME TO LIST-LINE-NAME.                        DCQRY200
00210 *       LOOKUP TYPE AND SET SW FOR SHOW CALLS                     DCQRY200
00211      MOVE 1 TO SUB2.                                              DCQRY200
00212  2030-FIND-TYPE.                                                     CL**2
00213      IF TBL-ENTRY-ID (SUB2) EQUAL TO HIT-WORK-ENTTYPE                CL**2
00214          GO TO 2040-FOUND-TYPE.                                   DCQRY200
00215      ADD 1 TO SUB2.                                               DCQRY200
00216      GO TO 2030-FIND-TYPE.                                        DCQRY200
00217  2040-FOUND-TYPE.                                                 DCQRY200
00218      MOVE TBL-ENTRY-NAME (SUB2) TO LIST-LINE-ENTTYPE.                CL**2
00219      MOVE "Y" TO ENTRY-TYPE-PRESENT (SUB2).                       DCQRY200
00220      IF QRYTYPE-1 EQUAL "5" OR "7"                                   CL**2
00221          MOVE " USES " TO USE-WORD                                   CL**2
00222      ELSE                                                            CL**2
00223          MOVE " USED " TO USE-WORD.                                  CL**2
00224      IF HIT-WORK-TIMES GREATER THAN 1                                CL**2
00225          MOVE HIT-WORK-TIMES TO USED-TIMES                           CL**2
00226          MOVE OCCURS-MSG TO LIST-LINE-END                            CL**2
00227      ELSE                                                            CL**2
00228          MOVE SPACES TO LIST-LINE-END.                               CL**2
00229      MOVE SPACES TO STD-RPT-MSG.                                     CL**2
00230      MOVE LIST-LINE-MSG TO STD-RPT-MSG.                              CL**2
00231      MOVE "1" TO PRT-CTL.                                            CL**2
00232      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCQRY200
00233      GO TO 2020-NEXT-HIT.                                         DCQRY200
00234  2050-NO-MORE-HITS.                                                  CL**2
00235          GO TO 6000-QUERY-END.                                       CL**2
00236                                                                    DCQRY20
00237 ***************************************************************** DCQRY200
00238 *    RETRIEVE NAME AND TYPE OF QUALIFYING ENTRY                   DCQRY200
00239 *        FROM HIT TABLE OF HIT TABLE RECORDS IN MAST3             DCQRY200
00240 ***************************************************************** DCQRY200
00241  2900-FETCH-HIT.                                                  DCQRY200
00242      IF SUB1 GREATER THAN HIT-TBL-LIMIT                           DCQRY200
               GO TO 2920-CK-ENDS.
      *  MAST3 NOLONGER USED AS OVERFLOW WORK AREA
00244      MOVE HIT-ENTRIES (SUB1) TO HIT-WORK-REC.                     DCQRY200
00245      ADD 1 TO SUB1.                                               DCQRY200
00246      GO TO 2990-FETCH-HIT-XIT.                                    DCQRY200
00262 *                                                                 DCQRY200
00263 *    CK FOR END OF ALL HITS                                       DCQRY200
00264 *                                                                 DCQRY200
00265  2920-CK-ENDS.                                                    DCQRY200
00266 *                                                                    CL**2
00267 *    CHECK FOR EXCESSIVE HITS ONLY LIST & SHOW FIRST 2000            CL**2
00268 *                                                                    CL**2
00269      IF HIT-COUNTER EQUAL TO 2001                                    CL**2
00270          MOVE EXCESS-COUNT-MSG TO STD-RPT-MESSAGE                    CL**2
00271          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00272          MOVE 2000 TO HIT-COUNT                                      CL**2
00273          GO TO 6000-QUERY-END.                                       CL**2
00274      IF HIT-COUNTER EQUAL TO HIT-COUNT                            DCQRY200
00275          GO TO 2950-FINI-HIT.                                     DCQRY200
00297  2940-NO-HIT-FOUND.                                               DCQRY200
00298      MOVE CERR-120 TO STD-RPT-MESSAGE.                            DCQRY200
00299      GO TO 6500-ABORT-RUN.                                        DCQRY200
00300  2950-FINI-HIT.                                                   DCQRY200
00301      MOVE SPACES TO HIT-WORK-REC.                                 DCQRY200
00302  2990-FETCH-HIT-XIT.                                              DCQRY200
00303      EXIT.                                                        DCQRY200
00304                                                                    DCQRY20
00305 ***************************************************************** DCQRY200
00306 ***************************************************************** DCQRY200
00307 *    SHOW COMMAND PROCESSING                                      DCQRY200
00308 ***************************************************************** DCQRY200
00309 ***************************************************************** DCQRY200
00310  3000-SHOW-COMMAND.                                               DCQRY200
00311 *   RETURN TO EDIT02                                                 CL**2
00312 ***************************************************************** DCQRY200
00313 ***************************************************************** DCQRY200
00314 *    COMPLETE MODULE PROCESSING                                   DCQRY200
00315 *        RETURN TO CALLING MODULE                                 DCQRY200
00316 ***************************************************************** DCQRY200
00317  6000-QUERY-END.                                                  DCQRY200
           IF QTBL-OPT-ENTTYPE IS EQUAL TO "22" 
              AND QTBL-SEL1-ENTTYPE IS EQUAL TO "03"
           THEN 
              MOVE SPACES TO STD-RPT-MSG
              MOVE "3" TO PRT-CTL 
              MOVE "SYSTEM COMPRESSION/DECOMPRESSION DBPS " 
               TO STD-RPT-MSG (2 : 38)
              MOVE "ARE NOT INCLUDED IN ABOVE REPORT."
               TO STD-RPT-MSG (40 : 33) 
              PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT
           END-IF.
00318      CLOSE MAST3.                                                 DCQRY200
           CLOSE SYSPRINT WITH NO REWIND. 
  
00320  6010-QUERY-END2.                                                 DCQRY200
           EXIT PROGRAM.
00322  6500-ABORT-RUN.                                                  DCQRY200
00323      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCQRY200
00324      MOVE "12" TO RETURN-CODE.                                       CL**2
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
00325      STOP RUN.                                                       CL**2
*CALL RETCODE 
00326 *                                                                    CL**2
00327 *   REPORT SUB HDG RT-NOT USED IN THIS MODULE                        CL**2
00328 *                                                                    CL**2
00329  USER-ROUTINE.                                                       CL**2
00330  USER-ROUTINE-XIT.                                                   CL**2
00331      EXIT.                                                           CL**2
00332  ERROR-PRINT.                                                        CL**2
00333 *                                                                    CL**2
00334 *    ERROR PRINT ROUTINE                                             CL**2
00335 *                                                                    CL**2
00336          MOVE ZEROES TO HIT-COUNT.                                   CL**2
00337      IF QTBL-HDR-REQTYPE EQUAL TO "DR"                               CL**2
00338          MOVE QTBL-SEL2-TOCNAME TO ENT-NAME1                         CL**2
00339          MOVE ERR-800 TO STD-REPORT-REC                              CL**2
00340          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00341          GO TO 6000-QUERY-END.                                       CL**2
00342      IF QTBL-HDR-REQTYPE EQUAL TO "RR"                               CL**2
00343          MOVE QTBL-SEL2-TOCNAME TO ENT-NAME2                         CL**2
00344          MOVE ERR-805 TO STD-REPORT-REC                              CL**2
00345          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00346          GO TO 6000-QUERY-END.                                       CL**2
00347      IF QTBL-HDR-REQTYPE EQUAL TO "CH"                               CL**2
00348          MOVE ERR-970 TO STD-REPORT-REC                              CL**2
00349          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00350          GO TO 6500-ABORT-RUN.                                       CL**2
00351      IF QTBL-HDR-REQTYPE EQUAL TO "CF"                               CL**2
00352          MOVE ERR-965 TO STD-REPORT-REC                              CL**2
00353          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00354          GO TO 6500-ABORT-RUN.                                       CL**2
00355  ERROR-PRINT-XIT.                                                    CL**2
00356      EXIT.                                                           CL**2
00357                                                                    DCQRY20
*CALL     DISPLAYLN                                                        CL**5
*CALL     WRITELN                                                          CL**5
