*DECK     DCQRY020
00001  IDENTIFICATION DIVISION.                                         08/02/78
       PROGRAM-ID. QRY020.
*CALL COPYRIGHT 
      *    VALIDATE NAMES, FIELDS, ETC FOR BUILT QTBL RECORDS 
      *    PRINT ERRORS 
      *    CALL PROCESS PROGRAMS
00010  ENVIRONMENT DIVISION.                                            DCQRY020
00011  CONFIGURATION SECTION.                                           DCQRY020
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
*CALL UPQRYSN 
00014  INPUT-OUTPUT SECTION.                                            DCQRY020
00015  FILE-CONTROL.                                                    DCQRY020
           SELECT MAST2 ASSIGN TO "MAST2" 
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS REL-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".
00023  DATA DIVISION.                                                   DCQRY020
00024  FILE SECTION.                                                    DCQRY020
00025 ******************************************************************DCQRY020
00026 *    PRINT A LINE FROM HERE                                      *DCQRY020
00027 ******************************************************************DCQRY020
*CALL     SYSPRTFD                                                      DCQRY020
*CALL     MAST2FD                                                       DCQRY020
*CALL     MAST3FD                                                       DCQRY020
00031                                                                    DCQRY02
*CALL QRYCSA
*CALL     WRKSTG77                                                      DCQRY020
00033  77  ERROR-CODE                  PICTURE XX.                      DCQRY020
00034  77  HOLD-FLDNO                  PICTURE XXX.                     DCQRY020
00035  77  HOLD-ENTTYPE                PICTURE XXX.                     DCQRY020
00036  77  WITH-SUB                    PICTURE 9.                       DCQRY020
00037  77  SUB3                        PICTURE 99.                      DCQRY020
00038  77  SUB4                        PICTURE 99.                      DCQRY020
00039  77  SUB5              PICTURE 99.                                DCQRY020
00040  77  FLD                         PICTURE 99.                      DCQRY020
00041  77  END-ENTTYPE                 PICTURE XX.                      DCQRY020
00042  77  CAT                 PICTURE 99.                              DCQRY020
00043  77   ENT-ID               PICTURE 99 COMP SYNC.                  DCQRY020
*CALL     WRKSTG01                                                      DCQRY020
00045  01  BLNK-ID.                                                     DCQRY020
00046      03  BLNK-ID-NAME.                                            DCQRY020
00047          05  BLNK-ID-NAME-SUB    PICTURE X OCCURS 32.             DCQRY020
00048          05  BLNK-ID-TRLR        PICTURE 9999.                    DCQRY020
00049  01  BLNK-ID-RD  REDEFINES BLNK-ID.                               DCQRY020
00050      03  BLNK-REC-ID-NUM1        PICTURE 9(18).                   DCQRY020
00051      03  BLNK-REC-ID-NUM2        PICTURE 9(18).                   DCQRY020
*CALL     MAST3DD1                                                      DCQRY020
00053  01  WORK-STORE.                                                  DCQRY020
00054      03  HOLD-FLDNAME.                                            DCQRY020
00055          05  FLDNAME-FIRST8.                                      DCQRY020
00056              07  FLDNAME-FIRST3  PICTURE XXX.                     DCQRY020
00057              07  FLDNAME-BYTE4   PICTURE X.                       DCQRY020
00058              07  FILLER          PICTURE X(4).                    DCQRY020
00059          05  FILLER              PICTURE X(18).                   DCQRY020
00060      03  CAT-LOC-HOLD.                                            DCQRY020
00061          05  HOLD-CAT-NAME     PICTURE X(15).                     DCQRY020
00062          05  HOLD-CAT-ID       PICTURE X(3).                      DCQRY020
               05 ENTRY-USED OCCURS 17 TIMES. 
