MP Batchs, copybooks, jcls, Procs
This commit is contained in:
757
Batch/DTSBS411.cob
Normal file
757
Batch/DTSBS411.cob
Normal file
@ -0,0 +1,757 @@
|
||||
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
|
||||
Reference in New Issue
Block a user