*DECK     DCRPT010
00001  IDENTIFICATION DIVISION.                                         10/03/78
       PROGRAM-ID.   RPT010.
*CALL COPYRIGHT 
      *    VALIDATE REPORT STATEMENT
      *    BUILD REPORT TABLE 
      *    TABLE REPORT ERRORS
00010  ENVIRONMENT DIVISION.                                            DCRPT010
00011  CONFIGURATION SECTION.                                           DCRPT010
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00014  INPUT-OUTPUT SECTION.                                            DCRPT010
00015  FILE-CONTROL.                                                    DCRPT010
           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".
00022  DATA DIVISION.                                                   DCRPT010
00023  FILE SECTION.                                                    DCRPT010
*CALL     MAST2FD                                                       DCRPT010
*CALL     MAST3FD                                                       DCRPT010
*CALL RETSCS
00026                                                                    DCRPT01
*CALL     WRKSTG77                                                      DCRPT010
00028  77  ERROR-CODE                  PICTURE XX.                      DCRPT010
00029  77  RPT-SUB                     PICTURE S99 COMP SYNC.              CL**2
*CALL     MAST1WS                                                       DCRPT010
*CALL     WRKSTG01                                                      DCRPT010
*CALL     MAST3DD1                                                      DCRPT010
00033                                                                    DCRPT01
00034  01  WORK-STORE.                                                  DCRPT010
00035 ******************************************************************DCRPT010
00036 *    COUNTERS PLACE HOLDERS EXTRACTION TABS                       DCRPT010
00037 ******************************************************************DCRPT010
00038      03  SUB1                    PICTURE 99      COMP.            DCRPT010
00039      03  SUB2                    PICTURE 99      COMP.            DCRPT010
00040      03  SUB3                    PICTURE 99      COMP.            DCRPT010
00041      03  SUB4                    PICTURE 99      COMP.            DCRPT010
00042      03  SUB5                    PICTURE 99      COMP.            DCRPT010
00043      03  SUB6                    PICTURE 99      COMP.            DCRPT010
00044      03  SUB7                    PICTURE 99      COMP.            DCRPT010
00045      03  SUB8                    PICTURE 99      COMP.               CL**2
00046      03  SUB9            PICTURE 99 COMP.                            CL**2
00047      03  SUB10           PICTURE 99 COMP.                            CL**2
00048 ******************************************************************DCRPT010
00049 *    EXTRACTION SWITCHES                                          DCRPT010
00050 *    Y = EXTRACT SUCCESSFUL - N = NOT SUCCESSFUL                 *DCRPT010
00051 ******************************************************************DCRPT010
00052      03  EXTRA-SW                PICTURE X.                       DCRPT010
00053      03  EDIT-SW                 PICTURE X.                       DCRPT010
00054      03  HAVE-SW                 PICTURE X.                       DCRPT010
00055      03  ROUTINE-SW              PICTURE X.                       DCRPT010
00056      03  PREFIX-A                PICTURE X.                       DCRPT010
00057      03  PREFIX-B                PICTURE X.                       DCRPT010
00058      03  OUTPUT-SW                PICTURE X.                         CL**2
00059      03  TWO-VALUE-SW    PICTURE X.                                  CL**2
00060      03  TYPE-CHANGE-SW  PICTURE X.                                  CL**2
00061      03  CHANGE-VALUE2.                                              CL**2
00062          05  CV1-BYTE    PICTURE X OCCURS 7 TIMES.                   CL**2
00063      03  CHANGE-VALUE1   PICTURE X(7).                               CL**2
00064      03  NUMERIC-CHANGE-VALUE.                                       CL**2
00065          05  NCV-BYTE    PICTURE X OCCURS 6 TIMES.                   CL**2
00066 ******************************************************************DCRPT010
00067 ******************************************************************DCRPT010
00068 *    HOLD AN EXTRACTED FIELD                                     *DCRPT010
00069 ******************************************************************DCRPT010
00070      03  HOLD-VALUE.                                              DCRPT010
00071          05  WORK-VALUE          PICTURE X OCCURS 72 TIMES.       DCRPT010
00072      03  TRANS-COUNT             PICTURE 99.                      DCRPT010
00073 ******************************************************************DCRPT010
00074 *    HOLD SHORT WORK AREAS                                       *DCRPT010
00075 ******************************************************************DCRPT010
00076      03  WORK-AREAS.                                              DCRPT010
00077          05  WORK-1              PICTURE X.                       DCRPT010
00078          05  WORK-1A  REDEFINES  WORK-1.                          DCRPT010
00079              07  WORK-N          PICTURE 9.                       DCRPT010
00080          05  WORK-3              PICTURE XXX.                     DCRPT010
00081          05  WORK-5              PICTURE X(5).                    DCRPT010
00082          05  WORK-9              PICTURE X(9).                    DCRPT010
00083          05  WORK-40.                                             DCRPT010
00084              07  WORK-40-A       PICTURE X OCCURS 40 TIMES.       DCRPT010
00085          05  WORK-32.                                             DCRPT010
00086              07  WORK-32-A       PICTURE X OCCURS 32 TIMES.       DCRPT010
00087          05  WORK-6.                                              DCRPT010
00088              07  FILLER          PICTURE 99.                      DCRPT010
00089              07  WORK-4.                                          DCRPT010
00090                  09  FILLER      PICTURE 99.                      DCRPT010
00091                  09  WORK-2      PICTURE 99.                      DCRPT010
00092          05  WORK-6Z  REDEFINES  WORK-6.                          DCRPT010
00093              07  WORK-6A         PICTURE X OCCURS 6 TIMES.        DCRPT010
00094 ******************************************************************DCRPT010
00095 *    USED IN ENTRY TYPE VALIDATION                               *DCRPT010
00096 ******************************************************************DCRPT010
00097      03  HOLD-ENTTYPE            PICTURE XX.                      DCRPT010
00098      03  HOLD-CATEGORY           PICTURE XXX.                     DCRPT010
00099      03  CAT                     PICTURE 99      COMP.            DCRPT010
00100      03  ENT                     PICTURE 99      COMP.            DCRPT010
00101      03  FLD                     PICTURE 99      COMP.            DCRPT010
00102      03  ENTRY-NAME-WK.                                           DCRPT010
00103          05  USER-ENTNAME-FIRST3 PICTURE XXX.                     DCRPT010
00104          05  USER-ENTNAME-BYTE4  PICTURE X.                       DCRPT010
00105          05  FILLER              PICTURE X(7).                    DCRPT010
00106      03  EDIT-ENT-NAME.                                           DCRPT010
00107          05  EDIT-ENTNAME-FIRST8.                                 DCRPT010
00108              07  ENT-NAME-3      PICTURE XXX.                     DCRPT010
00109              07  FILLER          PICTURE X(5).                    DCRPT010
00110          05  FILLER              PICTURE XXX.                     DCRPT010
00111      03  CAT-NAME-WK.                                             DCRPT010
00112          05  USER-CATNAME-FIRST3 PICTURE XXX.                     DCRPT010
00113          05  USER-CATNAME-BYTE4  PICTURE X.                       DCRPT010
00114          05  FILLER              PICTURE X(13).                   DCRPT010
00115      03  EDIT-CAT-NAME.                                           DCRPT010
00116          05  EDIT-CATNAME-FIRST15.                                DCRPT010
00117              07  CAT-NAME-3      PICTURE XXX.                     DCRPT010
00118              07  FILLER          PICTURE X(12).                   DCRPT010
00119          05  FILLER              PICTURE XX.                      DCRPT010
00120 ******************************************************************DCRPT010
00121 *    NUMERIC WITH FIELD WORK AREA                                *DCRPT010
00122 ******************************************************************DCRPT010
00123      03  NUMERIC-WORK.                                            DCRPT010
00124          05  NUM-WORKS           PICTURE X       OCCURS 4  TIMES. DCRPT010
00125 ******************************************************************DCRPT010
00126 *    STORAGE AREA FOR SELECT AND OUTPUT ERRORS                    DCRPT010
00127 *****************************************************************+DCRPT010
00128 ******************************************************************DCRPT010
*CALL     HITLINKT                                                         CL**2
00367                                                                    DCRPT01
00368  PROCEDURE DIVISION.                                              DCRPT010
00371 *************************************************************        CL**2
00372 *************************************************************        CL**2
00373 *                                                                    CL**2
00374 *    CONTROL I/O RETURNS FROM CALLING MODULE                         CL**2
00375 *                                                                    CL**2
00376 ***********************************************************          CL**2
00377 ***********************************************************          CL**2
00378  0000-BEGIN.                                                         CL**2
00379      IF RPT-REQ-SEL-WA NOT EQUAL TO SPACES                           CL**2
00380          GO TO 5800-REQWRITE-RETURN.                                 CL**2
00381 **************************************************                DCRPT010
00382 *************************************************                 DCRPT010
00383 *     INITIALIZATION                                              DCRPT010
00384 ***************************************************               DCRPT010
00385 **************************************************                DCRPT010
00386      OPEN INPUT MAST3.                                            DCRPT010
00387      MOVE ZERO TO SUB1.                                           DCRPT010
00388      MOVE SPACES TO RTBL.                                         DCRPT010
00389  1000-SET-NINE-FIELD.                                             DCRPT010
00390      ADD 1 TO SUB1.                                               DCRPT010
00391      IF SUB1 GREATER THAN 9                                       DCRPT010
00392          MOVE ZERO TO RTBL-USEOUT-NUM (SUB1)                         CL**2
00393          GO TO 1010-CONTINUE-PROCEDURE.                           DCRPT010
00394      MOVE ZERO TO RTBL-USEOUT-NUM (SUB1).                         DCRPT010
00395      MOVE ZERO TO RTBL-OUTPUT-NUM (SUB1).                         DCRPT010
00396      GO TO 1000-SET-NINE-FIELD.                                   DCRPT010
00397  1010-CONTINUE-PROCEDURE.                                         DCRPT010
00398      MOVE ZERO TO SUB1 SUB2 SUB3 SUB4 SUB5 SUB6 SUB7 SUB8.           CL**2
00399      MOVE "N" TO HAVE-SW, PREFIX-B.                               DCRPT010
00400      MOVE SPACES TO ERROR-SELECT.                                 DCRPT010
00401      MOVE SPACES TO ERROR-OUTPUT.                                 DCRPT010
00402      IF ERROR-COUNT NOT EQUAL TO ZEROS                               CL**2
00403          MOVE "Y" TO ERROR-CHECK                                     CL**2
00404          GO TO 5600-REPORT-EDIT-END.                                 CL**2
00405 ******************************************************************DCRPT010
00406 *    EXTRACT FIEST CARD FROM HOLD AREA                            DCRPT010
00407 ******************************************************************DCRPT010
00408      ADD 1 TO SUB5.                                               DCRPT010
00409      MOVE QRY-WORK (SUB5) TO HOLD-VALUE.                          DCRPT010
00410      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00411 *                                                                 DCRPT010
00412 *    MUST EXTRACT A $FILE OR A $REPORT ENTRY                      DCRPT010
00413 *                                                                 DCRPT010
           IF WORK-40 EQUAL TO "$FILE"
00415          PERFORM 8700-DEFAULT-CODE THRU 8799-DEFAULT-CODE-XIT     DCRPT010
00416          MOVE "F" TO HAVE-SW                                      DCRPT010
00417          GO TO 1020-FIND-REPORT.                                  DCRPT010
           IF WORK-40 EQUAL TO "$REPORT"
00419          PERFORM 8700-DEFAULT-CODE THRU 8799-DEFAULT-CODE-XIT     DCRPT010
00420          GO TO 1020-FIND-REPORT.                                  DCRPT010
00421      MOVE "04" TO ERROR-CODE.                                     DCRPT010
00422      GO TO 8250-BAD-ERROR-Y.                                      DCRPT010
00423  1020-FIND-REPORT.                                                DCRPT010
00424 *                                                                 DCRPT010
00425 *    EXTRACT NEXT FIELD---SHOULD BE A REPORT TYPE FIELD           DCRPT010
00426 *                                                                 DCRPT010
00427      MOVE TITLE-LINK-HOLD TO RTBL-OPT-TITLE.                      DCRPT010
00428      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00429      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00430          MOVE "09" TO ERROR-CODE                                  DCRPT010
00431          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00432 *                                                                 DCRPT010
00433 *    REPORT TYPE = CATALOGUE                                      DCRPT010
00434 *                                                                 DCRPT010
           IF WORK-40 NOT EQUAL TO "CATALOGUE"
00436          GO TO 1030-TEST-USAGE.                                   DCRPT010
00437      MOVE WORK-40 TO RTBL-HDR-RPTNAME.                            DCRPT010
00438      IF HAVE-SW EQUAL TO "F"                                      DCRPT010
00439          MOVE "N" TO HAVE-SW                                      DCRPT010
00440          MOVE "RU" TO RTBL-HDR-REQTYPE                            DCRPT010
00441          GO TO 1500-PROCESS-OPTIONS.                              DCRPT010
00442      MOVE "RR" TO RTBL-HDR-REQTYPE.                               DCRPT010
00443      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.         CL**2
00444      IF EXTRA-SW EQUAL TO "Y"                                        CL**2
00445          MOVE "14" TO ERROR-CODE                                     CL**2
00446          GO TO 8250-BAD-ERROR-Y.                                     CL**2
00447      GO TO 1500-PROCESS-OPTIONS.                                  DCRPT010
00448 *                                                                 DCRPT010
00449 *    REPORT TYPE = USAGE                                          DCRPT010
00450 *                                                                 DCRPT010
00451  1030-TEST-USAGE.                                                 DCRPT010
           IF WORK-40 NOT EQUAL TO "USAGE"
00453          GO TO 1040-TEST-HIERARCHY.                               DCRPT010
00454      MOVE WORK-40 TO RTBL-HDR-RPTNAME.                            DCRPT010
00455      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00456      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00457          GO TO 8200-BAD-ERROR-A.                                  DCRPT010
           IF WORK-40 NOT EQUAL TO "OF" 
00459          GO TO 8200-BAD-ERROR-A.                                  DCRPT010
00460      MOVE "U" TO RTBL-HDR-RETRIEVE.                               DCRPT010
00461      IF HAVE-SW EQUAL TO "F"                                      DCRPT010
00462          MOVE "N" TO HAVE-SW                                      DCRPT010
00463          MOVE "RV" TO RTBL-HDR-REQTYPE                            DCRPT010
00464          GO TO 1080-CHECK-CATNAME.                                DCRPT010
00465      MOVE "RS" TO RTBL-HDR-REQTYPE.                               DCRPT010
00466      GO TO 1080-CHECK-CATNAME.                                    DCRPT010
00467 *                                                                 DCRPT010
00468 *    REPORT TYPE = HIERARCHY                                      DCRPT010
00469 *                                                                 DCRPT010
00470  1040-TEST-HIERARCHY.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "HIERARCHY"
00472          GO TO 1050-TEST-FOR-FILE.                                DCRPT010
00473      MOVE WORK-40 TO RTBL-HDR-RPTNAME.                            DCRPT010
00474      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00475      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00476          GO TO 8200-BAD-ERROR-A.                                  DCRPT010
           IF WORK-40 NOT EQUAL TO "OF" 
00478          GO TO 8200-BAD-ERROR-A.                                  DCRPT010
00479      IF HAVE-SW EQUAL TO "F"                                      DCRPT010
00480          MOVE "N" TO HAVE-SW                                      DCRPT010
00481          MOVE "RW" TO RTBL-HDR-REQTYPE                            DCRPT010
00482          GO TO 1080-CHECK-CATNAME.                                DCRPT010
00483      MOVE "RT" TO RTBL-HDR-REQTYPE.                               DCRPT010
00484      GO TO 1080-CHECK-CATNAME.                                    DCRPT010
00485 *                                                                 DCRPT010
00486 *    TEST IF A FILE REPORT WAS SPECIFIED                          DCRPT010
00487 *                                                                 DCRPT010
00488  1050-TEST-FOR-FILE.                                              DCRPT010
00489      IF HAVE-SW EQUAL TO "F"                                      DCRPT010
00490          MOVE "N" TO HAVE-SW                                      DCRPT010
00491          ADD 1 TO SUB7                                            DCRPT010
00492          MOVE WORK-40 TO SYNTAX-WORD (SUB7)                       DCRPT010
00493          MOVE "11" TO ERROR-CODE                                  DCRPT010
00494          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00495 *                                                                 DCRPT010
00496 *    REPORT TYPE = INDEX                                          DCRPT010
00497 *                                                                 DCRPT010
           IF WORK-40 NOT EQUAL TO "INDEX"
00499          GO TO 1060-TEST-RELATIONAL.                              DCRPT010
00500      MOVE "RH" TO RTBL-HDR-REQTYPE.                                  CL**2
00501      MOVE WORK-40 TO RTBL-HDR-RPTNAME.                            DCRPT010
00502  1055-PROCESS-BY.                                                    CL**2
00503      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00504      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00505          GO TO 8200-BAD-ERROR-A.                                  DCRPT010
           IF WORK-40 NOT EQUAL TO "BY" 
00507          GO TO 8200-BAD-ERROR-A.                                  DCRPT010
00508 *                                                                 DCRPT010
00509 *    TEST FOR INDEX REPORT FIELDNAME                              DCRPT010
00510 *                                                                 DCRPT010
00511      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00512      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00513          MOVE "12" TO ERROR-CODE                                  DCRPT010
00514          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00515      MOVE WORK-40 TO RTBL-HDR-IDXFNAME.                           DCRPT010
00516      GO TO 1070-CHECK-FOR.                                        DCRPT010
00517 *                                                                 DCRPT010
00518 *    REPORT TYPE = RELATIONAL                                     DCRPT010
00519 *                                                                 DCRPT010
00520  1060-TEST-RELATIONAL.                                            DCRPT010
           IF WORK-40 EQUAL TO "RELATIONAL" 
