*DECK     DCRPT400
00001  IDENTIFICATION DIVISION.                                         10/05/78
       PROGRAM-ID. RPT400.
*CALL COPYRIGHT 
      *    THIS MODULE CONTROLS THE PRINTING FOR THE NAME ANALYSIS, 
      *    THE INDEX, AND THE RELATIONAL REPORTS. 
00009  ENVIRONMENT DIVISION.                                            DCRPT400
00010  CONFIGURATION SECTION.                                           DCRPT400
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00013  INPUT-OUTPUT SECTION.                                            DCRPT400
00014  FILE-CONTROL.                                                    DCRPT400
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CON-KEY
               USE "PRUF = YES".
00019  DATA DIVISION.                                                   DCRPT400
00020  FILE SECTION.                                                    DCRPT400
*CALL     MAST3FD                                                       DCRPT400
*CALL RPTCS 
*CALL     WRKSTG77                                                      DCRPT400
00023  77  RPT-EOF-SW              PICTURE X.                              CL**2
*CALL     EXTLINK                                                          CL**2
*CALL     EXTWORK4                                                         CL**2
*CALL     TESTWACOM                                                        CL**2
*CALL     MAST3DD1                                                      DCRPT400
*CALL     MAST1WS                                                          CL**2
00029  01  REPORT-HEADINGS.                                             DCRPT400
00030      03  HDG-1.                                                   DCRPT400
00031          05  FILLER              PICTURE X(16)  VALUE SPACE.      DCRPT400
00032          05  FILLER              PICTURE X(17)   VALUE            DCRPT400
00033         "NAME ANALYSIS BY ".                                         CL**2
00034          05  HDG-1-REQTYPE          PICTURE X(8).                    CL**2
00035          05  HDG-FOR                PICTURE X(5).                    CL**2
00036          05  HDG-1-CAT              PICTURE X(32).                   CL**2
00037          05  HDG-1-USAGE            PICTURE X(6).                    CL**2
00038      03  HDG-2.                                                   DCRPT400
00039          05 FILLER              PICTURE X  VALUE SPACE.              CL**2
00040          05  FILLER              PICTURE X(14)  VALUE             DCRPT400
00041          "NAME COMPONENT".                                        DCRPT400
00042          05  FILLER             PICTURE X(20)  VALUE SPACE.          CL**2
00043          05  FILLER              PICTURE X(12)  VALUE             DCRPT400
00044          "FULL CONTEXT".                                          DCRPT400
00045          05  FILLER              PICTURE X(22)  VALUE SPACE.         CL**2
00046          05  FILLER              PICTURE X(10)  VALUE             DCRPT400
00047          "ENTRY TYPE".                                            DCRPT400
00048          05  FILLER              PICTURE X(6)  VALUE SPACE.          CL**2
00049          05  FILLER              PICTURE X(19)  VALUE             DCRPT400
00050          "DATA CATALOGUE NAME".                                   DCRPT400
00051          05  FILLER              PICTURE X(15)  VALUE SPACE.         CL**2
00052          05  FILLER              PICTURE X(3)  VALUE              DCRPT400
00053          "CAT".                                                   DCRPT400
00054          05  FILLER              PICTURE X(6)  VALUE              DCRPT400
00055          "  LINE".                                                DCRPT400
00056      03  HDG-2A.                                                     CL**2
00057          05 FILLER               PICTURE X  VALUE SPACE.             CL**2
00058          05  FILLER              PICTURE X(14)  VALUE                CL**2
00059          "NAME COMPONENT".                                           CL**2
00060          05  FILLER              PICTURE X(20)  VALUE SPACE.         CL**2
00061          05  FILLER              PICTURE X(12)  VALUE                CL**2
00062          "FULL CONTEXT".                                             CL**2
00063          05  FILLER              PICTURE X(21)  VALUE SPACE.         CL**2
00064          05  FILLER              PICTURE X(10)  VALUE                CL**2
00065          "ENTRY TYPE".                                               CL**2
00066  01  DETAIL-LINES.                                                DCRPT400
00067      03  DET-1.                                                   DCRPT400
00068          05  FILLER              PICTURE X VALUE SPACE.           DCRPT400
00069          05  NAM-COMP            PICTURE X(32)  VALUE SPACE.      DCRPT400
00070          05  FILLER              PICTURE XX  VALUE SPACE.         DCRPT400
00071          05  FUL-COMP            PICTURE X(32)  VALUE SPACE.      DCRPT400
00072          05  FILLER              PICTURE XX  VALUE SPACE.         DCRPT400
00073          05  ENT-TYPE            PICTURE X(15)  VALUE SPACE.      DCRPT400
00074          05  FILLER              PICTURE X  VALUE SPACE.          DCRPT400
00075          05  DC-NAME             PICTURE X(32)  VALUE SPACE.      DCRPT400
00076          05  FILLER              PICTURE XX  VALUE SPACE.         DCRPT400
00077          05  CAT-INIT            PICTURE XXX VALUE SPACE.         DCRPT400
00078          05  FILLER              PICTURE X  VALUE SPACE.          DCRPT400
00079          05  LINE-NO             PICTURE X(4)  VALUE SPACE.       DCRPT400
00080          05  FILLER              PICTURE X(5)  VALUE SPACE.       DCRPT400
00081      03  DET-2.                                                   DCRPT400
00082          05  FILLER              PICTURE X(35)  VALUE SPACE.      DCRPT400
00083          05  FILLER              PICTURE X(5)  VALUE              DCRPT400
00084          "DESC=".                                                 DCRPT400
00085          05  DESC-1              PICTURE X(65)  VALUE SPACE.      DCRPT400
00086      03  DET-3.                                                   DCRPT400
00087          05  FILLER              PICTURE X(40)  VALUE SPACE.      DCRPT400
00088          05  DESC-2              PICTURE X(65)  VALUE SPACE.      DCRPT400
00089      03  DET-4.                                                   DCRPT400
00090          05  FILLER              PICTURE X(20)  VALUE SPACE.      DCRPT400
00091          05  E-O-P-MSG               PICTURE X(54)  VALUE SPACE.     CL**2
00092  01  RPT-HDG-L.                                                   DCRPT400
00093      03  HDG-1-L.                                                 DCRPT400
00094          05  FILLER              PICTURE X(37)  VALUE SPACE.      DCRPT400
00095          05  FILLER              PICTURE X(16)  VALUE             DCRPT400
00096          "INDEX REPORT BY ".                                      DCRPT400
00097          05  SN-NAME-1-L         PICTURE X(8)  VALUE SPACE.       DCRPT400
00098          05  HDG-IR-FOR             PICTURE X(5).                    CL**2
00099          05  HDG-IR-CAT             PICTURE X(32).                   CL**2
00100          05  HDG-IR-USAGE           PICTURE X(6).                    CL**2
00101      03  HDG-2-L.                                                    CL**2
00102          05  FILLER             PICTURE XX  VALUE SPACE.             CL**2
00103          05  FLD-1-L             PICTURE X(8)  VALUE SPACE.       DCRPT400
00104          05  FILLER              PICTURE X(26)  VALUE SPACE.         CL**2
00105          05  FILLER              PICTURE  X(10)  VALUE            DCRPT400
00106          "ENTRY TYPE".                                            DCRPT400
00107          05  FILLER             PICTURE X(7)  VALUE SPACE.           CL**2
00108          05  FILLER              PICTURE X(14)  VALUE             DCRPT400
00109          "CATALOGUE NAME".                                        DCRPT400
00110          05  FILLER              PICTURE X(20)  VALUE SPACE.         CL**2
00111          05  FILLER              PICTURE X(8)  VALUE              DCRPT400
00112          "CATEGORY".                                              DCRPT400
00113          05  FILLER              PICTURE X(10)  VALUE SPACE.         CL**2
00114          05  FILLER              PICTURE X(4)  VALUE              DCRPT400
00115          "LINE".                                                  DCRPT400
00116      03  HDG-2A-L.                                                   CL**2
00117          05  FILLER              PICTURE XX  VALUE SPACE.            CL**2
00118          05  FLD-1A-L            PICTURE X(8).                       CL**2
00119          05  FILLER              PICTURE X(26)  VALUE SPACE.         CL**2
00120          05  FILLER              PICTURE X(10)  VALUE                CL**2
00121          "ENTRY TYPE".                                               CL**2
00122          05  FILLER              PICTURE X(7)  VALUE SPACE.          CL**2
00123          05  FILLER              PICTURE X(14)  VALUE                CL**2
00124          "CATALOGUE NAME".                                           CL**2
00125  01  RPT-DET-L.                                                   DCRPT400
00126      03  DET-1-L.                                                 DCRPT400
00127          05  FILLER              PICTURE XX  VALUE SPACE.         DCRPT400
00128          05  FIELD-1-L           PICTURE X(32)  VALUE SPACE.      DCRPT400
00129          05  FILLER              PICTURE XX VALUE SPACE.          DCRPT400
00130          05  ENTTYPE-1-L         PICTURE X(15)  VALUE SPACE.      DCRPT400
00131          05  FILLER              PICTURE XX  VALUE SPACE.         DCRPT400
00132          05  CATNAME-1-L         PICTURE X(32)  VALUE SPACE.      DCRPT400
00133          05  FILLER              PICTURE XX VALUE SPACE.          DCRPT400
00134          05  CATTYPE-1-L         PICTURE X(15)  VALUE SPACE.      DCRPT400
00135          05  FILLER              PICTURE XX  VALUE  SPACE.        DCRPT400
00136          05  LINE-1-L            PICTURE X(4)  VALUE SPACE.       DCRPT400
00137      03  DET-2-L.                                                 DCRPT400
00138          05  FILLER              PICTURE X(20)  VALUE SPACE.      DCRPT400
00139          05  EOP-MSG-1-L         PICTURE X(54)  VALUE SPACE.      DCRPT400
00140  01  RPT-HDG-811.                                                 DCRPT400
00141      03  HDG-1-S.                                                 DCRPT400
00142          05  FILLER              PICTURE X(10)  VALUE             DCRPT400
00143          " INDEX BY ".                                            DCRPT400
00144          05  FLD-1-S             PICTURE X(8)  VALUE SPACE.       DCRPT400
00145          05  HDG-SIR-FOR            PICTURE X(5).                    CL**2
00146          05  HDG-SIR-CAT            PICTURE X(32).                   CL**2
00147          05  HDG-SIR-USAGE          PICTURE X(6).                    CL**2
00148      03  HDG-2-S.                                                 DCRPT400
00149          05  FLD-2-S             PICTURE X(8)  VALUE SPACE.       DCRPT400
00150          05  FILLER              PICTURE X(26)  VALUE SPACE.         CL**2
00151          05  FILLER              PICTURE X(10)  VALUE                CL**2
00152          "ENTRY TYPE".                                            DCRPT400
00153          05  FILLER            PICTURE X(4) VALUE SPACE.             CL**2
00154          05  FILLER              PICTURE X(14)  VALUE             DCRPT400
00155          "CATALOGUE NAME".                                        DCRPT400
00156  01  RPT-DET-811.                                                 DCRPT400
00157      03  DET-1-S.                                                 DCRPT400
00158          05  FIELD-1-S           PICTURE X(32)  VALUE SPACE.      DCRPT400
00159          05  FILLER              PICTURE XX  VALUE SPACE.         DCRPT400
00160          05  ENTTYPE-1-S         PICTURE X(12)  VALUE SPACE.      DCRPT400
00161          05  FILLER              PICTURE XX  VALUE SPACE.         DCRPT400
00162          05  CATNAME-1-S         PICTURE X(32)  VALUE SPACE.      DCRPT400
00163      03  DET-2-S.                                                 DCRPT400
00164          05  FILLER              PICTURE  X(13)  VALUE SPACE.     DCRPT400
00165          05  EOP-1-S             PICTURE X(54)  VALUE SPACE.      DCRPT400
00166      03  DET-3-EOF.                                               DCRPT400
00167          05  FILLER              PICTURE X(27)  VALUE SPACE.      DCRPT400
00168          05  FILLER              PICTURE X(24)  VALUE             DCRPT400
00169          "*** END OF REPORT ***".                                    CL**2
00170      03  OCCURANCE-LINE.                                             CL**2
00171          05  FILLER               PICTURE X(45)  VALUE SPACE.        CL**2
00172          05  FILLER              PICTURE X(26)  VALUE                CL**2
00173         "*** ABOVE VALUE REOCCURED ".                                CL**2
00174          05  OCC-CTR-PRINT     PICTURE ZZZ9 VALUE ZERO.              CL**2
00175          05  FILLER              PICTURE X(7)  VALUE                 CL**2
00176         " TIMES.".                                                   CL**2
00177  01  RELATIONAL-HEADINGS.                                            CL**2
00178      03  DASH-HDG.                                                DCRPT400
00179          05  DASH-1.                                              DCRPT400
00180              07  FILLER          PICTURE X(16)  VALUE             DCRPT400
00181              " ---------------".                                  DCRPT400
00182          05  ENTTYPE-HDG.                                         DCRPT400
00183              07  FILLER          PICTURE X  VALUE SPACE.          DCRPT400
00184              07  ENTRY-TYPE-HDG  PICTURE X(15)  VALUE SPACE.      DCRPT400
00185      03  REPORT-HEAD.                                             DCRPT400
00186          05  FILLER              PICTURE X(27)  VALUE SPACE.         CL**2
00187          05  REPORT-HDG          PICTURE X(45)  VALUE             DCRPT400
00188          "R E L A T E D   E N T R I E S   B Y   T Y P E".         DCRPT400
00189      03  DET-HDG-L.                                               DCRPT400
00190          05  CATORDATA-L         PICTURE X(14).                      CL**2
00191          05  FILLER              PICTURE X(108)  VALUE               CL**2
00192          "                      CATALOGUE NAME                       CL**2
00193 -        " REMARK         CATALOGUE NAME                REMARK".     CL**2
00194      03  DET-HDG-S.                                               DCRPT400
00195          05  CATORDATA-S         PICTURE X(14).                      CL**2
00196          05  FILLER              PICTURE X(63)   VALUE               CL**2
00197          "                      CATALOGUE NAME                       CL**2
00198 -        " REMARK".                                                  CL**2
00199      03  ENTRY-HEADER.                                               CL**2
00200          05  ENT-CATNAME         PICTURE X(32).                      CL**2
00201          05  FILLER              PICTURE X(34)  VALUE SPACE.         CL**2
00202          05  ENT-REMARK          PICTURE X(15)  VALUE SPACE.         CL**2
00203      03  UNDERLINE.                                                  CL**2
00204          05  FILLER              PICTURE X(20)  VALUE SPACE.         CL**2
00205          05  FILLER              PICTURE X(15)  VALUE                CL**2
00206         "---------------".                                           CL**2
00207      03  DETAIL-LINE-2.                                           DCRPT400
00208          05  FILLER              PICTURE X(20)  VALUE SPACE.      DCRPT400
00209          05  ENTRY-TYPE-DET      PICTURE X(15)  VALUE SPACE.      DCRPT400
00210          05  FILLER              PICTURE X  VALUE SPACE.          DCRPT400
00211          05  CATNAME-1-DET       PICTURE X(32)  VALUE SPACE.      DCRPT400
00212          05  FILLER              PICTURE X  VALUE SPACE.          DCRPT400
00213          05  REMARK-1-DET        PICTURE X(14)  VALUE SPACE.      DCRPT400
00214          05  FILLER              PICTURE X(3)  VALUE SPACE.       DCRPT400
00215          05  CATNAME-2-DET       PICTURE X(32)  VALUE SPACE.      DCRPT400
00216          05  FILLER              PICTURE X  VALUE SPACE.          DCRPT400
00217          05  REMARK-2-DET        PICTURE X(14)  VALUE SPACE.      DCRPT400
00218      03  CAT-LINE-DET.                                               CL**2
00219          05  FILLER              PICTURE X(20)  VALUE SPACE.         CL**2
00220          05  ENTRY-TYPE-DET-2    PICTURE X(15)  VALUE SPACE.         CL**2
00221          05  FILLER              PICTURE XX  VALUE SPACE.            CL**2
00222          05  ENTRY-NAME-DET-2    PICTURE X(32)  VALUE SPACE.         CL**2
00223          05  FILLER              PICTURE X  VALUE SPACE.             CL**2
00224          05  FILLER              PICTURE X(4)  VALUE "CAT=".         CL**2
00225          05  CAT-DET             PICTURE XXX  VALUE SPACE.           CL**2
00226          05  FILLER              PICTURE X  VALUE SPACE.             CL**2
00227          05  LINE-DET            PICTURE 9999  VALUE ZERO.           CL**2
00228      03  HDG-REL-1.                                                  CL**2
00229          05  FILLER              PICTURE X(22)  VALUE SPACE.         CL**2
00230          05  FILLER                 PICTURE X(21)  VALUE             CL**2
00231          "RELATIONAL REPORT BY ".                                    CL**2
00232          05  HDG-REL-REQTYPE        PICTURE X(8).                    CL**2
00233          05  HDG-REL-FOR            PICTURE X(5).                    CL**2
00234          05  HDG-REL-CAT            PICTURE X(32).                   CL**2
00235          05  HDG-REL-USAGE          PICTURE X(6).                    CL**2
00236  01  CONSTANT-SWITCHES.                                           DCRPT400
00237      03  OCC-CTR              PICTURE 9999  VALUE ZERO.              CL**2
00238      03  DESC-CT                 PICTURE 9999 VALUE ZERO.            CL**2
00239      03  CATTYPE                 PICTURE X(15)  VALUE SPACE.         CL**2
00240      03  ENTTYPE                 PICTURE X(15) VALUE SPACE.          CL**2
00241      03  CON-SUB                 PICTURE 99  VALUE ZERO.             CL**2
00242      03  CON2                    PICTURE 99  VALUE ZERO.             CL**2
00243      03  SUB1                    PICTURE 99  VALUE ZERO.             CL**2
00244      03  SUB2                    PICTURE 99  VALUE ZERO.             CL**2
00245      03  NO-PLURAL-SW            PICTURE X  VALUE "Y".               CL**2
00246      03  CAT-SEARCH              PICTURE 999  VALUE ZERO.            CL**2
00247      03  ENT-SEARCH              PICTURE 99  VALUE ZERO.             CL**2
00248      03  FIRST-TIME-SW           PICTURE X  VALUE "Y".               CL**2
00249      03  REF-SW                  PICTURE X  VALUE "N".               CL**2
00250      03  OLD-DEF                 PICTURE 99  VALUE ZERO.          DCRPT400
00251      03  OLD-REF                 PICTURE 99  VALUE ZERO.          DCRPT400
00252      03  USE-CON                 PICTURE X(13)  VALUE             DCRPT400
00253      "PARTIAL USAGE".                                                CL**2
00254      03  LAST-REL-NAME        PICTURE X(32).                         CL**2
00255      03  LAST-REFNAME          PICTURE X(32).                        CL**2
00256      03  NEW-REF-NAMES.                                              CL**2
00257          05  NEW-REL-NAME           PICTURE X(32).                   CL**2
00258          05  NEW-REL-REF-NAME       PICTURE X(32).                   CL**2
00259      03  OLD-REF-NAMES.                                              CL**2
00260          05  OLD-REL-NAME           PICTURE X(32).                   CL**2
00261          05  OLD-REL-REF-NAME       PICTURE X(32).                   CL**2
00262      03  USE-SAVE                PICTURE X(13)  VALUE SPACE.      DCRPT400
00263      03  ALIAS-CON               PICTURE X(8)  VALUE "ALIAS OF".  DCRPT400
00264      03  ALIASES-CON             PICTURE X(7)  VALUE "ALIASES".   DCRPT400
00265      03  CON-DEFINE              PICTURE X(7)  VALUE "DEFINED".   DCRPT400
00266      03   HDG-ENTTYPE          PICTURE X(15)  VALUE SPACE.           CL**2
00267  01  ERR-MESSAGES.                                                   CL**2
00268      03  NO-REF-MSG.                                                 CL**2
00269          05  FILLER            PICTURE X(20) VALUE SPACE.            CL**2
00270          05  FILLER            PICTURE X(34) VALUE                   CL**2
00271          "DCRPT-666-I * NO REFERENCE RECORDS".                       CL**2
00272      03  ERR-MSG2.                                                   CL**2
00273           05  FILLER           PICTURE X(20) VALUE SPACE.            CL**2
00274          05  FILLER            PICTURE X(35)  VALUE                  CL**2
00275         "DCRPT-667-I * NO RELATIONAL RECORDS".                       CL**2
00276      03  PLURAL-AREA.                                                CL**2
00277          05  PLURAL-BYTE    PICTURE X  OCCURS 15.                    CL**2
00278      03  SAVE-CON-ENTRY  OCCURS 15 TIMES.                            CL**2
00279          05  SAVE-CON-ENTRY-NAME  PICTURE X(15).                     CL**2
00280          05  SAVE-CON-ENTRY-ID    PICTURE XX.                        CL**2
00281      03  SAVE-CON-CAT  OCCURS 40 TIMES.                              CL**2
00282          05  SAVE-CAT-NAME          PICTURE X(15).                   CL**2
00283          05  SAVE-CAT-ID            PICTURE XXX.                     CL**2
00284      03  INDEX-VALUE-SAVE       PICTURE X(32)  VALUE SPACE.          CL**2
00285      03  INDEX-CAT-SAVE          PICTURE 999.                        CL**2
00286 *                                                                    CL**2
00287 *    HEADING LITERALS                                                CL**2
00288 *                                                                    CL**2
00289      03  LITERAL-1               PICTURE X(24)  VALUE                CL**2
00290          "REPORT DATE-".                                             CL**2
00291      03  LITERAL-2               PICTURE X(24)  VALUE                CL**2
00292          "DATE OF LAST REVISION-".                                   CL**2
00293      03  LITERAL-3               PICTURE X(5)  VALUE                 CL**2
00294          "PAGE-".                                                    CL**2
00295      03  LITERAL-4               PICTURE X(31)  VALUE                CL**2
00296          "D A T A   C A T A L O G U E   2".                          CL**2
00297      03  LITERAL-5               PICTURE X(25)  VALUE                CL**2
00298          "REVISION NUMBER-".                                         CL**2
00299      03  PROP-MSG.                                                   CL**2
00300          05  FILLER              PICTURE X(44)  VALUE                CL**2
               "DATA CATALOGUE 2                       V2.0-".
