DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
665
Batch/DTSBE408.cob
Normal file
665
Batch/DTSBE408.cob
Normal file
@ -0,0 +1,665 @@
|
||||
00001 IDENTIFICATION DIVISION. 01/18/99
|
||||
00002 PROGRAM-ID. DTSBE408. DTSBE408
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD LV004
|
||||
00004 MODIFIED BY TRW S&ITG. CL**2
|
||||
00005 DATE-WRITTEN. AUGUST 1994. DTSBE408
|
||||
00006 DATE-COMPILED. DTSBE408
|
||||
00007 SKIP3 DTSBE408
|
||||
00008 ***** DTSBE408
|
||||
00009 * DTSBE408
|
||||
00010 * CALLING SEQUENCE: DTSBE408 CREATES DTSIR408 RECORDS. CL**2
|
||||
00011 * DTSBD800 CALLS DTSBR408 CL**2
|
||||
00012 * WHICH PRODUCES THE EXTRACT. CL**2
|
||||
00013 * CL**4
|
||||
00014 * FUNCTION: PAYMENT PLANS SATISFIED LIST EXTRACT. DTSBE408
|
||||
00015 * DTSBE408
|
||||
00016 * DTSBE408
|
||||
00017 * MODIFICATION LOG: DTSBE408
|
||||
00018 * DTSBE408
|
||||
00019 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE408
|
||||
00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE408
|
||||
00021 * WORK ORDER: PROGRAMMER: XXX DTSBE408
|
||||
00022 * DTSBE408
|
||||
00023 * DTSBE408
|
||||
00024 * DESCRIPTION: DTSBE408
|
||||
00025 * DTSBE408
|
||||
00026 * DTSBE408
|
||||
00027 * INITIATION: DTSBE408
|
||||
00028 * DTSBE408
|
||||
00029 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE408
|
||||
00030 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE408
|
||||
00031 * DTSBE408
|
||||
00032 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUTS DTSBE408
|
||||
00033 * DESCRIPTIONS AND LAYOUTS (408R1). DTSBE408
|
||||
00034 * DTSBE408
|
||||
00035 * DETERMINE WRK-PAYMENT-CUTOFF-DATE. DTSBE408
|
||||
00036 * DTSBE408
|
||||
00037 * DTSBE408
|
||||
00038 * PROCESSING: DTSBE408
|
||||
00039 * DTSBE408
|
||||
00040 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (408R1). DTSBE408
|
||||
00041 * DTSBE408
|
||||
00042 * TO DETERMINE THE AGE OF PAYMENTS DISTRIBUTED TO A DTSBE408
|
||||
00043 * SPECIFIED QUARTER, USE THE SAME LOGIC AS FOUND IN DTSBE408
|
||||
00044 * DTSBE405. CL**2
|
||||
00045 * DTSBE408
|
||||
00046 * DTSBE408
|
||||
00047 * TERMINATION: DTSBE408
|
||||
00048 * DTSBE408
|
||||
00049 * NONE. DTSBE408
|
||||
00050 * DTSBE408
|
||||
00051 * DTSBE408
|
||||
00052 * RECORDS READ: DTSBE408
|
||||
00053 * DTSBE408
|
||||
00054 * MASTER: DTSBE408
|
||||
00055 * DTSBE408
|
||||
00056 * MDPC DTSBE408
|
||||
00057 * MQTR DTSBE408
|
||||
00058 * MDST DTSBE408
|
||||
00059 * DTSBE408
|
||||
00060 * DTSBE408
|
||||
00061 * ALTERNATE INDEX: DTSBE408
|
||||
00062 * DTSBE408
|
||||
00063 * NONE. DTSBE408
|
||||
00064 * DTSBE408
|
||||
00065 * DTSBE408
|
||||
00066 * REFERENCE: DTSBE408
|
||||
00067 * DTSBE408
|
||||
00068 * NONE. DTSBE408
|
||||
00069 * DTSBE408
|
||||
00070 * DTSBE408
|
||||
00071 * RECORDS UPDATED: DTSBE408
|
||||
00072 * DTSBE408
|
||||
00073 * MDPC DTSBE408
|
||||
00074 * MEVL DTSBE408
|
||||
00075 * DTSBE408
|
||||
00076 * DTSBE408
|
||||
00077 * REPORT RECORDS WRITTEN: DTSBE408
|
||||
00078 * DTSBE408
|
||||
00079 * R408 PAYMENT PLANS SATISFIED LIST. DTSBE408
|
||||
00080 * DTSBE408
|
||||
00081 * DTSBE408
|
||||
00082 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE408
|
||||
00083 * DTSBE408
|
||||
00084 * NONE. DTSBE408
|
||||
00085 * DTSBE408
|
||||
00086 * DTSBE408
|
||||
00087 * MODULES CALLED: DTSBE408
|
||||
00088 * DTSBE408
|
||||
00089 * DTSBU001 DATE CONVERSION/EDIT. CL**2
|
||||
00090 * DTSBU004 QUARTER CONVERSION/EDIT. CL**2
|
||||
00091 * DTSBU910 MASTER FILE I/O. CL**2
|
||||
00092 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. CL**2
|
||||
00093 * DTSBE408
|
||||
00094 * DTSBE408
|
||||
00095 * VERMONT REFERENCE: DTSBE408
|
||||
00096 * DTSBE408
|
||||
00097 * TXBE348 DTSBE408
|
||||
00098 * DTSBE408
|
||||
00099 ***** DTSBE408
|
||||
00100 SKIP3 DTSBE408
|
||||
00101 ENVIRONMENT DIVISION. DTSBE408
|
||||
00102 SKIP3 DTSBE408
|
||||
00103 DATA DIVISION. DTSBE408
|
||||
00104 SKIP3 DTSBE408
|
||||
00105 WORKING-STORAGE SECTION. DTSBE408
|
||||
001055 77 PAN-VALET PICTURE X(24) VALUE '004DTSBE408 01/18/99'. DTSBE408
|
||||
00106 SKIP3 DTSBE408
|
||||
00107 01 WRK-AREA. DTSBE408
|
||||
00108 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +408.DTSBE408
|
||||
00109 SKIP1 DTSBE408
|
||||
00110 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE408'. CL**2
|
||||
00111 SKIP3 DTSBE408
|
||||
00112 05 ABEND-MSG PIC X(60). DTSBE408
|
||||
00113 SKIP3 DTSBE408
|
||||
00114 05 WRK-PARM-PERIOD-START-DATE PIC S9(09) COMP-3. DTSBE408
|
||||
00115 SKIP1 DTSBE408
|
||||
00116 05 WRK-PARM-PERIOD-END-DATE PIC S9(09) COMP-3. DTSBE408
|
||||
00117 SKIP1 DTSBE408
|
||||
00118 05 WRK-PAYMENT-CUTOFF-DATE PIC S9(09) COMP-3. DTSBE408
|
||||
00119 SKIP1 DTSBE408
|
||||
00120 05 WRK-SUB PIC S9(04) COMP. DTSBE408
|
||||
00121 SKIP1 DTSBE408
|
||||
00122 05 WRK-PLAN-SATISFIED-IND PIC X(01). DTSBE408
|
||||
00123 88 WRK-PLAN-SATISFIED-88 VALUE 'Y'. DTSBE408
|
||||
00124 88 WRK-PLAN-NOT-SATISFIED-88 VALUE 'N'. DTSBE408
|
||||
00125 DTSBE408
|
||||
00126 05 EVL-TEXT. DTSBE408
|
||||
00127 10 FILLER PIC X(46) VALUE DTSBE408
|
||||
00128 'PAYMENT PLAN HAS BEEN AUTOMATICALLY SATISFIED.'. DTSBE408
|
||||
00129 EJECT DTSBE408
|
||||
00130 01 L001-LINK-AREA. DTSBE408
|
||||
00131 ++INCLUDE DTSIL001 CL**2
|
||||
00132 EJECT DTSBE408
|
||||
00133 01 L004-LINK-AREA. DTSBE408
|
||||
00134 ++INCLUDE DTSIL004 CL**2
|
||||
00135 EJECT DTSBE408
|
||||
00136 01 L005-LINK-AREA. DTSBE408
|
||||
00137 ++INCLUDE DTSIL005 CL**2
|
||||
00138 EJECT DTSBE408
|
||||
00139 01 L910-LINK-AREA. DTSBE408
|
||||
00140 ++INCLUDE DTSIL910 CL**2
|
||||
00141 SKIP3 DTSBE408
|
||||
00142 01 MSKL-REC. DTSBE408
|
||||
00143 ++INCLUDE DTSIMSKL CL**2
|
||||
00144 SKIP3 DTSBE408
|
||||
00145 01 MDPC-REC. DTSBE408
|
||||
00146 ++INCLUDE DTSIMDPC CL**2
|
||||
00147 SKIP3 DTSBE408
|
||||
00148 01 MQTR-REC. DTSBE408
|
||||
00149 ++INCLUDE DTSIMQTR CL**2
|
||||
00150 SKIP3 DTSBE408
|
||||
00151 01 MDST-REC. DTSBE408
|
||||
00152 ++INCLUDE DTSIMDST CL**2
|
||||
00153 SKIP3 DTSBE408
|
||||
00154 01 MEVL-REC. DTSBE408
|
||||
00155 ++INCLUDE DTSIMEVL CL**2
|
||||
00156 EJECT DTSBE408
|
||||
00157 01 R408-REC. DTSBE408
|
||||
00158 ++INCLUDE DTSIR408 CL**2
|
||||
00159 EJECT DTSBE408
|
||||
00160 LINKAGE SECTION. DTSBE408
|
||||
00161 SKIP3 DTSBE408
|
||||
00162 01 LECM-LINK-AREA. DTSBE408
|
||||
00163 ++INCLUDE DTSILECM CL**2
|
||||
00164 SKIP3 DTSBE408
|
||||
00165 10 LECM-PARM-AREA REDEFINES LECM-EXTRACT-PARMS. DTSBE408
|
||||
00166 15 LECM-PARM-PERIOD-START-DATE PIC X(06). DTSBE408
|
||||
00167 15 FILLER PIC X(01). DTSBE408
|
||||
00168 15 LECM-PARM-PERIOD-END-DATE PIC X(06). DTSBE408
|
||||
00169 15 FILLER PIC X(55). DTSBE408
|
||||
00170 EJECT DTSBE408
|
||||
00171 01 MPRF-LINK-REC. DTSBE408
|
||||
00172 ++INCLUDE DTSIMPRF CL**2
|
||||
00173 EJECT DTSBE408
|
||||
00174 ************************************************************** DTSBE408
|
||||
00175 * PROCEDURE DIVISION FOR DTSBE408 - PAYMENT PLANS SATISFIED CL**2
|
||||
00176 * LIST STARTS HERE. DTSBE408
|
||||
00177 ************************************************************** DTSBE408
|
||||
00178 DTSBE408
|
||||
00179 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE408
|
||||
00180 MPRF-LINK-REC. DTSBE408
|
||||
00181 SKIP2 DTSBE408
|
||||
00182 IF LECM-PROCESS-88 DTSBE408
|
||||
00183 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE408
|
||||
00184 ELSE DTSBE408
|
||||
00185 IF LECM-INITIALIZE-88 DTSBE408
|
||||
00186 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE408
|
||||
00187 ELSE DTSBE408
|
||||
00188 IF LECM-TERMINATE-88 DTSBE408
|
||||
00189 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE408
|
||||
00190 ELSE DTSBE408
|
||||
00191 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE408
|
||||
00192 TO ABEND-MSG DTSBE408
|
||||
00193 PERFORM S999-ABEND THRU S999-EXIT. DTSBE408
|
||||
00194 SKIP2 DTSBE408
|
||||
00195 GOBACK. DTSBE408
|
||||
00196 EJECT DTSBE408
|
||||
00197 ************************************************************** DTSBE408
|
||||
00198 * THIS PARAGRAPH CONTROLS THE INITIALIZATION PROCESS FOR DTSBE408
|
||||
00199 * DTSBE408. CL**2
|
||||
00200 ************************************************************** DTSBE408
|
||||
00201 DTSBE408
|
||||
00202 I0000-INITIALIZE. DTSBE408
|
||||
00203 SKIP2 DTSBE408
|
||||
00204 MOVE LENGTH OF R408-REC TO R408-LENGTH. CL**2
|
||||
00205 MOVE '408' TO R408-REC-TYPE. CL**2
|
||||
00206 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE408
|
||||
00207 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE408
|
||||
00208 DTSBE408
|
||||
00209 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE408
|
||||
00210 SKIP1 DTSBE408
|
||||
00211 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE408
|
||||
00212 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE408
|
||||
00213 SKIP2 DTSBE408
|
||||
00214 I0000-EXIT. DTSBE408
|
||||
00215 EXIT. DTSBE408
|
||||
00216 SKIP3 DTSBE408
|
||||
00217 ************************************************************** DTSBE408
|
||||
00218 * THIS PARAGRAPH EDITS AND DEFAULTS THE PARMS. DTSBE408
|
||||
00219 ************************************************************** DTSBE408
|
||||
00220 DTSBE408
|
||||
00221 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE408
|
||||
00222 PERFORM I1100-PERIOD-START-DATE THRU I1100-EXIT. DTSBE408
|
||||
00223 DTSBE408
|
||||
00224 PERFORM I1200-PERIOD-END-DATE THRU I1200-EXIT. DTSBE408
|
||||
00225 DTSBE408
|
||||
00226 MOVE LECM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBE408
|
||||
00227 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE408
|
||||
00228 SUBTRACT 14 FROM L001-JUL-ABS-DAY. DTSBE408
|
||||
00229 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBE408
|
||||
00230 MOVE L001-FED-8-DATE-9 TO WRK-PAYMENT-CUTOFF-DATE. DTSBE408
|
||||
00231 I1000-EXIT. DTSBE408
|
||||
00232 EXIT. DTSBE408
|
||||
00233 EJECT DTSBE408
|
||||
00234 ************************************************************** DTSBE408
|
||||
00235 * THIS PARAGRAPH EDITS THE PERIOD START DATE. DTSBE408
|
||||
00236 ************************************************************** DTSBE408
|
||||
00237 DTSBE408
|
||||
00238 I1100-PERIOD-START-DATE. DTSBE408
|
||||
00239 DTSBE408
|
||||
00240 IF LECM-PARM-PERIOD-START-DATE = SPACES DTSBE408
|
||||
00241 IF LECM-PERIOD-START-DATE > +0 DTSBE408
|
||||
00242 MOVE LECM-PERIOD-START-DATE DTSBE408
|
||||
00243 TO WRK-PARM-PERIOD-START-DATE DTSBE408
|
||||
00244 ELSE DTSBE408
|
||||
00245 MOVE 'PERIOD-START-DATE MISSING' DTSBE408
|
||||
00246 TO ABEND-MSG DTSBE408
|
||||
00247 PERFORM S999-ABEND THRU S999-EXIT DTSBE408
|
||||
00248 ELSE DTSBE408
|
||||
00249 MOVE LECM-PARM-PERIOD-START-DATE TO L001-CAL-6-DATE-X DTSBE408
|
||||
00250 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE408
|
||||
00251 IF L001-VALID-DATE DTSBE408
|
||||
00252 MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE408
|
||||
00253 ELSE DTSBE408
|
||||
00254 MOVE 'PERIOD-START-DATE NOT VALID' DTSBE408
|
||||
00255 TO ABEND-MSG DTSBE408
|
||||
00256 PERFORM S999-ABEND THRU S999-EXIT. DTSBE408
|
||||
00257 I1100-EXIT. DTSBE408
|
||||
00258 EXIT. DTSBE408
|
||||
00259 EJECT DTSBE408
|
||||
00260 ************************************************************** DTSBE408
|
||||
00261 * THIS PARAGRAPH EDITS THE PERIOD END DATE. DTSBE408
|
||||
00262 ************************************************************** DTSBE408
|
||||
00263 DTSBE408
|
||||
00264 I1200-PERIOD-END-DATE. DTSBE408
|
||||
00265 DTSBE408
|
||||
00266 IF LECM-PARM-PERIOD-END-DATE = SPACES DTSBE408
|
||||
00267 IF LECM-PERIOD-END-DATE > +0 DTSBE408
|
||||
00268 MOVE LECM-PERIOD-END-DATE DTSBE408
|
||||
00269 TO WRK-PARM-PERIOD-END-DATE DTSBE408
|
||||
00270 ELSE DTSBE408
|
||||
00271 MOVE 'PERIOD-END-DATE MISSING' DTSBE408
|
||||
00272 TO ABEND-MSG DTSBE408
|
||||
00273 PERFORM S999-ABEND THRU S999-EXIT DTSBE408
|
||||
00274 ELSE DTSBE408
|
||||
00275 MOVE LECM-PARM-PERIOD-END-DATE TO L001-CAL-6-DATE-X DTSBE408
|
||||
00276 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE408
|
||||
00277 IF L001-VALID-DATE DTSBE408
|
||||
00278 MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-END-DATE DTSBE408
|
||||
00279 ELSE DTSBE408
|
||||
00280 MOVE 'PERIOD-END-DATE NOT VALID' DTSBE408
|
||||
00281 TO ABEND-MSG DTSBE408
|
||||
00282 PERFORM S999-ABEND THRU S999-EXIT. DTSBE408
|
||||
00283 DTSBE408
|
||||
00284 IF WRK-PARM-PERIOD-START-DATE > WRK-PARM-PERIOD-END-DATE DTSBE408
|
||||
00285 MOVE 'PERIOD START DATE IS GREATER THAN PERIOD END DATE' DTSBE408
|
||||
00286 TO ABEND-MSG DTSBE408
|
||||
00287 PERFORM S999-ABEND THRU S999-EXIT. DTSBE408
|
||||
00288 I1200-EXIT. DTSBE408
|
||||
00289 EXIT. DTSBE408
|
||||
00290 EJECT DTSBE408
|
||||
00291 ************************************************************** DTSBE408
|
||||
00292 * THIS IS THE PROCESS PARAGRAPH FOR DTSBE408. CL**2
|
||||
00293 ************************************************************** DTSBE408
|
||||
00294 DTSBE408
|
||||
00295 P0000-PROCESS. DTSBE408
|
||||
00296 DTSBE408
|
||||
00297 IF MPRF-NO-MDPC-88 DTSBE408
|
||||
00298 GO TO P0000-EXIT. DTSBE408
|
||||
00299 DTSBE408
|
||||
00300 MOVE LOW-VALUES TO MDPC-KEY-AREA. DTSBE408
|
||||
00301 MOVE MPRF-EMP-NO TO MDPC-EMP-NO. DTSBE408
|
||||
00302 SET MDPC-DPC-88 TO TRUE. DTSBE408
|
||||
00303 MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA. DTSBE408
|
||||
00304 DTSBE408
|
||||
00305 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE408
|
||||
00306 DTSBE408
|
||||
00307 PERFORM P1000-MDPC-SCAN THRU P1000-EXIT DTSBE408
|
||||
00308 UNTIL L910-NO-REC-88. DTSBE408
|
||||
00309 DTSBE408
|
||||
00310 P0000-EXIT. DTSBE408
|
||||
00311 EXIT. DTSBE408
|
||||
00312 SKIP3 DTSBE408
|
||||
00313 ************************************************************** DTSBE408
|
||||
00314 * THIS PARAGRAPH SCANS ALL MDPC RECORDS FOR THE EMPLOYER. DTSBE408
|
||||
00315 ************************************************************** DTSBE408
|
||||
00316 DTSBE408
|
||||
00317 P1000-MDPC-SCAN. DTSBE408
|
||||
00318 DTSBE408
|
||||
00319 MOVE MSKL-REC TO MDPC-REC. DTSBE408
|
||||
00320 DTSBE408
|
||||
00321 IF MDPC-STATUS-SATISFIED-88 DTSBE408
|
||||
00322 PERFORM P1100-SATISFIED-MDPC THRU P1100-EXIT DTSBE408
|
||||
00323 ELSE DTSBE408
|
||||
00324 IF MDPC-STATUS-OPEN-88 DTSBE408
|
||||
00325 PERFORM P1200-OPEN-MDPC THRU P1200-EXIT DTSBE408
|
||||
00326 MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA DTSBE408
|
||||
00327 PERFORM S910-READ THRU S910-EXIT DTSBE408
|
||||
00328 IF L910-NO-REC-88 DTSBE408
|
||||
00329 MOVE 'LOGIC ERROR IN P1000' TO ABEND-MSG DTSBE408
|
||||
00330 PERFORM S999-ABEND THRU S999-EXIT. DTSBE408
|
||||
00331 DTSBE408
|
||||
00332 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE408
|
||||
00333 DTSBE408
|
||||
00334 P1000-EXIT. DTSBE408
|
||||
00335 EXIT. DTSBE408
|
||||
00336 EJECT DTSBE408
|
||||
00337 ************************************************************** DTSBE408
|
||||
00338 * THIS PARAGRAPH PROCESSES ALL SATSIFIED MDPC RECORDS. DTSBE408
|
||||
00339 ************************************************************** DTSBE408
|
||||
00340 DTSBE408
|
||||
00341 P1100-SATISFIED-MDPC. DTSBE408
|
||||
00342 DTSBE408
|
||||
00343 IF MDPC-STATUS-SYSTEM-88 DTSBE408
|
||||
00344 GO TO P1100-EXIT. DTSBE408
|
||||
00345 DTSBE408
|
||||
00346 IF (MDPC-STATUS-DATE < WRK-PARM-PERIOD-START-DATE) DTSBE408
|
||||
00347 OR DTSBE408
|
||||
00348 (MDPC-STATUS-DATE > WRK-PARM-PERIOD-END-DATE) DTSBE408
|
||||
00349 NEXT SENTENCE DTSBE408
|
||||
00350 ELSE DTSBE408
|
||||
00351 PERFORM P1110-GENERATE-R408 THRU P1110-EXIT. DTSBE408
|
||||
00352 DTSBE408
|
||||
00353 P1100-EXIT. DTSBE408
|
||||
00354 EXIT. DTSBE408
|
||||
00355 EJECT DTSBE408
|
||||
00356 ************************************************************** DTSBE408
|
||||
00357 * THIS PARAGRAPH SETS UP THE R408 REPORT EXTRACT RECORD AND DTSBE408
|
||||
00358 * CAUSES IT TO BE WRITTEN. DTSBE408
|
||||
00359 ************************************************************** DTSBE408
|
||||
00360 DTSBE408
|
||||
00361 P1110-GENERATE-R408. DTSBE408
|
||||
00362 DTSBE408
|
||||
00363 MOVE MDPC-RESPONSIBLE-OP-ID TO R408-OP-ID. DTSBE408
|
||||
00364 MOVE MPRF-EMP-NO TO R408-EMP-NO. DTSBE408
|
||||
00365 MOVE MPRF-PRIMARY-NAME TO R408-PRIMARY-NAME. CL**2
|
||||
00366 MOVE WRK-PARM-PERIOD-START-DATE DTSBE408
|
||||
00367 TO R408-PERIOD-START-DATE. DTSBE408
|
||||
00368 MOVE WRK-PARM-PERIOD-END-DATE DTSBE408
|
||||
00369 TO R408-PERIOD-END-DATE. DTSBE408
|
||||
00370 MOVE MDPC-COV-CNT TO R408-COVERED-YRQ-CNT. DTSBE408
|
||||
00371 DTSBE408
|
||||
00372 PERFORM P1112-MOVE-YRQ-TABLE THRU P1112-EXIT DTSBE408
|
||||
00373 VARYING MDPC-COV-IDX FROM 1 BY 1 DTSBE408
|
||||
00374 UNTIL MDPC-COV-IDX GREATER THAN MDPC-COV-CNT. DTSBE408
|
||||
00375 DTSBE408
|
||||
00376 PERFORM S946-WRITE-R408 THRU S946-EXIT. DTSBE408
|
||||
00377 DTSBE408
|
||||
00378 PERFORM P1111-INITIALIZE-TABLE THRU P1111-EXIT DTSBE408
|
||||
00379 VARYING WRK-SUB FROM 1 BY 1 DTSBE408
|
||||
00380 UNTIL WRK-SUB GREATER THAN R408-COVERED-YRQ-CNT. DTSBE408
|
||||
00381 DTSBE408
|
||||
00382 P1110-EXIT. DTSBE408
|
||||
00383 EXIT. DTSBE408
|
||||
00384 EJECT DTSBE408
|
||||
00385 ************************************************************** DTSBE408
|
||||
00386 * THIS PARAGRAPH MOVES THE QUARTERS COVERED TABLE IN THE MDPC DTSBE408
|
||||
00387 * RECORD TO THE R408 EXTRACT RECORD TABLE. DTSBE408
|
||||
00388 ************************************************************** DTSBE408
|
||||
00389 DTSBE408
|
||||
00390 P1111-INITIALIZE-TABLE. DTSBE408
|
||||
00391 DTSBE408
|
||||
00392 MOVE ZEROS TO R408-COVERED-YRQ (WRK-SUB). DTSBE408
|
||||
00393 DTSBE408
|
||||
00394 P1111-EXIT. DTSBE408
|
||||
00395 EXIT. DTSBE408
|
||||
00396 EJECT DTSBE408
|
||||
00397 ************************************************************** DTSBE408
|
||||
00398 * THIS PARAGRAPH MOVES THE QUARTERS COVERED TABLE IN THE MDPC DTSBE408
|
||||
00399 * RECORD TO THE R408 EXTRACT RECORD TABLE. DTSBE408
|
||||
00400 ************************************************************** DTSBE408
|
||||
00401 DTSBE408
|
||||
00402 P1112-MOVE-YRQ-TABLE. DTSBE408
|
||||
00403 DTSBE408
|
||||
00404 SET R408-YRQ-IDX TO MDPC-COV-IDX. DTSBE408
|
||||
00405 DTSBE408
|
||||
00406 MOVE MDPC-COVERED-YRQ (MDPC-COV-IDX) DTSBE408
|
||||
00407 TO R408-COVERED-YRQ (R408-YRQ-IDX). DTSBE408
|
||||
00408 DTSBE408
|
||||
00409 P1112-EXIT. DTSBE408
|
||||
00410 EXIT. DTSBE408
|
||||
00411 EJECT DTSBE408
|
||||
00412 ************************************************************** DTSBE408
|
||||
00413 * THIS PARAGRAPH DETERMINES WHETHER AN OPEN MDPC RECORD DTSBE408
|
||||
00414 * SHOULD BE AUTOMATICALLY SATISFIED. IF IT SHOULD BE DTSBE408
|
||||
00415 * SATISFIED MODIFY AND REWRITE THE MDPC RECORD, AND WRITE DTSBE408
|
||||
00416 * AN MEVL RECORD COMMEMORATING THE EVENT. DTSBE408
|
||||
00417 ************************************************************** DTSBE408
|
||||
00418 DTSBE408
|
||||
00419 P1200-OPEN-MDPC. DTSBE408
|
||||
00420 DTSBE408
|
||||
00421 SET WRK-PLAN-SATISFIED-88 TO TRUE. DTSBE408
|
||||
00422 DTSBE408
|
||||
00423 PERFORM P1210-PROCESS-QTRS THRU P1210-EXIT DTSBE408
|
||||
00424 VARYING MDPC-COV-IDX FROM 1 BY 1 DTSBE408
|
||||
00425 UNTIL WRK-PLAN-NOT-SATISFIED-88 OR DTSBE408
|
||||
00426 MDPC-COV-IDX GREATER THAN MDPC-COV-CNT. DTSBE408
|
||||
00427 DTSBE408
|
||||
00428 IF WRK-PLAN-SATISFIED-88 DTSBE408
|
||||
00429 PERFORM P1110-GENERATE-R408 THRU P1110-EXIT DTSBE408
|
||||
00430 PERFORM P1220-REWRITE-MDPC THRU P1220-EXIT DTSBE408
|
||||
00431 PERFORM P1230-WRITE-MEVL THRU P1230-EXIT. DTSBE408
|
||||
00432 DTSBE408
|
||||
00433 P1200-EXIT. DTSBE408
|
||||
00434 EXIT. DTSBE408
|
||||
00435 EJECT DTSBE408
|
||||
00436 ************************************************************** DTSBE408
|
||||
00437 * THIS PARAGRAPH READS THE MQTR RECORDS COVERED BY THE MDPC DTSBE408
|
||||
00438 * RECORD TO DETERMINE IF THER ARE BALANCES DUE. IF THERE DTSBE408
|
||||
00439 * ARE NOT THE PAYMENTS ARE CHECKED TO SEE IF THEY ARE OVER DTSBE408
|
||||
00440 * TWO WEEKS OLD. DTSBE408
|
||||
00441 ************************************************************** DTSBE408
|
||||
00442 DTSBE408
|
||||
00443 P1210-PROCESS-QTRS. DTSBE408
|
||||
00444 DTSBE408
|
||||
00445 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE408
|
||||
00446 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE408
|
||||
00447 SET MQTR-QTR-88 TO TRUE. DTSBE408
|
||||
00448 MOVE MDPC-COVERED-YRQ (MDPC-COV-IDX) TO MQTR-YRQ. DTSBE408
|
||||
00449 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE408
|
||||
00450 DTSBE408
|
||||
00451 PERFORM S910-READ THRU S910-EXIT. DTSBE408
|
||||
00452 DTSBE408
|
||||
00453 IF L910-OK-88 DTSBE408
|
||||
00454 NEXT SENTENCE DTSBE408
|
||||
00455 ELSE DTSBE408
|
||||
00456 GO TO P1210-EXIT. DTSBE408
|
||||
00457 DTSBE408
|
||||
00458 MOVE MSKL-REC TO MQTR-REC. DTSBE408
|
||||
00459 DTSBE408
|
||||
00460 PERFORM P1211-PROCESS-ACCT-AREA THRU P1211-EXIT DTSBE408
|
||||
00461 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE408
|
||||
00462 UNTIL WRK-PLAN-NOT-SATISFIED-88 OR DTSBE408
|
||||
00463 MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT. DTSBE408
|
||||
00464 DTSBE408
|
||||
00465 IF MQTR-RPT-IS-PURSUED-88 DTSBE408
|
||||
00466 SET WRK-PLAN-NOT-SATISFIED-88 TO TRUE. DTSBE408
|
||||
00467 DTSBE408
|
||||
00468 IF WRK-PLAN-NOT-SATISFIED-88 DTSBE408
|
||||
00469 GO TO P1210-EXIT. DTSBE408
|
||||
00470 DTSBE408
|
||||
00471 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBE408
|
||||
00472 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE408
|
||||
00473 MOVE MQTR-YRQ TO MDST-YRQ. DTSBE408
|
||||
00474 SET MDST-DST-88 TO TRUE. DTSBE408
|
||||
00475 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE408
|
||||
00476 DTSBE408
|
||||
00477 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE408
|
||||
00478 DTSBE408
|
||||
00479 IF L910-OK-88 DTSBE408
|
||||
00480 PERFORM P1212-CHECK-DATE THRU P1212-EXIT DTSBE408
|
||||
00481 UNTIL L910-NO-REC-88 OR DTSBE408
|
||||
00482 WRK-PLAN-NOT-SATISFIED-88. DTSBE408
|
||||
00483 DTSBE408
|
||||
00484 P1210-EXIT. DTSBE408
|
||||
00485 EXIT. DTSBE408
|
||||
00486 EJECT DTSBE408
|
||||
00487 ************************************************************** DTSBE408
|
||||
00488 * THIS PARAGRAPH CHECKS THE BALANCE DUE IN THE MQTR RECORDS. DTSBE408
|
||||
00489 ************************************************************** DTSBE408
|
||||
00490 DTSBE408
|
||||
00491 P1211-PROCESS-ACCT-AREA. DTSBE408
|
||||
00492 DTSBE408
|
||||
00493 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) GREATER THAN ZERO DTSBE408
|
||||
00494 SET WRK-PLAN-NOT-SATISFIED-88 TO TRUE. DTSBE408
|
||||
00495 DTSBE408
|
||||
00496 P1211-EXIT. DTSBE408
|
||||
00497 EXIT. DTSBE408
|
||||
00498 EJECT DTSBE408
|
||||
00499 ************************************************************** DTSBE408
|
||||
00500 * THIS PARAGRAPH CHECKS THE PAYMENT DATES ON ALL MDST DTSBE408
|
||||
00501 * RECORDS FOR THE QUARTER TO DETERMINE IF THE PAYMENTS HAVE DTSBE408
|
||||
00502 * AGED. DTSBE408
|
||||
00503 ************************************************************** DTSBE408
|
||||
00504 DTSBE408
|
||||
00505 P1212-CHECK-DATE. DTSBE408
|
||||
00506 DTSBE408
|
||||
00507 MOVE MSKL-REC TO MDST-REC. DTSBE408
|
||||
00508 DTSBE408
|
||||
00509 IF MDST-YRQ EQUAL MQTR-YRQ DTSBE408
|
||||
00510 NEXT SENTENCE DTSBE408
|
||||
00511 ELSE DTSBE408
|
||||
00512 SET L910-NO-REC-88 TO TRUE DTSBE408
|
||||
00513 GO TO P1212-EXIT. DTSBE408
|
||||
00514 DTSBE408
|
||||
00515 IF MDST-RECEIVED-DATE LESS THAN WRK-PAYMENT-CUTOFF-DATE DTSBE408
|
||||
00516 NEXT SENTENCE DTSBE408
|
||||
00517 ELSE DTSBE408
|
||||
00518 SET WRK-PLAN-NOT-SATISFIED-88 TO TRUE. DTSBE408
|
||||
00519 DTSBE408
|
||||
00520 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE408
|
||||
00521 DTSBE408
|
||||
00522 P1212-EXIT. DTSBE408
|
||||
00523 EXIT. DTSBE408
|
||||
00524 EJECT DTSBE408
|
||||
00525 ************************************************************** DTSBE408
|
||||
00526 * THIS PARAGRAPH REWRITES THE MDPC RECORD IF IT HAS BEEN DTSBE408
|
||||
00527 * DETERMINED THAT IT SHOULD BE AUTOMATICALLY SATISFIED. DTSBE408
|
||||
00528 ************************************************************** DTSBE408
|
||||
00529 DTSBE408
|
||||
00530 P1220-REWRITE-MDPC. DTSBE408
|
||||
00531 DTSBE408
|
||||
00532 SET MDPC-STATUS-SATISFIED-88 TO TRUE. DTSBE408
|
||||
00533 SET MDPC-STATUS-SYSTEM-88 TO TRUE. DTSBE408
|
||||
00534 DTSBE408
|
||||
00535 MOVE LECM-CURR-RUN-DATE TO MDPC-STATUS-DATE DTSBE408
|
||||
00536 MDPC-CHNG-DATE. DTSBE408
|
||||
00537 MOVE MDPC-REC TO MSKL-REC. DTSBE408
|
||||
00538 DTSBE408
|
||||
00539 PERFORM S910-REWRITE THRU S910-EXIT. DTSBE408
|
||||
00540 DTSBE408
|
||||
00541 P1220-EXIT. DTSBE408
|
||||
00542 EXIT. DTSBE408
|
||||
00543 EJECT DTSBE408
|
||||
00544 ************************************************************** DTSBE408
|
||||
00545 * THIS PARAGRAPH WRITES AN MEVL RECORD WHEN AN MDST RECORD DTSBE408
|
||||
00546 * HAS BEEN AUTOMATICALLY SATISFIED. DTSBE408
|
||||
00547 ************************************************************** DTSBE408
|
||||
00548 DTSBE408
|
||||
00549 P1230-WRITE-MEVL. DTSBE408
|
||||
00550 DTSBE408
|
||||
00551 MOVE LOW-VALUES TO MEVL-REC. DTSBE408
|
||||
00552 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE408
|
||||
00553 SET MEVL-EVL-88 TO TRUE. DTSBE408
|
||||
00554 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE408
|
||||
00555 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE408
|
||||
00556 DTSBE408
|
||||
00557 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE408
|
||||
00558 DTSBE408
|
||||
00559 MOVE L005-DATE TO MEVL-DATE. DTSBE408
|
||||
00560 MOVE L005-TIME TO MEVL-TIME. DTSBE408
|
||||
00561 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBE408
|
||||
00562 MOVE EVL-TEXT TO MEVL-TEXT. DTSBE408
|
||||
00563 DTSBE408
|
||||
00564 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE408
|
||||
00565 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE408
|
||||
00566 DTSBE408
|
||||
00567 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE408
|
||||
00568 MEVL-CHNG-DATE. DTSBE408
|
||||
00569 MOVE MEVL-REC TO MSKL-REC. DTSBE408
|
||||
00570 DTSBE408
|
||||
00571 PERFORM S910-WRITE THRU S910-EXIT. DTSBE408
|
||||
00572 DTSBE408
|
||||
00573 P1230-EXIT. DTSBE408
|
||||
00574 EXIT. DTSBE408
|
||||
00575 EJECT DTSBE408
|
||||
00576 T0000-TERMINATE. DTSBE408
|
||||
00577 SKIP2 DTSBE408
|
||||
00578 SKIP2 DTSBE408
|
||||
00579 T0000-EXIT. DTSBE408
|
||||
00580 EXIT. DTSBE408
|
||||
00581 EJECT DTSBE408
|
||||
00582 S001-FROM-FED-8. DTSBE408
|
||||
00583 SET L001-FROM-FED-8 TO TRUE. DTSBE408
|
||||
00584 GO TO S001-DATE. DTSBE408
|
||||
00585 SKIP1 DTSBE408
|
||||
00586 S001-FROM-CAL-6. DTSBE408
|
||||
00587 SET L001-FROM-CAL-6 TO TRUE. DTSBE408
|
||||
00588 GO TO S001-DATE. DTSBE408
|
||||
00589 SKIP1 DTSBE408
|
||||
00590 S001-FROM-ABS-DAY. DTSBE408
|
||||
00591 SET L001-FROM-ABS-DAY TO TRUE. DTSBE408
|
||||
00592 GO TO S001-DATE. DTSBE408
|
||||
00593 SKIP1 DTSBE408
|
||||
00594 S001-DATE. DTSBE408
|
||||
00595 CALL 'DTSBU001' USING L001-LINK-AREA. CL**2
|
||||
00596 S001-EXIT. DTSBE408
|
||||
00597 EXIT. DTSBE408
|
||||
00598 SKIP3 DTSBE408
|
||||
00599 S004-FROM-ABS. DTSBE408
|
||||
00600 SET L004-FROM-ABS TO TRUE. DTSBE408
|
||||
00601 GO TO S004-QTR. DTSBE408
|
||||
00602 SKIP1 DTSBE408
|
||||
00603 S004-FROM-3. DTSBE408
|
||||
00604 SET L004-FROM-3 TO TRUE. DTSBE408
|
||||
00605 GO TO S004-QTR. DTSBE408
|
||||
00606 SKIP1 DTSBE408
|
||||
00607 S004-QTR. DTSBE408
|
||||
00608 SKIP1 DTSBE408
|
||||
00609 CALL 'DTSBU004' USING L004-LINK-AREA. CL**2
|
||||
00610 SKIP1 DTSBE408
|
||||
00611 S004-EXIT. DTSBE408
|
||||
00612 EXIT. DTSBE408
|
||||
00613 SKIP3 DTSBE408
|
||||
00614 S005-FROM-ABSTIME. DTSBE408
|
||||
00615 SET L005-FROM-ABSTIME TO TRUE. DTSBE408
|
||||
00616 GO TO S005-ABSTIME. DTSBE408
|
||||
00617 DTSBE408
|
||||
00618 S005-ABSTIME. DTSBE408
|
||||
00619 CALL 'DTSBU005' USING L005-LINK-AREA. CL**2
|
||||
00620 S005-EXIT. DTSBE408
|
||||
00621 EXIT. DTSBE408
|
||||
00622 SKIP3 DTSBE408
|
||||
00623 S910-READ. DTSBE408
|
||||
00624 SET L910-READ-88 TO TRUE. DTSBE408
|
||||
00625 GO TO S910-MSTR-IO. DTSBE408
|
||||
00626 SKIP1 DTSBE408
|
||||
00627 S910-START-BROWSE. DTSBE408
|
||||
00628 SET L910-START-BROWSE-88 TO TRUE. DTSBE408
|
||||
00629 GO TO S910-MSTR-IO. DTSBE408
|
||||
00630 SKIP1 DTSBE408
|
||||
00631 S910-READ-NEXT. DTSBE408
|
||||
00632 SET L910-READ-NEXT-88 TO TRUE. DTSBE408
|
||||
00633 GO TO S910-MSTR-IO. DTSBE408
|
||||
00634 SKIP1 DTSBE408
|
||||
00635 S910-WRITE. DTSBE408
|
||||
00636 SET L910-WRITE-88 TO TRUE. DTSBE408
|
||||
00637 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE408
|
||||
00638 GO TO S910-MSTR-IO. DTSBE408
|
||||
00639 SKIP1 DTSBE408
|
||||
00640 S910-REWRITE. DTSBE408
|
||||
00641 SET L910-REWRITE-88 TO TRUE. DTSBE408
|
||||
00642 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE408
|
||||
00643 GO TO S910-MSTR-IO. DTSBE408
|
||||
00644 SKIP1 DTSBE408
|
||||
00645 S910-MSTR-IO. DTSBE408
|
||||
00646 CALL 'DTSBU910' USING L910-LINK-AREA CL**2
|
||||
00647 MSKL-REC. DTSBE408
|
||||
00648 S910-EXIT. DTSBE408
|
||||
00649 EXIT. DTSBE408
|
||||
00650 SKIP3 DTSBE408
|
||||
00651 S946-WRITE-R408. DTSBE408
|
||||
00652 CALL 'DTSBU946' USING R408-REC. CL**2
|
||||
00653 GO TO S946-EXIT. DTSBE408
|
||||
00654 SKIP1 DTSBE408
|
||||
00655 S946-EXIT. DTSBE408
|
||||
00656 EXIT. DTSBE408
|
||||
00657 SKIP3 DTSBE408
|
||||
00658 S999-ABEND. DTSBE408
|
||||
00659 DISPLAY '*** DTSBE408 ABENDING. ' CL**2
|
||||
00660 ABEND-MSG. DTSBE408
|
||||
00661 SKIP1 DTSBE408
|
||||
00662 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2
|
||||
00663 S999-EXIT. DTSBE408
|
||||
00664 EXIT. DTSBE408
|
||||
Reference in New Issue
Block a user