00064              07  CAT-ENTRY-HOLD   PICTURE 99.                     DCQRY020
00065              07  CAT-LENGTH-HOLD  PICTURE 999 .                    DCQRY02
00066      03  HOLD-VALUE.                                              DCQRY020
00067          05  WORK-VALUE          PICTURE X       OCCURS 50 TIMES. DCQRY020
00068      03  HOLD-FLDVALUE.                                           DCQRY020
00069          05  H-FLD               PICTURE X       OCCURS 50 TIMES. DCQRY020
00070      03  EDIT-WITH.                                               DCQRY020
00071          05  WITH-NO             PICTURE X       OCCURS 3 TIMES.  DCQRY020
00072      03  HOLD-ENTRY-TYPE-1       PICTURE XX.                      DCQRY020
00073      03  HOLD-ENTRY-TYPE-2       PICTURE XX.                      DCQRY020
00074      03  KW-TABLE.                                                DCQRY020
00075          05  KW-HOLD1            PICTURE X(7).                    DCQRY020
00076          05  KW-HOLD2            PICTURE X(7).                    DCQRY020
00077          05  KW-HOLD3            PICTURE X(7).                    DCQRY020
00078      03  INPUT-KW.                                                DCQRY020
00079          05  INPUT-KW-BYTE       PICTURE X OCCURS 7.              DCQRY020
00080      03  OUTPUT-KW.                                               DCQRY020
00081          05  OUTPUT-KW-BYTE      PICTURE X OCCURS 7.              DCQRY020
00082      03  KSUB1                   PICTURE 99 COMP SYNC.            DCQRY020
00083      03  KSUB2                   PICTURE 99 COMP SYNC.            DCQRY020
00084      03  EDIT-SW                 PICTURE X.                       DCQRY020
00085      03  FIELD-TYPE              PICTURE X.                       DCQRY020
00086      03  LITERAL-E               PICTURE X(6) VALUE               DCQRY020
00087         "*ERROR".                                                 DCQRY020
00088 *                                                                 DCQRY020
00089 *    DATA DIVISION ENTRIES FOR SHOW FIELDS                        DCQRY020
00090 *                                                                 DCQRY020
00091      03  NAME-COUNT-HOLD.                                         DCQRY020
00092          05 NAME-COUNT-CHR      PICTURE X OCCURS 8 TIMES.         DCQRY020
00093      03  QSUB           PICTURE 99 COMP SYNC.                     DCQRY020
00094      03  CSUB           PICTURE 99 COMP SYNC.                     DCQRY020
00095      03  SHOW-LINE-LENGTH       PICTURE 99 COMP SYNC.             DCQRY020
00096      03  START-PRINT-POS        PICTURE 99 COMP SYNC  VALUE 50.   DCQRY020
00097      03  MAX-PRINT-POS     PICTURE 999 COMP SYNC  VALUE 132.         CL**2
00098 ******************************************************************DCQRY020
00099 *    ERROR-MESSAGES.                                             *DCQRY020
00100 ******************************************************************DCQRY020
00101  01  ERROR-TABLE.                                                 DCQRY020
00102      03  ERROR-HOLD.                                              DCQRY020
00103          05  ERROR-1            PICTURE X(35) VALUE               DCQRY020
00104               "TITLE VALUE INVALID".                              DCQRY020
00105          05  MESSAGE-NUMBER-1   PICTURE X(11) VALUE "DCQRY-415-S".DCQRY020
00106          05  ERROR-2            PICTURE X(35) VALUE               DCQRY020
00107             "NO INPUT SUBMITTED".                                 DCQRY020
00108          05  MESSAGE-NUMBER-2   PICTURE X(11) VALUE "DCQRY-560-S".DCQRY020
00109          05  ERROR-3            PICTURE X(35) VALUE               DCQRY020
00110             "MAST3 READ ENT RECORD".                              DCQRY020
00111          05  MESSAGE-NUMBER-3   PICTURE X(11) VALUE "DCQRY-975-F".DCQRY020
00112          05  ERROR-4            PICTURE X(35) VALUE               DCQRY020
00113             "***********************************".                DCQRY020
00114          05  MESSAGE-NUMBER-4   PICTURE X(11) VALUE "DCQRY-040-F".DCQRY020
00115          05  ERROR-5            PICTURE X(35) VALUE               DCQRY020
00116             "ENTRY RANGE MUST BE ASCENDING".                      DCQRY020
00117          05  MESSAGE-NUMBER-5   PICTURE X(11) VALUE "DCQRY-540-S".DCQRY020
00118          05  ERROR-6            PICTURE X(35) VALUE               DCQRY020
00119               "ALIAS NOT VALID FOR NAMED ENTRY".                  DCQRY020
00120          05  MESSAGE-NUMBER-6   PICTURE X(11) VALUE "DCQRY-445-S".DCQRY020
00121          05  ERROR-7            PICTURE X(35) VALUE               DCQRY020
00122             "MAST3 READ CATG RECORD".                             DCQRY020
00123          05  MESSAGE-NUMBER-7   PICTURE X(11) VALUE "DCQRY-960-F".DCQRY020
00124          05  ERROR-8            PICTURE X(35) VALUE               DCQRY020
00125               "FIELD NAME INVALID".                               DCQRY020
00126          05  MESSAGE-NUMBER-8   PICTURE X(11) VALUE "DCQRY-460-S".DCQRY020
00127          05  ERROR-9            PICTURE X(35) VALUE               DCQRY020
00128               "INVALID WITH CLAUSE SYNTAX".                       DCQRY020
00129          05  MESSAGE-NUMBER-9   PICTURE X(11) VALUE "DCQRY-465-S".DCQRY020
00130          05  ERROR-10           PICTURE X(35) VALUE               DCQRY020
00131               "FIELD VALUE TOO LONG".                             DCQRY020
00132          05  MESSAGE-NUMBER-10  PICTURE X(11) VALUE "DCQRY-480-S".DCQRY020
00133          05  ERROR-11           PICTURE X(35) VALUE               DCQRY020
00134             "NAME RANGE INVALID".                                 DCQRY020
00135          05  MESSAGE-NUMBER-11  PICTURE X(11) VALUE "DCQRY-535-S".DCQRY020
00136          05  ERROR-12           PICTURE X(35) VALUE               DCQRY020
00137             "EXCESS COMMAND WORDS".                               DCQRY020
00138          05  MESSAGE-NUMBER-12  PICTURE X(11) VALUE "DCQRY-550-S".DCQRY020
00139          05  ERROR-13           PICTURE X(35) VALUE               DCQRY020
00140               "ALIAS/VERSION REQUEST MUST USE--OF".               DCQRY020
00141          05  MESSAGE-NUMBER-13  PICTURE X(11) VALUE "DCQRY-455-S".DCQRY020
00142          05  ERROR-14           PICTURE X(35) VALUE               DCQRY020
00143               "ENTRY TYPE RANGE INVALID".                         DCQRY020
00144          05  MESSAGE-NUMBER-14  PICTURE X(11) VALUE "DCQRY-525-S".DCQRY020
00145          05  ERROR-15           PICTURE X(35) VALUE               DCQRY020
00146            "INVALID DISPLAY WIDTH             ".                  DCQRY020
00147          05  MESSAGE-NUMBER-15  PICTURE X(11) VALUE "DCQRY-150-S".   CL**2
00148          05  ERROR-16           PICTURE X(35) VALUE               DCQRY020
00149               "INVALID WHICH-USE ENTRY TYPE RANGE".               DCQRY020
00150          05  MESSAGE-NUMBER-16  PICTURE X(11) VALUE "DCQRY-505-S".DCQRY020
00151          05  ERROR-17           PICTURE X(35) VALUE               DCQRY020
00152             "INVALID USED-BY ENTRY TYPE RANGE".                   DCQRY020
00153          05  MESSAGE-NUMBER-17  PICTURE X(11) VALUE "DCQRY-520-S".DCQRY020
00154          05  ERROR-18           PICTURE X(35) VALUE               DCQRY020
00155               "CATALOGUE NAME NOT ON FILE".                       DCQRY020
00156          05  MESSAGE-NUMBER-18  PICTURE X(11) VALUE "DCQRY-425-S".DCQRY020
00157          05  ERROR-19           PICTURE X(35) VALUE               DCQRY020
00158               "VERSION NOT VALID FOR NAMED ENTRY".                DCQRY020
00159          05  MESSAGE-NUMBER-19  PICTURE X(11) VALUE "DCQRY-450-S".DCQRY020
00160          05  ERROR-20           PICTURE X(35) VALUE               DCQRY020
00161               "ENTRY TYPE CANNOT USE NAMED ENTRY".                DCQRY020
00162          05  MESSAGE-NUMBER-20  PICTURE X(11) VALUE "DCQRY-510-S".DCQRY020
00163          05  ERROR-21           PICTURE X(35) VALUE               DCQRY020
00164               "ENTRY TYPE NOT USED-BY NAMED ENTRY".               DCQRY020
00165          05  MESSAGE-NUMBER-21  PICTURE X(11) VALUE "DCQRY-515-S".DCQRY020
00166          05  ERROR-22           PICTURE X(35) VALUE               DCQRY020
00167             "LINE NUMBER MUST BE NUMERIC".                        DCQRY020
00168          05  MESSAGE-NUMBER-22  PICTURE X(11) VALUE "DCQRY-440-S".DCQRY020
00169          05  ERROR-23           PICTURE X(35) VALUE               DCQRY020
00170             "INCOMPLETE LIMIT CLAUSE".                            DCQRY020
00171          05  MESSAGE-NUMBER-23  PICTURE X(11) VALUE "DCQRY-430-S".DCQRY020
00172          05  ERROR-24           PICTURE X(35) VALUE               DCQRY020
00173             "ALPHA VALUE MISSING QUOTE".                          DCQRY020
00174          05  MESSAGE-NUMBER-24  PICTURE X(11) VALUE "DCQRY-470-S".DCQRY020
00175          05  ERROR-25           PICTURE X(35) VALUE               DCQRY020
00176               "FIELD VALUE MUST BE NUMERIC".                      DCQRY020
00177          05  MESSAGE-NUMBER-25  PICTURE X(11) VALUE "DCQRY-475-S".DCQRY020
00178          05  ERROR-26           PICTURE X(35) VALUE               DCQRY020
00179               "FIRST WITH--SEARCH CLAUSE--INVALID".               DCQRY020
00180          05  MESSAGE-NUMBER-26  PICTURE X(11) VALUE "DCQRY-485-S".DCQRY020
00181          05  ERROR-27           PICTURE X(35) VALUE               DCQRY020
00182               "SECOND WITH--SEARCH CLAUSE--INVALID".              DCQRY020
00183          05  MESSAGE-NUMBER-27  PICTURE X(11) VALUE "DCQRY-490-S".DCQRY020
00184          05  ERROR-28           PICTURE X(35) VALUE               DCQRY020
00185               "THIRD WITH--SEARCH CLAUSE--INVALID".               DCQRY020
00186          05  MESSAGE-NUMBER-28  PICTURE X(11) VALUE "DCQRY-495-S".DCQRY020
00187          05  ERROR-29           PICTURE X(35) VALUE               DCQRY020
00188              "STATEMENT SEQUENCE ERROR".                          DCQRY020
00189          05  MESSAGE-NUMBER-29  PICTURE X(11) VALUE "DCQRY-410-S".DCQRY020
00190          05  ERROR-30           PICTURE X(35) VALUE               DCQRY020
00191             "MAST READ CLIENT RECORD".                            DCQRY020
00192          05  MESSAGE-NUMBER-30  PICTURE X(11) VALUE "DCQRY-950-F".DCQRY020
00193          05  ERROR-31           PICTURE X(35) VALUE               DCQRY020
00194               "COMMAND NOT FULLY EDITED".                         DCQRY020
00195          05  MESSAGE-NUMBER-31  PICTURE X(11) VALUE "DCQRY-005-I".DCQRY020
00196          05  ERROR-32           PICTURE X(35) VALUE               DCQRY020
00197               "INVALID HAVING CLAUSE SYNTAX".                     DCQRY020
00198          05  MESSAGE-NUMBER-32  PICTURE X(11) VALUE "DCQRY-500-S".DCQRY020
00199          05  ERROR-33            PICTURE X(35) VALUE              DCQRY020
                 "INPUT IGNORED UNTIL $QUERY".
00201          05  MESSAGE-NUMBER-33  PICTURE X(11) VALUE "DCQRY-555-S".DCQRY020
00202          05  ERROR-34            PICTURE X(35) VALUE              DCQRY020
00203               "TO MANY CONTINUATION STATEMENTS".                  DCQRY020
00204          05  MESSAGE-NUMBER-34  PICTURE X(11) VALUE "DCQRY-420-S".DCQRY020
00205          05  ERROR-35            PICTURE X(35) VALUE              DCQRY020
00206                "NO COMMAND SPECIFIED".                            DCQRY020
00207          05  MESSAGE-NUMBER-35  PICTURE X(11) VALUE "DCQRY-405-S".DCQRY020
00208          05  ERROR-36           PICTURE X(35) VALUE               DCQRY020
00209               "FIRST STATEMENT NOT A FUNCTION".                   DCQRY020
00210          05  MESSAGE-NUMBER-36  PICTURE X(11) VALUE "DCQRY-400-S".DCQRY020
00211          05  ERROR-37           PICTURE X(35) VALUE               DCQRY020
00212               "INVALID COMMAND SYNTAX".                           DCQRY020
00213          05  MESSAGE-NUMBER-37  PICTURE X(11) VALUE "DCQRY-545-S".DCQRY020
00214          05  ERROR-38            PICTURE X(35) VALUE              DCQRY020
00215             "LAST WORD PROCESSED SHOWN BELOW".                    DCQRY020
00216          05  MESSAGE-NUMBER-38  PICTURE X(11) VALUE "DCQRY-010-I".DCQRY020
00217          05  ERROR-39.                                            DCQRY020
00218              07  FILLER          PICTURE XXX VALUE SPACES.        DCQRY020
00219              07  LW-MSG          PICTURE X(32).                   DCQRY020
00220          05  MESSAGE-NUMBER-39  PICTURE X(11) VALUE "           ".DCQRY020
00221          05  ERROR-40        PICTURE X(35) VALUE                  DCQRY020
00222              "SHOW CATEGORY INVALID".                             DCQRY020
00223          05  MESSAGE-NUMBER-40  PICTURE X(11) VALUE "DCQRY-435-S".DCQRY020
00224      03  ERROR-PRINT  REDEFINES  ERROR-HOLD.                      DCQRY020
00225          05  ERROR-MOVE          OCCURS 40 TIMES.                 DCQRY020
00226              07  ERROR-MESSAGE   PICTURE X(35).                   DCQRY020
00227              07  ERROR-NUMBER.                                    DCQRY020
00228                  09  FILLER      PICTURE X(10).                   DCQRY020
00229                  09  TYPE-ERR    PICTURE X.                       DCQRY020
00230                                                                    DCQRY02
00252                                                                    DCQRY02
00253  PROCEDURE DIVISION.                                              DCQRY020
       BEGIN-PARA.