00302          05  FILLER              PICTURE X(30)  VALUE                CL**2
*CALL LEVEL 
00304      03  SAVE-CTL-NAME           PICTURE X(27).                      CL**2
00305      03  SAVE-CTL-DATE-UPD       PICTURE X(8).                       CL**2
00306      03  SAVE-CTL-REV-NUM        PICTURE S9(5)  .                  DCRPT40
00307      03  SAVE-CTL-LINES          PICTURE S99.                        CL**2
00308  01  PRINTER-LINE.                                                   CL**2
00309      03  PRINT-LINE.                                                 CL**2
00310          05  ACTUAL-PRT-CTL      PICTURE X.                          CL**2
00311          05  PRINT-DATA.                                             CL**2
00312              07  FILLER          PICTURE X(24).                      CL**2
00313              07  PRT-TITLE.                                          CL**2
00314              10  FILLER          PICTURE X(10).                      CL**2
00315              10  PRT-DC          PICTURE X(31).                      CL**2
00316              10  FILLER          PICTURE X(10).                      CL**2
00317              07  FILLER          PICTURE X(25).                      CL**2
00318              07  PRT-DATE1.                                          CL**2
00319              10  FILLER          PICTURE X(19).                      CL**2
00320              10  PRT-PAGE        PICTURE X(13).                      CL**2
00321      03  PRINT-LINE1  REDEFINES  PRINT-LINE.                         CL**2
00322          05  FILLER              PICTURE X(23).                      CL**2
00323          05  PRT-EOP-MSG.                                            CL**2
00324              07  FILLER          PICTURE X(17).                      CL**2
00325              07  PRT-USER-TITLE  PICTURE X(20).                      CL**2
00326              07  FILLER             PICTURE X(17).                   CL**2
00327          05  FILLER              PICTURE X(56).                      CL**2
00328      03  PRINT-LINE-811  REDEFINES  PRINT-LINE.                      CL**2
00329          05  FILLER              PICTURE X.                          CL**2
00330          05  PRT-PROP.                                               CL**2
00331              07  PRT-TITLE-811.                                      CL**2
00332              10  PRT-DC-811      PICTURE X(26).                      CL**2
00333              10  FILLER          PICTURE X(12).                      CL**2
00334              10  FILLER          PICTURE X(10).                      CL**2
00335              07  PRT-DATE1-811.                                      CL**2
00336              10  FILLER          PICTURE X(21).                      CL**2
00337              10  PRT-PAGE-811    PICTURE X(10).                      CL**2
00338              07  FILLER          PICTURE X(53).                      CL**2
00339          05  PRT-CONUSER-811  REDEFINES  PRT-PROP.                   CL**2
00340              07  CON-USER-811    PICTURE X(27).                      CL**2
00341              07  FILLER          PICTURE X(5).                       CL**2
00342              07  DATE1-811       PICTURE X(32).                      CL**2
00343              07  FILLER          PICTURE X(5).                       CL**2
00344              07  PAGE-811        PICTURE X(10).                      CL**2
00345              07  FILLER          PICTURE X(53).                      CL**2
00346                                                                    DCRPT40
00358                                                                    DCRPT40
00359  PROCEDURE DIVISION.                                              DCRPT400
00366 ******************************************************************DCRPT400
00367 ******************************************************************DCRPT400
00368 *                                                                 DCRPT400
00369 *    PROCESS RETURNS FROM CALLING MODULE                          DCRPT400
00370 *                                                                 DCRPT400
00371 ******************************************************************DCRPT400
00372 ******************************************************************DCRPT400
00373  0000-BEGIN.                                                      DCRPT400
00374      IF RTBL-MOD-REQ EQUAL TO "1"                                 DCRPT400
00375          GO TO DATA-READ-RETURN.                                  DCRPT400
00376      IF RTBL-MOD-REQ EQUAL "3"                                       CL**2
00377          GO TO READ-EXTRACT-RETURN.                                  CL**2
00378      IF RTBL-MOD-REQ EQUAL TO "4"                                 DCRPT400
00379          GO TO RPT-OUTPUT-RETURN.                                 DCRPT400
00380 ******************************************************************DCRPT400
00381 ******************************************************************DCRPT400
00382 *                                                                 DCRPT400
00383 *    INITIALIZATION                                               DCRPT400
00384 *                                                                 DCRPT400
00385 ******************************************************************DCRPT400
00386 ******************************************************************DCRPT400
00387      MOVE ZEROES TO SUB1.                                         DCRPT400
00388      MOVE ZEROES TO SUB2.                                         DCRPT400
00389      MOVE ZEROES TO CON-SUB.                                      DCRPT400
00390      MOVE ZEROES TO CON2.                                         DCRPT400
00391      MOVE ZEROES TO DESC-CT.                                      DCRPT400
00392      MOVE ZERO TO NSUB1.                                             CL**2
00393      MOVE SPACES TO REPORT-TITLE-LONG.                               CL**2
00394      MOVE ZERO TO OCC-CTR.                                           CL**2
00396      MOVE "N" TO RPT-EOF-SW.                                         CL**2
00397 *                                                                 DCRPT400
00398 *    BUILD ENTRY AND CATEGORY TABLE                               DCRPT400
00399 *                                                                 DCRPT400
00400      PERFORM CON-OPEN THRU CON-OPEN-XIT.                             CL**2
00401      MOVE 3 TO CON-ENTRY-FUNCTION.                                DCRPT400
00402      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT400
00403  0100-READ-CTL-REC-3.                                             DCRPT400
00404      ADD 1 TO CON-SUB.                                            DCRPT400
00405      MOVE CTL-ENTRY (CON-SUB) TO SAVE-CON-ENTRY (CON-SUB).           CL**2
           IF CON-SUB LESS THAN 18
