*DECK     DCRPT020
00001  IDENTIFICATION DIVISION.                                         10/04/78
       PROGRAM-ID.   RPT020.
*CALL COPYRIGHT 
      *    VALIDATE NAMES, FIELDS, ETC OF BUILT RTBL RECORDS
      *    PRINT ERRORS 
00010  ENVIRONMENT DIVISION.                                            DCRPT020
00011  CONFIGURATION SECTION.                                           DCRPT020
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00014  INPUT-OUTPUT SECTION.                                            DCRPT020
00015  FILE-CONTROL.                                                    DCRPT020
           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.                                                   DCRPT020
00024  FILE SECTION.                                                    DCRPT020
00025 ******************************************************************DCRPT020
00026 *    PRINT A LINE FROM HERE                                      *DCRPT020
00027 ******************************************************************DCRPT020
*CALL     SYSPRTFD                                                      DCRPT020
*CALL     MAST2FD                                                       DCRPT020
*CALL     MAST3FD                                                       DCRPT020
*CALL RETSCS
*CALL     WRKSTG77                                                      DCRPT020
00032  77  ERROR-CODE                  PICTURE XX.                      DCRPT020
00033  77  HOLD-FLDNO                  PICTURE XXX.                     DCRPT020
00034  77  HOLD-ENTTYPE                PICTURE XXX.                     DCRPT020
00035  77  WITH-SUB                    PICTURE 9    COMP SYNC.          DCRPT020
00036  77  SUB3                        PICTURE 99    COMP SYNC.         DCRPT020
00037  77  SUB4                        PICTURE 99.                         CL**2
00038  77  SUB5                        PICTURE 99    COMP SYNC.         DCRPT020
00039  77  FLD                         PICTURE 99    COMP SYNC.         DCRPT020
00040  77  END-ENTTYPE                 PICTURE XX.                      DCRPT020
00041  77  CAT                         PICTURE 99    COMP SYNC.         DCRPT020
00042  77  SUBA                        PICTURE 99    COMP SYNC.         DCRPT020
00043  77  OUTA                        PICTURE 99    COMP SYNC.         DCRPT020
00044  77  SELA                         PICTURE 99.                        CL**2
00045  77  CHECK-SW                    PICTURE X.                       DCRPT020
00046  77  NUMBER-SW                  PICTURE X.                        DCRPT020
00047  77  SUB6                         PICTURE 99.                        CL**2
00048  77  FIELD-SW                    PICTURE X.                          CL**2
00049  77  LCSUB                     PICTURE 99 COMP SYNC.                 CL**2
*CALL     WRKSTG01                                                      DCRPT020
00051  01  BLNK-ID.                                                     DCRPT020
00052      03  BLNK-ID-NAME.                                            DCRPT020
00053          05  BLNK-ID-NAME-SUB     PICTURE X OCCURS 32 TIMES.      DCRPT020
00054      03  BLNK-ID-TRLR             PICTURE 99999.                  DCRPT020
00055  01  BLNK-ID-RD  REDEFINES  BLNK-ID.                              DCRPT020
00056      03  BLNK-REC-ID-NUM1         PICTURE 9(18).                  DCRPT020
00057      03  BLNK-REC-ID-NUM2         PICTURE 9(18).                  DCRPT020
*CALL     MAST3DD1                                                      DCRPT020
00059  01  WORK-STORE.                                                  DCRPT020
00060      03  HOLD-FLDNAME.                                            DCRPT020
00061          05  FLDNAME-FIRST8.                                      DCRPT020
00062              07  FLDNAME-FIRST3  PICTURE XXX.                     DCRPT020
00063              07  FLDNAME-BYTE4   PICTURE X.                       DCRPT020
00064              07  FILLER          PICTURE X(4).                    DCRPT020
00065          05  FILLER              PICTURE X(18).                   DCRPT020
00066      03  CAT-LOC-HOLD.                                            DCRPT020
00067          05  HOLD-CAT-NAME       PICTURE X(15).                   DCRPT020
00068          05  HOLD-CAT-ID         PICTURE X(3).                    DCRPT020
00069          05  ENTRY-USED OCCURS 15 TIMES.                          DCRPT020
00070              07  CAT-ENTRY-HOLD  PICTURE 99.                         CL**2
00071              07  CAT-LENGTH-HOLD PICTURE 999 .                     DCRPT02
00072      03  HOLD-VALUE.                                              DCRPT020
00073          05  WORK-VALUE          PICTURE X       OCCURS 50 TIMES. DCRPT020
00074      03  HOLD-FLDVALUE.                                           DCRPT020
00075          05  H-FLD               PICTURE X       OCCURS 50 TIMES. DCRPT020
00076      03  EDIT-WITH.                                               DCRPT020
00077          05  WITH-NO             PICTURE X       OCCURS 3 TIMES.  DCRPT020
00078      03  HOLD-ENTRY-TYPE-1       PICTURE XX.                      DCRPT020
00079      03  HOLD-ENTRY-TYPE-2       PICTURE XX.                      DCRPT020
00080      03  KW-TABLE.                                                   CL**2
00081          05  KW-HOLD1              PICTURE X(7).                     CL**2
00082          05  KW-HOLD2              PICTURE X(7).                     CL**2
00083          05  KW-HOLD3              PICTURE X(7).                     CL**2
00084      03  HOLD-KW-ERROR             PICTURE 99.                       CL**2
00085      03  INPUT-KW.                                                   CL**2
00086          05  INPUT-KW-BYTE         PICTURE X OCCURS 7.               CL**2
00087      03  OUTPUT-KW.                                                  CL**2
00088          05  OUTPUT-KW-BYTE        PICTURE X OCCURS 7.               CL**2
00089      03  KSUB1                     PICTURE 99 COMP SYNC.             CL**2
00090      03  KSUB2                     PICTURE 99 COMP SYNC.             CL**2
00091      03  EDIT-SW                 PICTURE X.                       DCRPT020
00092      03  FIELD-TYPE              PICTURE X.                       DCRPT020
00093      03  LITERAL-E               PICTURE X(6) VALUE               DCRPT020
00094         "*ERROR".                                                 DCRPT020
00095  01  HOLD-SELECT-NUMBER.                                          DCRPT020
00096      03  HOLD-SELECT             PICTURE 99  OCCURS 30 TIMES.        CL**2
00097      03  HOLD-SELECT-A            PICTURE 99   OCCURS 30 TIMES.      CL**2
00098 ******************************************************************DCRPT020
00099 *    ERROR-MESSAGES.                                             *DCRPT020
00100 ******************************************************************DCRPT020
00101  01  ERROR-TABLE.                                                 DCRPT020
00102      03  ERROR-HOLD.                                              DCRPT020
00103          05  ERROR-1            PICTURE X(35) VALUE               DCRPT020
00104             "NO REQUEST INPUT".                                      CL**2
00105          05  MESSAGE-NUMBER-1   PICTURE X(11) VALUE "DCRPT-400-S".   CL**2
00106          05  ERROR-2            PICTURE X(35) VALUE               DCRPT020
00107             "TITLE VALUE INVALID".                                DCRPT020
               05  MESSAGE-NUMBER-2 PICTURE X(11) VALUE "DCRPT-450-S".