00256 ***************************************************************   DCQRY020
00257 *                                                                 DCQRY020
00258 *    INITIALIZATION                                               DCQRY020
00259 *                                                                 DCQRY020
00260 ****************************************************************  DCQRY020
00261      PERFORM CON-OPEN THRU CON-OPEN-XIT.                          DCQRY020
00262      MOVE "1" TO CON-ENTRY-FUNCTION.                              DCQRY020
00263      PERFORM CON-READ THRU CON-READ-XIT.                          DCQRY020
00264      IF CON-RETURN-CODE EQUAL TO "9"                              DCQRY020
00265          MOVE "30" TO ERROR-CODE                                  DCQRY020
00266          GO TO ERROR-SET.                                         DCQRY020
00269      MOVE SPACES TO HOLD-VALUE.                                   DCQRY020
00270      PERFORM REL-OPEN THRU REL-OPEN-XIT.                          DCQRY020
00271 *                                                                 DCQRY020
00272 *     IF ERRORS DETECTED OR VALIDATION COMPLETE                   DCQRY020
00273 *          BYPASS THIS MODULE"S PROCESSING                        DCQRY020
00274 *                                                                 DCQRY020
00275      IF ERROR-COUNT NOT EQUAL TO ZEROES                           DCQRY020
00276         GO TO END-VALIDATE.                                       DCQRY020
00277 *                                                                 DCQRY020
00278 *     DETERMINE PROCESSING ENVIRONMENT                            DCQRY020
00279 *                                                                 DCQRY020
00280      MOVE SPACES TO LAST-WORD.                                    DCQRY020
00281      MOVE "3" TO CON-ENTRY-FUNCTION.                              DCQRY020
00282      PERFORM CON-READ THRU CON-READ-XIT.                          DCQRY020
           MOVE "T" TO QTBL-ENVIRONMENT 
00294 *                                                                 DCQRY020
00295 *    VALIDATE SHOW CATEGORY                                       DCQRY020
00296 *                                                                 DCQRY020
00297 *        IF QUERY IS FOR A SPECIFIED ENTRY TYPE THEN SINGLE       DCQRY020
00298 *         CATEGORY TO BE SHOWN MUST BE VALID FOR THAT             DCQRY020
00299 *        ENTRY TYPE                                               DCQRY020
00300 *                                                                 DCQRY020
00301  SHOW-CHECK.                                                      DCQRY020
00302      IF QRYTYPE-1 NOT EQUAL TO "S"                                DCQRY020
00303          GO TO END-SHOW-CK.                                       DCQRY020
00304      IF QTBL-SHOW-FIELD (1) NOT EQUAL SPACES                      DCQRY020
00305          GO TO EDIT-SHOW-FLD.                                     DCQRY020
00306      IF QRYTYPE-2 EQUAL TO "3" OR "4" OR "5" OR "6" OR "7"        DCQRY020
00307          GO TO SHOW-CHECK-1 ELSE                                  DCQRY020
00308      GO TO END-SHOW-CK.                                           DCQRY020
00309  SHOW-CHECK-1.                                                    DCQRY020
00310      IF QTBL-OUT-CAT GREATER THAN "994"                           DCQRY020
00311          GO TO END-SHOW-CK.                                       DCQRY020
00312      IF QTBL-OUT-CAT EQUAL TO "010" OR "020" OR "030" OR "900"    DCQRY020
00313          GO TO END-SHOW-CK.                                       DCQRY020
00314      IF QTBL-SEL1-ENTTYPE GREATER THAN "95"                       DCQRY020
00315          GO TO END-SHOW-CK.                                       DCQRY020
00316 *                                                                 DCQRY020
00317 *    RETRIEVE CATEGORY RECORD FROM CTL FILE                       DCQRY020
00318 *                                                                 DCQRY020
00319      MOVE 01 TO CAT.                                              DCQRY020
           MOVE 4 TO CON-KEY. 
00321      READ MAST3 INVALID KEY                                       DCQRY020
00322          MOVE "07" TO ERROR-CODE                                  DCQRY020
00323          GO TO ERROR-SET.                                         DCQRY020
00324  CAT-LOOP.                                                        DCQRY020
00325      IF CTL-CAT-ID (CAT) EQUAL TO QTBL-OUT-CAT                    DCQRY020
00326          GO TO MATCH-ENT-ID.                                      DCQRY020
00327      ADD 1 TO CAT.                                                DCQRY020
           IF CAT LESS THAN 32
00329          GO TO CAT-LOOP.                                          DCQRY020
00330      GO TO END-SHOW-CK.                                           DCQRY020
00331 *                                                                 DCQRY020
00332 *    HAVE CATEGORY-SEE IF VALID FOR ENTRY                         DCQRY020
00333 *                                                                 DCQRY020
00334  MATCH-ENT-ID.                                                    DCQRY020
00335      MOVE CTL-CATEGORY (CAT) TO CAT-LOC-HOLD.                     DCQRY020
00336      MOVE 01 TO CAT.                                              DCQRY020
00337  CAT-ENT-LOOP.                                                    DCQRY020
00338      IF CAT-ENTRY-HOLD (CAT) EQUAL TO QTBL-SEL1-ENTTYPE           DCQRY020
00339          GO TO END-SHOW-CK.                                       DCQRY020
00340      ADD 1 TO CAT.                                                DCQRY020
           IF CAT IS LESS THAN 18 
00342          GO TO CAT-ENT-LOOP.                                      DCQRY020
00343      MOVE "40" TO ERROR-CODE.                                     DCQRY020
00344      GO TO ERROR-SET.                                             DCQRY020
00345 ******************************************************************DCQRY020
00346 *                                                                 DCQRY020
00347 *    VALIDATE NAMES USED IN SHOW FIELDS                           DCQRY020
00348 *                                                                 DCQRY020
00349 ******************************************************************DCQRY020
00350  EDIT-SHOW-FLD.                                                   DCQRY020
00351      IF QRYTYPE-23 EQUAL TO "85" OR "95"                          DCQRY020
00352          GO TO SF-SET-SUPER                                       DCQRY020
00353      ELSE                                                         DCQRY020
00354          GO TO SF-INIT-UNIQUE-FLDS.                               DCQRY020
00355  SF-SET-SUPER.                                                    DCQRY020
00356      MOVE "A" TO FIELD-TYPE.                                      DCQRY020
           MOVE "03" TO HOLD-ENTTYPE
00358      GO TO SF-EDIT-FIELD-NAMES.                                      CL**2
00359 *                                                                 DCQRY020
00360 *    INITIALIZE FOR ALL OTHERS - IF QUERY IS ON DATA PROCEDURES   DCQRY020
00361 *    OR  ENTRY IS ONLY COMMON FIELD ALLOWED.                      DCQRY020
00362 *                                                                 DCQRY020
00363  SF-INIT-UNIQUE-FLDS.                                             DCQRY020
00364      MOVE "S" TO FIELD-TYPE.                                      DCQRY020
           IF QRYTYPE-23 EQUAL TO "15" OR "25" OR "04"
00366          MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTTYPE                    DCQRY020
00367          GO TO SF-CK-SUPER-ENT.                                   DCQRY020
00368      IF QRYTYPE-23 EQUAL TO "67" OR "77"                          DCQRY020
00369          MOVE QTBL-SEL2-TOTYPE TO HOLD-ENTTYPE                    DCQRY020
00370      ELSE                                                         DCQRY020
00371          MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTTYPE.                  DCQRY020
00372  SF-CK-SUPER-ENT.                                                 DCQRY020
00373      IF HOLD-ENTTYPE EQUAL TO "97" OR "98" OR "99"                DCQRY020
00374          GO TO SF-SET-SUPER.                                      DCQRY020
00375 *                                                                 DCQRY020
00376 *    EDIT NAMES                                                   DCQRY020
00377 *                                                                 DCQRY020
00378  SF-EDIT-FIELD-NAMES.                                             DCQRY020
00379      IF HOLD-ENTTYPE EQUAL SPACES                                 DCQRY020
00380          GO TO SF-END-VALIDATE.                                   DCQRY020
00381      MOVE 1 TO QSUB.                                              DCQRY020
00382      MOVE SPACES TO HOLD-FLDNAME.                                    CL**2
00383      MOVE START-PRINT-POS TO SHOW-LINE-LENGTH.                    DCQRY020
00384  SF-RETRIEVE-FLD.                                                 DCQRY020
00385      MOVE QTBL-SHOW-FIELD (QSUB) TO HOLD-FLDNAME.                 DCQRY020
00386      PERFORM FIND-FLD THRU FIND-FLD-XIT.                          DCQRY020
00387      IF EDIT-SW EQUAL "Y"                                         DCQRY020
00388          GO TO SF-MATCH-FIELD-NAME.                               DCQRY020
00389 *                                                                 DCQRY020
00390 *    TEST FOR COMMON FIELD                                        DCQRY020
00391 *                                                                 DCQRY020
00392      IF FIELD-TYPE EQUAL TO "A"                                   DCQRY020
00393          GO TO SF-ERROR-08.                                       DCQRY020
00394      MOVE "A" TO FIELD-TYPE.                                      DCQRY020
           MOVE "03" TO HOLD-ENTTYPE
