*DECK     DCQRY232
00001  IDENTIFICATION DIVISION.                                         08/10/78
       PROGRAM-ID. QRY232.
*CALL COPYRIGHT 
      *    THIS MODULE FORMATS THE QUERY RESPONSE REPORT
      *    FOR SHOW QUERIES AGAINSTENTRY-TYPE 30
      *    ENTRY-TYPE 30 = DATABASE 
00009  ENVIRONMENT DIVISION.                                               CL**2
00010  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
*CALL UPQRYSN 
00013  INPUT-OUTPUT SECTION.                                               CL**2
00014  FILE-CONTROL.                                                       CL**2
           SELECT MAST1 ASSIGN TO "MAST1" 
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS DATA-KEY.
           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.                                                      CL**2
00023  FILE SECTION.                                                       CL**2
*CALL     MAST1FD                                                          CL**2
*CALL     MAST3FD                                                          CL**2
*CALL     SYSPRTFD                                                         CL**2
*CALL QRYCS 
*CALL     WRKSTG77                                                         CL**2
*CALL     MAST1WS                                                          CL**2
*CALL     TESTWACOM                                                        CL**2
*CALL     TOTWA32                                                          CL**2
00031  01  COMMON-RPTDATA.                                                 CL**2
00032 *                                                                    CL**2
00033 *    THIS REFINES LINE FORMATS  FIELD VALUES, CODES AND WORK AREAS   CL**2
00034 *    WHICH ARE COMMON TO ALL ENTRY TYPES.                            CL**2
00035 ******************************************************************   CL**2
00036 *    STANDARD CATEGORY RPT DETAIL LINES COMMON TO ALL ENTRY TYPES    CL**2
00037 ******************************************************************   CL**2
00038      03  00-CAT-DETAIL-LINES.                                        CL**2
00039 *    CONTROL CATEGORY                                                CL**2
00040          05  CAT00010-LINE.                                          CL**2
00041              07  FLD0001005-HDG  PICTURE X(11).                      CL**2
00042              07  FLD0001005-VAL  PICTURE X(32).                      CL**2
00043              07  FILLER          PICTURE X.                          CL**2
00044              07  FLD0001010-HDG  PICTURE X(7).                       CL**2
00045              07  FLD0001010-VAL.                                     CL**2
00046                  09  FLD0001010-POS1 PICTURE X.                      CL**2
00047                  09  FILLER          PICTURE X(7).                   CL**2
00048              07  FILLER          PICTURE X.                          CL**2
00049              07  FLD0001015-HDG  PICTURE X(9).                       CL**2
00050              07  FLD0001015-VAL  PICTURE X.                          CL**2
00051 *    KEYWORD CATEGORY                                                CL**2
00052          05  CAT00020-LINE REDEFINES CAT00010-LINE.                  CL**2
00053              07  FLD0002005-HDG  PICTURE X(3).                       CL**2
00054              07  FLD0002005-VAL PICTURE X(67).                       CL**2
00055 *"   DESCRIPTION CATEGORY                                            CL**2
00056          05  CAT00030-LINE REDEFINES CAT00020-LINE.                  CL**2
00057              07  FLD0003005-VAL  PICTURE X.                          CL**2
00058              07  FLD0003010-VAL  PICTURE X(66).                      CL**2
00059              07  FILLER          PICTURE X(3).                       CL**2
00060 *    OTHER CATEGORY                                                  CL**2
00061          05  CAT00900-LINE REDEFINES CAT00020-LINE.                  CL**2
00062              07  FLD0090005-VAL  PICTURE X.                          CL**2
00063              07  FLD0090010-VAL  PICTURE X(66).                      CL**2
00064              07  FILLER          PICTURE X(3).                       CL**2
00065 ******************************************************************   CL**2
00066 *    STANDARD FIELD HEADING CONSTANTS FOR DETAIL LINES               CL**2
00067 *        COMMON TO ALL ENTRY TYPES                                   CL**2
00068 ******************************************************************   CL**2
00069      03  00-FIELD-HDG-CONSTANTS.                                     CL**2
00070          05  FLD0001005-HCONA    PICTURE X(11)  VALUE                CL**2
00071             "  ALIAS OF ".                                           CL**2
00072          05  FLD0001010-HCON     PICTURE X(7)   VALUE                CL**2
00073             "STATUS=".                                               CL**2
00074          05  FLD0001015-HCON     PICTURE X(9)   VALUE                CL**2
00075             "SECURITY=".                                             CL**2
00076          05  FLD0002005-HCON     PICTURE X(3)   VALUE                CL**2
00077              "   ".                                                  CL**2
00078          05  FLD0001005-HCONV    PICTURE X(11)  VALUE                CL**2
00079             "VERSION OF ".                                           CL**2
00080          05  SUB-HEADING-LINE.                                       CL**2
00081              07  FILLER          PICTURE X(14)   VALUE               CL**2
00082             "CATALOGUE NAME".                                        CL**2
00083              07  FILLER          PICTURE X(8)    VALUE SPACE.        CL**2
00084              07  FILLER          PICTURE X(9)    VALUE               CL**2
00085             "REV  LINE".                                             CL**2
00086              07  FILLER          PICTURE X(5)    VALUE SPACE.        CL**2
00087              07  FILLER          PICTURE X(4)    VALUE               CL**2
00088             "TYPE".                                                  CL**2
00089              07  FILLER          PICTURE X(92)   VALUE SPACE.        CL**2
00090          05  CONTINUATION-LINE.                                      CL**2
00091              07  CATA-NAME-LINE  PICTURE X(56)   VALUE SPACE.        CL**2
00092              07  FILLER          PICTURE X(72)   VALUE SPACE.        CL**2
00093              07  STATEMENT-LINE.                                     CL**2
00094                  09  FILLER      PICTURE X(5)    VALUE SPACE.        CL**2
00095                  09  FILLER      PICTURE X(30)   VALUE               CL**2
00096                 "* CONTINUED FROM PREVIOUS PAGE".                    CL**2
00097                  09  FILLER      PICTURE X(97)   VALUE SPACE.        CL**2
00098 *****************************************************************    CL**2
00099 *    FIELD CODES AND THIER MEANINGS                                  CL**2
00100 *       COMMON TO ALL ENTRY TYPES-FOR COMMON CATS                    CL**2
00101 **********************************************************           CL**2
00102      03  00-CAT-CODES.                                               CL**2
00103 *  STATUS OF ENTRY                                                   CL**2
00104          05  FLD0001010-CV       PICTURE X(4)    VALUE               CL**2
00105         "EPO9".                                                      CL**2
00106          05  FLD0001010-CD  REDEFINES  FLD0001010-CV.                CL**2
00107              07  FLD0001010-CODES PICTURE X OCCURS 4.                CL**2
00108          05  FLD0001010-MV       PICTURE X(32)   VALUE               CL**2
00109         "EXISTINGPROPOSEDOBSOLETEXXXXXXXX".                          CL**2
00110          05  FLD0001010-MD   REDEFINES FLD0001010-MV.                CL**2
00111              07  FLD0001010-MNG  PICTURE X(8) OCCURS 4.              CL**2
00112      03  WORK-FIELDS.                                                CL**2
00113          05  DATA-OPEN-SW PICTURE X.                                 CL**2
00114          05  HIT-WORK-REC.                                           CL**2
00115          07  HIT-WORK-NAME       PICTURE X(32).                      CL**2
00116          07  HIT-WORK-ENTTYPE    PICTURE XX.                         CL**2
               05  HIT-TBL-LIMIT           PICTURE 9999 VALUE 1000. 