00109          05  ERROR-3            PICTURE X(35) VALUE               DCRPT020
00110             "INPUT IGNORED UNTIL NEXT FUNCTION".                  DCRPT020
00111          05  MESSAGE-NUMBER-3   PICTURE X(11) VALUE "DCRPT-410-S".   CL**2
00112          05  ERROR-4            PICTURE X(35) VALUE               DCRPT020
00113             "STATEMENT SEQUENCE ERROR".                           DCRPT020
00114          05  MESSAGE-NUMBER-4   PICTURE X(11) VALUE "DCRPT-405-S".   CL**2
00115          05  ERROR-5            PICTURE X(35) VALUE               DCRPT020
00116             "TO MANY SELECT STATEMENTS".                             CL**2
00117          05  MESSAGE-NUMBER-5   PICTURE X(11) VALUE "DCRPT-510-S".   CL**2
00118          05  ERROR-6            PICTURE X(35) VALUE               DCRPT020
00119             "TOO MANY OUTPUT STATEMENTS".                         DCRPT020
00120          05  MESSAGE-NUMBER-6   PICTURE X(11) VALUE "DCRPT-715-S".   CL**2
00121          05  ERROR-7            PICTURE X(35) VALUE               DCRPT020
00122             "TOO MANY OPTION CONTINUATIONS".                      DCRPT020
00123          05  MESSAGE-NUMBER-7   PICTURE X(11) VALUE "DCRPT-485-S".   CL**2
00124          05  ERROR-8            PICTURE X(35) VALUE               DCRPT020
00125             "TOO MANY SELECT CONTINUATIONS".                      DCRPT020
00126          05  MESSAGE-NUMBER-8   PICTURE X(11) VALUE "DCRPT-515-S".   CL**2
00127          05  ERROR-9            PICTURE X(35) VALUE               DCRPT020
00128             "NO REPORT/FILE TYPE SPECIFIED".                         CL**2
00129          05  MESSAGE-NUMBER-9   PICTURE X(11) VALUE "DCRPT-425-S".   CL**2
00130          05  ERROR-10           PICTURE X(35) VALUE               DCRPT020
00131             "*************************".                             CL**2
00132          05  MESSAGE-NUMBER-10  PICTURE X(11) VALUE "DCRPT-NNN-S".   CL**2
00133          05  ERROR-11.                                            DCRPT020
00134              07  FILE-1         PICTURE X(15).                    DCRPT020
00135              07  FILLER         PICTURE X(20)   VALUE             DCRPT020
00136             "ILLEGAL REPORT/FILE".                                   CL**2
00137          05  MESSAGE-NUMBER-11  PICTURE X(11) VALUE "DCRPT-435-S".   CL**2
00138          05  ERROR-12           PICTURE X(35) VALUE               DCRPT020
00139          "$REPORT SYSTEM NAME INVALID".                              CL**2
00140          05  MESSAGE-NUMBER-12 PICTURE X(11) VALUE "DCRPT-436-S".    CL**2
00141          05  ERROR-13           PICTURE X(35) VALUE               DCRPT020
00142             "*************************".                             CL**2
00143          05  MESSAGE-NUMBER-13  PICTURE X(11) VALUE "DCRPT-NNN-S".   CL**2
00144          05  ERROR-14           PICTURE X(35) VALUE               DCRPT020
00145             "REPORT/FILE SYNTAX ERROR".                              CL**2
00146          05  MESSAGE-NUMBER-14  PICTURE X(11) VALUE "DCRPT-430-S".   CL**2
00147          05  ERROR-15           PICTURE X(35) VALUE               DCRPT020
00148         "OUTPUT STMT INVALID FOR REPORT".                            CL**2
00149          05  MESSAGE-NUMBER-15 PICTURE X(11) VALUE "DCRPT-437-S".    CL**2
00150          05  ERROR-16           PICTURE X(35) VALUE               DCRPT020
00151             "COMMA AFTER LAST OPTION/EXPECT MORE".                DCRPT020
00152          05  MESSAGE-NUMBER-16  PICTURE X(11) VALUE "DCRPT-480-S".   CL**2
00153          05  ERROR-17           PICTURE X(35) VALUE               DCRPT020
00154             "INVALID OPTION SYNTAX".                              DCRPT020
00155          05  MESSAGE-NUMBER-17  PICTURE X(11) VALUE "DCRPT-460-S".   CL**2
00156          05  ERROR-18.                                            DCRPT020
00157              07  FILLER         PICTURE X(7)   VALUE              DCRPT020
00158                 "OPTION ".                                        DCRPT020
00159              07  FILE-C         PICTURE X(13).                    DCRPT020
00160              07  FILLER         PICTURE X(15)  VALUE              DCRPT020
00161                 " HAS NO VALUE".                                  DCRPT020
00162          05  MESSAGE-NUMBER-18  PICTURE X(11) VALUE "DCRPT-465-S".   CL**2
00163          05  ERROR-19           PICTURE X(35)   VALUE                CL**2
00164             "*************************".                             CL**2
00165          05  MESSAGE-NUMBER-19  PICTURE X(11) VALUE "DCRPT-NNN-S".   CL**2
00166          05  ERROR-20.                                            DCRPT020
00167              07  OPT-NAME-A     PICTURE X(15).                    DCRPT020
00168              07  FILLER         PICTURE X(20)   VALUE             DCRPT020
00169             "INVALID FOR REQUEST".                                   CL**2
00170          05  MESSAGE-NUMBER-20  PICTURE X(11) VALUE "DCRPT-470-S".   CL**2
00171          05  ERROR-21           PICTURE X(35) VALUE               DCRPT020
00172             "KEYWORD OPTION AND/OR RELATIONSHIP".                 DCRPT020
00173          05  MESSAGE-NUMBER-21  PICTURE X(11) VALUE "DCRPT-490-S".   CL**2
00174          05  ERROR-22           PICTURE X(35) VALUE               DCRPT020
00175             "INVALID SELECT SYNTAX".                              DCRPT020
00176          05  MESSAGE-NUMBER-22  PICTURE X(11) VALUE "DCRPT-505-S".   CL**2
00177          05  ERROR-23           PICTURE X(35) VALUE               DCRPT020
00178             "ALIAS/VERSION SELECT MUST USE-OF".                      CL**2
00179          05  MESSAGE-NUMBER-23  PICTURE X(11) VALUE "DCRPT-520-S".   CL**2
00180          05  ERROR-24           PICTURE X(35) VALUE               DCRPT020
00181             "NAME RANGE INVALID".                                 DCRPT020
00182          05  MESSAGE-NUMBER-24 PICTURE X(11) VALUE "DCRPT-540-S".    CL**2
00183          05  ERROR-25           PICTURE X(35) VALUE               DCRPT020
00184             "ALPHA VALUE MISSING QUOTE".                          DCRPT020
00185          05  MESSAGE-NUMBER-25  PICTURE X(11) VALUE "DCRPT-580-S".   CL**2
00186          05  ERROR-26.                                            DCRPT020
00187              07  FILLER           PICTURE X(33)   VALUE           DCRPT020
00188                 "SELECT STATEMENT IN ERROR IS #".                    CL**2
00189              07  SEL-ERROR      PICTURE XX.                          CL**2
00190          05  MESSAGE-NUMBER-26  PICTURE X(11) VALUE "DCRPT-500-S".   CL**2
00191          05  ERROR-27.                                            DCRPT020
00192              07  OPT-NAME-B     PICTURE X(12).                    DCRPT020
00193              07  FILLER         PICTURE X(23)   VALUE             DCRPT020
00194                 "OPTION VALUE INVALID".                           DCRPT020
00195          05  MESSAGE-NUMBER-27  PICTURE X(11) VALUE "DCRPT-475-S".   CL**2
00196          05  ERROR-28.                                            DCRPT020
00197              07  NUM-RECORD     PICTURE X(12).                    DCRPT020
00198              07  FILLER         PICTURE X(23)   VALUE             DCRPT020
00199                 "NUMERIC VALUE TOO LARGE".                        DCRPT020
00200          05  MESSAGE-NUMBER-28  PICTURE X(11) VALUE "DCRPT-645-S".   CL**2
00201          05  ERROR-29           PICTURE X(35) VALUE               DCRPT020
00202             "ALIAS/VERSION INVALID FOR REQUEST".                  DCRPT020
00203          05  MESSAGE-NUMBER-29  PICTURE X(11) VALUE "DCRPT-525-S".   CL**2
00204          05  ERROR-30           PICTURE X(35) VALUE               DCRPT020
00205             "ENTRY TYPE RANGE INVALID".                           DCRPT020
00206          05  MESSAGE-NUMBER-30  PICTURE X(11) VALUE "DCRPT-550-S".   CL**2
00207          05  ERROR-31           PICTURE X(35) VALUE               DCRPT020
00208             "FIELD NAME INVALID".                                 DCRPT020
00209          05  MESSAGE-NUMBER-31  PICTURE X(11) VALUE "DCRPT-585-S".   CL**2
00210          05  ERROR-32           PICTURE X(35) VALUE               DCRPT020
00211             "INVALID WITH CLAUSE SYNTAX".                         DCRPT020
00212          05  MESSAGE-NUMBER-32  PICTURE X(11) VALUE "DCRPT-600-S".   CL**2
00213          05  ERROR-33           PICTURE X(35) VALUE               DCRPT020
00214             "INVALID HAVING CLAUSE SYNTAX".                       DCRPT020
00215          05  MESSAGE-NUMBER-33  PICTURE X(11) VALUE "DCRPT-605-S".   CL**2
00216          05  ERROR-34           PICTURE X(35) VALUE               DCRPT020
00217             "EXCESS STATEMENT WORDS".                                CL**2
00218          05  MESSAGE-NUMBER-34  PICTURE X(11) VALUE "DCRPT-635-S".   CL**2
00219          05  ERROR-35           PICTURE X(35) VALUE               DCRPT020
00220             "SELECT INVALID FOR REQUEST".                            CL**2
00221          05  MESSAGE-NUMBER-35  PICTURE X(11) VALUE "DCRPT-640-S".   CL**2
00222          05  ERROR-36           PICTURE X(35) VALUE               DCRPT020
00223             "INVALID USE-OUTPUT CLAUSE".                          DCRPT020
00224          05  MESSAGE-NUMBER-36  PICTURE X(11) VALUE "DCRPT-630-S".   CL**2
00225          05  ERROR-37           PICTURE X(35) VALUE               DCRPT020
00226             "INVALID OUTPUT STATEMENT".                           DCRPT020
00227          05  MESSAGE-NUMBER-37  PICTURE X(11) VALUE "DCRPT-710-S".   CL**2
00228          05  ERROR-38           PICTURE X(35) VALUE               DCRPT020
00229             "OUTPUT STATEMENT MUST BE NUMBERED".                     CL**2
00230          05  MESSAGE-NUMBER-38  PICTURE X(11) VALUE "DCRPT-720-S".   CL**2
00231          05  ERROR-39           PICTURE X(35)   VALUE             DCRPT020
00232             "OUTPUT STATEMENT SEQUENCE ERROR".                       CL**2
00233          05  MESSAGE-NUMBER-39  PICTURE X(11) VALUE "DCRPT-730-S".   CL**2
00234          05  ERROR-40           PICTURE X(35) VALUE               DCRPT020
00235             "OUTPUT CATEGORY CLAUSE ILLEGAL".                     DCRPT020
00236          05  MESSAGE-NUMBER-40  PICTURE X(11) VALUE "DCRPT-740-S".   CL**2
00237          05  ERROR-41           PICTURE X(35)   VALUE             DCRPT020
00238             "INCOMPLETE LINE LIMITS".                                CL**2
00239          05  MESSAGE-NUMBER-41  PICTURE X(11) VALUE "DCRPT-745-S".   CL**2
00240          05  ERROR-42           PICTURE X(35)   VALUE             DCRPT020
00241             "SELECT REFERS TO MISSING OUTPUT".                    DCRPT020
00242          05  MESSAGE-NUMBER-42  PICTURE X(11) VALUE "DCRPT-625-S".   CL**2
00243          05  ERROR-43.                                            DCRPT020
00244              07  FILLER         PICTURE X(33)   VALUE             DCRPT020
00245                 "OUTPUT STATEMENT IN ERROR IS #".                    CL**2
00246              07  OUT-ERR        PICTURE XX.                          CL**2
00247          05  MESSAGE-NUMBER-43  PICTURE X(11) VALUE "DCRPT-700-S".   CL**2
00248          05  ERROR-44           PICTURE X(35)   VALUE             DCRPT020
00249             "OUTPUT STATEMENT ILLEGALLY NUMBERED".                DCRPT020
00250          05  MESSAGE-NUMBER-44  PICTURE X(11) VALUE "DCRPT-725-S".   CL**2
00251          05  ERROR-45           PICTURE X(35)   VALUE             DCRPT020
00252             "SELECT REFERS TO MISSING OUTPUT".                    DCRPT020
00253          05  MESSAGE-NUMBER-45  PICTURE X(11) VALUE "DCRPT-625-S".   CL**2
00254          05  ERROR-46           PICTURE X(35)   VALUE             DCRPT020
00255             "MAST3 READ CLIENT RECORD".                              CL**2
00256          05  MESSAGE-NUMBER-46  PICTURE X(11) VALUE "DCRPT-950-F".   CL**2
00257          05  ERROR-47           PICTURE X(35)   VALUE             DCRPT020
00258             "MAST3 READ CATG RECORD".                             DCRPT020
00259          05  MESSAGE-NUMBER-47  PICTURE X(11) VALUE "DCRPT-960-F".   CL**2
00260          05  ERROR-48           PICTURE X(35)   VALUE             DCRPT020
00261             "OUTPUT CATEGORY INVALID".                            DCRPT020
00262          05  MESSAGE-NUMBER-48  PICTURE X(11) VALUE "DCRPT-750-S".   CL**2
00263          05  ERROR-49           PICTURE X(35)   VALUE             DCRPT020
00264             "ENTRY RANGE MUST BE ASCENDING".                      DCRPT020
00265          05  MESSAGE-NUMBER-49  PICTURE X(11) VALUE "DCRPT-555-S".   CL**2
00266          05  ERROR-50           PICTURE X(35)   VALUE             DCRPT020
00267             "INVALID HIERARCHY ENTRY RANGE".                      DCRPT020
00268          05  MESSAGE-NUMBER-50  PICTURE X(11) VALUE "DCRPT-560-S".   CL**2
00269          05  ERROR-51           PICTURE X(35)   VALUE             DCRPT020
00270             "INVALID USAGE ENTRY RANGE".                          DCRPT020
00271          05  MESSAGE-NUMBER-51  PICTURE X(11) VALUE "DCRPT-565-S".   CL**2
00272          05  ERROR-52           PICTURE X(35)   VALUE             DCRPT020
00273             "CATALOGUE NAME NOT ON FILE".                            CL**2
00274          05  MESSAGE-NUMBER-52  PICTURE X(11) VALUE "DCRPT-440-S".   CL**2
00275          05  ERROR-53           PICTURE X(35)   VALUE             DCRPT020
00276             "ALIAS NOT VALID FOR NAMED ENTRY".                    DCRPT020
00277          05  MESSAGE-NUMBER-53  PICTURE X(11) VALUE "DCRPT-530-S".   CL**2
00278          05  ERROR-54           PICTURE X(35)   VALUE             DCRPT020
00279             "VERSION NOT VALID FOR NAMED ENTRY".                  DCRPT020
00280          05  MESSAGE-NUMBER-54  PICTURE X(11) VALUE "DCRPT-535-S".   CL**2
00281          05  ERROR-55           PICTURE X(35)   VALUE             DCRPT020
00282             "ENTRY TYPE CANNOT USE NAMED ENTRY".                  DCRPT020
00283          05  MESSAGE-NUMBER-55  PICTURE X(11) VALUE "DCRPT-570-S".   CL**2
00284          05  ERROR-56           PICTURE X(35)   VALUE             DCRPT020
00285             "ENTRY TYPE NOT USED BY NAMED ENTRY".                 DCRPT020
00286          05  MESSAGE-NUMBER-56  PICTURE X(11) VALUE "DCRPT-575-S".   CL**2
00287          05  ERROR-57           PICTURE X(35)   VALUE             DCRPT020
00288             "FIELD VALUE TOO LONG".                               DCRPT020
00289          05  MESSAGE-NUMBER-57  PICTURE X(11) VALUE "DCRPT-590-S".   CL**2
00290          05  ERROR-58           PICTURE X(35)   VALUE             DCRPT020
00291             "FIELD VALUE MUST BE NUMERIC".                        DCRPT020
00292          05  MESSAGE-NUMBER-58  PICTURE X(11) VALUE "DCRPT-595-S".   CL**2
00293          05  ERROR-59           PICTURE X(35)   VALUE             DCRPT020
00294             "FIRST WITH--SEARCH CLAUSE--INVALID".                 DCRPT020
00295          05  MESSAGE-NUMBER-59  PICTURE X(11) VALUE "DCRPT-610-S".   CL**2
00296          05  ERROR-60           PICTURE X(35)   VALUE             DCRPT020
00297             "SECOND WITH--SEARCH CLAUSE--INVALID".                DCRPT020
00298          05  MESSAGE-NUMBER-60  PICTURE X(11) VALUE "DCRPT-615-S".   CL**2
00299          05  ERROR-61           PICTURE X(35)   VALUE             DCRPT020
00300             "THIRD WITH--SEARCH CLAUSE--INVALID".                 DCRPT020
00301          05  MESSAGE-NUMBER-61  PICTURE X(11) VALUE "DCRPT-620-S".   CL**2
00302          05  ERROR-62           PICTURE X(35)   VALUE             DCRPT020
00303             "OUTPUT LINE NUMBER MUST BE NUMERIC".                    CL**2
00304          05  MESSAGE-NUMBER-62  PICTURE X(11) VALUE "DCRPT-755-S".   CL**2
00305          05  ERROR-63           PICTURE X(35)   VALUE                CL**2
00306             "UNRECOGNIZABLE STATEMENT TYPE".                         CL**2
00307          05  MESSAGE-NUMBER-63  PICTURE X(11) VALUE "DCRPT-415-S".   CL**2
00308          05  ERROR-64.                                               CL**2
00309              07  FILLER         PICTURE X(33)   VALUE                CL**2
00310                 "REFERS TO SELECT STATEMENT #".                      CL**2
00311              07  SELECT-NUMBER  PICTURE XX.                          CL**2
00312          05  MESSAGE-NUMBER-64  PICTURE X(11) VALUE "DCRPT-705-S".   CL**2
00313          05  ERROR-65           PICTURE X(35)   VALUE                CL**2
00314             "NAME RANGE MUST BE ASCENDING".                          CL**2
00315          05  MESSAGE-NUMBER-65  PICTURE X(11) VALUE "DCRPT-545-S".   CL**2
00316          05  ERROR-66           PICTURE X(35)   VALUE                CL**2
00317             "DUPLICATE CATEGORIES IN OUTPUT".                        CL**2
00318          05  MESSAGE-NUMBER-66  PICTURE X(11) VALUE "DCRPT-760-S".   CL**2
00319      03  ERROR-PRINT  REDEFINES  ERROR-HOLD.                      DCRPT020
00320          05  ERROR-MOVE         OCCURS 66 TIMES.                     CL**2
00321              07  ERROR-MESSAGE   PICTURE X(35).                   DCRPT020
00322              07  ERROR-NUMBER.                                    DCRPT020
00323                  09  FILLER      PICTURE X(10).                   DCRPT020
00324                  09  TYPE-ERR    PICTURE X.                       DCRPT020
00325                                                                    DCRPT02
00355                                                                    DCRPT02
00356  PROCEDURE DIVISION.                                              DCRPT020
00359 ***************************************************************   DCRPT020
00360 *                                                                 DCRPT020
00361 *    INITIALIZATION                                               DCRPT020
00362 *                                                                 DCRPT020
00363 ****************************************************************  DCRPT020
       BEGIN-PARA.
