*COMDECK  EXTOUT4 
00001                                                                    EXTOUT4
00002 **************************************************************    EXTOUT4 
00003 *                                                                    LV002
00004 *     FORMAT EXTRACT FILE DETAIL RECORDS                             CL**2
00005 *                                                                    CL**2
00006 **************************************************************       CL**2
00007 *    THIS SUBROUTINE FORMATS EXTRACT FILE RECORDS BASED ON THE    EXTOUT4 
00008 *        INFORMATION STORED IN RTBL.  OUTPUT RECORDS ARE TABLED   EXTOUT4 
00009 *        AND WHEN THE TABLE IS FULL CONTROL IS PASSED TO THE      EXTOUT4 
00010 *         CONTROL PROGRAM FOR OUTPUT                              EXTOUT4 
00011 *                                                                 EXTOUT4 
00012 **************************************************************       CL**2
00013  EXT-OUT.                                                         EXTOUT4 
00014 *                                                                 EXTOUT4 
00015 *    OUTPUT ERROR MESSAGE                                         EXTOUT4 
00016 *                                                                 EXTOUT4 
00017      IF MSG-SWITCH EQUAL "Y"                                         CL**2
00018          ADD 1 TO EXT-COUNT                                          CL**2
00019          MOVE ERROR-LINE TO EXT-OUT-REC (EXT-COUNT)                  CL**2
00020          MOVE "E" TO EXT-OUTPUT-IND (EXT-COUNT)                   EXTOUT4 
00021          MOVE "N" TO MSG-SWITCH                                   EXTOUT4 
00022          PERFORM EXT-OUT-CHECK THRU EXT-OUT-CHECK-XIT                CL**2
00023          GO TO EXT-OUT-XIT.                                          CL**2
00024 *                                                                 EXTOUT4 
00025 *    OUTPUT EXTRACT FILE RECORD                                   EXTOUT4 
00026 *                                                                 EXTOUT4 
00027      IF RTBL-HDR-REQTYPE EQUAL TO                                 EXTOUT4 
00028              "RR" OR "RS" OR "RT" OR "RW"  OR "RV" OR "RU"        EXTOUT4 
00029          GO TO EXT-OUT-CAT.                                       EXTOUT4 
00030      IF RTBL-HDR-REQTYPE EQUAL TO "RC" OR "RH" OR "RJ"               CL**2
00031          GO TO EXT-OUT-IDX.                                          CL**2
00032      GO TO EXT-OUT-XIT.                                           EXTOUT4 
00033 *************************************************                    CL**2
00034 *                                                                    CL**2
00035 *    FORMAT RECORDS FOR INDEX, NAME AND RELATIONAL REPORTS           CL**2
00036 ************************************************                     CL**2
00037  EXT-OUT-IDX.                                                        CL**2
00038      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00039          MOVE EXTRACT-CNAME TO HOLD-VALUE                            CL**2
00040          GO TO EXT-OUT-FMT.                                          CL**2
00041 *                                                                    CL**2
00042 *     LOCATE FIELD TO BE EXTRACTED IN ENTRY                          CL**2
00043 *        DETERMINE IF ENTRY CAN HAVE THE FIELD                       CL**2
00044 *                                                                    CL**2
00045      MOVE 1 TO NSUB1.                                                CL**2
00046  EXT-OUT-CK-TYPE.                                                    CL**2
00047      IF FFT-ENTTYPE (NSUB1) EQUAL SPACES                             CL**2
00048          GO TO EXT-OUT-XIT.                                          CL**2
00049      IF FFT-ENTTYPE (NSUB1) EQUAL EXTRACT-ENTTYPE                    CL**2
00050          GO TO EXT-OUT-GET-ENT.                                      CL**2
00051      IF NSUB1 EQUAL 15                                               CL**2
00052          GO TO EXT-OUT-XIT.                                          CL**2
00053      ADD 1 TO NSUB1.                                                 CL**2
00054      GO TO EXT-OUT-CK-TYPE.                                          CL**2
00055 *     RETRIEVE THE ENTRY                                             CL**2
00056 *                                                                    CL**2
00057  EXT-OUT-GET-ENT.                                                    CL**2
00058      MOVE EXTRACT-CNAME TO DATA-ENTRY-NAME.                          CL**2
00059      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00060      IF DATA-RETURN-CODE NOT EQUAL TO "0"                            CL**2
00061          GO TO EXT-OUT-XIT.                                          CL**2
00062      GO TO EXT-OUT-CAT-CK2.                                          CL**2
00063 *                                                                    CL**2
00064 *     CHECK THE CATEGORY                                             CL**2
00065 *                                                                    CL**2
00066  EXT-OUT-CAT-CK.                                                     CL**2
00067      MOVE 1 TO NSUB1.                                                CL**2
00068  EXT-OUT-CAT-CK2.                                                    CL**2
00069      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00070          GO TO EXT-OUT-NEXT-LINE.                                    CL**2
00071  EXT-OUT-CAT-COMP.                                                   CL**2
00072      IF FFT-ENTTYPE (NSUB1) EQUAL SPACES                             CL**2
00073          GO TO EXT-OUT-SAVE-CAT.                                     CL**2
00074      IF FFT-CATEGORY (NSUB1) EQUAL CAT-CATEGORY                      CL**2
00075        AND FFT-ENTTYPE (NSUB1) EQUAL EXTRACT-ENTTYPE                 CL**2
00076          GO TO EXT-OUT-MULT-LINES.                                   CL**2
00077      IF NSUB1 EQUAL 15                                               CL**2
00078          GO TO EXT-OUT-SAVE-CAT.                                     CL**2
00079      ADD 1 TO NSUB1.                                                 CL**2
00080      GO TO EXT-OUT-CAT-COMP.                                         CL**2
00081  EXT-OUT-SAVE-CAT.                                                   CL**2
00082      MOVE CAT-CATEGORY TO OLD-CAT.                                   CL**2
00083      GO TO EXT-OUT-SKIP-CAT.                                         CL**2
00084 *                                                                    CL**2
00085 *     MATCH-NOW CHECK FOR MULTIPLE LINE CATEGORY                     CL**2
00086 *                                                                    CL**2
00087  EXT-OUT-MULT-LINES.                                                 CL**2
      * 
      *    FIELD WAY-TO-GO DETERMINES WHETHER TO
      *    EXTRACT VALUE OR TO SKIP 
      *        G = EXTRACT
      *        S = SKIP 
      * 
           MOVE "G" TO WAY-TO-GO. 
      * 
      *    CHECK GROUP AND RECORD FOR STRUCTURE LINES 
      * 
           IF DATA-HDR-ENT-ID EQUAL "10"
             AND CAT-CATEGORY EQUAL TO "300"
               PERFORM EXT-OUT-GRP-STR THRU EXT-OUT-GRP-STR-EXIT
           END-IF 
  
           IF DATA-HDR-ENT-ID EQUAL "13"
             AND CAT-CATEGORY EQUAL TO "300"
               PERFORM EXT-OUT-REC-STR THRU EXT-OUT-REC-STR-EXIT
           END-IF 
      * 
      *    CHECK AREA FOR PROCESS LINE
      * 
           IF DATA-HDR-ENT-ID EQUAL "22"
             AND CAT-CATEGORY EQUAL TO "400"
               PERFORM EXT-OUT-AREA-PROCESS THRU
                   EXT-OUT-AREA-PROCESS-EXIT
           END-IF 
      * 
      *    CHECK AREA AND ACCESS LINES
      * 
           IF DATA-HDR-ENT-ID EQUAL "22"
             AND CAT-CATEGORY EQUAL TO "425"
               PERFORM EXT-OUT-AREA-ACC THRU
                   EXT-OUT-AREA-ACC-EXIT
           END-IF 
      * 
      *    CHECK AREA AND AREAKEY LINES 
      * 
           IF DATA-HDR-ENT-ID EQUAL "22"
             AND CAT-CATEGORY EQUAL TO "500"
               PERFORM EXT-OUT-AREA-KEYS THRU 
                   EXT-OUT-AREA-KEYS-EXIT 
           END-IF 
      * 
      *    CHECK SUBSCHEMA AND SSREL LINES
      * 
           IF DATA-HDR-ENT-ID EQUAL "24"
             AND CAT-CATEGORY EQUAL TO "525"
               PERFORM EXT-OUT-SS-SSREL THRU
                   EXT-OUT-SS-SSREL-EXIT
           END-IF 
      * 
      *    CHECK SCHEMA AND MD LINES
      * 
           IF DATA-HDR-ENT-ID EQUAL "26"
             AND CAT-CATEGORY EQUAL TO "450"
               PERFORM EXT-OUT-SCH-MD THRU
                   EXT-OUT-SCH-MD-EXIT
           END-IF 
      * 
      *    CHECK SCHEMA AND BOND LINES
      * 
           IF DATA-HDR-ENT-ID EQUAL "26"
             AND CAT-CATEGORY EQUAL TO "550"
               PERFORM EXT-OUT-SCH-BOND THRU
                   EXT-OUT-SCH-BOND-EXIT
           END-IF 
      * 
      *    CHECK SCHEMA AND JOIN LINES
      * 
           IF DATA-HDR-ENT-ID EQUAL "26"
             AND CAT-CATEGORY EQUAL TO "575"
               PERFORM EXT-OUT-SCH-JOIN THRU
                   EXT-OUT-SCH-JOIN-EXIT
           END-IF 
      * 
      *    NOW TEST WAY-TO-GO TO SEE WHETHER TO 
      *    SKIP OR GET FIELD
      * 
           IF WAY-TO-GO EQUAL "S" 
               GO TO EXT-OUT-SKIP-CAT 
           ELSE 
               GO TO EXT-OUT-GET-FLD
           END-IF 
  
       EXT-OUT-GRP-STR. 
           IF STC-LINE-TYPE EQUAL TO "A"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-A 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "D"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-D 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "O"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-O 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "I"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-I 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "K"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-K 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "R"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-R 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "Q"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-Q 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "T"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-T 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "2"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-GRP-LINE-2 
               GO TO EXT-OUT-GRP-STR-EXIT 
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-GRP-STR-EXIT.
           EXIT.
  
       EXT-OUT-REC-STR. 
           IF STC-LINE-TYPE EQUAL TO "A"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-A 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "B"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-B 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "C"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-C 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "D"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-D 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "O"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-O 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "I"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-I 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "K"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-K 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "R"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-R 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "Q"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-Q 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "T"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-T 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "2"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             STR-REC-LINE-2 
               GO TO EXT-OUT-REC-STR-EXIT 
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-REC-STR-EXIT.
           EXIT.
  
       EXT-OUT-AREA-KEYS. 
           IF STC-LINE-TYPE EQUAL TO "K"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             ARE-KEY-LINE-K 
               GO TO EXT-OUT-AREA-KEYS
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "C"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             ARE-KEY-LINE-C 
               GO TO EXT-OUT-AREA-KEYS
           END-IF 
           IF STC-LINE-TYPE EQUAL TO "I"
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             ARE-KEY-LINE-I 
               GO TO EXT-OUT-AREA-KEYS
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-AREA-KEYS-EXIT.
           EXIT.
  
       EXT-OUT-AREA-PROCESS.
           IF STC-LINE-TYPE EQUAL "P" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             ARE-PRO-LINE-P 
               GO TO EXT-OUT-AREA-PROCESS-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "R" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             ARE-PRO-LINE-R 
               GO TO EXT-OUT-AREA-PROCESS-EXIT
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-AREA-PROCESS-EXIT. 
           EXIT.
  
       EXT-OUT-AREA-ACC.
           IF STC-LINE-TYPE EQUAL "M" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             ARE-ACC-LINE-M 
               GO TO EXT-OUT-AREA-ACC-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "L" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             ARE-ACC-LINE-L 
               GO TO EXT-OUT-AREA-ACC-EXIT
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-AREA-ACC-EXIT. 
           EXIT.
  
       EXT-OUT-SS-SSREL.
           IF STC-LINE-TYPE EQUAL "R" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SS-REL-LINE-R
               GO TO EXT-OUT-SS-SSREL-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "I" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SS-REL-LINE-I
               GO TO EXT-OUT-SS-SSREL-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "Q" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SS-REL-LINE-Q
               GO TO EXT-OUT-SS-SSREL-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "2" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SS-REL-LINE-2
               GO TO EXT-OUT-SS-SSREL-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "B" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SS-REL-LINE-B
               GO TO EXT-OUT-SS-SSREL-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "3" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SS-REL-LINE-3
               GO TO EXT-OUT-SS-SSREL-EXIT
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-SS-SSREL-EXIT. 
           EXIT.
  
       EXT-OUT-SCH-MD.
           IF STC-LINE-TYPE EQUAL "L" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-MDI-LINE-L
               GO TO EXT-OUT-SCH-MD-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "P" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-MDI-LINE-P
               GO TO EXT-OUT-SCH-MD-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "T" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-MDI-LINE-T
               GO TO EXT-OUT-SCH-MD-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "R" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-MDI-LINE-R
               GO TO EXT-OUT-SCH-MD-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "Q" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-MDI-LINE-Q
               GO TO EXT-OUT-SCH-MD-EXIT
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-SCH-MD-EXIT. 
           EXIT.
  
       EXT-OUT-SCH-BOND.
           IF STC-LINE-TYPE EQUAL "N" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-CON-LINE-N
               GO TO EXT-OUT-SCH-BOND-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "O" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-CON-LINE-O
               GO TO EXT-OUT-SCH-BOND-EXIT
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-SCH-BOND-EXIT. 
           EXIT.
  
       EXT-OUT-SCH-JOIN.
           IF STC-LINE-TYPE EQUAL "A" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-JOI-LINE-A
               GO TO EXT-OUT-SCH-JOIN-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "B" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-JOI-LINE-B
               GO TO EXT-OUT-SCH-JOIN-EXIT
           END-IF 
           IF STC-LINE-TYPE EQUAL "C" 
             AND FFT-CTL-KEY (NSUB1) EQUAL TO 
             SC-JOI-LINE-C
               GO TO EXT-OUT-SCH-JOIN-EXIT
           END-IF 
           MOVE "S" TO WAY-TO-GO. 
       EXT-OUT-SCH-JOIN-EXIT. 
           EXIT.
