*DECK     DCQRY140
00001  IDENTIFICATION DIVISION.                                         07/31/78
       PROGRAM-ID. QRY140.
*CALL COPYRIGHT 
      *    THIS SEGMENT PERFORMS SELECTION PROCESSING FOR THE 
      *    FOLLOWING TYPES OF QUERIES:  
      * 
      *    QRYTYPE                DESCRIPTION 
      * 
      *      50         ENTITY-TYPE WHICH-USES ENTRY-NAME 
      *      55         ENTITY-TYPE WITH ... WHICH-USES ENTRY-NAME
      *      56         ENTITY-TYPE HAVING ... WHICH-USES ENTRY-NAME
      *      70         ENTITY-TYPE WHICH-USES ENTITY-TYPE
      *      75         ENTITY-TYPE WITH ... WHICH-USES ENTITY-TYPE 
      *      76         ENTITY-TYPE HAVING ... WHICH-USES ENTITY-TYPE 
      *      77         ENTITY-TYPE WHICH-USES ENTITY-TYPE WITH ... 
      *      78         ENTITY-TYPE WHICH-USES ENTITY-TYPE HAVING ... 
      * 
00019  ENVIRONMENT DIVISION.                                               CL**2
00020  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00023  INPUT-OUTPUT SECTION.                                               CL**2
00024  FILE-CONTROL.                                                       CL**2
*CALL     SELECTS                                                          CL**5
00026  DATA DIVISION.                                                      CL**2
00027  FILE SECTION.                                                       CL**2
*CALL     MAST1FD                                                          CL**5
*CALL     MAST2FD                                                          CL**5
*CALL     MAST3FD                                                          CL**5
*CALL QRYCS 
*CALL     WRKSTG77                                                         CL**5
00032  77  OPEN-DATA                   PICTURE X.                          CL**2
*CALL     MAST1WS                                                          CL**5
*CALL     TESTWACOM                                                        CL**5
*CALL     WRKSTG01                                                         CL**5
*CALL     MAST3DD1                                                         CL**5
*CALL     CONWORK                                                          CL**5
*CALL     RELSAVE                                                          CL**5
00039  01  WORK-STORE.                                                     CL**2
*CALL     WITHHIT4                                                         CL**2
*CALL     HITWORK                                                          CL**5
*CALL     MULTSTORE                                                        CL**2
00043                                                                    DCQRY14
00050                                                                    DCQRY14
00051  PROCEDURE DIVISION.                                                 CL**2
00053 ******************************************************               CL**2
00054 *                                                                    CL**2
00055 *    INITIALIZATION                                                  CL**2
00056 *                                                                    CL**2
00057 ****************************************************                 CL**2
00058  0000-BEGIN.                                                         CL**2
00059      MOVE SPACES TO DATA-ARG-LIST.                                   CL**2
00060      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                            CL**2
00061      MOVE "Y" TO OPEN-DATA.                                          CL**2
00062      MOVE SPACES TO REL-ARG-LIST.                                    CL**2
00063      MOVE SPACES TO CON-ARG-LIST.                                    CL**2
00064      MOVE SPACES TO HIT-ARG-LIST.                                    CL**2
00065      MOVE SPACES TO HIT-TABLE.                                       CL**2
00066      MOVE ZERO TO HIT-COUNT.                                         CL**2
00067      MOVE "Y" TO HIT-SW.                                             CL**2
00068      MOVE SPACES TO WORK-HEADER.                                     CL**2
00069      MOVE "Y" TO 1ST-CHGQRY-SW.                                      CL**2
00070 *                                                                    CL**2
00071 *    OPEN FILES- GET PRIME NUMS FOR DATA AND REL FILES               CL**2
00072 *                                                                    CL**2
00073      OPEN INPUT MAST1.                                               CL**2
00074      PERFORM REL-OPEN THRU REL-OPEN-XIT.                             CL**2
00075      PERFORM CON-OPEN THRU CON-OPEN-XIT.                             CL**2
00080      MOVE "3" TO CON-ENTRY-FUNCTION.                                 CL**2
00081      PERFORM CON-READ THRU CON-READ-XIT.                             CL**2
00082      MOVE 1 TO SUB1.                                                 CL**2
00083      PERFORM CHECK-MULT-STC THRU CHECK-MULT-STC-XIT.                 CL**2
00084 *                                                                    CL**2
00085 *    DETERMINE TYPE OF QRY AND ENTER APPROPRIEATE ROUTINES           CL**2
00086 *        IF TYPE IS                                                  CL**2
00087 *            50-RELATIONAL FILE IS ACCESSED TO OBTAIN                CL**2
00088 *                USAGE OF A NAMED ENTRY                              CL**2
00089 *            55-56- RELATIONAL FILE IS ACCESSED                      CL**2
00090 *                    TO OBTAIN USAGE RELATIONSHIPS-DATA FILE         CL**2
00091 *                    IS ACCESSED TO QUALIFY EACH USAGE ENTRY         CL**2
00092 *            70-RELATIONAL FILE ALL-NAMES RECORD IS READ             CL**2
00093 *                TO OBTAIN NAMES OF ENTRIES FOR A SELECTED ENTITY    CL**2
00094 *                EACH ENTRY NAME IS THEN PROCESSED AS A TYPE 50-     CL**2
00095 *                SEE ABOVE                                           CL**2
00096 *            75,76- RELATIONAL FILE ALL-NAMES RECORD IS READ         CL**2
00097 *                TO OBTAIN ENTRY NAMES FOR SELECTED ENTITY TYPE      CL**2
00098 *                THA DATA FILE IS THEN ACCESSED TO QUALIFY EACH      CL**2
00099 *                NAMED ENTRY- IF ENTRY QUALIFIES THEN THE            CL**2
00100 *                RELATIONAL FILE IS ACCESSED TO RETRIEVE ITS USAGE   CL**2
00101 *            77,78-RELATIONAL FILE ALL-NAMES RECORD IS READ          CL**2
00102 *                TO OBTAIN NAMES OF ENTRIES FOR SELECTED ENTITY TY   CL**2
00103 *                RELATIONAL FILE IS THEN ACCESSED TO GET USAGE       CL**2
00104 *                OF EACH EDNTRY.   DATA FILE IS THEN ACCESSED FOR    CL**2
00105 *                 EACH ENTRY USED .                                  CL**2
00106                                                                      CL**2
00107      IF QRYTYPE-23 EQUAL TO "50" OR "55" OR "56"                     CL**2
00108          GO TO 0200-RETRIEVE-USAGE.                                  CL**2
00109 ****************************************************************     CL**2
00110 *                                                                    CL**2
00111 *    PROCESS WHICH-USE ENTITY-TYPE QUERIES (70,75,76,77,78)          CL**2
00112 *        READ RELATIONAL FILE ALL-NAMES RECORD AND                   CL**2
00113 *        RETRIEVE ITS POINTERS SEQUENTIALLY.  WHEN AN ENTRY          CL**2
00114 *        IS FOUND THAT QUALIFIES, THEN THAT ENTRY IS                 CL**2
00115 *        PROCESSED AS A 50, 55 OR 56 QUERY TO GET USAGE.             CL**2
00116 *                                                                    CL**2
00117 **************************************************************       CL**2
00118      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                       CL**2
00119      GO TO 0110-NAME-READ.                                           CL**2
00120 *                                                                    CL**2
00121 *    RESET ALL NAMES ENTRY TO LAST POINTER RETRIEVED                 CL**2
00122 *                                                                    CL**2
00123  0100-GET-ENTITY-NAME.                                               CL**2
00124      MOVE ENTRY-NAME-SAVE TO REL-ENTRY-NAME.                         CL**2
00125      MOVE POINTER-NAME-SAVE TO REL-POINTER-NAME.                     CL**2
00126      MOVE NEXT-REC-SAVE TO REL-NEXT-REC.                             CL**2
00127      PERFORM RETURN-POINTER THRU RETURN-POINTER-XIT.                 CL**2
00128      IF REL-RETURN-CODE NOT EQUAL TO "0"                             CL**2
00129          MOVE "RR" TO QTBL-HDR-REQTYPE                               CL**2
00130          MOVE REL-ENTRY-NAME TO QTBL-SEL2-TOCNAME                    CL**2
00131          GO TO PROGRAM-END-BAD.                                      CL**2
00132 *                                                                    CL**2
00133 *    RETRIEVE NEXT ENTITY NAME                                       CL**2
00134 *                                                                    CL**2
00135  0110-NAME-READ.                                                     CL**2
00136      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00137      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00138      IF REL-RETURN-CODE EQUAL TO "0"                                 CL**2
00139          GO TO 0115-MOVE-NAME-PTR.                                   CL**2
00140      IF REL-RETURN-CODE EQUAL TO "1"                                 CL**2
00141          GO TO 0900-WHICHUSE-END.                                    CL**2
00142      MOVE "RR" TO QTBL-HDR-REQTYPE.                                  CL**2
00143      MOVE REL-ENTRY-NAME TO QTBL-SEL2-TOCNAME.                       CL**2
00144      GO TO PROGRAM-END-BAD.                                          CL**2
00145 *                                                                    CL**2
00146 *    PROCESS POINTER TO SEE IF IT IS DESIRED TYPE                    CL**2
00147 *                                                                    CL**2
00148  0115-MOVE-NAME-PTR.                                                 CL**2
00149      MOVE REL-ENTRY-NAME TO ENTRY-NAME-SAVE.                         CL**2
00150      MOVE REL-POINTER-NAME TO POINTER-NAME-SAVE.                     CL**2
00151      MOVE REL-NEXT-REC TO NEXT-REC-SAVE.                             CL**2
00152      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2.                          CL**2
00153      MOVE QTBL-SEL1-ENTTYPE TO ENTRY-TYPE-1.                         CL**2
00154      PERFORM MATCH-ENTRY-TYPE THRU MATCH-ENTRY-TYPE-XIT.             CL**2
00155      IF ENTRY-TYPE-MATCH EQUAL TO "N"                                CL**2
00156          GO TO 0110-NAME-READ.                                       CL**2
00157 *                                                                    CL**2
00158 *    POINTER QUALIFIES -CHECK FOR CONDITION CLAUSE                   CL**2
00159 *                                                                    CL**2
00160      IF QRYTYPE-23 EQUAL TO "70" OR "77" OR "78"                     CL**2
00161          MOVE REL-POINTER-NAME TO QTBL-OPT-CNAME                     CL**2
00162      MOVE REL-POINTER-TYPE TO QTBL-OPT-ENTTYPE                       CL**2
00163          GO TO 0200-RETRIEVE-USAGE.                                  CL**2
00164 *    PROCESS CONDITION CLAUSE (WITH-HAVING)                          CL**2
00165 *        RETRIEVE ENTRY FROM DATA FILE                               CL**2
00166 *                                                                    CL**2
00167      MOVE REL-POINTER-NAME TO QUERY-NAME.                            CL**2
00168      PERFORM QRY-WITH THRU QRY-HAVE-XIT.                             CL**2
00169      IF HIT-SW EQUAL TO "N"                                          CL**2
00170          GO TO 0110-NAME-READ.                                       CL**2
00171      MOVE "N" TO HIT-SW.                                             CL**2
00172      MOVE REL-POINTER-NAME TO QTBL-OPT-CNAME.                        CL**2
00173      MOVE REL-POINTER-TYPE TO QTBL-OPT-ENTTYPE.                      CL**2
00174 **********************************************************           CL**2
00175 *                                                                    CL**2
00176 *    RETRIEVE USAGE OF NAMED ENTRY                                   CL**2
00177 *        THIS PROCESSING IS COMMON TO ALL WHICH-USE                  CL**2
00178 *        QUERIES, IT STARTS AT A NAMED RELATIONAL FILE               CL**2
00179 *        ENTRY AND RETRIEVES ALL RELATED HIGHER LEVEL ENTRIES.       CL**2
00180 *                                                                    CL**2
00181 ******************************************************               CL**2
00182  0200-RETRIEVE-USAGE.                                                CL**2
00183      MOVE QTBL-OPT-CNAME TO REL-ENTRY-NAME.                          CL**2
00184      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00185      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00186      IF REL-RETURN-CODE EQUAL TO "0"                                 CL**2
00187          GO TO 0210-PROCESS-USAGE.                                   CL**2
00188      IF REL-RETURN-CODE NOT EQUAL TO "1"                             CL**2
00189          MOVE "RR" TO QTBL-HDR-REQTYPE                               CL**2
00190          MOVE REL-ENTRY-NAME TO QTBL-SEL2-TOCNAME                    CL**2
00191          GO TO PROGRAM-END-BAD.                                      CL**2
00192 *                                                                    CL**2
00193 *    ENTRY HAS NO USAGE-CK MULTIPLE HIER                             CL**2
00194      IF QRYTYPE-23 GREATER THAN "56"                                 CL**2
00195          GO TO 0100-GET-ENTITY-NAME.                                 CL**2
00196      GO TO 0900-WHICHUSE-END.                                        CL**2
00197  0210-PROCESS-USAGE.                                                 CL**2
00198      MOVE SPACES TO HOLD-KEY-AREA.                                   CL**2
00199      MOVE ZERO TO KEY-CNT.                                           CL**2
00200 *******************************************************              CL**2
00201 *                                                                    CL**2
00202 *    PROCESS USAGE POINTER FOR QUALIFICATION                         CL**2
00203 *                                                                    CL**2
00204 ***************************************************************      CL**2
00205  0300-CHECK-PTR.                                                     CL**2
00206      IF QRYTYPE-23 GREATER THAN "56"                                 CL**2
00207          MOVE QTBL-SEL2-TOTYPE TO ENTRY-TYPE-1                       CL**2
00208      ELSE                                                            CL**2
00209          MOVE QTBL-SEL1-ENTTYPE TO ENTRY-TYPE-1.                     CL**2
00210      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2.                          CL**2
00211      PERFORM MATCH-ENTRY-TYPE THRU MATCH-ENTRY-TYPE-XIT.             CL**2
00212      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2.                          CL**2
00213      IF ENTRY-TYPE-MATCH EQUAL TO "N"                                CL**2
00214          GO TO 0500-UP-A-LEVEL.                                      CL**2
00215 *                                                                    CL**2
00216 *    BYPASS ALIAS/VERSION POINTERS                                   CL**2
00217 *                                                                    CL**2
           IF REL-POINTER-ALIAS IS EQUAL TO "1" OR "2"