00522          MOVE "RJ" TO RTBL-HDR-REQTYPE                            DCRPT010
00523          MOVE WORK-40 TO RTBL-HDR-RPTNAME                         DCRPT010
00524          GO TO 1055-PROCESS-BY.                                      CL**2
00525 *                                                                 DCRPT010
00526 *    REPORT-TYPE = NAME-ANALYSIS                                  DCRPT010
00527 *                                                                 DCRPT010
           IF WORK-40 EQUAL TO "NAME-ANALYSIS"
00529          MOVE "RC" TO RTBL-HDR-REQTYPE                            DCRPT010
00530          MOVE WORK-40 TO RTBL-HDR-RPTNAME                         DCRPT010
00531          GO TO 1055-PROCESS-BY.                                      CL**2
00532      ADD 1 TO SUB7.                                                  CL**2
00533      MOVE WORK-40 TO SYNTAX-WORD (SUB7).                             CL**2
00534      MOVE "11" TO ERROR-CODE.                                        CL**2
00535      GO TO 8250-BAD-ERROR-Y.                                      DCRPT010
00536 *                                                                 DCRPT010
00537 *    CHECK FOR "FOR" WHICH PUTS A LIMIT ON REPORT OUTPUT          DCRPT010
00538 *                                                                 DCRPT010
00539  1070-CHECK-FOR.                                                  DCRPT010
00540      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00541      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00542          GO TO 1500-PROCESS-OPTIONS.                              DCRPT010
           IF WORK-40 EQUAL TO "FOR"
00544          GO TO 1080-CHECK-CATNAME.                                DCRPT010
00545      MOVE "14" TO ERROR-CODE.                                        CL**2
00546      GO TO 8250-BAD-ERROR-Y.                                      DCRPT010
00547 *                                                                 DCRPT010
00548 *    DETERMINE BETWEEN A NAMED ENTRY AND A N ENTRY TYPE           DCRPT010
00549 *                                                                 DCRPT010
00550  1080-CHECK-CATNAME.                                              DCRPT010
00551      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00552      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00553          MOVE "14" TO ERROR-CODE                                  DCRPT010
00554          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00555      PERFORM 9900-VALIDATE-TYPE THRU 9599-VALIDATE-TYPE-XIT.      DCRPT010
00556      IF EDIT-SW EQUAL TO "N"                                      DCRPT010
00557          MOVE WORK-40 TO RTBL-HDR-STARTCNAME                      DCRPT010
00558          GO TO 1090-CHECK-UPWARD.                                 DCRPT010
           IF HOLD-ENTTYPE EQUAL TO "03"
00560          GO TO 1085-TEST-HIERARCHY.                                  CL**2
00561      IF HOLD-ENTTYPE EQUAL TO "65"                                   CL**2
00562          GO TO 1087-TEST-USAGE.                                      CL**2
00563      GO TO 1088-MOVE-FIELDS.                                         CL**2
00564  1085-TEST-HIERARCHY.                                                CL**2
00565      IF RTBL-HDR-REQTYPE EQUAL TO "RT" OR "RW"                       CL**2
00566          MOVE "50" TO ERROR-CODE                                     CL**2
00567          PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT              CL**2
00568          GO TO 5100-EDIT-END.                                        CL**2
00569      GO TO 1088-MOVE-FIELDS.                                         CL**2
00570  1087-TEST-USAGE.                                                    CL**2
00571      IF RTBL-HDR-REQTYPE EQUAL TO "RV" OR "RS"                       CL**2
00572          MOVE "51" TO ERROR-CODE                                     CL**2
00573          PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT              CL**2
00574          GO TO 5100-EDIT-END.                                        CL**2
00575  1088-MOVE-FIELDS.                                                   CL**2
00576      MOVE HOLD-ENTTYPE TO RTBL-HDR-ENTTYPE.                       DCRPT010
00577      MOVE WORK-40 TO RTBL-HDR-ENTITY.                             DCRPT010
00578 *                                                                 DCRPT010
00579 *    CHECK FOR UPWARD REFERENCE OF REPORT                         DCRPT010
      *    CODES ARE AS FOLLOWS 
      *        RC = NAME ANALYSIS 
      *        RH = INDEX 
      *        RJ = RELATIONAL
      *        RR = CATALOGUE (REPORTS) 
      *        RS = USAGE     (REPORTS) 
      *        RT = HIERARCHY (REPORTS) 
      *        RU = CATALOGUE (FILES) 
      *        RV = USAGE     (FILES) 
      *        RW = HIERARCHY (FILES) 
00580 *                                                                 DCRPT010
00581  1090-CHECK-UPWARD.                                               DCRPT010
00582      IF RTBL-HDR-REQTYPE EQUAL TO "RR" OR "RS" OR "RT"            DCRPT010
00583          OR "RU" OR "RV" OR "RW"                                  DCRPT010
00584          GO TO 1500-PROCESS-OPTIONS.                              DCRPT010
00585      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00586      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00587          MOVE SPACE TO RTBL-HDR-RETRIEVE                             CL**2
00588          GO TO 1480-CHECK-DOWN.                                      CL**2
           IF WORK-40 EQUAL TO "USAGE"
00590          MOVE "U" TO RTBL-HDR-RETRIEVE                            DCRPT010
00591          GO TO 1490-CHECK-UP.                                        CL**2
00592      MOVE "14" TO ERROR-CODE.                                     DCRPT010
00593      GO TO 8250-BAD-ERROR-Y.                                      DCRPT010
00594  1480-CHECK-DOWN.                                                    CL**2
           IF RTBL-HDR-ENTTYPE EQUAL TO "03"
00596          MOVE "50" TO ERROR-CODE                                     CL**2
00597          PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT              CL**2
00598          GO TO 5100-EDIT-END.                                        CL**2
00599      GO TO 1500-PROCESS-OPTIONS.                                     CL**2
00600  1490-CHECK-UP.                                                      CL**2
00601      IF RTBL-HDR-ENTTYPE EQUAL "65"                                  CL**2
00602          MOVE "51" TO ERROR-CODE                                     CL**2
00603          PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT              CL**2
00604          GO TO 5100-EDIT-END.                                        CL**2
00605 ******************************************************************DCRPT010
00606 *    LOOK AT NEXT ENTRY IN QRY-HOLD                               DCRPT010
00607 *        CHECK TO SEE IF IT IS AN OPTION CARD OR A SELECT CARD    DCRPT010
00608 ******************************************************************DCRPT010
00609  1500-PROCESS-OPTIONS.                                            DCRPT010
00610      MOVE ZERO TO SUB1                                            DCRPT010
00611      ADD 1 TO SUB5.                                               DCRPT010
00612      IF SUB5 GREATER THAN LINKAGE-COUNT                           DCRPT010
00613          MOVE 1 TO SUB6                                           DCRPT010
00614          GO TO 5100-EDIT-END.                                     DCRPT010
00615      MOVE QRY-WORK (SUB5) TO HOLD-VALUE.                          DCRPT010
00616      MOVE "A" TO ROUTINE-SW.                                         CL**2
00617      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00618 *                                                                 DCRPT010
00619 *    CHECK HOLD AREA FOR OPTION--SELECT--OUTPUT CARD              DCRPT010
00620 *                                                                 DCRPT010
           IF WORK-40 EQUAL TO "SEL" OR "SELECT"
00622          MOVE SPACES TO ROUTINE-SW                                   CL**2
00623          GO TO 1750-PROCESS-SELECT.                               DCRPT010
           IF WORK-40 EQUAL TO "OPT" OR "OPTIONS" 
00625          GO TO 1510-EXTRACT-OPTIONS.                              DCRPT010
           IF WORK-40 EQUAL TO "OUT" OR "OUTPUT"
00627          MOVE SPACES TO ROUTINE-SW                                   CL**2
00628          GO TO 4300-BEGIN-OUTPUT.                                 DCRPT010
00629      MOVE "04" TO ERROR-CODE.                                     DCRPT010
00630      GO TO 8250-BAD-ERROR-Y.                                      DCRPT010
00631 *                                                                 DCRPT010
00632 *    PROCESS OPTIONS FROM OPTIONS QUERY                           DCRPT010
00633 *                                                                 DCRPT010
00634  1510-EXTRACT-OPTIONS.                                            DCRPT010
00635      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00636      IF EDIT-SW NOT EQUAL TO "M"                                  DCRPT010
00637          GO TO 1520-CHECK-BAD-SWITCHES.                           DCRPT010
00638      IF ROUTINE-SW NOT EQUAL TO "A"                                  CL**2
00639          MOVE SPACES TO ROUTINE-SW                                   CL**2
00640          MOVE "17" TO ERROR-CODE                                     CL**2
00641          GO TO 8250-BAD-ERROR-Y.                                     CL**2
00642      ADD 1 TO SUB5.                                               DCRPT010
00643      MOVE ZERO TO SUB1.                                           DCRPT010
00644      MOVE QRY-WORK (SUB5) TO HOLD-VALUE.                          DCRPT010
00645      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
00646 *                                                                 DCRPT010
00647 *    EXTRA-SW = Y  MEANS EXTRACTION OF OPTION ITSELF              DCRPT010
00648 *    HAVE-SW  = Y  MEANS EXTRACTION OF OPTION VALUE WAS MADE      DCRPT010
00649 *                                                                 DCRPT010
00650  1520-CHECK-BAD-SWITCHES.                                         DCRPT010
00651      MOVE SPACES TO ROUTINE-SW.                                      CL**2
00652      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
00653          MOVE "17" TO ERROR-CODE                                  DCRPT010
00654          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
           IF WORK-40 EQUAL TO "SEL" OR "SELECT"
00656          MOVE "17" TO ERROR-CODE                                  DCRPT010
00657          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00658      IF HAVE-SW EQUAL TO "N"                                      DCRPT010
00659          MOVE "A" TO ROUTINE-SW                                   DCRPT010
00660          ADD 1 TO SUB7                                            DCRPT010
00661          MOVE WORK-40 TO SYNTAX-WORD (SUB7)                       DCRPT010
00662          MOVE "18" TO ERROR-CODE                                  DCRPT010
00663          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00664 *                                                                 DCRPT010
00665 *    VALIDATE IF OPTION LEGAL FOR REPORT TYPE NAMED               DCRPT010
00666 *                                                                 DCRPT010
00667      IF RTBL-HDR-REQTYPE EQUAL TO "RC"                            DCRPT010
00668          GO TO 1555-BRKCHR-OPTION.                                   CL**2
00669      IF RTBL-HDR-REQTYPE EQUAL TO "RH"                            DCRPT010
00670          GO TO 1640-FORMAT-OPTIONS.                               DCRPT010
00671      IF RTBL-HDR-REQTYPE EQUAL TO "RJ"                            DCRPT010
00672          GO TO 1590-DIRECT-OPTIONS.                               DCRPT010
00673      IF RTBL-HDR-REQTYPE EQUAL TO "RR"                            DCRPT010
00674          GO TO 1630-INDEX-OPTIONS.                                DCRPT010
00675      IF RTBL-HDR-REQTYPE EQUAL TO "RS"                            DCRPT010
00676          GO TO 1620-INDENT-OPTION.                                DCRPT010
00677      IF RTBL-HDR-REQTYPE EQUAL TO "RT"                            DCRPT010
00678          GO TO 1620-INDENT-OPTION.                                DCRPT010
00679      IF RTBL-HDR-REQTYPE EQUAL TO "RU"                            DCRPT010
00680          GO TO 1615-REPORT-OPTION.                                DCRPT010
00681      IF RTBL-HDR-REQTYPE EQUAL TO "RV"                            DCRPT010
00682          GO TO 1615-REPORT-OPTION.                                DCRPT010
00683      IF RTBL-HDR-REQTYPE EQUAL TO "RW"                            DCRPT010
00684          GO TO 1615-REPORT-OPTION.                                DCRPT010
00685 *                                                                 DCRPT010
00686 *    BREAK CHARACTER OPTION---COMMON TO NAME-ANALYSIS-REPORTS     DCRPT010
00687 *                                                                 DCRPT010
00688  1555-BRKCHR-OPTION.                                              DCRPT010
           IF WORK-40 NOT EQUAL TO "BRKCHR" 
00690          GO TO 1580-DESLINE-OPTION.                               DCRPT010
00691      MOVE WORK-32 TO RTBL-OPT-BRECHR.                             DCRPT010
00692      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00693 **********************************************************           CL**2
00694 *     OPTIONS FOR NAME ANALYSIS REPORT                               CL**2
00695 **********************************************************           CL**2
00696  1580-DESLINE-OPTION.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "DESLINES" 
00698          GO TO 1645-COMMON-OPTIONS.                               DCRPT010
00699      PERFORM 8900-MOVE-NUMERIC THRU 8999-MOVE-NUMERIC-XIT.        DCRPT010
00700      IF WORK-4 NUMERIC                                            DCRPT010
00701          MOVE WORK-4 TO RTBL-OPT-LINES                            DCRPT010
00702          MOVE "Y" TO RTBL-OPT-DESC                                   CL**2
00703          GO TO 1690-END-OPTION-TEST.                              DCRPT010
           IF WORK-32 EQUAL TO "ALL"
00705          MOVE "A" TO RTBL-OPT-DESC                                DCRPT010
00706          MOVE 9999 TO RTBL-OPT-LINES                                 CL**2
00707          GO TO 1690-END-OPTION-TEST.                              DCRPT010
           IF WORK-32 NOT EQUAL TO "NONE" 
00709          ADD 1 TO SUB7                                            DCRPT010
00710          MOVE WORK-40 TO SYNTAX-WORD (SUB7)                       DCRPT010
00711          MOVE "27" TO ERROR-CODE                                  DCRPT010
00712          MOVE "A" TO ROUTINE-SW                                   DCRPT010
00713          PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.          DCRPT010
00714      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00715 ******************************************************************DCRPT010
00716 *                                                                 DCRPT010
00717 *    OPTIONS COMMON TO RELATIONAL RECORDS                         DCRPT010
00718 *                                                                 DCRPT010
00719 ******************************************************************DCRPT010
00720  1590-DIRECT-OPTIONS.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "DIRECT" 
00722          GO TO 1595-INDIRECT-OPTIONS.                             DCRPT010
00723      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00724      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00725          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00726      MOVE "N" TO RTBL-OPT-DIRECT.                                 DCRPT010
00727      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00728 *                                                                 DCRPT010
00729 *    INDIRECT-OPTION---COMMON ONLY TO RELATIONAL RECORDS.         DCRPT010
00730 *                                                                 DCRPT010
00731  1595-INDIRECT-OPTIONS.                                           DCRPT010
           IF WORK-40 NOT EQUAL TO "INDIRECT" 
00733          GO TO 1600-DETAIL-OPTIONS.                               DCRPT010
00734      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00735      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00736          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00737      MOVE "N" TO RTBL-OPT-INDIRECT.                               DCRPT010
00738      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00739 *                                                                 DCRPT010
00740 *    DETAIL OPTIONS---COMMON ONLY TO RELATION RECORDS             DCRPT010
00741 *                                                                 DCRPT010
00742  1600-DETAIL-OPTIONS.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "DETAIL" 
               GO TO 1605-UNREF-OPTIONS.
00745      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00746      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00747          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00748      MOVE "N" TO RTBL-OPT-DETAIL.                                 DCRPT010
00749      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00750 *                                                                 DCRPT010
00751 *    UNREFERENCE OPTION---COMMON ONLY TO RELATIONAL RECORDS       DCRPT010
00752 *                                                                 DCRPT010
00753  1605-UNREF-OPTIONS.                                              DCRPT010
           IF WORK-40 NOT EQUAL TO "UNREF"
00755      GO TO 1610-SUMMARY-OPTIONS.                                  DCRPT010
00756      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00757      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00758          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00759      MOVE "N" TO RTBL-OPT-UNREF.                                  DCRPT010
00760      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00761  1610-SUMMARY-OPTIONS.                                            DCRPT010
           IF WORK-40 NOT EQUAL TO "SUMMARY"
00763          GO TO 1640-FORMAT-OPTIONS.                               DCRPT010
00764      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00765      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00766          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00767      MOVE "N" TO RTBL-OPT-SUMMARY.                                DCRPT010
00768      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00769 ******************************************************************DCRPT010
00770 *                                                                 DCRPT010
00771 *    REPORTS OPTION----COMMON ONLY TO FILE REPORTS                DCRPT010
00772 *                                                                 DCRPT010
00773 ******************************************************************DCRPT010
00774  1615-REPORT-OPTION.                                              DCRPT010
           IF WORK-40 NOT EQUAL TO "REPORT" 
00776          GO TO 1620-INDENT-OPTION.                                   CL**2
00777      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00778      IF HAVE-SW EQUAL TO "N"                                      DCRPT010
               MOVE "N" TO RTBL-OPT-REPORT
00780          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00781      MOVE "Y" TO RTBL-OPT-REPORT.                                 DCRPT010
00782      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00783 *                                                                 DCRPT010
00784 *    INDENT OPTION---COMMON TO FILE USAGE AND HIERARCHY REPORTS   DCRPT010
00785 *                                                                 DCRPT010
00786  1620-INDENT-OPTION.                                              DCRPT010
00787      IF RTBL-HDR-REQTYPE EQUAL TO "RU"                            DCRPT010
00788          GO TO 1630-INDEX-OPTIONS.                                DCRPT010
           IF WORK-40 NOT EQUAL TO "INDENTED-INDEX" 
00790          GO TO 1625-STOPENT-OPTION.                               DCRPT010
00791      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00792      IF HAVE-SW EQUAL TO "N"                                      DCRPT010
00793          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00794      MOVE "Y" TO RTBL-OPT-INDENT.                                 DCRPT010
00795      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00796 *                                                                 DCRPT010
00797 *    STOPENT OPTION---COMMON TO USAGE AND HIERARCHY REPORTS       DCRPT010
00798 *                                                                 DCRPT010
00799  1625-STOPENT-OPTION.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "STOPENT"
00801          GO TO 1630-INDEX-OPTIONS.                                DCRPT010
00802      MOVE WORK-32 TO RTBL-OPT-STOPNAME.                           DCRPT010
00803      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00804 *                                                                 DCRPT010
00805 *    INDEX OPTION COMMON TO USAGE, HIERARCHY, AND CATALOGUE       DCRPT010
00806 *                                                                 DCRPT010
00807  1630-INDEX-OPTIONS.                                              DCRPT010
           IF WORK-40 NOT EQUAL TO "INDEX"