00407          GO TO 0100-READ-CTL-REC-3.                               DCRPT400
00408      MOVE 4 TO CON-ENTRY-FUNCTION.                                DCRPT400
00409      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT400
00410  0150-READ-CTL-REC-4.                                             DCRPT400
00411      ADD 1 TO CON2.                                               DCRPT400
00412      MOVE CTL-CAT-NAME (CON2) TO SAVE-CAT-NAME (CON2).            DCRPT400
00413      MOVE CTL-CAT-ID (CON2) TO SAVE-CAT-ID (CON2).                DCRPT400
           IF CON2 LESS THAN 35 
00415          GO TO 0150-READ-CTL-REC-4.                               DCRPT400
00416 ******************************************************************DCRPT400
00417 ******************************************************************DCRPT400
00418 *                                                                 DCRPT400
00419 *    DETERMINE IF NAME ANALYSIS,INDEX OR RELATIONAL                  CL**2
00420 *                                                                 DCRPT400
00421 ******************************************************************DCRPT400
00422 ******************************************************************DCRPT400
00423  0250-DETERMINE-REP.                                              DCRPT400
00424      IF RTBL-HDR-REQTYPE EQUAL "RH"                               DCRPT400
00425          GO TO 1000-INDEX.                                        DCRPT400
00426      IF RTBL-HDR-REQTYPE EQUAL "RJ"                                  CL**2
00427          GO TO 2000-RELATIONAL.                                      CL**2
00428                                                                    DCRPT40
00429 ******************************************************************DCRPT400
00430 ******************************************************************DCRPT400
00431 *                                                                 DCRPT400
00432 *    NAME ANALYSIS REPORT                                         DCRPT400
00433 *                                                                 DCRPT400
00434 ******************************************************************DCRPT400
00435 ******************************************************************DCRPT400
00436  0275-INITIALIZE-HDGS.                                            DCRPT400
00437 *                                                                 DCRPT400
00438 *    INITIALIZE HEADINGS                                          DCRPT400
00439 *                                                                 DCRPT400
00440      MOVE RTBL-HDR-IDXFNAME TO HDG-1-REQTYPE.                        CL**2
00441      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                      CL**2
00442          MOVE RTBL-HDR-STARTCNAME TO HDG-1-CAT                       CL**2
00443          GO TO 0305-CHECK-USAGE.                                     CL**2
00444      IF RTBL-HDR-ENTTYPE NOT EQUAL TO SPACES                         CL**2
00445          MOVE RTBL-HDR-ENTTYPE TO ENT-SEARCH                         CL**2
00446          PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT                  CL**2
00447          MOVE ENTTYPE TO HDG-1-CAT                                   CL**2
00448          GO TO 0305-CHECK-USAGE.                                     CL**2
00449      MOVE SPACES TO HDG-FOR.                                         CL**2
00450      MOVE SPACES TO HDG-1-CAT.                                       CL**2
00451      MOVE SPACES TO HDG-1-USAGE.                                     CL**2
00452      GO TO 0320-INIT-PRINT.                                          CL**2
00453  0305-CHECK-USAGE.                                                   CL**2
00454      MOVE " FOR " TO HDG-FOR.                                        CL**2
00455      IF RTBL-HDR-RETRIEVE EQUAL "U"                                  CL**2
00456          MOVE " USAGE" TO HDG-1-USAGE                                CL**2
00457      ELSE                                                            CL**2
00458          MOVE SPACES TO HDG-1-USAGE.                                 CL**2
00459  0320-INIT-PRINT.                                                    CL**2
00460      MOVE SPACES TO STD-REPORT-REC.                               DCRPT400
00461      MOVE SPACES TO PRINT-LINE.                                   DCRPT400
00462      MOVE 1 TO PRT-CTL.                                           DCRPT400
00463      MOVE 99 TO LINE-CT.                                          DCRPT400
00464      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00465 *                                                                    CL**2
00466 *    READ FIRST RECORD FOR REPORT - CHECK IF DATA SELECTED           CL**2
00467 *                                                                    CL**2
00468      PERFORM READ-EXTRACT THRU READ-EXTRACT-XIT.                     CL**2
00469      IF RPT-EOF-SW EQUAL "Y"                                         CL**2
00470          GO TO 8000-NO-DETAIL-REC.                                   CL**2
00471      GO TO 0500-GET-DETAIL.                                          CL**2
00472 *                                                                 DCRPT400
00473 *    READ DETAIL RECORD                                           DCRPT400
00474 *                                                                 DCRPT400
00475  0400-READ-DETAIL-REC.                                            DCRPT400
00476      PERFORM READ-EXTRACT THRU READ-EXTRACT-XIT.                  DCRPT400
00477      IF RPT-EOF-SW EQUAL "Y"                                         CL**2
00478          GO TO 9000-END-REPORT.                                      CL**2
00479  0500-GET-DETAIL.                                                 DCRPT400
00480      MOVE NAME-NAMCOMP TO NAM-COMP.                               DCRPT400
00481      MOVE NAME-CATNAME TO DATA-ENTRY-NAME.                           CL**2
00482      MOVE NAME-ENTTYPE TO ENT-SEARCH.                                CL**2
00483      MOVE NAME-CAT TO CAT-SEARCH.                                 DCRPT400
00484      PERFORM 6000-GET-CAT THRU 6099-GET-ENT-XIT.                  DCRPT400
00485      MOVE ENTTYPE TO ENT-TYPE.                                    DCRPT400
00486      MOVE NAME-NAMFULL TO FUL-COMP.                               DCRPT400
00487      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00488          GO TO 550-PRINT.                                            CL**2
00489      MOVE NAME-LINE TO LINE-NO.                                      CL**2
00490      MOVE CATTYPE TO CAT-INIT.                                       CL**2
00491      MOVE NAME-CATNAME TO DC-NAME.                                   CL**2
00492  550-PRINT.                                                          CL**2
00493      MOVE DET-1 TO STD-REPORT-REC.                                DCRPT400
00494      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00495 *                                                                 DCRPT400
00496 *    PRINT DESCRIPTION IF OPTION SPECIFIED                        DCRPT400
00497 *                                                                 DCRPT400
00498  0600-CK-DESC.                                                    DCRPT400
00499      IF RTBL-OPT-DESC EQUAL "Y" OR "A"                               CL**2
00500          GO TO 0700-GET-DESC.                                     DCRPT400
00501      GO TO 0400-READ-DETAIL-REC.                                  DCRPT400
00502  0700-GET-DESC.                                                   DCRPT400
00503 *                                                                    CL**2
00504 *    READ MAST1 FOR DESCRIPTION LINES                                CL**2
00505 *                                                                    CL**2
00506      MOVE "030" TO DATA-ENTRY-CAT.                                DCRPT400
00507      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                DCRPT400
00508      IF DATA-RETURN-CODE NOT EQUAL "0"                            DCRPT400
00509          GO TO 0400-READ-DETAIL-REC.                              DCRPT400
00510      ADD 1 TO DESC-CT.                                            DCRPT400
00511      MOVE CAT-DETAIL TO DESC-1.                                   DCRPT400
00512      MOVE DET-2 TO STD-REPORT-REC.                                DCRPT400
00513      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00514  0800-READ-NEXT.                                                  DCRPT400
00515      IF DESC-CT EQUAL RTBL-OPT-LINES                              DCRPT400
00516          GO TO 0400-READ-DETAIL-REC.                              DCRPT400
00517      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.              DCRPT400
00518      IF DATA-RETURN-CODE NOT EQUAL "0"                            DCRPT400
00519          GO TO 0400-READ-DETAIL-REC.                              DCRPT400
00520      ADD 1 TO DESC-CT.                                            DCRPT400
00521      MOVE CAT-DETAIL TO DESC-2.                                   DCRPT400
00522      MOVE DET-3 TO STD-REPORT-REC.                                DCRPT400
00523      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00524      GO TO 0800-READ-NEXT.                                        DCRPT400
00525                                                                    DCRPT40
00526 ******************************************************************DCRPT400
00527 ******************************************************************DCRPT400
00528 *                                                                 DCRPT400
00529 *    INDEX REPORT                                                 DCRPT400
00530 *                                                                 DCRPT400
00531 ******************************************************************DCRPT400
00532 ******************************************************************DCRPT400
00533  1000-INDEX.                                                      DCRPT400
00534      MOVE SPACE TO INDEX-VALUE-SAVE.                                 CL**2
00535      MOVE ZERO TO INDEX-CAT-SAVE.                                    CL**2
00536      IF RTBL-OPT-FORMAT EQUAL "D"                                 DCRPT400
00537          MOVE "Y" TO 8BY11-FLAG                                   DCRPT400
00538          GO TO 1150-DOC-FORMAT.                                   DCRPT400
00539 *                                                                 DCRPT400
00540 *    INITIALIZE HEADINGS                                          DCRPT400
00541 *                                                                 DCRPT400
00542  1100-STD-FORMAT.                                                    CL**2
00543      MOVE RTBL-HDR-IDXFNAME TO SN-NAME-1-L.                          CL**2
00544      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                      CL**2
00545          MOVE RTBL-HDR-STARTCNAME TO HDG-IR-CAT                      CL**2
00546          GO TO 1105-CHECK-USAGE.                                     CL**2
00547      IF RTBL-HDR-ENTTYPE NOT EQUAL TO SPACES                         CL**2
00548          MOVE RTBL-HDR-ENTTYPE TO ENT-SEARCH                         CL**2
00549          PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT                  CL**2
00550          MOVE ENTTYPE TO HDG-IR-CAT                                  CL**2
00551          GO TO 1105-CHECK-USAGE.                                     CL**2
00552      MOVE SPACES TO HDG-IR-FOR.                                      CL**2
00553      MOVE SPACES TO HDG-IR-CAT.                                      CL**2
00554      MOVE SPACES TO HDG-IR-USAGE.                                    CL**2
00555      GO TO 1200-MOVE.                                                CL**2
00556  1105-CHECK-USAGE.                                                   CL**2
00557      MOVE " FOR " TO HDG-IR-FOR.                                     CL**2
00558      IF RTBL-HDR-RETRIEVE EQUAL "U"                                  CL**2
00559          MOVE " USAGE" TO HDG-IR-USAGE                               CL**2
00560      ELSE                                                            CL**2
00561          MOVE SPACES TO HDG-IR-USAGE.                                CL**2
00562      MOVE RTBL-HDR-IDXFNAME TO FLD-1-L FLD-1A-L.                     CL**2
00563      GO TO 1200-MOVE.                                                CL**2
00564  1150-DOC-FORMAT.                                                    CL**2
00565      MOVE RTBL-HDR-IDXFNAME TO FLD-1-S.                              CL**2
00566      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                      CL**2
00567          MOVE RTBL-HDR-STARTCNAME TO HDG-SIR-CAT                     CL**2
00568          GO TO 1155-CHECK-USAGE.                                     CL**2
00569      IF RTBL-HDR-ENTTYPE NOT EQUAL TO SPACES                         CL**2
00570          MOVE RTBL-HDR-ENTTYPE TO ENT-SEARCH                         CL**2
00571          PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT                  CL**2
00572          MOVE ENTTYPE TO HDG-SIR-CAT                                 CL**2
00573          GO TO 1155-CHECK-USAGE.                                     CL**2
00574      MOVE SPACES TO HDG-SIR-FOR.                                     CL**2
00575      MOVE SPACES TO HDG-SIR-CAT.                                     CL**2
00576      MOVE SPACES TO HDG-SIR-USAGE.                                   CL**2
00577      GO TO 1200-MOVE.                                                CL**2
00578  1155-CHECK-USAGE.                                                   CL**2
00579      MOVE " FOR " TO HDG-SIR-FOR.                                    CL**2
00580      IF RTBL-HDR-RETRIEVE EQUAL "U"                                  CL**2
00581          MOVE " USAGE" TO HDG-SIR-USAGE                              CL**2
00582      ELSE                                                            CL**2
00583          MOVE SPACES TO HDG-SIR-USAGE.                               CL**2
00584      MOVE RTBL-HDR-IDXFNAME TO FLD-2-S.                              CL**2
00585  1200-MOVE.                                                       DCRPT400
00586      MOVE SPACES TO STD-REPORT-REC.                               DCRPT400
00587      MOVE SPACES TO PRINT-LINE.                                   DCRPT400
00588      MOVE 1 TO PRT-CTL.                                           DCRPT400
00589      MOVE 99 TO LINE-CT.                                          DCRPT400
00590      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00591 *                                                                    CL**2
00592 *    READ-FIRST RECORD FOR REPORT - CHECK IF DATA SELECTED           CL**2
00593 *                                                                    CL**2
00594      PERFORM READ-EXTRACT THRU READ-EXTRACT-XIT.                     CL**2
00595      IF RPT-EOF-SW EQUAL "Y"                                         CL**2
00596          GO TO 8000-NO-DETAIL-REC.                                   CL**2
00597      GO TO 1300-FORMAT-DET-LINE.                                     CL**2
00598  1250-READ-DET-REC.                                               DCRPT400
00599      PERFORM READ-EXTRACT THRU READ-EXTRACT-XIT.                  DCRPT400
00600      IF RPT-EOF-SW EQUAL "Y"                                         CL**2
00601          GO TO 9000-END-REPORT.                                      CL**2
00602 *                                                                 DCRPT400
00603 *    FORMAT STANDARD DETAIL LINE                                  DCRPT400
00604 *                                                                 DCRPT400
00605  1300-FORMAT-DET-LINE.                                            DCRPT400
00606      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00607          GO TO 1400-FMT-LINE-S.                                   DCRPT400
00608      IF INDEX-VALUE EQUAL INDEX-VALUE-SAVE AND                       CL**2
00609          INDEX-CAT EQUAL INDEX-CAT-SAVE                              CL**2
00610          ADD 1 TO OCC-CTR                                            CL**2
00611          GO TO 1250-READ-DET-REC.                                    CL**2
00612      IF FIRST-REC-SW EQUAL "Y"                                       CL**2
00613          MOVE "N" TO FIRST-REC-SW                                    CL**2
00614          GO TO 1310-MOVE.                                            CL**2
00615      IF OCC-CTR EQUAL ZEROES                                         CL**2
00616          GO TO 1310-MOVE.                                            CL**2
00617      MOVE OCC-CTR TO OCC-CTR-PRINT.                                  CL**2
00618      MOVE OCCURANCE-LINE TO STD-REPORT-REC.                          CL**2
00619      MOVE ZERO TO OCC-CTR.                                           CL**2
00620      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00621      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00622  1310-MOVE.                                                          CL**2
00623      MOVE INDEX-CAT TO INDEX-CAT-SAVE.                               CL**2
00624      MOVE INDEX-VALUE TO INDEX-VALUE-SAVE.                           CL**2
00625      MOVE INDEX-VALUE TO FIELD-1-L.                               DCRPT400
00626      MOVE INDEX-CATNAME TO CATNAME-1-L.                              CL**2
00627      MOVE INDEX-ENTTYPE TO ENT-SEARCH.                               CL**2
00628      MOVE INDEX-CAT TO CAT-SEARCH.                                DCRPT400
00629      PERFORM 6000-GET-CAT THRU 6099-GET-ENT-XIT.                  DCRPT400
00630      MOVE ENTTYPE TO ENTTYPE-1-L.                                 DCRPT400
00631      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00632          GO TO 1320-PRINT.                                           CL**2
00633      MOVE INDEX-LINE TO LINE-1-L.                                    CL**2
00634      MOVE CATTYPE TO CATTYPE-1-L.                                    CL**2
00635  1320-PRINT.                                                         CL**2
00636      MOVE RPT-DET-L TO STD-REPORT-REC.                               CL**2
00637      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00638      GO TO 1250-READ-DET-REC.                                     DCRPT400
00639 *                                                                 DCRPT400
00640 *    FORMAT DOCUMENTATION DETAIL LINE                             DCRPT400
00641 *                                                                 DCRPT400
00642  1400-FMT-LINE-S.                                                 DCRPT400
00643      IF INDEX-VALUE EQUAL INDEX-VALUE-SAVE                           CL**2
00644          ADD 1 TO OCC-CTR                                            CL**2
00645          GO TO 1250-READ-DET-REC.                                    CL**2
00646      IF FIRST-REC-SW EQUAL "Y"                                       CL**2
00647          MOVE "N" TO FIRST-REC-SW                                    CL**2
00648          GO TO 1410-MOVE.                                            CL**2
00649      IF OCC-CTR EQUAL ZEROES                                         CL**2
00650          GO TO 1410-MOVE.                                            CL**2
00651      MOVE OCC-CTR TO OCC-CTR-PRINT.                                  CL**2
00652      MOVE OCCURANCE-LINE TO STD-REPORT-REC.                          CL**2
00653      MOVE ZERO TO OCC-CTR.                                           CL**2
00654      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00655      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00656  1410-MOVE.                                                          CL**2
00657      MOVE INDEX-VALUE TO INDEX-VALUE-SAVE.                           CL**2
00658      MOVE INDEX-VALUE TO FIELD-1-S.                               DCRPT400
00659      MOVE INDEX-CATNAME TO CATNAME-1-S.                           DCRPT400
00660      MOVE INDEX-ENTTYPE TO ENT-SEARCH.                               CL**2
00661      PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT.                  DCRPT400
00662      MOVE ENTTYPE TO ENTTYPE-1-S.                                 DCRPT400
00663      MOVE ZERO TO SUB2.                                           DCRPT400
00664      MOVE DET-1-S TO STD-REPORT-REC.                              DCRPT400
00665      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00666      GO TO 1250-READ-DET-REC.                                     DCRPT400
00667                                                                    DCRPT40
00668 ******************************************************************DCRPT400
00669 ******************************************************************DCRPT400
00670 *                                                                 DCRPT400
00671 *    RELATIONAL REPORT                                            DCRPT400
00672 *                                                                 DCRPT400
00673 ******************************************************************DCRPT400
00674 ******************************************************************DCRPT400
00675  2000-RELATIONAL.                                                 DCRPT400
00676 *                                                                 DCRPT400
00677 *    INITIALIZE HEADINGS                                          DCRPT400
00678 *                                                                 DCRPT400
00679      MOVE SPACES TO LAST-REL-NAME.                                   CL**2
00680      MOVE SPACES TO LAST-REFNAME.                                    CL**2
00681      MOVE RTBL-HDR-IDXFNAME TO HDG-REL-REQTYPE.                      CL**2
00682      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                      CL**2
00683          MOVE RTBL-HDR-STARTCNAME TO HDG-REL-CAT                     CL**2
00684          GO TO 2005-CHECK-USAGE.                                     CL**2
00685      IF RTBL-HDR-ENTTYPE NOT EQUAL TO SPACES                         CL**2
00686          MOVE RTBL-HDR-ENTTYPE TO ENT-SEARCH                         CL**2
00687          PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT                  CL**2
00688          MOVE ENTTYPE TO HDG-REL-CAT                                 CL**2
00689          GO TO 2005-CHECK-USAGE.                                     CL**2
00690      MOVE SPACES TO HDG-REL-FOR.                                     CL**2
00691      MOVE SPACES TO HDG-REL-CAT.                                     CL**2
00692      MOVE SPACES TO HDG-REL-USAGE.                                   CL**2
00693      GO TO 2008-INIT-PRINT.                                          CL**2
00694  2005-CHECK-USAGE.                                                   CL**2
00695      MOVE " FOR " TO HDG-REL-FOR.                                    CL**2
00696      IF RTBL-HDR-RETRIEVE EQUAL "U"                                  CL**2
00697          MOVE " USAGE" TO HDG-REL-USAGE                              CL**2
00698      ELSE                                                            CL**2
00699          MOVE SPACES TO HDG-REL-USAGE.                               CL**2
00700  2008-INIT-PRINT.                                                    CL**2
00701      MOVE SPACES TO DETAIL-LINE-2.                                   CL**2
00702      MOVE SPACES TO REPORT-TITLE-LONG.                            DCRPT400
00703      MOVE SPACES TO STD-REPORT-REC.                               DCRPT400
00704      MOVE SPACES TO PRINT-LINE.                                   DCRPT400
00705      MOVE 1 TO PRT-CTL.                                           DCRPT400
00706      MOVE 99 TO LINE-CT.                                          DCRPT400
00707 *                                                                    CL**2
00708 *    READ FIRST RECORD FOR REPORT - CHECK IF DATA SELECTED           CL**2
00709 *                                                                    CL**2
00710      PERFORM READ-EXTRACT THRU READ-EXTRACT-XIT.                     CL**2
00711      IF RPT-EOF-SW EQUAL "Y"                                         CL**2
00712          GO TO 8000-NO-DETAIL-REC.                                   CL**2
00713 *                                                                 DCRPT400
00714 *    PROCESS RECORD.                                              DCRPT400
00715 *                                                                 DCRPT400
00716      IF EXT-REL-FIELDS EQUAL TO SPACES                            DCRPT400
00717          GO TO 9100-ERR-MSG.                                      DCRPT400
00718      IF REL-RECCODE EQUAL "D"                                     DCRPT400
00719          GO TO 2100-DO-D.                                         DCRPT400
00720      GO TO 2300-DO-R.                                             DCRPT400
00721 *                                                                 DCRPT400
00722 *    READ RECORD                                                  DCRPT400
00723 *                                                                 DCRPT400
00724  2010-READ-EXTRACT.                                               DCRPT400
00725      PERFORM READ-EXTRACT THRU READ-EXTRACT-XIT.                  DCRPT400
00726      IF RPT-EOF-SW EQUAL "Y"                                         CL**2
00727          GO TO 9000-END-REPORT.                                      CL**2
00728      IF REL-RECCODE EQUAL "D"                                     DCRPT400
00729          GO TO 2100-DO-D.                                         DCRPT400
           IF REL-REFNAME NOT EQUAL LAST-REFNAME
