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