00219          GO TO 0700-READ-NEXT-PTR.                                   CL**2
00220 *   REESTABLISH ENTRY TYPE (CAN CHG IN MATCH CODE)                   CL**2
00221      IF QRYTYPE-23 EQUAL TO "50" OR "70" OR "75" OR "76"             CL**2
00222          MOVE "Y" TO HIT-SW                                          CL**2
00223          GO TO 0350-RESTORE.                                         CL**2
00224 *                                                                    CL**2
00225 *    PROCESS DATA FILE FOR CONDITION CLAUSE                          CL**2
00226 *                                                                    CL**2
00227      MOVE REL-POINTER-NAME TO QUERY-NAME.                            CL**2
00228      PERFORM QRY-WITH THRU QRY-HAVE-XIT.                             CL**2
00229  0350-RESTORE.                                                       CL**2
00230      IF HIT-SW EQUAL TO "N"                                          CL**2
00231          GO TO 0500-UP-A-LEVEL.                                      CL**2
00232 ******************************************************               CL**2
00233 *                                                                    CL**2
00234 *    ENTRY QUALIFIES                                                 CL**2
00235 *                                                                    CL**2
00236 ************************************************************         CL**2
00237      MOVE ENTRY-TYPE-2 TO HIT-ENTRY-TYPE.                            CL**2
00238      MOVE REL-POINTER-NAME TO HIT-NAME.                              CL**2
00239      PERFORM WRITE-HIT THRU WRITE-HIT-XIT.                           CL**2
00240      MOVE "N" TO HIT-SW.                                             CL**2
00241 **************************************************************       CL**2
00242 *                                                                    CL**2
00243 *    RETRIEVE USAGE POINTERS OF CURRENT USAGE POINTER                CL**2
00244 *                                                                    CL**2
00245 ************************************************************         CL**2
00246  0500-UP-A-LEVEL.                                                    CL**2
00247      IF ENTRY-TYPE-2 EQUAL TO "65"                                   CL**2
00248          GO TO 0700-READ-NEXT-PTR.                                   CL**2
00249      IF REL-PUSE EQUAL TO "Y"                                        CL**2
00250          GO TO 0700-READ-NEXT-PTR.                                   CL**2
00251      ADD 1 TO KEY-CNT.                                               CL**2
00252      IF KEY-CNT GREATER THAN 30                                      CL**2
00253          SUBTRACT 1 FROM KEY-CNT                                     CL**2
00254          GO TO 0700-READ-NEXT-PTR.                                   CL**2
00255 *                                                                    CL**2
00256 *    SAVE LOCATION OF CURRENT POINTER                                CL**2
00257 *                                                                    CL**2
00258      MOVE REL-ENTRY-NAME TO KEY-ENTRY-NAME (KEY-CNT).                CL**2
00259      MOVE REL-POINTER-NAME TO KEY-POINTER-NAME (KEY-CNT).            CL**2
00260      MOVE REL-NEXT-REC TO KEY-NEXT-REC (KEY-CNT).                    CL**2
00261 *                                                                    CL**2
00262 *    RETRIEVE USAGE                                                  CL**2
00263 *                                                                    CL**2
00264      MOVE REL-POINTER-NAME TO REL-ENTRY-NAME.                        CL**2
00265      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00266      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00267      IF REL-RETURN-CODE EQUAL TO "0"                                 CL**2
00268          GO TO 0300-CHECK-PTR.                                       CL**2
00269      IF REL-RETURN-CODE EQUAL TO "1"                                 CL**2
00270          GO TO 0600-RETURN-A-LEVEL.                                  CL**2
00271      MOVE "RR" TO QTBL-HDR-REQTYPE.                                  CL**2
00272      MOVE REL-ENTRY-NAME TO QTBL-SEL2-TOCNAME.                       CL**2
00273      GO TO PROGRAM-END-BAD.                                          CL**2
00274 *******************************************************              CL**2
00275 *                                                                    CL**2
00276 *        GO DOWN TO PREVIOUSLY PROCESS REL FILE RECORD               CL**2
00277 *                                                                    CL**2
00278 **************************************************************       CL**2
00279  0600-RETURN-A-LEVEL.                                                CL**2
00280      IF KEY-CNT NOT LESS THAN 01                                     CL**2
00281          GO TO 0610-RESTORE-KEY.                                     CL**2
00282      IF QRYTYPE-23 GREATER THAN "56"                                 CL**2
00283          GO TO 0100-GET-ENTITY-NAME                                  CL**2
00284      ELSE                                                            CL**2
00285          GO TO 0900-WHICHUSE-END.                                    CL**2
00286  0610-RESTORE-KEY.                                                   CL**2
00287      MOVE KEY-ENTRY-NAME (KEY-CNT) TO REL-ENTRY-NAME.                CL**2
00288      MOVE KEY-POINTER-NAME (KEY-CNT) TO REL-POINTER-NAME.            CL**2
00289      MOVE KEY-NEXT-REC (KEY-CNT) TO REL-NEXT-REC.                    CL**2
00290      SUBTRACT 1 FROM KEY-CNT.                                        CL**2
00291      PERFORM RETURN-POINTER THRU RETURN-POINTER-XIT.                 CL**2
00292      IF REL-RETURN-CODE NOT EQUAL TO "0"                             CL**2
00293          MOVE "RR" TO QTBL-HDR-REQTYPE                               CL**2
00294          MOVE REL-ENTRY-NAME TO QTBL-SEL2-TOCNAME                    CL**2
00295          GO TO PROGRAM-END-BAD.                                      CL**2
00296 ************************************************************         CL**2
00297 *                                                                    CL**2
00298 *    RETRIEVE THE NEXT USAGE POINTER                                 CL**2
00299 *                                                                    CL**2
00300 *************************************************************        CL**2
00301  0700-READ-NEXT-PTR.                                                 CL**2
00302      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00303      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00304      IF REL-RETURN-CODE EQUAL TO "1" OR "2"                          CL**2
00305          GO TO 0600-RETURN-A-LEVEL.                                  CL**2
00306      GO TO 0300-CHECK-PTR.                                           CL**2
00307 ***********************************************************          CL**2
00308 *                                                                    CL**2
00309 *    END OF MODULE PROCESSING                                        CL**2
00310 *                                                                    CL**2
00311 *******************************************************              CL**2
00312  0900-WHICHUSE-END.                                                  CL**2
00313      GO TO QUERY-END.                                                CL**2
*CALL     MULTLINE                                                         CL**2
*CALL     MATCHENT                                                         CL**5
*CALL     PQRYEND2                                                         CL**2
*CALL     QRYWITH4                                                         CL**2
*CALL     MAST1RFL                                                         CL**5
*CALL     MAST1RNL                                                         CL**5
*CALL     MAST1RFC                                                         CL**5
*CALL     MAST1EXT                                                         CL**5
*CALL     MAST1READ                                                        CL**5
*CALL     MAST1ALG                                                         CL**5
*CALL     MAST3IO1                                                         CL**5
*CALL     RELCOM                                                           CL**5
*CALL     MAST2RK                                                          CL**5
*CALL     RELALG                                                           CL**5