00731          GO TO 2300-DO-R.                                            CL**2
00732      GO TO 2010-READ-EXTRACT.                                        CL**2
00733 *                                                                 DCRPT400
00734 *    PROCESS D TYPE RECORD                                        DCRPT400
00735 *                                                                 DCRPT400
00736  2100-DO-D.                                                       DCRPT400
00737      IF REL-NAME NOT EQUAL LAST-REL-NAME                             CL**2
00738          GO TO 2150-NEW-ID.                                          CL**2
00739 **********************                                               CL**2
00740 *     BYPASS DUPLICATE EXTRACTS                                      CL**2
00741 **********************                                               CL**2
00742  2120-BYPASS-R.                                                      CL**2
00743      PERFORM READ-EXTRACT THRU READ-EXTRACT-XIT.                     CL**2
00744      IF RPT-EOF-SW EQUAL "Y"                                         CL**2
00745          GO TO 9000-END-REPORT.                                      CL**2
00746      IF REL-RECCODE EQUAL "D"                                        CL**2
00747          GO TO 2100-DO-D.                                            CL**2
00748      GO TO 2120-BYPASS-R.                                            CL**2
00749  2150-NEW-ID.                                                        CL**2
00750      MOVE REL-NAME TO LAST-REL-NAME.                                 CL**2
00751      MOVE SPACES TO OLD-REF-NAMES.                                   CL**2
00752      MOVE SPACES TO NEW-REF-NAMES.                                   CL**2
00753      IF FIRST-TIME-SW EQUAL "Y"                                   DCRPT400
00754          MOVE "N" TO FIRST-TIME-SW                                DCRPT400
00755          MOVE REL-ENTTYPE TO ENT-SEARCH                           DCRPT400
00756          PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT               DCRPT400
00757          MOVE ENTTYPE TO HDG-ENTTYPE                                 CL**2
00758          GO TO 2120-CK-SEQ.                                       DCRPT400
00759      IF REF-SW NOT EQUAL "Y"                                      DCRPT400
00760           PERFORM 9200-NO-REF-MSG THRU 9299-NO-REF-MSG-XIT.          CL**2
00761      IF RTBL-OPT-FORMAT NOT EQUAL "S"                                CL**2
00762          GO TO 2110-SEQ-CHECK.                                       CL**2
00763      IF ENTTYPE EQUAL "---------------"                              CL**2
00764          MOVE ENTTYPE TO ENTRY-TYPE-DET                              CL**2
00765          MOVE DETAIL-LINE-2 TO STD-REPORT-REC                        CL**2
00766          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00767          MOVE SPACES TO DETAIL-LINE-2                                CL**2
00768          MOVE SPACES TO ENTTYPE                                      CL**2
00769          GO TO 2110-SEQ-CHECK.                                       CL**2
00770      IF ENTTYPE NOT EQUAL SPACES                                     CL**2
00771          MOVE DETAIL-LINE-2 TO STD-REPORT-REC                        CL**2
00772          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00773          MOVE SPACES TO DETAIL-LINE-2                                CL**2
00774          MOVE "---------------" TO ENTRY-TYPE-DET                    CL**2
00775          MOVE DETAIL-LINE-2 TO STD-REPORT-REC                        CL**2
00776          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00777          MOVE SPACE TO DETAIL-LINE-2                                 CL**2
00778          GO TO 2110-SEQ-CHECK.                                       CL**2
00779      IF CATNAME-1-DET NOT EQUAL SPACES                               CL**2
00780          MOVE DETAIL-LINE-2 TO STD-REPORT-REC                        CL**2
00781          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00782          MOVE SPACES TO DETAIL-LINE-2.                               CL**2
00783  2110-SEQ-CHECK.                                                     CL**2
00784      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
00785          MOVE REL-ENTTYPE TO ENT-SEARCH                              CL**2
00786          PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT                  CL**2
00787          GO TO 2130-MOVE-IT.                                         CL**2
00788      IF REL-ENTTYPE EQUAL OLD-DEF                                 DCRPT400
00789          GO TO 2130-MOVE-IT.                                         CL**2
00790      MOVE REL-ENTTYPE TO ENT-SEARCH.                                 CL**2
00791      PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT.                  DCRPT400
00792      MOVE ENTTYPE TO HDG-ENTTYPE.                                    CL**2
00793      IF RTBL-MOD-REQ EQUAL "5"                                       CL**2
00794          GO TO 8000-NO-DETAIL-REC.                                   CL**2
00795 *                                                                 DCRPT400
00796 *    CHECK SEQUENCE                                               DCRPT400
00797 *                                                                 DCRPT400
00798  2120-CK-SEQ.                                                     DCRPT400
00799      IF RTBL-OPT-SEQ NOT EQUAL "3"                                   CL**2
00800          MOVE HDG-ENTTYPE TO ENTRY-TYPE-HDG                          CL**2
00801          MOVE 99 TO LINE-CT                                          CL**2
00802          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00803  2130-MOVE-IT.                                                       CL**2
00804      MOVE REL-NAME TO ENT-CATNAME.                                   CL**2
00805      MOVE REL-ENTTYPE TO OLD-DEF.                                    CL**2
00806      MOVE "99" TO OLD-REF.                                           CL**2
00807      MOVE "N" TO REF-SW.                                             CL**2
00808  2140-FORMAT-FIELDS.                                                 CL**2
00809      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
00810          MOVE "Y" TO NO-PLURAL-SW                                    CL**2
00811          MOVE REL-ENTTYPE TO ENT-SEARCH                              CL**2
00812          PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT                  CL**2
00813          MOVE "N" TO NO-PLURAL-SW                                    CL**2
00814          MOVE ENTTYPE TO ENT-REMARK                                  CL**2
00815      ELSE                                                            CL**2
00816          MOVE SPACES TO ENT-REMARK.                                  CL**2
00817      MOVE ENTRY-HEADER TO STD-REPORT-REC.                            CL**2
00818      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00819 *                                                                    CL**2
00820 *    PRINT DEFINE LINE IF OTHER THAN CATNAME                         CL**2
00821 *                                                                    CL**2
00822      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00823          GO TO 2010-READ-EXTRACT.                                    CL**2
00824      MOVE CON-DEFINE TO ENTRY-TYPE-DET-2.                            CL**2
00825      MOVE REL-CATNAME TO ENTRY-NAME-DET-2.                           CL**2
00826      MOVE REL-CAT TO CAT-SEARCH.                                     CL**2
00827      PERFORM 6000-GET-CAT THRU 6099-GET-ENT-XIT.                     CL**2
00828      MOVE CATTYPE TO CAT-DET.                                        CL**2
00829      MOVE REL-LINE TO LINE-DET.                                      CL**2
00830      MOVE CAT-LINE-DET TO STD-REPORT-REC.                            CL**2
00831      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00832      MOVE UNDERLINE TO STD-REPORT-REC.                               CL**2
00833      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00834      GO TO 2010-READ-EXTRACT.                                        CL**2
00835  2300-DO-R.                                                          CL**2
00836      MOVE REL-REFNAME TO LAST-REFNAME.                               CL**2
00837      MOVE "Y" TO REF-SW.                                             CL**2
00838      IF REL-USAGE EQUAL "P"                                          CL**2
00839          MOVE USE-CON TO USE-SAVE.                                   CL**2
00840      IF REL-REFTYPE EQUAL OLD-REF                                    CL**2
00841          GO TO 2350-PRINT-LINE.                                      CL**2
00842      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00843          GO TO 2320-TEST-D.                                          CL**2
00844      IF ENTTYPE EQUAL "---------------"                              CL**2
00845          MOVE ENTTYPE TO ENTRY-TYPE-DET                              CL**2
00846          GO TO 2310-LAST-REF.                                        CL**2
00847      IF CATNAME-1-DET EQUAL SPACES                                   CL**2
00848          GO TO 2323-CVT-ENTTYPE.                                     CL**2
00849  2310-LAST-REF.                                                      CL**2
00850      MOVE DETAIL-LINE-2 TO STD-REPORT-REC.                           CL**2
00851      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00852      MOVE SPACES TO ENTRY-TYPE-DET.                                  CL**2
00853      MOVE SPACES TO CATNAME-1-DET.                                   CL**2
00854      MOVE SPACES TO CATNAME-2-DET.                                   CL**2
00855      MOVE SPACES TO REMARK-1-DET.                                    CL**2
00856      MOVE SPACES TO REMARK-2-DET.                                    CL**2
00857      IF ENTTYPE EQUAL SPACES                                         CL**2
00858          GO TO 2323-CVT-ENTTYPE.                                     CL**2
00859      IF ENTTYPE EQUAL "---------------"                              CL**2
00860          GO TO 2323-CVT-ENTTYPE.                                     CL**2
00861      MOVE "---------------" TO ENTRY-TYPE-DET.                       CL**2
00862      MOVE DETAIL-LINE-2 TO STD-REPORT-REC.                           CL**2
00863      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00864      MOVE SPACES TO ENTRY-TYPE-DET.                                  CL**2
00865  2320-TEST-D.                                                        CL**2
00866      IF ENTTYPE EQUAL "---------------"                              CL**2
00867          MOVE SPACE TO DETAIL-LINE-2                                 CL**2
00868          MOVE ENTTYPE TO ENTRY-TYPE-DET                              CL**2
00869          MOVE DETAIL-LINE-2 TO STD-REPORT-REC                        CL**2
00870          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00871          MOVE SPACE TO ENTRY-TYPE-DET.                               CL**2
00872  2323-CVT-ENTTYPE.                                                   CL**2
00873      IF REL-REFTYPE EQUAL "00"                                       CL**2
00874          MOVE ALIAS-CON TO ENTTYPE                                   CL**2
00875          GO TO 2325-SAVE-OLD.                                        CL**2
00876      IF REL-REFTYPE EQUAL "01"                                       CL**2
00877          MOVE ALIASES-CON TO ENTTYPE                                 CL**2
00878          GO TO 2325-SAVE-OLD.                                        CL**2
00879      MOVE REL-REFTYPE TO ENT-SEARCH.                                 CL**2
00880      PERFORM 6010-GET-ENT THRU 6099-GET-ENT-XIT.                     CL**2
00881  2325-SAVE-OLD.                                                      CL**2
00882      MOVE REL-REFTYPE TO OLD-REF.                                    CL**2
00883 *                                                                    CL**2
00884 *    FORMAT FOR DOCUMENTATION OPTION                                 CL**2
00885 *                                                                    CL**2
00886  2350-PRINT-LINE.                                                 DCRPT400
00887      IF RTBL-OPT-FORMAT EQUAL "S"                                 DCRPT400
00888          GO TO 2360-PRINT-LONG.                                   DCRPT400
00889      MOVE ENTTYPE TO ENTRY-TYPE-DET.                              DCRPT400
00890      MOVE REL-REFNAME TO CATNAME-1-DET.                           DCRPT400
00891      MOVE USE-SAVE TO REMARK-1-DET.                               DCRPT400
00892      MOVE SPACE TO USE-SAVE.                                      DCRPT400
00893      MOVE DETAIL-LINE-2 TO STD-REPORT-REC.                        DCRPT400
00894      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00895      IF ENTTYPE EQUAL "---------------"                              CL**2
00896          MOVE SPACES TO ENTTYPE                                      CL**2
00897          GO TO 2355-GET-OUT.                                         CL**2
00898      IF ENTTYPE NOT EQUAL SPACES                                     CL**2
00899          MOVE "---------------" TO ENTTYPE.                          CL**2
00900  2355-GET-OUT.                                                       CL**2
00901      MOVE SPACES TO DETAIL-LINE-2.                                   CL**2
00902      GO TO 2010-READ-EXTRACT.                                     DCRPT400
00903 *                                                                    CL**2
00904 *    FORMAT FOR STANDARD OPTION                                      CL**2
00905 *                                                                    CL**2
00906  2360-PRINT-LONG.                                                 DCRPT400
00907      IF CATNAME-1-DET EQUAL SPACES                                   CL**2
00908          MOVE ENTTYPE TO ENTRY-TYPE-DET                           DCRPT400
00909          MOVE REL-REFNAME TO CATNAME-1-DET                        DCRPT400
00910          MOVE USE-SAVE TO REMARK-1-DET                            DCRPT400
00911          MOVE SPACE TO USE-SAVE                                   DCRPT400
00912          GO TO 2010-READ-EXTRACT.                                 DCRPT400
00913 *                                                                 DCRPT400
00914 *    PRINT TWO LINES ACROSS                                       DCRPT400
00915 *                                                                 DCRPT400
00916      MOVE REL-REFNAME TO CATNAME-2-DET.                           DCRPT400
00917      MOVE USE-SAVE TO REMARK-2-DET.                               DCRPT400
00918      MOVE SPACES TO USE-SAVE.                                     DCRPT400
00919      MOVE DETAIL-LINE-2 TO STD-REPORT-REC.                        DCRPT400
00920      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00921      IF ENTTYPE EQUAL "---------------"                              CL**2
00922          MOVE SPACE TO ENTTYPE                                       CL**2
00923          GO TO 2370-LEAVE.                                           CL**2
00924      IF ENTTYPE NOT EQUAL SPACES                                     CL**2
00925          MOVE "---------------" TO ENTTYPE.                          CL**2
00926  2370-LEAVE.                                                         CL**2
00927      MOVE SPACES TO ENTRY-TYPE-DET.                                  CL**2
00928      MOVE SPACES TO CATNAME-1-DET.                                   CL**2
00929      MOVE SPACES TO CATNAME-2-DET.                                   CL**2
00930      MOVE SPACES TO REMARK-2-DET.                                    CL**2
00931      MOVE SPACES TO REMARK-1-DET.                                    CL**2
00932      GO TO 2010-READ-EXTRACT.                                     DCRPT400
00933                                                                    DCRPT40
00934  8000-NO-DETAIL-REC.                                                 CL**2
00935  9000-END-REPORT.                                                    CL**2
00936 *                                                                 DCRPT400
00937 *    END OF FILE MESSAGE                                          DCRPT400
00938 *                                                                 DCRPT400
00939      IF CATNAME-1-DET NOT EQUAL SPACES                               CL**2
00940          MOVE DETAIL-LINE-2 TO STD-REPORT-REC                        CL**2
00941          MOVE SPACES TO CATNAME-1-DET                                CL**2
00942          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00943      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00944      IF OCC-CTR NOT EQUAL ZEROES                                     CL**2
00945          MOVE OCC-CTR TO OCC-CTR-PRINT                               CL**2
00946          MOVE OCCURANCE-LINE TO STD-REPORT-REC                       CL**2
00947          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00948      MOVE DET-3-EOF TO STD-REPORT-REC.                               CL**2
00949      MOVE "N" TO RPT-EOF-SW.                                         CL**2
00950  9050-END-IT.                                                        CL**2
00951      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00952      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
00953      MOVE "9" TO RTBL-MOD-REQ.                                       CL**2
00954      PERFORM CON-CLOSE THRU CON-CLOSE-XIT.                           CL**2
           EXIT PROGRAM.