00396      PERFORM FIND-FLD THRU FIND-FLD-XIT.                          DCQRY020
00397 *                                                                 DCQRY020
00398 *    TEST FOR SPECIFIC                                            DCQRY020
00399 *                                                                 DCQRY020
00400      MOVE "S" TO FIELD-TYPE.                                      DCQRY020
00401      IF QRYTYPE-23 EQUAL TO "15" OR "25"                          DCQRY020
00402          MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTTYPE                       CL**2
00403          GO TO SF-CH-ERROR-08.                                    DCQRY020
00404      IF QRYTYPE-23 EQUAL TO "67" OR "77"                          DCQRY020
00405          MOVE QTBL-SEL2-TOTYPE TO HOLD-ENTTYPE                    DCQRY020
00406      ELSE                                                         DCQRY020
00407          MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTTYPE.                     CL**2
00408  SF-CH-ERROR-08.                                                  DCQRY020
00409      IF EDIT-SW EQUAL TO "Y"                                      DCQRY020
00410          GO TO SF-MATCH-FIELD-NAME.                               DCQRY020
00411  SF-ERROR-08.                                                     DCQRY020
00412      MOVE "08" TO ERROR-CODE.                                     DCQRY020
00413      GO TO ERROR-SET.                                             DCQRY020
00414  SF-MATCH-FIELD-NAME.                                             DCQRY020
00415      MOVE CTL-FLD-ENTRY-TYPE TO QTBL-SHOW-ENTNO (QSUB).           DCQRY020
00416      MOVE CTL-FLD-CATEGORY TO QTBL-SHOW-CATNO (QSUB).             DCQRY020
00417      MOVE CTL-FLD-ID (FLD) TO QTBL-SHOW-FNO (QSUB).               DCQRY020
00418 *                                                                 DCQRY020
00419 *    VERIFY REPORT WIDTH  (SN IS USED FOR HEADING-CALC LENGTH)    DCQRY020
00420 *                                                                 DCQRY020
00421      MOVE CTL-FLD-NAME (FLD) TO NAME-COUNT-HOLD.                  DCQRY020
00422      MOVE 4 TO CSUB.                                              DCQRY020
00423  SF-COUNT-CHR.                                                    DCQRY020
00424      IF NAME-COUNT-CHR (CSUB) EQUAL SPACE                            CL**2
00425          GO TO SF-ADJUST.                                         DCQRY020
00426      ADD 1 TO CSUB.                                               DCQRY020
00427      IF CSUB GREATER THAN 8                                       DCQRY020
00428          GO TO SF-ADJUST.                                         DCQRY020
00429      GO TO SF-COUNT-CHR.                                          DCQRY020
00430  SF-ADJUST.                                                       DCQRY020
00431      SUBTRACT 1 FROM CSUB.                                        DCQRY020
00432 *                                                                 DCQRY020
00433 *    USE LONGEST ITEM (EITHER FIELD OR HEADING) IN WIDTH CHECK    DCQRY020
00434 *                                                                 DCQRY020
00435      IF CSUB GREATER THAN CTL-FLD-LENGTH (FLD)                    DCQRY020
00436          ADD CSUB TO SHOW-LINE-LENGTH                             DCQRY020
00437      ELSE                                                         DCQRY020
00438          ADD CTL-FLD-LENGTH (FLD) TO SHOW-LINE-LENGTH.            DCQRY020
00439      ADD 1 TO SHOW-LINE-LENGTH.                                   DCQRY020
00440      IF SHOW-LINE-LENGTH GREATER THAN MAX-PRINT-POS               DCQRY020
00441          MOVE 15 TO ERROR-CODE                                    DCQRY020
00442          GO TO ERROR-SET.                                         DCQRY020
00443  SF-GET-NEXT-FLD.                                                 DCQRY020
00444      IF QSUB EQUAL TO 6                                           DCQRY020
00445          GO TO SF-END-VALIDATE.                                   DCQRY020
00446      ADD 1 TO QSUB.                                               DCQRY020
00447      IF QTBL-SHOW-FIELD (QSUB) NOT EQUAL TO SPACES                DCQRY020
00448          GO TO SF-RETRIEVE-FLD.                                   DCQRY020
00449  SF-END-VALIDATE.                                                 DCQRY020
00450 *                                                                 DCQRY020
00451 *    RESET FIELDS SEL BY WITH CLAUSE VALIDATION                   DCQRY020
00452 *                                                                 DCQRY020
00453      MOVE SPACES TO HOLD-FLDNAME.                                 DCQRY020
00454  END-SHOW-CK.                                                     DCQRY020
00455      IF QRYTYPE-23 EQUAL TO "01" OR "02" OR "03" OR "30"          DCQRY020
00456          OR "36" OR "90" OR "96"                                  DCQRY020
00457          GO TO END-VALIDATE.                                      DCQRY020
00458      IF QRYTYPE-23 EQUAL TO "16" OR "26" OR "46" OR "56"          DCQRY020
00459          GO TO CK-USE.                                            DCQRY020
00460 *********************************************                     DCQRY020
00461 *                                                                 DCQRY020
00462 *     PRELIMINARY EDITS                                           DCQRY020
00463 *        CHECK FOR CORRECT USAGE OF CLAUSES                       DCQRY020
00464 *                                                                 DCQRY020
00465 *************************************************                 DCQRY020
00466      IF QRYTYPE-23 EQUAL TO "35" OR "95"                          DCQRY020
00467          GO TO VALIDATE-FIELDS.                                   DCQRY020
00468      IF QRYTYPE-23 LESS THAN "60"                                 DCQRY020
00469          GO TO CK-USE.                                            DCQRY020
00470 *                                                                 DCQRY020
00471 *    VALIDATE ENTITY USAGE RELATIONSHIPS (RANGE)                  DCQRY020
00472 *        CHECK USED-BY                                            DCQRY020
00473 *                                                                 DCQRY020
00474      IF QRYTYPE-2 NOT EQUAL TO "6"                                DCQRY020
00475          GO TO CK-70-SERIES.                                      DCQRY020
00476      IF QTBL-SEL1-ENTTYPE EQUAL TO "99" OR "97"                   DCQRY020
               GO TO NO-DBP-ALLOWED.
00478      IF QTBL-SEL1-ENTTYPE EQUAL TO "98"                           DCQRY020
00479          GO TO NO-DATA-ALLOWED.                                   DCQRY020
00480      GO TO VAL-ENT-RANGE.                                         DCQRY020
       NO-DBP-ALLOWED.
           IF QTBL-SEL2-TOTYPE IS EQUAL TO "03" 