00364      MOVE ZERO TO HOLD-SELECT-NUMBER.                             DCRPT020
00365      MOVE SPACE TO EDIT-SW.                                          CL**2
00366      MOVE SPACE TO CHECK-SW.                                         CL**2
00367      MOVE SPACE TO FIELD-SW.                                         CL**2
00368      PERFORM CON-OPEN THRU CON-OPEN-XIT.                          DCRPT020
00369      MOVE "1" TO CON-ENTRY-FUNCTION.                              DCRPT020
00370      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT020
00371      IF CON-RETURN-CODE EQUAL TO "9"                              DCRPT020
00372          MOVE "46" TO ERROR-CODE                                  DCRPT020
00373          PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT           DCRPT020
00374          MOVE "A" TO CHECK-SW                                     DCRPT020
00375          GO TO 8000-END-VALIDATE.                                 DCRPT020
00378      PERFORM REL-OPEN THRU REL-OPEN-XIT.                          DCRPT020
00379 *                                                                 DCRPT020
00380 *     IF ERRORS DETECTED OR VALIDATION COMPLETE                   DCRPT020
00381 *          BYPASS THIS MODULE"S PROCESSING                        DCRPT020
00382 *                                                                 DCRPT020
00383      MOVE ZERO TO OUTA, SUBA, SUB6.                                  CL**2
00384      MOVE 01 TO SELA.                                                CL**2
00385      IF ERROR-CHECK EQUAL TO "Y"                                  DCRPT020
00386          MOVE "A" TO CHECK-SW                                     DCRPT020
00387          GO TO 7000-TEST-FOR-ERRORS.                              DCRPT020
00388      MOVE SPACES TO NUMBER-SW.                                    DCRPT020
00389      MOVE SPACES TO QTBL-HDR-ENT.                                    CL**2
00390 *                                                                 DCRPT020
00391 *    TEST IF ANY SELECTS EXIST                                    DCRPT020
00392 *                                                                 DCRPT020
00393      IF RTBL-QRYTYPE-23 (SELA) EQUAL TO SPACES                    DCRPT020
00394          MOVE "A" TO CHECK-SW                                     DCRPT020
00395          GO TO 1700-NO-SELECTS-EXIST.                             DCRPT020
00396      GO TO 1500-SET-QTBL.                                         DCRPT020
00397 *                                                                 DCRPT020
00398 *    PROCESS NEXT SELECT AFTER VERIFICATION OF AT LEAST ONE       DCRPT020
00399 *                                                                 DCRPT020
00400  1000-TEST-NEXT-SELECT.                                           DCRPT020
00401      MOVE "N" TO NUMBER-SW.                                       DCRPT020
00402      MOVE ZERO TO OUTA.                                           DCRPT020
00403      ADD 1 TO SELA.                                               DCRPT020
00404      IF SELA GREATER THAN 9                                       DCRPT020
00405          MOVE "A" TO CHECK-SW                                        CL**2
00406          GO TO 8000-END-VALIDATE.                                 DCRPT020
00407      IF RTBL-QRYTYPE-23 (SELA) EQUAL TO SPACES                    DCRPT020
00408          MOVE "A" TO CHECK-SW                                     DCRPT020
00409          GO TO 8000-END-VALIDATE.                                 DCRPT020
00410 *                                                                 DCRPT020
00411 *    FOUND A SELECT---MUST SET UP QTBL-FOR PROCESSING             DCRPT020
00412 *                                                                 DCRPT020
00413  1500-SET-QTBL.                                                   DCRPT020
00414      MOVE SPACES TO QTBL-HDR-ENT.                                    CL**2
00415      MOVE RTBL-SEL1-QRYTYPE (SELA) TO QTBL-OPT-QRYTYPE.           DCRPT020
00416      IF QRYTYPE-2 EQUAL TO "4" OR "5"                             DCRPT020
00417          MOVE RTBL-HDR-STARTCNAME TO QTBL-OPT-CNAME               DCRPT020
00418          MOVE RTBL-HDR-STARTCNAME TO RTBL-OPT-CNAME (SELA).       DCRPT020
00419      IF QRYTYPE-2 EQUAL TO "6"                                       CL**2
00420          MOVE RTBL-HDR-ENTTYPE TO QTBL-SEL2-TOTYPE.                  CL**2
00421      IF QRYTYPE-2 EQUAL TO "8"                                    DCRPT020
00422          MOVE RTBL-SEL2-TOTYPE (SELA) TO QTBL-SEL2-TOTYPE.        DCRPT020
00423      IF QRYTYPE-2 EQUAL TO "9"                                    DCRPT020
00424          MOVE RTBL-SEL2-TOCNAME (SELA) TO QTBL-SEL2-TOCNAME.      DCRPT020
00425      MOVE RTBL-OPT-CNAME (SELA) TO QTBL-OPT-CNAME.                   CL**2
00426      MOVE RTBL-OPT-ENTTYPE (SELA) TO QTBL-OPT-ENTTYPE.               CL**2
00427      MOVE RTBL-OPT-CAT (SELA) TO QTBL-OPT-CAT.                       CL**2
00428      MOVE RTBL-SELECT1-ENT (SELA) TO QTBL-SELECT1-ENT.               CL**2
00429      IF RTBL-QRYTYPE-2 (SELA) EQUAL TO "7"                           CL**2
00430          MOVE RTBL-SEL1-ENTTYPE (SELA) TO QTBL-SEL2-TOTYPE           CL**2
00431          MOVE RTBL-HDR-ENTTYPE TO QTBL-SEL1-ENTTYPE.                 CL**2
00432 *                                                                 DCRPT020
00433 *    TEST IF SELECT REFERS TO A NUMBERED OUTPUT STATEMENT         DCRPT020
00434 *                                                                 DCRPT020
00435  1600-TEST-SELECT-NUMBER.                                         DCRPT020
00436      IF RTBL-USEOUT-NUM (SELA) EQUAL TO ZERO                      DCRPT020
00437          MOVE "B" TO CHECK-SW                                     DCRPT020
00438          GO TO 1900-TEST-ALL-OUTPUT.                              DCRPT020
00439      MOVE "C" TO CHECK-SW.                                        DCRPT020
00440      GO TO 2000-TEST-NUMBERED-OUTPUT.                             DCRPT020
00441 *                                                                 DCRPT020
00442 *    FOUND THAT NO SELECTS EXIST---MUST CHECK FOR OUTPUTS         DCRPT020
00443 *                                                                 DCRPT020
00444  1700-NO-SELECTS-EXIST.                                           DCRPT020
00445      ADD 1 TO OUTA.                                               DCRPT020
00446      IF OUTA GREATER THAN 9                                       DCRPT020
00447          GO TO 8100-END-PROCESSING.                               DCRPT020
00448      IF RTBL-OUT-CAT (OUTA) EQUAL TO SPACES                       DCRPT020
00449          GO TO 8100-END-PROCESSING.                               DCRPT020
00450 *                                                                 DCRPT020
00451 *    FOUND OUTPUT CARDS BUT NO SELECTS                            DCRPT020
00452 *        OUTPUT STATEMENTS THEREFORE CANNOT BE NUMBERED           DCRPT020
00453 *                                                                 DCRPT020
00454  1800-CHECK-FOR-NUMBERS.                                          DCRPT020
00455      IF RTBL-OUTPUT-NUM (OUTA) EQUAL TO ZERO                      DCRPT020
00456          MOVE "30" TO QRYTYPE-23                                  DCRPT020
00457          GO TO 2200-MOVE-LIMIT-TABLE.                             DCRPT020
00458      MOVE "44" TO ERROR-CODE                                      DCRPT020
00459      GO TO 8500-SET-UP-ERROR.                                     DCRPT020
00460 *                                                                 DCRPT020
00461 *    TEST FOR OUTPUT STATEMENTS WITH NO NUMBER                    DCRPT020
00462 *        SELECT SPECIFIES NO NUMBERED OUTPUT                      DCRPT020
00463 *                                                                 DCRPT020
00464  1900-TEST-ALL-OUTPUT.                                            DCRPT020
00465      ADD 1 TO OUTA.                                               DCRPT020
00466      IF OUTA GREATER THAN 9                                       DCRPT020
00467          GO TO 4000-VALIDATE-SELECTION.                           DCRPT020
00468      IF RTBL-OUT-CAT (OUTA) EQUAL TO SPACES                       DCRPT020
00469          GO TO 4000-VALIDATE-SELECTION.                           DCRPT020
00470      IF RTBL-OUTPUT-NUM (OUTA) EQUAL TO ZERO                      DCRPT020
00471          GO TO 2200-MOVE-LIMIT-TABLE.                             DCRPT020
00472      GO TO 4000-VALIDATE-SELECTION.                               DCRPT020
00473 *                                                                 DCRPT020
00474 *    SELECT REFERENCES A NUMBERED OUTPUT STATEMENT                DCRPT020
00475 *        IT CAN THEREFORE REFERENCE A NON-NUMBERED OUTOUT ALSO    DCRPT020
00476 *                                                                 DCRPT020
00477  2000-TEST-NUMBERED-OUTPUT.                                       DCRPT020
00478      ADD 1 TO OUTA.                                               DCRPT020
00479      IF OUTA GREATER THAN 9                                       DCRPT020
00480          GO TO 2150-TEST-SWITCH.                                  DCRPT020
00481      IF RTBL-OUT-CAT (OUTA) EQUAL TO SPACES                       DCRPT020
00482          GO TO 2150-TEST-SWITCH.                                  DCRPT020
00483      IF NUMBER-SW EQUAL TO "Y"                                    DCRPT020
00484          GO TO 2100-TEST-EQUALITY.                                DCRPT020
00485      IF RTBL-OUTPUT-NUM (OUTA) EQUAL TO ZERO                      DCRPT020
00486          GO TO 2200-MOVE-LIMIT-TABLE.                             DCRPT020
00487 *                                                                 DCRPT020
00488 *    TEST EQUALITY BETWEEN NUMBERED SELECT AND NUMBERED OUTPUT    DCRPT020
00489 *                                                                 DCRPT020
00490  2100-TEST-EQUALITY.                                              DCRPT020
00491      IF RTBL-USEOUT-NUM (SELA) EQUAL TO RTBL-OUTPUT-NUM (OUTA)    DCRPT020
00492          MOVE "Y" TO NUMBER-SW                                    DCRPT020
00493          GO TO 2200-MOVE-LIMIT-TABLE.                             DCRPT020
00494      IF NUMBER-SW EQUAL TO "Y"                                    DCRPT020
00495          GO TO 4000-VALIDATE-SELECTION.                           DCRPT020
00496      ADD 1 TO OUTA.                                               DCRPT020
00497      IF OUTA GREATER THAN 9                                       DCRPT020
00498          GO TO 2150-TEST-SWITCH.                                  DCRPT020
00499      GO TO 2100-TEST-EQUALITY.                                    DCRPT020
00500 *                                                                 DCRPT020
00501 *    TEST NUMBER SWITCH--MAKE SURE CORRECT NUMBERED OUTPUT FOUND  DCRPT020
00502 *                                                                 DCRPT020
00503  2150-TEST-SWITCH.                                                DCRPT020
00504      IF NUMBER-SW EQUAL TO "Y"                                    DCRPT020
00505          GO TO 4000-VALIDATE-SELECTION.                           DCRPT020
00506      MOVE "45" TO ERROR-CODE.                                     DCRPT020
00507      GO TO 8600-SET-SELECT-ERROR.                                 DCRPT020
00508 *                                                                 DCRPT020
00509 *    MOVE DATA FROM OUTPUT STATEMENT TO QTBL                      DCRPT020
00510 *                                                                 DCRPT020
00511  2200-MOVE-LIMIT-TABLE.                                           DCRPT020
00512      MOVE RTBL-OUT-CAT (OUTA) TO QTBL-OUT-CAT.                    DCRPT020
00513      MOVE RTBL-OUT-FRLINE (OUTA) TO QTBL-OUT-FRLINE.              DCRPT020
00514      MOVE RTBL-OUT-TOLINE (OUTA) TO QTBL-OUT-TOLINE.              DCRPT020
00515      MOVE RTBL-OUT-FORLINES (OUTA) TO QTBL-OUT-FORLINES.          DCRPT020
00516 *                                                                 DCRPT020
00517 *    VALIDATE OUTPUT CATEGORY                                     DCRPT020
00518 *        IF REQUEST IS FOR AN ENTRY THEN CATEGORY                 DCRPT020
00519 *        MUST BE VALID FOR THAT ENTRY                             DCRPT020
00520 *                                                                 DCRPT020
00521      PERFORM 3000-SHOW-CHECK THRU 3900-SHOW-CHECK-XIT.            DCRPT020
00522      IF CHECK-SW EQUAL TO "A"                                     DCRPT020
00523          GO TO 1700-NO-SELECTS-EXIST.                             DCRPT020
00524      IF CHECK-SW EQUAL TO "B"                                     DCRPT020
00525          GO TO 1900-TEST-ALL-OUTPUT.                              DCRPT020
00526      IF CHECK-SW EQUAL TO "C"                                     DCRPT020
00527          GO TO 2000-TEST-NUMBERED-OUTPUT.                         DCRPT020
00528                                                                    DCRPT02
00529 **************************************************************    DCRPT020
00530 *    ROUTINE TO VALIDATE OUTPUT CATEGORY                          DCRPT020
00531 **************************************************************    DCRPT020
00532  3000-SHOW-CHECK.                                                 DCRPT020
00533      IF QRYTYPE-2 EQUAL TO "3" OR "4" OR "5" OR "6" OR "7"        DCRPT020
00534          GO TO 3200-VALIDATE-SPECIAL-NAMES ELSE                   DCRPT020
00535          GO TO 3900-SHOW-CHECK-XIT.                               DCRPT020
00536 *                                                                 DCRPT020
00537 *    CHECK FOR LEGAL SPECIAL NAMES OTHER THAN CATEGORIES          DCRPT020
00538 *        DATA--PROCEDURES--ENTRIES--ADMINISTRATION--PEOPLE--      DCRPT020
00539 *        CHARACTERISTICS--COMPONENTS-ALL                          DCRPT020
00540 *    ALSO VALID ARE THE COMMON CATEGORIES                         DCRPT020
00541 *                                                                 DCRPT020
00542  3200-VALIDATE-SPECIAL-NAMES.                                     DCRPT020
00543      IF QTBL-OUT-CAT GREATER THAN "994"                           DCRPT020
00544          GO TO 3900-SHOW-CHECK-XIT.                               DCRPT020
00545      IF QTBL-OUT-CAT EQUAL TO "010" OR "020" OR "030" OR "900"    DCRPT020
00546          GO TO 3900-SHOW-CHECK-XIT.                               DCRPT020
00547      IF QTBL-SEL1-ENTTYPE GREATER THAN "95"                       DCRPT020
00548          GO TO 3900-SHOW-CHECK-XIT.                               DCRPT020
00549 *                                                                 DCRPT020
00550 *    5350-RETRIEVE CATEGORY RECORD FROM CTL FILE                  DCRPT020
00551 *                                                                 DCRPT020
00552      MOVE 01 TO CAT.                                              DCRPT020
           MOVE 4 TO CON-KEY. 
