*DECK     DCRPT232
00001  IDENTIFICATION DIVISION.                                         06/19/78
       PROGRAM-ID. RPT232.
*CALL COPYRIGHT 
      *    THIS MODULE PRINTS A DATABASE FOR A $REPORT OR $FILE REQUEST 
      *    IN ADDITION IF A FILE HAS BEEN REQUESTED THIS MODULE FORMATS 
      *    RECORDS FOR DATABASES.  THE MODULE ALSO FORMATS INDEX REPORT 
      *    DETAIL RECORDS.
      *    ENTRY TYPE 3 = DATABASE
00011  ENVIRONMENT DIVISION.                                               CL**2
00012  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00015  INPUT-OUTPUT SECTION.                                               CL**2
00016  DATA DIVISION.                                                      CL**2
*CALL RPTCS 
*CALL     WRKSTG77                                                         CL**2
*CALL     MAST1WS                                                          CL**2
*CALL     TESTWACOM                                                        CL**2
*CALL     TOTWA32                                                          CL**2
00021  01  COMMON-RPTDATA.                                                 CL**2
00022 *                                                                    CL**2
00023 *    THIS REFINES LINE FORMATS  FIELD VALUES, CODES AND WORK AREAS   CL**2
00024 *    WHICH ARE COMMON TO ALL ENTRY TYPES.                            CL**2
00025 ******************************************************************   CL**2
00026 *    STANDARD CATEGORY RPT DETAIL LINES COMMON TO ALL ENTRY TYPES    CL**2
00027 ******************************************************************   CL**2
00028      03  00-CAT-DETAIL-LINES.                                        CL**2
00029 *    CONTROL CATEGORY                                                CL**2
00030          05  CAT00010-LINE.                                          CL**2
00031              07  FLD0001005-HDG  PICTURE X(11).                      CL**2
00032              07  FLD0001005-VAL  PICTURE X(32).                      CL**2
00033              07  FILLER          PICTURE X.                          CL**2
00034              07  FLD0001010-HDG  PICTURE X(7).                       CL**2
00035              07  FLD0001010-VAL.                                     CL**2
00036                  09  FLD0001010-POS1 PICTURE X.                      CL**2
00037                  09  FILLER          PICTURE X(7).                   CL**2
00038              07  FILLER          PICTURE X.                          CL**2
00039              07  FLD0001015-HDG  PICTURE X(9).                       CL**2
00040              07  FLD0001015-VAL  PICTURE X.                          CL**2
00041 *    KEYWORD CATEGORY                                                CL**2
00042          05  CAT00020-LINE REDEFINES CAT00010-LINE.                  CL**2
00043              07  FLD0002005-HDG  PICTURE X(3).                       CL**2
00044              07  FLD0002005-VAL PICTURE X(67).                       CL**2
00045 *"   DESCRIPTION CATEGORY                                            CL**2
00046          05  CAT00030-LINE REDEFINES CAT00020-LINE.                  CL**2
00047              07  FLD0003005-VAL  PICTURE X.                          CL**2
00048              07  FLD0003010-VAL  PICTURE X(66).                      CL**2
00049              07  FILLER          PICTURE X(3).                       CL**2
00050 *    OTHER CATEGORY                                                  CL**2
00051          05  CAT00900-LINE REDEFINES CAT00020-LINE.                  CL**2
00052              07  FLD0090005-VAL  PICTURE X.                          CL**2
00053              07  FLD0090010-VAL  PICTURE X(66).                      CL**2
00054              07  FILLER          PICTURE X(3).                       CL**2
00055 ******************************************************************   CL**2
00056 *    STANDARD FIELD HEADING CONSTANTS FOR DETAIL LINES               CL**2
00057 *        COMMON TO ALL ENTRY TYPES                                   CL**2
00058 ******************************************************************   CL**2
00059      03  00-FIELD-HDG-CONSTANTS.                                     CL**2
00060          05  FLD0001005-HCONA    PICTURE X(11)  VALUE                CL**2
00061             "  ALIAS OF ".                                           CL**2
00062          05  FLD0001010-HCON     PICTURE X(7)   VALUE                CL**2
00063             "STATUS=".                                               CL**2
00064          05  FLD0001015-HCON     PICTURE X(9)   VALUE                CL**2
00065             "SECURITY=".                                             CL**2
00066          05  FLD0002005-HCON     PICTURE X(3)   VALUE                CL**2
00067              "   ".                                                  CL**2
00068          05  FLD0001005-HCONV    PICTURE X(11)  VALUE                CL**2
00069             "VERSION OF ".                                           CL**2
00070          05  SUB-HEADING-LINE.                                       CL**2
00071              07  FILLER          PICTURE X(14)   VALUE               CL**2
00072             "CATALOGUE NAME".                                        CL**2
00073              07  FILLER          PICTURE X(8)    VALUE SPACE.        CL**2
00074              07  FILLER          PICTURE X(9)    VALUE               CL**2
00075             "REV  LINE".                                             CL**2
00076              07  FILLER          PICTURE X(5)    VALUE SPACE.        CL**2
00077              07  FILLER          PICTURE X(4)    VALUE               CL**2
00078             "TYPE".                                                  CL**2
00079              07  FILLER          PICTURE X(92)   VALUE SPACE.        CL**2
00080          05  CONTINUATION-LINE.                                      CL**2
00081              07  CATA-NAME-LINE  PICTURE X(56)   VALUE SPACE.        CL**2
00082              07  FILLER          PICTURE X(72)   VALUE SPACE.        CL**2
00083              07  STATEMENT-LINE.                                     CL**2
00084                  09  FILLER      PICTURE X(5)    VALUE SPACE.        CL**2
00085                  09  FILLER      PICTURE X(30)   VALUE               CL**2
00086                 "* CONTINUED FROM PREVIOUS PAGE".                    CL**2
00087                  09  FILLER      PICTURE X(97)   VALUE SPACE.        CL**2
00088 *****************************************************************    CL**2
00089 *    FIELD CODES AND THIER MEANINGS                                  CL**2
00090 *       COMMON TO ALL ENTRY TYPES-FOR COMMON CATS                    CL**2
00091 **********************************************************           CL**2
00092      03  00-CAT-CODES.                                               CL**2
00093 *  STATUS OF ENTRY                                                   CL**2
00094          05  FLD0001010-CV       PICTURE X(4)    VALUE               CL**2
00095         "EPO9".                                                      CL**2
00096          05  FLD0001010-CD  REDEFINES  FLD0001010-CV.                CL**2
00097              07  FLD0001010-CODES PICTURE X OCCURS 4.                CL**2
00098          05  FLD0001010-MV       PICTURE X(32)   VALUE               CL**2
00099         "EXISTINGPROPOSEDOBSOLETEXXXXXXXX".                          CL**2
00100          05  FLD0001010-MD   REDEFINES FLD0001010-MV.                CL**2
00101              07  FLD0001010-MNG  PICTURE X(8) OCCURS 4.              CL**2
00102      03  WORK-FIELDS.                                                CL**2
00103          05  DATA-OPEN-SW PICTURE X.                                 CL**2
00104          05  HIT-WORK-REC.                                           CL**2
00105          07  HIT-WORK-NAME       PICTURE X(32).                      CL**2
00106          07  HIT-WORK-ENTTYPE    PICTURE XX.                         CL**2
00107          05  HIT-TBL-LIMIT       PICTURE   99    VALUE               CL**2
00108            25.                                                       CL**2
00109          05  HIT-TBL-LIMIT-PLUS1 PICTURE   99    VALUE               CL**2
00110              26.                                                     CL**2
00111          05  FRLINE-LIMIT        PICTURE 9(4).                       CL**2
00112          05  TOLINE-LIMIT        PICTURE 9(4).                       CL**2
00113          05  FORLINE-LIMIT       PICTURE 9(4).                       CL**2
00114          05  CATLINE-COUNTER     PICTURE 9(4).                       CL**2
00115          05  ENTRY-NAME          PICTURE X(32).                      CL**2
00116          05  ENTRY-TYPE-NO       PICTURE 99.                         CL**2
00117          05  ENTRY-TYPE-NAME     PICTURE X(8).                       CL**2
00118          05  CATEGORY-NUMBER     PICTURE XXX.                        CL**2
00119          05  CATEGORY-OUTPUT-SW  PICTURE X.                          CL**2
00120          05  1ST-HIT-OVER-SW  PICTURE X VALUE "X".                   CL**2
00121          05  HIT-COUNTER   PICTURE 9(5) VALUE 0.                     CL**2
00122          05  HITS-PER-RECORD  PICTURE 99 VALUE 91.                   CL**2
00123          05  CON-KEY          PICTURE S9(8) COMP SYNC.               CL**2
00124          05  SUB1                PICTURE   S99  COMP SYNC.           CL**2
00125          05  SUB2                PICTURE   S99  COMP SYNC.           CL**2
00126          05  SUB3                PICTURE   S99  COMP SYNC.           CL**2
00127          05  SUB4                PICTURE   S99  COMP SYNC.           CL**2
00128          05  SUB5                PICTURE   S99  COMP SYNC.           CL**2
00129          05  SUB6                PICTURE   S99  COMP SYNC.           CL**2
00130           05  DISPLAY-LINE-LENGTH PICTURE XXX VALUE "132".           CL**2
00131      03  QUERY-MESSAGES.                                             CL**2
00132          05  NO-LINES-MSG.                                           CL**2
00133              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00134              07  NLM             PICTURE X(55)   VALUE               CL**2
00135             "DCRPT-015-I * REQUESTED LINES NOT PRESENT FOR CATEGOR   CL**2
00136 -           "Y.".                                                    CL**2
00137          05  NO-CAT-MSG.                                             CL**2
00138              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00139              07  NC7             PICTURE X(45)   VALUE               CL**2
00140             "DCRPT-020-I * REQUESTED CATEGORY NOT DEFINED.".         CL**2
00141              07  FILLER          PICTURE X(9) VALUE SPACES.          CL**2
00142          05  NO-CATS-MSG.                                            CL**2
00143              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00144              07  NCPM            PICTURE X(47)   VALUE               CL**2
00145             "DCRPT-025-I * REQUESTED CATEGORIES NOT DEFINED.".       CL**2
00146              07  FILLER          PICTURE X(9)    VALUE SPACES.       CL**2
00153          05  LIST-LINE-MSG.                                          CL**2
00154              07 FILLER           PICTURE XX    VALUE SPACES.         CL**2
00155              07  LIST-LINE-NAME  PICTURE X(32).                      CL**2
00156              07  FILLER          PICTURE XX    VALUE SPACES.         CL**2
00157              07  LIST-LINE-ENTTYPE PICTURE X(8) VALUE                CL**2
00158             "DATABASE".                                              CL**2
00159              07  FILLER          PICTURE X(12) VALUE SPACES.         CL**2
*CALL     RPTDEF32                                                         CL**2
*CALL     QTBL2                                                            CL**2
*CALL     RPTWORK                                                          CL**2
00179                                                                    DCRPT23
00180  PROCEDURE DIVISION.                                                 CL**2
*CALL     CATRTS                                                           CL**2
00188 *                                                                    CL**2
00189 *    INITIALIZE LINE RETRIEVAL LIMITS FOR QUERY                      CL**2
00190 *                                                                    CL**2
00191  3400-INIT-LINELIMS.                                                 CL**2
00192      IF QTBL-OUT-FRLINE EQUAL TO SPACES                              CL**2
00193          MOVE 0001 TO FRLINE-LIMIT                                   CL**2
00194         ELSE                                                         CL**2
00195          MOVE QTBL-OUT-FRLINE TO FRLINE-LIMIT.                       CL**2
00196      IF QTBL-OUT-TOLINE EQUAL TO SPACES                              CL**2
00197          MOVE 9999 TO TOLINE-LIMIT                                   CL**2
00198         ELSE                                                         CL**2
00199          MOVE QTBL-OUT-TOLINE TO TOLINE-LIMIT.                       CL**2
00200      IF QTBL-OUT-FORLINES EQUAL TO SPACES                            CL**2
00201          MOVE 9999 TO FORLINE-LIMIT                                  CL**2
00202         ELSE                                                         CL**2
00203          MOVE QTBL-OUT-FORLINES TO FORLINE-LIMIT.                    CL**2
00204 *                                                                    CL**2
00205 *    DETERMINE IF SHOW IF FOR A CATEGORY OR SUPER CATEGORY           CL**2
00206 *                                                                    CL**2
00207      MOVE QTBL-OUT-CAT TO CATEGORY-NUMBER.                           CL**2
00208      MOVE HIT-WORK-NAME TO DATA-ENTRY-NAME.                          CL**2
00209      MOVE HIT-WORK-ENTTYPE TO DATA-ENTRY-TYPE.                       CL**2
00210      MOVE "N" TO CATEGORY-OUTPUT-SW.                                 CL**2
00211      IF CATEGORY-NUMBER EQUAL TO "999"                               CL**2
00212          GO TO 3450-SHOW-ALL.                                        CL**2
00213      IF CATEGORY-NUMBER EQUAL TO "998"                               CL**2
00214          GO TO 3465-SHOW-COMP.                                       CL**2
00215      IF CATEGORY-NUMBER EQUAL TO "997"                               CL**2
00216          GO TO 3460-SHOW-CHAR.                                       CL**2
00217      IF CATEGORY-NUMBER EQUAL TO "996"                               CL**2
00218          GO TO 3450-SHOW-ALL.                                        CL**2
00219      IF CATEGORY-NUMBER EQUAL TO "995"                               CL**2
00220          GO TO 3467-SHOW-PERS.                                       CL**2
00221 *                                                                    CL**2
00222 *    SHOW ONE CATEGORY HE ASKED FOR                                  CL**2
00223 *                                                                    CL**2
00224      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00225      GO TO 1100-NEXT-OUTPUT.                                         CL**2
00226 *                                                                    CL**2
00227 *    SHOW ALL                                                        CL**2
00228 *                                                                    CL**2
00229  3450-SHOW-ALL.                                                      CL**2
00230      MOVE "010" TO CATEGORY-NUMBER.                                  CL**2
00231      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00232      MOVE "020" TO CATEGORY-NUMBER.                                  CL**2
00233      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00234 *                                                                    CL**2
00235  3460-SHOW-CHAR.                                                     CL**2
00236 *                                                                    CL**2
00237      MOVE "030" TO CATEGORY-NUMBER.                                  CL**2
00238      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00239      IF QTBL-OUT-CAT EQUAL TO "996"                                  CL**2
00240          GO TO 3470-CHECK-SUPER.                                     CL**2
00241      MOVE "140" TO CATEGORY-NUMBER.                                  CL**2
00242      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00243      MOVE "200" TO CATEGORY-NUMBER.                                  CL**2
00244      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00245      MOVE "215" TO CATEGORY-NUMBER.                                  CL**2
00246      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00247      MOVE "900" TO CATEGORY-NUMBER.                                  CL**2
00248      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00249      IF QTBL-OUT-CAT EQUAL TO "997"                                  CL**2
00250          GO TO 3470-CHECK-SUPER.                                     CL**2
00251  3465-SHOW-COMP.                                                     CL**2
00252      IF QTBL-OUT-CAT EQUAL TO "999"                                  CL**2
00253          GO TO 3466-JUST-COMP.                                       CL**2
00254      MOVE "030" TO CATEGORY-NUMBER.                                  CL**2
00255      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00256  3466-JUST-COMP.                                                     CL**2
00257      MOVE "300" TO CATEGORY-NUMBER.                                  CL**2
00258      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00259      GO TO 3470-CHECK-SUPER.                                         CL**2
00260  3467-SHOW-PERS.                                                     CL**2
00261      MOVE "030" TO CATEGORY-NUMBER.                                  CL**2
00262      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00263      MOVE "140" TO CATEGORY-NUMBER.                                  CL**2
00264      PERFORM 3500-DISPLAY-CATEGORY THRU 3749-DISPLAY-CAT-XIT.        CL**2
00265 *                                                                    CL**2
00266 *    CHECK TO SEE IF ANY OUTPUT FOR ENTYR                            CL**2
00267 *                                                                    CL**2
00268  3470-CHECK-SUPER.                                                   CL**2
00269      IF CATEGORY-OUTPUT-SW EQUAL TO "Y"                              CL**2
00270          GO TO 1100-NEXT-OUTPUT.                                     CL**2
00271  3475-NO-CATS.                                                       CL**2
00272      MOVE NO-CATS-MSG TO STD-RPT-MESSAGE.                            CL**2
00273      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00274          MOVE "Y" TO CATEGORY-811-SW.                                CL**2
00275      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00276      GO TO 1100-NEXT-OUTPUT.                                         CL**2
00277                                                                    DCRPT23
00278 ******************************************************************   CL**2
00279 *                                                                    CL**2
00280 *    DISPLAY CATEGORY                                                CL**2
00281 *        RETRIEVES LINES FOR SPECIFIED CATEGORY AND FORMATS          CL**2
00282 *        EITHER A 70, 80 OR 132 CHARACTER LINE                       CL**2
00283 *                                                                    CL**2
00284 ******************************************************************   CL**2
00285  3500-DISPLAY-CATEGORY.                                              CL**2
00286      MOVE CATEGORY-NUMBER TO DATA-ENTRY-CAT.                         CL**2
00287      MOVE 0001 TO CATLINE-COUNTER.                                   CL**2
00288      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00289      IF DATA-RETURN-CODE EQUAL TO "0"                                CL**2
00290          GO TO 3510-CK-1ST-LINE.                                     CL**2
00291 *                                                                    CL**2
00292 *    CHECK FOR SUPER CAT AND BYPASS MSG                              CL**2
00293 *                                                                    CL**2
00294      IF QTBL-OUT-CAT GREATER THAN 950                                CL**2
00295      GO TO 3749-DISPLAY-CAT-XIT.                                     CL**2
00296      GO TO 3715-NOCAT-LINE.                                          CL**2
00297 *                                                                    CL**2
00298 *    CHECK IF FIRST CATEGORY LINE IS IN DESIRED RANGE                CL**2
00299 *        READ PAST LINES WITH NUMBERS LOWER THAN LOW LIMIT           CL**2
00300 *                                                                    CL**2
00301  3510-CK-1ST-LINE.                                                   CL**2
00302      IF CAT-LINE LESS THAN FRLINE-LIMIT                              CL**2
00303          GO TO 3515-BYPASS-LINE.                                     CL**2
00304 *                                                                    CL**2
00305 *    RETRIEVE 1ST LINE OF CATEGORY                                   CL**2
00306 *                                                                    CL**2
00307      IF CAT-LINE GREATER THAN TOLINE-LIMIT                           CL**2
00308          GO TO 3717-CK-SUPER-CAT.                                    CL**2
00309      GO TO 3520-OUTPUT-CATHDR.                                       CL**2
00310  3515-BYPASS-LINE.                                                   CL**2
00311      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00312      IF DATA-RETURN-CODE EQUAL TO "0" OR "3"                         CL**2
00313          GO TO 3510-CK-1ST-LINE.                                     CL**2
00314  3717-CK-SUPER-CAT.                                                  CL**2
00315      IF QTBL-OUT-CAT GREATER THAN 950                                CL**2
00316          GO TO 3749-DISPLAY-CAT-XIT.                                 CL**2
00317      GO TO 3715-NOCAT-LINE.                                          CL**2
00318 *                                                                    CL**2
00319 *    LOOKUP AND OUTPUT CATEGORY HEADER LINE                          CL**2
00320 *                                                                    CL**2
00321  3520-OUTPUT-CATHDR.                                                 CL**2
00322      MOVE 1 TO SUB4.                                                 CL**2
00323  3525-NEXT-CATNUM.                                                   CL**2
00324      IF ENT32-CATNUMS (SUB4) EQUAL TO CATEGORY-NUMBER                CL**2
00325          GO TO 3530-DISPLAY-HDG.                                     CL**2
00326      ADD 1 TO SUB4.                                                  CL**2
00327      GO TO 3525-NEXT-CATNUM.                                         CL**2
00328  3530-DISPLAY-HDG.                                                   CL**2
00329      IF RTBL-OPT-REPORT EQUAL "N"                                    CL**2
00330          GO TO 3532-FMT-FILE-DETAIL.                                 CL**2
00331      MOVE SPACES TO STD-RPT-CATHDG.                                  CL**2
00332      MOVE ENT32-CATHDRS (SUB4) TO CATEGORY-HEADER.                   CL**2
00333      MOVE CATEGORY-HEADER TO CATEGORY-NAME-WORK.                     CL**2
00334      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00335          MOVE "Y" TO CATEGORY-811-SW                                 CL**2
00336          MOVE CATEGORY-HEADER TO CAT-HEADER-811                      CL**2
00337          MOVE CATEGORY-HEADER-811 TO STD-REPORT-REC.                 CL**2
00338      MOVE 2 TO PRT-CTL.                                              CL**2
00339      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00340      MOVE 1 TO PRT-CTL.                                              CL**2
00341      MOVE SPACES TO STD-RPT-CATHDG.                                  CL**2
00342      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00343      MOVE "Y" TO CATEGORY-OUTPUT-SW.                                 CL**2
00344 *****************************************************************    CL**2
00345 *                                                                    CL**2
00346 *     FORMAT$FILE REQUEST DETAIL RECORDS                             CL**2
00347 *          A RECORD IS FORMATTED FOR EACH SELECTED LINE              CL**2
00348 *                                                                    CL**2
00349 ***************************************************************      CL**2
00350  3532-FMT-FILE-DETAIL.                                               CL**2
00351      IF RTBL-HDR-REQTYPE EQUAL TO "RR" OR "RS" OR "RT"               CL**2
00352          GO TO 3540-FMT-CAT-DETAIL.                                  CL**2
00353 *                                                                    CL**2
00354 *     USE 1ST 3 CHRS OF CATEGORY HDG TO IDENTIFY OUTPUT CATEGORY     CL**2
00355 *                                                                    CL**2
00356      MOVE 1 TO HDG-SUB.                                              CL**2
00357 *     FIND THE FIRST DASH IN THE HDG                                 CL**2
00358  3534-FIND-DASH.                                                     CL**2
00359      IF CATEGORY-HDG-CHR (HDG-SUB) NOT EQUAL "-"                     CL**2
00360          ADD 1 TO HDG-SUB                                            CL**2
00361          GO TO 3534-FIND-DASH.                                       CL**2
00362  3536-BYPASS-DASH.                                                   CL**2
00363      IF CATEGORY-HDG-CHR (HDG-SUB) EQUAL TO "-"                      CL**2
00364          ADD 1 TO HDG-SUB                                            CL**2
00365          GO TO 3536-BYPASS-DASH.                                     CL**2
00366      MOVE CATEGORY-HDG-CHR (HDG-SUB) TO CATEGORY-ABB-CHR1.           CL**2
00367      ADD 1 TO HDG-SUB.                                               CL**2
00368      MOVE CATEGORY-HDG-CHR (HDG-SUB) TO CATEGORY-ABB-CHR2.           CL**2
00369      ADD 1 TO HDG-SUB.                                               CL**2
00370      MOVE CATEGORY-HDG-CHR (HDG-SUB) TO CATEGORY-ABB-CHR3.           CL**2
00371 *                                                                    CL**2
00372 *     FORMAT DETAIL RECORD                                           CL**2
00373 *                                                                    CL**2
00374      MOVE SPACES TO USER-LINE200-REC.                                CL**2
00375      MOVE RTBL-HDR-REQNO TO USER-L200-REQNO.                         CL**2
00376      MOVE EXT-HOLD-CATNAME TO USER-L200-CNAME.                       CL**2
00377      MOVE EXT-HOLD-TYPE TO USER-L200-ENTTYPE.                        CL**2
00378      MOVE CATEGORY-NAME-ABBRV TO USER-L200-CAT.                      CL**2
00379      MOVE CAT-LENGTH    TO USER-L200-LENGTH.                         CL**2
00380      MOVE CAT-LINE      TO USER-L200-LINE.                           CL**2
00381      MOVE CAT-REV       TO USER-L200-REV.                            CL**2
00382      MOVE CAT-DETAIL    TO USER-L200-DATA.                           CL**2
00383      MOVE "U" TO CATTBL-FILE-TYPE.                                   CL**2
00384      IF CAT-LENGTH GREATER THAN 67                                   CL**2
00385      MOVE "5" TO USER-L200-RECTYPE                                   CL**2
00386          MOVE "5" TO CATTBL-RECORD-TYPE                              CL**2
00387      ELSE                                                            CL**2
00388      MOVE "4" TO USER-L200-RECTYPE                                   CL**2
00389          MOVE "4" TO CATTBL-RECORD-TYPE.                             CL**2
00390      PERFORM 0900-USERFILE-OUT THRU 0999-USERFILE-OUT-XIT.           CL**2
00391      IF RTBL-OPT-REPORT EQUAL "N"                                    CL**2
00392          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00393 *                                                                    CL**2
00394 *    FORMAT CATEGORY DETAIL LINES                                    CL**2
00395 *        IF 70 CHR FORMAT PUT OUT LINE NO ON SEP LINE                CL**2
00396 *                                                                    CL**2
00397  3540-FMT-CAT-DETAIL.                                                CL**2
00398      IF RTBL-OPT-FORMAT EQUAL "S"                                    CL**2
00399          GO TO 3550-FMT-LINE-PREFIX.                                 CL**2
00400      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00401          GO TO 3550-FMT-LINE-PREFIX.                                 CL**2
00402      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00403      GO TO 3560-FORMAT-REPORT.                                       CL**2
00404  3550-FMT-LINE-PREFIX.                                               CL**2
00405      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00406          MOVE 98765 TO STDRPT-REVNO                                  CL**2
00407          MOVE CAT-LINE TO STDRPT-LINE                                CL**2
00408          GO TO 3560-FORMAT-REPORT                                    CL**2
00409      ELSE                                                            CL**2
00410          MOVE CAT-REV TO STDRPT-REVNO                                CL**2
00411      MOVE CAT-LINE TO STDRPT-LINE.                                   CL**2
00412 *                                                                    CL**2
00413 *    CHECK FOR COMMENT LINE                                          CL**2
00414  3560-FORMAT-REPORT.                                                 CL**2
00415      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00416          PERFORM 5300-FMT-CAT030 THRU 5399-FMT-CAT030-XIT            CL**2
00417          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00418 *                                                                    CL**2
00419 *    CHECK FOR CATEGORY NUMBERS AND ENTER FORMATTING RT              CL**2
00420 *                                                                    CL**2
00421      IF CATEGORY-NUMBER EQUAL TO "010"                               CL**2
00422          PERFORM 5100-FMT-CAT010 THRU 5199-FMT-CAT010-XIT            CL**2
00423          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00424      IF CATEGORY-NUMBER EQUAL TO "020"                               CL**2
00425          PERFORM 5200-FMT-CAT020 THRU 5299-FMT-CAT020-XIT            CL**2
00426          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00427      IF CATEGORY-NUMBER EQUAL TO "030"                               CL**2
00428          PERFORM 5300-FMT-CAT030 THRU 5399-FMT-CAT030-XIT            CL**2
00429          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00430      IF CATEGORY-NUMBER EQUAL TO "140"                               CL**2
00431          PERFORM 1000-FMT-CAT32140 THRU 1099-FMT-CAT32140-XIT        CL**2
00432          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00433      IF CATEGORY-NUMBER EQUAL TO "200"                               CL**2
00434          PERFORM 1500-FMT-CAT32200 THRU 1599-FMT-CAT32200-XIT        CL**2
00435          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00436      IF CATEGORY-NUMBER EQUAL TO "215"                               CL**2
00437          PERFORM 3200-FMT-CAT215 THRU 3299-FMT-CAT215-XIT            CL**2
00438          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00439      IF CATEGORY-NUMBER EQUAL TO "300"                               CL**2
00440          PERFORM 1300-FMT-CAT300 THRU 1399-FMT-CAT300-XIT            CL**2
00441          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00442      IF CATEGORY-NUMBER EQUAL TO "900"                               CL**2
00443          PERFORM 5900-FMT-CAT900 THRU 5999-FMT-CAT900-XIT            CL**2
00444          GO TO 3700-GET-NEXT-LINE.                                   CL**2
00445      GO TO 3710-NOCAT-DATA.                                          CL**2
00446 *                                                                    CL**2
00447 *    RETRIEVE NEXT LINE OF CATEGORY - CK FOR END                     CL**2
00448 *                                                                    CL**2
00449  3700-GET-NEXT-LINE.                                                 CL**2
00450      IF CATLINE-COUNTER EQUAL TO FORLINE-LIMIT                       CL**2
00451        GO TO 3749-DISPLAY-CAT-XIT.                                   CL**2
00452      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00453      IF DATA-RETURN-CODE EQUAL TO  1 OR 2                            CL**2
00454          GO TO 3749-DISPLAY-CAT-XIT.                                 CL**2
00455      IF CAT-LINE GREATER THAN TOLINE-LIMIT                           CL**2
00456          GO TO 3749-DISPLAY-CAT-XIT.                                 CL**2
00457      ADD 1 TO CATLINE-COUNTER.                                       CL**2
00458      GO TO 3532-FMT-FILE-DETAIL.                                     CL**2
00459  3749-DISPLAY-CAT-XIT.                                               CL**2
00460      EXIT.                                                           CL**2
00461                                                                    DCRPT23
00462 *                                                                    CL**2
00463 *   FORMAT WARNING AND INFORMATION MESSAGES                          CL**2
00464 *                                                                    CL**2
00465  3710-NOCAT-DATA.                                                    CL**2
00466      MOVE NO-CAT-MSG   TO        STD-RPT-MESSAGE.                    CL**2
00467      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00468          MOVE "Y" TO CATEGORY-811-SW.                                CL**2
00469      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00470      GO TO 1100-NEXT-OUTPUT.                                         CL**2
00471  3715-NOCAT-LINE.                                                    CL**2
00472      MOVE NO-LINES-MSG  TO       STD-RPT-MESSAGE.                    CL**2
00473      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00474          MOVE "Y" TO CATEGORY-811-SW.                                CL**2
00475      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00476      GO TO 1100-NEXT-OUTPUT.                                         CL**2
00477                                                                    DCRPT23
00478  3800-NOMORE-HITS.                                                   CL**2
00479 *                                                                    CL**2
00480 *    ON-LINE VERSION WILL DETERMINE NEXT STEP HERE                   CL**2
00481 *                                                                    CL**2
00482      GO TO 1500-REPORT-END.                                          CL**2
00483                                                                    DCRPT23
00484 *****************************************************************    CL**2
00485 *                                                                    CL**2
00486 *    FORMAT CATEGORY 010 DETAIL LINE                                 CL**2
00487 *        CATEGORY 010 = CONTROL                                      CL**2
00488 *                                                                    CL**2
00489 *****************************************************************    CL**2
00490  5100-FMT-CAT010.                                                    CL**2
00491      MOVE SPACES TO CAT00010-LINE.                                   CL**2
00492 *                                                                    CL**2
00493 *    FORMAT ALIAS VERSION FIELD                                      CL**2
00494 *                                                                    CL**2
00495  5105-FMT-FLD05.                                                     CL**2
00496      IF CTL-ALY-VER EQUAL TO SPACES GO TO 5110-FMT-FLD010.           CL**2
00497      IF DATA-ENTRY-TYPE GREATER THAN 15                              CL**2
00498          MOVE FLD0001005-HCONV TO FLD0001005-HDG                     CL**2
00499       ELSE                                                           CL**2
00500          MOVE FLD0001005-HCONA TO FLD0001005-HDG.                    CL**2
00501      MOVE CTL-ALY-VER TO FLD0001005-VAL.                             CL**2
00502 *                                                                    CL**2
00503 *     FORMAT STATUS FIELD                                            CL**2
00504 *                                                                    CL**2
00505  5110-FMT-FLD010.                                                    CL**2
00506      IF CTL-STATUS EQUAL TO SPACES GO TO 5115-FMT-FLD015.            CL**2
00507      MOVE FLD0001010-HCON TO FLD0001010-HDG.                         CL**2
00508          GO TO 5112-INTERPRET-CODE.                                  CL**2
00509  5111-JUST-CODE.                                                     CL**2
00510      MOVE CTL-STATUS TO FLD0001010-POS1.                             CL**2
00511      GO TO 5115-FMT-FLD015.                                          CL**2
00512  5112-INTERPRET-CODE.                                                CL**2
00513      MOVE 01 TO SUB3.                                                CL**2
00514  5113-NEXT-CODE-CK.                                                  CL**2
00515      IF FLD0001010-CODES (SUB3) EQUAL TO "9"                         CL**2
00516          GO TO 5111-JUST-CODE.                                       CL**2
00517      IF FLD0001010-CODES (SUB3) EQUAL TO CTL-STATUS                  CL**2
00518          GO TO 5114-EXTRACT-MNG.                                     CL**2
00519      ADD 1 TO SUB3.                                                  CL**2
00520      GO TO 5113-NEXT-CODE-CK.                                        CL**2
00521  5114-EXTRACT-MNG.                                                   CL**2
00522      MOVE FLD0001010-MNG (SUB3) TO FLD0001010-VAL.                   CL**2
00523 *                                                                    CL**2
00524 *     FORMAT SECURITY FIELD                                          CL**2
00525 *                                                                    CL**2
00526  5115-FMT-FLD015.                                                    CL**2
00527      IF CTL-SECURITY EQUAL TO SPACES                                 CL**2
00528          GO TO 5120-OUTPUT-LINE.                                     CL**2
00529      MOVE FLD0001015-HCON TO FLD0001015-HDG.                         CL**2
00530      MOVE CTL-SECURITY    TO FLD0001015-VAL.                         CL**2
00531 *                                                                    CL**2
00532 *     FORMATTING OF CATEGORY LINE COMPLETE                           CL**2
00533  5120-OUTPUT-LINE.                                                   CL**2
00534      IF CAT00010-LINE EQUAL TO SPACES GO TO 5199-FMT-CAT010-XIT.     CL**2
00535      MOVE CAT00010-LINE TO STDRPT-70CHR.                             CL**2
00536      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00537 *                                                                    CL**2
00538  5199-FMT-CAT010-XIT.                                                CL**2
00539      EXIT.                                                           CL**2
00540                                                                    DCRPT23
00541 *****************************************************************    CL**2
00542 *                                                                    CL**2
00543 *    FORMAT CATEGORY 020 LINE                                        CL**2
00544 *        CATEGORY 020 = KEYWORD                                      CL**2
00545 *                                                                    CL**2
00546 *****************************************************************    CL**2
00547  5200-FMT-CAT020.                                                    CL**2
00548      MOVE SPACES TO CAT00020-LINE.                                   CL**2
00549 *                                                                    CL**2
00550 *    FORMAT KEYWORD FIELD                                            CL**2
00551 *                                                                    CL**2
00552  5205-FMT-FLD05.                                                     CL**2
00553      MOVE FLD0002005-HCON TO FLD0002005-HDG.                         CL**2
00554      MOVE KEY-WORDS TO FLD0002005-VAL.                               CL**2
00555 *                                                                    CL**2
00556 *    FORMATTING OF CATEGORY LINE COMPLETE                            CL**2
00557 *                                                                    CL**2
00558  5210-OUTPUT-LINE.                                                   CL**2
00559      MOVE CAT00020-LINE TO STDRPT-70CHR.                             CL**2
00560      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00561  5299-FMT-CAT020-XIT.                                                CL**2
00562      EXIT.                                                           CL**2
00563                                                                    DCRPT23
00564 *****************************************************************    CL**2
00565 *                                                                    CL**2
00566 *    FORMAT CATEGORY 030 LINE                                        CL**2
00567 *        CATEGORY 030 = DESCRIPTION                                  CL**2
00568 *                                                                    CL**2
00569 *****************************************************************    CL**2
00570  5300-FMT-CAT030.                                                    CL**2
00571      MOVE SPACES TO CAT00030-LINE.                                   CL**2
00572      MOVE DESC-FLAG      TO FLD0003005-VAL.                          CL**2
00573      MOVE DESC-COMMENT   TO FLD0003010-VAL.                          CL**2
00574  5310-OUTPUT-LINE.                                                   CL**2
00575      MOVE CAT00030-LINE  TO STDRPT-70CHR.                            CL**2
00576      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00577  5399-FMT-CAT030-XIT.                                                CL**2
00578      EXIT.                                                           CL**2
00579                                                                    DCRPT23
00580 *****************************************************************    CL**2
00581 *                                                                    CL**2
00582 *    FORMAT CATEGORY 900 LINE                                        CL**2
00583 *        CATEGORY 900 = OTHER                                        CL**2
00584 *****************************************************************    CL**2
00585  5900-FMT-CAT900.                                                    CL**2
00586      MOVE SPACES TO CAT00900-LINE.                                   CL**2
00587      MOVE DESC-FLAG      TO FLD0090005-VAL.                          CL**2
00588      MOVE DESC-COMMENT   TO FLD0090010-VAL.                          CL**2
00589  5910-OUTPUT-LINE.                                                   CL**2
00590      MOVE CAT00900-LINE TO STDRPT-70CHR.                             CL**2
00591      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00592  5999-FMT-CAT900-XIT.                                                CL**2
00593      EXIT.                                                           CL**2
00594                                                                    DCRPT23
*CALL     RPTRT32                                                          CL**2
*CALL     DISPLAY2                                                         CL**2
*CALL     WRITELNI                                                         CL**2
00598  USER-ROUTINE.                                                       CL**2
00599      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00600          MOVE SUB-HEAD-811 TO PRINT-DATA                             CL**2
00601          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
00602          MOVE SUB-HEAD2-811 TO PRINT-DATA                            CL**2
00603      ELSE                                                            CL**2
00604          MOVE SUB-HEADING-LINE TO PRINT-DATA.                        CL**2
00605      ADD 2 TO LINE-CT.                                               CL**2
00606      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00607      MOVE SPACES TO PRINT-DATA.                                      CL**2
00608      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00609      IF SEC-PAGE-SW EQUAL TO "Y"                                     CL**2
00610          MOVE LIST-LINE-MSG TO CATA-NAME-LINE                        CL**2
00611          MOVE CONTINUATION-LINE TO PRINT-DATA                        CL**2
00612          MOVE 1 TO PRT-CTL                                           CL**2
00613          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
00614          MOVE 1 TO PRT-CTL                                           CL**2
00615          MOVE STATEMENT-LINE TO PRINT-DATA                           CL**2
00616          PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                     CL**2
00617      MOVE "Y" TO SEC-PAGE-SW.                                        CL**2
00618  USER-ROUTINE-XIT.                                                   CL**2
00619      EXIT.                                                           CL**2
*CALL     RPT811                                                           CL**2
00624                                                                    DCRPT23
*CALL     MAST1RFL                                                         CL**2
*CALL     MAST1RFC                                                         CL**2
*CALL     MAST1RNL                                                         CL**2
*CALL     MAST1EXT                                                         CL**2
*CALL     MAST1RDR                                                         CL**2
*CALL     MAST1ALG                                                         CL**2