00809          GO TO 1635-NEWPAGE-OPTION.                               DCRPT010
00810      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00811      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00812          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00813      MOVE "N" TO RTBL-OPT-INDEX.                                  DCRPT010
00814      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00815 *                                                                 DCRPT010
00816 *    NEWPAGE OPTION--- COMMON TO USAGE HIERARCHY AND CATALOGUE    DCRPT010
00817 *                                                                 DCRPT010
00818  1635-NEWPAGE-OPTION.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "NEWPAGE"
00820          GO TO 1640-FORMAT-OPTIONS.                               DCRPT010
00821      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00822      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00823          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00824      MOVE "N" TO RTBL-OPT-NEWPAGE.                                DCRPT010
00825      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00826 *                                                                 DCRPT010
00827 *    FORMAT OPTION---CATALOGUE USAGE HIERARCHY INDEX RELATIONAL   DCRPT010
00828 *                                                                 DCRPT010
00829  1640-FORMAT-OPTIONS.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "FORMAT" 
00831          GO TO 1645-COMMON-OPTIONS.                               DCRPT010
           IF WORK-40 NOT EQUAL TO "DOCUM"
00833          MOVE "D" TO RTBL-OPT-FORMAT                                 CL**2
00834          GO TO 1690-END-OPTION-TEST.                              DCRPT010
           IF WORK-40 NOT EQUAL TO "STANDARD" 
00836          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00837      ADD 1 TO SUB7.                                               DCRPT010
00838      MOVE WORK-40 TO SYNTAX-WORD (SUB7).                          DCRPT010
00839      MOVE "27" TO ERROR-CODE.                                     DCRPT010
00840      MOVE "A" TO ROUTINE-SW.                                      DCRPT010
00841      PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.              DCRPT010
00842 ******************************************************************DCRPT010
00843 *                                                                 DCRPT010
00844 *    COMMON OPTION TO ALL TYPES OF RECORDS.                       DCRPT010
00845 *                                                                 DCRPT010
00846 ******************************************************************DCRPT010
00847 *                                                                 DCRPT010
00848 *    TEST FOR SHOWREQ                                             DCRPT010
00849 *                                                                 DCRPT010
00850  1645-COMMON-OPTIONS.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "SHOWREQ"
00852          GO TO 1650-MESSAGE-OPTION.                               DCRPT010
00853      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00854      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00855          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00856      MOVE "N" TO RTBL-OPT-PRTREQ.                                 DCRPT010
00857      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00858 *                                                                 DCRPT010
00859 *    TEST FOR MESSAGE OPTION                                      DCRPT010
00860 *                                                                 DCRPT010
00861  1650-MESSAGE-OPTION.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "MESSAGE"
00863          GO TO 1655-SEQ-OPTION.                                   DCRPT010
00864      PERFORM 8800-YES-NO THRU 8899-YES-NO-XIT.                    DCRPT010
00865      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
00866          MOVE "Y" TO RTBL-OPT-BOTMSG                                 CL**2
00867          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00868      MOVE "N" TO RTBL-OPT-BOTMSG.                                 DCRPT010
00869      GO TO 1690-END-OPTION-TEST.                                  DCRPT010
00870 *                                                                 DCRPT010
00871 *    TEST FOR SEQ OPTION                                          DCRPT010
00872 *                                                                 DCRPT010
00873  1655-SEQ-OPTION.                                                 DCRPT010
           IF WORK-40 NOT EQUAL TO "SEQ"
00875          GO TO 1670-NO-OPTIONS-EXIST.                             DCRPT010
           IF WORK-32 NOT EQUAL TO "TYPE" 
00877          MOVE 1 TO RTBL-OPT-SEQ                                   DCRPT010
00878          GO TO 1690-END-OPTION-TEST.                              DCRPT010
           IF WORK-32 NOT EQUAL TO "REVERSE"
00880          MOVE 2 TO RTBL-OPT-SEQ                                   DCRPT010
00881          GO TO 1690-END-OPTION-TEST.                              DCRPT010
           IF WORK-32 EQUAL TO "NAME" OR "NAMECOMP" 
00883          MOVE 3 TO RTBL-OPT-SEQ                                   DCRPT010
00884          GO TO 1690-END-OPTION-TEST.                              DCRPT010
           IF WORK-32 EQUAL TO "RETRIEVAL"
00886          MOVE 4 TO RTBL-OPT-SEQ                                   DCRPT010
00887          GO TO 1690-END-OPTION-TEST.                              DCRPT010
           IF WORK-32 EQUAL TO "FIELD"
00889          MOVE 5 TO RTBL-OPT-SEQ                                   DCRPT010
00890          GO TO 1690-END-OPTION-TEST.                              DCRPT010
00891      ADD 1 TO SUB7.                                               DCRPT010
00892      MOVE WORK-40 TO SYNTAX-WORD (SUB7).                          DCRPT010
00893      MOVE "27" TO ERROR-CODE.                                     DCRPT010
00894      MOVE "A" TO ROUTINE-SW.                                      DCRPT010
00895      PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.              DCRPT010
00896 *                                                                 DCRPT010
00897 *    THE GIVE OPTION DOESN"T EXIST FOR NAMED REPORT               DCRPT010
00898 *                                                                 DCRPT010
00899  1670-NO-OPTIONS-EXIST.                                           DCRPT010
00900      ADD 1 TO SUB7.                                               DCRPT010
00901      MOVE WORK-40 TO SYNTAX-WORD (SUB7).                          DCRPT010
00902      MOVE "20" TO ERROR-CODE.                                     DCRPT010
00903      MOVE "A" TO ROUTINE-SW.                                      DCRPT010
00904      PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.              DCRPT010
00905  1675-MOVE-YES.                                                   DCRPT010
00906      MOVE "Y" TO ERROR-CHECK.                                     DCRPT010
00907 *                                                                 DCRPT010
00908 *    IF A SPACE FOUND AT END OF OPTION CLAUSE INSTEAD OF COMMA    DCRPT010
00909 *    THE EDIT-SW WILL EQUAL "Y" AND NO MORE OPTIONS WILL EXIST    DCRPT010
00910 *                                                                 DCRPT010
00911  1690-END-OPTION-TEST.                                            DCRPT010
00912      IF EDIT-SW EQUAL TO "Y"                                      DCRPT010
00913          MOVE "N" TO EDIT-SW, HAVE-SW, EXTRA-SW                   DCRPT010
00914          GO TO 1700-PROCESS-SELECTIONS.                           DCRPT010
00915 *                                                                 DCRPT010
00916 *    IF EDIT-SW EQUAL "N" THEN MORE OPTIONS WILL BE FOUND AND A   DCRPT010
00917 *       TEST FOR END OF CARD CONTINUATION MUST OCCUR              DCRPT010
00918 *                                                                 DCRPT010
00919      IF SUB1 NOT GREATER THAN 71                                     CL**2
00920          MOVE "A" TO ROUTINE-SW                                      CL**2
00921          GO TO 1510-EXTRACT-OPTIONS.                                 CL**2
00922      ADD 1 TO SUB5.                                               DCRPT010
00923      IF SUB5 GREATER THAN LINKAGE-COUNT                           DCRPT010
00924          MOVE "17" TO ERROR-CODE                                  DCRPT010
00925          PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT           DCRPT010
00926          MOVE "16" TO ERROR-CODE                                  DCRPT010
00927          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00928      IF SUB5 GREATER THAN 5                                       DCRPT010
00929          MOVE "04" TO ERROR-CODE                                  DCRPT010
00930          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00931      MOVE ZERO TO SUB1.                                           DCRPT010
00932      MOVE QRY-WORK (SUB5) TO HOLD-VALUE.                          DCRPT010
00933      GO TO 1510-EXTRACT-OPTIONS.                                  DCRPT010
00934                                                                    DCRPT01
00935 ******************************************************************DCRPT010
00936 *                                                                 DCRPT010
00937 *    BEGIN PROCESSING THE SELECTION STATEMENTS                    DCRPT010
00938 *                                                                 DCRPT010
00939 ******************************************************************DCRPT010
00940  1700-PROCESS-SELECTIONS.                                         DCRPT010
00941      MOVE ZERO TO SUB1 SUB2 SUB3 SUB4 SUB6.                       DCRPT010
00942      ADD 1 TO SUB5.                                               DCRPT010
00943      IF SUB5 GREATER THAN 5                                       DCRPT010
00944          MOVE "04" TO ERROR-CODE                                  DCRPT010
00945          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
00946      IF SUB5 GREATER THAN LINKAGE-COUNT                           DCRPT010
00947          GO TO 5100-EDIT-END.                                     DCRPT010
00948      MOVE QRY-WORK (SUB5) TO HOLD-VALUE.                          DCRPT010
00949      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
           IF WORK-40 EQUAL TO "SELECT" OR "SEL"
00951          GO TO 1750-PROCESS-SELECT.                               DCRPT010
           IF WORK-40 EQUAL TO "OUTPUT" OR "OUT"
00953          GO TO 4300-BEGIN-OUTPUT.                                 DCRPT010
00954      MOVE "17" TO ERROR-CODE.                                        CL**2
00955      GO TO 8250-BAD-ERROR-Y.                                      DCRPT010
00956  1750-PROCESS-SELECT.                                             DCRPT010
00957      ADD 1 TO SUB6.                                               DCRPT010
00958      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
00959      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
00960 *                                                                 DCRPT010
00961 *    ALIAS AND VERSION QUERY VALIDATION                           DCRPT010
00962 *                                                                 DCRPT010
00963      MOVE WORK-40 TO WORK-9.                                      DCRPT010
           IF WORK-40 EQUAL TO "ALIASES" OR "ALI" 
             OR "VERSIONS" OR "VER" 
00966          GO TO 1800-PROCESS-ALIAS.                                DCRPT010
00967      GO TO 1825-E-QUOTE.                                          DCRPT010
00968  1800-PROCESS-ALIAS.                                              DCRPT010
00969      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                   DCRPT010
00970          MOVE "29" TO SEL-ERR (SUB6)                              DCRPT010
00971          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
00972      IF RTBL-HDR-ENTTYPE NOT EQUAL TO SPACES                      DCRPT010
00973          MOVE "29" TO SEL-ERR (SUB6)                              DCRPT010
00974          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
00975      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
00976      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
           IF WORK-40 NOT EQUAL TO "OF" 
00978          MOVE "23" TO SEL-ERR (SUB6)                              DCRPT010
00979          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
00980      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
00981      IF EXTRA-SW NOT EQUAL TO "Y"                                    CL**2
00982          MOVE "29" TO SEL-ERR (SUB6)                                 CL**2
00983          GO TO 4250-PROCESS-NEXT-SELECT.                             CL**2
00984      MOVE WORK-40 TO RTBL-OPT-CNAME (SUB6).                       DCRPT010
00985      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
00986      IF EXTRA-SW EQUAL TO "B" OR "C"                              DCRPT010
00987          GO TO 1810-BUILD-VER.                                    DCRPT010
           IF WORK-9 EQUAL TO "VERSIONS" OR "VER" 
00989          MOVE "25" TO RTBL-QRYTYPE-23 (SUB6) ELSE                 DCRPT010
00990          MOVE "15" TO RTBL-QRYTYPE-23 (SUB6).                     DCRPT010
00991      GO TO 2000-EDIT-WITH.                                        DCRPT010
00992  1810-BUILD-VER.                                                  DCRPT010
           IF WORK-9 EQUAL TO "VERSIONS" OR "VER" 
00994          MOVE "20" TO RTBL-QRYTYPE-23 (SUB6) ELSE                 DCRPT010
00995          MOVE "10" TO RTBL-QRYTYPE-23 (SUB6).                     DCRPT010
00996      GO TO 5000-BUILD-CAT-ID.                                     DCRPT010
00997                                                                    DCRPT01
00998 ******************************************************************DCRPT010
00999 *                                                                 DCRPT010
01000 *    CHECK FOR VALUE RANGE QUERY (QUOTES)                         DCRPT010
01001 *                                                                 DCRPT010
01002 ******************************************************************DCRPT010
01003  1825-E-QUOTE.                                                    DCRPT010
01004      MOVE WORK-40 TO WORK-1.                                      DCRPT010
01005      IF WORK-1 NOT EQUAL TO QUOTE                                 DCRPT010
01006          GO TO 1850-E-ENTRY-TYPE.                                 DCRPT010
01007      PERFORM 1830-EXTRACT-QUOTE THRU 1839-EXTRACT-QUOTE-XIT.      DCRPT010
01008      MOVE WORK-40 TO RTBL-OPT-CNAME (SUB6).                       DCRPT010
01009      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01010      IF EXTRA-SW NOT EQUAL TO "Y"                                    CL**2
01011          MOVE "24" TO SEL-ERR (SUB6)                                 CL**2
01012          GO TO 4250-PROCESS-NEXT-SELECT.                             CL**2
01013 *                                                                 DCRPT010
01014 *    VALUE RANGE QUERY VALIDATION                                 DCRPT010
01015 *                                                                 DCRPT010
           IF WORK-40 NOT EQUAL TO "TO" 
01017          MOVE "24" TO SEL-ERR (SUB6)                              DCRPT010
01018          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01019      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01020      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
01021      MOVE WORK-40 TO WORK-1.                                      DCRPT010
01022      IF WORK-1 NOT EQUAL TO QUOTE                                 DCRPT010
01023          MOVE "24" TO SEL-ERR (SUB6)                              DCRPT010
01024          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01025      PERFORM 1830-EXTRACT-QUOTE THRU 1839-EXTRACT-QUOTE-XIT.      DCRPT010
01026      GO TO 1865-MOVE-RIGHT.                                       DCRPT010
01027 *                                                                 DCRPT010
01028 *    SUBROUTINE TO EXTRACT VALUE FROM QUOTES                      DCRPT010
01029 *                                                                 DCRPT010
01030  1830-EXTRACT-QUOTE.                                              DCRPT010
01031      MOVE "01" TO SUB4.                                           DCRPT010
01032      MOVE "02" TO SUB2.                                           DCRPT010
01033  1835-NEXT-TRY.                                                   DCRPT010
01034      MOVE WORK-40-A (SUB2) TO WORK-40-A (SUB4).                   DCRPT010
01035      ADD 1 TO SUB4.                                               DCRPT010
01036      ADD 1 TO SUB2.                                               DCRPT010
01037      IF SUB2 GREATER THAN 32                                      DCRPT010
01038          MOVE "25" TO SEL-ERR (SUB6)                              DCRPT010
01039          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01040      IF WORK-40-A (SUB2) NOT EQUAL TO QUOTES                      DCRPT010
01041          GO TO 1835-NEXT-TRY.                                     DCRPT010
01042      MOVE SPACES TO WORK-40-A (SUB2).                             DCRPT010
01043      MOVE SPACES TO WORK-40-A (SUB4).                             DCRPT010
01044      MOVE ZERO TO SUB4.                                           DCRPT010
01045  1839-EXTRACT-QUOTE-XIT.                                          DCRPT010
01046      EXIT.                                                        DCRPT010
01047                                                                    DCRPT01
01048 *                                                                 DCRPT010
01049 *    DETERMINATION BETWEEN A NAMED ENTRY AND A TYPE OF ENTRY      DCRPT010
01050 *                                                                 DCRPT010
01051  1850-E-ENTRY-TYPE.                                               DCRPT010
01052      PERFORM 9900-VALIDATE-TYPE THRU 9599-VALIDATE-TYPE-XIT.      DCRPT010
01053      IF EDIT-SW EQUAL TO "N"                                      DCRPT010
01054          GO TO 1855-BUILD-NAME-REQUEST.                           DCRPT010
01055      GO TO 1900-E-ENTTYPE.                                        DCRPT010
01056 *                                                                 DCRPT010
01057 *    ENTRY SINGLE QUERY VALIDATION                                DCRPT010
01058 *    ENTRY FOR SINGLE NAME VALIDATION                             DCRPT010
01059 *                                                                 DCRPT010
01060  1855-BUILD-NAME-REQUEST.                                         DCRPT010
01061      MOVE WORK-40 TO RTBL-OPT-CNAME (SUB6).                       DCRPT010
01062      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01063      IF EXTRA-SW EQUAL TO "Y"                                     DCRPT010
01064          GO TO 1860-GET-NAME-RANGE.                               DCRPT010
01065 *                                                                 DCRPT010
01066 *    BUILD AN S04 REQUEST                                         DCRPT010
01067 *                                                                 DCRPT010
01068      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                   DCRPT010
01069          MOVE "35" TO SEL-ERR (SUB6)                              DCRPT010
01070          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01071      IF RTBL-HDR-ENTTYPE NOT EQUAL TO SPACES                      DCRPT010
01072          MOVE "35" TO SEL-ERR (SUB6)                              DCRPT010
01073          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01074      MOVE "04" TO RTBL-QRYTYPE-23 (SUB6).                         DCRPT010
01075      GO TO 5000-BUILD-CAT-ID.                                     DCRPT010
01076 *                                                                 DCRPT010
01077 *      NAME RANGE QUERY VALIDATION                                DCRPT010
01078 *                                                                 DCRPT010
01079  1860-GET-NAME-RANGE.                                             DCRPT010
           IF WORK-40 NOT EQUAL TO "TO" 