00483          GO TO BAD-UNIT.                                          DCQRY020
00484      GO TO VALIDATE-FIELDS.                                       DCQRY020
00485  NO-DATA-ALLOWED.                                                 DCQRY020
00486      IF QTBL-SEL2-TOTYPE LESS THAN "35"                           DCQRY020
00487          GO TO BAD-UNIT.                                          DCQRY020
00488      GO TO VALIDATE-FIELDS.                                       DCQRY020
00489 *                                                                 DCQRY020
00490 *    CHECK WHICH-USE                                              DCQRY020
00491 *                                                                 DCQRY020
00492  CK-70-SERIES.                                                    DCQRY020
00493      IF QRYTYPE-2 NOT EQUAL TO "7"                                DCQRY020
00494          GO TO VAL-ENT-RANGE.                                     DCQRY020
00495      IF QTBL-SEL2-TOTYPE EQUAL TO "99" OR "98"                    DCQRY020
00496          GO TO NO-USERS-ALLOWED.                                  DCQRY020
00497      IF QTBL-SEL2-TOTYPE EQUAL TO "97"                            DCQRY020
00498          GO TO NO-PROC-ALLOWED.                                   DCQRY020
00499      GO TO VAL-ENT-RANGE.                                         DCQRY020
00500  NO-USERS-ALLOWED.                                                DCQRY020
00501      IF QTBL-SEL1-ENTTYPE EQUAL TO "65"                           DCQRY020
00502          GO TO BAD-UNIT.                                          DCQRY020
00503      GO TO VALIDATE-FIELDS.                                       DCQRY020
00504  NO-PROC-ALLOWED.                                                 DCQRY020
00505      IF QTBL-SEL1-ENTTYPE GREATER THAN "22"                       DCQRY020
00506          GO TO BAD-UNIT.                                          DCQRY020
00507      GO TO VALIDATE-FIELDS.                                       DCQRY020
00508 *                                                                 DCQRY020
00509 *     VALIDATE ENTRY TYPE RANGES                                  DCQRY020
00510 *                                                                 DCQRY020
00511  VAL-ENT-RANGE.                                                   DCQRY020
00512      MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTRY-TYPE-1.                 DCQRY020
00513      MOVE QTBL-SEL2-TOTYPE TO HOLD-ENTRY-TYPE-2.                  DCQRY020
00514      PERFORM CK-ASCENDING THRU CK-ASCENDING-XIT.                  DCQRY020
00515      IF EDIT-SW EQUAL TO "Y"                                      DCQRY020
00516          GO TO VALIDATE-FIELDS.                                   DCQRY020
00517      IF QRYTYPE-23 GREATER THAN "79"                              DCQRY020
00518          MOVE "05" TO ERROR-CODE                                  DCQRY020
00519          GO TO ERROR-SET.                                         DCQRY020
00520  BAD-UNIT.                                                        DCQRY020
00521      IF QRYTYPE-23 GREATER THAN "69"                              DCQRY020
00522          MOVE "16" TO ERROR-CODE     ELSE                         DCQRY020
00523          MOVE "17" TO ERROR-CODE.                                 DCQRY020
00524          GO TO ERROR-SET.                                         DCQRY020
00525 *                                                                 DCQRY020
00526 *     VALIDATE START NAME FOR USED-BY AND WHICH-USE               DCQRY020
00527 *                                                                 DCQRY020
00528  CK-USE.                                                          DCQRY020
00529      MOVE QTBL-OPT-CNAME TO REL-ENTRY-NAME.                       DCQRY020
00530      MOVE SPACES TO REL-ENTRY-FUNCTION.                           DCQRY020
00531      PERFORM REL-READ THRU REL-READ-XIT.                          DCQRY020
00532      IF REL-RETURN-CODE NOT EQUAL TO "0"                          DCQRY020
00533          MOVE "18" TO ERROR-CODE                                  DCQRY020
00534          GO TO ERROR-SET.                                         DCQRY020
00535      MOVE REL-ENTRY-TYPE TO QTBL-OPT-ENTTYPE.                     DCQRY020
00536      IF QRYTYPE-23 EQUAL TO "04"                                  DCQRY020
00537          GO TO END-VALIDATE.                                      DCQRY020
00538      IF QRYTYPE-23 GREATER THAN "19"                              DCQRY020
00539          GO TO CK-VERSION.                                        DCQRY020
00540 *                                                                 DCQRY020
00541 *     VALIDATE THAT ALIAS USED WITH ELM, GROUP OR REC             DCQRY020
00542 *                                                                 DCQRY020
00543      IF QTBL-OPT-ENTTYPE LESS THAN "18"                           DCQRY020
00544          GO TO VALIDATE-FIELDS.                                   DCQRY020
00545      MOVE "06" TO ERROR-CODE.                                     DCQRY020
00546      GO TO ERROR-SET.                                             DCQRY020
00547 *                                                                 DCQRY020
00548 *     VALIDATE THAT VERSION USED WITH FILE OR PROC                DCQRY020
00549 *                                                                 DCQRY020
00550  CK-VERSION.                                                      DCQRY020
00551      IF QRYTYPE-23 GREATER THAN "29"                              DCQRY020
00552          GO TO CK-WHICH.                                          DCQRY020
00553      IF QTBL-OPT-ENTTYPE LESS THAN "18"                           DCQRY020
00554          MOVE "19" TO ERROR-CODE                                  DCQRY020
00555          GO TO ERROR-SET.                                         DCQRY020
00556      GO TO VALIDATE-FIELDS.                                       DCQRY020
00557 *                                                                 DCQRY020
00558 *     VALIDATE RELATIONSHIP OF WHICH-USE ENTITIES                 DCQRY020
00559 *                                                                 DCQRY020
00560  CK-WHICH.                                                        DCQRY020
00561      IF QRYTYPE-23 EQUAL TO "40" OR "45" OR "46"                  DCQRY020
00562          GO TO CK-USED-BY.                                        DCQRY020
00563      IF QTBL-SEL1-ENTTYPE EQUAL TO "99" OR "98"                   DCQRY020
00564          GO TO NO-USERS-ALLOWED-2.                                DCQRY020
00565      IF QTBL-SEL1-ENTTYPE EQUAL TO "97"                           DCQRY020
00566         GO TO NO-PROC-ALLOWED-2.                                  DCQRY020
00567      GO TO NORM-WHICH.                                            DCQRY020
00568  NO-USERS-ALLOWED-2.                                              DCQRY020
00569      IF QTBL-OPT-ENTTYPE EQUAL TO "65"                            DCQRY020
00570          GO TO BAD-WHICH.                                         DCQRY020
00571      GO TO VALIDATE-FIELDS.                                       DCQRY020
00572  NO-PROC-ALLOWED-2.                                               DCQRY020
           IF QTBL-OPT-ENTTYPE IS GREATER THAN "26" 
00574          GO TO BAD-WHICH.                                         DCQRY020
00575      GO TO VALIDATE-FIELDS.                                       DCQRY020
00576  NORM-WHICH.                                                      DCQRY020
00577      MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTRY-TYPE-1.                  DCQRY020
00578      MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTRY-TYPE-2.                 DCQRY020
00579      PERFORM CK-ASCENDING THRU CK-ASCENDING-XIT.                  DCQRY020
00580      IF EDIT-SW EQUAL TO "Y"                                      DCQRY020
00581          GO TO VALIDATE-FIELDS.                                   DCQRY020
00582  BAD-WHICH.                                                       DCQRY020
00583      MOVE "20" TO ERROR-CODE.                                     DCQRY020
00584      GO TO ERROR-SET.                                             DCQRY020
00585 *                                                                 DCQRY020
00586 *     VALIDATE RELATIONSHIP OF USED-BY ENTITIES                   DCQRY020
00587 *                                                                 DCQRY020
00588  CK-USED-BY.                                                      DCQRY020
00589      IF QTBL-SEL1-ENTTYPE EQUAL TO "99" OR "97"                   DCQRY020
               GO TO NO-DBP-ALLOWED-2.
00591      IF QTBL-SEL1-ENTTYPE EQUAL TO "98"                           DCQRY020
00592          GO TO NO-DATA-ALLOWED-2.                                 DCQRY020
00593      GO TO NORM-UBY.                                              DCQRY020
       NO-DBP-ALLOWED-2.
           IF QTBL-OPT-ENTTYPE IS EQUAL TO "03" 
00596          GO TO BAD-UBY.                                           DCQRY020
00597      GO TO VALIDATE-FIELDS.                                       DCQRY020
00598  NO-DATA-ALLOWED-2.                                               DCQRY020
00599      IF QTBL-OPT-ENTTYPE LESS THAN "35"                           DCQRY020
00600          GO TO BAD-UBY.                                           DCQRY020
00601      GO TO VALIDATE-FIELDS.                                       DCQRY020
00602  NORM-UBY.                                                        DCQRY020
00603      MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTRY-TYPE-1.                 DCQRY020
00604      MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTRY-TYPE-2.                  DCQRY020
00605      PERFORM CK-ASCENDING THRU CK-ASCENDING-XIT.                  DCQRY020
00606      IF EDIT-SW EQUAL TO "Y"                                      DCQRY020
00607          GO TO VALIDATE-FIELDS.                                   DCQRY020
00608  BAD-UBY.                                                         DCQRY020
00609      MOVE "21" TO ERROR-CODE.                                     DCQRY020
00610  ERROR-SET.                                                       DCQRY020
00611      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCQRY020
00612          GO TO END-VALIDATE.                                      DCQRY020
00613 ************************************************                  DCQRY020
00614 *                                                                 DCQRY020
00615 *     EDIT FIELD NAMES AND VALUES OF WITH CLAUSE                  DCQRY020
00616 *                                                                 DCQRY020
00617 ************************************************                  DCQRY020
00618  VALIDATE-FIELDS.                                                 DCQRY020
00619      IF QRYTYPE-3 EQUAL TO "0" OR "6" OR "8"                      DCQRY020
00620          GO TO END-VALIDATE.                                      DCQRY020
00621      MOVE ALL "N" TO EDIT-WITH.                                   DCQRY020
00622 *                                                                 DCQRY020
00623 *    CHECK FOR RANGE QUERIES-ONLY CO MON FIELDS ALLOWED           DCQRY020
00624 *                                                                 DCQRY020
00625      IF QRYTYPE-23 EQUAL TO "85" OR "95"                          DCQRY020
00626          GO TO SET-SUPER ELSE                                     DCQRY020
00627      GO TO INIT-UNIQUE-FLDS.                                         CL**2
00628  SET-SUPER.                                                       DCQRY020
00629      MOVE "A" TO FIELD-TYPE.                                      DCQRY020
           MOVE "03" TO HOLD-ENTTYPE