00956 *                                                                    CL**2
00957 *    NO RECORD MESSAGE                                               CL**2
00958 *                                                                    CL**2
00959  9100-ERR-MSG.                                                    DCRPT400
00960      MOVE ERR-MSG2 TO STD-REPORT-REC.                             DCRPT400
00961      GO TO 9050-END-IT.                                              CL**2
00962 *                                                                    CL**2
00963 *    NO REFERENCE RECORDS                                            CL**2
00964 *                                                                    CL**2
00965  9200-NO-REF-MSG.                                                 DCRPT400
00966      MOVE NO-REF-MSG TO STD-REPORT-REC.                           DCRPT400
00967      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT400
00968  9299-NO-REF-MSG-XIT.                                                CL**2
00969      EXIT.                                                           CL**2
00970 *                                                                    CL**2
00971 *    LOOK UP CATEGORY AND ENTRY                                      CL**2
00972 *                                                                    CL**2
00973  6000-GET-CAT.                                                    DCRPT400
00974      MOVE 1 TO SUB1.                                                 CL**2
00975  6005-NEXT-CAT.                                                   DCRPT400
00976      IF CAT-SEARCH EQUAL SAVE-CAT-ID (SUB1)                       DCRPT400
00977          MOVE SAVE-CAT-NAME (SUB1) TO CATTYPE                     DCRPT400
00978          GO TO 6010-GET-ENT.                                      DCRPT400
00979      ADD 1 TO SUB1.                                               DCRPT400
           IF SUB1 LESS THAN 35 