01081          MOVE "04" TO RTBL-QRYTYPE-23 (SUB6)                         CL**2
01082          GO TO 4000-CHECK-USE-OUTPUT.                             DCRPT010
01083      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01084      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
01085      PERFORM 9900-VALIDATE-TYPE THRU 9599-VALIDATE-TYPE-XIT.      DCRPT010
01086      IF EDIT-SW EQUAL TO "Y"                                      DCRPT010
01087          MOVE "24" TO SEL-ERR (SUB6)                              DCRPT010
01088          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01089  1865-MOVE-RIGHT.                                                 DCRPT010
01090      MOVE WORK-40 TO RTBL-SEL2-TOCNAME (SUB6).                    DCRPT010
01091 *                                                                 DCRPT010
01092 *    BUILD S90, S95                                              *DCRPT010
01093 *                                                                 DCRPT010
01094      IF RTBL-SEL2-TOCNAME (SUB6)                                  DCRPT010
01095          GREATER THAN RTBL-OPT-CNAME (SUB6)                       DCRPT010
01096          GO TO 1870-BUILD-S90.                                    DCRPT010
01097      MOVE "65" TO SEL-ERR (SUB6).                                    CL**2
01098      GO TO 4200-PROCESS-AGAIN.                                    DCRPT010
01099  1870-BUILD-S90.                                                  DCRPT010
01100      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01101      IF EXTRA-SW EQUAL TO "Y"                                     DCRPT010
01102          MOVE "95" TO RTBL-QRYTYPE-23 (SUB6)                      DCRPT010
01103          GO TO 2000-EDIT-WITH.                                    DCRPT010
01104      MOVE "90" TO RTBL-QRYTYPE-23 (SUB6).                         DCRPT010
01105      GO TO 5000-BUILD-CAT-ID.                                     DCRPT010
01106                                                                    DCRPT01
01107 ************************************************                  DCRPT010
01108 *                                                                 DCRPT010
01109 *      ENTRY TYPE DESIGNATOR VALIDATION                           DCRPT010
01110 *                                                                 DCRPT010
01111 *************************************************************     DCRPT010
01112  1900-E-ENTTYPE.                                                  DCRPT010
01113      MOVE HOLD-ENTTYPE TO RTBL-SEL1-ENTTYPE (SUB6).               DCRPT010
01114      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01115      IF EXTRA-SW EQUAL TO "B" OR "C"                              DCRPT010
01116          MOVE "30" TO RTBL-QRYTYPE-23 (SUB6)                      DCRPT010
01117          GO TO 5000-BUILD-CAT-ID.                                 DCRPT010
01118      MOVE WORK-40 TO WORK-9.                                      DCRPT010
           IF WORK-9 EQUAL TO "WITH" OR "HAVING"
01120          GO TO 2000-EDIT-WITH.                                    DCRPT010
           IF WORK-9 NOT EQUAL TO "TO"
01122          MOVE "30" TO RTBL-QRYTYPE-23 (SUB6)                         CL**2
01123          GO TO 4000-CHECK-USE-OUTPUT.                             DCRPT010
01124 ************************************************                  DCRPT010
01125 *                                                                 DCRPT010
01126 *      ENTRY TYPE RANGE VALIDATION                                DCRPT010
01127 *                                                                 DCRPT010
01128 *************************************************                 DCRPT010
01129      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01130      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
01131      PERFORM 9900-VALIDATE-TYPE THRU 9599-VALIDATE-TYPE-XIT.      DCRPT010
01132      IF EDIT-SW EQUAL TO "N"                                      DCRPT010
01133          MOVE "30" TO SEL-ERR (SUB6)                              DCRPT010
01134          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01135      MOVE HOLD-ENTTYPE TO RTBL-SEL2-TOTYPE (SUB6).                DCRPT010
01136      IF RTBL-SEL1-ENTTYPE (SUB6) EQUAL TO RTBL-SEL2-TOTYPE (SUB6)    CL**2
01137          MOVE "49" TO SEL-ERR (SUB6)                                 CL**2
01138          GO TO 4200-PROCESS-AGAIN.                                   CL**2
01139      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01140      IF EXTRA-SW EQUAL TO "Y"                                     DCRPT010
01141          MOVE "85" TO RTBL-QRYTYPE-23 (SUB6)                      DCRPT010
01142          GO TO 2000-EDIT-WITH.                                    DCRPT010
01143      MOVE "80" TO RTBL-QRYTYPE-23 (SUB6).                         DCRPT010
01144      GO TO 5000-BUILD-CAT-ID.                                     DCRPT010
01145                                                                    DCRPT01
01146 *************************************************                 DCRPT010
01147 *                                                                 DCRPT010
01148 *     WITH CLAUSE VALIDATION                                      DCRPT010
01149 *                                                                 DCRPT010
01150 *************************************************                 DCRPT010
01151  2000-EDIT-WITH.                                                  DCRPT010
           IF WORK-40 NOT EQUAL TO "WITH" 
01153          GO TO 2300-EDIT-HAVE.                                    DCRPT010
01154      MOVE 01 TO TRANS-COUNT.                                      DCRPT010
01155  2100-FIELD-NAME-LOOP.                                            DCRPT010
01156      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01157      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
01158      IF WORK-40-A (9) NOT EQUAL TO SPACES                         DCRPT010
01159          MOVE "31" TO SEL-ERR (SUB6)                              DCRPT010
01160          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01161      MOVE WORK-40 TO RTBL-SEL1-FLDNO (SUB6, TRANS-COUNT).         DCRPT010
01162 *                                                                 DCRPT010
01163 *    GET  LOGICAL INDICATOR                                      *DCRPT010
01164 *                                                                 DCRPT010
01165      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01166      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
01167      MOVE WORK-40 TO WORK-3.                                      DCRPT010
01168      IF WORK-3 EQUAL TO "EQ" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
01169      IF WORK-3 EQUAL TO "GT" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
01170      IF WORK-3 EQUAL TO "LT" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
01171      IF WORK-3 EQUAL TO "NE" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
01172      IF WORK-3 EQUAL TO "N=" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
01173      IF WORK-3 EQUAL TO  "<" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
01174      IF WORK-3 EQUAL TO  "=" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
01175      IF WORK-3 EQUAL TO "CS" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
01176      IF WORK-3 EQUAL TO  ">" GO TO 2200-GET-FIELD-VALUE.          DCRPT010
           IF WORK-3 EQUAL TO ">=" GO TO 2200-GET-FIELD-VALUE.
           IF WORK-3 EQUAL TO "LE" GO TO 2200-GET-FIELD-VALUE.
           IF WORK-3 EQUAL TO "GE" GO TO 2200-GET-FIELD-VALUE.
           IF WORK-3 EQUAL TO "<=" GO TO 2200-GET-FIELD-VALUE.
01181 *                                                                 DCRPT010
01182 *    LOGICAL INDICATOR BAD                                       *DCRPT010
01183 *                                                                 DCRPT010
01184      MOVE "32" TO ERROR-CODE.                                     DCRPT010
01185      GO TO 4200-PROCESS-AGAIN.                                    DCRPT010
01186  2200-GET-FIELD-VALUE.                                            DCRPT010
01187      MOVE WORK-3 TO RTBL-SEL1-LOGIND (SUB6, TRANS-COUNT).         DCRPT010
01188      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01189      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
01190      MOVE WORK-40 TO RTBL-SEL1-FLDVALUE (SUB6, TRANS-COUNT).      DCRPT010
01191      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01192      IF EXTRA-SW EQUAL TO "B" OR "C"                              DCRPT010
01193          GO TO 3000-EDIT-WITH-END.                                DCRPT010
01194      IF TRANS-COUNT EQUAL TO 3  GO TO 3100-EDIT-WITH-MORE.        DCRPT010
           IF WORK-40 EQUAL TO "AND" OR "OR"
01196          MOVE WORK-40 TO RTBL-SEL1-ANDOR (SUB6, TRANS-COUNT)      DCRPT010
01197          ADD 1 TO TRANS-COUNT                                     DCRPT010
01198          GO TO 2100-FIELD-NAME-LOOP.                              DCRPT010
01199      GO TO 3100-EDIT-WITH-MORE.                                   DCRPT010
01200                                                                    DCRPT01
01201 ************************************************                  DCRPT010
01202 *                                                                 DCRPT010
01203 *      HAVING CLAUSE VALIDATION                                   DCRPT010
01204 *                                                                 DCRPT010
01205 ************************************************                  DCRPT010
01206  2300-EDIT-HAVE.                                                  DCRPT010
           IF WORK-40 NOT EQUAL TO "HAVING" 
01208          GO TO 4000-CHECK-USE-OUTPUT.                             DCRPT010
01209      MOVE "Y" TO PREFIX-B.                                        DCRPT010
01210      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01211      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
01212      MOVE WORK-40 TO WORK-3.                                      DCRPT010
01213 *                                                                    CL**2
01214 *     PROCESS CHANGE/NOCHANGE CLAUSES                                CL**2
01215 *        USER CAN SPECIFY JUST CHANGE/NOCHANGE OR HE CAN             CL**2
01216 *        FOLLOW WITH TEST OF LAST UPDATE, REV, DATES, INITIALS,      CL**2
01217 *        OR TIMES UPDATED.  ANY TEST CAN BE FOLLOWED BY              CL**2
01218 *        USE-OUTPUT CLAUSE.                                          CL**2
01219 *                                                                    CL**2
           IF WORK-3 EQUAL TO "CHA" OR "NOC"
01221          GO TO 2302-INIT-CHG.                                        CL**2
01222      GO TO 2500-CHECK-REF.                                           CL**2
01223  2302-INIT-CHG.                                                      CL**2
01224      MOVE WORK-3 TO TYPE-CHANGE-SW.                                  CL**2
01225      MOVE "N" TO TWO-VALUE-SW.                                       CL**2
01226      MOVE SPACES TO CHANGE-VALUE1.                                   CL**2
01227      MOVE SPACES TO CHANGE-VALUE2.                                   CL**2
01228      MOVE "$C" TO RTBL-SEL1-ENTNO (SUB6, 1).                         CL**2
01229      MOVE SPACES TO RTBL-SEL1-FLDVALUE (SUB6, 1).                    CL**2
01230      IF TYPE-CHANGE-SW EQUAL "N"                                     CL**2
01231          MOVE "NE" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01232      ELSE                                                            CL**2
01233          MOVE "EQ" TO RTBL-SEL1-LOGIND (SUB6, 1).                    CL**2
01234 *                                                                    CL**2
01235 *    DETERMINE NEXT WORD OF STATEMENT-DETERMINE TYPE                 CL**2
01236 *      OF TESTS TO BE DONE                                           CL**2
01237 *                                                                    CL**2
01238      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01239      IF EXTRA-SW EQUAL "B" OR "C"                                    CL**2
01240          GO TO 3000-EDIT-WITH-END.                                   CL**2
           IF WORK-40 EQUAL TO "USE-OUTPUT" 
01242          GO TO 4100-FOUND-USE-OUTPUT.                                CL**2
           IF WORK-40 EQUAL TO "LAST "
01244          MOVE "$L" TO RTBL-SEL1-ENTNO (SUB6, 1)                      CL**2
01245          GO TO 2385-CHECK-CHGEND.                                    CL**2
           IF WORK-40 EQUAL TO "ON "
01247          GO TO 2310-CHECK-REV.                                       CL**2
           IF WORK-40 EQUAL TO "BEFORE " AND
01249         TYPE-CHANGE-SW EQUAL "C"                                     CL**2
01250          MOVE "LT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01251          GO TO 2310-CHECK-REV.                                       CL**2
           IF WORK-40 EQUAL TO "BEFORE "
01253          MOVE "GT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01254          GO TO 2310-CHECK-REV.                                       CL**2
01255 *                                                                    CL**2
           IF WORK-40 EQUAL TO "AFTER "  AND
01257         TYPE-CHANGE-SW EQUAL "C"                                     CL**2
01258          MOVE "GT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01259          GO TO 2310-CHECK-REV.                                       CL**2
           IF WORK-40 EQUAL TO "AFTER " 
01261          MOVE "LT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01262          GO TO 2310-CHECK-REV.                                       CL**2
01263 *                                                                    CL**2
           IF WORK-40 EQUAL TO "BETWEEN " AND 
01265         TYPE-CHANGE-SW EQUAL "C"                                     CL**2
01266          MOVE "GT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01267          MOVE "LT" TO RTBL-SEL1-LOGIND (SUB6, 2)                     CL**2
01268          MOVE "Y" TO TWO-VALUE-SW                                    CL**2
01269          GO TO 2310-CHECK-REV.                                       CL**2
           IF WORK-40 EQUAL TO "BETWEEN " 
01271          MOVE "LT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01272          MOVE "GT" TO RTBL-SEL1-LOGIND (SUB6, 2)                     CL**2
01273          MOVE "Y" TO TWO-VALUE-SW                                    CL**2
01274          GO TO 2310-CHECK-REV.                                       CL**2
01275 *                                                                    CL**2
01276 *    FREQUENCEY                                                      CL**2
01277 *                                                                    CL**2
           IF WORK-40 EQUAL TO "MORE "
01279         AND TYPE-CHANGE-SW EQUAL "C"                                 CL**2
01280          MOVE "GT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01281          GO TO 2340-HAVE-FREQ-THAN.                                  CL**2
           IF WORK-40 EQUAL TO "MORE "
01283          MOVE "LT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01284          GO TO 2340-HAVE-FREQ-THAN.                                  CL**2
           IF WORK-40 EQUAL TO "LESS "  AND 
01286         TYPE-CHANGE-SW EQUAL "C"                                     CL**2
01287          MOVE "LT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01288          GO TO 2340-HAVE-FREQ-THAN.                                  CL**2
           IF WORK-40 EQUAL TO "LESS "
01290          MOVE "GT" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01291          GO TO 2340-HAVE-FREQ-THAN.                                  CL**2
           IF WORK-40 EQUAL TO "FROM "  AND 
01293         TYPE-CHANGE-SW EQUAL "C"                                     CL**2
01294          MOVE "GE" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01295          MOVE "LE" TO RTBL-SEL1-LOGIND (SUB6, 2)                     CL**2
01296          MOVE "Y" TO TWO-VALUE-SW                                    CL**2
01297          GO TO 2345-HAVE-FREQ.                                       CL**2
           IF WORK-40 EQUAL TO "FROM "
01299          MOVE "LE" TO RTBL-SEL1-LOGIND (SUB6, 1)                     CL**2
01300          MOVE "GE" TO RTBL-SEL1-LOGIND (SUB6, 2)                     CL**2
01301          MOVE "Y" TO TWO-VALUE-SW                                    CL**2
01302          GO TO 2345-HAVE-FREQ.                                       CL**2
           IF WORK-40 EQUAL TO "BY "
01304          GO TO 2380-HAVE-BY.                                         CL**2
01305      MOVE "$T" TO RTBL-SEL1-ENTNO (SUB6, 1).                         CL**2
01306      MOVE WORK-40 TO CHANGE-VALUE1.                                  CL**2
01307      GO TO 2350-CHECK-TIMES1.                                        CL**2
01308 *                                                                    CL**2
01309 *     EDIT HAVING CHANGED DATE/FREQ CLAUSES                          CL**2
01310 *                                                                    CL**2
01311  2310-CHECK-REV.                                                     CL**2
01312      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01313      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
           IF WORK-40 NOT EQUAL TO "REV " 
01315          MOVE "$D" TO RTBL-SEL1-ENTNO (SUB6, 1)                      CL**2
01316          GO TO  2315-RVALUE1.                                        CL**2
01317 *                                                                    CL**2
01318 *     ASSUME REV TEST                                                CL**2
01319 *                                                                    CL**2
01320      MOVE "$R" TO RTBL-SEL1-ENTNO (SUB6, 1)                          CL**2
01321      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01322      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
01323  2315-RVALUE1.                                                       CL**2
01324      MOVE WORK-40 TO CHANGE-VALUE1.                                  CL**2
01325      IF TWO-VALUE-SW EQUAL "N"                                       CL**2
01326          GO TO 2385-CHECK-CHGEND.                                    CL**2
01327      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01328      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
           IF WORK-40 NOT EQUAL TO "AND " 
01330          GO TO 2420-BAD-CHG.                                         CL**2
01331 *                                                                    CL**2
01332      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01333      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
01334      MOVE WORK-40 TO CHANGE-VALUE2.                                  CL**2
01335      GO TO 2385-CHECK-CHGEND.                                        CL**2
01336 *                                                                    CL**2
01337 *    EDIT CHANGED N TIMES CLAUSES                                    CL**2
01338 *                                                                    CL**2
01339  2340-HAVE-FREQ-THAN.                                                CL**2
01340      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01341      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
           IF WORK-40 NOT EQUAL TO "THAN "
01343          GO TO 2385-CHECK-CHGEND.                                    CL**2
01344  2345-HAVE-FREQ.                                                     CL**2
01345      MOVE "$T" TO RTBL-SEL1-ENTNO (SUB6, 1).                         CL**2
01346      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01347      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
01348      MOVE WORK-40 TO CHANGE-VALUE1.                                  CL**2
01349  2350-CHECK-TIMES1.                                                  CL**2
01350 *                                                                    CL**2
01351 *     CHECK VALUE 2                                                  CL**2
01352 *                                                                    CL**2
01353      IF TWO-VALUE-SW EQUAL "N"                                       CL**2
01354          GO TO 2360-CHECK-WORDTIMES.                                 CL**2
01355      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01356      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
           IF WORK-40 NOT EQUAL TO "TO "
01358          GO TO 2420-BAD-CHG.                                         CL**2
01359 *       GET THE 2ND VALUE                                            CL**2
01360      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01361      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
01362      MOVE WORK-40 TO CHANGE-VALUE2.                                  CL**2
01363 *       RETRIEVE THE WORD TIMES                                      CL**2
01364  2360-CHECK-WORDTIMES.                                               CL**2
01365      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01366      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
           IF WORK-40 NOT EQUAL TO "TIMES " 