00554      READ MAST3 INVALID KEY                                       DCRPT020
00555          MOVE "47" TO ERROR-CODE                                  DCRPT020
00556          GO TO 8500-SET-UP-ERROR.                                 DCRPT020
00557  3400-CAT-LOOP.                                                   DCRPT020
00558      IF CTL-CAT-ID (CAT) EQUAL TO QTBL-OUT-CAT                    DCRPT020
00559          GO TO 3500-MATCH-ENT-ID.                                 DCRPT020
00560      ADD 1 TO CAT.                                                DCRPT020
           IF CAT LESS THAN 36
00562          GO TO 3400-CAT-LOOP.                                     DCRPT020
00563      GO TO 3900-SHOW-CHECK-XIT.                                   DCRPT020
00564 *                                                                 DCRPT020
00565 *    HAVE CATEGORY-SEE IF VALID FOR ENTRY                         DCRPT020
00566 *                                                                 DCRPT020
00567  3500-MATCH-ENT-ID.                                               DCRPT020
00568      MOVE CTL-CATEGORY (CAT) TO CAT-LOC-HOLD.                     DCRPT020
00569      MOVE 01 TO CAT.                                              DCRPT020
00570  3600-CAT-ENT-LOOP.                                               DCRPT020
00571      IF QRYTYPE-2 EQUAL TO "7"                                       CL**2
00572          GO TO 3650-CK-TOTYPE.                                       CL**2
00573      IF CAT-ENTRY-HOLD (CAT) EQUAL TO QTBL-SEL1-ENTTYPE           DCRPT020
00574          GO TO 3900-SHOW-CHECK-XIT.                               DCRPT020
00575      GO TO 3700-CONTINUE-CAT-LOOP.                                   CL**2
00576  3650-CK-TOTYPE.                                                     CL**2
00577      IF CAT-ENTRY-HOLD (CAT) EQUAL TO QTBL-SEL2-TOTYPE               CL**2
00578          GO TO 3900-SHOW-CHECK-XIT.                                  CL**2
00579  3700-CONTINUE-CAT-LOOP.                                             CL**2
00580      ADD 1 TO CAT.                                                DCRPT020
           IF CAT LESS THAN 18
00582          GO TO 3600-CAT-ENT-LOOP.                                 DCRPT020
00583      MOVE "48" TO ERROR-CODE.                                     DCRPT020
00584      MOVE "X" TO EDIT-SW.                                            CL**2
00585      GO TO 8500-SET-UP-ERROR.                                     DCRPT020
00586  3900-SHOW-CHECK-XIT.                                             DCRPT020
00587      EXIT.                                                        DCRPT020
00588                                                                    DCRPT02
00589 ************************************************************      DCRPT020
00590 *                                                                 DCRPT020
00591 *    VALIDATION OF SELECT STATEMENTS START HERE                   DCRPT020
00592 *                                                                 DCRPT020
00593 ************************************************************      DCRPT020
00594  4000-VALIDATE-SELECTION.                                         DCRPT020
00595      IF QRYTYPE-23 EQUAL TO "01" OR "02" OR "03" OR "30"          DCRPT020
00596          OR "36" OR "90" OR "96"                                  DCRPT020
00597          GO TO 8000-END-VALIDATE.                                 DCRPT020
00598      IF QRYTYPE-23 EQUAL TO "16" OR "26" OR "46" OR "56"          DCRPT020
00599          GO TO 4400-CK-USE.                                       DCRPT020
00600 *********************************************                     DCRPT020
00601 *                                                                 DCRPT020
00602 *     PRELIMINARY EDITS                                           DCRPT020
00603 *        CHECK FOR CORRECT USAGE OF CLAUSES                       DCRPT020
00604 *                                                                 DCRPT020
00605 *************************************************                 DCRPT020
00606      IF QRYTYPE-23 EQUAL TO "35" OR "95"                          DCRPT020
00607          GO TO 5000-VALIDATE-FIELDS.                              DCRPT020
00608      IF QRYTYPE-23 LESS THAN "60"                                 DCRPT020
00609          GO TO 4400-CK-USE.                                       DCRPT020
00610 *                                                                 DCRPT020
00611 *    VALIDATE ENTITY USAGE RELATIONSHIPS (RANGE)                  DCRPT020
00612 *        CHECK USED-BY                                            DCRPT020
00613 *                                                                 DCRPT020
00614      IF QRYTYPE-2 NOT EQUAL TO "6"                                DCRPT020
00615          GO TO 4200-CK-70-SERIES.                                 DCRPT020
00616      IF QTBL-SEL1-ENTTYPE EQUAL TO "99" OR "97"                   DCRPT020
00617          GO TO 4050-NO-ELM-ALLOWED.                               DCRPT020
00618      IF QTBL-SEL1-ENTTYPE EQUAL TO "98"                           DCRPT020
00619          GO TO 4100-NO-DATA-ALLOWED.                              DCRPT020
00620      GO TO 4300-VAL-ENT-RANGE.                                    DCRPT020
00621  4050-NO-ELM-ALLOWED.                                             DCRPT020
           IF QTBL-SEL2-TOTYPE EQUAL TO "03"
00623          GO TO 4350-BAD-UNIT.                                     DCRPT020
00624      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00625  4100-NO-DATA-ALLOWED.                                            DCRPT020
00626      IF QTBL-SEL2-TOTYPE LESS THAN "35"                           DCRPT020
00627          GO TO 4350-BAD-UNIT.                                     DCRPT020
00628      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00629 *                                                                 DCRPT020
00630 *    CHECK WHICH-USE                                              DCRPT020
00631 *                                                                 DCRPT020
00632  4200-CK-70-SERIES.                                               DCRPT020
00633      IF QRYTYPE-2 NOT EQUAL TO "7"                                DCRPT020
00634          GO TO 4300-VAL-ENT-RANGE.                                DCRPT020
00635      IF QTBL-SEL2-TOTYPE EQUAL TO "99" OR "98"                    DCRPT020
00636          GO TO 4250-NO-USERS-ALLOWED.                             DCRPT020
00637      IF QTBL-SEL2-TOTYPE EQUAL TO "97"                            DCRPT020
00638          GO TO 4275-NO-PROC-ALLOWED.                              DCRPT020
00639      GO TO 4300-VAL-ENT-RANGE.                                    DCRPT020
00640  4250-NO-USERS-ALLOWED.                                           DCRPT020
00641      IF QTBL-SEL1-ENTTYPE EQUAL TO "65"                           DCRPT020
00642          GO TO 4350-BAD-UNIT.                                     DCRPT020
00643      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00644  4275-NO-PROC-ALLOWED.                                            DCRPT020
           IF QTBL-SEL1-ENTTYPE GREATER THAN "26" 
00646          GO TO 4350-BAD-UNIT.                                     DCRPT020
00647      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00648 *                                                                 DCRPT020
00649 *     VALIDATE ENTRY TYPE RANGES                                  DCRPT020
00650 *                                                                 DCRPT020
00651  4300-VAL-ENT-RANGE.                                              DCRPT020
00652      MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTRY-TYPE-1.                 DCRPT020
00653      MOVE QTBL-SEL2-TOTYPE TO HOLD-ENTRY-TYPE-2.                  DCRPT020
00654      PERFORM 9000-CK-ASCENDING THRU 9499-CK-ASCENDING-XIT.           CL**2
00655      IF EDIT-SW EQUAL TO "Y"                                      DCRPT020
00656          GO TO 5000-VALIDATE-FIELDS.                              DCRPT020
00657      IF QRYTYPE-23 GREATER THAN "79"                              DCRPT020
00658          MOVE "49" TO ERROR-CODE                                  DCRPT020
00659          GO TO 8600-SET-SELECT-ERROR.                             DCRPT020
00660  4350-BAD-UNIT.                                                   DCRPT020
00661      IF QRYTYPE-23 GREATER THAN "69"                              DCRPT020
00662          MOVE "51" TO ERROR-CODE ELSE                                CL**2
00663          MOVE "50" TO ERROR-CODE.                                    CL**2
00664      GO TO 8600-SET-SELECT-ERROR.                                    CL**2
00665 *                                                                 DCRPT020
00666 *     VALIDATE START NAME FOR USED-BY AND WHICH-USE               DCRPT020
00667 *                                                                 DCRPT020
00668  4400-CK-USE.                                                     DCRPT020
00669      MOVE QTBL-OPT-CNAME TO REL-ENTRY-NAME.                       DCRPT020
00670      MOVE SPACES TO REL-ENTRY-FUNCTION.                           DCRPT020
00671      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT020
00672      IF REL-RETURN-CODE NOT EQUAL TO "0"                          DCRPT020
00673          MOVE "52" TO ERROR-CODE                                  DCRPT020
00674          GO TO 8600-SET-SELECT-ERROR.                             DCRPT020
00675      MOVE REL-ENTRY-TYPE TO QTBL-OPT-ENTTYPE.                     DCRPT020
00676      IF QRYTYPE-23 EQUAL TO "04"                                  DCRPT020
00677          GO TO 8000-END-VALIDATE.                                 DCRPT020
00678      IF QRYTYPE-23 GREATER THAN "19"                              DCRPT020
00679          GO TO 4450-CK-VERSION.                                   DCRPT020
00680 *                                                                 DCRPT020
00681 *     VALIDATE THAT ALIAS USED WITH ELM, GROUP OR REC             DCRPT020
00682 *                                                                 DCRPT020
00683      IF QTBL-OPT-ENTTYPE LESS THAN "19"                              CL**2
00684          GO TO 5000-VALIDATE-FIELDS.                              DCRPT020
00685      MOVE "53" TO ERROR-CODE.                                     DCRPT020
00686      GO TO 8600-SET-SELECT-ERROR.                                 DCRPT020
00687 *                                                                 DCRPT020
00688 *     VALIDATE THAT VERSION USED WITH FILE OR PROC                DCRPT020
00689 *                                                                 DCRPT020
00690  4450-CK-VERSION.                                                 DCRPT020
00691      IF QRYTYPE-23 GREATER THAN "29"                              DCRPT020
00692          GO TO 4500-CK-WHICH.                                     DCRPT020
00693      IF QTBL-OPT-ENTTYPE LESS THAN "19"                              CL**2
00694          MOVE "54" TO ERROR-CODE                                  DCRPT020
00695          GO TO 8600-SET-SELECT-ERROR.                             DCRPT020
00696      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00697 *                                                                 DCRPT020
00698 *     VALIDATE RELATIONSHIP OF WHICH-USE ENTITIES                 DCRPT020
00699 *                                                                 DCRPT020
00700  4500-CK-WHICH.                                                   DCRPT020
00701      IF QRYTYPE-23 EQUAL TO "40" OR "45" OR "46"                  DCRPT020
00702          GO TO 4750-CK-USED-BY.                                   DCRPT020
00703      IF QTBL-SEL1-ENTTYPE EQUAL TO "99" OR "98"                   DCRPT020
00704          GO TO 4550-NO-USERS-ALLOWED-2.                           DCRPT020
00705      IF QTBL-SEL1-ENTTYPE EQUAL TO "97"                           DCRPT020
00706         GO TO 4600-NO-PROC-ALLOWED-2.                             DCRPT020
00707      GO TO 4650-NORM-WHICH.                                       DCRPT020
00708  4550-NO-USERS-ALLOWED-2.                                         DCRPT020
00709      IF QTBL-OPT-ENTTYPE EQUAL TO "65"                            DCRPT020
00710          GO TO 4700-BAD-WHICH.                                    DCRPT020
00711      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00712  4600-NO-PROC-ALLOWED-2.                                          DCRPT020
           IF QTBL-OPT-ENTTYPE GREATER THAN "26"
