996 lines
79 KiB
COBOL
996 lines
79 KiB
COBOL
00001 IDENTIFICATION DIVISION. 09/14/05
|
|
00002 PROGRAM-ID. DTSBD326. DTSBD326
|
|
00003 AUTHOR. NGC. LV003
|
|
00004 DATE-WRITTEN. APRIL 2004. DTSBD326
|
|
00005 DATE-COMPILED. DTSBD326
|
|
00006 SKIP3 DTSBD326
|
|
00007 ***** DTSBD326
|
|
00008 * DTSBD326
|
|
00009 * FUNCTION: COMPROMISE SETTLEMENT PROCESSING. DTSBD326
|
|
00010 * DTSBD326
|
|
00011 * DTSBD326
|
|
00012 * MODIFICATION LOG: DTSBD326
|
|
00013 * DTSBD326
|
|
00014 * 04/30/2004 INITIAL DEVELOPMENT DTSBD326
|
|
00015 * REFERENCE: COMPROMISE PROGRAMMER: GD DTSBD326
|
|
00016 * DTSBD326
|
|
00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD326
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD326
|
|
00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD326
|
|
00020 * DTSBD326
|
|
00021 * DTSBD326
|
|
00022 * DESCRIPTION: DTSBD326
|
|
00023 * DTSBD326
|
|
00024 * READ THE MCMP RECORD INDICATED BY T011-ESTB-ABSTIME. DTSBD326
|
|
00025 * DTSBD326
|
|
00026 * IF MCMP RECORD INDICATED BY T011-ESTB-ABSTIME DOES NOT DTSBD326
|
|
00027 * EXIST, THEN THE TRANSACTION IS IN ERROR. DTSBD326
|
|
00028 * DTSBD326
|
|
00029 * IF NOT (MCMP-STATUS-PENDING-88), DTSBD326
|
|
00030 * THEN THE TRANSACTION IS IN ERROR. DTSBD326
|
|
00031 * DTSBD326
|
|
00032 * SCAN THE MQTR RECORDS INDICATED BY MCMP-COVERED-YRQ. DTSBD326
|
|
00033 * IF NO UI TAX HAS BEEN WAIVED IN MCMP-COVERED-YRQ(S), DTSBD326
|
|
00034 * THEN CHANGE MCMP STATUS TO MCMP-STATUS-WITHDRAWN-88 DTSBD326
|
|
00035 * AND THE TRANSACTION IS IN ERROR. DTSBD326
|
|
00036 * DTSBD326
|
|
00037 * THE FOLLOWING SPECIFICATIONS ASSUME AMOUNTS ARE WAIVED DTSBD326
|
|
00038 * IN ONE OR MORE OF MCMP-COVERED-YRQ(S). DTSBD326
|
|
00039 * DTSBD326
|
|
00040 * CONSTRUCT AND WRITE A R436 RECORD. DTSBD326
|
|
00041 * DTSBD326
|
|
00042 * WRITE AN EVENT LOG RECORD. DTSBD326
|
|
00043 * DTSBD326
|
|
00044 * DTSBD326
|
|
00045 * MASTER FILE RECORDS READ: DTSBD326
|
|
00046 * DTSBD326
|
|
00047 * MCMP DTSBD326
|
|
00048 * MQTR DTSBD326
|
|
00049 * MOPO DTSBD326
|
|
00050 * DTSBD326
|
|
00051 * DTSBD326
|
|
00052 * MASTER FILE RECORDS UPDATED: DTSBD326
|
|
00053 * DTSBD326
|
|
00054 * MCMP (REWRITE) DTSBD326
|
|
00055 * MEVL (WRITE) DTSBD326
|
|
00056 * DTSBD326
|
|
00057 * DTSBD326
|
|
00058 * REPORT RECORDS WRITTEN: DTSBD326
|
|
00059 * DTSBD326
|
|
00060 * R436 COMPROMISE SETTLEMENT DOCUMENT. DTSBD326
|
|
00061 * R907 EXCEPTION REPORT. DTSBD326
|
|
00062 * DTSBD326
|
|
00063 * DTSBD326
|
|
00064 * MODULES CALLED: DTSBD326
|
|
00065 * DTSBD326
|
|
00066 * DTSBU001 DATE EDIT/CONVERSION. DTSBD326
|
|
00067 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBD326
|
|
00068 * DTSBU005 TIME EDIT/CONVERSION. DTSBD326
|
|
00069 * DTSBU101 INTEREST CHARGE/ABATEMENT COMPUTATION. DTSBD326
|
|
00070 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD326
|
|
00071 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTAIL OUTPUT 1. DTSBD326
|
|
00072 * DTSBD326
|
|
00073 * DTSBD326
|
|
00074 ***** DTSBD326
|
|
00075 SKIP3 DTSBD326
|
|
00076 ENVIRONMENT DIVISION. DTSBD326
|
|
00077 EJECT DTSBD326
|
|
00078 DATA DIVISION. DTSBD326
|
|
00079 SKIP3 DTSBD326
|
|
00080 WORKING-STORAGE SECTION. DTSBD326
|
|
000805 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD326 09/14/05'. DTSBD326
|
|
00081 SKIP3 DTSBD326
|
|
00082 01 WRK-AREA. DTSBD326
|
|
00083 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +326.DTSBD326
|
|
00084 DTSBD326
|
|
00085 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD326'.DTSBD326
|
|
00086 DTSBD326
|
|
00087 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD326
|
|
00088 DTSBD326
|
|
00089 05 WRK-AMT-DISP1 PIC --------9.99. DTSBD326
|
|
00090 05 WRK-AMT-DISP2 PIC --------9.99. DTSBD326
|
|
00091 DTSBD326
|
|
00092 05 WRK-QTR-FOUND-IND PIC X(01). DTSBD326
|
|
00093 88 WRK-QTR-FOUND-YES-88 VALUE 'Y'. DTSBD326
|
|
00094 88 WRK-QTR-FOUND-NO-88 VALUE 'N'. DTSBD326
|
|
00095 DTSBD326
|
|
00096 05 WRK-QTR-WAIVER-IND PIC X(01). DTSBD326
|
|
00097 88 WRK-QTR-WAIVER-YES-88 VALUE 'Y'. DTSBD326
|
|
00098 88 WRK-QTR-WAIVER-NO-88 VALUE 'N'. DTSBD326
|
|
00099 DTSBD326
|
|
00100 05 WRK-CNT PIC S9(04) COMP. DTSBD326
|
|
00101 05 WRK-AMT PIC S9(09)V9(02) COMP-3. DTSBD326
|
|
00102 DTSBD326
|
|
00103 05 WRK-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBD326
|
|
00104 05 WRK-YRQ-UI-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD326
|
|
00105 05 WRK-TOT-TAX-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD326
|
|
00106 05 WRK-TOT-PEN-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD326
|
|
00107 05 WRK-TOT-INT-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD326
|
|
00108 DTSBD326
|
|
00109 05 WRK-QTR-TBL. DTSBD326
|
|
00110 10 WRK-QTR-MAX PIC S9(04) COMP DTSBD326
|
|
00111 VALUE +20. DTSBD326
|
|
00112 10 WRK-QTR-CNT PIC S9(04) COMP. DTSBD326
|
|
00113 10 QTR-SUB PIC S9(04) COMP. DTSBD326
|
|
00114 10 FILLER OCCURS 20. DTSBD326
|
|
00115 15 WRK-QTR-YRQ PIC S9(05) COMP-3. DTSBD326
|
|
00116 15 WRK-QTR-WAIVED-AMT PIC S9(09)V99 COMP-3. DTSBD326
|
|
00117 15 WRK-QTR-REVERSE-AMT PIC S9(09)V99 COMP-3. DTSBD326
|
|
00118 DTSBD326
|
|
00119 05 WRK-REVERSE-TBL. DTSBD326
|
|
00120 10 WRK-REV-MAX PIC S9(04) COMP DTSBD326
|
|
00121 VALUE +100. DTSBD326
|
|
00122 10 REV-CNT PIC S9(04) COMP. DTSBD326
|
|
00123 10 REV-SUB PIC S9(04) COMP. DTSBD326
|
|
00124 10 FILLER OCCURS 100. DTSBD326
|
|
00125 15 WRK-REV-APPLIC-YRQ PIC S9(05) COMP-3. DTSBD326
|
|
00126 15 WRK-REV-APPLIC-IND PIC X(02). DTSBD326
|
|
00127 15 WRK-REV-AMT PIC S9(09)V99 COMP-3. DTSBD326
|
|
00128 DTSBD326
|
|
00129 05 WRK-EVENT-TXT. DTSBD326
|
|
00130 10 FILLER PIC X(36) DTSBD326
|
|
00131 VALUE 'COMPROMISE SETTLEMENT PRINTED. '. DTSBD326
|
|
00132 EJECT DTSBD326
|
|
00133 01 MSG-TABLE. DTSBD326
|
|
00134 05 MSG1-MCMP-NOT-FOUND. DTSBD326
|
|
00135 10 MSG1-ID PIC X(11) VALUE 'DTSBD326411'. DTSBD326
|
|
00136 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'DELETED MCMP '. DTSBD326
|
|
00137 10 MSG1-LONG-TEXT. DTSBD326
|
|
00138 15 FILLER PIC X(30) DTSBD326
|
|
00139 VALUE 'TRANSACTION FAILED - RECORD NO'. DTSBD326
|
|
00140 15 FILLER PIC X(30) DTSBD326
|
|
00141 VALUE 'T FOUND - NO CMP PRINTED '. DTSBD326
|
|
00142 DTSBD326
|
|
00143 05 MSG2-MCMP-NOT-PENDING. DTSBD326
|
|
00144 10 MSG2-ID PIC X(11) VALUE 'DTSBD326412'. DTSBD326
|
|
00145 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'NOT PENDING '. DTSBD326
|
|
00146 10 MSG2-LONG-TEXT. DTSBD326
|
|
00147 15 FILLER PIC X(30) DTSBD326
|
|
00148 VALUE 'TRANSACTION FAILED - COMPROMIS'. DTSBD326
|
|
00149 15 FILLER PIC X(30) DTSBD326
|
|
00150 VALUE 'E NOT PENDING - NO CMP PRNTED'. DTSBD326
|
|
00151 DTSBD326
|
|
00152 05 MSG3-MQTR-NOT-FOUND. DTSBD326
|
|
00153 10 MSG3-ID. DTSBD326
|
|
00154 15 MSG3-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326
|
|
00155 15 MSG3-ID-2 PIC X(03) VALUE '413'. DTSBD326
|
|
00156 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'MQTR NOT FOUND'. DTSBD326
|
|
00157 10 MSG3-LONG-TEXT. DTSBD326
|
|
00158 15 FILLER PIC X(30) DTSBD326
|
|
00159 VALUE 'TRANSACTION FAILED - MQTR RECO'. DTSBD326
|
|
00160 15 FILLER PIC X(30) DTSBD326
|
|
00161 VALUE 'RD NOT FOUND '. DTSBD326
|
|
00162 15 MSG3-YRQ PIC X(06). DTSBD326
|
|
00163 DTSBD326
|
|
00164 05 MSG4-NO-DUE. DTSBD326
|
|
00165 10 MSG4-ID. DTSBD326
|
|
00166 15 MSG4-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326
|
|
00167 15 MSG4-ID-2 PIC X(03) VALUE '414'. DTSBD326
|
|
00168 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'NOTHING WAIVED'. DTSBD326
|
|
00169 10 MSG4-LONG-TEXT. DTSBD326
|
|
00170 15 FILLER PIC X(30) DTSBD326
|
|
00171 VALUE 'NOTHING WAIVED - NO COMPROMISE'. DTSBD326
|
|
00172 15 FILLER PIC X(30) DTSBD326
|
|
00173 VALUE ' SETTLEMENT PRINTED '. DTSBD326
|
|
00174 DTSBD326
|
|
00175 05 MSG5-NO-WAIVER. DTSBD326
|
|
00176 10 MSG5-ID. DTSBD326
|
|
00177 15 MSG5-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326
|
|
00178 15 MSG5-ID-2 PIC X(03) VALUE '415'. DTSBD326
|
|
00179 10 MSG5-SHORT-TEXT PIC X(20) VALUE 'NO WAIVER '. DTSBD326
|
|
00180 10 MSG5-LONG-TEXT. DTSBD326
|
|
00181 15 FILLER PIC X(30) DTSBD326
|
|
00182 VALUE 'UI TAX NOT WAIVED FOR THIS QUA'. DTSBD326
|
|
00183 15 FILLER PIC X(05) DTSBD326
|
|
00184 VALUE 'RTER '. DTSBD326
|
|
00185 15 MSG5-YRQ PIC X(06). DTSBD326
|
|
00186 DTSBD326
|
|
00187 05 MSG6-ADJ-FAILED. DTSBD326
|
|
00188 10 MSG6-ID. DTSBD326
|
|
00189 15 MSG6-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326
|
|
00190 15 MSG6-ID-2 PIC X(03) VALUE '416'. DTSBD326
|
|
00191 10 MSG6-SHORT-TEXT PIC X(20) VALUE 'ADJ FAILED '. DTSBD326
|
|
00192 10 MSG6-LONG-TEXT. DTSBD326
|
|
00193 15 FILLER PIC X(30) DTSBD326
|
|
00194 VALUE 'ADJ TRANSACTION FAILED - WITHD'. DTSBD326
|
|
00195 15 FILLER PIC X(16) DTSBD326
|
|
00196 VALUE 'RAWAL CANCELLED '. DTSBD326
|
|
00197 05 MSG7-ADJ-EDIT-FAILED. DTSBD326
|
|
00198 10 MSG7-ID. DTSBD326
|
|
00199 15 MSG7-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326
|
|
00200 15 MSG7-ID-2 PIC X(03) VALUE '417'. DTSBD326
|
|
00201 10 MSG7-SHORT-TEXT PIC X(20) VALUE 'ADJ EDIT FAIL '. DTSBD326
|
|
00202 10 MSG7-LONG-TEXT. DTSBD326
|
|
00203 15 FILLER PIC X(30) DTSBD326
|
|
00204 VALUE 'ADJ WAIVED AMT NOT = QTR WAIVE'. DTSBD326
|
|
00205 15 FILLER PIC X(16) DTSBD326
|
|
00206 VALUE 'D AMT '. DTSBD326
|
|
00207 EJECT DTSBD326
|
|
00208 01 L001-LINK-AREA. DTSBD326
|
|
00209 ++INCLUDE DTSIL001 DTSBD326
|
|
00210 SKIP3 DTSBD326
|
|
00211 01 L003-LINK-AREA. DTSBD326
|
|
00212 ++INCLUDE DTSIL003 DTSBD326
|
|
00213 SKIP3 DTSBD326
|
|
00214 01 L004-LINK-AREA. DTSBD326
|
|
00215 ++INCLUDE DTSIL004 DTSBD326
|
|
00216 SKIP3 DTSBD326
|
|
00217 01 L005-LINK-AREA. DTSBD326
|
|
00218 ++INCLUDE DTSIL005 DTSBD326
|
|
00219 SKIP3 DTSBD326
|
|
00220 01 L101-LINK-AREA. DTSBD326
|
|
00221 ++INCLUDE DTSIL101 DTSBD326
|
|
00222 EJECT DTSBD326
|
|
00223 01 ASKL-REC. DTSBD326
|
|
00224 ++INCLUDE DTSIASKL DTSBD326
|
|
00225 SKIP3 DTSBD326
|
|
00226 01 AADJ-REC REDEFINES ASKL-REC. DTSBD326
|
|
00227 ++INCLUDE DTSIAADJ DTSBD326
|
|
00228 DTSBD326
|
|
00229 01 L910-LINK-AREA. DTSBD326
|
|
00230 ++INCLUDE DTSIL910 DTSBD326
|
|
00231 SKIP3 DTSBD326
|
|
00232 01 MSKL-REC. DTSBD326
|
|
00233 ++INCLUDE DTSIMSKL DTSBD326
|
|
00234 SKIP3 DTSBD326
|
|
00235 01 MCMP-REC. DTSBD326
|
|
00236 ++INCLUDE DTSIMCMP DTSBD326
|
|
00237 SKIP3 DTSBD326
|
|
00238 01 MQTR-REC. DTSBD326
|
|
00239 ++INCLUDE DTSIMQTR DTSBD326
|
|
00240 SKIP3 DTSBD326
|
|
00241 01 MEVL-REC. DTSBD326
|
|
00242 ++INCLUDE DTSIMEVL DTSBD326
|
|
00243 SKIP3 DTSBD326
|
|
00244 01 MTCK-REC. DTSBD326
|
|
00245 ++INCLUDE DTSIMTCK DTSBD326
|
|
00246 EJECT DTSBD326
|
|
00247 01 MADJ-REC. DTSBD326
|
|
00248 ++INCLUDE DTSIMADJ DTSBD326
|
|
00249 EJECT DTSBD326
|
|
00250 01 MMAX-LITERALS. DTSBD326
|
|
00251 ++INCLUDE DTSIMMAX DTSBD326
|
|
00252 EJECT DTSBD326
|
|
00253 01 R436-REC. DTSBD326
|
|
00254 ++INCLUDE DTSIR436 DTSBD326
|
|
00255 SKIP3 DTSBD326
|
|
00256 01 L501-LINK-AREA. DTSBD326
|
|
00257 ++INCLUDE DTSIL501 DTSBD326
|
|
00258 DTSBD326
|
|
00259 01 R907-REC. DTSBD326
|
|
00260 ++INCLUDE DTSIR907 DTSBD326
|
|
00261 EJECT DTSBD326
|
|
00262 LINKAGE SECTION. DTSBD326
|
|
00263 SKIP3 DTSBD326
|
|
00264 01 LBCM-LINK-AREA. DTSBD326
|
|
00265 ++INCLUDE DTSILBCM DTSBD326
|
|
00266 EJECT DTSBD326
|
|
00267 01 MPRF-REC. DTSBD326
|
|
00268 ++INCLUDE DTSIMPRF DTSBD326
|
|
00269 EJECT DTSBD326
|
|
00270 01 T011-REC. DTSBD326
|
|
00271 ++INCLUDE DTSIT011 DTSBD326
|
|
00272 EJECT DTSBD326
|
|
00273 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD326
|
|
00274 MPRF-REC DTSBD326
|
|
00275 T011-REC. DTSBD326
|
|
00276 DTSBD326
|
|
00277 DTSBD326
|
|
00278 IF FIRST-TIME-IND = 'Y' DTSBD326
|
|
00279 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBD326
|
|
00280 MOVE 'N' TO FIRST-TIME-IND. DTSBD326
|
|
00281 DTSBD326
|
|
00282 DTSBD326
|
|
00283 IF T011-CMP-PKG DTSBD326
|
|
00284 OR T011-CMP-TCK DTSBD326
|
|
00285 OR T011-CMP-WD DTSBD326
|
|
00286 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD326
|
|
00287 ELSE DTSBD326
|
|
00288 PERFORM S999-ABEND THRU S999-EXIT. DTSBD326
|
|
00289 DTSBD326
|
|
00290 DTSBD326
|
|
00291 GOBACK. DTSBD326
|
|
00292 EJECT DTSBD326
|
|
00293 I0000-FIRST-TIME. DTSBD326
|
|
00294 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD326
|
|
00295 DTSBD326
|
|
00296 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD326
|
|
00297 R907-MODULE-NAME DTSBD326
|
|
00298 L501-ORIGIN. DTSBD326
|
|
00299 DTSBD326
|
|
00300 MOVE LENGTH OF R436-REC TO R436-LENGTH. DTSBD326
|
|
00301 DTSBD326
|
|
00302 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD326
|
|
00303 DTSBD326
|
|
00304 I0000-EXIT. DTSBD326
|
|
00305 EXIT. DTSBD326
|
|
00306 DTSBD326
|
|
00307 P0000-PROCESS. DTSBD326
|
|
00308 PERFORM S1000-READ-SUBJECT-MCMP THRU S1000-EXIT. DTSBD326
|
|
00309 DTSBD326
|
|
00310 IF L910-NO-REC-88 DTSBD326
|
|
00311 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326
|
|
00312 MOVE MSG1-MCMP-NOT-FOUND TO LBCM-TRN-MSG-AREA DTSBD326
|
|
00313 GO TO P0000-EXIT. DTSBD326
|
|
00314 DTSBD326
|
|
00315 PERFORM S2000-DELETE-MTCK THRU S2000-EXIT. DTSBD326
|
|
00316 ************************************************************* DTSBD326
|
|
00317 * STATUS MUST BE PENDING. THIS PROGRAM WRITES A TICKLER DTSBD326
|
|
00318 * IF THE MCMP CANNOT BE UPDATED SUCCESSFULLY - THE TICKLER DTSBD326
|
|
00319 * WILL TRIGGER ON THE NEXT RUN DATE, AND CALL THIS PROGRAM DTSBD326
|
|
00320 * TO RE-PROCESS THE MCMP. IF THE T011 TRANSACTION CAME FROM DTSBD326
|
|
00321 * THE TICKLER PROCESS (T011-CMP-TCK IS TRUE), AND THE STATUS DTSBD326
|
|
00322 * IS NOT PENDING, THEN PROCESSING HAS BEEN COMPLETED, AND DTSBD326
|
|
00323 * THE TRIGGER RECORD CAN BE IGNORED. DTSBD326
|
|
00324 ************************************************************* DTSBD326
|
|
00325 IF MCMP-STATUS-WITHDRAWN-88 DTSBD326
|
|
00326 PERFORM P7000-WITHDRAW THRU P7000-EXIT DTSBD326
|
|
00327 IF LBCM-TRN-NOT-OK-88 DTSBD326
|
|
00328 PERFORM P6000-WRITE-TICKLER THRU P6000-EXIT DTSBD326
|
|
00329 END-IF DTSBD326
|
|
00330 GO TO P0000-EXIT DTSBD326
|
|
00331 ELSE DTSBD326
|
|
00332 IF MCMP-STATUS-PENDING-88 DTSBD326
|
|
00333 NEXT SENTENCE DTSBD326
|
|
00334 ELSE DTSBD326
|
|
00335 IF T011-CMP-PKG DTSBD326
|
|
00336 GO TO P0000-EXIT DTSBD326
|
|
00337 ELSE DTSBD326
|
|
00338 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326
|
|
00339 MOVE MSG2-MCMP-NOT-PENDING TO LBCM-TRN-MSG-AREA DTSBD326
|
|
00340 GO TO P0000-EXIT DTSBD326
|
|
00341 END-IF DTSBD326
|
|
00342 END-IF DTSBD326
|
|
00343 END-IF. DTSBD326
|
|
00344 DTSBD326
|
|
00345 PERFORM P1000-START-R436 THRU P1000-EXIT. DTSBD326
|
|
00346 DTSBD326
|
|
00347 MOVE MCMP-INT-COMP-DATE TO L101-RECEIVED-DATE. DTSBD326
|
|
00348 *& DTSBD326
|
|
00349 * DISPLAY 'BD326 P0000 INT COMP ' MCMP-INT-COMP-DATE DTSBD326
|
|
00350 * ' ABS ' LBCM-ABSTIME. DTSBD326
|
|
00351 *& DTSBD326
|
|
00352 DTSBD326
|
|
00353 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBD326
|
|
00354 DTSBD326
|
|
00355 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD326
|
|
00356 DTSBD326
|
|
00357 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD326
|
|
00358 DTSBD326
|
|
00359 SET MQTR-QTR-88 TO TRUE. DTSBD326
|
|
00360 DTSBD326
|
|
00361 PERFORM P3000-PROCESS-MQTR THRU P3000-EXIT. DTSBD326
|
|
00362 DTSBD326
|
|
00363 IF LBCM-TRN-OK-88 DTSBD326
|
|
00364 PERFORM P4000-WRITE-MCMP-AND-REPORT THRU P4000-EXIT DTSBD326
|
|
00365 PERFORM P5000-UPDATE-MQTR THRU P5000-EXIT DTSBD326
|
|
00366 ELSE DTSBD326
|
|
00367 PERFORM P6000-WRITE-TICKLER THRU P6000-EXIT DTSBD326
|
|
00368 END-IF. DTSBD326
|
|
00369 DTSBD326
|
|
00370 P0000-EXIT. DTSBD326
|
|
00371 EXIT. DTSBD326
|
|
00372 EJECT DTSBD326
|
|
00373 P1000-START-R436. DTSBD326
|
|
00374 MOVE T011-RESP-OP-ID TO R436-RESP-OP-ID. DTSBD326
|
|
00375 DTSBD326
|
|
00376 MOVE MPRF-EMP-NO TO R436-EMP-NO. DTSBD326
|
|
00377 DTSBD326
|
|
00378 DTSBD326
|
|
00379 INITIALIZE R436-DATA-AREA. DTSBD326
|
|
00380 MOVE LBCM-CURR-MAIL-DATE TO R436-MAIL-DATE. DTSBD326
|
|
00381 DTSBD326
|
|
00382 MOVE MCMP-SETTLEMENT-DATE TO R436-SETTLEMENT-DATE DTSBD326
|
|
00383 DTSBD326
|
|
00384 MOVE MPRF-PRIMARY-NAME TO R436-PRIMARY-NAME. DTSBD326
|
|
00385 DTSBD326
|
|
00386 MOVE MCMP-MAILING-ADDRESS TO R436-MAILING-ADDRESS. DTSBD326
|
|
00387 DTSBD326
|
|
00388 P1000-EXIT. DTSBD326
|
|
00389 EXIT. DTSBD326
|
|
00390 EJECT DTSBD326
|
|
00391 P3000-PROCESS-MQTR. DTSBD326
|
|
00392 MOVE +0 TO WRK-TOT-BALANCE-AMT DTSBD326
|
|
00393 WRK-TOT-TAX-WAIVED-AMT DTSBD326
|
|
00394 WRK-TOT-PEN-WAIVED-AMT DTSBD326
|
|
00395 WRK-TOT-INT-WAIVED-AMT. DTSBD326
|
|
00396 DTSBD326
|
|
00397 PERFORM P3100-EACH-QTR THRU P3100-EXIT DTSBD326
|
|
00398 VARYING WRK-CNT FROM 1 BY 1 DTSBD326
|
|
00399 UNTIL WRK-CNT > MCMP-COV-CNT. DTSBD326
|
|
00400 DTSBD326
|
|
00401 IF LBCM-TRN-OK-88 DTSBD326
|
|
00402 IF WRK-TOT-TAX-WAIVED-AMT = ZERO DTSBD326
|
|
00403 DISPLAY 'ERR: TOT WAIVED = ZERO' DTSBD326
|
|
00404 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326
|
|
00405 MOVE MSG4-NO-DUE TO LBCM-TRN-MSG-AREA DTSBD326
|
|
00406 END-IF DTSBD326
|
|
00407 END-IF. DTSBD326
|
|
00408 DTSBD326
|
|
00409 P3000-EXIT. DTSBD326
|
|
00410 EXIT. DTSBD326
|
|
00411 DTSBD326
|
|
00412 P3100-EACH-QTR. DTSBD326
|
|
00413 *& DTSBD326
|
|
00414 DISPLAY 'BD326 P3100 ' MPRF-EMP-NO DTSBD326
|
|
00415 ' WRK-CNT ' WRK-CNT DTSBD326
|
|
00416 ' QTR ' MCMP-COVERED-YRQ (WRK-CNT). DTSBD326
|
|
00417 *& DTSBD326
|
|
00418 MOVE +0 TO L101-PAID-CHNG. DTSBD326
|
|
00419 DTSBD326
|
|
00420 SET WRK-QTR-WAIVER-NO-88 TO TRUE. DTSBD326
|
|
00421 DTSBD326
|
|
00422 MOVE MCMP-COVERED-YRQ (WRK-CNT) TO MQTR-YRQ. DTSBD326
|
|
00423 DTSBD326
|
|
00424 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD326
|
|
00425 DTSBD326
|
|
00426 PERFORM S910-READ THRU S910-EXIT. DTSBD326
|
|
00427 DTSBD326
|
|
00428 IF L910-OK-88 DTSBD326
|
|
00429 MOVE MSKL-REC TO MQTR-REC DTSBD326
|
|
00430 ELSE DTSBD326
|
|
00431 DISPLAY 'ERR: P3100 NO MQTR' DTSBD326
|
|
00432 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326
|
|
00433 MOVE MSG3-ID-2 TO R907-MSG-ID DTSBD326
|
|
00434 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBD326
|
|
00435 PERFORM S004-FROM-5 THRU S004-EXIT DTSBD326
|
|
00436 MOVE L004-SLASH-5-QTR TO MSG3-YRQ DTSBD326
|
|
00437 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD326
|
|
00438 MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT DTSBD326
|
|
00439 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD326
|
|
00440 GO TO P3100-EXIT. DTSBD326
|
|
00441 DTSBD326
|
|
00442 DTSBD326
|
|
00443 PERFORM P3110-PROCESS-ACCT-AREA THRU P3110-EXIT DTSBD326
|
|
00444 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD326
|
|
00445 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBD326
|
|
00446 DTSBD326
|
|
00447 IF WRK-QTR-WAIVER-NO-88 DTSBD326
|
|
00448 DISPLAY 'ERR: P3100 NOTHING WAIVED' DTSBD326
|
|
00449 MOVE MSG5-ID-2 TO R907-MSG-ID DTSBD326
|
|
00450 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBD326
|
|
00451 PERFORM S004-FROM-5 THRU S004-EXIT DTSBD326
|
|
00452 MOVE L004-SLASH-5-QTR TO MSG5-YRQ DTSBD326
|
|
00453 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD326
|
|
00454 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326
|
|
00455 MOVE MSG5-LONG-TEXT TO R907-MSG-TEXT DTSBD326
|
|
00456 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD326
|
|
00457 GO TO P3100-EXIT. DTSBD326
|
|
00458 DTSBD326
|
|
00459 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBD326
|
|
00460 DTSBD326
|
|
00461 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBD326
|
|
00462 DTSBD326
|
|
00463 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBD326
|
|
00464 DISPLAY 'INT CHNG ' L101-INT-CHARGE-CHNG. DTSBD326
|
|
00465 DTSBD326
|
|
00466 ADD L101-INT-CHARGE-CHNG TO WRK-TOT-BALANCE-AMT. DTSBD326
|
|
00467 ** WRK-YRQ-INT-WAIVED-AMT. DTSBD326
|
|
00468 DTSBD326
|
|
00469 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-TOT-BALANCE-AMT. DTSBD326
|
|
00470 ** WRK-YRQ-INT-WAIVED-AMT. DTSBD326
|
|
00471 DTSBD326
|
|
00472 IF R436-COV-CNT < MMAX-CMP-COV-MAX DTSBD326
|
|
00473 ADD +1 TO R436-COV-CNT DTSBD326
|
|
00474 MOVE MQTR-YRQ TO R436-COVERED-YRQ (R436-COV-CNT) DTSBD326
|
|
00475 END-IF. DTSBD326
|
|
00476 DTSBD326
|
|
00477 P3100-EXIT. DTSBD326
|
|
00478 EXIT. DTSBD326
|
|
00479 DTSBD326
|
|
00480 P3110-PROCESS-ACCT-AREA. DTSBD326
|
|
00481 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-TOT-BALANCE-AMT. DTSBD326
|
|
00482 DTSBD326
|
|
00483 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSBD326
|
|
00484 IF MQTR-WAIVED-AMT (MQTR-ACCT-IDX) > ZERO DTSBD326
|
|
00485 SET WRK-QTR-WAIVER-YES-88 TO TRUE DTSBD326
|
|
00486 END-IF DTSBD326
|
|
00487 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD326
|
|
00488 TO WRK-TOT-TAX-WAIVED-AMT DTSBD326
|
|
00489 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD326
|
|
00490 TO L101-PAID-CHNG DTSBD326
|
|
00491 ELSE DTSBD326
|
|
00492 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBD326
|
|
00493 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD326
|
|
00494 TO WRK-TOT-PEN-WAIVED-AMT DTSBD326
|
|
00495 ELSE DTSBD326
|
|
00496 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBD326
|
|
00497 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD326
|
|
00498 TO WRK-TOT-INT-WAIVED-AMT DTSBD326
|
|
00499 END-IF DTSBD326
|
|
00500 END-IF DTSBD326
|
|
00501 END-IF. DTSBD326
|
|
00502 DTSBD326
|
|
00503 P3110-EXIT. DTSBD326
|
|
00504 EXIT. DTSBD326
|
|
00505 EJECT DTSBD326
|
|
00506 P4000-WRITE-MCMP-AND-REPORT. DTSBD326
|
|
00507 MOVE WRK-TOT-BALANCE-AMT TO MCMP-TOT-BALANCE-AMT DTSBD326
|
|
00508 R436-SETTLEMENT-DUE-AMT. DTSBD326
|
|
00509 MOVE WRK-TOT-TAX-WAIVED-AMT TO MCMP-TAX-WAIVED-AMT DTSBD326
|
|
00510 R436-TAX-WAIVED-AMT. DTSBD326
|
|
00511 MOVE WRK-TOT-PEN-WAIVED-AMT TO MCMP-PEN-WAIVED-AMT DTSBD326
|
|
00512 R436-PEN-WAIVED-AMT. DTSBD326
|
|
00513 MOVE WRK-TOT-INT-WAIVED-AMT TO MCMP-INT-WAIVED-AMT DTSBD326
|
|
00514 R436-INT-WAIVED-AMT. DTSBD326
|
|
00515 DTSBD326
|
|
00516 PERFORM S946-WRITE-R436 THRU S946-EXIT. DTSBD326
|
|
00517 DTSBD326
|
|
00518 PERFORM P4100-WRITE-MEVL THRU P4100-EXIT. DTSBD326
|
|
00519 DTSBD326
|
|
00520 SET MCMP-STATUS-FINAL-88 TO TRUE. DTSBD326
|
|
00521 DTSBD326
|
|
00522 MOVE LBCM-CURR-RUN-DATE TO MCMP-CHNG-DATE. DTSBD326
|
|
00523 DTSBD326
|
|
00524 MOVE MCMP-REC TO MSKL-REC. DTSBD326
|
|
00525 DTSBD326
|
|
00526 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD326
|
|
00527 P4000-EXIT. DTSBD326
|
|
00528 EXIT. DTSBD326
|
|
00529 EJECT DTSBD326
|
|
00530 P4100-WRITE-MEVL. DTSBD326
|
|
00531 MOVE LOW-VALUE TO MEVL-REC. DTSBD326
|
|
00532 DTSBD326
|
|
00533 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBD326
|
|
00534 DTSBD326
|
|
00535 SET MEVL-EVL-88 TO TRUE. DTSBD326
|
|
00536 DTSBD326
|
|
00537 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD326
|
|
00538 DTSBD326
|
|
00539 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. DTSBD326
|
|
00540 DTSBD326
|
|
00541 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD326
|
|
00542 DTSBD326
|
|
00543 MOVE L005-DATE TO MEVL-DATE. DTSBD326
|
|
00544 DTSBD326
|
|
00545 MOVE L005-TIME TO MEVL-TIME. DTSBD326
|
|
00546 DTSBD326
|
|
00547 MOVE +0 TO MEVL-PURGE-DATE. DTSBD326
|
|
00548 DTSBD326
|
|
00549 MOVE WRK-EVENT-TXT TO MEVL-TEXT. DTSBD326
|
|
00550 DTSBD326
|
|
00551 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBD326
|
|
00552 DTSBD326
|
|
00553 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBD326
|
|
00554 DTSBD326
|
|
00555 MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBD326
|
|
00556 MEVL-CHNG-DATE. DTSBD326
|
|
00557 DTSBD326
|
|
00558 MOVE MEVL-REC TO MSKL-REC. DTSBD326
|
|
00559 DTSBD326
|
|
00560 PERFORM S910-WRITE THRU S910-EXIT. DTSBD326
|
|
00561 P4100-EXIT. DTSBD326
|
|
00562 EXIT. DTSBD326
|
|
00563 DTSBD326
|
|
00564 P5000-UPDATE-MQTR. DTSBD326
|
|
00565 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD326
|
|
00566 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD326
|
|
00567 SET MQTR-QTR-88 TO TRUE. DTSBD326
|
|
00568 DTSBD326
|
|
00569 PERFORM P5100-PROCESS-MQTR THRU P5100-EXIT DTSBD326
|
|
00570 VARYING WRK-CNT FROM 1 BY 1 DTSBD326
|
|
00571 UNTIL WRK-CNT > MCMP-COV-CNT. DTSBD326
|
|
00572 DTSBD326
|
|
00573 P5000-EXIT. DTSBD326
|
|
00574 EXIT. DTSBD326
|
|
00575 DTSBD326
|
|
00576 P5100-PROCESS-MQTR. DTSBD326
|
|
00577 MOVE MCMP-COVERED-YRQ (WRK-CNT) TO MQTR-YRQ. DTSBD326
|
|
00578 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD326
|
|
00579 DTSBD326
|
|
00580 PERFORM S910-READ THRU S910-EXIT. DTSBD326
|
|
00581 DTSBD326
|
|
00582 IF L910-OK-88 DTSBD326
|
|
00583 MOVE MSKL-REC TO MQTR-REC DTSBD326
|
|
00584 MOVE MCMP-ESTB-ABSTIME TO MQTR-CMP-ESTB-ABSTIME DTSBD326
|
|
00585 MOVE MQTR-REC TO MSKL-REC DTSBD326
|
|
00586 PERFORM S910-REWRITE THRU S910-EXIT DTSBD326
|
|
00587 ELSE DTSBD326
|
|
00588 DISPLAY 'DTSBD326 CANNOT FIND MQTR ' MQTR-YRQ DTSBD326
|
|
00589 PERFORM S999-ABEND THRU S999-EXIT DTSBD326
|
|
00590 END-IF. DTSBD326
|
|
00591 DTSBD326
|
|
00592 P5100-EXIT. DTSBD326
|
|
00593 EXIT. DTSBD326
|
|
00594 DTSBD326
|
|
00595 P6000-WRITE-TICKLER. DTSBD326
|
|
00596 MOVE LOW-VALUE TO MTCK-REC. DTSBD326
|
|
00597 MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSBD326
|
|
00598 SET MTCK-TCK-88 TO TRUE. DTSBD326
|
|
00599 MOVE LBCM-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBD326
|
|
00600 MOVE +0 TO MTCK-PURGE-DATE. DTSBD326
|
|
00601 INITIALIZE MTCK-DATA-AREA. DTSBD326
|
|
00602 SET MTCK-TYPE-CMP-PEND-88 TO TRUE. DTSBD326
|
|
00603 DTSBD326
|
|
00604 MOVE LBCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBD326
|
|
00605 SET L001-FROM-FED-8 TO TRUE. DTSBD326
|
|
00606 PERFORM S001-CONVERT-DATE THRU S001-EXIT. DTSBD326
|
|
00607 ADD +1 TO L001-JUL-ABS-DAY. DTSBD326
|
|
00608 SET L001-FROM-ABS-DAY TO TRUE. DTSBD326
|
|
00609 PERFORM S001-CONVERT-DATE THRU S001-EXIT. DTSBD326
|
|
00610 MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE. DTSBD326
|
|
00611 DTSBD326
|
|
00612 SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSBD326
|
|
00613 SET MTCK-DEST-SYSTEM-88 TO TRUE. DTSBD326
|
|
00614 MOVE MCMP-ESTB-ABSTIME TO MTCK-CMP-ESTB-ABSTIME. DTSBD326
|
|
00615 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSBD326
|
|
00616 MOVE LBCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSBD326
|
|
00617 MTCK-CHNG-DATE. DTSBD326
|
|
00618 MOVE +0 TO MTCK-TEXT-CNT. DTSBD326
|
|
00619 MOVE MTCK-REC TO MSKL-REC. DTSBD326
|
|
00620 PERFORM S910-WRITE THRU S910-EXIT. DTSBD326
|
|
00621 DTSBD326
|
|
00622 P6000-EXIT. DTSBD326
|
|
00623 EXIT. DTSBD326
|
|
00624 DTSBD326
|
|
00625 P7000-WITHDRAW. DTSBD326
|
|
00626 DISPLAY 'P7000 ' MPRF-EMP-NO. DTSBD326
|
|
00627 PERFORM P7100-FIND-QTRS THRU P7100-EXIT. DTSBD326
|
|
00628 PERFORM P7200-EDIT-ADJ THRU P7200-EXIT. DTSBD326
|
|
00629 IF LBCM-TRN-OK-88 DTSBD326
|
|
00630 PERFORM P7300-WITHDRAW THRU P7300-EXIT DTSBD326
|
|
00631 IF LBCM-TRN-OK-88 DTSBD326
|
|
00632 PERFORM P7400-UPDATE-MQTR THRU P7400-EXIT DTSBD326
|
|
00633 END-IF DTSBD326
|
|
00634 END-IF. DTSBD326
|
|
00635 DTSBD326
|
|
00636 P7000-EXIT. DTSBD326
|
|
00637 EXIT. DTSBD326
|
|
00638 DTSBD326
|
|
00639 P7100-FIND-QTRS. DTSBD326
|
|
00640 PERFORM P7110-INIT-QTR-TBL THRU P7110-EXIT. DTSBD326
|
|
00641 DTSBD326
|
|
00642 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD326
|
|
00643 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD326
|
|
00644 SET MQTR-QTR-88 TO TRUE. DTSBD326
|
|
00645 DTSBD326
|
|
00646 PERFORM DTSBD326
|
|
00647 VARYING WRK-CNT FROM 1 BY 1 DTSBD326
|
|
00648 UNTIL WRK-CNT > MCMP-COV-CNT DTSBD326
|
|
00649 MOVE MCMP-COVERED-YRQ (WRK-CNT) TO MQTR-YRQ DTSBD326
|
|
00650 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBD326
|
|
00651 PERFORM S910-READ THRU S910-EXIT DTSBD326
|
|
00652 IF L910-OK-88 DTSBD326
|
|
00653 MOVE MSKL-REC TO MQTR-REC DTSBD326
|
|
00654 MOVE MQTR-YRQ TO WRK-QTR-YRQ (WRK-CNT) DTSBD326
|
|
00655 PERFORM P7120-PROCESS-ACCT-AREA THRU P7120-EXIT DTSBD326
|
|
00656 END-IF DTSBD326
|
|
00657 END-PERFORM. DTSBD326
|
|
00658 DTSBD326
|
|
00659 P7100-EXIT. DTSBD326
|
|
00660 EXIT. DTSBD326
|
|
00661 DTSBD326
|
|
00662 P7110-INIT-QTR-TBL. DTSBD326
|
|
00663 PERFORM DTSBD326
|
|
00664 VARYING QTR-SUB FROM +1 BY +1 DTSBD326
|
|
00665 UNTIL QTR-SUB > WRK-QTR-MAX DTSBD326
|
|
00666 MOVE +0 TO WRK-QTR-YRQ (QTR-SUB) DTSBD326
|
|
00667 WRK-QTR-WAIVED-AMT (QTR-SUB) DTSBD326
|
|
00668 WRK-QTR-REVERSE-AMT (QTR-SUB) DTSBD326
|
|
00669 END-PERFORM. DTSBD326
|
|
00670 DTSBD326
|
|
00671 P7110-EXIT. DTSBD326
|
|
00672 EXIT. DTSBD326
|
|
00673 DTSBD326
|
|
00674 P7120-PROCESS-ACCT-AREA. DTSBD326
|
|
00675 PERFORM DTSBD326
|
|
00676 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD326
|
|
00677 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD326
|
|
00678 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD326
|
|
00679 TO WRK-QTR-WAIVED-AMT (WRK-CNT) DTSBD326
|
|
00680 END-PERFORM. DTSBD326
|
|
00681 DTSBD326
|
|
00682 P7120-EXIT. DTSBD326
|
|
00683 EXIT. DTSBD326
|
|
00684 DTSBD326
|
|
00685 P7200-EDIT-ADJ. DTSBD326
|
|
00686 PERFORM P7210-INIT-REV-TBL THRU P7210-EXIT. DTSBD326
|
|
00687 DTSBD326
|
|
00688 MOVE LOW-VALUE TO MADJ-KEY-AREA. DTSBD326
|
|
00689 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBD326
|
|
00690 SET MADJ-ADJ-88 TO TRUE. DTSBD326
|
|
00691 DTSBD326
|
|
00692 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBD326
|
|
00693 DTSBD326
|
|
00694 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD326
|
|
00695 DTSBD326
|
|
00696 PERFORM DTSBD326
|
|
00697 UNTIL L910-NO-REC-88 DTSBD326
|
|
00698 MOVE MSKL-REC TO MADJ-REC DTSBD326
|
|
00699 DISPLAY 'P7200 ' MPRF-EMP-NO ' ' MADJ-APPLIC-YRQ DTSBD326
|
|
00700 IF MADJ-CMP-ESTB-ABSTIME = MCMP-ESTB-ABSTIME DTSBD326
|
|
00701 PERFORM P7220-ADD-TO-TBL THRU P7220-EXIT DTSBD326
|
|
00702 END-IF DTSBD326
|
|
00703 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD326
|
|
00704 END-PERFORM. DTSBD326
|
|
00705 DTSBD326
|
|
00706 PERFORM P7230-CHECK-QTRS THRU P7230-EXIT. DTSBD326
|
|
00707 DTSBD326
|
|
00708 P7200-EXIT. DTSBD326
|
|
00709 EXIT. DTSBD326
|
|
00710 DTSBD326
|
|
00711 P7210-INIT-REV-TBL. DTSBD326
|
|
00712 MOVE +0 TO REV-CNT. DTSBD326
|
|
00713 DTSBD326
|
|
00714 PERFORM DTSBD326
|
|
00715 VARYING REV-SUB FROM +1 BY +1 DTSBD326
|
|
00716 UNTIL REV-SUB > WRK-REV-MAX DTSBD326
|
|
00717 MOVE +0 TO WRK-REV-AMT (REV-SUB) DTSBD326
|
|
00718 WRK-REV-APPLIC-YRQ (REV-SUB) DTSBD326
|
|
00719 MOVE SPACES TO WRK-REV-APPLIC-IND (REV-SUB) DTSBD326
|
|
00720 END-PERFORM. DTSBD326
|
|
00721 DTSBD326
|
|
00722 P7210-EXIT. DTSBD326
|
|
00723 EXIT. DTSBD326
|
|
00724 DTSBD326
|
|
00725 P7220-ADD-TO-TBL. DTSBD326
|
|
00726 IF REV-CNT < WRK-REV-MAX DTSBD326
|
|
00727 ADD +1 TO REV-CNT DTSBD326
|
|
00728 ELSE DTSBD326
|
|
00729 DISPLAY 'P7220 TABLE LENGTH EXCEEDED ' MPRF-EMP-NO DTSBD326
|
|
00730 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326
|
|
00731 GO TO P7220-EXIT DTSBD326
|
|
00732 END-IF. DTSBD326
|
|
00733 DTSBD326
|
|
00734 MOVE MADJ-AMT TO WRK-REV-AMT (REV-CNT). DTSBD326
|
|
00735 MOVE MADJ-APPLIC-YRQ TO WRK-REV-APPLIC-YRQ (REV-CNT). DTSBD326
|
|
00736 MOVE MADJ-APPLIC-IND TO WRK-REV-APPLIC-IND (REV-CNT). DTSBD326
|
|
00737 DTSBD326
|
|
00738 PERFORM P7221-UPD-QTR-TBL THRU P7221-EXIT. DTSBD326
|
|
00739 DTSBD326
|
|
00740 P7220-EXIT. DTSBD326
|
|
00741 EXIT. DTSBD326
|
|
00742 DTSBD326
|
|
00743 P7221-UPD-QTR-TBL. DTSBD326
|
|
00744 SET WRK-QTR-FOUND-NO-88 TO TRUE. DTSBD326
|
|
00745 DTSBD326
|
|
00746 PERFORM DTSBD326
|
|
00747 VARYING QTR-SUB FROM +1 BY +1 DTSBD326
|
|
00748 UNTIL QTR-SUB > WRK-QTR-MAX DTSBD326
|
|
00749 OR WRK-QTR-FOUND-YES-88 DTSBD326
|
|
00750 IF WRK-QTR-YRQ (QTR-SUB) = DTSBD326
|
|
00751 WRK-REV-APPLIC-YRQ (REV-CNT) DTSBD326
|
|
00752 SET WRK-QTR-FOUND-YES-88 TO TRUE DTSBD326
|
|
00753 ADD MADJ-AMT TO DTSBD326
|
|
00754 WRK-QTR-REVERSE-AMT (QTR-SUB) DTSBD326
|
|
00755 END-IF DTSBD326
|
|
00756 END-PERFORM. DTSBD326
|
|
00757 DTSBD326
|
|
00758 P7221-EXIT. DTSBD326
|
|
00759 EXIT. DTSBD326
|
|
00760 DTSBD326
|
|
00761 P7230-CHECK-QTRS. DTSBD326
|
|
00762 PERFORM DTSBD326
|
|
00763 VARYING QTR-SUB FROM +1 BY +1 DTSBD326
|
|
00764 UNTIL QTR-SUB > WRK-QTR-MAX DTSBD326
|
|
00765 IF WRK-QTR-WAIVED-AMT (QTR-SUB) NOT = DTSBD326
|
|
00766 WRK-QTR-REVERSE-AMT (QTR-SUB) DTSBD326
|
|
00767 DISPLAY 'P7230: WAIVE ' DTSBD326
|
|
00768 WRK-QTR-WAIVED-AMT (QTR-SUB) DTSBD326
|
|
00769 ' REV ' WRK-QTR-REVERSE-AMT (QTR-SUB) DTSBD326
|
|
00770 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326
|
|
00771 MOVE MSG7-ADJ-EDIT-FAILED TO LBCM-TRN-MSG-AREA DTSBD326
|
|
00772 END-IF DTSBD326
|
|
00773 END-PERFORM. DTSBD326
|
|
00774 DTSBD326
|
|
00775 P7230-EXIT. DTSBD326
|
|
00776 EXIT. DTSBD326
|
|
00777 DTSBD326
|
|
00778 P7300-WITHDRAW. DTSBD326
|
|
00779 PERFORM P7310-SCAN-TBL THRU P7310-EXIT DTSBD326
|
|
00780 VARYING REV-SUB FROM +1 BY +1 DTSBD326
|
|
00781 UNTIL REV-SUB > REV-CNT. DTSBD326
|
|
00782 DTSBD326
|
|
00783 P7300-EXIT. DTSBD326
|
|
00784 EXIT. DTSBD326
|
|
00785 DTSBD326
|
|
00786 P7310-SCAN-TBL. DTSBD326
|
|
00787 MOVE LOW-VALUES TO AADJ-REC. DTSBD326
|
|
00788 SET AADJ-ADJ-88 TO TRUE. DTSBD326
|
|
00789 MOVE MPRF-PRIMARY-NAME (1:4) TO AADJ-NAME-CHECK. DTSBD326
|
|
00790 MOVE MPRF-EMP-NO TO AADJ-EMP-NO. DTSBD326
|
|
00791 SET AADJ-WAIVE-88 TO TRUE. DTSBD326
|
|
00792 MOVE LBCM-RECEIVED-DATE TO AADJ-RECEIVED-DATE. DTSBD326
|
|
00793 MOVE LBCM-DEPOSIT-DATE TO AADJ-DEPOSIT-DATE. DTSBD326
|
|
00794 MOVE WRK-REV-AMT (REV-SUB) TO WRK-AMT. DTSBD326
|
|
00795 COMPUTE AADJ-AMT = WRK-AMT * -1. DTSBD326
|
|
00796 MOVE WRK-REV-APPLIC-YRQ (REV-SUB) TO AADJ-APPLIC-YRQ. DTSBD326
|
|
00797 MOVE WRK-REV-APPLIC-IND (REV-SUB) TO AADJ-APPLIC-IND. DTSBD326
|
|
00798 MOVE ZEROS TO AADJ-APPLIC-BATCH-NO DTSBD326
|
|
00799 AADJ-APPLIC-ITEM-NO DTSBD326
|
|
00800 AADJ-DATE-1 DTSBD326
|
|
00801 AADJ-DATE-2 DTSBD326
|
|
00802 AADJ-INT-RATE DTSBD326
|
|
00803 AADJ-CMP-ESTB-ABSTIME. DTSBD326
|
|
00804 DTSBD326
|
|
00805 MOVE 'N' TO AADJ-DISREGARD-EDITS-IND. DTSBD326
|
|
00806 MOVE 'SYS' TO AADJ-RESPONSIBLE-ACTIVITY. DTSBD326
|
|
00807 MOVE 'SYSTEM' TO AADJ-RESPONSIBLE-OP-ID. DTSBD326
|
|
00808 SET AADJ-NOT-PROCESSED-88 TO TRUE. DTSBD326
|
|
00809 DTSBD326
|
|
00810 MOVE AADJ-AMT TO WRK-AMT-DISP1. DTSBD326
|
|
00811 DISPLAY 'P7310 ' MPRF-EMP-NO ' ' AADJ-APPLIC-YRQ DTSBD326
|
|
00812 ' AMT ' WRK-AMT-DISP1. DTSBD326
|
|
00813 DTSBD326
|
|
00814 SET L501-EXT-TO-ACCT-88 TO TRUE. DTSBD326
|
|
00815 PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT. DTSBD326
|
|
00816 IF L501-TRN-NOT-OK-88 DTSBD326
|
|
00817 DISPLAY 'L501 TRAN FAILED' DTSBD326
|
|
00818 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326
|
|
00819 MOVE MSG6-ADJ-FAILED TO LBCM-TRN-MSG-AREA DTSBD326
|
|
00820 END-IF. DTSBD326
|
|
00821 DTSBD326
|
|
00822 P7310-EXIT. DTSBD326
|
|
00823 EXIT. DTSBD326
|
|
00824 DTSBD326
|
|
00825 P7400-UPDATE-MQTR. DTSBD326
|
|
00826 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD326
|
|
00827 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD326
|
|
00828 SET MQTR-QTR-88 TO TRUE. DTSBD326
|
|
00829 DTSBD326
|
|
00830 PERFORM DTSBD326
|
|
00831 VARYING WRK-CNT FROM 1 BY 1 DTSBD326
|
|
00832 UNTIL WRK-CNT > MCMP-COV-CNT DTSBD326
|
|
00833 MOVE MCMP-COVERED-YRQ (WRK-CNT) TO MQTR-YRQ DTSBD326
|
|
00834 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBD326
|
|
00835 PERFORM S910-READ THRU S910-EXIT DTSBD326
|
|
00836 IF L910-OK-88 DTSBD326
|
|
00837 MOVE MSKL-REC TO MQTR-REC DTSBD326
|
|
00838 DISPLAY 'P7400 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBD326
|
|
00839 MOVE ZERO TO MQTR-CMP-ESTB-ABSTIMEDTSBD326
|
|
00840 MOVE MQTR-REC TO MSKL-REC DTSBD326
|
|
00841 PERFORM S910-REWRITE THRU S910-EXIT DTSBD326
|
|
00842 ELSE DTSBD326
|
|
00843 PERFORM P7410-ERROR THRU P7410-EXIT DTSBD326
|
|
00844 END-IF DTSBD326
|
|
00845 END-PERFORM. DTSBD326
|
|
00846 DTSBD326
|
|
00847 P7400-EXIT. DTSBD326
|
|
00848 EXIT. DTSBD326
|
|
00849 DTSBD326
|
|
00850 P7410-ERROR. DTSBD326
|
|
00851 SET LBCM-TRN-NOT-OK-88 TO TRUE. DTSBD326
|
|
00852 MOVE MSG3-ID-2 TO R907-MSG-ID. DTSBD326
|
|
00853 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBD326
|
|
00854 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD326
|
|
00855 MOVE L004-SLASH-5-QTR TO MSG3-YRQ. DTSBD326
|
|
00856 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBD326
|
|
00857 MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT. DTSBD326
|
|
00858 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBD326
|
|
00859 DTSBD326
|
|
00860 P7410-EXIT. DTSBD326
|
|
00861 EXIT. DTSBD326
|
|
00862 DTSBD326
|
|
00863 S1000-READ-SUBJECT-MCMP. DTSBD326
|
|
00864 MOVE LOW-VALUE TO MCMP-KEY-AREA. DTSBD326
|
|
00865 DTSBD326
|
|
00866 MOVE MPRF-EMP-NO TO MCMP-EMP-NO. DTSBD326
|
|
00867 DTSBD326
|
|
00868 SET MCMP-CMP-88 TO TRUE. DTSBD326
|
|
00869 DTSBD326
|
|
00870 MOVE T011-ESTB-ABSTIME TO MCMP-ESTB-ABSTIME. DTSBD326
|
|
00871 DTSBD326
|
|
00872 MOVE MCMP-KEY-AREA TO MSKL-KEY-AREA. DTSBD326
|
|
00873 DTSBD326
|
|
00874 PERFORM S910-READ THRU S910-EXIT. DTSBD326
|
|
00875 DTSBD326
|
|
00876 IF L910-OK-88 DTSBD326
|
|
00877 MOVE MSKL-REC TO MCMP-REC. DTSBD326
|
|
00878 S1000-EXIT. DTSBD326
|
|
00879 EXIT. DTSBD326
|
|
00880 EJECT DTSBD326
|
|
00881 S2000-DELETE-MTCK. DTSBD326
|
|
00882 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD326
|
|
00883 DTSBD326
|
|
00884 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD326
|
|
00885 DTSBD326
|
|
00886 SET MSKL-TCK-88 TO TRUE. DTSBD326
|
|
00887 DTSBD326
|
|
00888 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD326
|
|
00889 DTSBD326
|
|
00890 PERFORM DTSBD326
|
|
00891 UNTIL L910-NO-REC-88 DTSBD326
|
|
00892 MOVE MSKL-REC TO MTCK-REC DTSBD326
|
|
00893 IF MTCK-TYPE-CMP-PEND-88 DTSBD326
|
|
00894 AND DTSBD326
|
|
00895 MTCK-CMP-ESTB-ABSTIME = T011-ESTB-ABSTIME DTSBD326
|
|
00896 PERFORM S910-DELETE THRU S910-EXIT DTSBD326
|
|
00897 END-IF DTSBD326
|
|
00898 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD326
|
|
00899 END-PERFORM. DTSBD326
|
|
00900 DTSBD326
|
|
00901 S2000-EXIT. DTSBD326
|
|
00902 EXIT. DTSBD326
|
|
00903 EJECT DTSBD326
|
|
00904 S001-CONVERT-DATE. DTSBD326
|
|
00905 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD326
|
|
00906 S001-EXIT. EXIT. DTSBD326
|
|
00907 DTSBD326
|
|
00908 S004-FROM-5. DTSBD326
|
|
00909 SET L004-FROM-5 TO TRUE. DTSBD326
|
|
00910 GO TO S004-YRQ. DTSBD326
|
|
00911 DTSBD326
|
|
00912 S004-YRQ. DTSBD326
|
|
00913 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD326
|
|
00914 S004-EXIT. DTSBD326
|
|
00915 EXIT. DTSBD326
|
|
00916 SKIP3 DTSBD326
|
|
00917 S005-FROM-ABSTIME. DTSBD326
|
|
00918 SET L005-FROM-ABSTIME TO TRUE. DTSBD326
|
|
00919 GO TO S005-TIME. DTSBD326
|
|
00920 DTSBD326
|
|
00921 S005-TIME. DTSBD326
|
|
00922 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD326
|
|
00923 S005-EXIT. DTSBD326
|
|
00924 EXIT. DTSBD326
|
|
00925 SKIP3 DTSBD326
|
|
00926 S101-PER-MONTH-NO. DTSBD326
|
|
00927 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBD326
|
|
00928 GO TO S101-INTEREST. DTSBD326
|
|
00929 DTSBD326
|
|
00930 S101-INTEREST. DTSBD326
|
|
00931 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBD326
|
|
00932 S101-EXIT. DTSBD326
|
|
00933 EXIT. DTSBD326
|
|
00934 SKIP3 DTSBD326
|
|
00935 S501-INTERNAL-ACCT-PROCESS. DTSBD326
|
|
00936 CALL 'DTSBU501' USING L501-LINK-AREA DTSBD326
|
|
00937 LBCM-LINK-AREA DTSBD326
|
|
00938 MPRF-REC DTSBD326
|
|
00939 ASKL-REC. DTSBD326
|
|
00940 S501-EXIT. DTSBD326
|
|
00941 EXIT. DTSBD326
|
|
00942 DTSBD326
|
|
00943 S910-READ. DTSBD326
|
|
00944 SET L910-READ-88 TO TRUE. DTSBD326
|
|
00945 GO TO S910-MSTR-IO. DTSBD326
|
|
00946 DTSBD326
|
|
00947 S910-START-BROWSE. DTSBD326
|
|
00948 SET L910-START-BROWSE-88 TO TRUE. DTSBD326
|
|
00949 GO TO S910-MSTR-IO. DTSBD326
|
|
00950 DTSBD326
|
|
00951 S910-READ-NEXT. DTSBD326
|
|
00952 SET L910-READ-NEXT-88 TO TRUE. DTSBD326
|
|
00953 GO TO S910-MSTR-IO. DTSBD326
|
|
00954 DTSBD326
|
|
00955 S910-DELETE. DTSBD326
|
|
00956 SET L910-DELETE-88 TO TRUE. DTSBD326
|
|
00957 GO TO S910-MSTR-IO. DTSBD326
|
|
00958 DTSBD326
|
|
00959 S910-WRITE. DTSBD326
|
|
00960 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD326
|
|
00961 SET L910-WRITE-88 TO TRUE. DTSBD326
|
|
00962 GO TO S910-MSTR-IO. DTSBD326
|
|
00963 DTSBD326
|
|
00964 S910-REWRITE. DTSBD326
|
|
00965 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD326
|
|
00966 SET L910-REWRITE-88 TO TRUE. DTSBD326
|
|
00967 GO TO S910-MSTR-IO. DTSBD326
|
|
00968 DTSBD326
|
|
00969 *S910-DELETE. DTSBD326
|
|
00970 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD326
|
|
00971 *****SET L910-DELETE-88 TO TRUE. DTSBD326
|
|
00972 *****GO TO S910-MSTR-IO. DTSBD326
|
|
00973 DTSBD326
|
|
00974 S910-MSTR-IO. DTSBD326
|
|
00975 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD326
|
|
00976 MSKL-REC. DTSBD326
|
|
00977 S910-EXIT. DTSBD326
|
|
00978 EXIT. DTSBD326
|
|
00979 SKIP3 DTSBD326
|
|
00980 S946-WRITE-R436. DTSBD326
|
|
00981 CALL 'DTSBU946' USING R436-REC. DTSBD326
|
|
00982 GO TO S946-EXIT. DTSBD326
|
|
00983 DTSBD326
|
|
00984 S946-WRITE-R907. DTSBD326
|
|
00985 CALL 'DTSBU946' USING R907-REC. DTSBD326
|
|
00986 GO TO S946-EXIT. DTSBD326
|
|
00987 DTSBD326
|
|
00988 S946-EXIT. DTSBD326
|
|
00989 EXIT. DTSBD326
|
|
00990 SKIP3 DTSBD326
|
|
00991 S999-ABEND. DTSBD326
|
|
00992 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD326
|
|
00993 S999-EXIT. DTSBD326
|
|
00994 EXIT. DTSBD326
|