01368          GO TO 2420-BAD-CHG.                                         CL**2
01369      GO TO 2385-CHECK-CHGEND.                                        CL**2
01370 *                                                                    CL**2
01371 *      PROCESS SINGLE BY CLAUSE                                      CL**2
01372 *                                                                    CL**2
01373  2380-HAVE-BY.                                                       CL**2
01374      MOVE "$B" TO RTBL-SEL1-ENTNO (SUB6, 1).                         CL**2
01375      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01376      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
01377      IF WORK-40-A (4) NOT EQUAL SPACE                                CL**2
01378          GO TO 2420-BAD-CHG.                                         CL**2
01379      MOVE WORK-40 TO RTBL-SEL1-FLDVALUE (SUB6, 1).                   CL**2
01380      GO TO 2400-CHGDONE.                                             CL**2
01381  2385-CHECK-CHGEND.                                                  CL**2
01382 *                                                                    CL**2
01383 *     VALIDATE END OF HAVING CHANGE CLAUSES-BY CAN BE USED           CL**2
01384 *        WITH ANY OF THEM-ALSO IF VALUES WERE INCUDED THEN           CL**2
01385 *        THEY MUST BE CHECKED.                                       CL**2
01386 *                                                                    CL**2
01387      IF CHANGE-VALUE2 NOT EQUAL SPACES                               CL**2
01388          PERFORM 2450-CHGVAL-CHECK THRU 2499-CHGVAL-CHECK-XIT        CL**2
01389        MOVE NUMERIC-CHANGE-VALUE TO RTBL-SEL1-FLDVALUE (SUB6, 2).    CL**2
01390      MOVE RTBL-SEL1-ENTNO (SUB6, 1) TO                               CL**2
01391           RTBL-SEL1-ENTNO (SUB6, 2).                                 CL**2
01392      IF CHANGE-VALUE1 NOT EQUAL SPACES                               CL**2
01393          MOVE CHANGE-VALUE1 TO CHANGE-VALUE2                         CL**2
01394          PERFORM 2450-CHGVAL-CHECK THRU 2499-CHGVAL-CHECK-XIT        CL**2
01395        MOVE NUMERIC-CHANGE-VALUE TO RTBL-SEL1-FLDVALUE (SUB6, 1).    CL**2
01396 *                                                                    CL**2
01397 *     CHECK FOR BY CLAUSE AFTER OTHERS                               CL**2
01398 *                                                                    CL**2
01399      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01400      IF EXTRA-SW EQUAL "B" OR "C"                                    CL**2
01401          GO TO 3000-EDIT-WITH-END.                                   CL**2
           IF WORK-40 NOT EQUAL TO "BY "
01403          GO TO 4000-CHECK-USE-OUTPUT.                                CL**2
01404      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01405      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.       CL**2
01406      IF WORK-40-A (4) NOT EQUAL SPACE                                CL**2
01407      GO TO 2420-BAD-CHG.                                             CL**2
01408      MOVE "$B" TO RTBL-SEL1-ENTNO (SUB6, 3).                         CL**2
01409      MOVE WORK-40 TO RTBL-SEL1-FLDVALUE (SUB6, 3).                   CL**2
01410 *                                                                    CL**2
01411 *     COMPLETE PROCESSING OF HAVING CHANGE CLAUSES                   CL**2
01412 *                                                                    CL**2
01413  2400-CHGDONE.                                                       CL**2
01414      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.       CL**2
01415      IF EXTRA-SW EQUAL "B" OR "C"                                    CL**2
01416          GO TO 3000-EDIT-WITH-END.                                   CL**2
01417      GO TO 4000-CHECK-USE-OUTPUT.                                    CL**2
01418  2420-BAD-CHG.                                                       CL**2
01419      MOVE "33" TO SEL-ERR (SUB6).                                    CL**2
01420      GO TO 4200-PROCESS-AGAIN.                                       CL**2
01421 *                                                                    CL**2
01422 *     VALIDATE HAVING CHANGE DATES/REVS AND TIMES VALUES             CL**2
01423 *                                                                    CL**2
01424  2450-CHGVAL-CHECK.                                                  CL**2
01425      MOVE ZEROES TO NUMERIC-CHANGE-VALUE.                            CL**2
01426      IF CV1-BYTE (7) NOT EQUAL SPACE                                 CL**2
01427          GO TO 2420-BAD-CHG.                                         CL**2
01428      MOVE 6 TO SUB9.                                                 CL**2
01429      MOVE 6 TO SUB10.                                                CL**2
01430  2455-FIND-NONSPACE.                                                 CL**2
01431      IF CV1-BYTE (SUB9) EQUAL SPACE                                  CL**2
01432          SUBTRACT 1 FROM SUB9                                        CL**2
01433          GO TO 2455-FIND-NONSPACE.                                   CL**2
01434  2460-MOVE-CHR.                                                      CL**2
01435      MOVE CV1-BYTE (SUB9) TO NCV-BYTE (SUB10).                       CL**2
01436      SUBTRACT 1 FROM SUB9.                                           CL**2
01437      SUBTRACT 1 FROM SUB10.                                          CL**2
01438      IF SUB9 EQUAL ZEROES                                            CL**2
01439          GO TO 2490-CK-NUMVAL.                                       CL**2
01440      GO TO 2460-MOVE-CHR.                                            CL**2
01441  2490-CK-NUMVAL.                                                     CL**2
01442      IF NUMERIC-CHANGE-VALUE NOT NUMERIC                             CL**2
01443          GO TO 2420-BAD-CHG.                                         CL**2
01444  2499-CHGVAL-CHECK-XIT.                                              CL**2
01445      EXIT.                                                           CL**2
01446 ***********************************************************          CL**2
01447 *     HAVING REFERENCE AND NOREFERENCE CLAUSES                       CL**2
01448 ***********************************************************          CL**2
01449  2500-CHECK-REF.                                                     CL**2
           IF WORK-3 EQUAL TO "REF" OR "NOR"
01451          GO TO 2400-TEST-CLAUSE.                                  DCRPT010
01452      GO TO 2700-HAVE-CATEGORY.                                    DCRPT010
01453  2400-TEST-CLAUSE.                                                DCRPT010
01454      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                   DCRPT010
01455          MOVE "33" TO SEL-ERR (SUB6)                                 CL**2
01456          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01457      IF RTBL-HDR-ENTTYPE NOT EQUAL TO SPACES                      DCRPT010
01458          MOVE "33" TO SEL-ERR (SUB6)                                 CL**2
01459          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
           IF WORK-3 EQUAL TO "REF" 
               MOVE "9999999" TO RTBL-SEL1-FLDNO (SUB6, 1)
               MOVE "EQ" TO RTBL-SEL1-LOGIND (SUB6, 1)
               MOVE "REFERENCE" TO RTBL-SEL1-FLDVALUE (SUB6, 1) 
01464          GO TO 2500-CK-TOO-MANY.                                  DCRPT010
           IF WORK-3 EQUAL TO "NOR" 
               MOVE "9999999" TO RTBL-SEL1-FLDNO (SUB6, 1)
               MOVE "NE" TO RTBL-SEL1-LOGIND (SUB6, 1)
               MOVE "REFERENCE" TO RTBL-SEL1-FLDVALUE (SUB6, 1) 
01469          GO TO 2500-CK-TOO-MANY.                                  DCRPT010
01470      GO TO 2700-HAVE-CATEGORY.                                    DCRPT010
01471  2500-CK-TOO-MANY.                                                DCRPT010
01472      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01473      IF EXTRA-SW EQUAL TO "Y"                                     DCRPT010
01474          MOVE "35" TO RTBL-QRYTYPE-23 (SUB6)                         CL**2
01475          GO TO 4000-CHECK-USE-OUTPUT.                             DCRPT010
01476      GO TO 3000-EDIT-WITH-END.                                    DCRPT010
01477 *                                                                 DCRPT010
01478 *    EXTRACT NEXT FIELD FROM HAVING CLAUSE                        DCRPT010
01479 *                                                                 DCRPT010
01480  2600-PERFORM-EXTRACT.                                            DCRPT010
01481      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01482      IF EXTRA-SW EQUAL TO "B" OR "C"                              DCRPT010
01483          GO TO 3000-EDIT-WITH-END.                                DCRPT010
01484      GO TO 3100-EDIT-WITH-MORE.                                   DCRPT010
01485 *                                                                 DCRPT010
01486 *      CATEGORY PRESENT OR MISSING                                DCRPT010
01487 *                                                                 DCRPT010
01488  2700-HAVE-CATEGORY.                                              DCRPT010
01489      MOVE 1 TO TRANS-COUNT.                                       DCRPT010
01490  2800-HAVE-CAT-LOOP.                                              DCRPT010
01491      PERFORM 9600-VALIDATE-CATEGORY THRU 9900-VALIDATE-CAT-XIT.   DCRPT010
01492      IF EDIT-SW EQUAL TO "N"                                      DCRPT010
01493          MOVE "33" TO SEL-ERR (SUB6)                              DCRPT010
01494          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01495      IF HOLD-CATEGORY GREATER THAN "994"                          DCRPT010
01496          MOVE "33" TO SEL-ERR (SUB6)                              DCRPT010
01497          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
           MOVE "EQ" TO RTBL-SEL1-LOGIND (SUB6, TRANS-COUNT). 
01499      MOVE HOLD-CATEGORY TO RTBL-SEL1-CATNO (SUB6, TRANS-COUNT).   DCRPT010
01500      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01501      IF EXTRA-SW EQUAL TO "B" OR "C"                              DCRPT010
01502          GO TO 3000-EDIT-WITH-END.                                DCRPT010
           IF WORK-40 NOT EQUAL TO "MISSING"
01504          GO TO 2900-CK-HAVE-CONTINUE.                             DCRPT010
           MOVE "NE" TO RTBL-SEL1-LOGIND (SUB6, TRANS-COUNT). 
01506      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01507      IF EXTRA-SW EQUAL TO "B" OR "C"                              DCRPT010
01508          GO TO 3000-EDIT-WITH-END.                                DCRPT010
01509  2900-CK-HAVE-CONTINUE.                                           DCRPT010
01510      IF TRANS-COUNT GREATER THAN 2                                DCRPT010
01511          GO TO 3100-EDIT-WITH-MORE.                               DCRPT010
01512      MOVE WORK-40 TO WORK-3.                                      DCRPT010
           IF WORK-3 EQUAL TO "AND" OR "OR" 
01514          NEXT SENTENCE    ELSE                                    DCRPT010
01515          GO TO 3100-EDIT-WITH-MORE.                               DCRPT010
01516      MOVE WORK-3 TO RTBL-SEL1-ANDOR (SUB6, TRANS-COUNT).          DCRPT010
01517      ADD 1 TO TRANS-COUNT.                                        DCRPT010
01518      PERFORM 6500-BYPASS-EXTRACT THRU 6599-BYPASS-EXTRACT-XIT.    DCRPT010
01519      PERFORM 6600-CHECK-SWITCHES THRU 6699-CHECK-SWITCHES-XIT.    DCRPT010
01520      MOVE WORK-40 TO WORK-3.                                      DCRPT010
01521      GO TO 2800-HAVE-CAT-LOOP.                                    DCRPT010
01525  3000-EDIT-WITH-END.                                              DCRPT010
01526      IF RTBL-QRYTYPE-23 (SUB6) EQUAL TO SPACES                    DCRPT010
01527          MOVE "35" TO RTBL-QRYTYPE-23 (SUB6).                     DCRPT010
01528      GO TO 5000-BUILD-CAT-ID.                                     DCRPT010
01529  3100-EDIT-WITH-MORE.                                             DCRPT010
01530      IF RTBL-QRYTYPE-23 (SUB6) NOT EQUAL TO SPACES                   CL**2
01531          MOVE "34" TO SEL-ERR (SUB6)                              DCRPT010
01532          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01533                                                                    DCRPT01
01534 ******************************************************************DCRPT010
01535 *    CHECK FOR "USE-OUTPUT" AT END OF SELECT                      DCRPT010
01536 ******************************************************************DCRPT010
01537  4000-CHECK-USE-OUTPUT.                                           DCRPT010
           IF WORK-40 EQUAL TO "USE-OUTPUT" 
01539          GO TO 4100-FOUND-USE-OUTPUT.                             DCRPT010
01540      MOVE "22" TO SEL-ERR (SUB6).                                 DCRPT010
01541      GO TO 4200-PROCESS-AGAIN.                                    DCRPT010
01542  4100-FOUND-USE-OUTPUT.                                           DCRPT010
01543      MOVE "Y" TO OUTPUT-SW.                                          CL**2
01544      IF RTBL-QRYTYPE-23 (SUB6) EQUAL TO SPACES                       CL**2
01545          MOVE "35" TO RTBL-QRYTYPE-23 (SUB6).                        CL**2
01546      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.         CL**2
01547      MOVE WORK-40 TO WORK-1.                                         CL**2
01548      IF WORK-1 NOT NUMERIC                                           CL**2
01549          MOVE "36" TO SEL-ERR (SUB6)                              DCRPT010
01550          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
01551      MOVE WORK-1 TO RTBL-USEOUT-NUM (SUB6).                          CL**2
01552      MOVE "F" TO ROUTINE-SW.                                         CL**2
01553      GO TO 5000-BUILD-CAT-ID.                                        CL**2
01554 *                                                                 DCRPT010
01555 *    PROCESS NEXT SELECT STARTS HERE                              DCRPT010
01556 *                                                                 DCRPT010
01557  4200-PROCESS-AGAIN.                                              DCRPT010
01558      IF SEL-ERR (SUB6) NOT EQUAL TO SPACES                        DCRPT010
01559          MOVE "Y" TO ERROR-CHECK.                                 DCRPT010
01560      ADD 1 TO SUB5.                                               DCRPT010
01561      IF SUB5 GREATER THAN LINKAGE-COUNT                           DCRPT010
01562          GO TO 5100-EDIT-END.                                     DCRPT010
01563      MOVE QRY-WORK (SUB5) TO HOLD-VALUE.                          DCRPT010
01564  4250-PROCESS-NEXT-SELECT.                                        DCRPT010
01565      MOVE ZERO TO SUB1.                                           DCRPT010
01566      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
           IF WORK-40 EQUAL TO "SEL" OR "SELECT"
01568          GO TO 1750-PROCESS-SELECT.                               DCRPT010
           IF WORK-40 EQUAL TO "OUT" OR "OUTPUT"
01570          GO TO 4300-BEGIN-OUTPUT.                                 DCRPT010
01571      MOVE "04" TO ERROR-CODE.                                     DCRPT010
01572      PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.              DCRPT010
01573      GO TO 5100-EDIT-END.                                         DCRPT010
01574 *                                                                 DCRPT010
01575 *    BEGIN PROCESSING OUTPUT STATEMENTS                           DCRPT010
01576 *                                                                 DCRPT010
01577  4300-BEGIN-OUTPUT.                                               DCRPT010
01578      MOVE "Y" TO OUTPUT-SW.                                          CL**2
01579      ADD 1 TO SUB8.                                                  CL**2
01580      MOVE ZERO TO SUB6.                                           DCRPT010
01581      IF SUB8 EQUAL TO 1                                              CL**2
01582          MOVE "N" TO PREFIX-A.                                       CL**2
01583      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01584      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01585          MOVE "37" TO OUTPUT-ERRORS (SUB8)                           CL**2
01586          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01587      MOVE WORK-40 TO WORK-1.                                         CL**2
01588      IF WORK-1 NOT NUMERIC                                           CL**2
01589          GO TO 4400-LIMIT-OUTPUT.                                 DCRPT010
01590      MOVE "Y" TO PREFIX-A.                                        DCRPT010
01591 *                                                                 DCRPT010
01592 *    CONFIRM CORRECT SELECT REFERENCED BY OUTPUT STATEMENT        DCRPT010
01593 *                                                                 DCRPT010
01594  4350-CONFIRM-NUMBER.                                             DCRPT010
01595      ADD 1 TO SUB6.                                               DCRPT010
01596      IF SUB6 GREATER THAN 9                                       DCRPT010
01597          MOVE "44" TO OUTPUT-ERRORS (SUB8)                           CL**2
01598          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01599      IF WORK-1 EQUAL TO RTBL-USEOUT-NUM (SUB6)                       CL**2
01600          GO TO 4450-LIMIT-OUTPUT-PROCESS.                         DCRPT010
01601      GO TO 4350-CONFIRM-NUMBER.                                   DCRPT010
01602 *                                                                 DCRPT010
01603 *    CONFIRM CORRECT ORDER OF NUMBERED OUTPUTS                    DCRPT010
01604 *                                                                 DCRPT010
01605  4400-LIMIT-OUTPUT.                                               DCRPT010
01606      IF PREFIX-A EQUAL TO "Y"                                     DCRPT010
01607          MOVE "38" TO OUTPUT-ERRORS (SUB8)                           CL**2
01608          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01609      GO TO 4550-CAT-EXTRACTED.                                    DCRPT010
01610  4450-LIMIT-OUTPUT-PROCESS.                                       DCRPT010
01611      IF SUB8 EQUAL TO 1                                              CL**2
01612          MOVE WORK-1 TO RTBL-OUTPUT-NUM (SUB8)                       CL**2
01613          GO TO 4500-EXTRACT-CAT-FIRST.                            DCRPT010
01614      SUBTRACT 1 FROM SUB8.                                           CL**2
01615      IF RTBL-OUTPUT-NUM (SUB8) EQUAL TO ZERO                         CL**2
01616          ADD 1 TO SUB8                                               CL**2
01617          MOVE WORK-1 TO RTBL-OUTPUT-NUM (SUB8)                       CL**2
01618          GO TO 4500-EXTRACT-CAT-FIRST.                            DCRPT010
01619      IF WORK-1 LESS THAN RTBL-OUTPUT-NUM (SUB8)                      CL**2
01620          MOVE "39" TO OUTPUT-ERRORS (SUB8)                           CL**2
01621          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01622      ADD 1 TO SUB8.                                                  CL**2
01623      MOVE WORK-1 TO RTBL-OUTPUT-NUM (SUB8).                          CL**2
01624 *                                                                 DCRPT010
01625 *    EXTRACT EITHER THE WORD "CAT" OR "CATEGORY"                  DCRPT010
01626 *                                                                 DCRPT010
01627  4500-EXTRACT-CAT-FIRST.                                          DCRPT010
01628      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01629      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01630          MOVE "37" TO OUTPUT-ERRORS (SUB8)                           CL**2
01631          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01632  4550-CAT-EXTRACTED.                                              DCRPT010
           IF WORK-40 EQUAL TO "CAT" OR "CATEGORY"
