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