00119          05  HIT-TBL-LIMIT-PLUS1 PICTURE   99    VALUE               CL**2
00120              26.                                                     CL**2
00121          05  FRLINE-LIMIT        PICTURE 9(4).                       CL**2
00122          05  TOLINE-LIMIT        PICTURE 9(4).                       CL**2
00123          05  FORLINE-LIMIT       PICTURE 9(4).                       CL**2
00124          05  CATLINE-COUNTER     PICTURE 9(4).                       CL**2
00125          05  ENTRY-NAME          PICTURE X(32).                      CL**2
00126          05  ENTRY-TYPE-NO       PICTURE 99.                         CL**2
00127          05  ENTRY-TYPE-NAME     PICTURE X(8).                       CL**2
00128          05  CATEGORY-NUMBER     PICTURE XXX.                        CL**2
00129          05  CATEGORY-OUTPUT-SW  PICTURE X.                          CL**2
00130          05  1ST-HIT-OVER-SW  PICTURE X VALUE "X".                   CL**2
00131          05  HIT-COUNTER   PICTURE 9(5) VALUE 0.                     CL**2
00132          05  HITS-PER-RECORD     PICTURE 99  VALUE 86.               CL**2
               05  CON-KEY PICTURE 999. 
               05  SUB1               PICTURE 9(4) COMP-1.
00135          05  SUB2                PICTURE   S99  COMP SYNC.           CL**2
00136          05  SUB3                PICTURE   S99  COMP SYNC.           CL**2
00137          05  SUB4                PICTURE   S99  COMP SYNC.           CL**2
00138          05  SUB5                PICTURE   S99  COMP SYNC.           CL**2
00139          05  SUB6                PICTURE   S99  COMP SYNC.           CL**2
00140           05  DISPLAY-LINE-LENGTH PICTURE XXX VALUE "132".           CL**2
00141      03  QUERY-MESSAGES.                                             CL**2
00142          05  NO-LINES-MSG.                                           CL**2
00143              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00144              07  NLM             PICTURE X(55)   VALUE               CL**2
00145             "DCQRY-015-I * REQUESTED LINES NOT PRESENT FOR CATEGOR   CL**2
00146 -           "Y.".                                                    CL**2
00147          05  NO-CAT-MSG.                                             CL**2
00148              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00149              07  NC7             PICTURE X(45)   VALUE               CL**2
00150             "DCQRY-020-I * REQUESTED CATEGORY NOT DEFINED.".         CL**2
00151              07  FILLER          PICTURE X(9) VALUE SPACES.          CL**2
00152          05  NO-CATS-MSG.                                            CL**2
00153              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00154              07  NCPM            PICTURE X(47)   VALUE               CL**2
00155             "DCQRY-025-I * REQUESTED CATEGORIES NOT DEFINED.".       CL**2
00156              07  FILLER          PICTURE X(9)    VALUE SPACES.       CL**2
00157          05  PROGRAM-PROBLEM-MSG.                                    CL**2
00158              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00159              07  PPM             PICTURE X(30)     VALUE             CL**2
00160             "DCQRY-099-F * PROGRAM PROBLEM-".                        CL**2
00161              07  PROBLEM-NO      PICTURE X.                          CL**2
00162              07  FILLER          PICTURE X(23) VALUE SPACES.         CL**2
00163          05  LIST-LINE-MSG.                                          CL**2
00164              07 FILLER           PICTURE XX    VALUE SPACES.         CL**2
00165              07  LIST-LINE-NAME  PICTURE X(32).                      CL**2
00166              07  FILLER          PICTURE XX    VALUE SPACES.         CL**2
00167              07  LIST-LINE-ENTTYPE PICTURE X(8) VALUE                CL**2
00168             "DATABASE".                                              CL**2
00169              07  FILLER          PICTURE X(12) VALUE SPACES.         CL**2
00170          05  CERR-110.                                               CL**2
00171              07  FILLER          PICTURE X(44)   VALUE               CL**2
00172             "DCQRY-950-F ERROR * MAST3 READ CLIENT RECORD".          CL**2
00173              07  FILLER          PICTURE X(12)   VALUE SPACE.        CL**2
00174           05  CERR-120.                                              CL**2
00175              07  FILLER          PICTURE X(41)   VALUE               CL**2
00176             "DCQRY-970-F ERROR * MAST3 READ HIT RECORD".             CL**2
00177              07  FILLER          PICTURE X(15)   VALUE SPACE.        CL**2
*CALL     RPTDEF32                                                         CL**2
00186                                                                    DCQRY23
00187  PROCEDURE DIVISION.                                                 CL**2
00190 *                                                                    CL**2
00191 *    INITIALIZATION                                                  CL**2
00192 *                                                                    CL**2
00193 ********************************************************             CL**2
00194  0000-BEGIN.                                                         CL**2
           OPEN OUTPUT SYSPRINT WITH NO REWIND. 