01634          GO TO 4600-CHECK-CATEGORY-TYPE.                          DCRPT010
01635      MOVE "37" TO OUTPUT-ERRORS (SUB8).                              CL**2
01636      GO TO 4900-GET-NEXT-OUTPUT.                                  DCRPT010
01637 *                                                                 DCRPT010
01638 *    EXTRACT THE NAME OF THE CATEGORY                             DCRPT010
01639 *                                                                 DCRPT010
01640  4600-CHECK-CATEGORY-TYPE.                                        DCRPT010
01641      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01642      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01643          MOVE "40" TO OUTPUT-ERRORS (SUB8)                           CL**2
01644          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01645      PERFORM 9600-VALIDATE-CATEGORY THRU 9900-VALIDATE-CAT-XIT.   DCRPT010
01646      IF EDIT-SW EQUAL TO "Y"                                      DCRPT010
01647          MOVE HOLD-CATEGORY TO RTBL-OUT-CAT (SUB8)                   CL**2
01648          GO TO 4650-DO-LIMITS.                                    DCRPT010
01649      MOVE "48" TO OUTPUT-ERRORS (SUB8).                              CL**2
01650      GO TO 4900-GET-NEXT-OUTPUT.                                  DCRPT010
01651 *                                                                 DCRPT010
01652 *    LIMIT CLAUSE PROCESSING (OUTPUT STATEMENT)                   DCRPT010
01653 *                                                                 DCRPT010
01654  4650-DO-LIMITS.                                                  DCRPT010
01655      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01656      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01657          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
           IF WORK-40 NOT EQUAL TO "FROM" 
01659          GO TO 4850-CHECK-LITERAL-FOR.                            DCRPT010
01660 *                                                                 DCRPT010
01661 *    FROM LINE PROCESSING                                         DCRPT010
01662 *                                                                 DCRPT010
01663      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01664      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01665          MOVE "41" TO OUTPUT-ERRORS (SUB8)                           CL**2
01666          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
           IF WORK-40 EQUAL TO "LINES" OR "LINE"
01668      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT ELSE  DCRPT010
01669          MOVE "41" TO OUTPUT-ERRORS (SUB8)                           CL**2
01670          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01671      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01672          MOVE "41" TO OUTPUT-ERRORS (SUB8)                           CL**2
01673          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01674  4700-EDIT-LINE-NO.                                               DCRPT010
01675      PERFORM 6000-JUSTIFY-NUMERIC THRU 6099-JUSTIFY-NUMERIC-XIT.  DCRPT010
01676      IF NUMERIC-WORK EQUAL TO SPACES                              DCRPT010
01677          MOVE "62" TO OUTPUT-ERRORS (SUB8)                           CL**2
01678          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01679      MOVE NUMERIC-WORK TO RTBL-OUT-FRLINE (SUB8).                    CL**2
01680      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01681      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01682          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01683 *                                                                 DCRPT010
01684 *    TO LINE NUMBER PROCESSING                                    DCRPT010
01685 *                                                                 DCRPT010
01686  4750-EDIT-TO.                                                    DCRPT010
           IF WORK-40 NOT EQUAL TO "TO" 
01688          GO TO 4850-CHECK-LITERAL-FOR.                            DCRPT010
01689      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01690      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01691          MOVE "41" TO OUTPUT-ERRORS (SUB8)                           CL**2
01692          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
           IF WORK-40 EQUAL TO "LINES" OR "LINE"
01694      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT ELSE  DCRPT010
01695          MOVE "41" TO OUTPUT-ERRORS (SUB8)                           CL**2
01696          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01697      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01698          MOVE "40" TO OUTPUT-ERRORS (SUB8)                           CL**2
01699          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01700  4800-EDIT-TO-LINE.                                               DCRPT010
01701      PERFORM 6000-JUSTIFY-NUMERIC THRU 6099-JUSTIFY-NUMERIC-XIT.  DCRPT010
01702      IF NUMERIC-WORK EQUAL TO SPACES                              DCRPT010
01703          MOVE "62" TO OUTPUT-ERRORS (SUB8)                           CL**2
01704          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01705      MOVE NUMERIC-WORK TO RTBL-OUT-TOLINE (SUB8).                    CL**2
01706      GO TO 4900-GET-NEXT-OUTPUT.                                  DCRPT010
01707 *                                                                 DCRPT010
01708 *     FOR LINES PROCESSING                                        DCRPT010
01709 *                                                                 DCRPT010
01710  4850-CHECK-LITERAL-FOR.                                          DCRPT010
           IF WORK-40 NOT EQUAL TO "FOR"
01712          MOVE "37" TO OUTPUT-ERRORS (SUB8)                           CL**2
01713          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01714      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01715      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01716          MOVE "41" TO OUTPUT-ERRORS (SUB8)                           CL**2
01717          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01718      PERFORM 6000-JUSTIFY-NUMERIC THRU 6099-JUSTIFY-NUMERIC-XIT.  DCRPT010
01719      IF NUMERIC-WORK EQUAL TO SPACES                              DCRPT010
01720          MOVE "62" TO OUTPUT-ERRORS (SUB8)                           CL**2
01721          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01722      MOVE NUMERIC-WORK TO RTBL-OUT-FORLINES (SUB8).                  CL**2
01723      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01724      IF EXTRA-SW EQUAL TO "N"                                     DCRPT010
01725          MOVE "41" TO OUTPUT-ERRORS (SUB8)                           CL**2
01726          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
           IF WORK-40 EQUAL TO "LINES" OR "LINE"
01728          GO TO 4900-GET-NEXT-OUTPUT.                              DCRPT010
01729      MOVE "41" TO OUTPUT-ERRORS (SUB8).                              CL**2
01730 *                                                                 DCRPT010
01731 *    EXTRACT NEXT OUTPUT CARD FROM HOLD AREA                      DCRPT010
01732 *                                                                 DCRPT010
01733  4900-GET-NEXT-OUTPUT.                                            DCRPT010
01734      MOVE ZERO TO SUB6.                                              CL**2
01735      IF OUTPUT-ERRORS (SUB8) NOT EQUAL TO SPACES                     CL**2
01736          MOVE "Y" TO ERROR-CHECK.                                 DCRPT010
01737      ADD 1 TO SUB5.                                               DCRPT010
01738      IF SUB5 GREATER THAN LINKAGE-COUNT                           DCRPT010
01739          ADD 1 TO SUB6                                               CL**2
01740          GO TO 5100-EDIT-END.                                     DCRPT010
01741      MOVE QRY-WORK (SUB5) TO HOLD-VALUE.                          DCRPT010
01742      GO TO 4250-PROCESS-NEXT-SELECT.                              DCRPT010
01743 *************************************************                 DCRPT010
01744 *************************************************                 DCRPT010
01745 *                                                                 DCRPT010
01746 *      END OF EDIT02 PROCESSING                                   DCRPT010
01747 *                                                                 DCRPT010
01748 *        PREFIX-B WILL EQUAL A "Y" IF A HAVING CLAUSE             DCRPT010
01749 ************************************************                  DCRPT010
01750 ***********************************************                   DCRPT010
01751  5000-BUILD-CAT-ID.                                               DCRPT010
01752      IF PREFIX-B EQUAL TO "N"                                     DCRPT010
01753          GO TO 5100-EDIT-END.                                     DCRPT010
01754      MOVE "N" TO PREFIX-B.                                        DCRPT010
01755      IF RTBL-QRYTYPE-3 (SUB6) EQUAL TO "5"                        DCRPT010
01756          MOVE "6" TO RTBL-QRYTYPE-3 (SUB6).                       DCRPT010
01757      IF RTBL-QRYTYPE-3 (SUB6) EQUAL TO "7"                        DCRPT010
01758          MOVE "8" TO RTBL-QRYTYPE-3 (SUB6).                       DCRPT010
01759  5100-EDIT-END.                                                   DCRPT010
01760      IF ROUTINE-SW EQUAL TO "F"                                      CL**2
01761          MOVE SPACES TO ROUTINE-SW                                   CL**2
01762          GO TO 4200-PROCESS-AGAIN.                                   CL**2
01763      IF EXTRA-SW EQUAL TO "B"                                     DCRPT010
01764          GO TO 4250-PROCESS-NEXT-SELECT.                          DCRPT010
01765      IF TITLE-LINK-HOLD EQUAL TO ZEROS                               CL**2
01766          MOVE "02" TO ERROR-CODE                                     CL**2
01767          PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.             CL**2
01768      IF ERROR-COUNT NOT EQUAL TO ZEROS                            DCRPT010
01769          MOVE "Y" TO ERROR-CHECK                                  DCRPT010
01770          GO TO 5600-REPORT-EDIT-END.                              DCRPT010
01771      IF RTBL-QRYTYPE-23 (SUB6) EQUAL TO SPACES                    DCRPT010
01772          GO TO 5600-REPORT-EDIT-END.                              DCRPT010
01773      IF ERROR-CHECK EQUAL TO "Y"                                     CL**2
01774          GO TO 5600-REPORT-EDIT-END.                                 CL**2
01775      MOVE ZERO TO SUB1.                                           DCRPT010
01776 *                                                                 DCRPT010
01777 *    CHANGE RTBL-QRYTYPE-23 TO ITS APPROPRIATE VALUE              DCRPT010
01778 *    DEPENDING ON TYPE OF SELECT REQUEST                          DCRPT010
01779 *                                                                 DCRPT010
01780  5200-TEST-ADDITION.                                              DCRPT010
01781      ADD 1 TO SUB1.                                               DCRPT010
01782      IF SUB1 GREATER THAN 9                                       DCRPT010
01783          GO TO 5600-REPORT-EDIT-END.                              DCRPT010
01784      IF RTBL-QRYTYPE-23 (SUB1) EQUAL TO SPACES                    DCRPT010
01785          GO TO 5600-REPORT-EDIT-END.                              DCRPT010
01786      IF RTBL-QRYTYPE-2 (SUB1) EQUAL TO "3"                        DCRPT010
01787          GO TO 5300-TEST-30.                                      DCRPT010
01788      GO TO 5200-TEST-ADDITION.                                    DCRPT010
01789 *                                                                 DCRPT010
01790 *    CHECK FOR VALID TYPE 30 SELECT                               DCRPT010
01791 *                                                                 DCRPT010
01792  5300-TEST-30.                                                    DCRPT010
01793      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                   DCRPT010
01794          GO TO 5400-TEST-HDR-RETRIEVE.                            DCRPT010
01795      IF RTBL-HDR-ENTITY NOT EQUAL TO SPACES                       DCRPT010
01796          GO TO 5500-TEST-HDR-RETRIEVE-B.                          DCRPT010
01797      GO TO 5200-TEST-ADDITION.                                    DCRPT010
01798  5400-TEST-HDR-RETRIEVE.                                          DCRPT010
01799      IF RTBL-HDR-RETRIEVE NOT EQUAL TO "U"                        DCRPT010
01800          MOVE "4" TO RTBL-QRYTYPE-2 (SUB1)                        DCRPT010
01801          GO TO 5200-TEST-ADDITION.                                DCRPT010
01802      MOVE "5" TO RTBL-QRYTYPE-2 (SUB1).                           DCRPT010
01803      GO TO 5200-TEST-ADDITION.                                    DCRPT010
01804  5500-TEST-HDR-RETRIEVE-B.                                        DCRPT010
01805      IF RTBL-HDR-RETRIEVE NOT EQUAL TO "U"                        DCRPT010
01806          MOVE "6" TO RTBL-QRYTYPE-2 (SUB1)                        DCRPT010
01807          GO TO 5200-TEST-ADDITION.                                DCRPT010
01808      MOVE "7" TO RTBL-QRYTYPE-2 (SUB1).                           DCRPT010
01809      GO TO 5200-TEST-ADDITION.                                    DCRPT010
01810  5600-REPORT-EDIT-END.                                            DCRPT010
01811      IF ERROR-CHECK EQUAL TO "Y"                                     CL**2
01812          GO TO 5650-SECOND-EDIT-END.                                 CL**2
01813 *                                                                    CL**2
01814 *    IF OUTPUT-SW IS EQUAL TO "Y"---OUTPUT STATEMENTS WERE FOUND     CL**2
01815 *        MUST PERFORM A CHECK OF CATEGORY UNIQUENESS                 CL**2
01816      IF OUTPUT-SW EQUAL TO "Y"                                       CL**2
01817          MOVE SUB8 TO SUB4                                           CL**2
01818          MOVE ZERO TO SUB1                                           CL**2
01819          MOVE 1 TO SUB2                                              CL**2
01820          PERFORM 6700-TEST-OUTPUT THRU 6799-TEST-OUTPUT-XIT          CL**2
01821          MOVE "N" TO OUTPUT-SW.                                      CL**2
01822 *                                                                 DCRPT010
01823 *    CALL THIRD EDIT MODULE                                       DCRPT010
01824 *                                                                 DCRPT010
01825  5650-SECOND-EDIT-END.                                               CL**2
01826      CLOSE MAST3.                                                 DCRPT010
           CALL "RPT020". 
01829 *****************************************************                CL**2
01830 *                                                                    CL**2
01831 *    WRITE RTBL AND USER PARAMS TO REQUEST FILE                      CL**2
01832 *        ONLY DO THIS IF NO ERROR-CONTROL PROG DOES I/O              CL**2
01833 *                                                                    CL**2
01834 **************************************************************       CL**2
01835  5700-WRITE-RPTREQ.                                                  CL**2
01836      IF ERROR-CHECK EQUAL TO "Y"                                     CL**2
01837          MOVE SPACES TO RPT-REQ-SEL-WA                               CL**2
           EXIT PROGRAM.
01839      ADD 1 TO RPT-REQ-COUNT.                                         CL**2
01840      GO TO 5810-FMT-HDR.                                             CL**2
01841  5800-REQWRITE-RETURN.                                               CL**2
01842      IF RPT-REQ-RECTYPE EQUAL TO "1"                                 CL**2
01843          GO TO 5820-FMT-OPT.                                         CL**2
01844      IF RPT-REQ-RECTYPE EQUAL TO "2"                                 CL**2
01845          GO TO 5830-FMT-SEL.                                         CL**2
01846      IF RPT-REQ-RECTYPE EQUAL TO 3                                   CL**2
01847          GO TO 5840-FMT-NXTSEL.                                      CL**2
01848      IF RPT-REQ-RECTYPE EQUAL TO 4                                   CL**2
01849          GO TO 5860-FMT-NXTOUT.                                      CL**2
01850      GO TO 5880-FMT-NXTPARAM.                                        CL**2
01851 *                                                                    CL**2
01852 *    FORMAT REQUEST HEADER RECORD-TYPE 1                             CL**2
01853 *                                                                    CL**2
01854  5810-FMT-HDR.                                                       CL**2
01855      MOVE 1 TO RTBL-HDR-RECTYPE.                                     CL**2
01856      MOVE RPT-REQ-COUNT TO RTBL-HDR-REQNO.                           CL**2
01857      MOVE 001 TO RTBL-HDR-REQSEQ.                                    CL**2
01858      MOVE RTBL-HDR-ENT TO RPT-REQ-HDR-WA.                            CL**2
01859      GO TO 5900-WRITE-GOBACK.                                        CL**2
01860 *                                                                    CL**2
01861 *    FORMAT OPTIONS RECORD- TYPE 2                                   CL**2
01862 *                                                                    CL**2
01863  5820-FMT-OPT.                                                       CL**2
01864      MOVE 2 TO RTBL-OPT-RECTYPE.                                     CL**2
01865      MOVE RPT-REQ-COUNT TO RTBL-OPT-REQNO.                           CL**2
01866      MOVE RTBL-HDR-REQTYPE TO RTBL-OPT-REQTYPE.                      CL**2
01867      MOVE 001 TO RTBL-OPT-RECSEQ.                                    CL**2
01868      MOVE RTBL-OPTIONS-ENT TO RPT-REQ-HDR-WA.                        CL**2
01869      GO TO 5900-WRITE-GOBACK.                                        CL**2
01870 *                                                                    CL**2
01871 *    FORMAT SELECTION RECORDS - TYPE 3 (10 OF THEM)                  CL**2
01872 *                                                                    CL**2
01873  5830-FMT-SEL.                                                       CL**2
01874      MOVE ZEROES TO RPT-SUB.                                         CL**2
01875  5835-FMT-SEL2.                                                      CL**2
01876      ADD 1 TO RPT-SUB.                                               CL**2
01877      MOVE RTBL-HDR-REQTYPE TO RTBL-SEL-REQTYPE (RPT-SUB).            CL**2
01878      MOVE 3 TO RTBL-SEL-RECTYPE (RPT-SUB).                           CL**2
01879      MOVE RPT-SUB TO RTBL-SEL-RECSEQ (RPT-SUB).                      CL**2
01880      MOVE RPT-REQ-COUNT TO RTBL-SEL-REQNO (RPT-SUB).                 CL**2
01881      IF RTBL-QRYTYPE-23 (RPT-SUB) NOT EQUAL TO SPACES                CL**2
01882          MOVE "S" TO RTBL-QRYTYPE-1 (RPT-SUB).                       CL**2
01883      MOVE RTBL-SELECTION-ENTRY (RPT-SUB) TO RPT-REQ-SEL-WA.          CL**2
01884      GO TO 5900-WRITE-GOBACK.                                        CL**2
01885  5840-FMT-NXTSEL.                                                    CL**2
01886      IF RPT-SUB LESS THAN 10                                         CL**2
01887          GO TO 5835-FMT-SEL2.                                        CL**2
01888 *                                                                    CL**2
01889 *    FORMAT RECORDS FOR OUTPUT STATEMENTS -TYPE 4 (9 OF THEM)        CL**2
01890 *                                                                    CL**2
01891      MOVE ZERO TO RPT-SUB.                                           CL**2
01892  5850-FMT-OUT.                                                       CL**2
01893      ADD 1 TO RPT-SUB.                                               CL**2
01894      MOVE RTBL-HDR-REQTYPE TO RTBL-OUT-REQTYPE (RPT-SUB).            CL**2
01895      MOVE RPT-REQ-COUNT TO RTBL-OUT-REQNO (RPT-SUB).                 CL**2
01896      MOVE 4 TO RTBL-OUT-RECTYPE (RPT-SUB).                           CL**2
01897      MOVE RPT-SUB TO RTBL-OUT-RECSEQ (RPT-SUB).                      CL**2
01898      MOVE SPACES TO RPT-REQ-OUT-WA.                                  CL**2
01899      MOVE RTBL-OUTPUT-ENTRIES (RPT-SUB) TO RPT-REQ-OUT-WA.           CL**2
01900      GO TO 5900-WRITE-GOBACK.                                        CL**2
01901  5860-FMT-NXTOUT.                                                    CL**2
01902      IF RPT-SUB LESS THAN 9                                          CL**2
01903          GO TO 5850-FMT-OUT.                                         CL**2
01904 *                                                                    CL**2
01905 *    FORMAT USER PARAMENTER RECORDS                                  CL**2
01906 *                                                                    CL**2
01907      MOVE 1 TO RPT-SUB.                                              CL**2
01908  5870-FMT-PARAM.                                                     CL**2
01909      MOVE RTBL-HDR-REQTYPE TO RPT-REQ-REQTYPE.                       CL**2
01910      MOVE RPT-REQ-COUNT TO RPT-REQ-REQNO.                            CL**2
01911      MOVE "6" TO RPT-REQ-RECTYPE.                                    CL**2
01912      MOVE RPT-SUB TO RPT-REQ-RECSEQ.                                 CL**2
01913      MOVE QRY-WORK (RPT-SUB) TO RPT-REQ-PARAM-STMT.                  CL**2
01914      GO TO 5900-WRITE-GOBACK.                                        CL**2
01915  5880-FMT-NXTPARAM.                                                  CL**2
01916      ADD 1 TO RPT-SUB.                                               CL**2
01917      IF RPT-SUB GREATER THAN 41                                      CL**2
01918          GO TO 5890-FINI.                                            CL**2
01919      IF QRY-WORK (RPT-SUB) EQUAL TO SPACES                           CL**2
01920          GO TO 5890-FINI.                                            CL**2
01921      GO TO 5870-FMT-PARAM.                                           CL**2
01922 *                                                                    CL**2
01923 *    RETURN TO CALLING MODULE FOR WRITE                              CL**2
01924 *                                                                    CL**2
01925  5890-FINI.                                                          CL**2
01926      MOVE SPACES TO RPT-REQ-SEL-WA.                                  CL**2
       5900-WRITE-GOBACK. 
           EXIT PROGRAM.