00631      GO TO EDIT-FIELD-NAME.                                       DCQRY020
00632 *                                                                 DCQRY020
00633 *    INITIALIZE FOR ALL OTHERS-IF QUERY IS ON DATA                DCQRY020
00634 *        PROCEDURES OR ENTRIES ONLY COMMON FIELDS ALLOWED         DCQRY020
00635  INIT-UNIQUE-FLDS.                                                DCQRY020
00636                MOVE "S" TO FIELD-TYPE.                            DCQRY020
00637      IF QRYTYPE-23 EQUAL TO "15" OR "25"                          DCQRY020
00638          MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTTYPE                    DCQRY020
00639          GO TO CK-SUPER-ENT.                                      DCQRY020
00640      IF QRYTYPE-23 EQUAL TO "67" OR "77"                          DCQRY020
00641          MOVE QTBL-SEL2-TOTYPE TO HOLD-ENTTYPE                    DCQRY020
00642      ELSE                                                         DCQRY020
00643          MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTTYPE.                  DCQRY020
00644 *                                                                 DCQRY020
00645  CK-SUPER-ENT.                                                    DCQRY020
00646      IF HOLD-ENTTYPE EQUAL TO "97" OR "98" OR "99"                DCQRY020
00647          GO TO SET-SUPER.                                         DCQRY020
00648 *                                                                 DCQRY020
00649 *    CONTROL VALIDATION OF WITH STATEMENTS                        DCQRY020
00650 *                                                                 DCQRY020
00651  EDIT-FIELD-NAME.                                                    CL**2
00652      IF HOLD-ENTTYPE EQUAL TO SPACES                              DCQRY020
00653          GO TO END-VALIDATE.                                      DCQRY020
00654  SET-FIELDS.                                                      DCQRY020
00655      MOVE SPACES TO KW-TABLE.                                     DCQRY020
00656      IF QTBL-SEL1-ENTNO (1) EQUAL "KW"                            DCQRY020
00657          MOVE QTBL-SEL1-FLDNO (1) TO KW-HOLD1                     DCQRY020
00658          MOVE "KEYWORD " TO QTBL-SEL1-FLDNO (1).                  DCQRY020
00659      IF QTBL-SEL1-ENTNO (2) EQUAL "KW"                            DCQRY020
00660          MOVE QTBL-SEL1-FLDNO (2) TO KW-HOLD2                     DCQRY020
00661          MOVE "KEYWORD " TO QTBL-SEL1-FLDNO (2).                  DCQRY020
00662      IF QTBL-SEL1-ENTNO (3) EQUAL "KW"                            DCQRY020
00663          MOVE QTBL-SEL1-FLDNO (3) TO KW-HOLD3                     DCQRY020
00664          MOVE "KEYWORD " TO QTBL-SEL1-FLDNO (3).                  DCQRY020
00665      MOVE SPACES TO HOLD-FLDNAME.                                 DCQRY020
00666      MOVE QTBL-SEL1-FLDNO (1) TO HOLD-FLDNAME.                    DCQRY020
00667      MOVE 02 TO WITH-SUB.                                         DCQRY020
00668  RETRIEVE-FLD.                                                    DCQRY020
00669      PERFORM FIND-FLD THRU FIND-FLD-XIT.                          DCQRY020
00670      IF EDIT-SW EQUAL TO "Y"                                      DCQRY020
00671          GO TO MATCH-FIELD-NAME.                                     CL**2
00672 *                                                                 DCQRY020
00673 *    TEST FOR A COMMON FIELD                                      DCQRY020
00674 *                                                                 DCQRY020
00675      IF FIELD-TYPE EQUAL TO "A"                                   DCQRY020
00676          GO TO ERROR-08.                                             CL**2
00677      MOVE "A" TO FIELD-TYPE.                                      DCQRY020
           MOVE "03" TO HOLD-ENTTYPE