00196      MOVE SPACES TO PRINT-LINE.                                      CL**2
00197      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00198      MOVE "N" TO DATA-OPEN-SW.                                       CL**2
00199 *                                                                    CL**2
00200 *         READ CTL FILE CLIENT RECORD FOR PRIME NUMBERS              CL**2
00201 *                                                                    CL**2
00202      OPEN INPUT MAST3.                                               CL**2
00209      GO TO 3000-SHOW-COMMAND.                                        CL**2
00210                                                                    DCQRY23
00211 ***************************************************************      CL**2
00212 *                                                                    CL**2
00213 *    END OF SHOW 30 PROCESSING                                       CL**2
00214 *                                                                    CL**2
00215 ***************************************************************      CL**2
00216  1500-QUERY-END.                                                     CL**2
00217      IF DATA-OPEN-SW EQUAL TO "Y"                                    CL**2
00218          CLOSE MAST1.                                                CL**2
00219      CLOSE MAST3.                                                    CL**2
           CLOSE SYSPRINT WITH NO REWIND. 
           EXIT PROGRAM.
00222  1900-ABORT-RUN.                                                     CL**2
00223      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00224      MOVE "12" TO RETURN-CODE.                                       CL**2
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
00225      STOP RUN.                                                       CL**2
*CALL RETCODE 
00226                                                                    DCQRY23
00227 ******************************************************************   CL**2
00228 ******************************************************************   CL**2
00229 *    SHOW COMMAND PROCESSING                                         CL**2
00230 *        DISPLAY REQUESTED CATEGORIES AND LINES OF QUALIFYING        CL**2
00231 *         ENTRIES                                                    CL**2
00232 *                                                                    CL**2
00233 ******************************************************************   CL**2
00234 ******************************************************************   CL**2
00235  3000-SHOW-COMMAND.                                                  CL**2
00236 *                                                                    CL**2
00237 *     OPEN DATA FILE (MAST1)                                         CL**2
00238      OPEN INPUT MAST1.                                               CL**2
00239      MOVE "Y" TO DATA-OPEN-SW.                                       CL**2
00240 *                                                                    CL**2
00241 *    RETRIEVE NAME AND TYPE OF QUALIFYING ENTRY                      CL**2
00242 *        OUTPUT LIST LINE                                            CL**2
00243  3010-FIRST-HIT.                                                     CL**2
00244      MOVE 1 TO SUB1.                                                 CL**2
00245  3100-NEXT-HIT.                                                      CL**2
00246 *     RETRIEVE NAME AND TYPE OF QUALIFYING ENTRY                     CL**2
00247 *            FROM HIT TABLE OR FROM MAST3 HIT RECORDS                CL**2
00248 *                                                                    CL**2
00249      IF SUB1 GREATER THAN HIT-TBL-LIMIT                              CL**2
               GO TO 3800-NOMORE-HITS.
      *  MAST3 NOLONGER USED AS OVERFLOW WORK AREA