01929                                                                    DCRPT01
01930 ******************************************************************DCRPT010
01931 *                                                                 DCRPT010
01932 *    SUBROUTINES FOR PROGRAM GENERATION                           DCRPT010
01933 *                                                                 DCRPT010
01934 ******************************************************************DCRPT010
01935 ******************************************************************DCRPT010
01936 ******************************************************************DCRPT010
01937 *                                                                 DCRPT010
01938 *    JUSTIFY A NUMERIC LINE NUMBER                               *DCRPT010
01939 *                                                                 DCRPT010
01940 ******************************************************************DCRPT010
01941  6000-JUSTIFY-NUMERIC.                                            DCRPT010
01942      MOVE ZEROES TO NUMERIC-WORK.                                 DCRPT010
01943      MOVE 04 TO SUB4.                                             DCRPT010
01944      MOVE 04 TO SUB3.                                             DCRPT010
01945  6025-MOVE-LINE-LOOP.                                             DCRPT010
01946      IF WORK-40-A (SUB3) NOT EQUAL TO SPACES                      DCRPT010
01947          GO TO 6050-LINE-LOOP.                                    DCRPT010
01948      SUBTRACT 1 FROM SUB3.                                        DCRPT010
01949      GO TO 6025-MOVE-LINE-LOOP.                                   DCRPT010
01950  6050-LINE-LOOP.                                                  DCRPT010
01951      MOVE WORK-40-A (SUB3) TO NUM-WORKS (SUB4).                   DCRPT010
01952      SUBTRACT 1 FROM SUB3.                                        DCRPT010
01953      SUBTRACT 1 FROM SUB4.                                        DCRPT010
01954      IF SUB3 GREATER THAN ZERO                                    DCRPT010
01955          GO TO 6050-LINE-LOOP.                                    DCRPT010
01956      IF NUMERIC-WORK NUMERIC                                      DCRPT010
01957          GO TO 6099-JUSTIFY-NUMERIC-XIT.                          DCRPT010
01958  6075-BAD-NUMERIC.                                                DCRPT010
01959      MOVE SPACES TO NUMERIC-WORK.                                 DCRPT010
01960  6099-JUSTIFY-NUMERIC-XIT.                                        DCRPT010
01961      EXIT.                                                        DCRPT010
01962                                                                    DCRPT01
01963 *                                                                 DCRPT010
01964 *    TEST FOR SELECT STATEMENTS CONTINUATION                      DCRPT010
01965 *                                                                 DCRPT010
01966  6500-BYPASS-EXTRACT.                                             DCRPT010
01967      PERFORM 7000-EXTRACT-FIELD THRU 7999-EXTRACT-FIELD-XIT.      DCRPT010
01968      IF EXTRA-SW EQUAL TO "Y"                                     DCRPT010
01969          GO TO 6599-BYPASS-EXTRACT-XIT.                           DCRPT010
01970      ADD 1 TO SUB5.                                               DCRPT010
01971      IF SUB5 GREATER THAN LINKAGE-COUNT                           DCRPT010
01972          MOVE "C" TO EXTRA-SW                                     DCRPT010
01973          GO TO 6599-BYPASS-EXTRACT-XIT.                           DCRPT010
01974      MOVE QRY-WORK (SUB5) TO HOLD-VALUE.                          DCRPT010
01975      MOVE HOLD-VALUE TO WORK-1.                                   DCRPT010
01976      IF WORK-1 EQUAL TO SPACES                                    DCRPT010
01977          MOVE ZEROES TO SUB1                                         CL**2
01978          GO TO 6500-BYPASS-EXTRACT.                                  CL**2
01979      MOVE "B" TO EXTRA-SW.                                        DCRPT010
01980  6599-BYPASS-EXTRACT-XIT.                                         DCRPT010
01981      EXIT.                                                        DCRPT010
01982 *                                                                 DCRPT010
01983 *    THIS ROUTINE WILL VALIDATE THAT A LEGAL EXTRACT WAS MADE     DCRPT010
01984 *        EXTRA-SW = "Y"   EXTRACT WAS OK                          DCRPT010
01985 *        EXTRA-SW = "C"   EXTRACT IN ERROR-REQUEST PROCESSING OVERDCRPT010
01986 *        EXTRA SW = "B"   EXTRACT IN ERROR-MOVE PROCESSING TO GO  DCRPT010
01987 *                                                                 DCRPT010
01988  6600-CHECK-SWITCHES.                                             DCRPT010
01989      IF EXTRA-SW EQUAL TO "Y"                                     DCRPT010
01990          GO TO 6699-CHECK-SWITCHES-XIT.                           DCRPT010
01991      IF EXTRA-SW EQUAL TO "C"                                     DCRPT010
01992           MOVE "22" TO SEL-ERR (SUB6)                                CL**2
01993          GO TO 8299-BAD-ERROR.                                       CL**2
01994      IF EXTRA-SW EQUAL TO "B"                                     DCRPT010
01995          MOVE "22" TO SEL-ERR (SUB6)                              DCRPT010
01996          MOVE "Y" TO ERROR-CHECK                                     CL**2
01997          GO TO 4250-PROCESS-NEXT-SELECT.                             CL**2
01998  6699-CHECK-SWITCHES-XIT.                                         DCRPT010
01999      EXIT.                                                        DCRPT010
02000                                                                    DCRPT01
02001  6700-TEST-OUTPUT.                                                   CL**2
02002      ADD 1 TO SUB1.                                                  CL**2
02003      IF SUB1 EQUAL TO SUB4                                           CL**2
02004          GO TO 6799-TEST-OUTPUT-XIT.                                 CL**2
02005 *                                                                    CL**2
02006 *    TEST IF OUTPUT STATEMENT IS NUMBERED                            CL**2
02007 *                                                                    CL**2
02008      IF RTBL-OUTPUT-NUM (SUB1) NOT EQUAL TO ZERO                     CL**2
02009          MOVE "N" TO OUTPUT-SW.                                      CL**2
02010  6725-TEST-EQUALITY.                                                 CL**2
02011      ADD 1 TO SUB2.                                                  CL**2
02012      IF SUB2 GREATER THAN SUB4                                       CL**2
02013          GO TO 6730-SET-SUB.                                         CL**2
02014      IF SUB2 GREATER THAN 9                                          CL**2
02015          GO TO 6730-SET-SUB.                                         CL**2
02016      GO TO 6740-TEST-OUTPUT-SW.                                      CL**2
02017  6730-SET-SUB.                                                       CL**2
02018      MOVE SUB1 TO SUB2.                                              CL**2
02019      ADD 1 TO SUB2.                                                  CL**2
02020      IF SUB2 GREATER THAN SUB4                                       CL**2
02021          GO TO 6799-TEST-OUTPUT-XIT.                                 CL**2
02022      GO TO 6700-TEST-OUTPUT.                                         CL**2
02023  6740-TEST-OUTPUT-SW.                                                CL**2
02024      IF OUTPUT-SW EQUAL TO "N"                                       CL**2
02025          GO TO 6750-TEST-EQUAL-NUMBERS.                              CL**2
02026      GO TO 6775-TEST-EQUAL-CATS.                                     CL**2
02027 *                                                                    CL**2
02028 *    COMPARE TWO ADJACENT OUTPUT NUMBERS FOR EQUALITY                CL**2
02029 *                                                                    CL**2
02030  6750-TEST-EQUAL-NUMBERS.                                            CL**2
02031      IF RTBL-OUTPUT-NUM (SUB1) EQUAL TO RTBL-OUTPUT-NUM (SUB2)       CL**2
02032          GO TO 6775-TEST-EQUAL-CATS.                                 CL**2
02033      GO TO 6730-SET-SUB.                                             CL**2
02034 *                                                                    CL**2
02035 *    COMPARE CATEGORIES MAKING SURE NONE ARE USED MORE THAN ONCE     CL**2
02036 *                                                                    CL**2
02037  6775-TEST-EQUAL-CATS.                                               CL**2
02038      IF RTBL-OUT-CAT (SUB1) EQUAL TO RTBL-OUT-CAT (SUB2)             CL**2
02039          MOVE "66" TO ERROR-CODE                                     CL**2
02040          PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT              CL**2
02041          GO TO 5100-EDIT-END.                                        CL**2
02042      GO TO 6725-TEST-EQUALITY.                                       CL**2
02043  6799-TEST-OUTPUT-XIT.                                               CL**2
02044      EXIT.                                                           CL**2
02045                                                                    DCRPT01
02046 ******************************************************            DCRPT010
02047 *                                                                 DCRPT010
02048 *      EXTRACT A FIELD FROM HOLD AREA                             DCRPT010
02049 *                                                                 DCRPT010
02050 ******************************************************            DCRPT010
02051  7000-EXTRACT-FIELD.                                              DCRPT010
02052      MOVE ZERO TO SUB2.                                           DCRPT010
02053      MOVE SPACES TO WORK-40.                                      DCRPT010
02054      MOVE SPACES TO EDIT-SW.                                         CL**2
02055      MOVE "N" TO EXTRA-SW.                                        DCRPT010
02056  7100-START-TO-FIND.                                              DCRPT010
02057      ADD 1 TO SUB1.                                               DCRPT010
02058      IF SUB1 GREATER THAN 72                                      DCRPT010
02059          MOVE "M" TO EDIT-SW                                      DCRPT010
02060          GO TO 7999-EXTRACT-FIELD-XIT.                            DCRPT010
02061      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCRPT010
02062          GO TO 7100-START-TO-FIND.                                DCRPT010
02063 *                                                                 DCRPT010
02064 *    CHECK FOR = SIGN IN OPTION QUERY                             DCRPT010
02065 *                                                                 DCRPT010
02066  7200-MOVE-FIELD.                                                 DCRPT010
02067      IF WORK-VALUE (SUB1) EQUAL TO "="                            DCRPT010
               ADD 1 TO SUB1
               IF WORK-VALUE (SUB1) NOT EQUAL TO " "
                   SUBTRACT 1 FROM SUB1 
                   GO TO 7300-EXTRACT-SECOND
               ELSE 
                   SUBTRACT 1 FROM SUB1.