00981          GO TO 6005-NEXT-CAT.                                     DCRPT400
00982  6010-GET-ENT.                                                       CL**2
00983      MOVE 1 TO SUB2.                                                 CL**2
00984  6015-NEXT-ENT.                                                      CL**2
00985      IF ENT-SEARCH EQUAL SAVE-CON-ENTRY-ID (SUB2)                    CL**2
00986          MOVE SAVE-CON-ENTRY-NAME (SUB2) TO ENTTYPE                  CL**2
00987          GO TO 6080-PLURALIZE.                                       CL**2
00988      ADD 1 TO SUB2.                                                  CL**2
           IF SUB2 LESS THAN 18 
  
  
  
  
  
  
  
00990          GO TO 6015-NEXT-ENT.                                        CL**2
00991      GO TO 6099-GET-ENT-XIT.                                         CL**2
00992  6080-PLURALIZE.                                                     CL**2
00993      IF ENTTYPE EQUAL "USERS"                                        CL**2
00994          GO TO 6099-GET-ENT-XIT.                                     CL**2
00995      IF NO-PLURAL-SW EQUAL "Y"                                       CL**2
00996          GO TO 6099-GET-ENT-XIT.                                     CL**2
00997      MOVE ENTTYPE TO PLURAL-AREA.                                    CL**2
00998      MOVE 1 TO SUB2.                                                 CL**2
00999  6085-NEXT-BYTE.                                                     CL**2
01000      IF PLURAL-BYTE (SUB2) NOT EQUAL SPACE                           CL**2
01001          ADD 1 TO SUB2                                               CL**2
01002          GO TO 6085-NEXT-BYTE.                                       CL**2
01003      MOVE "S" TO PLURAL-BYTE (SUB2).                                 CL**2
01004      MOVE PLURAL-AREA TO ENTTYPE.                                    CL**2
01005  6099-GET-ENT-XIT.                                                DCRPT400
01006      EXIT.                                                           CL**2
01007                                                                    DCRPT40
01008 *                                                                    CL**2
01009 *    READ EXTRACT FILE RECORD                                        CL**2
01010 *                                                                    CL**2
01011 ******************************************************************   CL**2
01012 ******************************************************************   CL**2
01013 *                                                                    CL**2
01014 *      READ EXTRACT FILE                                             CL**2
01015 *                                                                    CL**2
01016 ******************************************************************   CL**2
01017 ******************************************************************   CL**2
01018  READ-EXTRACT.                                                       CL**2
01019      ADD 1 TO NSUB1.                                                 CL**2
01020      IF NSUB1 LESS THAN 21                                           CL**2
01021          GO TO READ-EXTRACT-GET.                                     CL**2
01022 *                                                                    CL**2
01023 *    TABLE HAS BEEN USED  -  GO BACK FOR REFILL                      CL**2
01024 *                                                                    CL**2
01025      MOVE "3" TO RTBL-MOD-REQ.                                       CL**2
           EXIT PROGRAM.