00251      MOVE HIT-ENTRIES (SUB1) TO HIT-WORK-REC.                        CL**2
00252      ADD 1 TO SUB1.                                                  CL**2
00253      GO TO 3190-HIT-FETCHED.                                         CL**2
00254  3120-USE-HIT-FILE.                                                  CL**2
00255      IF HIT-COUNT EQUAL TO HIT-TBL-LIMIT                             CL**2
00256          MOVE SPACES TO HIT-WORK-REC                                 CL**2
00257          GO TO 3190-HIT-FETCHED.                                     CL**2
00258 *                                                                    CL**2
00259 *     HIT TABLE LIMIT EXCEEDED USE MAST 3                            CL**2
00260 *                                                                    CL**2
00261      IF 1ST-HIT-OVER-SW EQUAL TO "N"                                 CL**2
00262          GO TO 3140-CK-ENDS.                                         CL**2
00263      MOVE "N" TO 1ST-HIT-OVER-SW.                                    CL**2
00264      MOVE 100 TO CON-KEY.                                            CL**2
00265      MOVE 1 TO SUB6.                                                 CL**2
00266      MOVE HIT-TBL-LIMIT TO HIT-COUNTER.                              CL**2
00267      READ MAST3 INVALID KEY                                          CL**2
00268          GO TO 3170-NO-HIT-FOUND.                                    CL**2
00269 *                                                                    CL**2
00270 *      CHECK FOR END OF HIT ENTRIES                                  CL**2
00271 *                                                                    CL**2
00272  3140-CK-ENDS.                                                       CL**2
00273      IF HIT-COUNTER EQUAL TO HIT-COUNT                               CL**2
00274          GO TO 3180-FINI-HIT.                                        CL**2
00275      IF SUB6 LESS THAN HITS-PER-RECORD                               CL**2
00276          GO TO 3160-MOVE-HIT.                                        CL**2
00277 *                                                                    CL**2
00278 *     READ NEXT RECORD FROM MAST3                                    CL**2
00279 *                                                                    CL**2
00280      MOVE 1 TO SUB6.                                                 CL**2
00281      ADD 1 TO CON-KEY.                                               CL**2
00282      READ MAST3 INVALID KEY                                          CL**2
00283          GO TO 3170-NO-HIT-FOUND.                                    CL**2
00284 *                                                                    CL**2
00285 *    RETRIEVE TYPE AND NAME OF QUALIFYING ENTRY                      CL**2
00286 *                                                                    CL**2
00287  3160-MOVE-HIT.                                                      CL**2
00290      ADD 1 TO SUB6.                                                  CL**2
00291      ADD 1 TO HIT-COUNTER.                                           CL**2
00292      GO TO 3190-HIT-FETCHED.                                         CL**2
00293  3170-NO-HIT-FOUND.                                                  CL**2
00294      MOVE CERR-120 TO STD-RPT-MESSAGE.                               CL**2
00295      GO TO 1900-ABORT-RUN.                                           CL**2
00296  3180-FINI-HIT.                                                      CL**2
00297      MOVE SPACES TO HIT-WORK-REC.                                    CL**2
00298  3190-HIT-FETCHED.                                                   CL**2
00299      IF HIT-WORK-NAME EQUAL TO SPACES                                CL**2
00300          GO TO 3800-NOMORE-HITS.                                     CL**2
00301      IF HIT-WORK-ENTTYPE NOT EQUAL TO "32"                           CL**2
00302         GO TO 3100-NEXT-HIT.                                         CL**2
00303      MOVE HIT-WORK-NAME TO LIST-LINE-NAME.                           CL**2
00304 *                                                                    CL**2
00305 *    LIST ENTRY NAME AND TYPE                                        CL**2
00306 *                                                                    CL**2
00307  3300-LIST-LINE.                                                     CL**2
00308      MOVE "N" TO SEC-PAGE-SW.                                        CL**2
00309      MOVE 99 TO LINE-CT.                                             CL**2
00310      MOVE 1 TO PRT-CTL.                                              CL**2
00311      MOVE SPACE TO STD-REPORT-REC.                                   CL**2
00312      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00313      MOVE LIST-LINE-MSG TO STD-RPT-MESSAGE.                          CL**2
00314      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00315 *                                                                    CL**2
00316 *    INITIALIZE LINE RETRIEVAL LIMITS FOR QUERY                      CL**2
00317 *                                                                    CL**2
00318  3400-INIT-LINELIMS.                                                 CL**2
00319      IF QTBL-OUT-FRLINE EQUAL TO SPACES                              CL**2
00320          MOVE 0001 TO FRLINE-LIMIT                                   CL**2
00321         ELSE                                                         CL**2
00322          MOVE QTBL-OUT-FRLINE TO FRLINE-LIMIT.                       CL**2
00323      IF QTBL-OUT-TOLINE EQUAL TO SPACES                              CL**2
00324          MOVE 9999 TO TOLINE-LIMIT                                   CL**2
00325         ELSE                                                         CL**2
00326          MOVE QTBL-OUT-TOLINE TO TOLINE-LIMIT.                       CL**2
00327      IF QTBL-OUT-FORLINES EQUAL TO SPACES                            CL**2
00328          MOVE 9999 TO FORLINE-LIMIT                                  CL**2
00329         ELSE                                                         CL**2
00330          MOVE QTBL-OUT-FORLINES TO FORLINE-LIMIT.                    CL**2
00331 *                                                                    CL**2
00332 *    DETERMINE IF SHOW IF FOR A CATEGORY OR SUPER CATEGORY           CL**2
00333 *                                                                    CL**2
00334      MOVE QTBL-OUT-CAT TO CATEGORY-NUMBER.                           CL**2
00335      MOVE HIT-WORK-NAME TO DATA-ENTRY-NAME.                          CL**2
00336      MOVE HIT-WORK-ENTTYPE TO DATA-ENTRY-TYPE.                       CL**2
00337      MOVE "N" TO CATEGORY-OUTPUT-SW.                                 CL**2
00338      IF CATEGORY-NUMBER EQUAL TO "999"                               CL**2
00339          GO TO 3450-SHOW-ALL.                                        CL**2
00340      IF CATEGORY-NUMBER EQUAL TO "998"                               CL**2
00341          GO TO 3465-SHOW-COMP.                                       CL**2
00342      IF CATEGORY-NUMBER EQUAL TO "997"                               CL**2
00343          GO TO 3460-SHOW-CHAR.                                       CL**2
00344      IF CATEGORY-NUMBER EQUAL TO "996"                               CL**2
00345          GO TO 3450-SHOW-ALL.                                        CL**2
00346      IF CATEGORY-NUMBER EQUAL TO "995"                               CL**2
00347          GO TO 3467-SHOW-PERS.                                       CL**2
00348 *                                                                    CL**2
00349 *    SHOW ONE CATEGORY HE ASKED FOR                                  CL**2
00350 *                                                                    CL**2
00351      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00352      GO TO 3100-NEXT-HIT.                                            CL**2
00353 *                                                                    CL**2
00354 *    SHOW ALL                                                        CL**2
00355 *                                                                    CL**2
00356  3450-SHOW-ALL.                                                      CL**2
00357      MOVE "010" TO CATEGORY-NUMBER.                                  CL**2
00358      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00359      MOVE "020" TO CATEGORY-NUMBER.                                  CL**2
00360      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00361 *                                                                    CL**2
00362  3460-SHOW-CHAR.                                                     CL**2
00363 *                                                                    CL**2
00364      MOVE "030" TO CATEGORY-NUMBER.                                  CL**2
00365      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00366      IF QTBL-OUT-CAT EQUAL TO "996"                                  CL**2
00367          GO TO 3470-CHECK-SUPER.                                     CL**2
00368      MOVE "140" TO CATEGORY-NUMBER.                                  CL**2
00369      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00370      MOVE "200" TO CATEGORY-NUMBER.                                  CL**2
00371      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00372      MOVE "215" TO CATEGORY-NUMBER.                                  CL**2
00373      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00374      MOVE "900" TO CATEGORY-NUMBER.                                  CL**2
00375      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00376      IF QTBL-OUT-CAT EQUAL TO "997"                                  CL**2
00377          GO TO 3470-CHECK-SUPER.                                     CL**2
00378  3465-SHOW-COMP.                                                     CL**2
00379      IF QTBL-OUT-CAT EQUAL TO "999"                                  CL**2
00380          GO TO 3466-JUST-COMP.                                       CL**2
00381      MOVE "030" TO CATEGORY-NUMBER.                                  CL**2
00382      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00383  3466-JUST-COMP.                                                     CL**2
00384      MOVE "300" TO CATEGORY-NUMBER.                                  CL**2
00385      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00386      GO TO 3470-CHECK-SUPER.                                         CL**2
00387  3467-SHOW-PERS.                                                     CL**2
00388      MOVE "030" TO CATEGORY-NUMBER.                                  CL**2
00389      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00390      MOVE "140" TO CATEGORY-NUMBER.                                  CL**2
00391      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00392 *                                                                    CL**2
00393 *    CHECK TO SEE IF ANY OUTPUT FOR ENTYR                            CL**2
00394 *                                                                    CL**2
00395  3470-CHECK-SUPER.                                                   CL**2
00396      IF CATEGORY-OUTPUT-SW EQUAL TO "Y"                              CL**2
00397          GO TO 3100-NEXT-HIT.                                        CL**2
00398  3475-NO-CATS.                                                       CL**2
00399      MOVE NO-CATS-MSG TO STD-RPT-MESSAGE.                            CL**2
00400      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00401      GO TO 3100-NEXT-HIT.                                            CL**2
00402                                                                    DCQRY23
00403 ******************************************************************   CL**2
00404 *                                                                    CL**2
00405 *    DISPLAY CATEGORY                                                CL**2
00406 *        RETRIEVES LINES FOR SPECIFIED CATEGORY AND FORMATS          CL**2
00407 *        EITHER A 70, 80 OR 132 CHARACTER LINE                       CL**2
00408 *                                                                    CL**2
00409 ******************************************************************   CL**2
00410  3500-DISPLAY-CATEGORY.                                              CL**2
00411      MOVE CATEGORY-NUMBER TO DATA-ENTRY-CAT.                         CL**2
00412      MOVE 0001 TO CATLINE-COUNTER.                                   CL**2
00413      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00414      IF DATA-RETURN-CODE EQUAL TO "0"                                CL**2
00415          GO TO 3510-CK-1ST-LINE.                                     CL**2
00416 *                                                                    CL**2
00417 *    CHECK FOR SUPER CAT AND BYPASS MSG                              CL**2
00418 *                                                                    CL**2
00419      IF QTBL-OUT-CAT GREATER THAN 950                                CL**2
00420      GO TO 3749-DISPLAY-CAT-XIT.                                     CL**2
00421      GO TO 3715-NOCAT-LINE.                                          CL**2
00422 *                                                                    CL**2
00423 *    CHECK IF FIRST CATEGORY LINE IS IN DESIRED RANGE                CL**2
00424 *        READ PAST LINES WITH NUMBERS LOWER THAN LOW LIMIT           CL**2
00425 *                                                                    CL**2
00426  3510-CK-1ST-LINE.                                                   CL**2
00427      IF CAT-LINE LESS THAN FRLINE-LIMIT                              CL**2
00428          GO TO 3515-BYPASS-LINE.                                     CL**2
00429 *                                                                    CL**2
00430 *    RETRIEVE 1ST LINE OF CATEGORY                                   CL**2
00431 *                                                                    CL**2
00432      IF CAT-LINE GREATER THAN TOLINE-LIMIT                           CL**2
00433          GO TO 3717-CK-SUPER-CAT.                                    CL**2
00434      GO TO 3520-OUTPUT-CATHDR.                                       CL**2
00435  3515-BYPASS-LINE.                                                   CL**2
00436      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00437      IF DATA-RETURN-CODE EQUAL TO "0" OR "3"                         CL**2
00438          GO TO 3510-CK-1ST-LINE.                                     CL**2
00439  3717-CK-SUPER-CAT.                                                  CL**2
00440      IF QTBL-OUT-CAT GREATER THAN 950                                CL**2
00441          GO TO 3749-DISPLAY-CAT-XIT.                                 CL**2
00442      GO TO 3715-NOCAT-LINE.                                          CL**2
00443 *                                                                    CL**2
00444 *    LOOKUP AND OUTPUT CATEGORY HEADER LINE                          CL**2
00445 *                                                                    CL**2
00446  3520-OUTPUT-CATHDR.                                                 CL**2
00447      MOVE 1 TO SUB4.                                                 CL**2
00448  3525-NEXT-CATNUM.                                                   CL**2
00449      IF ENT32-CATNUMS (SUB4) EQUAL TO CATEGORY-NUMBER                CL**2
00450          GO TO 3530-DISPLAY-HDG.                                     CL**2
00451      ADD 1 TO SUB4.                                                  CL**2
00452      GO TO 3525-NEXT-CATNUM.                                         CL**2
00453  3530-DISPLAY-HDG.                                                   CL**2
00454      MOVE SPACES TO STD-RPT-CATHDG.                                  CL**2
00455      MOVE ENT32-CATHDRS (SUB4) TO CATEGORY-HEADER.                   CL**2
00456      MOVE 2 TO PRT-CTL.                                              CL**2
00457      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00458      MOVE 1 TO PRT-CTL.                                              CL**2
00459      MOVE SPACES TO STD-RPT-CATHDG.                                  CL**2
00460      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00461      MOVE "Y" TO CATEGORY-OUTPUT-SW.                                 CL**2
00462 *                                                                    CL**2
00463 *    FORMAT CATEGORY DETAIL LINES                                    CL**2
00464 *        IF 70 CHR FORMAT PUT OUT LINE NO ON SEP LINE                CL**2
00465 *                                                                    CL**2
00466  3540-FMT-CAT-DETAIL.                                                CL**2
00467       IF DISPLAY-LINE-LENGTH NOT EQUAL TO "070"                      CL**2
00468          GO TO 3550-FMT-LINE-PREFIX.                                 CL**2
00469      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00470      GO TO 3560-OUTPUT-STD.                                          CL**2
00471  3550-FMT-LINE-PREFIX.                                               CL**2
00472      MOVE CAT-REV            TO  STDRPT-REVNO.                       CL**2
00473      MOVE CAT-LINE           TO  STDRPT-LINE.                        CL**2
00474 *                                                                    CL**2
00475 *    CHECK FOR COMMENT LINE                                          CL**2
00476  3560-OUTPUT-STD.                                                    CL**2
00477      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00478          PERFORM 5300-FMT-CAT030 THRU 5399-FMT-CAT030-XIT            CL**2
00479          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00480 *                                                                    CL**2
00481 *    CHECK FOR CATEGORY NUMBERS AND ENTER FORMATTING RT              CL**2
00482 *                                                                    CL**2
00483      IF CATEGORY-NUMBER EQUAL TO "010"                               CL**2
00484          PERFORM 5100-FMT-CAT010 THRU 5199-FMT-CAT010-XIT            CL**2
00485          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00486      IF CATEGORY-NUMBER EQUAL TO "020"                               CL**2
00487          PERFORM 5200-FMT-CAT020 THRU 5299-FMT-CAT020-XIT            CL**2
00488          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00489      IF CATEGORY-NUMBER EQUAL TO "030"                               CL**2
00490          PERFORM 5300-FMT-CAT030 THRU 5399-FMT-CAT030-XIT            CL**2
00491          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00492      IF CATEGORY-NUMBER EQUAL TO "140"                               CL**2
00493          PERFORM 1000-FMT-CAT32140 THRU 1099-FMT-CAT32140-XIT        CL**2
00494          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00495      IF CATEGORY-NUMBER EQUAL TO "200"                               CL**2
00496          PERFORM 1500-FMT-CAT32200 THRU 1599-FMT-CAT32200-XIT        CL**2
00497          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00498      IF CATEGORY-NUMBER EQUAL TO "215"                               CL**2
00499          PERFORM 3200-FMT-CAT215 THRU 3299-FMT-CAT215-XIT            CL**2
00500          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00501      IF CATEGORY-NUMBER EQUAL TO "300"                               CL**2
00502          PERFORM 1300-FMT-CAT300 THRU 1399-FMT-CAT300-XIT            CL**2
00503          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00504      IF CATEGORY-NUMBER EQUAL TO "900"                               CL**2
00505          PERFORM 5900-FMT-CAT900 THRU 5999-FMT-CAT900-XIT            CL**2
00506          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00507      GO TO 3710-NOCAT-DATA.                                          CL**2
00508 *                                                                    CL**2
00509 *    RETRIEVE NEXT LINE OF CATEGORY - CK FOR END                     CL**2
00510 *                                                                    CL**2
00511  3700-GET-NEXT-LINE.                                                 CL**2
00512      IF CATLINE-COUNTER EQUAL TO FORLINE-LIMIT                       CL**2
00513        GO TO 3749-DISPLAY-CAT-XIT.                                   CL**2
00514      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00515      IF DATA-RETURN-CODE EQUAL TO  1 OR 2                            CL**2
00516          GO TO 3749-DISPLAY-CAT-XIT.                                 CL**2
00517      IF CAT-LINE GREATER THAN TOLINE-LIMIT                           CL**2
00518          GO TO 3749-DISPLAY-CAT-XIT.                                 CL**2
00519      ADD 1 TO CATLINE-COUNTER.                                       CL**2
00520      GO TO 3540-FMT-CAT-DETAIL.                                      CL**2
00521  3749-DISPLAY-CAT-XIT.                                               CL**2
00522      EXIT.                                                           CL**2
00523                                                                    DCQRY23
00524 *                                                                    CL**2
00525 *   FORMAT WARNING AND INFORMATION MESSAGES                          CL**2
00526 *                                                                    CL**2
00527  3710-NOCAT-DATA.                                                    CL**2
00528      MOVE NO-CAT-MSG   TO        STD-RPT-MESSAGE.                    CL**2
00529      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00530      GO TO 3100-NEXT-HIT.                                            CL**2
00531  3715-NOCAT-LINE.                                                    CL**2
00532      MOVE NO-LINES-MSG  TO       STD-RPT-MESSAGE.                    CL**2
00533      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00534      GO TO 3100-NEXT-HIT.                                            CL**2
00535                                                                    DCQRY23
00536  3800-NOMORE-HITS.                                                   CL**2
00537 *                                                                    CL**2
00538 *    ON-LINE VERSION WILL DETERMINE NEXT STEP HERE                   CL**2
00539 *                                                                    CL**2
00540      GO TO 1500-QUERY-END.                                           CL**2
00541                                                                    DCQRY23
00542 *****************************************************************    CL**2
00543 *                                                                    CL**2
00544 *    FORMAT CATEGORY 010 DETAIL LINE                                 CL**2
00545 *        CATEGORY 010 = CONTROL                                      CL**2
00546 *                                                                    CL**2
00547 *****************************************************************    CL**2
00548  5100-FMT-CAT010.                                                    CL**2
00549      MOVE SPACES TO CAT00010-LINE.                                   CL**2
00550 *                                                                    CL**2
00551 *    FORMAT ALIAS VERSION FIELD                                      CL**2
00552 *                                                                    CL**2
00553  5105-FMT-FLD05.                                                     CL**2
00554      IF CTL-ALY-VER EQUAL TO SPACES GO TO 5110-FMT-FLD010.           CL**2
00555      IF DATA-ENTRY-TYPE GREATER THAN 15                              CL**2
00556          MOVE FLD0001005-HCONV TO FLD0001005-HDG                     CL**2
00557       ELSE                                                           CL**2
00558          MOVE FLD0001005-HCONA TO FLD0001005-HDG.                    CL**2
00559      MOVE CTL-ALY-VER TO FLD0001005-VAL.                             CL**2
00560 *                                                                    CL**2
00561 *     FORMAT STATUS FIELD                                            CL**2
00562 *                                                                    CL**2
00563  5110-FMT-FLD010.                                                    CL**2
00564      IF CTL-STATUS EQUAL TO SPACES GO TO 5115-FMT-FLD015.            CL**2
00565      MOVE FLD0001010-HCON TO FLD0001010-HDG.                         CL**2
00566          GO TO 5112-INTERPRET-CODE.                                  CL**2
00567  5111-JUST-CODE.                                                     CL**2
00568      MOVE CTL-STATUS TO FLD0001010-POS1.                             CL**2
00569      GO TO 5115-FMT-FLD015.                                          CL**2
00570  5112-INTERPRET-CODE.                                                CL**2
00571      MOVE 01 TO SUB3.                                                CL**2
00572  5113-NEXT-CODE-CK.                                                  CL**2
00573      IF FLD0001010-CODES (SUB3) EQUAL TO "9"                         CL**2
00574          GO TO 5111-JUST-CODE.                                       CL**2
00575      IF FLD0001010-CODES (SUB3) EQUAL TO CTL-STATUS                  CL**2
00576          GO TO 5114-EXTRACT-MNG.                                     CL**2
00577      ADD 1 TO SUB3.                                                  CL**2
00578      GO TO 5113-NEXT-CODE-CK.                                        CL**2
00579  5114-EXTRACT-MNG.                                                   CL**2
00580      MOVE FLD0001010-MNG (SUB3) TO FLD0001010-VAL.                   CL**2
00581 *                                                                    CL**2
00582 *     FORMAT SECURITY FIELD                                          CL**2
00583 *                                                                    CL**2
00584  5115-FMT-FLD015.                                                    CL**2
00585      IF CTL-SECURITY EQUAL TO SPACES                                 CL**2
00586          GO TO 5120-OUTPUT-LINE.                                     CL**2
00587      MOVE FLD0001015-HCON TO FLD0001015-HDG.                         CL**2
00588      MOVE CTL-SECURITY    TO FLD0001015-VAL.                         CL**2
00589 *                                                                    CL**2
00590 *     FORMATTING OF CATEGORY LINE COMPLETE                           CL**2
00591  5120-OUTPUT-LINE.                                                   CL**2
00592      IF CAT00010-LINE EQUAL TO SPACES GO TO 5199-FMT-CAT010-XIT.     CL**2
00593      MOVE CAT00010-LINE TO STDRPT-70CHR.                             CL**2
00594      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00595 *                                                                    CL**2
00596  5199-FMT-CAT010-XIT.                                                CL**2
00597      EXIT.                                                           CL**2
00598                                                                    DCQRY23
00599 *****************************************************************    CL**2
00600 *                                                                    CL**2
00601 *    FORMAT CATEGORY 020 LINE                                        CL**2
00602 *        CATEGORY 020 = KEYWORD                                      CL**2
00603 *                                                                    CL**2
00604 *****************************************************************    CL**2
00605  5200-FMT-CAT020.                                                    CL**2
00606      MOVE SPACES TO CAT00020-LINE.                                   CL**2
00607 *                                                                    CL**2
00608 *    FORMAT KEYWORD FIELD                                            CL**2
00609 *                                                                    CL**2
00610  5205-FMT-FLD05.                                                     CL**2
00611      MOVE FLD0002005-HCON TO FLD0002005-HDG.                         CL**2
00612      MOVE KEY-WORDS TO FLD0002005-VAL.                               CL**2
00613 *                                                                    CL**2
00614 *    FORMATTING OF CATEGORY LINE COMPLETE                            CL**2
00615 *                                                                    CL**2
00616  5210-OUTPUT-LINE.                                                   CL**2
00617      MOVE CAT00020-LINE TO STDRPT-70CHR.                             CL**2
00618      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00619  5299-FMT-CAT020-XIT.                                                CL**2
00620      EXIT.                                                           CL**2
00621                                                                    DCQRY23
00622 *****************************************************************    CL**2
00623 *                                                                    CL**2
00624 *    FORMAT CATEGORY 030 LINE                                        CL**2
00625 *        CATEGORY 030 = DESCRIPTION                                  CL**2
00626 *                                                                    CL**2
00627 *****************************************************************    CL**2
00628  5300-FMT-CAT030.                                                    CL**2
00629      MOVE SPACES TO CAT00030-LINE.                                   CL**2
00630      MOVE DESC-FLAG      TO FLD0003005-VAL.                          CL**2
00631      MOVE DESC-COMMENT   TO FLD0003010-VAL.                          CL**2
00632  5310-OUTPUT-LINE.                                                   CL**2
00633      MOVE CAT00030-LINE  TO STDRPT-70CHR.                            CL**2
00634      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00635  5399-FMT-CAT030-XIT.                                                CL**2
00636      EXIT.                                                           CL**2
00637                                                                    DCQRY23
00638 *****************************************************************    CL**2
00639 *                                                                    CL**2
00640 *    FORMAT CATEGORY 900 LINE                                        CL**2
00641 *        CATEGORY 900 = OTHER                                        CL**2
00642 *****************************************************************    CL**2
00643  5900-FMT-CAT900.                                                    CL**2
00644      MOVE SPACES TO CAT00900-LINE.                                   CL**2
00645      MOVE DESC-FLAG      TO FLD0090005-VAL.                          CL**2
00646      MOVE DESC-COMMENT   TO FLD0090010-VAL.                          CL**2
00647  5910-OUTPUT-LINE.                                                   CL**2
00648      MOVE CAT00900-LINE TO STDRPT-70CHR.                             CL**2
00649      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00650  5999-FMT-CAT900-XIT.                                                CL**2
00651      EXIT.                                                           CL**2
00652                                                                    DCQRY23
*CALL     RPTRT32                                                          CL**2
*CALL     DISPLAYLN                                                        CL**2
*CALL     WRITELN                                                          CL**2
00656  USER-ROUTINE.                                                       CL**2
00657      MOVE SUB-HEADING-LINE TO PRINT-DATA.                            CL**2
00658      ADD 2 TO LINE-CT.                                               CL**2
00659      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00660      MOVE SPACES TO PRINT-DATA.                                      CL**2
00661      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00662      IF SEC-PAGE-SW EQUAL TO "Y"                                     CL**2
00663          MOVE LIST-LINE-MSG TO CATA-NAME-LINE                        CL**2
00664          MOVE CONTINUATION-LINE TO PRINT-DATA                        CL**2
00665          MOVE 1 TO PRT-CTL                                           CL**2
00666          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
00667          MOVE 1 TO PRT-CTL                                           CL**2
00668          MOVE STATEMENT-LINE TO PRINT-DATA                           CL**2
00669          PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                     CL**2
00670      MOVE "Y" TO SEC-PAGE-SW.                                        CL**2
00671  USER-ROUTINE-XIT.                                                   CL**2
00672      EXIT.                                                           CL**2
00673  PROGRAM-END-BAD.                                                    CL**2
00674      MOVE PROGRAM-PROBLEM-MSG TO STD-RPT-MESSAGE.                    CL**2
00675      GO TO 1900-ABORT-RUN.                                           CL**2
00676                                                                    DCQRY23
*CALL     MAST1RFC                                                         CL**2
*CALL     MAST1RNL                                                         CL**2
*CALL     MAST1EXT                                                         CL**2
*CALL     MAST1READ                                                        CL**2
*CALL     MAST1ALG                                                         CL**2