00714          GO TO 4700-BAD-WHICH.                                    DCRPT020
00715      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00716  4650-NORM-WHICH.                                                 DCRPT020
00717      MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTRY-TYPE-1.                  DCRPT020
00718      MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTRY-TYPE-2.                 DCRPT020
00719      PERFORM 9000-CK-ASCENDING THRU 9499-CK-ASCENDING-XIT.           CL**2
00720      IF EDIT-SW EQUAL TO "Y"                                      DCRPT020
00721          GO TO 5000-VALIDATE-FIELDS.                              DCRPT020
00722  4700-BAD-WHICH.                                                  DCRPT020
00723      MOVE "55" TO ERROR-CODE.                                     DCRPT020
00724      GO TO 8600-SET-SELECT-ERROR.                                 DCRPT020
00725 *                                                                 DCRPT020
00726 *     VALIDATE RELATIONSHIP OF USED-BY ENTITIES                   DCRPT020
00727 *                                                                 DCRPT020
00728  4750-CK-USED-BY.                                                 DCRPT020
00729      IF QTBL-SEL1-ENTTYPE EQUAL TO "99" OR "97"                   DCRPT020
00730          GO TO 4800-NO-ELM-ALLOWED-2.                             DCRPT020
00731      IF QTBL-SEL1-ENTTYPE EQUAL TO "98"                           DCRPT020
00732          GO TO 4850-NO-DATA-ALLOWED-2.                            DCRPT020
00733      GO TO 4900-NORM-UBY.                                         DCRPT020
00734  4800-NO-ELM-ALLOWED-2.                                           DCRPT020
           IF QTBL-OPT-ENTTYPE EQUAL TO "03"
00736          GO TO 4950-BAD-UBY.                                      DCRPT020
00737      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00738  4850-NO-DATA-ALLOWED-2.                                          DCRPT020
00739      IF QTBL-OPT-ENTTYPE LESS THAN "35"                           DCRPT020
00740          GO TO 4950-BAD-UBY.                                      DCRPT020
00741      GO TO 5000-VALIDATE-FIELDS.                                  DCRPT020
00742  4900-NORM-UBY.                                                   DCRPT020
00743      MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTRY-TYPE-1.                 DCRPT020
00744      MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTRY-TYPE-2.                  DCRPT020
00745      PERFORM 9000-CK-ASCENDING THRU 9499-CK-ASCENDING-XIT.           CL**2
00746      IF EDIT-SW EQUAL TO "Y"                                      DCRPT020
00747          GO TO 5000-VALIDATE-FIELDS.                              DCRPT020
00748  4950-BAD-UBY.                                                    DCRPT020
00749      MOVE "56" TO ERROR-CODE.                                     DCRPT020
00750      GO TO 8600-SET-SELECT-ERROR.                                 DCRPT020
00751 ************************************************                  DCRPT020
00752 *                                                                 DCRPT020
00753 *     EDIT FIELD NAMES AND VALUES OF WITH CLAUSE                  DCRPT020
00754 *                                                                 DCRPT020
00755 ************************************************                  DCRPT020
00756  5000-VALIDATE-FIELDS.                                            DCRPT020
00757      IF QRYTYPE-3 EQUAL TO "0" OR "6" OR "8"                      DCRPT020
00758          GO TO 8000-END-VALIDATE.                                 DCRPT020
00759      MOVE ALL "N" TO EDIT-WITH.                                   DCRPT020
00760 *                                                                 DCRPT020
00761 *    CHECK FOR RANGE QUERIES-ONLY CO MON FIELDS ALLOWED           DCRPT020
00762 *                                                                 DCRPT020
00763      IF QRYTYPE-23 EQUAL TO "85" OR "95"                          DCRPT020
00764          GO TO 5100-SET-SUPER ELSE                                DCRPT020
00765      GO TO 5150-INIT-UNIQUE-FLDS.                                 DCRPT020
00766  5100-SET-SUPER.                                                  DCRPT020
00767      MOVE "A" TO FIELD-TYPE.                                      DCRPT020
           MOVE "03" TO HOLD-ENTTYPE. 
00769      GO TO 5250-EDIT-FIELD-NAME.                                  DCRPT020
00770 *                                                                 DCRPT020
00771 *    INITIALIZE FOR ALL OTHERS-IF QUERY IS ON DATA                DCRPT020
00772 *        PROCEDURES OR ENTRIES ONLY COMMON FIELDS ALLOWED         DCRPT020
00773 *                                                                 DCRPT020
00774  5150-INIT-UNIQUE-FLDS.                                           DCRPT020
00775      MOVE "S" TO FIELD-TYPE.                                      DCRPT020
00776      IF QRYTYPE-23 EQUAL TO "15" OR "25"                          DCRPT020
00777          MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTTYPE                    DCRPT020
00778          GO TO 5200-CK-SUPER-ENT.                                 DCRPT020
00779      IF QRYTYPE-23 EQUAL TO "67" OR "70" OR "75" OR "77"             CL**2
00780          MOVE QTBL-SEL2-TOTYPE TO HOLD-ENTTYPE                    DCRPT020
00781      ELSE                                                         DCRPT020
00782          MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTTYPE.                  DCRPT020
00783 *                                                                 DCRPT020
00784  5200-CK-SUPER-ENT.                                               DCRPT020
00785      IF HOLD-ENTTYPE EQUAL TO "97" OR "98" OR "99"                DCRPT020
00786          GO TO 5100-SET-SUPER.                                    DCRPT020
00787 *                                                                 DCRPT020
00788 *    CONTROL VALIDATION OF WITH STATEMENTS                        DCRPT020
00789 *                                                                 DCRPT020
00790  5250-EDIT-FIELD-NAME.                                            DCRPT020
00791      IF HOLD-ENTTYPE EQUAL TO SPACES                              DCRPT020
00792          GO TO 8000-END-VALIDATE.                                 DCRPT020
00793  5300-SET-FIELDS.                                                 DCRPT020
00794      MOVE SPACES TO KW-TABLE.                                        CL**2
00795      IF QTBL-SEL1-ENTNO (1) EQUAL "KW"                               CL**2
00796          MOVE QTBL-SEL1-FLDNO (1) TO KW-HOLD1                        CL**2
00797          MOVE "KEYWORD " TO QTBL-SEL1-FLDNO (1).                     CL**2
00798      IF QTBL-SEL1-ENTNO (2) EQUAL "KW"                               CL**2
00799          MOVE QTBL-SEL1-FLDNO (2) TO KW-HOLD2                        CL**2
00800          MOVE "KEYWORD " TO QTBL-SEL1-FLDNO (2).                     CL**2
00801      IF QTBL-SEL1-ENTNO (3) EQUAL "KW"                               CL**2
00802          MOVE QTBL-SEL1-FLDNO (3) TO KW-HOLD3                        CL**2
00803          MOVE "KEYWORD " TO QTBL-SEL1-FLDNO (3).                     CL**2
00804      MOVE SPACES TO HOLD-FLDNAME.                                 DCRPT020
00805      MOVE QTBL-SEL1-FLDNO (1) TO HOLD-FLDNAME.                    DCRPT020
00806      MOVE 02 TO WITH-SUB.                                         DCRPT020
00807  5350-RETRIEVE-FLD.                                               DCRPT020
00808      PERFORM 6100-FIND-FLD THRU 6699-FIND-FLD-XIT.                DCRPT020
00809      IF EDIT-SW EQUAL TO "Y"                                      DCRPT020
00810          GO TO 5550-MATCH-FIELD-NAME.                             DCRPT020
00811 *                                                                 DCRPT020
00812 *    TEST FOR A COMMON FIELD                                      DCRPT020
00813 *                                                                 DCRPT020
00814      IF FIELD-TYPE EQUAL TO "A"                                   DCRPT020
00815          GO TO 5450-ERROR-08.                                     DCRPT020
00816      MOVE "A" TO FIELD-TYPE.                                      DCRPT020
           MOVE "03" TO HOLD-ENTTYPE. 