01027  READ-EXTRACT-RETURN.                                                CL**2
01028      MOVE 1 TO NSUB1.                                                CL**2
01029      MOVE ZERO TO RTBL-MOD-REQ.                                      CL**2
01030 *                                                                    CL**2
01031 *    RETRIEVE RECORD FROM TABLE                                      CL**2
01032 *        TEST FOR EOF                                                CL**2
01033 *        FORMAT COMMON AREA                                          CL**2
01034 *                                                                    CL**2
01035  READ-EXTRACT-GET.                                                   CL**2
01036      IF RPT-INPUT-TYPE (NSUB1) EQUAL HIGH-VALUES                     CL**2
01037          MOVE "Y" TO RPT-EOF-SW                                      CL**2
01038          GO TO READ-EXTRACT-XIT.                                     CL**2
01039      IF RPT-INPUT-TYPE (NSUB1) EQUAL "RC"                            CL**2
01040          GO TO READ-EXTRACT-NAME.                                    CL**2
01041      IF RPT-INPUT-TYPE (NSUB1) EQUAL "RH"                            CL**2
01042          GO TO READ-EXTRACT-INDEX.                                   CL**2
01043      GO TO READ-EXTRACT-REL.                                         CL**2
01044 *                                                                    CL**2
01045 *    PLACE NAME ANALYSIS DATA IN COMMON AREA                         CL**2
01046 *                                                                    CL**2
01047  READ-EXTRACT-NAME.                                                  CL**2
01048      MOVE REPORT-RECORD-IN (NSUB1) TO EXT-NAME-REC.                  CL**2
01049      MOVE EXT-NAM-REQTYPE TO NAME-REQTYPE.                           CL**2
01050      MOVE EXT-NAM-REQNO   TO NAME-REQNO.                             CL**2
01051      MOVE EXT-NAM-RECTYPE TO NAME-RECTYPE.                           CL**2
01052      MOVE EXT-NAM-RECSEQ  TO NAME-RECSEQ.                            CL**2
01053      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
01054          MOVE EXT-NAM1-ENTTYPE  TO  NAME-ENTTYPE                     CL**2
01055          MOVE EXT-NAM1-NAMCOMP  TO  NAME-NAMCOMP                     CL**2
01056          MOVE EXT-NAM1-CATNAME  TO  NAME-CATNAME                     CL**2
01057          MOVE EXT-NAM1-CAT      TO  NAME-CAT                         CL**2
01058          MOVE EXT-NAM1-LINE     TO  NAME-LINE                        CL**2
01059          MOVE EXT-NAM1-NAMFULL  TO  NAME-NAMFULL                     CL**2
01060          MOVE EXT-NAM1-SELNO    TO  NAME-SELNO.                      CL**2
01061      IF RTBL-OPT-SEQ EQUAL "2"                                       CL**2
01062          SUBTRACT EXT-NAM1-ENTTYPE FROM 99                           CL**2
01063          GIVING NAME-ENTTYPE                                         CL**2
01064          GO TO READ-EXTRACT-XIT.                                     CL**2
01065      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
01066          MOVE EXT-NAM3-NAMCOMP  TO  NAME-NAMCOMP                     CL**2
01067          MOVE EXT-NAM3-CATNAME  TO  NAME-CATNAME                     CL**2
01068          MOVE EXT-NAM3-ENTTYPE  TO  NAME-ENTTYPE                     CL**2
01069          MOVE EXT-NAM3-CAT      TO  NAME-CAT                         CL**2
01070          MOVE EXT-NAM3-LINE     TO  NAME-LINE                        CL**2
01071          MOVE EXT-NAM3-NAMFULL  TO  NAME-NAMFULL                     CL**2
01072          MOVE EXT-NAM3-SELNO    TO  NAME-SELNO.                      CL**2
01073      IF RTBL-OPT-SEQ EQUAL "5"                                       CL**2
01074          MOVE EXT-NAM5-NAMCOMP  TO  NAME-NAMCOMP                     CL**2
01075          MOVE EXT-NAM5-ENTTYPE  TO  NAME-ENTTYPE                     CL**2
01076          MOVE EXT-NAM5-CATNAME  TO  NAME-CATNAME                     CL**2
01077          MOVE EXT-NAM5-CAT      TO  NAME-CAT                         CL**2
01078          MOVE EXT-NAM5-LINE     TO  NAME-LINE                        CL**2
01079          MOVE EXT-NAM5-NAMFULL  TO  NAME-NAMFULL                     CL**2
01080          MOVE EXT-NAM5-SELNO    TO  NAME-SELNO.                      CL**2
01081      GO TO READ-EXTRACT-XIT.                                         CL**2
01082 *                                                                    CL**2
01083 *    PLACE INDEX ANALYSIS DATA IN COMMON AREA                        CL**2
01084 *                                                                    CL**2
01085  READ-EXTRACT-INDEX.                                                 CL**2
01086      MOVE REPORT-RECORD-IN (NSUB1) TO EXT-INDEX-REC.                 CL**2
01087      MOVE EXT-IDX-REQTYPE TO INDEX-REQTYPE.                          CL**2
01088      MOVE EXT-IDX-REQNO   TO INDEX-REQNO.                            CL**2
01089      MOVE EXT-IDX-RECTYPE TO INDEX-RECTYPE.                          CL**2
01090      MOVE EXT-IDX-RECSEQ  TO INDEX-RECSEQ.                           CL**2
01091      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
01092          MOVE EXT-IDX1-ENTTYPE  TO  INDEX-ENTTYPE                    CL**2
01093          MOVE EXT-IDX1-VALUE  TO  INDEX-VALUE                        CL**2
01094          MOVE EXT-IDX1-CATNAME  TO  INDEX-CATNAME                    CL**2
01095          MOVE EXT-IDX1-CAT      TO  INDEX-CAT                        CL**2
01096          MOVE EXT-IDX1-LINE     TO  INDEX-LINE                       CL**2
01097          MOVE EXT-IDX1-SELNO    TO  INDEX-SELNO.                     CL**2
01098      IF RTBL-OPT-SEQ EQUAL "2"                                       CL**2
01099          SUBTRACT EXT-IDX1-ENTTYPE FROM 99                           CL**2
01100              GIVING INDEX-ENTTYPE.                                   CL**2
01101      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
01102          MOVE EXT-IDX3-VALUE  TO  INDEX-VALUE                        CL**2
01103          MOVE EXT-IDX3-CATNAME  TO  INDEX-CATNAME                    CL**2
01104          MOVE EXT-IDX3-ENTTYPE  TO  INDEX-ENTTYPE                    CL**2
01105          MOVE EXT-IDX3-CAT      TO  INDEX-CAT                        CL**2
01106          MOVE EXT-IDX3-LINE     TO  INDEX-LINE                       CL**2
01107          MOVE EXT-IDX3-SELNO    TO  INDEX-SELNO.                     CL**2
01108      IF RTBL-OPT-SEQ EQUAL "5"                                       CL**2
01109          MOVE EXT-IDX5-VALUE  TO  INDEX-VALUE                        CL**2
01110          MOVE EXT-IDX5-ENTTYPE  TO  INDEX-ENTTYPE                    CL**2
01111          MOVE EXT-IDX5-CATNAME  TO  INDEX-CATNAME                    CL**2
01112          MOVE EXT-IDX5-CAT      TO  INDEX-CAT                        CL**2
01113          MOVE EXT-IDX5-LINE     TO  INDEX-LINE                       CL**2
01114          MOVE EXT-IDX5-SELNO    TO  INDEX-SELNO.                     CL**2
01115      GO TO READ-EXTRACT-XIT.                                         CL**2
01116 *                                                                    CL**2
01117 *    FORMAT RELATIONAL RECORDS                                       CL**2
01118 *                                                                    CL**2
01119  READ-EXTRACT-REL.                                                   CL**2
01120      IF RPT-REL-TYPE (NSUB1)  EQUAL "R"                              CL**2
01121          GO TO READ-EXTRACT-RELR.                                    CL**2
01122 *                                                                    CL**2
01123 *    FORMAT DEFINITION RECORDS                                       CL**2
01124 *                                                                    CL**2
01125      MOVE REPORT-RECORD-IN (NSUB1) TO EXT-REL-DEF-REC.               CL**2
01126      MOVE EXT-RELD-REQTYPE TO REL-REQTYPE.                           CL**2
01127      MOVE EXT-RELD-REQNO   TO REL-REQNO.                             CL**2
01128      MOVE EXT-RELD-RECTYPE TO REL-RECTYPE.                           CL**2
01129      MOVE EXT-RELD-RECSEQ  TO REL-RECSEQ.                            CL**2
01130      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
01131          MOVE EXT-RELD1-ENTTYPE  TO  REL-ENTTYPE                     CL**2
01132          MOVE EXT-RELD1-NAME     TO REL-NAME                         CL**2
01133          MOVE EXT-RELD1-SORTID   TO  REL-SORTID                      CL**2
01134          MOVE EXT-RELD1-RECCODE  TO  REL-RECCODE                     CL**2
01135          MOVE EXT-RELD1-CAT      TO  REL-CAT                         CL**2
01136          MOVE EXT-RELD1-LINE     TO  REL-LINE                        CL**2
01137          MOVE EXT-RELD1-CATNAME  TO  REL-CATNAME                     CL**2
01138          MOVE EXT-RELD1-SELNO    TO  REL-SELNO.                      CL**2
01139      IF RTBL-OPT-SEQ EQUAL "2"                                       CL**2
01140          SUBTRACT EXT-RELD1-ENTTYPE FROM 99                          CL**2
01141             GIVING REL-ENTTYPE.                                      CL**2
01142      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
01143          MOVE EXT-RELD3-NAME     TO REL-NAME                         CL**2
01144          MOVE EXT-RELD3-ENTTYPE  TO  REL-ENTTYPE                     CL**2
01145          MOVE EXT-RELD3-SORTID   TO  REL-SORTID                      CL**2
01146          MOVE EXT-RELD3-RECCODE  TO  REL-RECCODE                     CL**2
01147          MOVE EXT-RELD3-CAT      TO  REL-CAT                         CL**2
01148          MOVE EXT-RELD3-LINE     TO  REL-LINE                        CL**2
01149          MOVE EXT-RELD3-CATNAME  TO  REL-CATNAME                     CL**2
01150          MOVE EXT-RELD3-SELNO    TO  REL-SELNO.                      CL**2
01151      GO TO READ-EXTRACT-XIT.                                         CL**2
01152 *                                                                    CL**2
01153 *    FORMAT REFERENCE RECORDS                                        CL**2
01154 *                                                                    CL**2
01155  READ-EXTRACT-RELR.                                                  CL**2
01156      MOVE REPORT-RECORD-IN (NSUB1) TO EXT-REL-REF-REC.               CL**2
01157      MOVE EXT-RELR-REQTYPE TO REL-REQTYPE.                           CL**2
01158      MOVE EXT-RELR-REQNO   TO REL-REQNO.                             CL**2
01159      MOVE EXT-RELR-RECTYPE TO REL-RECTYPE.                           CL**2
01160      MOVE EXT-RELR-RECSEQ  TO REL-RECSEQ.                            CL**2
01161      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
01162          MOVE EXT-RELR1-ENTTYPE  TO  REL-ENTTYPE                     CL**2
01163          MOVE EXT-RELR1-NAME     TO REL-NAME                         CL**2
01164          MOVE EXT-RELR1-SORTID   TO  REL-SORTID                      CL**2
01165          MOVE EXT-RELR1-RECCODE  TO  REL-RECCODE                     CL**2
01166          MOVE EXT-RELR1-REFTYPE      TO  REL-REFTYPE                 CL**2
01167          MOVE EXT-RELR1-REFNAME     TO  REL-REFNAME                  CL**2
01168          MOVE EXT-RELR1-USAGE  TO  REL-USAGE                         CL**2
01169          MOVE EXT-RELR1-ALIAS  TO  REL-ALIAS                         CL**2
01170          MOVE EXT-RELR1-SELNO    TO  REL-SELNO.                      CL**2
01171      IF RTBL-OPT-SEQ EQUAL "2"                                       CL**2
01172          SUBTRACT EXT-RELR1-ENTTYPE FROM 99                          CL**2
01173              GIVING REL-ENTTYPE.                                     CL**2
01174      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
01175          MOVE EXT-RELR3-NAME     TO REL-NAME                         CL**2
01176          MOVE EXT-RELR3-ENTTYPE  TO  REL-ENTTYPE                     CL**2
01177          MOVE EXT-RELR3-SORTID   TO  REL-SORTID                      CL**2
01178          MOVE EXT-RELR3-RECCODE  TO  REL-RECCODE                     CL**2
01179          MOVE EXT-RELR3-REFTYPE      TO  REL-REFTYPE                 CL**2
01180          MOVE EXT-RELR3-REFNAME     TO  REL-REFNAME                  CL**2
01181          MOVE EXT-RELR3-USAGE  TO  REL-USAGE                         CL**2
01182          MOVE EXT-RELR3-ALIAS  TO  REL-ALIAS                         CL**2
01183          MOVE EXT-RELR3-SELNO    TO  REL-SELNO.                      CL**2
01184 *                                                                    CL**2
01185 *    BYPASS DUPLICATE REFERENCE RECORDS                              CL**2
01186 *                                                                    CL**2
01187      MOVE REL-NAME TO NEW-REL-NAME.                                  CL**2
01188      MOVE REL-REFNAME TO NEW-REL-REF-NAME.                           CL**2
01189      IF NEW-REF-NAMES EQUAL OLD-REF-NAMES                            CL**2
01190          GO TO READ-EXTRACT.                                         CL**2
01191      MOVE NEW-REF-NAMES TO OLD-REF-NAMES.                            CL**2
01192  READ-EXTRACT-XIT.                                                   CL**2
01193      EXIT.                                                           CL**2
01194  USER-ROUTINE.                                                    DCRPT400
01195      IF RTBL-HDR-REQTYPE EQUAL "RH"                                  CL**2
01196          GO TO INDEX-HDGS.                                           CL**2
01197      IF RTBL-HDR-REQTYPE EQUAL "RJ"                                  CL**2
01198          GO TO RELATIONAL-HDGS.                                      CL**2
01199      MOVE 2 TO PRT-CTL.                                              CL**2
01200      MOVE HDG-1 TO PRINT-DATA.                                       CL**2
01201      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01202      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01203      ADD 4 TO LINE-CT.                                               CL**2
01204      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
01205          MOVE HDG-2A TO PRINT-DATA                                   CL**2
01206          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
01207          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
01208          ADD 2 TO LINE-CT                                            CL**2
01209          GO TO USER-ROUTINE-XIT.                                     CL**2
01210      MOVE HDG-2 TO PRINT-DATA.                                       CL**2
01211      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01212      ADD 1 TO LINE-CT.                                               CL**2
01213      GO TO USER-ROUTINE-XIT.                                         CL**2
01214  INDEX-HDGS.                                                         CL**2
01215      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
01216          GO TO INDEX-HDGS-S.                                         CL**2
01217      MOVE HDG-1-L TO PRINT-DATA.                                     CL**2
01218      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01219      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01220      ADD 2 TO LINE-CT.                                               CL**2
01221      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
01222          MOVE HDG-2A-L TO PRINT-DATA                                 CL**2
01223          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
01224          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
01225          ADD 2 TO LINE-CT                                            CL**2
01226          GO TO USER-ROUTINE-XIT.                                     CL**2
01227      MOVE HDG-2-L TO PRINT-DATA.                                     CL**2
01228      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01229      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01230      ADD 2 TO LINE-CT.                                               CL**2
01231      GO TO USER-ROUTINE-XIT.                                         CL**2
01232  INDEX-HDGS-S.                                                       CL**2
01233      MOVE HDG-1-S TO PRINT-DATA.                                     CL**2
01234      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01235      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01236      ADD 2 TO LINE-CT.                                               CL**2
01237      MOVE HDG-2-S TO PRINT-DATA.                                     CL**2
01238      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01239      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01240      ADD 2 TO LINE-CT.                                               CL**2
01241      GO TO USER-ROUTINE-XIT.                                         CL**2
01242  RELATIONAL-HDGS.                                                    CL**2
01243      MOVE HDG-REL-1 TO PRINT-DATA.                                   CL**2
01244      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01245      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01246      MOVE REPORT-HEAD TO PRINT-DATA.                                 CL**2
01247      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01248      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01249      ADD 4 TO LINE-CT.                                               CL**2
01250      IF RTBL-OPT-SEQ NOT EQUAL "3"                                   CL**2
01251          MOVE DASH-1 TO PRINT-DATA                                   CL**2
01252          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
01253          MOVE ENTTYPE-HDG TO PRINT-DATA                              CL**2
01254          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
01255          MOVE DASH-1 TO PRINT-DATA                                   CL**2
01256          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
01257          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
01258      ADD 4 TO LINE-CT.                                               CL**2
01259      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
01260          MOVE "CATALOGUE NAME" TO CATORDATA-L CATORDATA-S            CL**2
01261      ELSE                                                            CL**2
01262          MOVE RTBL-HDR-IDXFNAME TO CATORDATA-L  CATORDATA-S.         CL**2
01263      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
01264          GO TO REL-HDG-S.                                            CL**2
01265      MOVE DET-HDG-L TO PRINT-DATA.                                   CL**2
01266      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01267      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01268      ADD 2 TO LINE-CT.                                               CL**2
01269      GO TO USER-ROUTINE-XIT.                                         CL**2
01270  REL-HDG-S.                                                          CL**2
01271      MOVE DET-HDG-S TO PRINT-DATA.                                   CL**2
01272      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01273      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01274      ADD 2 TO LINE-CT.                                               CL**2
01275  USER-ROUTINE-XIT.                                                DCRPT400
01276      EXIT.                                                        DCRPT400
01277  RPT-PRINT811.                                                       CL**2
01278  RPT-PRINT811-XIT.                                                   CL**2
01279      EXIT.                                                           CL**2
*CALL     DISPLAY2                                                      DCRPT400
*CALL     WRITELNI                                                         CL**2
*CALL     MAST1RNL                                                      DCRPT400
*CALL     MAST1RFC                                                         CL**2
*CALL     MAST1EXT                                                      DCRPT400
*CALL     MAST1RFL                                                         CL**2
*CALL     MAST1RDR                                                         CL**2
*CALL     MAST1ALG                                                      DCRPT400
*CALL     MAST3IO1                                                         CL**2