00679      PERFORM FIND-FLD THRU FIND-FLD-XIT.                          DCQRY020
00680 *                                                                 DCQRY020
00681 *        RESET FOR SPECIFIC FIELD REQUEST                         DCQRY020
00682 *                                                                 DCQRY020
00683      MOVE "S" TO FIELD-TYPE.                                      DCQRY020
00684      IF QRYTYPE-23 EQUAL TO "15" OR "25"                          DCQRY020
00685          MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTTYPE                    DCQRY020
00686          GO TO CK-ERROR-08.                                       DCQRY020
00687      IF QRYTYPE-23 EQUAL TO "67" OR "77"                          DCQRY020
00688          MOVE QTBL-SEL2-TOTYPE TO HOLD-ENTTYPE                    DCQRY020
00689          ELSE                                                     DCQRY020
00690          MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTTYPE.                  DCQRY020
00691  CK-ERROR-08.                                                     DCQRY020
00692      IF EDIT-SW EQUAL TO "Y"                                      DCQRY020
00693          GO TO MATCH-FIELD-NAME.                                     CL**2
00694  ERROR-08.                                                        DCQRY020
00695      MOVE "08" TO ERROR-CODE.                                     DCQRY020
00696      GO TO FLD-ERROR.                                             DCQRY020
00697 *                                                                 DCQRY020
00698 *    RETURNS TO PROCESS AND/OR TESTS IF ANY                       DCQRY020
00699 *                                                                 DCQRY020
00700  GET-NEXT-FLD.                                                    DCQRY020
00701      IF WITH-SUB GREATER THAN 3                                   DCQRY020
00702          GO TO END-FIELD-SEARCH.                                  DCQRY020
00703      IF QTBL-SEL1-FLDNO (WITH-SUB) EQUAL TO SPACES                DCQRY020
00704          GO TO END-FIELD-SEARCH.                                  DCQRY020
00705      MOVE QTBL-SEL1-FLDNO (WITH-SUB) TO HOLD-FLDNAME.             DCQRY020
00706      ADD 1 TO WITH-SUB.                                           DCQRY020
00707      GO TO RETRIEVE-FLD.                                          DCQRY020
00708 *                                                                 DCQRY020
00709 *    SUBROUTINE TO FIND FIELD NAME IN CONTROL FILE                DCQRY020
00710 *                                                                 DCQRY020
00711  MATCH-FIELD-NAME.                                                DCQRY020
00712      SUBTRACT 1 FROM WITH-SUB.                                    DCQRY020
00713      MOVE CTL-FLD-ENTRY-TYPE TO QTBL-SEL1-ENTNO (WITH-SUB).       DCQRY020
00714      MOVE CTL-FLD-CATEGORY TO QTBL-SEL1-CATNO (WITH-SUB).         DCQRY020
00715      MOVE CTL-FLD-ID (FLD) TO QTBL-SEL1-FNO (WITH-SUB).           DCQRY020
00716      MOVE QTBL-SEL1-FLDVALUE (WITH-SUB) TO HOLD-FLDVALUE.         DCQRY020
00717 *                                                                 DCQRY020
00718 *    DETERMINE FORMAT OF FIELD                                    DCQRY020
00719 *                                                                 DCQRY020
00720      IF CTL-FLD-FORMAT (FLD) EQUAL TO "N"                         DCQRY020
00721      GO TO BUILD-NUMERIC.                                         DCQRY020
00722 *                                                                 DCQRY020
00723 *     PROCESS ALPHANUMERIC VALUES                                 DCQRY020
00724 *                                                                 DCQRY020
00725      MOVE 02 TO SUB3.                                             DCQRY020
00726      MOVE 01 TO SUB4.                                             DCQRY020
00727      MOVE SPACES TO HOLD-VALUE.                                   DCQRY020
00728      IF H-FLD (1) NOT EQUAL TO QUOTE                              DCQRY020
00729      MOVE HOLD-FLDVALUE TO HOLD-VALUE                             DCQRY020
00730      GO TO STORE-VALUE.                                           DCQRY020
00731  FLD-VALUE-LOOP.                                                  DCQRY020
00732      MOVE H-FLD (SUB3) TO WORK-VALUE (SUB4).                      DCQRY020
00733      ADD 1 TO SUB3.                                               DCQRY020
00734      IF SUB3 GREATER THAN 50                                      DCQRY020
00735          MOVE "24" TO ERROR-CODE                                  DCQRY020
00736          GO TO FLD-ERROR.                                         DCQRY020
00737      ADD 1 TO SUB4.                                               DCQRY020
00738      IF H-FLD (SUB3) NOT EQUAL TO QUOTE                           DCQRY020
00739          GO TO FLD-VALUE-LOOP.                                    DCQRY020
00740  STORE-VALUE.                                                     DCQRY020
00741      IF CTL-FLD-FORMAT (FLD) EQUAL TO "C"                         DCQRY020
00742          MOVE WORK-VALUE (1) TO H-FLD (1)                         DCQRY020
00743          MOVE SPACES TO HOLD-VALUE                                DCQRY020
00744          MOVE H-FLD (1) TO WORK-VALUE (1)                         DCQRY020
00745          GO TO MOVE-X-VALUE.                                      DCQRY020
00746      MOVE "50" TO SUB3.                                           DCQRY020
00747  CHECK-LENGTH-LOOP.                                               DCQRY020
00748      IF WORK-VALUE (SUB3) NOT EQUAL TO SPACE                      DCQRY020
00749          GO TO CK-LENGTH.                                         DCQRY020
00750      SUBTRACT 1 FROM SUB3.                                        DCQRY020
00751      IF SUB3 EQUAL TO ZERO                                        DCQRY020
00752          GO TO MOVE-X-VALUE.                                      DCQRY020
00753      GO TO CHECK-LENGTH-LOOP.                                     DCQRY020
00754  CK-LENGTH.                                                       DCQRY020
00755      IF SUB3 GREATER THAN CTL-FLD-LENGTH (FLD)                    DCQRY020
00756          MOVE "10" TO ERROR-CODE                                  DCQRY020
00757          GO TO FLD-ERROR.                                         DCQRY020
00758  MOVE-X-VALUE.                                                    DCQRY020
00759      MOVE HOLD-VALUE TO QTBL-SEL1-FLDVALUE (WITH-SUB).            DCQRY020
00760      MOVE "Y" TO WITH-NO (WITH-SUB).                              DCQRY020
00761      ADD 1 TO WITH-SUB.                                           DCQRY020
00762      GO TO GET-NEXT-FLD.                                          DCQRY020
00763 *     PROCESS NUMERIC VALUES                                      DCQRY020
00764  BUILD-NUMERIC.                                                   DCQRY020
00765      MOVE CTL-FLD-LENGTH (FLD) TO SUB4.                           DCQRY020
00766      MOVE ALL "0" TO HOLD-VALUE.                                  DCQRY020
00767      MOVE 50 TO SUB3.                                             DCQRY020
00768  NUM-LOOP.                                                        DCQRY020
00769      IF H-FLD (SUB3) NOT EQUAL TO SPACES                          DCQRY020
00770          GO TO NUM-FLD-LOOP.                                      DCQRY020
00771      SUBTRACT 1 FROM SUB3.                                        DCQRY020
00772      IF SUB3 GREATER THAN ZERO                                    DCQRY020
00773          GO TO NUM-LOOP.                                          DCQRY020
00774  NUM-FLD-LOOP.                                                    DCQRY020
00775      MOVE H-FLD (SUB3) TO WORK-VALUE (SUB4).                      DCQRY020
00776      SUBTRACT 1 FROM SUB3.                                        DCQRY020
00777      IF SUB3 LESS THAN 01                                         DCQRY020
00778          GO TO CK-NUMERIC.                                        DCQRY020
00779      SUBTRACT 1 FROM SUB4.                                        DCQRY020
00780      IF SUB4 LESS THAN 01                                         DCQRY020
00781          MOVE "10" TO ERROR-CODE                                  DCQRY020
00782          GO TO FLD-ERROR.                                         DCQRY020
00783      GO TO NUM-FLD-LOOP.                                          DCQRY020
00784 *                                                                 DCQRY020
00785 *     PROCESS NUMERIC VALUES                                      DCQRY020
00786 *                                                                 DCQRY020
00787  CK-NUMERIC.                                                      DCQRY020
00788      IF HOLD-VALUE IS NOT NUMERIC                                 DCQRY020
00789          MOVE "25" TO ERROR-CODE                                  DCQRY020
00790          GO TO FLD-ERROR.                                         DCQRY020
00791      MOVE CTL-FLD-LENGTH (FLD) TO SUB4.                           DCQRY020
00792  CLEAR-ZERO.                                                      DCQRY020
00793      ADD 1 TO SUB4.                                               DCQRY020
00794      MOVE SPACES TO WORK-VALUE (SUB4).                            DCQRY020
00795      IF SUB4 NOT GREATER THAN 50                                  DCQRY020
00796          GO TO CLEAR-ZERO.                                        DCQRY020
00797      MOVE HOLD-VALUE TO QTBL-SEL1-FLDVALUE (WITH-SUB).            DCQRY020
00798      MOVE "Y" TO WITH-NO (WITH-SUB).                              DCQRY020
00799      ADD 1 TO WITH-SUB.                                           DCQRY020
00800      GO TO GET-NEXT-FLD.                                          DCQRY020
00801  FLD-ERROR.                                                       DCQRY020
00802      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCQRY020
00803      ADD 1 TO WITH-SUB.                                           DCQRY020
00804      GO TO GET-NEXT-FLD.                                          DCQRY020
00805  END-FIELD-SEARCH.                                                DCQRY020
00806      IF KW-HOLD1 NOT EQUAL TO SPACES                              DCQRY020
00807          MOVE KW-HOLD1 TO INPUT-KW                                DCQRY020
00808          PERFORM 9500-CVTKW THRU 9599-CVTKW-XIT                   DCQRY020
00809          MOVE OUTPUT-KW TO QTBL-SEL1-FLDNO (1).                   DCQRY020
00810      IF KW-HOLD2 NOT EQUAL TO SPACES                              DCQRY020
00811          MOVE KW-HOLD2 TO INPUT-KW                                DCQRY020
00812          PERFORM 9500-CVTKW THRU 9599-CVTKW-XIT                   DCQRY020
00813          MOVE OUTPUT-KW TO QTBL-SEL1-FLDNO (2).                   DCQRY020
00814      IF KW-HOLD3 NOT EQUAL TO SPACES                              DCQRY020
00815          MOVE KW-HOLD3 TO INPUT-KW                                DCQRY020
00816          PERFORM 9500-CVTKW THRU 9599-CVTKW-XIT                   DCQRY020
00817          MOVE OUTPUT-KW TO QTBL-SEL1-FLDNO (3).                   DCQRY020
00818      IF WITH-NO (1) EQUAL TO "N"                                  DCQRY020
00819          MOVE "26" TO ERROR-CODE                                  DCQRY020
00820          PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                    DCQRY020
00821      IF QTBL-SEL1-FLDNO (2) EQUAL TO SPACES                       DCQRY020
00822          GO TO END-VALIDATE.                                      DCQRY020
00823      IF WITH-NO (2) EQUAL TO "N"                                  DCQRY020
00824          MOVE "27" TO ERROR-CODE                                  DCQRY020
00825          PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                    DCQRY020
00826      IF QTBL-SEL1-FLDNO (3) EQUAL TO SPACES                       DCQRY020
00827          GO TO END-VALIDATE.                                      DCQRY020
00828      IF WITH-NO (3) EQUAL TO "N"                                  DCQRY020
00829          MOVE "28" TO ERROR-CODE                                  DCQRY020
00830          PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                    DCQRY020
00831      GO TO END-VALIDATE.                                          DCQRY020
00832  FIND-FLD.                                                        DCQRY020
00833      MOVE 01 TO FLD.                                              DCQRY020
00834      MOVE "N" TO EDIT-SW.                                         DCQRY020
00835      MOVE HOLD-ENTTYPE TO CON-ENTRY-TYPE.                         DCQRY020
00836      MOVE "E" TO CON-ENTRY-FUNCTION.                              DCQRY020
00837      PERFORM CON-READ THRU CON-READ-XIT.                          DCQRY020
00838      IF CON-RETURN-CODE NOT EQUAL TO ZERO                         DCQRY020
00839          GO TO FIND-FLD-XIT.                                      DCQRY020
00840  FLD-LOOP.                                                        DCQRY020
00841      IF FLDNAME-BYTE4 NOT EQUAL TO SPACE                          DCQRY020
00842          GO TO CK-FULL-NAME.                                      DCQRY020
00843      IF FLDNAME-FIRST3 EQUAL TO CTL-FLD-NAME-3 (FLD)              DCQRY020
00844          GO TO POSSIBLE-MATCH.                                    DCQRY020
00845      GO TO TRY-NEXT.                                              DCQRY020
00846  CK-FULL-NAME.                                                    DCQRY020
00847      IF HOLD-FLDNAME EQUAL TO CTL-FLD-NAME (FLD)                  DCQRY020
00848          GO TO POSSIBLE-MATCH.                                    DCQRY020
00849  TRY-NEXT.                                                        DCQRY020
00850      ADD 1 TO FLD.                                                DCQRY020
00851      IF FLD GREATER THAN 20                                       DCQRY020
00852          GO TO NEXT-FLD-RECORD.                                   DCQRY020
00853      IF CTL-FLD-ID (FLD) NOT EQUAL TO SPACES                      DCQRY020
00854      GO TO FLD-LOOP.                                              DCQRY020
00855  NEXT-FLD-RECORD.                                                 DCQRY020
00856 *    GET ANOTHER RECORD                                           DCQRY020
00857      MOVE "N" TO CON-ENTRY-FUNCTION.                              DCQRY020
00858      PERFORM CON-READ THRU CON-READ-XIT.                          DCQRY020
00859      IF CON-RETURN-CODE EQUAL TO ZERO                             DCQRY020
00860          MOVE 1 TO FLD                                            DCQRY020
00861          GO TO FLD-LOOP.                                          DCQRY020
00862      GO TO FIND-FLD-XIT.                                          DCQRY020
00863 *                                                                 DCQRY020
00864 *    HAVE MATCH ON NAME-IF COMMON FIELD QUERY                     DCQRY020
00865 *              VALIDATE CATEGORY                                  DCQRY020
00866  POSSIBLE-MATCH.                                                  DCQRY020
00867      IF FIELD-TYPE EQUAL TO "S"                                   DCQRY020
00868          MOVE "Y" TO EDIT-SW                                      DCQRY020
00869          GO TO FIND-FLD-XIT.                                      DCQRY020
00870      IF CTL-FLD-CATEGORY EQUAL TO "010" OR "020" OR "030"         DCQRY020
00871              OR "900"                                             DCQRY020
00872          MOVE "Y" TO EDIT-SW.                                     DCQRY020
00873  FIND-FLD-XIT.                                                    DCQRY020
00874      EXIT.                                                        DCQRY020
00875 *************************************************                 DCQRY020
00876 *                                                                 DCQRY020
00877 *     END EDIT03 PROCESSING                                       DCQRY020
00878 *                                                                 DCQRY020
00879 ************************************************                  DCQRY020
00880  END-VALIDATE.                                                    DCQRY020
00881      IF ERROR-COUNT EQUAL TO ZERO                                 DCQRY020
00882          GO TO PRINT-REQUEST-ERRORS.                              DCQRY020
00883      IF LAST-WORD EQUAL TO SPACES                                 DCQRY020
00884          GO TO PRINT-REQUEST-ERRORS.                              DCQRY020
00885      MOVE "38" TO ERROR-CODE.                                     DCQRY020
00886      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCQRY020
00887      MOVE "39" TO ERROR-CODE.                                     DCQRY020
00888      MOVE LAST-WORD TO LW-MSG.                                    DCQRY020
00889      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCQRY020
00890  PRINT-REQUEST-ERRORS.                                            DCQRY020
00891      PERFORM PRINT-REQUEST THRU PRINT-REQUEST-XIT.                DCQRY020
00892      PERFORM CON-CLOSE THRU CON-CLOSE-XIT.                        DCQRY020
00893      PERFORM REL-CLOSE THRU REL-CLOSE-XIT.                        DCQRY020
           EXIT PROGRAM.