00818      PERFORM 6100-FIND-FLD THRU 6699-FIND-FLD-XIT.                DCRPT020
00819 *                                                                 DCRPT020
00820 *        RESET FOR SPECIFIC FIELD REQUEST                         DCRPT020
00821 *                                                                 DCRPT020
00822      MOVE "S" TO FIELD-TYPE.                                      DCRPT020
00823      IF QRYTYPE-23 EQUAL TO "15" OR "25"                          DCRPT020
00824          MOVE QTBL-OPT-ENTTYPE TO HOLD-ENTTYPE                    DCRPT020
00825          GO TO 5400-CK-ERROR-08.                                  DCRPT020
00826      IF QRYTYPE-23 EQUAL TO "67" OR "70" OR "75" OR "77"             CL**2
00827          MOVE QTBL-SEL2-TOTYPE TO HOLD-ENTTYPE                    DCRPT020
00828          ELSE                                                     DCRPT020
00829          MOVE QTBL-SEL1-ENTTYPE TO HOLD-ENTTYPE.                  DCRPT020
00830  5400-CK-ERROR-08.                                                DCRPT020
00831      IF EDIT-SW EQUAL TO "Y"                                      DCRPT020
00832          GO TO 5550-MATCH-FIELD-NAME.                             DCRPT020
00833  5450-ERROR-08.                                                   DCRPT020
00834      MOVE "31" TO ERROR-CODE.                                     DCRPT020
00835      GO TO 5950-FLD-ERROR.                                        DCRPT020
00836 *                                                                 DCRPT020
00837 *    RETURNS TO PROCESS AND/OR TESTS IF ANY                       DCRPT020
00838 *                                                                 DCRPT020
00839  5500-GET-NEXT-FLD.                                               DCRPT020
00840      IF WITH-SUB GREATER THAN 3                                   DCRPT020
00841          GO TO 6000-END-FIELD-SEARCH.                             DCRPT020
00842      IF QTBL-SEL1-FLDNO (WITH-SUB) EQUAL TO SPACES                DCRPT020
00843          GO TO 6000-END-FIELD-SEARCH.                             DCRPT020
00844      MOVE QTBL-SEL1-FLDNO (WITH-SUB) TO HOLD-FLDNAME.             DCRPT020
00845      ADD 1 TO WITH-SUB.                                           DCRPT020
00846      GO TO 5350-RETRIEVE-FLD.                                     DCRPT020
00847 *                                                                 DCRPT020
00848 *    SUBROUTINE TO FIND FIELD NAME IN CONTROL FILE                DCRPT020
00849 *                                                                 DCRPT020
00850  5550-MATCH-FIELD-NAME.                                           DCRPT020
00851      SUBTRACT 1 FROM WITH-SUB.                                    DCRPT020
00852      MOVE CTL-FLD-ENTRY-TYPE TO QTBL-SEL1-ENTNO (WITH-SUB).       DCRPT020
00853      MOVE CTL-FLD-CATEGORY TO QTBL-SEL1-CATNO (WITH-SUB).         DCRPT020
00854      MOVE CTL-FLD-ID (FLD) TO QTBL-SEL1-FNO (WITH-SUB).           DCRPT020
00855      MOVE QTBL-SEL1-FLDVALUE (WITH-SUB) TO HOLD-FLDVALUE.         DCRPT020
00856 *                                                                 DCRPT020
00857 *    DETERMINE FORMAT OF FIELD                                    DCRPT020
00858 *                                                                 DCRPT020
00859      IF CTL-FLD-FORMAT (FLD) EQUAL TO "N"                         DCRPT020
00860      GO TO 5700-BUILD-NUMERIC.                                    DCRPT020
00861 *                                                                 DCRPT020
00862 *     PROCESS ALPHANUMERIC VALUES                                 DCRPT020
00863 *                                                                 DCRPT020
00864      MOVE 02 TO SUB3.                                             DCRPT020
00865      MOVE 01 TO SUB4.                                             DCRPT020
00866      MOVE SPACES TO HOLD-VALUE.                                   DCRPT020
00867      IF H-FLD (1) NOT EQUAL TO QUOTE                              DCRPT020
00868      MOVE HOLD-FLDVALUE TO HOLD-VALUE                             DCRPT020
00869      GO TO 5565-STORE-VALUE.                                      DCRPT020
00870  5560-FLD-VALUE-LOOP.                                             DCRPT020
00871      MOVE H-FLD (SUB3) TO WORK-VALUE (SUB4).                      DCRPT020
00872      ADD 1 TO SUB3.                                               DCRPT020
00873      IF SUB3 GREATER THAN 50                                      DCRPT020
00874          MOVE "25" TO ERROR-CODE                                  DCRPT020
00875          GO TO 5950-FLD-ERROR.                                    DCRPT020
00876      ADD 1 TO SUB4.                                               DCRPT020
00877      IF H-FLD (SUB3) NOT EQUAL TO QUOTE                           DCRPT020
00878          GO TO 5560-FLD-VALUE-LOOP.                               DCRPT020
00879  5565-STORE-VALUE.                                                DCRPT020
00880      IF CTL-FLD-FORMAT (FLD) EQUAL TO "C"                         DCRPT020
00881          MOVE WORK-VALUE (1) TO H-FLD (1)                         DCRPT020
00882          MOVE SPACES TO HOLD-VALUE                                DCRPT020
00883          MOVE H-FLD (1) TO WORK-VALUE (1)                         DCRPT020
00884          GO TO 5650-MOVE-X-VALUE.                                 DCRPT020
00885      MOVE "50" TO SUB3.                                           DCRPT020
00886  5570-CHECK-LENGTH-LOOP.                                          DCRPT020
00887      IF WORK-VALUE (SUB3) NOT EQUAL TO SPACE                      DCRPT020
00888          GO TO 5600-CK-LENGTH.                                    DCRPT020
00889      SUBTRACT 1 FROM SUB3.                                        DCRPT020
00890      IF SUB3 EQUAL TO ZERO                                        DCRPT020
00891          GO TO 5650-MOVE-X-VALUE.                                 DCRPT020
00892      GO TO 5570-CHECK-LENGTH-LOOP.                                DCRPT020
00893  5600-CK-LENGTH.                                                  DCRPT020
00894      IF SUB3 GREATER THAN CTL-FLD-LENGTH (FLD)                    DCRPT020
00895          MOVE "57" TO ERROR-CODE                                  DCRPT020
00896          GO TO 5950-FLD-ERROR.                                    DCRPT020
00897  5650-MOVE-X-VALUE.                                               DCRPT020
00898      MOVE HOLD-VALUE TO QTBL-SEL1-FLDVALUE (WITH-SUB).            DCRPT020
00899      MOVE "Y" TO WITH-NO (WITH-SUB).                              DCRPT020
00900      ADD 1 TO WITH-SUB.                                           DCRPT020
00901      GO TO 5500-GET-NEXT-FLD.                                     DCRPT020
00902 *     PROCESS NUMERIC VALUES                                      DCRPT020
00903  5700-BUILD-NUMERIC.                                              DCRPT020
00904      MOVE CTL-FLD-LENGTH (FLD) TO SUB4.                           DCRPT020
00905      MOVE ALL "0" TO HOLD-VALUE.                                  DCRPT020
00906      MOVE 50 TO SUB3.                                             DCRPT020
00907  5750-NUM-LOOP.                                                   DCRPT020
00908      IF H-FLD (SUB3) NOT EQUAL TO SPACES                          DCRPT020
00909          GO TO 5800-NUM-FLD-LOOP.                                 DCRPT020
00910      SUBTRACT 1 FROM SUB3.                                        DCRPT020
00911      IF SUB3 GREATER THAN ZERO                                    DCRPT020
00912          GO TO 5750-NUM-LOOP.                                     DCRPT020
00913  5800-NUM-FLD-LOOP.                                               DCRPT020
00914      MOVE H-FLD (SUB3) TO WORK-VALUE (SUB4).                      DCRPT020
00915      SUBTRACT 1 FROM SUB3.                                        DCRPT020
00916      IF SUB3 LESS THAN 01                                         DCRPT020
00917          GO TO 5850-CK-NUMERIC.                                   DCRPT020
00918      SUBTRACT 1 FROM SUB4.                                        DCRPT020
00919      IF SUB4 LESS THAN 01                                         DCRPT020
00920          MOVE "57" TO ERROR-CODE                                  DCRPT020
00921          GO TO 5950-FLD-ERROR.                                    DCRPT020
00922      GO TO 5800-NUM-FLD-LOOP.                                     DCRPT020
00923 *                                                                 DCRPT020
00924 *     PROCESS NUMERIC VALUES                                      DCRPT020
00925 *                                                                 DCRPT020
00926  5850-CK-NUMERIC.                                                 DCRPT020
00927      IF HOLD-VALUE IS NOT NUMERIC                                 DCRPT020
00928          MOVE "58" TO ERROR-CODE                                  DCRPT020
00929          GO TO 5950-FLD-ERROR.                                    DCRPT020
00930      MOVE CTL-FLD-LENGTH (FLD) TO SUB4.                           DCRPT020
00931  5900-CLEAR-ZERO.                                                 DCRPT020
00932      ADD 1 TO SUB4.                                               DCRPT020
00933      MOVE SPACES TO WORK-VALUE (SUB4).                            DCRPT020
00934      IF SUB4 NOT GREATER THAN 50                                  DCRPT020
00935          GO TO 5900-CLEAR-ZERO.                                   DCRPT020
00936      MOVE HOLD-VALUE TO QTBL-SEL1-FLDVALUE (WITH-SUB).            DCRPT020
00937      MOVE "Y" TO WITH-NO (WITH-SUB).                              DCRPT020
00938      ADD 1 TO WITH-SUB.                                           DCRPT020
00939      GO TO 5500-GET-NEXT-FLD.                                     DCRPT020
00940  5950-FLD-ERROR.                                                  DCRPT020
00941      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
00942      MOVE "Y" TO FIELD-SW.                                           CL**2
00943      ADD 1 TO WITH-SUB.                                           DCRPT020
00944      GO TO 5500-GET-NEXT-FLD.                                     DCRPT020
00945  6000-END-FIELD-SEARCH.                                           DCRPT020
00946      IF WITH-NO (1) EQUAL TO "N"                                  DCRPT020
00947          MOVE "Y" TO FIELD-SW                                        CL**2
00948          MOVE "59" TO ERROR-CODE                                  DCRPT020
00949          PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.          DCRPT020
00950      IF QTBL-SEL1-FLDNO (2) EQUAL TO SPACES                       DCRPT020
00951          GO TO 6050-CK-FIELD-SW.                                     CL**2
00952      IF WITH-NO (2) EQUAL TO "N"                                  DCRPT020
00953          MOVE "Y" TO FIELD-SW                                        CL**2
00954          MOVE "60" TO ERROR-CODE                                  DCRPT020
00955          PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.          DCRPT020
00956      IF QTBL-SEL1-FLDNO (3) EQUAL TO SPACES                       DCRPT020
00957          GO TO 6050-CK-FIELD-SW.                                     CL**2
00958      IF WITH-NO (3) EQUAL TO "N"                                  DCRPT020
00959          MOVE "Y" TO FIELD-SW                                        CL**2
00960      MOVE "61" TO ERROR-CODE                                         CL**2
00961          PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.          DCRPT020
00962  6050-CK-FIELD-SW.                                                   CL**2
00963      IF FIELD-SW EQUAL TO "Y"                                        CL**2
00964          GO TO 8700-SELECT-ERROR.                                    CL**2
00965      IF KW-HOLD1 NOT EQUAL SPACES                                    CL**2
00966          MOVE KW-HOLD1 TO INPUT-KW                                   CL**2
00967          MOVE "59" TO HOLD-KW-ERROR                                  CL**2
00968          PERFORM 9500-CVTKW THRU 9599-CVTKW-XIT                      CL**2
00969          MOVE OUTPUT-KW TO QTBL-SEL1-FLDNO (1).                      CL**2
00970      IF KW-HOLD2 NOT EQUAL SPACES                                    CL**2
00971          MOVE KW-HOLD2 TO INPUT-KW                                   CL**2
00972          MOVE "60" TO HOLD-KW-ERROR                                  CL**2
00973          PERFORM 9500-CVTKW THRU 9599-CVTKW-XIT                      CL**2
00974          MOVE OUTPUT-KW TO QTBL-SEL1-FLDNO (2).                      CL**2
00975      IF KW-HOLD3 NOT EQUAL SPACES                                    CL**2
00976          MOVE KW-HOLD3 TO INPUT-KW                                   CL**2
00977          MOVE "61" TO HOLD-KW-ERROR                                  CL**2
00978          PERFORM 9500-CVTKW THRU 9599-CVTKW-XIT                      CL**2
00979          MOVE OUTPUT-KW TO QTBL-SEL1-FLDNO (3).                      CL**2
00980      GO TO 8000-END-VALIDATE.                                        CL**2
00981  6100-FIND-FLD.                                                   DCRPT020
00982      MOVE 01 TO FLD.                                              DCRPT020
00983      MOVE "N" TO EDIT-SW.                                         DCRPT020
00984      MOVE HOLD-ENTTYPE TO CON-ENTRY-TYPE.                         DCRPT020
00985      MOVE "E" TO CON-ENTRY-FUNCTION.                              DCRPT020
00986      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT020
00987      IF CON-RETURN-CODE NOT EQUAL TO ZERO                         DCRPT020
00988          GO TO 6699-FIND-FLD-XIT.                                 DCRPT020
00989  6100-FLD-LOOP.                                                   DCRPT020
00990      IF FLDNAME-BYTE4 NOT EQUAL TO SPACE                          DCRPT020
00991          GO TO 6200-CK-FULL-NAME.                                 DCRPT020
00992      IF FLDNAME-FIRST3 EQUAL TO CTL-FLD-NAME-3 (FLD)              DCRPT020
00993          GO TO 6500-POSSIBLE-MATCH.                               DCRPT020
00994      GO TO 6300-TRY-NEXT.                                         DCRPT020
00995  6200-CK-FULL-NAME.                                               DCRPT020
00996      IF HOLD-FLDNAME EQUAL TO CTL-FLD-NAME (FLD)                  DCRPT020
00997          GO TO 6500-POSSIBLE-MATCH.                               DCRPT020
00998  6300-TRY-NEXT.                                                   DCRPT020
00999      ADD 1 TO FLD.                                                DCRPT020
           IF FLD GREATER THAN 30 
