00001 IDENTIFICATION DIVISION. 09/04/24 00002 PROGRAM-ID. DTSBS411. DTSBS411 00003 AUTHOR. SC. LV135 00004 DATE-WRITTEN. MAY 2024. CL*29 00005 DATE-COMPILED. DTSBS411 00006 SKIP3 DTSBS411 00007 ***** DTSBS411 00008 * DTSBS411 00009 * FUNCTION: EXTRACT ALL THE ACCOUNTS CREATED YESTERDAY CL*29 00010 * DTSBS411 00011 * DTSBS411 00012 * MODIFICATION LOG: DTSBS411 00013 * DTSBS411 00014 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBS411 00015 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBS411 00016 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBS411 00017 * DTSBS411 00018 * DTSBS411 00019 * DESCRIPTION: DTSBS411 00020 * DTSBS411 00021 * DTSBS411 00022 * INITIATION: DTSBS411 00023 * DTSBS411 00024 * DTSBS411 00025 * DTSBS411 00026 * PROCESSING: DTSBS411 00027 * DTSBS411 00028 * DTSBS411 00029 * TERMINATION: DTSBS411 00030 * DTSBS411 00031 * DTSBS411 00032 * DTSBS411 00033 * RECORDS READ: DTSBS411 00034 * DTSBS411 00035 * MASTER: DTSBS411 00036 * DTSBS411 00037 * MSOL DTSBS411 00038 * MQTR DTSBS411 00039 * DTSBS411 00040 * DTSBS411 00041 * ALTERNATE INDEX: DTSBS411 00042 * DTSBS411 00043 * NONE. DTSBS411 00044 * DTSBS411 00045 * DTSBS411 00046 * REFERENCE: DTSBS411 00047 * DTSBS411 00048 * DTSBS411 00049 * DTSBS411 00050 * RECORDS UPDATED: DTSBS411 00051 * DTSBS411 00052 * NONE DTSBS411 00053 * DTSBS411 00054 * DTSBS411 00055 * OUTPUT RECORDS WRITTEN: DTSBS411 00056 * DTSBS411 00057 * DTSBS411 00058 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBS411 00059 * DTSBS411 00060 * NONE. DTSBS411 00061 * DTSBS411 00062 * DTSBS411 00063 * MODULES CALLED: DTSBS411 00064 * DTSBS411 00065 * DTSBU910 MASTER FILE I/O. DTSBS411 00066 * DTSBS411 00067 * DTSBS411 00068 * DTSBS411 00069 ***** DTSBS411 00070 SKIP3 DTSBS411 00071 ENVIRONMENT DIVISION. DTSBS411 00072 INPUT-OUTPUT SECTION. DTSBS411 00073 FILE-CONTROL. DTSBS411 00074 SELECT CURR-PREV-FILE ASSIGN TO DTSFCPRE CL*90 00075 FILE STATUS IS CURR-PREV-STATUS. CL*90 00076 DTSBS411 00077 SELECT CURR-MINI-FILE ASSIGN TO DTSFCURR CL*90 00078 FILE STATUS IS CURR-MINI-STATUS. CL*90 00079 CL*90 00080 SELECT CURR-MINI-RPT ASSIGN TO DTSFCRPT CL114 00081 FILE STATUS IS CURR-RPT-STATUS. CL114 00082 CL114 00083 SELECT SENT-MINI-FILE ASSIGN TO DTSFSENT CL*80 00084 FILE STATUS IS SENT-MINI-STATUS. CL*82 00085 CL114 00086 SELECT SENT-MINI-RPT ASSIGN TO DTSFSRPT CL114 00087 FILE STATUS IS SENT-RPT-STATUS. CL114 00088 CL*80 00089 DTSBS411 00090 DATA DIVISION. DTSBS411 00091 FILE SECTION. DTSBS411 00092 FD CURR-PREV-FILE CL*90 00093 RECORDING MODE IS F DTSBS411 00094 LABEL RECORDS ARE STANDARD DTSBS411 00095 BLOCK CONTAINS 0 CHARACTERS. DTSBS411 00096 DTSBS411 00097 01 CURR-PREV-REC PIC X(80). CL*90 00098 CL*48 00099 FD CURR-MINI-FILE CL*90 00100 RECORDING MODE IS F CL*90 00101 LABEL RECORDS ARE STANDARD CL*90 00102 BLOCK CONTAINS 0 CHARACTERS. CL*90 00103 CL*90 00104 01 CURR-MINI-REC PIC X(80). CL*90 00105 CL*90 00106 FD CURR-MINI-RPT CL114 00107 RECORDING MODE IS F CL114 00108 LABEL RECORDS ARE STANDARD CL114 00109 BLOCK CONTAINS 0 CHARACTERS. CL114 00110 CL114 00111 01 CURR-RPT-REC PIC X(80). CL114 00112 CL114 00113 FD SENT-MINI-FILE CL*70 00114 RECORDING MODE IS F CL*70 00115 LABEL RECORDS ARE STANDARD CL*70 00116 BLOCK CONTAINS 0 CHARACTERS. CL*70 00117 CL*70 00118 01 SENT-MINI-REC PIC X(80). CL*70 00119 CL*70 00120 FD SENT-MINI-RPT CL114 00121 RECORDING MODE IS F CL114 00122 LABEL RECORDS ARE STANDARD CL114 00123 BLOCK CONTAINS 0 CHARACTERS. CL114 00124 CL114 00125 01 SENT-RPT-REC PIC X(80). CL114 00126 CL114 00127 DTSBS411 00128 WORKING-STORAGE SECTION. DTSBS411 001285 77 PAN-VALET PICTURE X(24) VALUE '135DTSBS411 09/04/24'. DTSBS411 00129 SKIP3 DTSBS411 00130 01 W-AREA. DTSBS411 00131 05 W-ABEND-CD PIC S9(04) COMP VALUE +340.DTSBS411 00132 DTSBS411 00133 05 W-TRACE-IND PIC X(01) VALUE SPACE. DTSBS411 00134 05 W-MOD-NAME PIC X(08) VALUE 'DTSBSMIN'. CL*51 00135 DTSBS411 00136 05 ABEND-MSG PIC X(60). DTSBS411 00137 DTSBS411 00138 05 WS-HOLD-EMP-NO PIC 9(06) VALUE 0. CL*62 00139 CL*45 00140 05 WS-HOLD-LIAB-DATE PIC 9(08) VALUE 0. CL109 00141 CL109 00142 05 CURR-MINI-STATUS PIC X(02). CL*70 00143 88 CURR-MINI-STATUS-OK-88 VALUE '00'. CL*70 00144 DTSBS411 00145 05 CURR-RPT-STATUS PIC X(02). CL114 00146 88 CURR-RPT-STATUS-OK-88 VALUE '00'. CL114 00147 CL114 00148 05 CURR-PREV-STATUS PIC X(02). CL*90 00149 88 CURR-PREV-STATUS-OK-88 VALUE '00'. CL*92 00150 88 CURR-PREV-STATUS-EOF-88 VALUE '10'. CL*92 00151 CL*90 00152 05 SENT-MINI-STATUS PIC X(02). CL*70 00153 88 SENT-MINI-STATUS-OK-88 VALUE '00'. CL*70 00154 CL*70 00155 05 SENT-RPT-STATUS PIC X(02). CL114 00156 88 SENT-RPT-STATUS-OK-88 VALUE '00'. CL114 00157 CL114 00158 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBS411 00159 88 W-ERROR-YES-88 VALUE 'Y'. DTSBS411 00160 88 W-ERROR-NO-88 VALUE 'N'. DTSBS411 00161 DTSBS411 00162 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS411 00163 05 W-CURR-PREV-CNT PIC S9(07) COMP-3 VALUE +0. CL*97 00164 05 W-CURR-MINI-CNT PIC S9(07) COMP-3 VALUE +0. CL*97 00165 05 W-SENT-MINI-CNT PIC S9(07) COMP-3 VALUE +0. CL*78 00166 DTSBS411 00167 01 WS-MINI-REC. CL*72 00168 05 WS-MINI-EMP-NO PIC 9(06) VALUE 0. CL117 00169 05 WS-MINI-EMP-STATUS PIC X(01) VALUE SPACES. CL117 00170 05 WS-MINI-CURR-DATE PIC 9(08) VALUE 0. CL117 00171 05 WS-MINI-LIAB-DATE PIC 9(08) VALUE 0. CL117 00172 05 WS-MINI-ESTB-DATE PIC 9(08) VALUE 0. CL117 00173 05 WS-MINI-CHNG-DATE PIC 9(08) VALUE 0. CL117 00174 05 FILLER PIC X(41) VALUE SPACES. CL117 00175 CL*40 00176 01 WRK-CURR-PREV-REC. CL*93 00177 05 WS-CURR-PREV-EMP-NO PIC 9(06) VALUE 0. CL117 00178 05 WS-CURR-PREV-EMP-STATUS PIC X(01) VALUE SPACES. CL117 00179 05 WS-CURR-PREV-CURR-DATE PIC 9(08) VALUE 0. CL117 00180 05 WS-CURR-PREV-LIAB-DATE PIC 9(08) VALUE 0. CL117 00181 05 WS-CURR-PREV-ESTB-DATE PIC 9(08) VALUE 0. CL117 00182 05 WS-CURR-PREV-CHNG-DATE PIC 9(08) VALUE 0. CL117 00183 05 FILLER PIC X(41) VALUE SPACES. CL117 00184 CL*93 00185 01 CURRENT-RPT-HEADER. CL117 00186 05 FILLER PIC X(06) CL117 00187 VALUE '***** '. CL117 00188 05 FILLER PIC X(52) VALUE CL131 00189 'ACCOUNTS PENDING FOR MINI CONV REGISTRATION IN DUTAS'. CL131 00190 05 FILLER PIC X(06) CL124 00191 VALUE ' *****'. CL117 00192 05 FILLER PIC X(16) VALUE SPACES. CL131 00193 CL117 00194 01 SENT-RPT-HEADER. CL117 00195 05 FILLER PIC X(06) CL117 00196 VALUE '***** '. CL117 00197 05 FILLER PIC X(48) VALUE CL133 00198 'ACCOUNTS SENT TO ESSP FOR MINI CONV REGISTRATION'. CL131 00199 05 FILLER PIC X(06) CL124 00200 VALUE ' *****'. CL117 00201 05 FILLER PIC X(20) VALUE SPACES. CL133 00202 CL117 00203 01 WS-BLANK-LINE PIC X(133) VALUE SPACES. CL117 00204 CL117 00205 01 WS-RPT-HDR1. CL117 00206 05 WS-HDR-EMP-NO PIC X(07) VALUE 'EMP-NO|'. CL124 00207 05 WS-HDR-EMP-STATUS PIC X(11) VALUE 'EMP-STATUS|'. CL124 00208 05 WS-HDR-CURR-DATE PIC X(09) VALUE 'CURR-DT |'. CL124 00209 05 WS-HDR-LIAB-DATE PIC X(09) VALUE 'LIAB-DT |'. CL124 00210 05 WS-HDR-ESTB-DATE PIC X(09) VALUE 'ESTB-DT |'. CL124 00211 05 WS-HDR-CHNG-DATE PIC X(07) VALUE 'CHNG-DT'. CL124 00212 05 FILLER PIC X(28) VALUE SPACES. CL117 00213 CL117 00214 01 WS-RPT-DETAIL-REC. CL117 00215 05 WS-RPT-EMP-NO PIC 9(06) VALUE 0. CL117 00216 05 FILLER PIC X(01) VALUE '|'. CL117 00217 05 WS-RPT-EMP-STATUS PIC X(01) VALUE SPACES. CL117 00218 05 FILLER PIC X(10) VALUE ' |'. CL124 00219 05 WS-RPT-CURR-DATE PIC 9(08) VALUE 0. CL117 00220 05 FILLER PIC X(01) VALUE '|'. CL117 00221 05 WS-RPT-LIAB-DATE PIC ZZZZZZZZ. CL135 00222 05 FILLER PIC X(01) VALUE '|'. CL117 00223 05 WS-RPT-ESTB-DATE PIC 9(08) VALUE 0. CL117 00224 05 FILLER PIC X(01) VALUE '|'. CL117 00225 05 WS-RPT-CHNG-DATE PIC 9(08) VALUE 0. CL117 00226 05 FILLER PIC X(27) VALUE SPACES. CL117 00227 CL117 00228 CL117 00229 EJECT DTSBS411 00230 01 L910-LINK-AREA. DTSBS411 00231 ++INCLUDE DTSIL910 DTSBS411 00232 SKIP3 DTSBS411 00233 01 MSKL-REC. DTSBS411 00234 ++INCLUDE DTSIMSKL DTSBS411 00235 SKIP3 DTSBS411 00236 01 MHDR-REC. DTSBS411 00237 ++INCLUDE DTSIMHDR DTSBS411 00238 SKIP3 DTSBS411 00239 01 MPRF-REC. DTSBS411 00240 ++INCLUDE DTSIMPRF DTSBS411 00241 SKIP3 CL*97 00242 01 MSOL-REC. CL*98 00243 ++INCLUDE DTSIMSOL CL*98 00244 SKIP3 CL*98 00245 01 L931-LINK-AREA. DTSBS411 00246 ++INCLUDE DTSIL931 DTSBS411 00247 DTSBS411 00248 PROCEDURE DIVISION. CL*32 00249 DTSBS411 00250 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBS411 00251 IF W-ERROR-NO-88 DTSBS411 00252 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBS411 00253 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBS411 00254 END-IF. DTSBS411 00255 DTSBS411 00256 GOBACK. DTSBS411 00257 DTSBS411 00258 I0000-INITIALIZE. DTSBS411 00259 SKIP2 DTSBS411 00260 MOVE W-TRACE-IND TO L910-TRACE-IND. CL*70 00261 MOVE W-MOD-NAME TO L910-MOD-NAME. CL*70 00262 DTSBS411 00263 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBS411 00264 IF W-ERROR-YES-88 DTSBS411 00265 GO TO I0000-EXIT DTSBS411 00266 END-IF. DTSBS411 00267 DTSBS411 00268 PERFORM I3000-GET-MHDR THRU I3000-EXIT. CL*70 00269 DTSBS411 00270 PERFORM I3500-WRITE-HDR THRU I3500-EXIT. CL119 00271 CL119 00272 PERFORM I4000-PROCESS-CURR-PREV THRU I4000-EXIT. CL*92 00273 CL*90 00274 I0000-EXIT. DTSBS411 00275 EXIT. DTSBS411 00276 EJECT DTSBS411 00277 DTSBS411 00278 I2000-OPEN-FILES. DTSBS411 00279 CL*70 00280 OPEN INPUT CURR-PREV-FILE. CL*90 00281 IF NOT CURR-PREV-STATUS-OK-88 CL*91 00282 DISPLAY 'OPEN ERROR ON CURR PREV FILE ' CURR-PREV-STATUS CL*90 00283 SET W-ERROR-YES-88 TO TRUE DTSBS411 00284 GO TO I2000-EXIT DTSBS411 00285 END-IF. DTSBS411 00286 DTSBS411 00287 OPEN OUTPUT CURR-MINI-FILE. CL*90 00288 IF NOT CURR-MINI-STATUS-OK-88 CL*90 00289 DISPLAY 'OPEN ERROR ON CURR MINI FILE ' CURR-MINI-STATUS CL*90 00290 SET W-ERROR-YES-88 TO TRUE CL*90 00291 GO TO I2000-EXIT CL*90 00292 END-IF. CL*90 00293 CL*90 00294 OPEN OUTPUT CURR-MINI-RPT. CL124 00295 IF NOT CURR-RPT-STATUS-OK-88 CL114 00296 DISPLAY 'OPEN ERROR ON CURR RPT FILE ' CURR-RPT-STATUS CL114 00297 SET W-ERROR-YES-88 TO TRUE CL114 00298 GO TO I2000-EXIT CL114 00299 END-IF. CL114 00300 CL114 00301 OPEN OUTPUT SENT-MINI-FILE. CL*70 00302 IF NOT SENT-MINI-STATUS-OK-88 CL*70 00303 DISPLAY 'OPEN ERROR ON SENT MINI FILE ' SENT-MINI-STATUS CL*84 00304 SET W-ERROR-YES-88 TO TRUE CL*70 00305 GO TO I2000-EXIT CL*70 00306 END-IF. CL*70 00307 CL*70 00308 OPEN OUTPUT SENT-MINI-RPT. CL125 00309 IF NOT SENT-RPT-STATUS-OK-88 CL114 00310 DISPLAY 'OPEN ERROR ON SENT RPT FILE ' SENT-RPT-STATUS CL114 00311 SET W-ERROR-YES-88 TO TRUE CL114 00312 GO TO I2000-EXIT CL114 00313 END-IF. CL114 00314 CL114 00315 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBS411 00316 DTSBS411 00317 I2000-EXIT. DTSBS411 00318 EXIT. DTSBS411 00319 DTSBS411 00320 I3000-GET-MHDR. DTSBS411 00321 MOVE LOW-VALUES TO MSKL-REC. DTSBS411 00322 MOVE +0 TO MSKL-EMP-NO. CL*57 00323 SET MSKL-HDR-88 TO TRUE. DTSBS411 00324 DTSBS411 00325 PERFORM S910-READ THRU S910-EXIT. DTSBS411 00326 IF L910-NO-REC-88 DTSBS411 00327 DISPLAY 'DTSBSMIN: MHDR RECORD IS MISSING' CL*50 00328 SET W-ERROR-YES-88 TO TRUE DTSBS411 00329 GO TO I3000-EXIT DTSBS411 00330 ELSE DTSBS411 00331 MOVE MSKL-REC TO MHDR-REC CL*47 00332 CL*54 00333 DISPLAY 'MHDR-CURR-RUN-DATE' MHDR-CURR-RUN-DATE CL*54 00334 DISPLAY 'MHDR-PRIOR-RUN-DATE' MHDR-PRIOR-RUN-DATE CL*54 00335 END-IF. DTSBS411 00336 DTSBS411 00337 I3000-EXIT. DTSBS411 00338 EXIT. DTSBS411 00339 CL119 00340 I3500-WRITE-HDR. CL119 00341 CL119 00342 WRITE CURR-RPT-REC FROM CURRENT-RPT-HEADER CL119 00343 WRITE CURR-RPT-REC FROM WS-BLANK-LINE CL119 00344 WRITE CURR-RPT-REC FROM WS-RPT-HDR1 CL119 00345 CL119 00346 WRITE SENT-RPT-REC FROM SENT-RPT-HEADER CL119 00347 WRITE SENT-RPT-REC FROM WS-BLANK-LINE CL119 00348 WRITE SENT-RPT-REC FROM WS-RPT-HDR1. CL124 00349 CL119 00350 CL119 00351 I3500-EXIT. CL119 00352 EXIT. CL119 00353 DTSBS411 00354 I4000-PROCESS-CURR-PREV. CL*92 00355 PERFORM S1010-READ-CURR-PREV THRU S1010-EXIT. CL*92 00356 CL*91 00357 IF CURR-PREV-STATUS-EOF-88 CL*92 00358 DISPLAY 'CURR PREV FILE IS EMPTY' CL102 00359 GO TO I4000-EXIT CL*92 00360 END-IF. CL*91 00361 CL*91 00362 PERFORM UNTIL CURR-PREV-STATUS-EOF-88 CL*99 00363 PERFORM I4100-CHK-EMPSTAT THRU I4100-EXIT CL*96 00364 PERFORM S1010-READ-CURR-PREV THRU S1010-EXIT CL*97 00365 END-PERFORM. CL*91 00366 CL*91 00367 I4000-EXIT. CL*91 00368 EXIT. CL*91 00369 CL*91 00370 I4100-CHK-EMPSTAT. CL*96 00371 CL127 00372 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*92 00373 MOVE WS-CURR-PREV-EMP-NO TO MSKL-EMP-NO. CL*94 00374 CL*92 00375 SET MSKL-PRF-88 TO TRUE. CL*92 00376 CL*92 00377 PERFORM S910-READ THRU S910-EXIT. CL*92 00378 IF L910-OK-88 CL*92 00379 MOVE MSKL-REC TO MPRF-REC CL105 00380 MOVE MPRF-EMP-NO TO WS-RPT-EMP-NO CL126 00381 MOVE MPRF-EMP-STATUS TO WS-CURR-PREV-EMP-STATUS CL126 00382 WS-RPT-EMP-STATUS CL126 00383 MOVE MHDR-CURR-RUN-DATE TO WS-CURR-PREV-CURR-DATE CL105 00384 WS-RPT-CURR-DATE CL118 00385 MOVE MPRF-ESTB-DATE TO WS-CURR-PREV-ESTB-DATE CL105 00386 WS-RPT-ESTB-DATE CL118 00387 MOVE MPRF-CHNG-DATE TO WS-CURR-PREV-CHNG-DATE CL105 00388 WS-RPT-CHNG-DATE CL118 00389 ELSE CL*92 00390 DISPLAY 'EMP NO NOT IN USE ' MSKL-EMP-NO CL*92 00391 PERFORM S999-ABEND THRU S999-EXIT CL100 00392 END-IF. CL*92 00393 CL100 00394 IF MPRF-EMP-STATUS = 'A' CL*92 00395 CL110 00396 PERFORM P1200-READ-MSOL THRU P1200-EXIT CL110 00397 CL110 00398 MOVE WS-HOLD-LIAB-DATE TO WS-CURR-PREV-LIAB-DATE CL110 00399 WS-RPT-LIAB-DATE CL118 00400 CL110 00401 WRITE SENT-MINI-REC FROM WRK-CURR-PREV-REC CL*94 00402 ADD +1 TO W-SENT-MINI-CNT CL*92 00403 CL118 00404 WRITE SENT-RPT-REC FROM WS-RPT-DETAIL-REC CL118 00405 ELSE CL*92 00406 WRITE CURR-MINI-REC FROM WRK-CURR-PREV-REC CL*94 00407 ADD +1 TO W-CURR-MINI-CNT CL*92 00408 CL118 00409 MOVE ZEROES TO WS-RPT-LIAB-DATE CL128 00410 WRITE CURR-RPT-REC FROM WS-RPT-DETAIL-REC CL118 00411 END-IF. CL*92 00412 CL*92 00413 I4100-EXIT. CL*96 00414 EXIT. CL*92 00415 CL*92 00416 P0000-PROCESS. DTSBS411 00417 DTSBS411 00418 PERFORM P1000-CONVERT THRU P1000-EXIT. CL*43 00419 DTSBS411 00420 P0000-EXIT. DTSBS411 00421 EXIT. DTSBS411 00422 DTSBS411 00423 P1000-CONVERT. DTSBS411 00424 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBS411 00425 MOVE +010021 TO MSKL-EMP-NO. CL*56 00426 SET MSKL-PRF-88 TO TRUE. DTSBS411 00427 DTSBS411 00428 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBS411 00429 IF NOT L910-OK-88 DTSBS411 00430 DISPLAY 'CANNOT READ MASTER FILE ' DTSBS411 00431 GO TO P1000-EXIT DTSBS411 00432 END-IF. DTSBS411 00433 DTSBS411 00434 PERFORM DTSBS411 00435 UNTIL L910-NO-REC-88 OR W-ERROR-YES-88 CL*71 00436 CL*71 00437 ADD +1 TO W-MPRF-CNT DTSBS411 00438 MOVE MSKL-REC TO MPRF-REC DTSBS411 00439 MOVE MPRF-EMP-NO TO WS-HOLD-EMP-NO CL*71 00440 CL*71 00441 PERFORM P1100-SELECT THRU P1100-EXIT DTSBS411 00442 CL*29 00443 MOVE MPRF-REC TO MSKL-REC DTSBS411 00444 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBS411 00445 END-PERFORM. DTSBS411 00446 DTSBS411 00447 P1000-EXIT. DTSBS411 00448 EXIT. DTSBS411 00449 DTSBS411 00450 P1100-SELECT. DTSBS411 00451 DTSBS411 00452 IF MPRF-ESTB-DATE = MHDR-PRIOR-RUN-DATE AND CL*71 00453 WS-HOLD-EMP-NO(1:3) = '186' CL*71 00454 CL*44 00455 MOVE MPRF-EMP-NO TO WS-MINI-EMP-NO CL*73 00456 WS-RPT-EMP-NO CL121 00457 MOVE MPRF-EMP-STATUS TO WS-MINI-EMP-STATUS CL*45 00458 WS-RPT-EMP-STATUS CL121 00459 MOVE MHDR-CURR-RUN-DATE TO WS-MINI-CURR-DATE CL*68 00460 WS-RPT-CURR-DATE CL121 00461 MOVE MPRF-ESTB-DATE TO WS-MINI-ESTB-DATE CL*68 00462 WS-RPT-ESTB-DATE CL121 00463 MOVE MPRF-CHNG-DATE TO WS-MINI-CHNG-DATE CL*68 00464 WS-RPT-CHNG-DATE CL121 00465 CL*58 00466 DISPLAY 'MPRF-ESTB-DATE' MPRF-ESTB-DATE CL*58 00467 DISPLAY 'WS-HOLD-EMP-NO' WS-HOLD-EMP-NO CL*61 00468 DISPLAY 'MPRF-EMP-NO ' MPRF-EMP-NO CL*62 00469 DISPLAY 'WS-HOLD-EMP-NO(1:3) ' WS-HOLD-EMP-NO(1:3) CL*63 00470 CL*64 00471 ELSE CL*64 00472 CL*64 00473 GO TO P1100-EXIT CL*64 00474 CL*64 00475 END-IF. CL*44 00476 CL*61 00477 IF MPRF-EMP-STATUS = 'A' CL*71 00478 PERFORM P1200-READ-MSOL THRU P1200-EXIT CL*82 00479 CL108 00480 MOVE WS-HOLD-LIAB-DATE TO WS-MINI-LIAB-DATE CL109 00481 WS-RPT-LIAB-DATE CL121 00482 CL109 00483 WRITE SENT-MINI-REC FROM WS-MINI-REC CL108 00484 ADD +1 TO W-SENT-MINI-CNT CL112 00485 CL121 00486 WRITE SENT-RPT-REC FROM WS-RPT-DETAIL-REC CL121 00487 ELSE CL*71 00488 WRITE CURR-MINI-REC FROM WS-MINI-REC CL*71 00489 ADD +1 TO W-CURR-MINI-CNT CL*78 00490 CL121 00491 MOVE ZEROES TO WS-RPT-LIAB-DATE CL128 00492 WRITE CURR-RPT-REC FROM WS-RPT-DETAIL-REC CL128 00493 END-IF. DTSBS411 00494 DTSBS411 00495 P1100-EXIT. DTSBS411 00496 EXIT. DTSBS411 00497 DTSBS411 00498 P1200-READ-MSOL. CL*76 00499 CL*76 00500 MOVE LOW-VALUES TO MSOL-REC. CL*76 00501 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*76 00502 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. CL*76 00503 SET MSOL-SOL-88 TO TRUE. CL*76 00504 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. CL*76 00505 CL*76 00506 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL*76 00507 CL*76 00508 IF L910-OK-88 CL*76 00509 PERFORM S910B-READ THRU S910B-EXIT CL*76 00510 ELSE CL*76 00511 PERFORM S999-ABEND THRU S999-EXIT. CL*76 00512 CL*76 00513 IF L910-OK-88 CL*76 00514 PERFORM P1210-GET-LIAB-DATE THRU P1210-EXIT CL*86 00515 UNTIL L910-NO-REC-88 CL*86 00516 ELSE CL*76 00517 PERFORM S999-ABEND THRU S999-EXIT. CL*76 00518 CL*76 00519 P1200-EXIT. CL*76 00520 EXIT. CL*76 00521 CL*76 00522 P1210-GET-LIAB-DATE. CL*86 00523 CL*86 00524 MOVE MSKL-REC TO MSOL-REC CL*86 00525 MOVE MSOL-LIAB-DATE TO WS-HOLD-LIAB-DATE CL109 00526 CL*86 00527 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*86 00528 CL*86 00529 P1210-EXIT. CL*86 00530 EXIT. CL*86 00531 CL*86 00532 S1010-READ-CURR-PREV. CL*92 00533 READ CURR-PREV-FILE INTO WRK-CURR-PREV-REC CL*93 00534 IF CURR-PREV-STATUS-OK-88 CL*92 00535 ADD +1 TO W-CURR-PREV-CNT CL*97 00536 ELSE CL*92 00537 IF CURR-PREV-STATUS-EOF-88 CL*92 00538 DISPLAY 'CURRENT PREV - EOF' CL*92 00539 ELSE CL*92 00540 DISPLAY 'CANNOT READ CURR PREV FILE' CURR-PREV-STATUS CL*92 00541 PERFORM S999-ABEND THRU S999-EXIT CL*92 00542 END-IF CL*92 00543 END-IF. CL*92 00544 CL*92 00545 S1010-EXIT. CL*92 00546 EXIT. CL*92 00547 CL*92 00548 T0000-TERMINATE. DTSBS411 00549 DTSBS411 00550 CLOSE CURR-PREV-FILE CL*99 00551 CURR-MINI-FILE CL*99 00552 CURR-MINI-RPT CL124 00553 SENT-MINI-FILE CL124 00554 SENT-MINI-RPT. CL124 00555 CL*79 00556 PERFORM S910-CLOSE THRU S910-EXIT. DTSBS411 00557 DTSBS411 00558 DISPLAY '*********************************************'. DTSBS411 00559 DISPLAY '** DTSBSMIN TERMINATION STATISTICS **'. CL105 00560 DISPLAY '** **'. CL105 00561 DISPLAY '** PROFILE RECORDS READ:' W-MPRF-CNT '**'. CL105 00562 DISPLAY '** ACCOUNTS IN CURRENT: ' W-CURR-MINI-CNT'**'. CL105 00563 DISPLAY '** ACCOUNTS IN SENT: ' W-SENT-MINI-CNT'**'. CL105 00564 DISPLAY '*********************************************'. DTSBS411 00565 DTSBS411 00566 T0000-EXIT. DTSBS411 00567 EXIT. DTSBS411 00568 DTSBS411 00569 *S001-FROM-FED-8. CL*87 00570 * SET L001-FROM-FED-8 TO TRUE. CL*87 00571 * GO TO S001-DATE. CL*87 00572 * CL*87 00573 *S001-FROM-ABS-DAY. CL*87 00574 * SET L001-FROM-ABS-DAY TO TRUE. CL*87 00575 * GO TO S001-DATE. CL*87 00576 * CL*87 00577 *S001-FROM-CAL-6. CL*87 00578 * SET L001-FROM-CAL-6 TO TRUE. CL*87 00579 * GO TO S001-DATE. CL*87 00580 * CL*87 00581 *S001-DATE. CL*87 00582 * CALL 'DTSBU001' USING L001-LINK-AREA. CL*87 00583 *S001-EXIT. CL*87 00584 * EXIT. CL*87 00585 * SKIP3 CL*87 00586 *S004-FROM-5. CL*87 00587 * SET L004-FROM-5 TO TRUE. CL*87 00588 * GO TO S004-QTR. CL*87 00589 * CL*87 00590 *S004-FROM-ABS. CL*87 00591 * SET L004-FROM-ABS TO TRUE. CL*87 00592 * GO TO S004-QTR. CL*87 00593 * CL*87 00594 *S004-FROM-3. CL*87 00595 * SET L004-FROM-3 TO TRUE. CL*87 00596 * GO TO S004-QTR. CL*87 00597 * CL*87 00598 *S004-FROM-DATE. CL*87 00599 * SET L004-FROM-DATE TO TRUE. CL*87 00600 * GO TO S004-QTR. CL*87 00601 * CL*87 00602 *S004-QTR. CL*87 00603 * CL*87 00604 * CALL 'DTSBU004' USING L004-LINK-AREA. CL*87 00605 * CL*87 00606 *S004-EXIT. CL*87 00607 * EXIT. CL*87 00608 SKIP3 DTSBS411 00609 *S005-FROM-SYS. CL*87 00610 * CALL 'DTSBU005' USING L005-LINK-AREA. CL*87 00611 *S005-EXIT. CL*87 00612 * EXIT. CL*87 00613 DTSBS411 00614 *S341-STATUS. CL*87 00615 * CALL 'DTSBX341' USING LX34-LINK-AREA CL*87 00616 * MPRF-REC. CL*87 00617 DTSBS411 00618 *S341-EXIT. CL*87 00619 * EXIT. CL*87 00620 * CL*87 00621 *S342-ACCT-DAILY. CL*87 00622 * CALL 'DTSBX342' USING LX34-LINK-AREA CL*87 00623 * MPRF-REC. CL*87 00624 * CL*87 00625 *S342-EXIT. CL*87 00626 * EXIT. CL*87 00627 * CL*87 00628 *S355-ACCT-CONVERT. CL*87 00629 * CALL 'DTSBX522' USING LX34-LINK-AREA CL*87 00630 * MPRF-REC. CL*87 00631 * CL*87 00632 *S355-EXIT. CL*87 00633 * EXIT. CL*87 00634 * CL*87 00635 *S344-DELINQ-COLL. CL*87 00636 * CALL 'DTSBX344' USING LX34-LINK-AREA CL*87 00637 * MPRF-REC. CL*87 00638 * CL*87 00639 *S344-EXIT. CL*87 00640 * EXIT. CL*87 00641 * CL*87 00642 *S346-CHARGES. DTSBS411 00643 * CALL 'DTSBX346' USING LX34-LINK-AREA DTSBS411 00644 * MPRF-REC. DTSBS411 00645 * DTSBS411 00646 *S346-EXIT. DTSBS411 00647 * EXIT. DTSBS411 00648 * CL*87 00649 * CL*87 00650 *S348-HOLIDAYS. CL*87 00651 * ADD +1 TO L001-JUL-ABS-DAY. CL*87 00652 * CL*87 00653 * PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. CL*87 00654 * CL*87 00655 * MOVE L001-FED-8-DATE-9 TO L003-DATE. CL*87 00656 * CL*87 00657 * MOVE '2' TO L003-OPTION. CL*87 00658 * CALL 'DTSBU003' USING L003-LINK-AREA. CL*87 00659 * CL*87 00660 *S348-EXIT. CL*87 00661 * EXIT. CL*87 00662 CL*87 00663 S910-OPEN-READ. DTSBS411 00664 SET L910-OPEN-READ-88 TO TRUE. DTSBS411 00665 GO TO S910-MSTR-IO. DTSBS411 00666 DTSBS411 00667 S910-READ. DTSBS411 00668 SET L910-READ-88 TO TRUE. DTSBS411 00669 GO TO S910-MSTR-IO. DTSBS411 00670 DTSBS411 00671 S910-START-BROWSE. DTSBS411 00672 SET L910-START-BROWSE-88 TO TRUE. DTSBS411 00673 GO TO S910-MSTR-IO. DTSBS411 00674 DTSBS411 00675 S910-READ-NEXT. DTSBS411 00676 SET L910-READ-NEXT-88 TO TRUE. DTSBS411 00677 GO TO S910-MSTR-IO. DTSBS411 00678 DTSBS411 00679 S910-COUNT. DTSBS411 00680 SET L910-COUNT-88 TO TRUE. DTSBS411 00681 GO TO S910-MSTR-IO. DTSBS411 00682 DTSBS411 00683 S910-REWRITE. DTSBS411 00684 SET L910-REWRITE-88 TO TRUE. DTSBS411 00685 GO TO S910-MSTR-IO. DTSBS411 00686 DTSBS411 00687 S910-CLOSE. DTSBS411 00688 SET L910-CLOSE-88 TO TRUE. DTSBS411 00689 GO TO S910-MSTR-IO. DTSBS411 00690 DTSBS411 00691 S910B-READ. CL*79 00692 SET L910-READ-88 TO TRUE. CL*79 00693 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. CL*79 00694 CL*79 00695 S910B-EXIT. CL*79 00696 EXIT. CL*79 00697 CL*79 00698 S910C-START-BROWSE. CL*79 00699 SET L910-START-BROWSE-88 TO TRUE. CL*79 00700 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. CL*79 00701 CL*79 00702 S910C-EXIT. CL*79 00703 EXIT. CL*79 00704 CL*79 00705 S910Z-MSTR-IO. CL*79 00706 CALL 'DTSBU910' USING L910-LINK-AREA CL*79 00707 MSKL-REC. CL*79 00708 S910Z-EXIT. CL*79 00709 EXIT. CL*79 00710 CL*79 00711 S910-MSTR-IO. DTSBS411 00712 CALL 'DTSBU910' USING L910-LINK-AREA DTSBS411 00713 MSKL-REC. DTSBS411 00714 S910-EXIT. DTSBS411 00715 EXIT. DTSBS411 00716 SKIP3 DTSBS411 00717 DTSBS411 00718 *S931-OPEN-READ. CL*87 00719 * SET L931-OPEN-READ-88 TO TRUE. CL*87 00720 * GO TO S931-REF-IO. CL*87 00721 * CL*87 00722 *S931-READ. CL*87 00723 * SET L931-READ-88 TO TRUE. CL*87 00724 * GO TO S931-REF-IO. CL*87 00725 * CL*87 00726 *S931-CLOSE. CL*87 00727 * SET L931-CLOSE-88 TO TRUE. CL*87 00728 * GO TO S931-REF-IO. CL*87 00729 * CL*87 00730 *S931-REF-IO. CL*87 00731 * CALL 'DTSBU931' USING L931-LINK-AREA CL*87 00732 * FSKL-REC. CL*87 00733 *S931-EXIT. CL*87 00734 * EXIT. CL*87 00735 * CL*87 00736 *S921-OPEN-READ. CL*87 00737 * SET L921-OPEN-READ-88 TO TRUE. CL*87 00738 * GO TO S921-AIX-IO. CL*87 00739 * CL*87 00740 *S921-CLOSE. CL*87 00741 * SET L921-CLOSE-88 TO TRUE. CL*87 00742 * GO TO S921-AIX-IO. CL*87 00743 * CL*87 00744 *S921-AIX-IO. CL*87 00745 * CALL 'DTSBU921' USING L921-LINK-AREA CL*87 00746 * ISKL-REC. CL*87 00747 *S921-EXIT. CL*87 00748 * EXIT. CL*87 00749 DTSBS411 00750 S999-ABEND. DTSBS411 00751 DISPLAY '*** DTSBX340 ABENDING. ' DTSBS411 00752 ABEND-MSG. DTSBS411 00753 DTSBS411 00754 CALL 'DTSBU999' USING W-ABEND-CD. DTSBS411 00755 S999-EXIT. DTSBS411 00756 EXIT. DTSBS411