00895 ************************************************                  DCQRY020
00896 ************************************************                  DCQRY020
00897 *     SUBROUTINES                                                 DCQRY020
00898 *                                                                 DCQRY020
00899 ************************************************                  DCQRY020
00900 ***********************************************                   DCQRY020
00901 ***************************************************************   DCQRY020
00902 *    STACK ERROR IN TABLE- ERROR IS ERROR-CODE                    DCQRY020
00903 ****************************************************************  DCQRY020
00904  ERROR-RTN.                                                       DCQRY020
00905      ADD 1 TO ERROR-COUNT.                                        DCQRY020
00906      IF ERROR-COUNT GREATER THAN 20                               DCQRY020
00907          GO TO ERROR-RTN-XIT.                                     DCQRY020
00908      MOVE ERROR-CODE TO ERROR-BUILD (ERROR-COUNT).                DCQRY020
00909  ERROR-RTN-XIT.                                                   DCQRY020
00910      EXIT.                                                        DCQRY020
00911 ******************************************************            DCQRY020
00912 *                                                                 DCQRY020
00913 *      PRINT USER REQUEST AND ERROR MESSAGES                      DCQRY020
00914 *                                                                 DCQRY020
00915 *******************************************************           DCQRY020
00916  PRINT-REQUEST.                                                   DCQRY020
           OPEN OUTPUT SYSPRINT WITH NO REWIND. 
00918      MOVE SPACES TO PRINT-LINE.                                   DCQRY020
00919      MOVE SPACES TO STD-REPORT-REC.                               DCQRY020
00920 *                                                                 DCQRY020
00921 *      PRINT ERROR MESSAGES IF ANY                                DCQRY020
00922 *                                                                 DCQRY020
00923      IF ERROR-COUNT EQUAL TO ZEROES                               DCQRY020
00924          GO TO DONE-PRINT-REQ.                                    DCQRY020
00925      MOVE 01 TO SUB3.                                             DCQRY020
00926  PRINT-ERROR-LOOP.                                                DCQRY020
00927      MOVE ERROR-BUILD (SUB3) TO SUB5.                             DCQRY020
00928      MOVE ERROR-NUMBER (SUB5) TO PRINT-MESSAGE-NUMBER.            DCQRY020
00929      IF SUB5 EQUAL TO "38" OR "39"                                DCQRY020
00930          MOVE SPACES TO PRINT-ERROR-LITERAL                       DCQRY020
00931          GO TO MESSAGE-SKIP.                                      DCQRY020
00932      MOVE LITERAL-E TO PRINT-ERROR-LITERAL.                       DCQRY020
00933  MESSAGE-SKIP.                                                    DCQRY020
00934      MOVE ERROR-MESSAGE (SUB5) TO PRINT-ERROR-MESSAGE.            DCQRY020
00935      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCQRY020
00936      IF TYPE-ERR (SUB5) EQUAL TO "F"                              DCQRY020
00937          MOVE "12" TO RETURN-CODE                                 DCQRY020
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT
00938          STOP RUN.                                                DCQRY020
00939      ADD 1 TO SUB3.                                               DCQRY020
00940      IF SUB3 NOT GREATER THAN ERROR-COUNT                         DCQRY020
00941          GO TO PRINT-ERROR-LOOP.                                  DCQRY020
00942  DONE-PRINT-REQ.                                                  DCQRY020
           CLOSE SYSPRINT WITH NO REWIND. 
00944  PRINT-REQUEST-XIT.                                               DCQRY020
00945      EXIT.                                                        DCQRY020
00946                                                                    DCQRY02
00947 ******************************************************************DCQRY020
00948 *                                                                 DCQRY020
00949 *    CHECK ASCENDING ENTRY TYPES                                  DCQRY020
00950 *                                                                 DCQRY020
00951 ********************************************************          DCQRY020
00952  CK-ASCENDING.                                                    DCQRY020
00953      MOVE "Y" TO EDIT-SW.                                         DCQRY020
00954      IF HOLD-ENTRY-TYPE-2 EQUAL TO HOLD-ENTRY-TYPE-1              DCQRY020
00955          GO TO CHECK-EQUAL-USAGE.                                 DCQRY020
           IF HOLD-ENTRY-TYPE-2 GREATER THAN HOLD-ENTRY-TYPE-1
00957          GO TO CK-ASCENDING-XIT.                                  DCQRY020
00958      IF HOLD-ENTRY-TYPE-1 EQUAL TO "35" OR "40" OR "45"           DCQRY020
00959          GO TO CK-REPORT.                                         DCQRY020
00960      IF HOLD-ENTRY-TYPE-1 EQUAL TO "50" OR "55"                   DCQRY020
00961          GO TO CK-PROGRAM.                                        DCQRY020
00962      GO TO NOT-ASCENDING.                                         DCQRY020
00963  CK-REPORT.                                                       DCQRY020
00964      IF HOLD-ENTRY-TYPE-2 EQUAL TO "35" OR "40" OR "45"           DCQRY020
00965          GO TO CK-ASCENDING-XIT.                                  DCQRY020
00966      GO TO NOT-ASCENDING.                                         DCQRY020
00967  CK-PROGRAM.                                                      DCQRY020
00968      IF HOLD-ENTRY-TYPE-2 EQUAL TO "50" OR "55"                   DCQRY020
00969          GO TO CK-ASCENDING-XIT.                                  DCQRY020
00970      GO TO NOT-ASCENDING.                                         DCQRY020
00971 *                                                                 DCQRY020
00972 *    USED-BY AND WHICH-USE EQUALITY TEST                          DCQRY020
00973 *                                                                 DCQRY020
00974  CHECK-EQUAL-USAGE.                                               DCQRY020
00975      IF QRYTYPE-2 EQUAL TO "4" OR "5" OR "6" OR "7"               DCQRY020
00976          NEXT SENTENCE ELSE                                       DCQRY020
00977          GO TO NOT-ASCENDING.                                     DCQRY020
00978      IF HOLD-ENTRY-TYPE-2 EQUAL TO "09" OR "10" OR "50"           DCQRY020
00979          OR "55" OR "60"                                          DCQRY020
00980          GO TO CK-ASCENDING-XIT.                                  DCQRY020
00981 *                                                                 DCQRY020
00982 *    NOT GREATER THAN OR EQUAL                                   *DCQRY020
00983 *                                                                 DCQRY020
00984  NOT-ASCENDING.                                                   DCQRY020
00985      MOVE "N" TO EDIT-SW.                                         DCQRY020
00986  CK-ASCENDING-XIT.                                                DCQRY020
00987      EXIT.                                                        DCQRY020
00988                                                                    DCQRY02
00989 ************************************************************      DCQRY020
00990 *                                                                 DCQRY020
00991 *    CONVERT KW FIELD NAMES                                       DCQRY020
00992 *        . VALIDATES THAT KW IS FOLLOWED BY NUMBER FROM 1 -99999  DCQRY020
00993 *        . CONVERTS KW1 TO KW00001                                DCQRY020
00994 *        . CONVERTS KW TO KW00000                                 DCQRY020
00995 *        . INPUT IN INPUT-KW                                      DCQRY020
00996 *        . OUTPUT IN OUTPUT-KW                                    DCQRY020
00997 **************************************************************    DCQRY020
00998  9500-CVTKW.                                                      DCQRY020
00999      MOVE ZEROES TO OUTPUT-KW.                                    DCQRY020
01000      MOVE 7 TO KSUB1.                                                CL**2
01001      MOVE 7 TO KSUB2.                                                CL**2
01002  9505-GET-BYTE.                                                      CL**2
01003      IF INPUT-KW-BYTE (KSUB1) EQUAL SPACES                           CL**2
01004          SUBTRACT 1 FROM KSUB1                                       CL**2
01005          GO TO 9505-GET-BYTE.                                        CL**2
01006      IF INPUT-KW-BYTE (KSUB1) EQUAL "W"                              CL**2
01007          GO TO 9510-CK-NUM.                                          CL**2
01008      MOVE INPUT-KW-BYTE (KSUB1) TO OUTPUT-KW-BYTE (KSUB2).           CL**2
01009      SUBTRACT 1 FROM KSUB2.                                          CL**2
01010      SUBTRACT 1 FROM KSUB1.                                          CL**2
01011      GO TO 9505-GET-BYTE.                                            CL**2
01012  9510-CK-NUM.                                                        CL**2
01013      IF OUTPUT-KW NUMERIC                                            CL**2
01014          MOVE "K" TO OUTPUT-KW-BYTE (1)                              CL**2
01015          MOVE "W" TO OUTPUT-KW-BYTE (2)                              CL**2
01016          GO TO 9599-CVTKW-XIT.                                       CL**2
01017      MOVE "31" TO ERROR-CODE.                                        CL**2
01018      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                           CL**2
01019  9599-CVTKW-XIT.                                                     CL**2
01020      EXIT.                                                           CL**2
*CALL RETCODE 
*CALL     DISPLAYLN                                                        CL**2
*CALL     WRITELN                                                          CL**2
01023  USER-ROUTINE.                                                       CL**2
01024  USER-ROUTINE-XIT.                                                   CL**2
01025      EXIT.                                                           CL**2
*CALL     RELALG                                                           CL**2
*CALL     RELCOM                                                           CL**2
*CALL     MAST3IO1                                                         CL**2
