758 lines
60 KiB
COBOL
758 lines
60 KiB
COBOL
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
|