00001  IDENTIFICATION DIVISION.                                         01/18/99
00002  PROGRAM-ID.             DTSBE411.                                DTSBE411
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV006
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE411
00005  DATE-COMPILED.                                                   DTSBE411
00006      SKIP3                                                        DTSBE411
00007 *****                                                             DTSBE411
00008 *                                                                 DTSBE411
00009 *    CALLING SEQUENCE:  DTSBE411 CREATES DTSIR411 RECORDS.           CL**2
00010 *                       DTSBD800 CALLS DTSBR411                      CL**2
00011 *                                WHICH PRODUCES THE REPORT.          CL**2
00012 *                       DTSBE411 ALSO CREATES DTSIR907 RECORDS       CL**3
00013 *                       IF ANY UNUSUAL EVENT OCCURRS.                CL**3
00014 *                                                                    CL**2
00015 *    FUNCTION:  OPEN BANKRUPTCIES LIST EXTRACT.                   DTSBE411
00016 *                                                                 DTSBE411
00017 *                                                                 DTSBE411
00018 *    MODIFICATION LOG:                                            DTSBE411
00019 *                                                                 DTSBE411
00020 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE411
00021 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE411
00022 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBE411
00023 *                                                                 DTSBE411
00024 *                                                                 DTSBE411
00025 *  DESCRIPTION:                                                   DTSBE411
00026 *                                                                 DTSBE411
00027 *                                                                 DTSBE411
00028 *    INITIATION:                                                  DTSBE411
00029 *                                                                 DTSBE411
00030 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE411
00031 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE411
00032 *                                                                 DTSBE411
00033 *      NO PARAMETERS ARE INPUT.                                   DTSBE411
00034 *                                                                 DTSBE411
00035 *                                                                 DTSBE411
00036 *    PROCESSING:                                                  DTSBE411
00037 *                                                                 DTSBE411
00038 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (411R1).       DTSBE411
00039 *                                                                 DTSBE411
00040 *                                                                 DTSBE411
00041 *    TERMINATION:                                                 DTSBE411
00042 *                                                                 DTSBE411
00043 *      NO PROCESSING.                                             DTSBE411
00044 *                                                                 DTSBE411
00045 *                                                                 DTSBE411
00046 *    RECORDS READ:                                                DTSBE411
00047 *                                                                 DTSBE411
00048 *      MASTER:                                                    DTSBE411
00049 *                                                                 DTSBE411
00050 *        MCOL                                                     DTSBE411
00051 *                                                                 DTSBE411
00052 *                                                                 DTSBE411
00053 *      ALTERNATE INDEX:                                           DTSBE411
00054 *                                                                 DTSBE411
00055 *        NONE.                                                    DTSBE411
00056 *                                                                 DTSBE411
00057 *                                                                 DTSBE411
00058 *      REFERENCE:                                                 DTSBE411
00059 *                                                                 DTSBE411
00060 *        NONE.                                                    DTSBE411
00061 *                                                                 DTSBE411
00062 *                                                                 DTSBE411
00063 *    RECORDS UPDATED:                                             DTSBE411
00064 *                                                                 DTSBE411
00065 *        NONE.                                                    DTSBE411
00066 *                                                                 DTSBE411
00067 *                                                                 DTSBE411
00068 *    REPORT RECORDS WRITTEN:                                      DTSBE411
00069 *                                                                 DTSBE411
00070 *        R411  OPEN BANKRUPTCIES LIST.                            DTSBE411
00071 *        R907  UNUSUAL EVENTS REPORT RECORD.                      DTSBE411
00072 *                                                                 DTSBE411
00073 *                                                                 DTSBE411
00074 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE411
00075 *                                                                 DTSBE411
00076 *        NONE.                                                    DTSBE411
00077 *                                                                 DTSBE411
00078 *                                                                 DTSBE411
00079 *    MODULES CALLED:                                              DTSBE411
00080 *                                                                 DTSBE411
00081 *        DTSBU001  DATE CONVERSION/EDIT.                             CL**3
00082 *        DTSBU061  FIELD ZIP /FIELD REP ID.                          CL**3
00083 *        DTSBU910  MASTER FILE I/O.                                  CL**3
00084 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.      CL**3
00085 *                                                                 DTSBE411
00086 *                                                                 DTSBE411
00087 *    VERMONT REFERENCE:                                           DTSBE411
00088 *                                                                 DTSBE411
00089 *        ???????                                                  DTSBE411
00090 *                                                                 DTSBE411
00091 *****                                                             DTSBE411
00092      SKIP3                                                        DTSBE411
00093  ENVIRONMENT DIVISION.                                            DTSBE411
00094      SKIP3                                                        DTSBE411
00095  DATA DIVISION.                                                   DTSBE411
00096      SKIP3                                                        DTSBE411
00097  WORKING-STORAGE SECTION.                                         DTSBE411
000975 77  PAN-VALET PICTURE X(24) VALUE '006DTSBE411  01/18/99'.       DTSBE411
00098      SKIP3                                                        DTSBE411
00099  01  WRK-AREA.                                                    DTSBE411
00100      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +411.DTSBE411
00101      SKIP1                                                        DTSBE411
00102      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE411'.   CL**3
00103      SKIP3                                                        DTSBE411
00104      05  ABEND-MSG                       PIC  X(60).              DTSBE411
00105      EJECT                                                        DTSBE411
00106  01  MSG-AREA.                                                    DTSBE411
00107      05  MSG1-AREA.                                               DTSBE411
00108          10  MSG1-ID                 PIC  X(03)  VALUE '411'.     DTSBE411
00109          10  MSG1-TEXT.                                           DTSBE411
00110              15  FILLER              PIC  X(40)                   DTSBE411
00111                VALUE 'MPRF-BANKRUPTCY-OPEN-IND IS OUT OF SYNC '.  DTSBE411
00112              15  FILLER              PIC  X(40)                   DTSBE411
00113                VALUE 'WITH MCOL DATA ELEMENTS.  NOTIFY PROGRAM'.  DTSBE411
00114              15  FILLER              PIC  X(20)                   DTSBE411
00115                VALUE 'MER.'.                                      DTSBE411
00116  01  L001-LINK-AREA.                                              DTSBE411
00117  ++INCLUDE DTSIL001                                                  CL**3
00118      EJECT                                                        DTSBE411
00119  01  L061-LINK-AREA.                                              DTSBE411
00120  ++INCLUDE DTSIL061                                                  CL**3
00121      EJECT                                                        DTSBE411
00122  01  L910-LINK-AREA.                                              DTSBE411
00123  ++INCLUDE DTSIL910                                                  CL**3
00124      SKIP3                                                        DTSBE411
00125  01  MSKL-REC.                                                    DTSBE411
00126  ++INCLUDE DTSIMSKL                                                  CL**3
00127      EJECT                                                        DTSBE411
00128  01  MCOL-REC.                                                    DTSBE411
00129  ++INCLUDE DTSIMCOL                                                  CL**3
00130      EJECT                                                        DTSBE411
00131  01  R411-REC.                                                    DTSBE411
00132  ++INCLUDE DTSIR411                                                  CL**3
00133      EJECT                                                        DTSBE411
00134  01  R907-REC.                                                    DTSBE411
00135  ++INCLUDE DTSIR907                                                  CL**3
00136      EJECT                                                        DTSBE411
00137  LINKAGE SECTION.                                                 DTSBE411
00138      SKIP3                                                        DTSBE411
00139  01  LECM-LINK-AREA.                                              DTSBE411
00140  ++INCLUDE DTSILECM                                                  CL**3
00141      EJECT                                                        DTSBE411
00142  01  MPRF-LINK-REC.                                               DTSBE411
00143  ++INCLUDE DTSIMPRF                                                  CL**3
00144      EJECT                                                        DTSBE411
00145  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE411
00146                           MPRF-LINK-REC.                          DTSBE411
00147      SKIP2                                                        DTSBE411
00148      IF LECM-PROCESS-88                                           DTSBE411
00149          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE411
00150      ELSE                                                         DTSBE411
00151      IF LECM-INITIALIZE-88                                        DTSBE411
00152          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE411
00153      ELSE                                                         DTSBE411
00154      IF LECM-TERMINATE-88                                         DTSBE411
00155          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE411
00156      ELSE                                                         DTSBE411
00157          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE411
00158            TO ABEND-MSG                                           DTSBE411
00159          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE411
00160      SKIP2                                                        DTSBE411
00161      GOBACK.                                                      DTSBE411
00162      EJECT                                                        DTSBE411
00163  I0000-INITIALIZE.                                                DTSBE411
00164      SKIP2                                                           CL**2
00165      MOVE LENGTH OF R411-REC TO R411-LENGTH.                         CL**2
00166      MOVE '411'              TO R411-REC-TYPE.                       CL**2
00167      MOVE LENGTH OF R411-REC TO R907-LENGTH.                         CL**3
00168      MOVE '907'              TO R907-REC-TYPE.                       CL**3
00169      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE411
00170      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBE411
00171                           R907-MODULE-NAME.                       DTSBE411
00172      SKIP1                                                        DTSBE411
00173      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE411
00174      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE411
00175      SKIP2                                                        DTSBE411
00176  I0000-EXIT.                                                      DTSBE411
00177      EXIT.                                                        DTSBE411
00178      EJECT                                                        DTSBE411
00179 ***************************************************************   DTSBE411
00180 *  THIS IS THE PROCESS PARAGRAPH FOR THE MCOL RECORDS.            DTSBE411
00181 *  IF NO MCOL RECORD IS FOUND WHEN A BANKRUPT IS INDICATED        DTSBE411
00182 *  AN UNEXPLAINED EVENT RECORD IS WRITTEN.                        DTSBE411
00183 ***************************************************************   DTSBE411
00184                                                                   DTSBE411
00185  P0000-PROCESS.                                                   DTSBE411
00186                                                                   DTSBE411
00187      IF MPRF-BANKRP-NOT-OPEN-88                                   DTSBE411
00188          GO TO P0000-EXIT.                                        DTSBE411
00189                                                                   DTSBE411
00190      MOVE LOW-VALUES          TO  MCOL-KEY-AREA.                  DTSBE411
00191      MOVE MPRF-EMP-NO         TO  MCOL-EMP-NO.                    DTSBE411
00192      SET MCOL-COL-88          TO  TRUE.                           DTSBE411
00193      MOVE MCOL-KEY-AREA       TO  MSKL-KEY-AREA.                  DTSBE411
00194      PERFORM S910-READ THRU S910-EXIT.                            DTSBE411
00195                                                                   DTSBE411
00196      IF L910-NO-REC-88                                            DTSBE411
00197          PERFORM P2000-SETUP-R907 THRU P2000-EXIT                 DTSBE411
00198          PERFORM S946-WRITE-R907  THRU S946-EXIT                  DTSBE411
00199          GO TO P0000-EXIT.                                        DTSBE411
00200                                                                   DTSBE411
00201      MOVE MSKL-REC            TO  MCOL-REC.                       DTSBE411
00202                                                                   DTSBE411
00203      IF (MCOL-BNK-BANKRUPT-88)                                    DTSBE411
00204              AND                                                  DTSBE411
00205         (MCOL-BNK-DISCHRG-CLOSE-DATE = +0)                        DTSBE411
00206              AND                                                  DTSBE411
00207         (MCOL-BNK-DISMISS-DATE = +0)                              DTSBE411
00208          NEXT SENTENCE                                            DTSBE411
00209      ELSE                                                         DTSBE411
00210          PERFORM P2000-SETUP-R907 THRU P2000-EXIT                 DTSBE411
00211          PERFORM S946-WRITE-R907 THRU S946-EXIT                   DTSBE411
00212          GO TO P0000-EXIT.                                        DTSBE411
00213                                                                   DTSBE411
00214      PERFORM P1000-SETUP-R411  THRU  P1000-EXIT.                  DTSBE411
00215      PERFORM S946-WRITE-R411   THRU  S946-EXIT.                   DTSBE411
00216      SKIP2                                                        DTSBE411
00217  P0000-EXIT.                                                      DTSBE411
00218      EXIT.                                                        DTSBE411
00219      EJECT                                                        DTSBE411
00220 ***************************************************************   DTSBE411
00221 *  THIS PARAGRAPH SETS UP THE R411 EXTRACT RECORD.                DTSBE411
00222 ***************************************************************   DTSBE411
00223                                                                   DTSBE411
00224  P1000-SETUP-R411.                                                DTSBE411
00225                                                                   DTSBE411
00226      PERFORM S061-DETERMINE-FLD-REP  THRU  S061-EXIT.             DTSBE411
00227      MOVE L061-FLD-REP-ID          TO  R411-FIELD-REP-ID          DTSBE411
00228                                                                   DTSBE411
00229      MOVE MCOL-EMP-NO              TO  R411-EMP-NO.               DTSBE411
00230      MOVE MPRF-PRIMARY-NAME        TO  R411-PRIMARY-NAME.            CL**3
00231      MOVE MCOL-BNK-CHAPTER         TO  R411-BNK-CHAPTER.          DTSBE411
00232      MOVE MCOL-BNK-COURT-CASE-NO   TO  R411-BNK-COURT-CASE-NO.    DTSBE411
00233      MOVE MCOL-BNK-PETITION-DATE   TO  R411-BNK-PETITION-DATE.    DTSBE411
00234      MOVE MCOL-BNK-POC-FILED-DATE  TO  R411-BNK-POC-FILED-DATE.   DTSBE411
00235      MOVE MCOL-BNK-POC-REQUIRED-DATE                              DTSBE411
00236                                    TO R411-BNK-POC-REQUIRED-DATE. DTSBE411
00237      MOVE MCOL-BNK-LAST-COMM-DATE  TO  R411-BNK-LAST-COMM.        DTSBE411
00238                                                                   DTSBE411
00239  P1000-EXIT.                                                      DTSBE411
00240      EXIT.                                                        DTSBE411
00241      EJECT                                                        DTSBE411
00242 ***************************************************************   DTSBE411
00243 *  THIS PARAGRAPH SETS UP THE R907 UNEXPLAINED EVENT RECORD.      DTSBE411
00244 ***************************************************************   DTSBE411
00245                                                                   DTSBE411
00246  P2000-SETUP-R907.                                                DTSBE411
00247                                                                   DTSBE411
00248      MOVE MSG1-ID                  TO  R907-MSG-ID.               DTSBE411
00249      MOVE MPRF-EMP-NO              TO  R907-EMP-NO.               DTSBE411
00250      MOVE MSG1-TEXT                TO  R907-MSG-TEXT.             DTSBE411
00251                                                                   DTSBE411
00252  P2000-EXIT.                                                      DTSBE411
00253      EXIT.                                                        DTSBE411
00254      EJECT                                                        DTSBE411
00255  T0000-TERMINATE.                                                 DTSBE411
00256      SKIP2                                                        DTSBE411
00257      SKIP2                                                        DTSBE411
00258  T0000-EXIT.                                                      DTSBE411
00259      EXIT.                                                        DTSBE411
00260      EJECT                                                        DTSBE411
00261 *BO S001-FROM-FED-8.                                                 CL**4
00262 *     SET L001-FROM-FED-8 TO TRUE.                                   CL**4
00263 *     GO TO S001-DATE.                                               CL**4
00264      SKIP1                                                        DTSBE411
00265 *BO S001-FROM-CAL-6.                                                 CL**4
00266 *     SET L001-FROM-CAL-6 TO TRUE.                                   CL**4
00267 *     GO TO S001-DATE.                                               CL**4
00268      SKIP1                                                        DTSBE411
00269 *BO S001-FROM-ABS-DAY.                                               CL**4
00270 *     SET L001-FROM-ABS-DAY TO TRUE.                                 CL**4
00271 *     GO TO S001-DATE.                                               CL**4
00272      SKIP1                                                        DTSBE411
00273 *BO S001-DATE.                                                       CL**5
00274 *     CALL 'DTSBU001' USING L001-LINK-AREA.                          CL**5
00275  S001-EXIT.                                                       DTSBE411
00276      EXIT.                                                        DTSBE411
00277      SKIP3                                                        DTSBE411
00278  S061-DETERMINE-FLD-REP.                                          DTSBE411
00279      MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP.                           DTSBE411
00280      MOVE MPRF-EMP-NO TO L061-EMP-NO.                             DTSBE411
00281                                                                   DTSBE411
00282      CALL 'DTSBU061' USING L061-LINK-AREA.                           CL**3
00283  S061-EXIT.                                                       DTSBE411
00284      EXIT.                                                        DTSBE411
00285      SKIP3                                                        DTSBE411
00286  S910-READ.                                                       DTSBE411
00287      SET L910-READ-88 TO TRUE.                                    DTSBE411
00288      GO TO S910-MSTR-IO.                                          DTSBE411
00289      SKIP1                                                        DTSBE411
00290 *BOS910-START-BROWSE.                                                CL**4
00291 *     SET L910-START-BROWSE-88 TO TRUE.                              CL**4
00292 *     GO TO S910-MSTR-IO.                                            CL**4
00293      SKIP1                                                        DTSBE411
00294 *BO S910-READ-NEXT.                                                  CL**5
00295 *     SET L910-READ-NEXT-88 TO TRUE.                                 CL**5
00296 *     GO TO S910-MSTR-IO.                                            CL**5
00297      SKIP1                                                        DTSBE411
00298 *BO S910-COUNT.                                                      CL**6
00299 *     SET L910-COUNT-88 TO TRUE.                                     CL**6
00300 *     GO TO S910-MSTR-IO.                                            CL**6
00301      SKIP1                                                        DTSBE411
00302  S910-MSTR-IO.                                                    DTSBE411
00303      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**3
00304                            MSKL-REC.                              DTSBE411
00305  S910-EXIT.                                                       DTSBE411
00306      EXIT.                                                        DTSBE411
00307      SKIP3                                                        DTSBE411
00308  S946-WRITE-R411.                                                 DTSBE411
00309      CALL 'DTSBU946' USING R411-REC.                                 CL**3
00310      GO TO S946-EXIT.                                             DTSBE411
00311      SKIP1                                                        DTSBE411
00312  S946-WRITE-R907.                                                 DTSBE411
00313      CALL 'DTSBU946' USING R907-REC.                                 CL**3
00314      GO TO S946-EXIT.                                             DTSBE411
00315      SKIP1                                                        DTSBE411
00316  S946-EXIT.                                                       DTSBE411
00317      EXIT.                                                        DTSBE411
00318      SKIP3                                                        DTSBE411
00319  S999-ABEND.                                                      DTSBE411
00320      DISPLAY '*** DTSBE411 ABENDING.  '                              CL**3
00321              ABEND-MSG.                                           DTSBE411
00322      SKIP1                                                        DTSBE411
00323      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**3
00324  S999-EXIT.                                                       DTSBE411
00325      EXIT.                                                        DTSBE411