02069      ADD 1 TO SUB2.                                               DCRPT010
02070      MOVE WORK-VALUE (SUB1) TO WORK-40-A (SUB2).                  DCRPT010
02071      ADD 1 TO SUB1.                                               DCRPT010
02072      IF SUB1 GREATER THAN 72                                      DCRPT010
02073          GO TO 7900-END-FIELD-SEARCH.                             DCRPT010
02074      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCRPT010
02075          GO TO 7900-END-FIELD-SEARCH.                             DCRPT010
02076      GO TO 7200-MOVE-FIELD.                                       DCRPT010
02077 *                                                                 DCRPT010
02078 *    FOUND A FIELD TO RIGHT OF = SIGN IN OPTION QUERY             DCRPT010
02079 *                                                                 DCRPT010
02080  7300-EXTRACT-SECOND.                                             DCRPT010
02081      MOVE SPACES TO WORK-32.                                      DCRPT010
02082      MOVE ZERO TO SUB2.                                           DCRPT010
02083      MOVE "N" TO HAVE-SW.                                         DCRPT010
02084      MOVE "N" TO EDIT-SW.                                         DCRPT010
02085  7400-START-SECOND.                                               DCRPT010
02086      ADD 1 TO SUB1.                                               DCRPT010
02087      IF SUB1 GREATER THAN 72                                      DCRPT010
02088          MOVE "Y" TO EDIT-SW                                         CL**2
02089          GO TO 7900-END-FIELD-SEARCH.                             DCRPT010
02090      IF WORK-VALUE (SUB1) EQUAL TO QUOTES                         DCRPT010
02091          GO TO 7700-QUOTE-FIELD.                                  DCRPT010
02092      IF WORK-VALUE (SUB1) EQUAL TO ","                            DCRPT010
02093          GO TO 7900-END-FIELD-SEARCH.                             DCRPT010
02094      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCRPT010
02095          GO TO 7400-START-SECOND.                                 DCRPT010
02096 *                                                                 DCRPT010
02097 *    MOVE SECOND FIELD TO WORK-32                                 DCRPT010
02098 *                                                                 DCRPT010
02099  7500-MOVE-SECOND.                                                DCRPT010
02100      ADD 1 TO SUB2.                                               DCRPT010
02101      IF SUB2 GREATER THAN 33                                      DCRPT010
02102          GO TO 7900-END-FIELD-SEARCH.                             DCRPT010
02103      MOVE WORK-VALUE (SUB1) TO WORK-32-A (SUB2).                  DCRPT010
02104  7600-CHECK-FOR-COMMA.                                            DCRPT010
02105      ADD 1 TO SUB1.                                               DCRPT010
02106      IF SUB1 GREATER THAN 72                                      DCRPT010
02107          MOVE "Y" TO EDIT-SW                                      DCRPT010
02108          GO TO 7880-END-SECOND-SEARCH.                            DCRPT010
02109      IF WORK-VALUE (SUB1) EQUAL TO ","                            DCRPT010
02110          GO TO 7880-END-SECOND-SEARCH.                            DCRPT010
02111      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCRPT010
02112          MOVE "Y" TO EDIT-SW                                      DCRPT010
02113          GO TO 7880-END-SECOND-SEARCH.                            DCRPT010
02114      GO TO 7500-MOVE-SECOND.                                      DCRPT010
02115 *                                                                 DCRPT010
02116 *    EXTRACT A FIELD IN QUOTES                                    DCRPT010
02117 *                                                                 DCRPT010
02118  7700-QUOTE-FIELD.                                                DCRPT010
02119      ADD 1 TO SUB1.                                               DCRPT010
02120      IF SUB1 GREATER THAN 72                                      DCRPT010
02121          GO TO 7900-END-FIELD-SEARCH.                             DCRPT010
02122      IF WORK-VALUE (SUB1) EQUAL TO QUOTES                         DCRPT010
02123          GO TO 7600-CHECK-FOR-COMMA.                              DCRPT010
02124      ADD 1 TO SUB2.                                               DCRPT010
02125      MOVE WORK-VALUE (SUB1) TO WORK-32-A (SUB2).                  DCRPT010
02126      GO TO 7700-QUOTE-FIELD.                                      DCRPT010
02127  7880-END-SECOND-SEARCH.                                          DCRPT010
02128      MOVE "Y" TO HAVE-SW.                                         DCRPT010
02129  7900-END-FIELD-SEARCH.                                           DCRPT010
02130      MOVE "Y" TO EXTRA-SW.                                        DCRPT010
02131  7999-EXTRACT-FIELD-XIT.                                          DCRPT010
02132      EXIT.                                                        DCRPT010
02133                                                                    DCRPT01
02134 ******************************************************************DCRPT010
02135 *                                                                 DCRPT010
02136 *    PROCESS ERROR MESSAGES                                       DCRPT010
02137 *                                                                 DCRPT010
02138 ******************************************************************DCRPT010
02139  8200-BAD-ERROR-A.                                                DCRPT010
02140      MOVE "14" TO ERROR-CODE.                                        CL**2
02141  8250-BAD-ERROR-Y.                                                DCRPT010
02142      PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.              DCRPT010
02143      IF ROUTINE-SW EQUAL TO "A"                                   DCRPT010
02144          MOVE SPACES TO ROUTINE-SW                                DCRPT010
02145          GO TO 1675-MOVE-YES.                                     DCRPT010
02146  8299-BAD-ERROR.                                                  DCRPT010
02147      MOVE "03" TO ERROR-CODE.                                     DCRPT010
02148      PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.              DCRPT010
02149      GO TO 5100-EDIT-END.                                         DCRPT010
02150 *                                                                 DCRPT010
02151 *    BUILD ERROR TABLE WITH ERROR NUMBERS                         DCRPT010
02152 *        "Y" IN ERROR-CHECK TELLS THAT ERRORS EXIST               DCRPT010
02153 *                                                                 DCRPT010
02154  8300-ERROR-RTN.                                                  DCRPT010
02155      MOVE "Y" TO ERROR-CHECK.                                     DCRPT010
02156      ADD 1 TO ERROR-COUNT.                                        DCRPT010
02157      IF ERROR-COUNT GREATER THAN 20                               DCRPT010
02158          GO TO 8399-ERROR-RTN-XIT.                                DCRPT010
02159      MOVE ERROR-CODE TO ERROR-BUILD (ERROR-COUNT).                DCRPT010
02160      IF ROUTINE-SW EQUAL TO "A"                                   DCRPT010
02161          MOVE SPACES TO ROUTINE-SW                                DCRPT010
02162          GO TO 1675-MOVE-YES.                                     DCRPT010
02163  8399-ERROR-RTN-XIT.                                              DCRPT010
02164      EXIT.                                                        DCRPT010
02165  8500-CTL-ENTRY-ERR.                                              DCRPT010
02166      MOVE "45" TO ERROR-CODE.                                     DCRPT010
02167      PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.              DCRPT010
02168      GO TO 4200-PROCESS-AGAIN.                                    DCRPT010
02169  8600-CTL-CAT-ERR.                                                DCRPT010
02170      MOVE "46" TO ERROR-CODE.                                     DCRPT010
02171      PERFORM 8300-ERROR-RTN THRU 8399-ERROR-RTN-XIT.              DCRPT010
02172      IF HAVE-SW EQUAL TO "Y"                                      DCRPT010
02173          GO TO 4200-PROCESS-AGAIN.                                DCRPT010
02174      GO TO 8299-BAD-ERROR.                                        DCRPT010
02175                                                                    DCRPT01
02176 ******************************************************************DCRPT010
02177 *                                                                 DCRPT010
02178 *    SET GENERATION TABLE VALUES TO THEIR DEFAULT CODES           DCRPT010
02179 ******************************************************************DCRPT010
02180  8700-DEFAULT-CODE.                                               DCRPT010
02181      MOVE SPACES TO RTBL-HDR-STARTCNAME.                          DCRPT010
02182      MOVE SPACES TO RTBL-HDR-ENTTYPE.                             DCRPT010
02183      MOVE SPACES TO RTBL-HDR-IDXFNAME.                            DCRPT010
02184      MOVE SPACES TO RTBL-HDR-RETRIEVE.                            DCRPT010
02185      MOVE SPACES TO RTBL-HDR-RPTNAME.                             DCRPT010
02186      MOVE "Y" TO RTBL-OPT-REPORT.                                    CL**2
02187      MOVE 1 TO RTBL-OPT-SEQ.                                         CL**2
02188      MOVE SPACES TO RTBL-OPT-TITLE.                               DCRPT010
02189      MOVE "Y" TO RTBL-OPT-INDEX.                                  DCRPT010
02190      MOVE "Y" TO RTBL-OPT-NEWPAGE.                                DCRPT010
02191      MOVE "S" TO RTBL-OPT-FORMAT.                                 DCRPT010
02192      MOVE "Y" TO RTBL-OPT-UNREF.                                  DCRPT010
02193      MOVE "N" TO RTBL-OPT-DESC.                                   DCRPT010
02194      MOVE "-" TO RTBL-OPT-BRECHR.                                 DCRPT010
02195      MOVE "Y" TO RTBL-OPT-PRTREQ.                                 DCRPT010
02196      MOVE "N" TO RTBL-OPT-BOTMSG.                                    CL**2
02197      MOVE "Y" TO RTBL-OPT-SUMMARY.                                DCRPT010
02198      MOVE "Y" TO RTBL-OPT-DIRECT.                                 DCRPT010
02199      MOVE "Y" TO RTBL-OPT-INDIRECT.                               DCRPT010
02200      MOVE "Y" TO RTBL-OPT-DETAIL.                                 DCRPT010
02201      MOVE "N" TO RTBL-OPT-ORIGIN.                                 DCRPT010
02202      MOVE "N" TO RTBL-OPT-INDENT.                                 DCRPT010
02203      MOVE SPACES TO RTBL-OPT-STOPNAME.                            DCRPT010
02204      MOVE ZERO TO RTBL-OPT-LINES.                                 DCRPT010
02205  8799-DEFAULT-CODE-XIT.                                           DCRPT010
02206      EXIT.                                                        DCRPT010
02207                                                                    DCRPT01
02208 *                                                                 DCRPT010
02209 *    OPTIONS TAKEN FROM OPTION QUERY HAVING A CODE OF YES OR NO   DCRPT010
02210 *                                                                 DCRPT010
02211  8800-YES-NO.                                                     DCRPT010
02212      IF WORK-32 EQUAL TO "Y" OR "YES"                             DCRPT010
02213          MOVE "Y" TO HAVE-SW                                      DCRPT010
02214          GO TO 8899-YES-NO-XIT.                                   DCRPT010
02215      IF WORK-32 EQUAL TO "N" OR "NO"                              DCRPT010
02216          MOVE "N" TO HAVE-SW                                      DCRPT010
02217          GO TO 8899-YES-NO-XIT.                                   DCRPT010
02218      ADD 1 TO SUB7.                                                  CL**2
02219      MOVE WORK-40 TO SYNTAX-WORD (SUB7).                             CL**2
02220      MOVE "27" TO ERROR-CODE.                                     DCRPT010
02221      MOVE "A" TO ROUTINE-SW.                                      DCRPT010
02222      GO TO 8300-ERROR-RTN.                                        DCRPT010
02223  8899-YES-NO-XIT.                                                 DCRPT010
02224      EXIT.                                                        DCRPT010
02225 *                                                                 DCRPT010
02226 *    TEST FOR AND RIGHT JUSTIFY A NUMERIC FIELD                   DCRPT010
02227 *                                                                 DCRPT010
02228  8900-MOVE-NUMERIC.                                               DCRPT010
02229      MOVE ZEROS TO WORK-6.                                        DCRPT010
02230      MOVE 1 TO SUB2.                                              DCRPT010
02231      IF WORK-32-A (SUB2) NUMERIC GO TO 8925-TEST-LENGTH.          DCRPT010
02232      MOVE SPACES TO WORK-6.                                       DCRPT010
02233      GO TO 8999-MOVE-NUMERIC-XIT.                                 DCRPT010
02234  8925-TEST-LENGTH.                                                DCRPT010
02235      ADD 1 TO SUB2.                                               DCRPT010
02236      IF SUB2 GREATER THAN 7                                       DCRPT010
02237          MOVE WORK-40 TO SYNTAX-WORD (SUB7)                       DCRPT010
02238          MOVE "A" TO ROUTINE-SW                                   DCRPT010
02239          MOVE "28" TO ERROR-CODE                                  DCRPT010
02240          GO TO 8250-BAD-ERROR-Y.                                  DCRPT010
02241      IF WORK-32-A (SUB2) EQUAL TO SPACES                          DCRPT010
02242          MOVE 7 TO SUB4                                           DCRPT010
02243          GO TO 8950-EXTRACT-NUMERIC.                              DCRPT010
02244      GO TO 8925-TEST-LENGTH.                                      DCRPT010
02245  8950-EXTRACT-NUMERIC.                                            DCRPT010
02246      SUBTRACT 1 FROM SUB4.                                        DCRPT010
02247      SUBTRACT 1 FROM SUB2.                                        DCRPT010
02248      IF SUB2 EQUAL TO ZERO                                        DCRPT010
02249          GO TO 8999-MOVE-NUMERIC-XIT.                             DCRPT010
02250      MOVE WORK-32-A (SUB2) TO WORK-6A (SUB4).                     DCRPT010
02251      GO TO 8950-EXTRACT-NUMERIC.                                  DCRPT010
02252  8999-MOVE-NUMERIC-XIT.                                           DCRPT010
02253      EXIT.                                                        DCRPT010
02254                                                                    DCRPT01
02255 ******************************************************************DCRPT010
02256 *                                                                 DCRPT010
02257 *    VALIDATION BETWEEN NAMED ENTRY AND AN ENTRY TYPE             DCRPT010
02258 *                                                                 DCRPT010
02259 ******************************************************************DCRPT010
02260  9900-VALIDATE-TYPE.                                              DCRPT010
02261      MOVE WORK-40 TO ENTRY-NAME-WK.                               DCRPT010
02262      MOVE 01 TO ENT.                                              DCRPT010
02263      MOVE "Y" TO EDIT-SW.                                         DCRPT010
02264 *                                                                 DCRPT010
02265 *    CHECK FOR SPECIAL NAMES                                      DCRPT010
02266 *            DATA, PROCEDURES , ENTRIES                           DCRPT010
02267 *                                                                 DCRPT010
           IF ENTRY-NAME-WK EQUAL TO "GDA" OR "GDATA" 
02269          MOVE "97" TO HOLD-ENTTYPE                                DCRPT010
02270          GO TO 9599-VALIDATE-TYPE-XIT.                            DCRPT010
           IF ENTRY-NAME-WK EQUAL TO "GPR" OR "GPROCEDURE"
             OR "GPROCEDURES" 
02273          MOVE "98" TO HOLD-ENTTYPE                                DCRPT010
02274          GO TO 9599-VALIDATE-TYPE-XIT.                            DCRPT010
           IF ENTRY-NAME-WK EQUAL TO "ENT" OR "ENTRY" 
             OR "ENTRIES" 
02277          MOVE "99" TO HOLD-ENTTYPE                                DCRPT010
02278          GO TO 9599-VALIDATE-TYPE-XIT.                            DCRPT010
02279 *                                                                 DCRPT010
02280 *      RETRIEVE ENTRY RECORD FROM CONTROL FILE                    DCRPT010
02281 *                                                                 DCRPT010
           MOVE 3 TO CON-KEY. 
02283      READ MAST3 INVALID KEY                                       DCRPT010
02284          GO TO 8500-CTL-ENTRY-ERR.                                DCRPT010
02285 *                                                                 DCRPT010
02286 *    RETRIEVE A STANDARD NAME                                     DCRPT010
02287 *                                                                 DCRPT010
02288  9100-TYPE-LOOP.                                                  DCRPT010
02289      MOVE SPACES TO EDIT-ENT-NAME.                                DCRPT010
02290      MOVE CTL-ENTRY-NAME (ENT) TO EDIT-ENTNAME-FIRST8.            DCRPT010
02291      IF USER-ENTNAME-BYTE4 NOT EQUAL TO SPACE                     DCRPT010
02292          GO TO 9400-CK-FULL-ENTNAME.                              DCRPT010
02293 *                                                                 DCRPT010
02294 *    CHECK FOR MATCH ON 1ST 3 BYTES                               DCRPT010
02295 *                                                                 DCRPT010
02296      IF USER-ENTNAME-FIRST3 EQUAL TO ENT-NAME-3                   DCRPT010
02297          GO TO 9300-HAVE-ENT-NAME.                                DCRPT010
02298  9200-NEXT-CTL-ENT.                                               DCRPT010
02299      ADD 1 TO ENT.                                                DCRPT010
           IF ENT LESS THAN 18
02301          GO TO 9100-TYPE-LOOP.                                    DCRPT010
02302      GO TO 9500-NO-CTL-ENT.                                       DCRPT010
02303  9300-HAVE-ENT-NAME.                                              DCRPT010
02304      MOVE CTL-ENTRY-ID (ENT) TO HOLD-ENTTYPE.                     DCRPT010
02305      GO TO 9599-VALIDATE-TYPE-XIT.                                DCRPT010
02306 *                                                                 DCRPT010
02307 *    CHECK FOR MATCH ON FULL NAME OR PLURAL                       DCRPT010
02308 *                                                                 DCRPT010
02309  9400-CK-FULL-ENTNAME.                                            DCRPT010
02310      IF ENTRY-NAME-WK EQUAL TO EDIT-ENT-NAME                      DCRPT010
02311          GO TO 9300-HAVE-ENT-NAME.                                DCRPT010
           INSPECT EDIT-ENT-NAME REPLACING FIRST " " BY "S".
02313      IF ENTRY-NAME-WK EQUAL TO EDIT-ENT-NAME                      DCRPT010
02314          GO TO 9300-HAVE-ENT-NAME.                                DCRPT010
02315      GO TO 9200-NEXT-CTL-ENT.                                     DCRPT010
02316 *                                                                 DCRPT010
02317 *    WORD IS NOT AN ENTRY TYPE                                    DCRPT010
02318 *                                                                 DCRPT010
02319  9500-NO-CTL-ENT.                                                 DCRPT010
02320      MOVE "N" TO EDIT-SW.                                         DCRPT010
02321  9599-VALIDATE-TYPE-XIT.                                          DCRPT010
02322      EXIT.                                                        DCRPT010
02323                                                                    DCRPT01
02324 ***********************************************************       DCRPT010
02325 *                                                                 DCRPT010
02326 *    VALIDATE CATEGORY NAME REFERENCE                             DCRPT010
02327 *                                                                 DCRPT010
02328 *        MUST  BE STANDARD NAME, PLURAL OF STANDARD NAME,         DCRPT010
02329 *            FIRST 3 BYTES OF STANDARD NAME OR A SPECIAL          DCRPT010
02330 *             NAME                                                DCRPT010
02331 *                                                                 DCRPT010
02332 *********************************************************         DCRPT010
02333  9600-VALIDATE-CATEGORY.                                          DCRPT010
02334      MOVE WORK-40 TO CAT-NAME-WK.                                 DCRPT010
02335      MOVE 01 TO CAT.                                              DCRPT010
02336      MOVE "Y" TO EDIT-SW.                                         DCRPT010
02337 *                                                                 DCRPT010
02338 *    CHECK FOR SPECIAL NAMES                                      DCRPT010
02339 *                                                                 DCRPT010
           IF CAT-NAME-WK EQUAL TO "PEO" OR "PEOPLE"
02341          MOVE "995" TO HOLD-CATEGORY                              DCRPT010
02342          GO TO 9900-VALIDATE-CAT-XIT.                             DCRPT010
           IF CAT-NAME-WK EQUAL TO "ADM" OR "ADMINISTRATION"
02344          MOVE "996" TO HOLD-CATEGORY                              DCRPT010
02345          GO TO 9900-VALIDATE-CAT-XIT.                             DCRPT010
           IF CAT-NAME-WK EQUAL TO "CHA" OR "CHARACTERISTICS" 
02347          MOVE "997" TO HOLD-CATEGORY                              DCRPT010
02348          GO TO 9900-VALIDATE-CAT-XIT.                             DCRPT010
           IF CAT-NAME-WK EQUAL TO "COM" OR "COMPONENTS"
02350          MOVE "998" TO HOLD-CATEGORY                              DCRPT010
02351          GO TO 9900-VALIDATE-CAT-XIT.                             DCRPT010
           IF CAT-NAME-WK EQUAL TO "ALL"
02353          MOVE "999" TO HOLD-CATEGORY                              DCRPT010
02354          GO TO 9900-VALIDATE-CAT-XIT.                             DCRPT010
02355 *                                                                 DCRPT010
02356 *    CHECK FOR STANDARD NAME                                      DCRPT010
02357 *        RETRIEVE CATEGORY RECORD                                 DCRPT010
02358 *                                                                 DCRPT010
           MOVE 4 TO CON-KEY. 
02360      READ MAST3 INVALID KEY                                       DCRPT010
02361          GO TO 8600-CTL-CAT-ERR.                                  DCRPT010
02362  9650-CAT-LOOP.                                                   DCRPT010
02363      MOVE SPACES TO EDIT-CAT-NAME.                                DCRPT010
02364      MOVE CTL-CAT-NAME (CAT) TO EDIT-CATNAME-FIRST15.             DCRPT010
02365      IF USER-CATNAME-BYTE4 NOT EQUAL TO SPACE                     DCRPT010
02366          GO TO 9800-CK-FULL-CATNAME.                              DCRPT010
02367 *                                                                 DCRPT010
02368 *    CHECK FOR MATCH ON 1ST 3 BYTES                               DCRPT010
02369 *                                                                 DCRPT010
02370      IF USER-CATNAME-FIRST3 EQUAL TO CAT-NAME-3                   DCRPT010
02371          GO TO 9750-HAVE-CAT-NAME.                                DCRPT010
02372  9700-NEXT-CTL-CAT.                                               DCRPT010
02373      ADD 1 TO CAT.                                                DCRPT010
           IF CAT LESS THAN 36
02375          GO TO 9650-CAT-LOOP.                                     DCRPT010
02376      GO TO 9850-NO-CAT-ENT.                                       DCRPT010
02377  9750-HAVE-CAT-NAME.                                              DCRPT010
02378      MOVE CTL-CAT-ID (CAT) TO HOLD-CATEGORY                       DCRPT010
02379      GO TO 9900-VALIDATE-CAT-XIT.                                 DCRPT010
02380 *                                                                 DCRPT010
02381 *    CHECK FOR MATCH ON FULL NAME OR PLIRAL                       DCRPT010
02382 *                                                                 DCRPT010
02383  9800-CK-FULL-CATNAME.                                            DCRPT010
02384      IF CAT-NAME-WK EQUAL TO EDIT-CAT-NAME                        DCRPT010
02385          GO TO 9750-HAVE-CAT-NAME.                                DCRPT010
           INSPECT EDIT-CAT-NAME REPLACING FIRST " " BY "S".
02387      IF CAT-NAME-WK EQUAL TO EDIT-CAT-NAME                        DCRPT010
02388          GO TO 9750-HAVE-CAT-NAME.                                DCRPT010
02389      GO TO 9700-NEXT-CTL-CAT.                                     DCRPT010
02390 *                                                                 DCRPT010
02391 *     WORD IS NOT A CATEGORY NAME                                 DCRPT010
02392 *                                                                 DCRPT010
02393  9850-NO-CAT-ENT.                                                 DCRPT010
02394      MOVE "N" TO EDIT-SW.                                         DCRPT010
02395  9900-VALIDATE-CAT-XIT.                                           DCRPT010
02396      EXIT.                                                        DCRPT010
02397                                                                    DCRPT01
02398 *                                                                 DCRPT010
02399 *    REL FILES FROM WHICH NAMED TYPE WILL BE VALIDATED            DCRPT010
02400 *                                                                 DCRPT010
*CALL     RELALG                                                        DCRPT010
*CALL     RELCOM                                                        DCRPT010