00195 *                                                                    CL**2
00196 *     EXTRACT THE REQUESTED FIELD FROM THE LINE                      CL**2
00197 *                                                                    CL**2
00198  EXT-OUT-GET-FLD.                                                    CL**2
00199      MOVE SPACES TO HOLD-VALUE.                                      CL**2
00200      MOVE FFT-START (NSUB1) TO NSUB2.                                CL**2
00201      MOVE 1 TO NSUB3.                                                CL**2
00202  EXT-OUT-BYTE-GET.                                                   CL**2
00203      MOVE DETAIL-LINE (NSUB2) TO WORK-VALUE (NSUB3).                 CL**2
00204      ADD 1 TO NSUB3.                                                 CL**2
00205      IF NSUB3 GREATER THAN FFT-LENGTH (NSUB1)                        CL**2
00206          GO TO EXT-OUT-HV-VALUE.                                     CL**2
00207      ADD 1 TO NSUB2.                                                 CL**2
00208      GO TO EXT-OUT-BYTE-GET.                                         CL**2
00209 *                                                                    CL**2
00210 *     CHECK FOR BLANK FIELD-IF SO BYPASS THIS LINE                   CL**2
00211 *                                                                    CL**2
00212  EXT-OUT-HV-VALUE.                                                   CL**2
00213      IF HOLD-VALUE EQUAL SPACES                                      CL**2
00214          GO TO EXT-OUT-NEXT-LINE.                                    CL**2
00215                                                                    EXTOUT4
00216 *********************************************************            CL**2
00217 *                                                                    CL**2
00218 *      FORMAT OUTPUT RECORDS                                         CL**2
00219 *                                                                    CL**2
00220  EXT-OUT-FMT.                                                        CL**2
00221      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00222          MOVE ZEROES TO CAT-CATEGORY                                 CL**2
00223          MOVE ZEROES TO CAT-LINE.                                    CL**2
00224      IF RTBL-HDR-REQTYPE EQUAL "RJ"                                  CL**2
00225          GO TO EXT-OUT-RELATIONAL.                                   CL**2
00226      IF RTBL-HDR-REQTYPE EQUAL "RC"                                  CL**2
00227          GO TO EXT-OUT-NAME.                                         CL**2
00228 *************************************************                    CL**2
00229 *                                                                    CL**2
00230 *    FORMAT INDEX REPORT RECORDS                                     CL**2
00231 *                                                                    CL**2
00232 *************************************************                    CL**2
00233  EXT-OUT-INDEX.                                                      CL**2
00234      ADD 1 TO RTBL-SELECT-COUNT (RTBL-SUB).                          CL**2
00235      MOVE RTBL-HDR-REQTYPE TO EXT-IDX-REQTYPE.                       CL**2
00236      MOVE RTBL-HDR-REQNO   TO EXT-IDX-REQNO.                         CL**2
00237      MOVE "8"              TO EXT-IDX-RECTYPE.                       CL**2
00238      MOVE "002"            TO EXT-IDX-RECSEQ.                        CL**2
00239      MOVE RTBL-SUB TO EXTRACT-SELNO.                                 CL**2
00240 *                                                                    CL**2
00241 *     BY ENTRY TYPE FORMAT RECORD                                    CL**2
00242 *                                                                    CL**2
00243      IF RTBL-OPT-SEQ EQUAL "1"                                       CL**2
00244          MOVE EXTRACT-ENTTYPE TO EXT-IDX1-ENTTYPE.                   CL**2
00245 *                                                                    CL**2
00246 *     BY ENTRY TYPE IN REVERSE ORDER                                 CL**2
00247 *                                                                    CL**2
00248      IF RTBL-OPT-SEQ EQUAL "2"                                       CL**2
00249          SUBTRACT EXTRACT-ENTTYPE FROM 99                            CL**2
00250          GIVING EXT-IDX1-ENTTYPE.                                    CL**2
00251      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
00252          MOVE EXTRACT-CNAME TO EXT-IDX1-CATNAME                      CL**2
00253          MOVE EXTRACT-SELNO TO EXT-IDX1-SELNO                        CL**2
00254          MOVE CAT-CATEGORY  TO EXT-IDX1-CAT                          CL**2
00255          MOVE CAT-LINE      TO EXT-IDX1-LINE                         CL**2
00256          MOVE HOLD-VALUE    TO EXT-IDX1-VALUE                        CL**2
00257          GO TO EXT-OUT-IDX-TABLE.                                    CL**2
00258 *                                                                    CL**2
00259 *     BY NAME                                                        CL**2
00260 *                                                                    CL**2
00261      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
00262          MOVE EXTRACT-CNAME   TO EXT-IDX3-CATNAME                    CL**2
00263          MOVE EXTRACT-SELNO   TO EXT-IDX3-SELNO                      CL**2
00264          MOVE CAT-CATEGORY    TO EXT-IDX3-CAT                        CL**2
00265          MOVE CAT-LINE        TO EXT-IDX3-LINE                       CL**2
00266          MOVE HOLD-VALUE      TO EXT-IDX3-VALUE                      CL**2
00267          MOVE EXTRACT-ENTTYPE TO EXT-IDX3-ENTTYPE                    CL**2
00268          GO TO EXT-OUT-IDX-TABLE.                                    CL**2
00269 *                                                                    CL**2
00270 *     BY VALUE                                                       CL**2
00271 *                                                                    CL**2
00272      MOVE EXTRACT-CNAME   TO EXT-IDX5-CATNAME.                       CL**2
00273      MOVE EXTRACT-SELNO   TO EXT-IDX5-SELNO.                         CL**2
00274      MOVE CAT-CATEGORY    TO EXT-IDX5-CAT.                           CL**2
00275      MOVE CAT-LINE        TO EXT-IDX5-LINE.                          CL**2
00276      MOVE HOLD-VALUE      TO EXT-IDX5-VALUE.                         CL**2
00277      MOVE EXTRACT-ENTTYPE TO EXT-IDX5-ENTTYPE.                       CL**2
00278 *                                                                    CL**2
00279 *     TABLE OUTPUT INDEX RECORD                                      CL**2
00280 *                                                                    CL**2
00281  EXT-OUT-IDX-TABLE.                                                  CL**2
00282      ADD 1 TO EXT-COUNT.                                             CL**2
00283      MOVE "2" TO EXT-OUTPUT-IND (EXT-COUNT).                         CL**2
00284      MOVE EXT-INDEX-REC TO EXT-OUT-REC (EXT-COUNT).                  CL**2
00285      PERFORM EXT-OUT-CHECK THRU EXT-OUT-CHECK-XIT.                   CL**2
00286      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00287          GO TO EXT-OUT-XIT.                                          CL**2
00288      GO TO EXT-OUT-NEXT-LINE.                                        CL**2
00289                                                                    EXTOUT4
00290 **************************************************                   CL**2
00291 *                                                                    CL**2
00292 *    FORMAT NAME ANALYSIS REPORT RECORD                              CL**2
00293 *                                                                    CL**2
00294 *************************************************                    CL**2
00295  EXT-OUT-NAME.                                                       CL**2
00296      ADD 1 TO RTBL-SELECT-COUNT (RTBL-SUB).                          CL**2
00297      MOVE RTBL-HDR-REQTYPE TO EXT-NAM-REQTYPE.                       CL**2
00298      MOVE RTBL-HDR-REQNO TO EXT-NAM-REQNO.                           CL**2
00299      MOVE "8" TO EXT-NAM-RECTYPE.                                    CL**2
00300      MOVE "002" TO EXT-NAM-RECSEQ.                                   CL**2
00301      MOVE RTBL-SUB TO EXTRACT-SELNO.                                 CL**2
00302 *                                                                    CL**2
00303 *    ENTRY TYPE AND REVERSE ENTRY TYPE SEQ                           CL**2
00304 *                                                                    CL**2
00305      IF RTBL-OPT-SEQ EQUAL "1"                                       CL**2
00306          MOVE EXTRACT-ENTTYPE TO EXT-NAM1-ENTTYPE.                   CL**2
00307      IF RTBL-OPT-SEQ EQUAL "2"                                       CL**2
00308          SUBTRACT EXTRACT-ENTTYPE FROM 99                            CL**2
00309          GIVING EXT-NAM1-ENTTYPE.                                    CL**2
00310      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
00311          MOVE EXTRACT-CNAME    TO EXT-NAM1-CATNAME                   CL**2
00312          MOVE EXTRACT-SELNO    TO EXT-NAM1-SELNO                     CL**2
00313          MOVE CAT-CATEGORY     TO EXT-NAM1-CAT                       CL**2
00314          MOVE CAT-LINE         TO EXT-NAM1-LINE                      CL**2
00315          MOVE HOLD-VALUE       TO EXT-NAM1-NAMFULL                   CL**2
00316          GO TO EXT-OUT-COMP.                                         CL**2
00317 *                                                                    CL**2
00318 *    BY NAME (DATA CATALOGUE NAME) SEQUENCE FORMAT                   CL**2
00319 *                                                                    CL**2
00320      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
00321          MOVE EXTRACT-ENTTYPE  TO EXT-NAM3-ENTTYPE                   CL**2
00322          MOVE EXTRACT-CNAME    TO EXT-NAM3-CATNAME                   CL**2
00323          MOVE EXTRACT-SELNO    TO EXT-NAM3-SELNO                     CL**2
00324          MOVE CAT-CATEGORY     TO EXT-NAM3-CAT                       CL**2
00325          MOVE CAT-LINE         TO EXT-NAM3-LINE                      CL**2
00326          MOVE HOLD-VALUE       TO EXT-NAM3-NAMFULL                   CL**2
00327          GO TO EXT-OUT-COMP.                                         CL**2
00328 *                                                                    CL**2
00329 *    BY COMPONENT OF NAME SEQUENCE FORMAT                            CL**2
00330 *                                                                    CL**2
00331      MOVE EXTRACT-ENTTYPE   TO EXT-NAM5-ENTTYPE.                     CL**2
00332      MOVE EXTRACT-CNAME     TO EXT-NAM5-CATNAME.                     CL**2
00333      MOVE EXTRACT-SELNO     TO EXT-NAM5-SELNO.                       CL**2
00334      MOVE CAT-CATEGORY      TO EXT-NAM5-CAT.                         CL**2
00335      MOVE CAT-LINE          TO EXT-NAM5-LINE.                        CL**2
00336      MOVE HOLD-VALUE        TO EXT-NAM5-NAMFULL.                     CL**2
00337 *                                                                    CL**2
00338 *    BREAK THE NAME INTO ITS COMPONENTS                              CL**2
00339 *                                                                    CL**2
00340 *       OUTPUT A NAME ANALYSIS REPORT RECORD FOR EACH                CL**2
00341 *       PART OF THE NAME.  BRKCHR DEFINED IN OPTIONS                 CL**2
00342 *       DIVIDES PARTS-SPACE ENDS THE NAME AND THE SCAN               CL**2
00343 *                                                                    CL**2
00344  EXT-OUT-COMP.                                                       CL**2
00345      MOVE SPACES TO HOLD-COMP.                                       CL**2
00346      MOVE 1 TO NSUB4.                                                CL**2
00347      MOVE 1 TO NSUB5.                                                CL**2
00348  EXT-OUT-GET-COMP.                                                   CL**2
00349      IF WORK-VALUE (NSUB4) EQUAL RTBL-OPT-BRECHR                     CL**2
00350          GO TO EXT-OUT-HAVE-COMP.                                    CL**2
00351      IF WORK-VALUE (NSUB4) EQUAL TO SPACE                            CL**2
00352          GO TO EXT-OUT-HAVE-COMP.                                    CL**2
00353      MOVE WORK-VALUE (NSUB4) TO COMP-VALUE (NSUB5).                  CL**2
00354      ADD 1 TO NSUB5.                                                 CL**2
00355  EXT-OUT-NCOMP.                                                      CL**2
00356      ADD 1 TO NSUB4.                                                 CL**2
00357  EXT-OUT-CK-OVER.                                                    CL**2
00358      IF NSUB4 GREATER THAN 32                                        CL**2
00359          GO TO EXT-OUT-HAVE-COMP.                                    CL**2
00360      GO TO EXT-OUT-GET-COMP.                                         CL**2
00361  EXT-OUT-HAVE-COMP.                                                  CL**2
00362      IF HOLD-COMP EQUAL SPACES                                       CL**2
00363          GO TO EXT-OUT-NAM-END.                                      CL**2
00364 *                                                                    CL**2
00365 *    TABLE EXTRACT FILE RECORD FOR THIS PART OF NAME                 CL**2
00366 *                                                                    CL**2
00367      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
00368          MOVE HOLD-COMP TO EXT-NAM1-NAMCOMP                          CL**2
00369          GO TO EXT-OUT-NAM-TBL.                                      CL**2
00370      IF RTBL-OPT-SEQ EQUAL "3"                                       CL**2
00371          MOVE HOLD-COMP TO EXT-NAM3-NAMCOMP                          CL**2
00372      ELSE                                                            CL**2
00373          MOVE HOLD-COMP TO EXT-NAM5-NAMCOMP.                         CL**2
00374  EXT-OUT-NAM-TBL.                                                    CL**2
00375      ADD 1 TO EXT-COUNT.                                             CL**2
00376      MOVE "3" TO EXT-OUTPUT-IND (EXT-COUNT).                         CL**2
00377      MOVE EXT-NAME-REC TO EXT-OUT-REC (EXT-COUNT).                   CL**2
00378      PERFORM EXT-OUT-CHECK THRU EXT-OUT-CHECK-XIT.                   CL**2
00379 *                                                                    CL**2
00380 *    DETERMINE IF MORE PARTS REMAIN                                  CL**2
00381 *                                                                    CL**2
00382      IF WORK-VALUE (NSUB4) EQUAL TO RTBL-OPT-BRECHR                  CL**2
00383          MOVE SPACES TO HOLD-COMP                                    CL**2
00384          MOVE 1 TO NSUB5                                             CL**2
00385          GO TO EXT-OUT-NCOMP.                                        CL**2
00386  EXT-OUT-NAM-END.                                                    CL**2
00387      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00388          GO TO EXT-OUT-XIT.                                          CL**2
00389      GO TO EXT-OUT-NEXT-LINE.                                        CL**2
00390                                                                    EXTOUT4
00391 ************************************************                     CL**2
00392 *                                                                    CL**2
00393 *    FORMAT AND WRITE RELATIONAL REPORT WORK FILE RECORDS            CL**2
00394 *                                                                    CL**2
00395 ***********************************************                      CL**2
00396  EXT-OUT-RELATIONAL.                                                 CL**2
00397      IF REL-1ST-SW EQUAL "Y"                                         CL**2
00398          MOVE "N" TO REL-1ST-SW                                      CL**2
00399          OPEN OUTPUT RELATIONAL-WORK-FILE.                           CL**2
00400      ADD 1 TO RTBL-SELECT-COUNT (RTBL-SUB).                          CL**2
00401      MOVE RTBL-HDR-REQTYPE TO REL-WORK-REQTYPE.                      CL**2
00402      MOVE RTBL-HDR-REQNO TO REL-WORK-REQNO.                          CL**2
00403      MOVE "D" TO REL-WORK1-RECCODE.                                  CL**2
00404      MOVE "8" TO REL-WORK-RECTYPE.                                   CL**2
00405      MOVE "002" TO REL-WORK-RECSEQ.                                  CL**2
00406      MOVE EXTRACT-ENTTYPE TO REL-WORK1-ENTTYPE.                      CL**2
00407      MOVE HOLD-VALUE TO REL-WORK1-NAME.                              CL**2
00408      MOVE CAT-CATEGORY TO REL-WORK1-CAT.                             CL**2
00409      MOVE CAT-LINE TO REL-WORK1-LINE.                                CL**2
00410      MOVE EXTRACT-CNAME TO REL-WORK1-CATNAME.                        CL**2
00411      MOVE HOLD-VALUE TO SORT-FIRST-5.                                CL**2
00412      MOVE RTBL-SUB TO REL-WORK1-SELNO.                               CL**2
00413      ADD 1 TO EXTRACT-RETNO.                                         CL**2
00414                                                                      CL**2
00415      MOVE EXTRACT-RETNO TO SORT-LAST-5.                              CL**2
00416      MOVE SORT-WORK TO REL-WORK1-SORTID.                             CL**2
00417      IF RTBL-HDR-IDXFNAME NOT EQUAL "CATNAME"                        CL**2
00418          MOVE FFT-HEADER (NSUB1) TO REL-WORK1-HEADER                 CL**2
00419          MOVE FFT-ID (NSUB1) TO REL-WORK1-ID                         CL**2
00420      ELSE                                                            CL**2
00421          MOVE "CATNAME" TO REL-WORK-FLDNO.                           CL**2
00422      WRITE REL-WORK-REC.                                             CL**2
00423      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00424          GO TO EXT-OUT-XIT.                                          CL**2
00425 ************************************************                     CL**2
00426 *                                                                    CL**2
00427 *    READ NEXT CATEGORY LINE OF CURRENT ENTRY                        CL**2
00428 *                                                                    CL**2
00429 ************************************************                     CL**2
00430  EXT-OUT-NEXT-LINE.                                                  CL**2
00431      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00432      IF DATA-RETURN-CODE EQUAL "1"                                   CL**2
00433          GO TO EXT-OUT-XIT.                                          CL**2
00434      IF CAT-COMMENT EQUAL "*"                                        CL**2
00435          GO TO EXT-OUT-NEXT-LINE.                                    CL**2
00436      IF CAT-CATEGORY EQUAL FFT-CATEGORY (NSUB1)                      CL**2
00437          GO TO EXT-OUT-MULT-LINES.                                   CL**2
00438      GO TO EXT-OUT-CAT-CK.                                           CL**2
00439 ************************************************                     CL**2
00440 *                                                                    CL**2
00441 *    BYPASS REMAINING LINES OF CURRENT CATEGORY                      CL**2
00442 *                                                                    CL**2
00443 ***********************************************                      CL**2
00444  EXT-OUT-SKIP-CAT.                                                   CL**2
00445      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00446      IF DATA-RETURN-CODE EQUAL "1"                                   CL**2
00447          GO TO EXT-OUT-XIT.                                          CL**2
00448      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00449          GO TO EXT-OUT-SKIP-CAT.                                     CL**2
00450      IF CAT-CATEGORY EQUAL OLD-CAT                                   CL**2
00451          GO TO EXT-OUT-SKIP-CAT.                                     CL**2
00452      GO TO EXT-OUT-CAT-CK.                                           CL**2
00453 ************************************************************      EXTOUT4 
00454 *                                                                 EXTOUT4 
00455 *    FORMAT RECORD FOR CATALOGUE/USAGE/HIERARCHY REPORTS          EXTOUT4 
00456 *                                                                 EXTOUT4 
00457 **************************************************************    EXTOUT4 
00458  EXT-OUT-CAT.                                                     EXTOUT4 
00459      ADD 1 TO EXT-COUNT.                                             CL**2
00460      ADD 1 TO RTBL-SELECT-COUNT (RTBL-SUB).                          CL**2
00461      MOVE RTBL-HDR-REQTYPE TO EXT-CAT-REQTYPE.                    EXTOUT4 
00462      MOVE RTBL-HDR-REQNO TO EXT-CAT-REQNO.                        EXTOUT4 
00463      MOVE "8" TO EXT-CAT-RECTYPE.                                 EXTOUT4 
00464      MOVE "002" TO EXT-CAT-RECSEQ.                                   CL**2
00465 *                                                                    CL**2
00466 *   TOP OR BOTTOM OF HIERARCHY HAS RELEVE OF ZERO                    CL**2
00467 *                                                                    CL**2
00468      IF EXTRACT-RETLEV EQUAL 99                                      CL**2
00469          MOVE ZEROES TO EXTRACT-RETLEV                               CL**2
00470      ELSE                                                            CL**2
00471          MOVE KEY-CNT TO EXTRACT-RETLEV                              CL**2
00472          ADD 1 TO EXTRACT-RETLEV.                                    CL**2
00473      MOVE RTBL-SUB TO EXTRACT-SELNO.                                 CL**2
00474      ADD 1 TO EXTRACT-RETNO.                                         CL**2
00475 *                                                                 EXTOUT4 
00476 *    BY ENTRY TYPE AND REVERSE ENTRY TYPE SEQ                        CL**2
00477 *                                                                 EXTOUT4 
00478      IF RTBL-OPT-SEQ EQUAL TO "1"                                 EXTOUT4 
00479          MOVE EXTRACT-ENTTYPE TO EXT-CAT1-ENTTYPE.                   CL**2
00480      IF RTBL-OPT-SEQ EQUAL TO "2"                                 EXTOUT4 
00481          SUBTRACT EXTRACT-ENTTYPE FROM 99                         EXTOUT4 
00482          GIVING EXT-CAT1-ENTTYPE.                                    CL**2
00483      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
00484          MOVE EXTRACT-CNAME TO EXT-CAT1-CATNAME                   EXTOUT4 
00485          MOVE EXTRACT-RETNO TO EXT-CAT1-RETNO                     EXTOUT4 
00486          MOVE EXTRACT-RETLEV TO EXT-CAT1-RETLEV                   EXTOUT4 
00487          MOVE EXTRACT-SELNO TO EXT-CAT1-SELNO                     EXTOUT4 
00488          GO TO EXT-OUT-TABLE.                                        CL**2
00489 *                                                                 EXTOUT4 
00490 *    BY CATALOGOUE NAME                                           EXTOUT4 
00491 *                                                                 EXTOUT4 
00492      IF RTBL-OPT-SEQ EQUAL TO "3"                                 EXTOUT4 
00493          MOVE EXTRACT-ENTTYPE TO EXT-CAT3-ENTTYPE                 EXTOUT4 
00494          MOVE EXTRACT-CNAME TO EXT-CAT3-CATNAME                   EXTOUT4 
00495          MOVE EXTRACT-RETNO TO EXT-CAT3-RETNO                     EXTOUT4 
00496          MOVE EXTRACT-RETLEV TO EXT-CAT3-RETLEV                   EXTOUT4 
00497          MOVE EXTRACT-SELNO TO EXT-CAT3-SELNO                     EXTOUT4 
00498          GO TO EXT-OUT-TABLE.                                     EXTOUT4 
00499 *                                                                 EXTOUT4 
00500 *    BY ORDER OF RETRIEVAL-(SEQ CODE 4 ASSUMED)                   EXTOUT4 
00501 *                                                                 EXTOUT4 
00502      MOVE EXTRACT-ENTTYPE TO EXT-CAT4-ENTTYPE.                    EXTOUT4 
00503      MOVE EXTRACT-CNAME TO EXT-CAT4-CATNAME.                      EXTOUT4 
00504      MOVE EXTRACT-RETNO TO EXT-CAT4-RETNO.                        EXTOUT4 
00505      MOVE EXTRACT-RETLEV TO EXT-CAT4-RETLEV.                      EXTOUT4 
00506      MOVE EXTRACT-SELNO TO EXT-CAT4-SELNO.                        EXTOUT4 
00507 *                                                                 EXTOUT4 
00508 *    TABLE RECORD                                                 EXTOUT4 
00509 *                                                                 EXTOUT4 
00510  EXT-OUT-TABLE.                                                   EXTOUT4 
00511      MOVE "1" TO EXT-OUTPUT-IND (EXT-COUNT).                      EXTOUT4 
00512      MOVE EXT-CATALOGUE-REC TO EXT-OUT-REC (EXT-COUNT).              CL**2
00513      PERFORM EXT-OUT-CHECK THRU EXT-OUT-CHECK-XIT.                   CL**2
00514      GO TO EXT-OUT-XIT.                                              CL**2
00515  EXT-OUT-CHECK.                                                   EXTOUT4 
00516      IF EXT-COUNT GREATER 29                                         CL**2
           CLOSE MAST1                                                  000172
00517          MOVE "4" TO RTBL-MOD-REQ                                 EXTOUT4 
00518          EXIT PROGRAM.                                             EXTOUT4
00519      GO TO EXT-OUT-CHECK-XIT.                                        CL**2
00520  EXT-OUT-RETURN.                                                  EXTOUT4 
           OPEN INPUT MAST1                                             000174
00521      MOVE ZERO TO EXT-COUNT.                                      EXTOUT4 
00522      MOVE ZERO TO RTBL-MOD-REQ.                                   EXTOUT4 
00523  EXT-OUT-CHECK-XIT.                                                  CL**2
00524      EXIT.                                                           CL**2
00525  EXT-OUT-XIT.                                                     EXTOUT4 
00526      EXIT.                                                           CL**2