01001          GO TO 6400-NEXT-FLD-RECORD.                              DCRPT020
01002      IF CTL-FLD-ID (FLD) NOT EQUAL TO SPACES                      DCRPT020
01003      GO TO 6100-FLD-LOOP.                                         DCRPT020
01004  6400-NEXT-FLD-RECORD.                                            DCRPT020
01005 *    GET ANOTHER RECORD                                           DCRPT020
01006      MOVE "N" TO CON-ENTRY-FUNCTION.                              DCRPT020
01007      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT020
01008      IF CON-RETURN-CODE EQUAL TO ZERO                             DCRPT020
01009          MOVE 1 TO FLD                                            DCRPT020
01010          GO TO 6100-FLD-LOOP.                                     DCRPT020
01011      GO TO 6699-FIND-FLD-XIT.                                     DCRPT020
01012 *                                                                 DCRPT020
01013 *    HAVE MATCH ON NAME-IF COMMON FIELD QUERY                     DCRPT020
01014 *              VALIDATE CATEGORY                                  DCRPT020
01015  6500-POSSIBLE-MATCH.                                             DCRPT020
01016      IF FIELD-TYPE EQUAL TO "S"                                   DCRPT020
01017          MOVE "Y" TO EDIT-SW                                      DCRPT020
01018          GO TO 6699-FIND-FLD-XIT.                                 DCRPT020
01019      IF CTL-FLD-CATEGORY EQUAL TO "010" OR "020" OR "030"         DCRPT020
01020              OR "900"                                             DCRPT020
01021          MOVE "Y" TO EDIT-SW.                                     DCRPT020
01022  6699-FIND-FLD-XIT.                                               DCRPT020
01023      EXIT.                                                        DCRPT020
01024                                                                    DCRPT02
01025 ***************************************************               DCRPT020
01026 *                                                                 DCRPT020
01027 *    TEST FOR ERROR MESSAGES CARRIED OVER FROM PREVIOUS EDITS     DCRPT020
01028 *                                                                 DCRPT020
01029 ***************************************************               DCRPT020
01030  7000-TEST-FOR-ERRORS.                                            DCRPT020
01031      IF ERROR-COUNT EQUAL TO ZERO                                 DCRPT020
01032          MOVE ZERO TO SUB4                                        DCRPT020
01033          GO TO 7100-CHECK-SELECT-ERRORS.                          DCRPT020
01034      MOVE ZERO TO SUB4.                                              CL**2
01035      PERFORM 8900-PRINT-REQUEST THRU 8999-PRINT-REQUEST-XIT.      DCRPT020
01036      MOVE ZERO TO ERROR-COUNT.                                    DCRPT020
01037      MOVE ZERO TO SUB4.                                           DCRPT020
01038 *                                                                 DCRPT020
01039 *    PROCESS SELECT ERROR MESSAGES IF ANY                         DCRPT020
01040 *                                                                 DCRPT020
01041  7100-CHECK-SELECT-ERRORS.                                        DCRPT020
01042      IF ERROR-SELECT EQUAL TO SPACES                              DCRPT020
01043          GO TO 7400-TEST-OUTPUT-ERRORS.                           DCRPT020
01044 *                                                                 DCRPT020
01045 *    FOUND SELECT ERRORS                                          DCRPT020
01046 *                                                                 DCRPT020
01047  7200-SEL-ERROR-EXIST.                                            DCRPT020
01048      ADD 1 TO SUB4.                                               DCRPT020
01049      IF SUB4 GREATER THAN 10                                      DCRPT020
01050          GO TO 7300-CHECK-OUTPUT-ERRORS.                          DCRPT020
01051      IF SEL-ERR (SUB4) EQUAL TO SPACES                            DCRPT020
01052          GO TO 7200-SEL-ERROR-EXIST.                              DCRPT020
01053      MOVE SEL-ERR (SUB4) TO ERROR-CODE.                           DCRPT020
01054      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
01055      ADD 1 TO SUBA.                                               DCRPT020
01056      MOVE SUB4 TO HOLD-SELECT (SUBA).                             DCRPT020
01057      MOVE "26" TO ERROR-CODE.                                     DCRPT020
01058      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
01059      GO TO 7200-SEL-ERROR-EXIST.                                  DCRPT020
01060 *                                                                 DCRPT020
01061 *    IF SELECT ERRORS FOUND PROCESSING STARTS HERE                DCRPT020
01062 *                                                                 DCRPT020
01063  7300-CHECK-OUTPUT-ERRORS.                                        DCRPT020
01064      IF ERROR-SELECT EQUAL TO SPACES                              DCRPT020
01065          MOVE ZERO TO SUB4                                        DCRPT020
01066          GO TO 7400-TEST-OUTPUT-ERRORS.                           DCRPT020
01067      PERFORM 8900-PRINT-REQUEST THRU 8999-PRINT-REQUEST-XIT.      DCRPT020
01068      MOVE ZERO TO ERROR-COUNT.                                    DCRPT020
01069      MOVE ZERO TO SUB4.                                           DCRPT020
01070      MOVE ZERO TO SUBA.                                           DCRPT020
01071 *                                                                 DCRPT020
01072 *    TEST FOR ERROR MESSAGES FOUND IN OUTPUT CARDS                DCRPT020
01073 *                                                                 DCRPT020
01074  7400-TEST-OUTPUT-ERRORS.                                         DCRPT020
01075      IF ERROR-OUTPUT EQUAL TO SPACES                              DCRPT020
01076          GO TO 8000-END-VALIDATE.                                 DCRPT020
01077      ADD 1 TO SUB4.                                               DCRPT020
01078      IF SUB4 GREATER THAN 9                                       DCRPT020
01079          GO TO 8000-END-VALIDATE.                                 DCRPT020
01080      IF OUTPUT-ERRORS (SUB4) EQUAL TO SPACES                      DCRPT020
01081          GO TO 7400-TEST-OUTPUT-ERRORS.                           DCRPT020
01082      MOVE OUTPUT-ERRORS (SUB4) TO ERROR-CODE.                     DCRPT020
01083      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
01084      ADD 1 TO SUBA.                                               DCRPT020
01085      MOVE SUB4 TO HOLD-SELECT (SUBA).                             DCRPT020
01086      MOVE "43" TO ERROR-CODE.                                     DCRPT020
01087      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
01088      GO TO 7400-TEST-OUTPUT-ERRORS.                               DCRPT020
01089 *************************************************                 DCRPT020
01090 *                                                                 DCRPT020
01091 *     END EDIT03 PROCESSING                                       DCRPT020
01092 *                                                                 DCRPT020
01093 ************************************************                  DCRPT020
01094  8000-END-VALIDATE.                                               DCRPT020
01095      IF CHECK-SW NOT EQUAL TO "A"                                 DCRPT020
01096          GO TO 8200-RETURN-QTBL.                                  DCRPT020
01097      IF ERROR-COUNT EQUAL TO ZERO                                 DCRPT020
01098          GO TO 8100-END-PROCESSING.                               DCRPT020
01099      MOVE "Y" TO ERROR-CHECK.                                     DCRPT020
01100      PERFORM 8900-PRINT-REQUEST THRU 8999-PRINT-REQUEST-XIT.      DCRPT020
01101      MOVE ZERO TO ERROR-COUNT.                                       CL**2
01102  8100-END-PROCESSING.                                             DCRPT020
01103      IF EDIT-SW EQUAL TO "X"                                         CL**2
01104          MOVE SPACES TO EDIT-SW                                      CL**2
01105          GO TO 8150-END-OF-JOB.                                      CL**2
01106      IF RTBL-HDR-IDXFNAME NOT EQUAL SPACES                           CL**2
01107          MOVE "X" TO EDIT-SW                                         CL**2
01108          PERFORM 8400-CHECK-BY THRU 8499-CHECK-BY-XIT.               CL**2
01109      IF RTBL-HDR-STARTCNAME EQUAL TO SPACES                          CL**2
01110          MOVE SPACES TO EDIT-SW                                      CL**2
01111          GO TO 8150-END-OF-JOB.                                      CL**2
01112      IF RTBL-HDR-REQTYPE EQUAL TO "RS" OR "RT" OR "RV" OR "RW"       CL**2
01113              OR "RC" OR "RH" OR "RJ"                                 CL**2
01114          MOVE "X" TO EDIT-SW                                         CL**2
01115          PERFORM 8300-TEST-HIGH THRU 8399-TEST-HIGH-XIT.             CL**2
01116  8150-END-OF-JOB.                                                    CL**2
01117      IF ERROR-CHECK EQUAL TO "N" OR SPACES                        DCRPT020
01118          MOVE "*** REPORT REQUEST COMPLETE ***" TO STD-REPORT-REC DCRPT020
01119          MOVE 2 TO PRT-CTL                                        DCRPT020
01120          OPEN OUTPUT SYSPRINT                                     DCRPT020
01121          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCRPT020
01122          PERFORM EOP-RT THRU EOP-RT-XIT                              CL**2
01123          CLOSE SYSPRINT.                                          DCRPT020
01124      PERFORM CON-CLOSE THRU CON-CLOSE-XIT.                        DCRPT020
01125      PERFORM REL-CLOSE THRU REL-CLOSE-XIT.                        DCRPT020
           EXIT PROGRAM.
01127 *                                                                 DCRPT020
01128 *    MOVE QTBL BACK TO RTBL WITH CORRECT CHANGES                  DCRPT020
01129 *                                                                 DCRPT020
01130  8200-RETURN-QTBL.                                                DCRPT020
01131      MOVE QTBL-OPT-QRYTYPE TO RTBL-SEL1-QRYTYPE (SELA).           DCRPT020
01132      MOVE QTBL-OPT-CNAME TO RTBL-OPT-CNAME (SELA).                DCRPT020
01133      MOVE QTBL-OPT-ENTTYPE TO RTBL-OPT-ENTTYPE (SELA).            DCRPT020
01134      MOVE QTBL-OPT-CAT TO RTBL-OPT-CAT (SELA).                    DCRPT020
01135      MOVE QTBL-SELECT1-ENT TO RTBL-SELECT1-ENT (SELA).            DCRPT020
01136      MOVE QTBL-SEL2-TOTYPE TO RTBL-SEL2-TOTYPE (SELA).            DCRPT020
01137      MOVE QTBL-SEL2-TOCNAME TO RTBL-SEL2-TOCNAME (SELA).          DCRPT020
01138      MOVE SPACES TO CHECK-SW.                                     DCRPT020
01139      GO TO 1000-TEST-NEXT-SELECT.                                 DCRPT020
01140 ************************************************                  DCRPT020
01141 ************************************************                  DCRPT020
01142 *     SUBROUTINES                                                 DCRPT020
01143 *                                                                 DCRPT020
01144 ************************************************                  DCRPT020
01145 ***********************************************                   DCRPT020
01146 *                                                                    CL**2
01147 *    TEST IF A HIERARCHY REPORT IS TO BE MADE ON ELEMENTS            CL**2
01148 *        OR IF A USAGE REPORT IS TO BE MADE ON USERS                 CL**2
01149 *        IF ATTEMPT IS MADE THERE IS AN ERROR                        CL**2
01150 *                                                                    CL**2
01151  8300-TEST-HIGH.                                                     CL**2
01152      MOVE RTBL-HDR-STARTCNAME TO REL-ENTRY-NAME.                     CL**2
01153      MOVE SPACES TO REL-ENTRY-FUNCTION.                              CL**2
01154      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
01155      IF REL-RETURN-CODE NOT EQUAL TO "0"                             CL**2
01156          MOVE "52" TO ERROR-CODE                                     CL**2
01157          GO TO 8375-RANGE-ERROR.                                     CL**2
01158      MOVE REL-ENTRY-TYPE TO RTBL-HDR-ENTTYPE.                        CL**2
           IF REL-ENTRY-TYPE EQUAL TO "03"
01160          GO TO 8325-TEST-HIERARCHY.                                  CL**2
01161      IF REL-ENTRY-TYPE EQUAL TO "65"                                 CL**2
01162          GO TO 8350-TEST-USAGE.                                      CL**2
01163      GO TO 8399-TEST-HIGH-XIT.                                       CL**2
01164  8325-TEST-HIERARCHY.                                                CL**2
01165      IF RTBL-HDR-REQTYPE EQUAL TO "RT" OR "RW"                       CL**2
01166          MOVE "50" TO ERROR-CODE                                     CL**2
01167          GO TO 8375-RANGE-ERROR.                                     CL**2
01168      IF RTBL-HDR-REQTYPE EQUAL "RC" OR "RH" OR "RJ"                  CL**2
01169          GO TO 8330-TH-2.                                            CL**2
01170      GO TO 8399-TEST-HIGH-XIT.                                       CL**2
01171  8330-TH-2.                                                          CL**2
01172      IF RTBL-HDR-RETRIEVE EQUAL SPACE                                CL**2
01173          MOVE "50" TO ERROR-CODE                                     CL**2
01174          GO TO 8375-RANGE-ERROR.                                     CL**2
01175      GO TO 8399-TEST-HIGH-XIT.                                       CL**2
01176  8350-TEST-USAGE.                                                    CL**2
01177      IF RTBL-HDR-REQTYPE EQUAL TO "RS" OR "RV"                       CL**2
01178          MOVE "51" TO ERROR-CODE                                     CL**2
01179          GO TO 8375-RANGE-ERROR.                                     CL**2
01180      IF RTBL-HDR-REQTYPE EQUAL "RC" OR "RH" OR "RJ"                  CL**2
01181          GO TO 8360-TU-2.                                            CL**2
01182      GO TO 8399-TEST-HIGH-XIT.                                       CL**2
01183  8360-TU-2.                                                          CL**2
01184      IF RTBL-HDR-RETRIEVE EQUAL "U"                                  CL**2
01185          MOVE "51" TO ERROR-CODE                                     CL**2
01186          GO TO 8375-RANGE-ERROR.                                     CL**2
01187      GO TO 8399-TEST-HIGH-XIT.                                       CL**2
01188  8375-RANGE-ERROR.                                                   CL**2
01189      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.                 CL**2
01190      GO TO 8000-END-VALIDATE.                                        CL**2
01191  8399-TEST-HIGH-XIT.                                                 CL**2
01192      EXIT.                                                           CL**2
01193                                                                    DCRPT02
01194 *                                                                    CL**2
01195 *    VALIDATE THAT BY FIELD NAME IN $REPORT IS VALID                 CL**2
01196 *                                                                    CL**2
01197  8400-CHECK-BY.                                                      CL**2
01198      MOVE "F" TO CON-ENTRY-FUNCTION.                                 CL**2
01199      PERFORM CON-READ THRU CON-READ-XIT.                             CL**2
01200  8410-1ST-FLD.                                                       CL**2
01201      MOVE 1 TO LCSUB.                                                CL**2
01202  8420-MATCH-FLD.                                                     CL**2
01203      IF RTBL-HDR-IDXFNAME EQUAL CTL-FLD-NAME (LCSUB)                 CL**2
01204          GO TO 8499-CHECK-BY-XIT.                                    CL**2
01205  8430-NEXT-FLD.                                                      CL**2
01206      ADD 1 TO LCSUB.                                                 CL**2
01207      IF CTL-FLD-NAME (LCSUB) EQUAL SPACES                            CL**2
01208          GO TO 8440-NEXT-MAST3.                                      CL**2
           IF LCSUB GREATER THAN 30 
01210          GO TO 8440-NEXT-MAST3.                                      CL**2
01211      GO TO 8420-MATCH-FLD.                                           CL**2
01212  8440-NEXT-MAST3.                                                    CL**2
01213      MOVE "N" TO CON-ENTRY-FUNCTION.                                 CL**2
01214      PERFORM CON-READ THRU CON-READ-XIT.                             CL**2
01215      IF CON-RETURN-CODE NOT EQUAL "3"                                CL**2
01216          GO TO 8410-1ST-FLD.                                         CL**2
01217      MOVE "12" TO ERROR-CODE.                                        CL**2
01218      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.                 CL**2
01219      GO TO 8000-END-VALIDATE.                                        CL**2
01220  8499-CHECK-BY-XIT.                                                  CL**2
01221      EXIT.                                                           CL**2
01222                                                                    DCRPT02
01223 *                                                                 DCRPT020
01224 *    STACK ERRORS FROM OUTPUT STATEMENTS IN TABLE                 DCRPT020
01225 *                                                                 DCRPT020
01226  8500-SET-UP-ERROR.                                               DCRPT020
01227      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
01228      ADD 1 TO SUBA.                                               DCRPT020
01229      MOVE OUTA TO HOLD-SELECT (SUBA).                             DCRPT020
01230      MOVE "43" TO ERROR-CODE.                                     DCRPT020
01231      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
01232      IF EDIT-SW NOT EQUAL TO "X"                                     CL**2
01233          GO TO 8000-END-VALIDATE.                                    CL**2
01234      MOVE SPACES TO EDIT-SW.                                         CL**2
01235      IF CHECK-SW EQUAL TO "A"                                        CL**2
01236          GO TO 8000-END-VALIDATE.                                    CL**2
01237      ADD 1 TO SUB6.                                                  CL**2
01238      MOVE SELA TO HOLD-SELECT-A (SUB6).                              CL**2
01239      MOVE "64" TO ERROR-CODE.                                        CL**2
01240      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.                 CL**2
01241      GO TO 8000-END-VALIDATE.                                     DCRPT020
01242 *                                                                 DCRPT020
01243 *    STACK ERRORS FROM SELECTS IN ERROR TABLE                     DCRPT020
01244 *                                                                 DCRPT020
01245  8600-SET-SELECT-ERROR.                                           DCRPT020
01246      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
01247  8700-SELECT-ERROR.                                                  CL**2
01248      IF FIELD-SW EQUAL TO "Y"                                        CL**2
01249          MOVE "N" TO FIELD-SW.                                       CL**2
01250      ADD 1 TO SUBA.                                               DCRPT020
01251      MOVE SELA TO HOLD-SELECT (SUBA).                             DCRPT020
01252      MOVE "26" TO ERROR-CODE.                                     DCRPT020
01253      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.              DCRPT020
01254      GO TO 1000-TEST-NEXT-SELECT.                                 DCRPT020
01255 ***************************************************************   DCRPT020
01256 *    STACK ERROR IN TABLE- ERROR IS ERROR-CODE                    DCRPT020
01257 ****************************************************************  DCRPT020
01258  8888-ERROR-RTN.                                                  DCRPT020
01259      ADD 1 TO ERROR-COUNT.                                        DCRPT020
01260      MOVE "Y" TO ERROR-CHECK.                                        CL**2
01261      IF ERROR-COUNT GREATER THAN 20                               DCRPT020
01262          GO TO 8899-ERROR-RTN-XIT.                                DCRPT020
01263      MOVE ERROR-CODE TO ERROR-BUILD (ERROR-COUNT).                DCRPT020
01264  8899-ERROR-RTN-XIT.                                              DCRPT020
01265      EXIT.                                                        DCRPT020
01266 ******************************************************            DCRPT020
01267 *                                                                 DCRPT020
01268 *      PRINT USER REQUEST AND ERROR MESSAGES                      DCRPT020
01269 *                                                                 DCRPT020
01270 *******************************************************           DCRPT020
01271  8900-PRINT-REQUEST.                                              DCRPT020
01272      OPEN OUTPUT SYSPRINT.                                        DCRPT020
01273      MOVE SPACES TO PRINT-LINE.                                   DCRPT020
01274      MOVE SPACES TO STD-REPORT-REC.                               DCRPT020
01275 *                                                                 DCRPT020
01276 *      PRINT ERROR MESSAGES IF ANY                                DCRPT020
01277 *                                                                 DCRPT020
01278      IF ERROR-COUNT EQUAL TO ZEROES                               DCRPT020
01279          GO TO 8975-DONE-PRINT-REQ.                               DCRPT020
01280      MOVE ZERO TO SUBA, SUB6.                                        CL**2
01281      MOVE 01 TO SUB3.                                             DCRPT020
01282  8925-PRINT-ERROR-LOOP.                                           DCRPT020
01283      MOVE ERROR-BUILD (SUB3) TO SUB5.                             DCRPT020
01284      MOVE ERROR-NUMBER (SUB5) TO PRINT-MESSAGE-NUMBER.            DCRPT020
01285 *                                                                 DCRPT020
01286 *    SPECIAL ERROR MESSAGES WHICH USE CALCULATED LITERALS         DCRPT020
01287 *        OR NUMBERS TO FORM THE COMPLETE MESSAGE                  DCRPT020
01288 *                                                                 DCRPT020
01289      IF SUB5 EQUAL TO 11                                          DCRPT020
01290          ADD 1 TO SUB4                                            DCRPT020
01291          MOVE SYNTAX-WORD (SUB4) TO FILE-1                        DCRPT020
01292          GO TO 8950-MESSAGE-SKIP.                                 DCRPT020
01293      IF SUB5 EQUAL TO 18                                          DCRPT020
01294          ADD 1 TO SUB4                                            DCRPT020
01295          MOVE SYNTAX-WORD (SUB4) TO FILE-C                        DCRPT020
01296          GO TO 8950-MESSAGE-SKIP.                                 DCRPT020
01297      IF SUB5 EQUAL TO 20                                          DCRPT020
01298          ADD 1 TO SUB4                                            DCRPT020
01299          MOVE SYNTAX-WORD (SUB4) TO OPT-NAME-A                    DCRPT020
01300          GO TO 8950-MESSAGE-SKIP.                                 DCRPT020
01301      IF SUB5 EQUAL TO 27                                          DCRPT020
01302          ADD 1 TO SUB4                                            DCRPT020
01303          MOVE SYNTAX-WORD (SUB4) TO OPT-NAME-B                    DCRPT020
01304          GO TO 8950-MESSAGE-SKIP.                                 DCRPT020
01305      IF SUB5 EQUAL TO 28                                          DCRPT020
01306          ADD 1 TO SUB4                                            DCRPT020
01307          MOVE SYNTAX-WORD (SUB4) TO NUM-RECORD                       CL**2
01308          GO TO 8950-MESSAGE-SKIP.                                 DCRPT020
01309      IF SUB5 EQUAL TO 26                                          DCRPT020
01310          ADD 1 TO SUBA                                            DCRPT020
01311          MOVE HOLD-SELECT (SUBA) TO SEL-ERROR                        CL**2
01312          GO TO 8960-E-SKIP.                                          CL**2
01313      IF SUB5 EQUAL TO 43                                          DCRPT020
01314          ADD 1 TO SUBA                                            DCRPT020
01315          MOVE HOLD-SELECT (SUBA) TO OUT-ERR                          CL**2
01316          GO TO 8960-E-SKIP.                                          CL**2
01317      IF SUB5 EQUAL TO 64                                             CL**2
01318          ADD 1 TO SUB6                                               CL**2
01319          MOVE HOLD-SELECT-A (SUB6) TO SELECT-NUMBER                  CL**2
01320          GO TO 8960-E-SKIP.                                          CL**2
01321  8950-MESSAGE-SKIP.                                               DCRPT020
01322      MOVE LITERAL-E TO PRINT-ERROR-LITERAL.                       DCRPT020
01323  8960-E-SKIP.                                                        CL**2
01324      MOVE ERROR-MESSAGE (SUB5) TO PRINT-ERROR-MESSAGE.            DCRPT020
01325      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT020
01326      ADD 1 TO SUB3.                                               DCRPT020
01327      IF SUB3 NOT GREATER THAN ERROR-COUNT                         DCRPT020
01328          GO TO 8925-PRINT-ERROR-LOOP.                             DCRPT020
01329  8975-DONE-PRINT-REQ.                                             DCRPT020
01330      CLOSE SYSPRINT.                                              DCRPT020
01331  8999-PRINT-REQUEST-XIT.                                          DCRPT020
01332      EXIT.                                                        DCRPT020
01333                                                                    DCRPT02
01334 ******************************************************************DCRPT020
01335 *                                                                 DCRPT020
01336 *    CHECK ASCENDING ENTRY TYPES                                  DCRPT020
01337 *                                                                 DCRPT020
01338 ********************************************************          DCRPT020
01339  9000-CK-ASCENDING.                                               DCRPT020
01340      MOVE "Y" TO EDIT-SW.                                         DCRPT020
01341      IF HOLD-ENTRY-TYPE-2 EQUAL TO HOLD-ENTRY-TYPE-1              DCRPT020
01342          GO TO 9300-CHECK-EQUAL-USAGE.                            DCRPT020
           IF HOLD-ENTRY-TYPE-2 GREATER THAN HOLD-ENTRY-TYPE-1
01344          GO TO 9499-CK-ASCENDING-XIT.                                CL**2
01345      IF HOLD-ENTRY-TYPE-1 EQUAL TO "35" OR "40" OR "45"           DCRPT020
01346          GO TO 9100-CK-REPORT.                                    DCRPT020
01347      IF HOLD-ENTRY-TYPE-1 EQUAL TO "50" OR "55"                   DCRPT020
01348          GO TO 9200-CK-PROGRAM.                                   DCRPT020
01349      GO TO 9400-NOT-ASCENDING.                                    DCRPT020
01350  9100-CK-REPORT.                                                  DCRPT020
01351      IF HOLD-ENTRY-TYPE-2 EQUAL TO "35" OR "40" OR "45"           DCRPT020
01352          GO TO 9499-CK-ASCENDING-XIT.                                CL**2
01353      GO TO 9400-NOT-ASCENDING.                                    DCRPT020
01354  9200-CK-PROGRAM.                                                 DCRPT020
01355      IF HOLD-ENTRY-TYPE-2 EQUAL TO "50" OR "55"                   DCRPT020
01356          GO TO 9499-CK-ASCENDING-XIT.                                CL**2
01357      GO TO 9400-NOT-ASCENDING.                                    DCRPT020
01358 *                                                                 DCRPT020
01359 *    USED-BY AND WHICH-USE EQUALITY TEST                          DCRPT020
01360 *                                                                 DCRPT020
01361  9300-CHECK-EQUAL-USAGE.                                          DCRPT020
01362      IF QRYTYPE-2 EQUAL TO "4" OR "5" OR "6" OR "7"               DCRPT020
01363          NEXT SENTENCE ELSE                                       DCRPT020
01364          GO TO 9400-NOT-ASCENDING.                                DCRPT020
01365      IF HOLD-ENTRY-TYPE-2 EQUAL TO "09" OR "10"                      CL**2
01366          OR "50" OR "55" OR "60"                                     CL**2
01367          GO TO 9499-CK-ASCENDING-XIT.                                CL**2
01368 *                                                                 DCRPT020
01369 *    NOT GREATER THAN OR EQUAL                                   *DCRPT020
01370 *                                                                 DCRPT020
01371  9400-NOT-ASCENDING.                                              DCRPT020
01372      MOVE "N" TO EDIT-SW.                                         DCRPT020
01373  9499-CK-ASCENDING-XIT.                                              CL**2
01374      EXIT.                                                           CL**2
01375                                                                    DCRPT02
01376 **************************************************                   CL**2
01377 *    CONVERT KW FIELD NAMES                                          CL**2
01378 *       .VALIDATES THAT KW IS FOLLOWED BY NUMBER FROM 1 TO 99999     CL**2
01379 *       .CONVERTS KW1 TO KW00001                                     CL**2
01380 *       .CONVERTS KW  TO KW00000                                     CL**2
01381 *       .INPUT IN INPUT-KW                                           CL**2
01382 *       .OUTPUT IN OUTPUT-KW                                         CL**2
01383 *                                                                    CL**2
01384 *****************************************************                CL**2
01385  9500-CVTKW.                                                         CL**2
01386      MOVE ZEROES TO OUTPUT-KW.                                       CL**2
01387      MOVE 7 TO KSUB1.                                                CL**2
01388      MOVE 7 TO KSUB2.                                                CL**2
01389  9505-GET-BYTE.                                                      CL**2
01390      IF INPUT-KW-BYTE (KSUB1) EQUAL SPACES                           CL**2
01391          SUBTRACT 1 FROM KSUB1                                       CL**2
01392          GO TO  9505-GET-BYTE.                                       CL**2
01393      IF INPUT-KW-BYTE (KSUB1) EQUAL "W"                              CL**2
01394          GO TO 9510-CK-NUM.                                          CL**2
01395      MOVE INPUT-KW-BYTE (KSUB1) TO OUTPUT-KW-BYTE (KSUB2).           CL**2
01396      SUBTRACT 1 FROM KSUB2.                                          CL**2
01397      SUBTRACT 1 FROM KSUB1.                                          CL**2
01398      GO TO 9505-GET-BYTE.                                            CL**2
01399  9510-CK-NUM.                                                        CL**2
01400      IF OUTPUT-KW NUMERIC                                            CL**2
01401          MOVE "K" TO OUTPUT-KW-BYTE (1)                              CL**2
01402          MOVE "W" TO OUTPUT-KW-BYTE (2)                              CL**2
01403          GO TO  9599-CVTKW-XIT.                                      CL**2
01404      MOVE "31" TO ERROR-CODE.                                        CL**2
01405      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.                 CL**2
01406      MOVE HOLD-KW-ERROR TO ERROR-CODE.                               CL**2
01407      PERFORM 8888-ERROR-RTN THRU 8899-ERROR-RTN-XIT.                 CL**2
01408  9599-CVTKW-XIT.                                                     CL**2
01409      EXIT.                                                           CL**2
*CALL     DISPLAYLN                                                     DCRPT020
01411  USER-ROUTINE.                                                       CL**2
01412      GO TO USER-ROUTINE-XIT.                                         CL**2
01413  USER-ROUTINE-XIT.                                                   CL**2
01414      EXIT.                                                           CL**2
*CALL     WRITELN                                                       DCRPT020
*CALL     RELALG                                                        DCRPT020
*CALL     RELCOM                                                        DCRPT020
*CALL     MAST3IO1                                                      DCRPT020
