1328 lines
105 KiB
COBOL
1328 lines
105 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/20/13
|
|
00002 PROGRAM-ID. DTSBU520. DTSBU520
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV018
|
|
00004 DATE-WRITTEN. JANUARY 1991. DTSBU520
|
|
00005 DATE-COMPILED. DTSBU520
|
|
00006 SKIP3 DTSBU520
|
|
00007 ***** DTSBU520
|
|
00008 * DTSBU520
|
|
00009 * FUNCTION: PAYMENT APPLICATION. DTSBU520
|
|
00010 * DTSBU520
|
|
00011 * DTSBU520
|
|
00012 * MODIFICATION LOG: DTSBU520
|
|
00013 * DTSBU520
|
|
00014 * 01/26/92 INITIAL DEVELOPMENT. DTSBU520
|
|
00015 * WORK ORDER: PROGRAMMER: TCL DTSBU520
|
|
00016 * DTSBU520
|
|
00017 * 06/13/95 CHANGE TO CREDIT TOLERANCE LOGIC REMOVES IT FROM DTSBU520
|
|
00018 * THIS PROGRAM. DTSBU520
|
|
00019 * WORK ORDER: CR094 PROGRAMMER: RHC DTSBU520
|
|
00020 * DTSBU520
|
|
00021 * 12/10/1998 REVIEWED AND MODIFIED FOR DC. DTSBU520
|
|
00022 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU520
|
|
00023 * DTSBU520
|
|
00024 * 10/21/2002 ADDED SPECIAL RULE FOR APPLICATION OF PAYMENTS DTSBU520
|
|
00025 * TO QUARTERS REPORTED ANNUALLY. DTSBU520
|
|
00026 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBU520
|
|
00027 * DTSBU520
|
|
00028 * 12/16/2003 MODIFIED P0000 TO EXECUTE P1000 ONLY ONE TIME DTSBU520
|
|
00029 * IF THERE IS A CREDIT. DTSBU520
|
|
00030 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBU520
|
|
00031 * DTSBU520
|
|
00032 * 10/22/2012 REMOVED SPECIAL PROCESSING FOR ANNUAL FILERS. DTSBU520
|
|
00033 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBU520
|
|
00034 * DTSBU520
|
|
00035 * DTSBU520
|
|
00036 * DESCRIPTION: DTSBU520
|
|
00037 * DTSBU520
|
|
00038 * PAYMENT APPLICATION. DTSBU520
|
|
00039 * DTSBU520
|
|
00040 * APPLY UNAPPLIED CREDIT PAYMENT DISTRIBUTIONS TO BALANCES DTSBU520
|
|
00041 * DUE UNTIL EITHER UNAPPLIED CREDITS ARE EXHAUSTED OR DTSBU520
|
|
00042 * BALANCES DUE ARE EXHAUSTED. AT EXIT FROM DTSBU520: IF DTSBU520
|
|
00043 * AN UNAPPLIED CREDIT EXISTS, THEN NO BALANCES DUE WILL DTSBU520
|
|
00044 * EXIST; IF A BALANCE DUE EXISTS, THEN NO UNAPPLIED CREDITS DTSBU520
|
|
00045 * WILL EXIST. DTSBU520
|
|
00046 * DTSBU520
|
|
00047 * PLEASE SEE THE ISSUE STATEMENTS AND REQUIREMENTS DEFINITIONDTSBU520
|
|
00048 * FOR PAYMENT APPLICATION DETAILS. DTSBU520
|
|
00049 * DTSBU520
|
|
00050 * THE DEFAULT MONEY APPLICATION LOGIC DEFINED IN THE ISSUE DTSBU520
|
|
00051 * STATEMENTS (OLDEST UNAPPLIED CREDITS FIRST, OLDEST BALANCE DTSBU520
|
|
00052 * DUE FIRST, WITHIN A QUARTER CONTRIBUTIONS, INTEREST, DTSBU520
|
|
00053 * PENALTY, ETC) IS TEMPERED BY THE MONEY APPLICATION REQUEST DTSBU520
|
|
00054 * INFORMATION PASSED TO DTSBU520 IN L520-LINK-AREA. DTSBU520
|
|
00055 * DTSBU520
|
|
00056 * IF L520-PREF-PAY-DOC-NO IS NOT EQUAL TO NULL, THEN DTSBU520
|
|
00057 * L520-PREF-PAY-DOC-NO INDICATES THE FIRST PAYMENT FROM DTSBU520
|
|
00058 * WHICH UNAPPLIED CREDITS ARE TO BE TAKEN. DTSBU520
|
|
00059 * DTSBU520
|
|
00060 * IF L520-PREF-APPLIC-YRQ, THEN L520-PREF-APPLIC-YRQ DTSBU520
|
|
00061 * INDICATES THE FIRST YRQ TO WHICH UNAPPLIED CREDITS DTSBU520
|
|
00062 * ARE TO BE APPLIED. DTSBU520
|
|
00063 * DTSBU520
|
|
00064 * IF L520-PREF-APPLIC-IND IS NOT EQUAL TO ZERO, THEN DTSBU520
|
|
00065 * L520-PREF-APPLIC-YRQ AND L520-PREF-APPLIC-IND INDICATES DTSBU520
|
|
00066 * THE AMOUNT DUE TO WHICH UNAPPLIED CREDITS ARE TO BE DTSBU520
|
|
00067 * APPLIED FIRST. DTSBU520
|
|
00068 * DTSBU520
|
|
00069 * THE RULES ARE SLIGHTLY DIFFERENT FOR PAYMENTS ASSOICATED DTSBU520
|
|
00070 * WITH ORIGINAL ANNUAL REPORTS. THE FOUR QUARTERS ARE DTSBU520
|
|
00071 * ESSENTIALLY TREATED AS ONE: APPLY THE PAYMENT FIRST TO DTSBU520
|
|
00072 * UI TAX FOR THE FIRST QUARTER, UI TAX FOR THE SECOND QTR, DTSBU520
|
|
00073 * UI TAX FOR THE THIRD QTR AND UI TAX FOR THE FOURTH QTR. DTSBU520
|
|
00074 * THEN APPLY THE PAYMENT TO SUR TAX ACROSS ALL FOUR QUARTERS.DTSBU520
|
|
00075 * DTSBU520
|
|
00076 * DTSBU520
|
|
00077 * MASTER FILE RECORDS READ: DTSBU520
|
|
00078 * DTSBU520
|
|
00079 * MQTR DTSBU520
|
|
00080 * MPAY DTSBU520
|
|
00081 * MDST DTSBU520
|
|
00082 * DTSBU520
|
|
00083 * DTSBU520
|
|
00084 * MASTER FILE RECORDS UPDATED: DTSBU520
|
|
00085 * DTSBU520
|
|
00086 * MDST (REWRITE, WRITE) DTSBU520
|
|
00087 * DTSBU520
|
|
00088 * DTSBU520
|
|
00089 * REPORT RECORDS WRITTEN: DTSBU520
|
|
00090 * DTSBU520
|
|
00091 * R907 ERROR. DTSBU520
|
|
00092 * DTSBU520
|
|
00093 * DTSBU520
|
|
00094 * MODULES CALLED: DTSBU520
|
|
00095 * DTSBU520
|
|
00096 * DTSBU521 APPLY/REVERSE A PAYMENT DISTRIBUTION. DTSBU520
|
|
00097 * DTSBU542 MODIFY MDST AMOUNTS. DTSBU520
|
|
00098 * DTSBU590 EMPLOYER UPDATE CLEANUP PROCESSING. DTSBU520
|
|
00099 * DTSBU910 MASTER FILE I/O. DTSBU520
|
|
00100 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBU520
|
|
00101 * DTSBU520
|
|
00102 * DTSBU520
|
|
00103 ***** DTSBU520
|
|
00104 SKIP3 DTSBU520
|
|
00105 ENVIRONMENT DIVISION. DTSBU520
|
|
00106 EJECT DTSBU520
|
|
00107 DATA DIVISION. DTSBU520
|
|
00108 SKIP3 DTSBU520
|
|
00109 WORKING-STORAGE SECTION. DTSBU520
|
|
001095 77 PAN-VALET PICTURE X(24) VALUE '018DTSBU520 05/20/13'. DTSBU520
|
|
00110 77 PAN-VALET PICTURE X(24) VALUE '017DTSBU520 05/15/13'. DTSBU520
|
|
00111 77 PAN-VALET PICTURE X(24) VALUE '016DTSBU520 12/17/03'. DTSBU520
|
|
00112 SKIP3 DTSBU520
|
|
00113 01 WRK-AREA. DTSBU520
|
|
00114 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +520.DTSBU520
|
|
00115 DTSBU520
|
|
00116 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU520'.DTSBU520
|
|
00117 DTSBU520
|
|
00118 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU520
|
|
00119 DTSBU520
|
|
00120 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBU520
|
|
00121 VALUE +999999999. DTSBU520
|
|
00122 DTSBU520
|
|
00123 05 AMT-DISP PIC ----------9.99. DTSBU520
|
|
00124 05 AMT-DISP1 PIC ----------9.99. DTSBU520
|
|
00125 05 AMT-DISP2 PIC ----------9.99. DTSBU520
|
|
00126 DTSBU520
|
|
00127 05 WRK-NULL-DOC-NO. DTSBU520
|
|
00128 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. DTSBU520
|
|
00129 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. DTSBU520
|
|
00130 DTSBU520
|
|
00131 05 WRK-PREF-PAY-DOC-NO PIC X(05). DTSBU520
|
|
00132 DTSBU520
|
|
00133 05 WRK-PREF-APPLIC-DATA. DTSBU520
|
|
00134 10 WRK-PREF-APPLIC-YRQ PIC S9(05) COMP-3. DTSBU520
|
|
00135 10 WRK-PREF-APPLIC-IND PIC X(02). DTSBU520
|
|
00136 DTSBU520
|
|
00137 *****05 WRK-OPEN-MAPL-DEBIT PIC X(01). DTSBU520
|
|
00138 DTSBU520
|
|
00139 *****05 WRK-MQTR-IN-OPEN-MAPL PIC X(01). DTSBU520
|
|
00140 DTSBU520
|
|
00141 05 HOLD-MPAY-DOC-NO PIC X(05). DTSBU520
|
|
00142 DTSBU520
|
|
00143 05 HOLD-RECEIVED-DATE PIC S9(09) COMP-3. DTSBU520
|
|
00144 DTSBU520
|
|
00145 05 HOLD-MQTR-YRQ PIC S9(05) COMP-3. DTSBU520
|
|
00146 DTSBU520
|
|
00147 05 HOLD-CREDIT-AMT PIC S9(09)V9(02) COMP-3. DTSBU520
|
|
00148 DTSBU520
|
|
00149 05 HOLD-ACCT-SUB PIC S9(04) COMP. DTSBU520
|
|
00150 DTSBU520
|
|
00151 05 HOLD-ACCT-IND PIC X(02). DTSBU520
|
|
00152 DTSBU520
|
|
00153 05 WRK-CR-AVAIL-IND PIC X(01). DTSBU520
|
|
00154 DTSBU520
|
|
00155 ** 05 WRK-ANN-YRQ PIC 9(05). DTSBU520
|
|
00156 * 05 FILLER REDEFINES WRK-ANN-YRQ. DTSBU520
|
|
00157 * 10 WRK-ANN-CCYY PIC 9(04). DTSBU520
|
|
00158 * 10 WRK-ANN-Q PIC 9(01). DTSBU520
|
|
00159 * DTSBU520
|
|
00160 * 05 WRK-ANN-RPT-YEAR PIC 9(04). DTSBU520
|
|
00161 * DTSBU520
|
|
00162 * 05 ANN-SUB PIC S9(04) COMP. DTSBU520
|
|
00163 * 05 CURR-SUB PIC S9(04) COMP. DTSBU520
|
|
00164 * 05 NEW-SUB PIC S9(04) COMP. DTSBU520
|
|
00165 * 05 ANN-SUB-MAX PIC S9(04) COMP DTSBU520
|
|
00166 * VALUE +12. DTSBU520
|
|
00167 * 05 ANNUAL-TABLE-AREA. DTSBU520
|
|
00168 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00169 * 10 FILLER PIC X(02) VALUE 'UI'. DTSBU520
|
|
00170 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00171 * 10 FILLER PIC X(02) VALUE 'UI'. DTSBU520
|
|
00172 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00173 * 10 FILLER PIC X(02) VALUE 'UI'. DTSBU520
|
|
00174 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00175 * 10 FILLER PIC X(02) VALUE 'UI'. DTSBU520
|
|
00176 * DTSBU520
|
|
00177 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00178 * 10 FILLER PIC X(02) VALUE 'SU'. DTSBU520
|
|
00179 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00180 * 10 FILLER PIC X(02) VALUE 'SU'. DTSBU520
|
|
00181 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00182 * 10 FILLER PIC X(02) VALUE 'SU'. DTSBU520
|
|
00183 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00184 * 10 FILLER PIC X(02) VALUE 'SU'. DTSBU520
|
|
00185 * DTSBU520
|
|
00186 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00187 * 10 FILLER PIC X(02) VALUE 'IN'. DTSBU520
|
|
00188 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00189 * 10 FILLER PIC X(02) VALUE 'IN'. DTSBU520
|
|
00190 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00191 * 10 FILLER PIC X(02) VALUE 'IN'. DTSBU520
|
|
00192 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00193 * 10 FILLER PIC X(02) VALUE 'IN'. DTSBU520
|
|
00194 * DTSBU520
|
|
00195 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00196 * 10 FILLER PIC X(02) VALUE 'LP'. DTSBU520
|
|
00197 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00198 * 10 FILLER PIC X(02) VALUE 'LP'. DTSBU520
|
|
00199 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00200 * 10 FILLER PIC X(02) VALUE 'LP'. DTSBU520
|
|
00201 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00202 * 10 FILLER PIC X(02) VALUE 'LP'. DTSBU520
|
|
00203 * DTSBU520
|
|
00204 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00205 * 10 FILLER PIC X(02) VALUE 'NP'. DTSBU520
|
|
00206 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00207 * 10 FILLER PIC X(02) VALUE 'NP'. DTSBU520
|
|
00208 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00209 * 10 FILLER PIC X(02) VALUE 'NP'. DTSBU520
|
|
00210 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00211 * 10 FILLER PIC X(02) VALUE 'NP'. DTSBU520
|
|
00212 * DTSBU520
|
|
00213 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00214 * 10 FILLER PIC X(02) VALUE 'MP'. DTSBU520
|
|
00215 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00216 * 10 FILLER PIC X(02) VALUE 'MP'. DTSBU520
|
|
00217 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00218 * 10 FILLER PIC X(02) VALUE 'MP'. DTSBU520
|
|
00219 * 10 FILLER PIC S9(05) COMP-3. DTSBU520
|
|
00220 * 10 FILLER PIC X(02) VALUE 'MP'. DTSBU520
|
|
00221 * 05 ANNUAL-TABLE-ENTRY REDEFINES ANNUAL-TABLE-AREA DTSBU520
|
|
00222 * OCCURS 24 TIMES. DTSBU520
|
|
00223 * 10 ANN-TBL-YRQ PIC S9(05) COMP-3. DTSBU520
|
|
00224 * 10 ANN-TBL-IND PIC X(02). DTSBU520
|
|
00225 DTSBU520
|
|
00226 EJECT DTSBU520
|
|
00227 01 MSG-TABLE. DTSBU520
|
|
00228 05 MSG1-TOT-CREDIT-AMT. DTSBU520
|
|
00229 10 MSG1-ID. DTSBU520
|
|
00230 15 MSG1-ID1 PIC X(08) VALUE 'DTSBU520'. DTSBU520
|
|
00231 15 MSG1-ID2 PIC X(03) VALUE '351'. DTSBU520
|
|
00232 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'INVALID CR AMT'. DTSBU520
|
|
00233 10 MSG1-LONG-TEXT. DTSBU520
|
|
00234 15 FILLER PIC X(30) DTSBU520
|
|
00235 VALUE 'MPRF-TOT-CREDIT-AMT OUT OF SYN'. DTSBU520
|
|
00236 15 FILLER PIC X(30) DTSBU520
|
|
00237 VALUE 'C WITH MPAY RECORDS. ADJUSTED'. DTSBU520
|
|
00238 DTSBU520
|
|
00239 05 MSG2-TOT-CREDIT-AMT. DTSBU520
|
|
00240 10 MSG2-ID. DTSBU520
|
|
00241 15 MSG2-ID1 PIC X(08) VALUE 'DTSBU520'. DTSBU520
|
|
00242 15 MSG2-ID2 PIC X(03) VALUE '352'. DTSBU520
|
|
00243 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'INVALID BAL AM'. DTSBU520
|
|
00244 10 MSG2-LONG-TEXT. DTSBU520
|
|
00245 15 FILLER PIC X(30) DTSBU520
|
|
00246 VALUE 'MPRF-TOT-BALANCE-AMT OUT OF SY'. DTSBU520
|
|
00247 15 FILLER PIC X(30) DTSBU520
|
|
00248 VALUE 'NC WITH MQTR RECORDS. ADJUSTED'. DTSBU520
|
|
00249 EJECT DTSBU520
|
|
00250 01 R907-REC. DTSBU520
|
|
00251 ++INCLUDE DTSIR907 DTSBU520
|
|
00252 EJECT DTSBU520
|
|
00253 01 L910-LINK-AREA. DTSBU520
|
|
00254 ++INCLUDE DTSIL910 DTSBU520
|
|
00255 SKIP3 DTSBU520
|
|
00256 01 MSKL-REC. DTSBU520
|
|
00257 ++INCLUDE DTSIMSKL DTSBU520
|
|
00258 SKIP3 DTSBU520
|
|
00259 01 MQTR-REC. DTSBU520
|
|
00260 ++INCLUDE DTSIMQTR DTSBU520
|
|
00261 SKIP3 DTSBU520
|
|
00262 01 MPAY-REC. DTSBU520
|
|
00263 ++INCLUDE DTSIMPAY DTSBU520
|
|
00264 SKIP3 DTSBU520
|
|
00265 01 MDST-REC. DTSBU520
|
|
00266 ++INCLUDE DTSIMDST DTSBU520
|
|
00267 SKIP3 DTSBU520
|
|
00268 *01 MAPL-REC. DTSBU520
|
|
00269 ***INCLUDE DTSIMAPL DTSBU520
|
|
00270 EJECT DTSBU520
|
|
00271 01 L004-LINK-AREA. DTSBU520
|
|
00272 ++INCLUDE DTSIL004 DTSBU520
|
|
00273 SKIP3 DTSBU520
|
|
00274 01 L521-LINK-AREA. DTSBU520
|
|
00275 ++INCLUDE DTSIL521 DTSBU520
|
|
00276 SKIP3 DTSBU520
|
|
00277 01 L542-LINK-AREA. DTSBU520
|
|
00278 ++INCLUDE DTSIL542 DTSBU520
|
|
00279 SKIP3 DTSBU520
|
|
00280 01 L590-LINK-AREA. DTSBU520
|
|
00281 ++INCLUDE DTSIL590 DTSBU520
|
|
00282 EJECT DTSBU520
|
|
00283 01 CACT-LITERALS. DTSBU520
|
|
00284 ++INCLUDE DTSICACT DTSBU520
|
|
00285 EJECT DTSBU520
|
|
00286 LINKAGE SECTION. DTSBU520
|
|
00287 SKIP3 DTSBU520
|
|
00288 01 L520-LINK-AREA. DTSBU520
|
|
00289 ++INCLUDE DTSIL520 DTSBU520
|
|
00290 EJECT DTSBU520
|
|
00291 01 LBCM-LINK-AREA. DTSBU520
|
|
00292 ++INCLUDE DTSILBCM DTSBU520
|
|
00293 EJECT DTSBU520
|
|
00294 01 MPRF-REC. DTSBU520
|
|
00295 ++INCLUDE DTSIMPRF DTSBU520
|
|
00296 EJECT DTSBU520
|
|
00297 PROCEDURE DIVISION USING L520-LINK-AREA DTSBU520
|
|
00298 LBCM-LINK-AREA DTSBU520
|
|
00299 MPRF-REC. DTSBU520
|
|
00300 DTSBU520
|
|
00301 DTSBU520
|
|
00302 IF FIRST-TIME-IND = 'Y' DTSBU520
|
|
00303 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBU520
|
|
00304 MOVE 'N' TO FIRST-TIME-IND. DTSBU520
|
|
00305 DTSBU520
|
|
00306 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBU520
|
|
00307 DTSBU520
|
|
00308 DTSBU520
|
|
00309 GOBACK. DTSBU520
|
|
00310 EJECT DTSBU520
|
|
00311 I0000-FIRST-TIME. DTSBU520
|
|
00312 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBU520
|
|
00313 DTSBU520
|
|
00314 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBU520
|
|
00315 R907-MODULE-NAME. DTSBU520
|
|
00316 DTSBU520
|
|
00317 MOVE +0 TO WRK-NULL-BATCH-NO DTSBU520
|
|
00318 WRK-NULL-ITEM-NO. DTSBU520
|
|
00319 DTSBU520
|
|
00320 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBU520
|
|
00321 I0000-EXIT. DTSBU520
|
|
00322 EXIT. DTSBU520
|
|
00323 EJECT DTSBU520
|
|
00324 P0000-PROCESS. DTSBU520
|
|
00325 *& DTSBU520
|
|
00326 IF MPRF-EMP-NO = 020852 OR 031484 DTSBU520
|
|
00327 DISPLAY 'BU520 P0000 OPT: ' L520-OPTION DTSBU520
|
|
00328 ' ' L520-PREF-APPLIC-IND DTSBU520
|
|
00329 END-IF. DTSBU520
|
|
00330 *& DTSBU520
|
|
00331 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBU520
|
|
00332 DTSBU520
|
|
00333 MOVE L520-PREF-PAY-DOC-NO TO WRK-PREF-PAY-DOC-NO. DTSBU520
|
|
00334 DTSBU520
|
|
00335 * IF L520-ANNUAL-RPT-PMT-88 DTSBU520
|
|
00336 * PERFORM P0200-BUILD-ANN-TABLE THRU P0200-EXIT. DTSBU520
|
|
00337 DTSBU520
|
|
00338 IF L520-NO-PREF-88 DTSBU520
|
|
00339 MOVE +0 TO WRK-PREF-APPLIC-YRQ DTSBU520
|
|
00340 MOVE SPACE TO WRK-PREF-APPLIC-IND DTSBU520
|
|
00341 ELSE DTSBU520
|
|
00342 IF L520-PREF-YRQ-88 DTSBU520
|
|
00343 MOVE L520-PREF-APPLIC-YRQ TO WRK-PREF-APPLIC-YRQ DTSBU520
|
|
00344 MOVE SPACE TO WRK-PREF-APPLIC-IND DTSBU520
|
|
00345 ELSE DTSBU520
|
|
00346 IF L520-PREF-YRQ-IND-88 DTSBU520
|
|
00347 MOVE L520-PREF-APPLIC-YRQ TO WRK-PREF-APPLIC-YRQ DTSBU520
|
|
00348 MOVE L520-PREF-APPLIC-IND TO WRK-PREF-APPLIC-IND DTSBU520
|
|
00349 ELSE DTSBU520
|
|
00350 DISPLAY 'DTSBU520:P0000' DTSBU520
|
|
00351 PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00352 DTSBU520
|
|
00353 *****MOVE 'N' TO WRK-OPEN-MAPL-DEBIT. DTSBU520
|
|
00354 DTSBU520
|
|
00355 *****IF MPRF-MAPL-EXISTS-88 DTSBU520
|
|
00356 *********PERFORM P0100-OPEN-MAPL THRU P0100-EXIT. DTSBU520
|
|
00357 DTSBU520
|
|
00358 MOVE +0 TO HOLD-MQTR-YRQ. DTSBU520
|
|
00359 DTSBU520
|
|
00360 PERFORM P1000-MAIN-LOOP THRU P1000-EXIT DTSBU520
|
|
00361 UNTIL (MPRF-TOT-BALANCE-AMT NOT > +0) DTSBU520
|
|
00362 OR (MPRF-TOT-CREDIT-AMT NOT > +0). DTSBU520
|
|
00363 DTSBU520
|
|
00364 ** IF L520-LAST-ANN-QTR-NULL-88 DTSBU520
|
|
00365 * OR L520-LAST-ANN-QTR-YES-88 DTSBU520
|
|
00366 * PERFORM P1000-MAIN-LOOP THRU P1000-EXIT DTSBU520
|
|
00367 * UNTIL (MPRF-TOT-BALANCE-AMT NOT > +0) DTSBU520
|
|
00368 * OR (MPRF-TOT-CREDIT-AMT NOT > +0) DTSBU520
|
|
00369 * ELSE DTSBU520
|
|
00370 * IF (MPRF-TOT-CREDIT-AMT > +0) DTSBU520
|
|
00371 * PERFORM P1000-MAIN-LOOP THRU P1000-EXIT DTSBU520
|
|
00372 * END-IF DTSBU520
|
|
00373 ** END-IF. DTSBU520
|
|
00374 DTSBU520
|
|
00375 P0000-EXIT. DTSBU520
|
|
00376 EXIT. DTSBU520
|
|
00377 SKIP3 DTSBU520
|
|
00378 *P0100-OPEN-MAPL. DTSBU520
|
|
00379 *****MOVE LOW-VALUES TO MAPL-KEY-AREA. DTSBU520
|
|
00380 *****MOVE MPRF-EMP-NO TO MAPL-EMP-NO. DTSBU520
|
|
00381 *****SET MAPL-APL-88 TO TRUE. DTSBU520
|
|
00382 *****MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00383 *****PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU520
|
|
00384 *****PERFORM P0110-MAPL-BROWSE THRU P0110-EXIT DTSBU520
|
|
00385 *********UNTIL L910-NO-REC-88. DTSBU520
|
|
00386 *P0100-EXIT. DTSBU520
|
|
00387 *****EXIT. DTSBU520
|
|
00388 SKIP3 DTSBU520
|
|
00389 *P0110-MAPL-BROWSE. DTSBU520
|
|
00390 *****MOVE MSKL-REC TO MAPL-REC. DTSBU520
|
|
00391 DTSBU520
|
|
00392 *****IF MAPL-STATUS-OPEN-88 DTSBU520
|
|
00393 *********MOVE 'Y' TO WRK-OPEN-MAPL-DEBIT DTSBU520
|
|
00394 *********SET L910-NO-REC-88 TO TRUE DTSBU520
|
|
00395 *********GO TO P0110-EXIT. DTSBU520
|
|
00396 DTSBU520
|
|
00397 *****PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU520
|
|
00398 *P0110-EXIT. DTSBU520
|
|
00399 *****EXIT. DTSBU520
|
|
00400 EJECT DTSBU520
|
|
00401 *P0200-BUILD-ANN-TABLE. DTSBU520
|
|
00402 * IF L520-PREF-APPLIC-YRQ = ZERO DTSBU520
|
|
00403 * DISPLAY 'DTSBU520:P0200 - APPLIC-YRQ = ZERO' DTSBU520
|
|
00404 * PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00405 * DTSBU520
|
|
00406 * MOVE L520-PREF-APPLIC-YRQ TO L004-QTR-5-9. DTSBU520
|
|
00407 * DTSBU520
|
|
00408 * MOVE 1 TO L004-QTR-5-Q. DTSBU520
|
|
00409 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBU520
|
|
00410 * MOVE L004-QTR-5-9 TO ANN-TBL-YRQ (1) DTSBU520
|
|
00411 * ANN-TBL-YRQ (5) DTSBU520
|
|
00412 * ANN-TBL-YRQ (9) DTSBU520
|
|
00413 * ANN-TBL-YRQ (13) DTSBU520
|
|
00414 * ANN-TBL-YRQ (17) DTSBU520
|
|
00415 * ANN-TBL-YRQ (21). DTSBU520
|
|
00416 * DTSBU520
|
|
00417 * DTSBU520
|
|
00418 * MOVE 2 TO L004-QTR-5-Q. DTSBU520
|
|
00419 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBU520
|
|
00420 * MOVE L004-QTR-5-9 TO ANN-TBL-YRQ (2) DTSBU520
|
|
00421 * ANN-TBL-YRQ (6) DTSBU520
|
|
00422 * ANN-TBL-YRQ (10) DTSBU520
|
|
00423 * ANN-TBL-YRQ (14) DTSBU520
|
|
00424 * ANN-TBL-YRQ (18) DTSBU520
|
|
00425 * ANN-TBL-YRQ (22). DTSBU520
|
|
00426 * DTSBU520
|
|
00427 * MOVE 3 TO L004-QTR-5-Q. DTSBU520
|
|
00428 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBU520
|
|
00429 * MOVE L004-QTR-5-9 TO ANN-TBL-YRQ (3) DTSBU520
|
|
00430 * ANN-TBL-YRQ (7) DTSBU520
|
|
00431 * ANN-TBL-YRQ (11) DTSBU520
|
|
00432 * ANN-TBL-YRQ (15) DTSBU520
|
|
00433 * ANN-TBL-YRQ (19) DTSBU520
|
|
00434 * ANN-TBL-YRQ (23). DTSBU520
|
|
00435 * DTSBU520
|
|
00436 * MOVE 4 TO L004-QTR-5-Q. DTSBU520
|
|
00437 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBU520
|
|
00438 * MOVE L004-QTR-5-9 TO ANN-TBL-YRQ (4) DTSBU520
|
|
00439 * ANN-TBL-YRQ (8) DTSBU520
|
|
00440 * ANN-TBL-YRQ (12) DTSBU520
|
|
00441 * ANN-TBL-YRQ (16) DTSBU520
|
|
00442 * ANN-TBL-YRQ (20) DTSBU520
|
|
00443 * ANN-TBL-YRQ (24). DTSBU520
|
|
00444 * DTSBU520
|
|
00445 *P0200-EXIT. DTSBU520
|
|
00446 * EXIT. DTSBU520
|
|
00447 DTSBU520
|
|
00448 P1000-MAIN-LOOP. DTSBU520
|
|
00449 MOVE WRK-NULL-DOC-NO TO HOLD-MPAY-DOC-NO. DTSBU520
|
|
00450 DTSBU520
|
|
00451 PERFORM P2000-LOCATE-MPAY THRU P2000-EXIT. DTSBU520
|
|
00452 DTSBU520
|
|
00453 IF HOLD-MPAY-DOC-NO = WRK-NULL-DOC-NO DTSBU520
|
|
00454 MOVE +0 TO MPRF-TOT-CREDIT-AMT DTSBU520
|
|
00455 MOVE MSG1-ID2 TO R907-MSG-ID DTSBU520
|
|
00456 MOVE MSG1-LONG-TEXT TO R907-MSG-TEXT DTSBU520
|
|
00457 PERFORM S946-R907-WRITE THRU S946-EXIT DTSBU520
|
|
00458 GO TO P1000-EXIT. DTSBU520
|
|
00459 DTSBU520
|
|
00460 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBU520
|
|
00461 DTSBU520
|
|
00462 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBU520
|
|
00463 DTSBU520
|
|
00464 SET MPAY-PAY-88 TO TRUE. DTSBU520
|
|
00465 DTSBU520
|
|
00466 MOVE HOLD-MPAY-DOC-NO TO MPAY-DOC-NO. DTSBU520
|
|
00467 DTSBU520
|
|
00468 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00469 DTSBU520
|
|
00470 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
00471 DTSBU520
|
|
00472 IF L910-NO-REC-88 DTSBU520
|
|
00473 DISPLAY 'DTSBU520:P1000:1' DTSBU520
|
|
00474 PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00475 DTSBU520
|
|
00476 MOVE MSKL-REC TO MPAY-REC. DTSBU520
|
|
00477 DTSBU520
|
|
00478 DTSBU520
|
|
00479 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU520
|
|
00480 DTSBU520
|
|
00481 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU520
|
|
00482 DTSBU520
|
|
00483 SET MDST-DST-88 TO TRUE. DTSBU520
|
|
00484 DTSBU520
|
|
00485 SET MDST-CREDIT-REC-88 TO TRUE. DTSBU520
|
|
00486 DTSBU520
|
|
00487 MOVE HOLD-MPAY-DOC-NO TO MDST-DOC-NO. DTSBU520
|
|
00488 DTSBU520
|
|
00489 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00490 DTSBU520
|
|
00491 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
00492 DTSBU520
|
|
00493 IF L910-NO-REC-88 DTSBU520
|
|
00494 DISPLAY 'DTSBU520:P1000:2' DTSBU520
|
|
00495 PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00496 DTSBU520
|
|
00497 MOVE MSKL-REC TO MDST-REC. DTSBU520
|
|
00498 DTSBU520
|
|
00499 DTSBU520
|
|
00500 PERFORM P3000-PROCESS-MPAY THRU P3000-EXIT. DTSBU520
|
|
00501 DTSBU520
|
|
00502 DTSBU520
|
|
00503 PERFORM P1100-MDST-CLEANUP THRU P1100-EXIT. DTSBU520
|
|
00504 P1000-EXIT. DTSBU520
|
|
00505 EXIT. DTSBU520
|
|
00506 SKIP3 DTSBU520
|
|
00507 P1100-MDST-CLEANUP. DTSBU520
|
|
00508 *****PERFORM P1110-MDST-ACCT-SCAN THRU P1110-EXIT DTSBU520
|
|
00509 *********VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
00510 *********UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBU520
|
|
00511 DTSBU520
|
|
00512 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00513 DTSBU520
|
|
00514 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
00515 DTSBU520
|
|
00516 IF L910-NO-REC-88 DTSBU520
|
|
00517 DISPLAY 'DTSBU520:P1100:1' DTSBU520
|
|
00518 PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00519 DTSBU520
|
|
00520 DTSBU520
|
|
00521 IF MDST-ACCT-CNT = +0 DTSBU520
|
|
00522 PERFORM S910-DELETE THRU S910-EXIT DTSBU520
|
|
00523 ELSE DTSBU520
|
|
00524 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE DTSBU520
|
|
00525 MOVE MDST-REC TO MSKL-REC DTSBU520
|
|
00526 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU520
|
|
00527 P1100-EXIT. DTSBU520
|
|
00528 EXIT. DTSBU520
|
|
00529 SKIP3 DTSBU520
|
|
00530 *P1110-MDST-ACCT-SCAN. DTSBU520
|
|
00531 *****IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBU520
|
|
00532 *********NEXT SENTENCE DTSBU520
|
|
00533 *****ELSE DTSBU520
|
|
00534 *********GO TO P1110-EXIT. DTSBU520
|
|
00535 DTSBU520
|
|
00536 *****IF (MDST-AMT (MDST-ACCT-IDX) = +0) DTSBU520
|
|
00537 ************OR DTSBU520
|
|
00538 ********(MDST-AMT (MDST-ACCT-IDX) > LBCM-CR-TOL-MAX) DTSBU520
|
|
00539 *********NEXT SENTENCE DTSBU520
|
|
00540 *****ELSE DTSBU520
|
|
00541 *********PERFORM S590-CR-TOL THRU S590-EXIT. DTSBU520
|
|
00542 *P1110-EXIT. DTSBU520
|
|
00543 *****EXIT. DTSBU520
|
|
00544 EJECT DTSBU520
|
|
00545 P2000-LOCATE-MPAY. DTSBU520
|
|
00546 IF WRK-PREF-PAY-DOC-NO NOT = WRK-NULL-DOC-NO DTSBU520
|
|
00547 PERFORM P2100-LOCATE-PREF-MPAY THRU P2100-EXIT DTSBU520
|
|
00548 MOVE WRK-NULL-DOC-NO TO WRK-PREF-PAY-DOC-NO DTSBU520
|
|
00549 IF HOLD-MPAY-DOC-NO = WRK-NULL-DOC-NO DTSBU520
|
|
00550 NEXT SENTENCE DTSBU520
|
|
00551 ELSE DTSBU520
|
|
00552 GO TO P2000-EXIT. DTSBU520
|
|
00553 DTSBU520
|
|
00554 DTSBU520
|
|
00555 MOVE ALL-NINES-DATE TO HOLD-RECEIVED-DATE. DTSBU520
|
|
00556 DTSBU520
|
|
00557 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU520
|
|
00558 DTSBU520
|
|
00559 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU520
|
|
00560 DTSBU520
|
|
00561 SET MDST-DST-88 TO TRUE. DTSBU520
|
|
00562 DTSBU520
|
|
00563 SET MDST-CREDIT-REC-88 TO TRUE. DTSBU520
|
|
00564 DTSBU520
|
|
00565 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00566 DTSBU520
|
|
00567 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU520
|
|
00568 DTSBU520
|
|
00569 PERFORM P2200-SCAN-MDST THRU P2200-EXIT DTSBU520
|
|
00570 UNTIL L910-NO-REC-88. DTSBU520
|
|
00571 P2000-EXIT. DTSBU520
|
|
00572 EXIT. DTSBU520
|
|
00573 SKIP3 DTSBU520
|
|
00574 P2100-LOCATE-PREF-MPAY. DTSBU520
|
|
00575 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBU520
|
|
00576 DTSBU520
|
|
00577 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBU520
|
|
00578 DTSBU520
|
|
00579 SET MPAY-PAY-88 TO TRUE. DTSBU520
|
|
00580 DTSBU520
|
|
00581 MOVE WRK-PREF-PAY-DOC-NO TO MPAY-DOC-NO. DTSBU520
|
|
00582 DTSBU520
|
|
00583 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00584 DTSBU520
|
|
00585 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
00586 DTSBU520
|
|
00587 IF L910-NO-REC-88 DTSBU520
|
|
00588 GO TO P2100-EXIT. DTSBU520
|
|
00589 DTSBU520
|
|
00590 MOVE MSKL-REC TO MPAY-REC. DTSBU520
|
|
00591 DTSBU520
|
|
00592 DTSBU520
|
|
00593 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU520
|
|
00594 DTSBU520
|
|
00595 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU520
|
|
00596 DTSBU520
|
|
00597 SET MDST-DST-88 TO TRUE. DTSBU520
|
|
00598 DTSBU520
|
|
00599 SET MDST-CREDIT-REC-88 TO TRUE. DTSBU520
|
|
00600 DTSBU520
|
|
00601 MOVE WRK-PREF-PAY-DOC-NO TO MDST-DOC-NO. DTSBU520
|
|
00602 DTSBU520
|
|
00603 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00604 DTSBU520
|
|
00605 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
00606 DTSBU520
|
|
00607 IF L910-NO-REC-88 DTSBU520
|
|
00608 GO TO P2100-EXIT. DTSBU520
|
|
00609 DTSBU520
|
|
00610 MOVE MSKL-REC TO MDST-REC. DTSBU520
|
|
00611 DTSBU520
|
|
00612 DTSBU520
|
|
00613 MOVE 'N' TO WRK-CR-AVAIL-IND. DTSBU520
|
|
00614 DTSBU520
|
|
00615 PERFORM DTSBU520
|
|
00616 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
00617 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBU520
|
|
00618 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBU520
|
|
00619 MOVE 'Y' TO WRK-CR-AVAIL-IND DTSBU520
|
|
00620 END-IF DTSBU520
|
|
00621 END-PERFORM. DTSBU520
|
|
00622 DTSBU520
|
|
00623 IF WRK-CR-AVAIL-IND = 'Y' DTSBU520
|
|
00624 MOVE MDST-DOC-NO TO HOLD-MPAY-DOC-NO. DTSBU520
|
|
00625 P2100-EXIT. DTSBU520
|
|
00626 EXIT. DTSBU520
|
|
00627 SKIP3 DTSBU520
|
|
00628 P2200-SCAN-MDST. DTSBU520
|
|
00629 MOVE MSKL-REC TO MDST-REC. DTSBU520
|
|
00630 DTSBU520
|
|
00631 IF MDST-CREDIT-REC-88 DTSBU520
|
|
00632 NEXT SENTENCE DTSBU520
|
|
00633 ELSE DTSBU520
|
|
00634 SET L910-NO-REC-88 TO TRUE DTSBU520
|
|
00635 GO TO P2200-EXIT. DTSBU520
|
|
00636 DTSBU520
|
|
00637 IF MDST-RECEIVED-DATE < HOLD-RECEIVED-DATE DTSBU520
|
|
00638 PERFORM P2300-LOOK-FOR-CREDIT THRU P2300-EXIT. DTSBU520
|
|
00639 DTSBU520
|
|
00640 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU520
|
|
00641 P2200-EXIT. DTSBU520
|
|
00642 EXIT. DTSBU520
|
|
00643 SKIP3 DTSBU520
|
|
00644 P2300-LOOK-FOR-CREDIT. DTSBU520
|
|
00645 MOVE 'N' TO WRK-CR-AVAIL-IND. DTSBU520
|
|
00646 DTSBU520
|
|
00647 PERFORM DTSBU520
|
|
00648 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
00649 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBU520
|
|
00650 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBU520
|
|
00651 MOVE 'Y' TO WRK-CR-AVAIL-IND DTSBU520
|
|
00652 END-IF DTSBU520
|
|
00653 END-PERFORM. DTSBU520
|
|
00654 DTSBU520
|
|
00655 IF WRK-CR-AVAIL-IND = 'N' DTSBU520
|
|
00656 GO TO P2300-EXIT. DTSBU520
|
|
00657 DTSBU520
|
|
00658 DTSBU520
|
|
00659 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBU520
|
|
00660 DTSBU520
|
|
00661 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBU520
|
|
00662 DTSBU520
|
|
00663 SET MPAY-PAY-88 TO TRUE. DTSBU520
|
|
00664 DTSBU520
|
|
00665 MOVE MDST-DOC-NO TO MPAY-DOC-NO. DTSBU520
|
|
00666 DTSBU520
|
|
00667 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00668 DTSBU520
|
|
00669 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
00670 DTSBU520
|
|
00671 IF L910-NO-REC-88 DTSBU520
|
|
00672 DISPLAY 'DTSBU520:P2300:1' DTSBU520
|
|
00673 PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00674 DTSBU520
|
|
00675 MOVE MSKL-REC TO MPAY-REC. DTSBU520
|
|
00676 DTSBU520
|
|
00677 DTSBU520
|
|
00678 IF MDST-RECEIVED-DATE NOT = MPAY-RECEIVED-DATE DTSBU520
|
|
00679 DISPLAY 'DTSBU520:P2300:2' DTSBU520
|
|
00680 PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00681 DTSBU520
|
|
00682 MOVE MDST-RECEIVED-DATE TO HOLD-RECEIVED-DATE. DTSBU520
|
|
00683 DTSBU520
|
|
00684 MOVE MDST-DOC-NO TO HOLD-MPAY-DOC-NO. DTSBU520
|
|
00685 P2300-EXIT. DTSBU520
|
|
00686 EXIT. DTSBU520
|
|
00687 EJECT DTSBU520
|
|
00688 P3000-PROCESS-MPAY. DTSBU520
|
|
00689 MOVE +0 TO HOLD-CREDIT-AMT. DTSBU520
|
|
00690 DTSBU520
|
|
00691 PERFORM P3100-CREDIT-FROM-MDST THRU P3100-EXIT. DTSBU520
|
|
00692 DTSBU520
|
|
00693 MOVE MDST-REC TO MSKL-REC. DTSBU520
|
|
00694 DTSBU520
|
|
00695 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU520
|
|
00696 DTSBU520
|
|
00697 *& DTSBU520
|
|
00698 IF MPRF-EMP-NO = 020852 OR 031484 DTSBU520
|
|
00699 MOVE HOLD-CREDIT-AMT TO AMT-DISP DTSBU520
|
|
00700 DISPLAY 'BU520 P3000 HOLD CR: ' AMT-DISP DTSBU520
|
|
00701 ' ' MDST-BATCH-NO ' ' MDST-ITEM-NO DTSBU520
|
|
00702 END-IF. DTSBU520
|
|
00703 *& DTSBU520
|
|
00704 ** MOVE +1 TO CURR-SUB. DTSBU520
|
|
00705 DTSBU520
|
|
00706 PERFORM P4000-APPLIC-HOLD-CREDIT-AMT THRU P4000-EXIT DTSBU520
|
|
00707 UNTIL (HOLD-CREDIT-AMT NOT > +0) DTSBU520
|
|
00708 OR (MPRF-TOT-BALANCE-AMT NOT > +0). DTSBU520
|
|
00709 DTSBU520
|
|
00710 ** IF L520-LAST-ANN-QTR-NULL-88 DTSBU520
|
|
00711 * OR L520-LAST-ANN-QTR-YES-88 DTSBU520
|
|
00712 * PERFORM P4000-APPLIC-HOLD-CREDIT-AMT THRU P4000-EXIT DTSBU520
|
|
00713 * UNTIL (HOLD-CREDIT-AMT NOT > +0) DTSBU520
|
|
00714 * OR (MPRF-TOT-BALANCE-AMT NOT > +0) DTSBU520
|
|
00715 * ELSE DTSBU520
|
|
00716 * PERFORM P4000-APPLIC-HOLD-CREDIT-AMT THRU P4000-EXIT DTSBU520
|
|
00717 ** END-IF. DTSBU520
|
|
00718 DTSBU520
|
|
00719 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU520
|
|
00720 DTSBU520
|
|
00721 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU520
|
|
00722 DTSBU520
|
|
00723 SET MDST-DST-88 TO TRUE. DTSBU520
|
|
00724 DTSBU520
|
|
00725 SET MDST-CREDIT-REC-88 TO TRUE. DTSBU520
|
|
00726 DTSBU520
|
|
00727 MOVE MPAY-DOC-NO TO MDST-DOC-NO. DTSBU520
|
|
00728 DTSBU520
|
|
00729 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00730 DTSBU520
|
|
00731 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
00732 DTSBU520
|
|
00733 IF L910-NO-REC-88 DTSBU520
|
|
00734 DISPLAY 'DTSBU520:P3000:1' DTSBU520
|
|
00735 PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00736 DTSBU520
|
|
00737 MOVE MSKL-REC TO MDST-REC. DTSBU520
|
|
00738 DTSBU520
|
|
00739 DTSBU520
|
|
00740 IF HOLD-CREDIT-AMT > +0 DTSBU520
|
|
00741 PERFORM P3200-CREDIT-TO-MDST THRU P3200-EXIT. DTSBU520
|
|
00742 P3000-EXIT. DTSBU520
|
|
00743 EXIT. DTSBU520
|
|
00744 SKIP3 DTSBU520
|
|
00745 P3100-CREDIT-FROM-MDST. DTSBU520
|
|
00746 PERFORM P3110-CR-AVAIL-LOOP THRU P3110-EXIT DTSBU520
|
|
00747 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
00748 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBU520
|
|
00749 P3100-EXIT. DTSBU520
|
|
00750 EXIT. DTSBU520
|
|
00751 SKIP3 DTSBU520
|
|
00752 P3110-CR-AVAIL-LOOP. DTSBU520
|
|
00753 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBU520
|
|
00754 NEXT SENTENCE DTSBU520
|
|
00755 ELSE DTSBU520
|
|
00756 GO TO P3110-EXIT. DTSBU520
|
|
00757 DTSBU520
|
|
00758 ADD MDST-AMT (MDST-ACCT-IDX) TO HOLD-CREDIT-AMT. DTSBU520
|
|
00759 DTSBU520
|
|
00760 COMPUTE L542-AMT DTSBU520
|
|
00761 = MDST-AMT (MDST-ACCT-IDX) * -1. DTSBU520
|
|
00762 DTSBU520
|
|
00763 MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO L542-ACCT-IND. DTSBU520
|
|
00764 DTSBU520
|
|
00765 PERFORM S542-MODIFY-MDST THRU S542-EXIT. DTSBU520
|
|
00766 P3110-EXIT. DTSBU520
|
|
00767 EXIT. DTSBU520
|
|
00768 SKIP3 DTSBU520
|
|
00769 P3200-CREDIT-TO-MDST. DTSBU520
|
|
00770 *& DTSBU520
|
|
00771 IF MPRF-EMP-NO = 081547 DTSBU520
|
|
00772 MOVE HOLD-CREDIT-AMT TO AMT-DISP DTSBU520
|
|
00773 DISPLAY 'BU520 P3200 HOLD CR: ' AMT-DISP DTSBU520
|
|
00774 ' ' MDST-BATCH-NO ' ' MDST-ITEM-NO DTSBU520
|
|
00775 END-IF. DTSBU520
|
|
00776 *& DTSBU520
|
|
00777 MOVE HOLD-CREDIT-AMT TO L542-AMT. DTSBU520
|
|
00778 DTSBU520
|
|
00779 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. DTSBU520
|
|
00780 DTSBU520
|
|
00781 PERFORM S542-MODIFY-MDST THRU S542-EXIT. DTSBU520
|
|
00782 P3200-EXIT. DTSBU520
|
|
00783 EXIT. DTSBU520
|
|
00784 EJECT DTSBU520
|
|
00785 P4000-APPLIC-HOLD-CREDIT-AMT. DTSBU520
|
|
00786 SET L521-UPDATE-88 TO TRUE. DTSBU520
|
|
00787 DTSBU520
|
|
00788 MOVE MPAY-DOC-NO TO L521-MPAY-DOC-NO. DTSBU520
|
|
00789 DTSBU520
|
|
00790 MOVE MPAY-RECEIVED-DATE TO L521-RECEIVED-DATE. DTSBU520
|
|
00791 DTSBU520
|
|
00792 SET L521-WAIVE-INT-NO-88 TO TRUE. DTSBU520
|
|
00793 DTSBU520
|
|
00794 *****SET L521-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBU520
|
|
00795 DTSBU520
|
|
00796 MOVE +0 TO L521-APPLIC-AMT. DTSBU520
|
|
00797 DTSBU520
|
|
00798 MOVE SPACE TO L521-APPLIC-ACCT-IND. DTSBU520
|
|
00799 DTSBU520
|
|
00800 MOVE +0 TO L521-APPLIC-YRQ. DTSBU520
|
|
00801 DTSBU520
|
|
00802 DTSBU520
|
|
00803 PERFORM P5000-LOCATE-DEBIT THRU P5000-EXIT. DTSBU520
|
|
00804 DTSBU520
|
|
00805 *& DTSBU520
|
|
00806 * IF MPRF-EMP-NO = 081547 DTSBU520
|
|
00807 * MOVE L521-APPLIC-AMT TO AMT-DISP DTSBU520
|
|
00808 * DISPLAY 'BD520 P4000 L521 AMT ' AMT-DISP DTSBU520
|
|
00809 * ' IND ' L521-APPLIC-ACCT-IND DTSBU520
|
|
00810 * ' YRQ ' L521-APPLIC-YRQ DTSBU520
|
|
00811 * END-IF. DTSBU520
|
|
00812 *& DTSBU520
|
|
00813 ** IF L521-APPLIC-AMT = +0 DTSBU520
|
|
00814 * IF MPRF-TOT-BALANCE-AMT > +0 DTSBU520
|
|
00815 * IF L520-ANNUAL-RPT-WD-88 DTSBU520
|
|
00816 * GO TO P4000-EXIT DTSBU520
|
|
00817 * END-IF DTSBU520
|
|
00818 * END-IF DTSBU520
|
|
00819 ** END-IF. DTSBU520
|
|
00820 DTSBU520
|
|
00821 IF L521-APPLIC-AMT = +0 DTSBU520
|
|
00822 IF MPRF-TOT-BALANCE-AMT > +0 DTSBU520
|
|
00823 MOVE +0 TO MPRF-TOT-BALANCE-AMT DTSBU520
|
|
00824 MOVE MSG2-ID2 TO R907-MSG-ID DTSBU520
|
|
00825 MOVE MSG2-LONG-TEXT TO R907-MSG-TEXT DTSBU520
|
|
00826 PERFORM S946-R907-WRITE THRU S946-EXIT DTSBU520
|
|
00827 GO TO P4000-EXIT DTSBU520
|
|
00828 ELSE DTSBU520
|
|
00829 GO TO P4000-EXIT DTSBU520
|
|
00830 END-IF DTSBU520
|
|
00831 END-IF. DTSBU520
|
|
00832 DTSBU520
|
|
00833 DTSBU520
|
|
00834 PERFORM P4100-SET-WAIVE-IND THRU P4100-EXIT. DTSBU520
|
|
00835 DTSBU520
|
|
00836 DTSBU520
|
|
00837 PERFORM P4200-ESTB-DSTRB THRU P4200-EXIT. DTSBU520
|
|
00838 DTSBU520
|
|
00839 PERFORM S521-APPLIC-PROCESS THRU S521-EXIT. DTSBU520
|
|
00840 DTSBU520
|
|
00841 IF L521-NOT-VALID-88 DTSBU520
|
|
00842 DISPLAY 'DTSBU520:P4000:1' DTSBU520
|
|
00843 PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
00844 DTSBU520
|
|
00845 DTSBU520
|
|
00846 COMPUTE HOLD-CREDIT-AMT = HOLD-CREDIT-AMT - L521-APPLIC-AMT. DTSBU520
|
|
00847 P4000-EXIT. DTSBU520
|
|
00848 EXIT. DTSBU520
|
|
00849 SKIP3 DTSBU520
|
|
00850 P4100-SET-WAIVE-IND. DTSBU520
|
|
00851 IF MPAY-ESTB-DATE = LBCM-CURR-RUN-DATE DTSBU520
|
|
00852 NEXT SENTENCE DTSBU520
|
|
00853 ELSE DTSBU520
|
|
00854 GO TO P4100-EXIT. DTSBU520
|
|
00855 DTSBU520
|
|
00856 IF MPAY-APPLIC-YRQ = +0 DTSBU520
|
|
00857 MOVE MPAY-WAIVE-INT-IND DTSBU520
|
|
00858 TO L521-WAIVE-INT-IND DTSBU520
|
|
00859 *********MOVE MPAY-WAIVE-LATE-PEN-IND DTSBU520
|
|
00860 ***********TO L521-WAIVE-LATE-PEN-IND DTSBU520
|
|
00861 GO TO P4100-EXIT. DTSBU520
|
|
00862 DTSBU520
|
|
00863 IF MPAY-APPLIC-YRQ = L521-APPLIC-YRQ DTSBU520
|
|
00864 IF MPAY-APPLIC-IND = SPACES DTSBU520
|
|
00865 MOVE MPAY-WAIVE-INT-IND DTSBU520
|
|
00866 TO L521-WAIVE-INT-IND DTSBU520
|
|
00867 *************MOVE MPAY-WAIVE-LATE-PEN-IND DTSBU520
|
|
00868 ***************TO L521-WAIVE-LATE-PEN-IND DTSBU520
|
|
00869 ELSE DTSBU520
|
|
00870 IF MPAY-APPLIC-IND = L521-APPLIC-ACCT-IND DTSBU520
|
|
00871 MOVE MPAY-WAIVE-INT-IND DTSBU520
|
|
00872 TO L521-WAIVE-INT-IND DTSBU520
|
|
00873 *****************MOVE MPAY-WAIVE-LATE-PEN-IND DTSBU520
|
|
00874 *******************TO L521-WAIVE-LATE-PEN-IND DTSBU520
|
|
00875 ELSE DTSBU520
|
|
00876 NEXT SENTENCE DTSBU520
|
|
00877 ELSE DTSBU520
|
|
00878 NEXT SENTENCE. DTSBU520
|
|
00879 P4100-EXIT. DTSBU520
|
|
00880 EXIT. DTSBU520
|
|
00881 SKIP3 DTSBU520
|
|
00882 P4200-ESTB-DSTRB. DTSBU520
|
|
00883 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU520
|
|
00884 DTSBU520
|
|
00885 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU520
|
|
00886 DTSBU520
|
|
00887 SET MDST-DST-88 TO TRUE. DTSBU520
|
|
00888 DTSBU520
|
|
00889 MOVE L521-APPLIC-YRQ TO MDST-YRQ. DTSBU520
|
|
00890 DTSBU520
|
|
00891 MOVE MPAY-DOC-NO TO MDST-DOC-NO. DTSBU520
|
|
00892 DTSBU520
|
|
00893 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00894 DTSBU520
|
|
00895 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
00896 DTSBU520
|
|
00897 IF L910-NO-REC-88 DTSBU520
|
|
00898 PERFORM P4210-ADD-MDST THRU P4210-EXIT DTSBU520
|
|
00899 ELSE DTSBU520
|
|
00900 PERFORM P4220-MOD-MDST THRU P4220-EXIT. DTSBU520
|
|
00901 P4200-EXIT. DTSBU520
|
|
00902 EXIT. DTSBU520
|
|
00903 SKIP3 DTSBU520
|
|
00904 P4210-ADD-MDST. DTSBU520
|
|
00905 MOVE LOW-VALUES TO MDST-DATA-AREA. DTSBU520
|
|
00906 DTSBU520
|
|
00907 MOVE +0 TO MDST-PURGE-DATE. DTSBU520
|
|
00908 DTSBU520
|
|
00909 MOVE MPAY-RECEIVED-DATE TO MDST-RECEIVED-DATE. DTSBU520
|
|
00910 DTSBU520
|
|
00911 SET MDST-NOT-CONVERTED-88 TO TRUE. DTSBU520
|
|
00912 DTSBU520
|
|
00913 MOVE LBCM-CURR-RUN-DATE TO MDST-ESTB-DATE DTSBU520
|
|
00914 MDST-CHNG-DATE. DTSBU520
|
|
00915 DTSBU520
|
|
00916 MOVE L521-APPLIC-AMT TO L542-AMT. DTSBU520
|
|
00917 DTSBU520
|
|
00918 MOVE L521-APPLIC-ACCT-IND TO L542-ACCT-IND. DTSBU520
|
|
00919 DTSBU520
|
|
00920 *& DTSBU520
|
|
00921 IF MPRF-EMP-NO = 081547 DTSBU520
|
|
00922 MOVE L542-AMT TO AMT-DISP DTSBU520
|
|
00923 DISPLAY 'BU520 P4210 ADD DST: ' AMT-DISP DTSBU520
|
|
00924 ' ' MDST-BATCH-NO ' ' MDST-ITEM-NO DTSBU520
|
|
00925 END-IF. DTSBU520
|
|
00926 *& DTSBU520
|
|
00927 PERFORM S542-MODIFY-MDST THRU S542-EXIT. DTSBU520
|
|
00928 DTSBU520
|
|
00929 IF MDST-ACCT-CNT = +0 DTSBU520
|
|
00930 NEXT SENTENCE DTSBU520
|
|
00931 ELSE DTSBU520
|
|
00932 MOVE MDST-REC TO MSKL-REC DTSBU520
|
|
00933 PERFORM S910-WRITE THRU S910-EXIT. DTSBU520
|
|
00934 P4210-EXIT. DTSBU520
|
|
00935 EXIT. DTSBU520
|
|
00936 SKIP3 DTSBU520
|
|
00937 P4220-MOD-MDST. DTSBU520
|
|
00938 MOVE MSKL-REC TO MDST-REC. DTSBU520
|
|
00939 DTSBU520
|
|
00940 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. DTSBU520
|
|
00941 DTSBU520
|
|
00942 MOVE L521-APPLIC-ACCT-IND TO L542-ACCT-IND. DTSBU520
|
|
00943 DTSBU520
|
|
00944 MOVE L521-APPLIC-AMT TO L542-AMT. DTSBU520
|
|
00945 DTSBU520
|
|
00946 PERFORM S542-MODIFY-MDST THRU S542-EXIT. DTSBU520
|
|
00947 DTSBU520
|
|
00948 IF MDST-ACCT-CNT = +0 DTSBU520
|
|
00949 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA DTSBU520
|
|
00950 PERFORM S910-DELETE THRU S910-EXIT DTSBU520
|
|
00951 ELSE DTSBU520
|
|
00952 MOVE MDST-REC TO MSKL-REC DTSBU520
|
|
00953 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU520
|
|
00954 P4220-EXIT. DTSBU520
|
|
00955 EXIT. DTSBU520
|
|
00956 EJECT DTSBU520
|
|
00957 P5000-LOCATE-DEBIT. DTSBU520
|
|
00958 IF WRK-PREF-APPLIC-YRQ NOT = +0 DTSBU520
|
|
00959 PERFORM P5200-LOCATE-MQTR THRU P5200-EXIT DTSBU520
|
|
00960 IF L521-APPLIC-AMT > +0 DTSBU520
|
|
00961 GO TO P5000-EXIT DTSBU520
|
|
00962 ELSE DTSBU520
|
|
00963 MOVE +0 TO WRK-PREF-APPLIC-YRQ DTSBU520
|
|
00964 MOVE SPACE TO WRK-PREF-APPLIC-IND. DTSBU520
|
|
00965 DTSBU520
|
|
00966 ** IF L520-ANNUAL-RPT-WD-88 DTSBU520
|
|
00967 * MOVE L520-WITHDRAW-ANN-YRQ TO WRK-ANN-YRQ DTSBU520
|
|
00968 * MOVE WRK-ANN-CCYY TO WRK-ANN-RPT-YEAR DTSBU520
|
|
00969 * ELSE DTSBU520
|
|
00970 * MOVE ZERO TO WRK-ANN-RPT-YEAR DTSBU520
|
|
00971 ** END-IF. DTSBU520
|
|
00972 DTSBU520
|
|
00973 *****IF WRK-OPEN-MAPL-DEBIT = 'Y' DTSBU520
|
|
00974 *********PERFORM P5500-LOCATE-NOT-MAPL-DEBIT THRU P5500-EXIT DTSBU520
|
|
00975 *********IF L521-APPLIC-AMT > +0 DTSBU520
|
|
00976 *************GO TO P5000-EXIT DTSBU520
|
|
00977 *********ELSE DTSBU520
|
|
00978 *************MOVE 'N' TO WRK-OPEN-MAPL-DEBIT. DTSBU520
|
|
00979 DTSBU520
|
|
00980 DTSBU520
|
|
00981 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU520
|
|
00982 DTSBU520
|
|
00983 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU520
|
|
00984 DTSBU520
|
|
00985 SET MQTR-QTR-88 TO TRUE. DTSBU520
|
|
00986 DTSBU520
|
|
00987 MOVE HOLD-MQTR-YRQ TO MQTR-YRQ. DTSBU520
|
|
00988 DTSBU520
|
|
00989 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
00990 DTSBU520
|
|
00991 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU520
|
|
00992 DTSBU520
|
|
00993 PERFORM P5800-MQTR-SCAN THRU P5800-EXIT DTSBU520
|
|
00994 UNTIL (L910-NO-REC-88) DTSBU520
|
|
00995 OR DTSBU520
|
|
00996 (L521-APPLIC-AMT > +0). DTSBU520
|
|
00997 DTSBU520
|
|
00998 P5000-EXIT. DTSBU520
|
|
00999 EXIT. DTSBU520
|
|
01000 SKIP3 DTSBU520
|
|
01001 P5200-LOCATE-MQTR. DTSBU520
|
|
01002 PERFORM P5210-MQTR THRU P5210-EXIT. DTSBU520
|
|
01003 DTSBU520
|
|
01004 ** IF L520-ANNUAL-RPT-PMT-88 DTSBU520
|
|
01005 * PERFORM P5220-ANN-MQTR THRU P5220-EXIT DTSBU520
|
|
01006 * ELSE DTSBU520
|
|
01007 ** PERFORM P5210-REG-MQTR THRU P5210-EXIT. DTSBU520
|
|
01008 P5200-EXIT. DTSBU520
|
|
01009 EXIT. DTSBU520
|
|
01010 SKIP3 DTSBU520
|
|
01011 P5210-MQTR. DTSBU520
|
|
01012 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU520
|
|
01013 DTSBU520
|
|
01014 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU520
|
|
01015 DTSBU520
|
|
01016 SET MQTR-QTR-88 TO TRUE. DTSBU520
|
|
01017 DTSBU520
|
|
01018 MOVE WRK-PREF-APPLIC-YRQ TO MQTR-YRQ. DTSBU520
|
|
01019 DTSBU520
|
|
01020 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
01021 DTSBU520
|
|
01022 PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
01023 DTSBU520
|
|
01024 MOVE MSKL-REC TO MQTR-REC. DTSBU520
|
|
01025 DTSBU520
|
|
01026 IF L910-OK-88 DTSBU520
|
|
01027 PERFORM P5900-PROCESS-MQTR THRU P5900-EXIT. DTSBU520
|
|
01028 P5210-EXIT. DTSBU520
|
|
01029 EXIT. DTSBU520
|
|
01030 SKIP3 DTSBU520
|
|
01031 *P5220-ANN-MQTR. DTSBU520
|
|
01032 * PERFORM DTSBU520
|
|
01033 * VARYING ANN-SUB FROM CURR-SUB BY +1 DTSBU520
|
|
01034 * UNTIL L521-APPLIC-AMT > +0 DTSBU520
|
|
01035 * OR ANN-SUB > ANN-SUB-MAX DTSBU520
|
|
01036 * MOVE ANN-SUB TO NEW-SUB DTSBU520
|
|
01037 * PERFORM P5221-PROCESS-MQTR THRU P5221-EXIT DTSBU520
|
|
01038 * END-PERFORM. DTSBU520
|
|
01039 * DTSBU520
|
|
01040 * COMPUTE CURR-SUB = (NEW-SUB + 1). DTSBU520
|
|
01041 * DTSBU520
|
|
01042 *P5220-EXIT. DTSBU520
|
|
01043 * EXIT. DTSBU520
|
|
01044 * SKIP3 DTSBU520
|
|
01045 *P5221-PROCESS-MQTR. DTSBU520
|
|
01046 * MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU520
|
|
01047 * DTSBU520
|
|
01048 * MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU520
|
|
01049 * DTSBU520
|
|
01050 * SET MQTR-QTR-88 TO TRUE. DTSBU520
|
|
01051 * DTSBU520
|
|
01052 * MOVE ANN-TBL-YRQ (ANN-SUB) TO MQTR-YRQ. DTSBU520
|
|
01053 * DTSBU520
|
|
01054 * MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
01055 * DTSBU520
|
|
01056 * PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
01057 * DTSBU520
|
|
01058 * MOVE MSKL-REC TO MQTR-REC. DTSBU520
|
|
01059 * DTSBU520
|
|
01060 * IF L910-OK-88 DTSBU520
|
|
01061 * MOVE ANN-TBL-IND (ANN-SUB) TO WRK-PREF-APPLIC-IND DTSBU520
|
|
01062 * PERFORM P5900-PROCESS-MQTR THRU P5900-EXIT. DTSBU520
|
|
01063 *P5221-EXIT. DTSBU520
|
|
01064 * EXIT. DTSBU520
|
|
01065 SKIP3 DTSBU520
|
|
01066 *P5500-LOCATE-NOT-MAPL-DEBIT. DTSBU520
|
|
01067 *****MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU520
|
|
01068 *****MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU520
|
|
01069 *****SET MQTR-QTR-88 TO TRUE. DTSBU520
|
|
01070 *****MOVE +0 TO MQTR-YRQ. DTSBU520
|
|
01071 *****MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
01072 *****PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU520
|
|
01073 *****PERFORM P5510-MQTR-SCAN THRU P5510-EXIT DTSBU520
|
|
01074 *********UNTIL (L910-NO-REC-88) DTSBU520
|
|
01075 *******************OR DTSBU520
|
|
01076 ***************(L521-APPLIC-AMT > +0). DTSBU520
|
|
01077 *P5500-EXIT. DTSBU520
|
|
01078 *****EXIT. DTSBU520
|
|
01079 SKIP3 DTSBU520
|
|
01080 *P5510-MQTR-SCAN. DTSBU520
|
|
01081 *****MOVE MSKL-REC TO MQTR-REC. DTSBU520
|
|
01082 DTSBU520
|
|
01083 *****MOVE LOW-VALUES TO MAPL-KEY-AREA. DTSBU520
|
|
01084 *****MOVE MPRF-EMP-NO TO MAPL-EMP-NO. DTSBU520
|
|
01085 *****SET MAPL-APL-88 TO TRUE. DTSBU520
|
|
01086 *****MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
01087 *****PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU520
|
|
01088 *****MOVE 'N' TO WRK-MQTR-IN-OPEN-MAPL. DTSBU520
|
|
01089 *****PERFORM P5511-MAPL-BROWSE THRU P5511-EXIT DTSBU520
|
|
01090 *********UNTIL (L910-NO-REC-88) DTSBU520
|
|
01091 *******************OR DTSBU520
|
|
01092 ***************(WRK-MQTR-IN-OPEN-MAPL = 'Y'). DTSBU520
|
|
01093 DTSBU520
|
|
01094 *****IF WRK-MQTR-IN-OPEN-MAPL = 'N' DTSBU520
|
|
01095 *********PERFORM P5900-PROCESS-MQTR THRU P5900-EXIT DTSBU520
|
|
01096 *********IF L521-APPLIC-AMT > +0 DTSBU520
|
|
01097 *************GO TO P5510-EXIT. DTSBU520
|
|
01098 DTSBU520
|
|
01099 *****MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU520
|
|
01100 *****PERFORM S910-READ THRU S910-EXIT. DTSBU520
|
|
01101 *****IF L910-NO-REC-88 DTSBU520
|
|
01102 *********DISPLAY 'DTSBU520:P5510:1' DTSBU520
|
|
01103 *********PERFORM S999-ABEND THRU S999-EXIT. DTSBU520
|
|
01104 DTSBU520
|
|
01105 *****PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU520
|
|
01106 *P5510-EXIT. DTSBU520
|
|
01107 *****EXIT. DTSBU520
|
|
01108 SKIP3 DTSBU520
|
|
01109 *P5511-MAPL-BROWSE. DTSBU520
|
|
01110 *****MOVE MSKL-REC TO MAPL-REC. DTSBU520
|
|
01111 DTSBU520
|
|
01112 *****PERFORM DTSBU520
|
|
01113 *******VARYING MAPL-COV-IDX FROM 1 BY 1 DTSBU520
|
|
01114 *******UNTIL MAPL-COV-IDX > MAPL-COVERED-CNT DTSBU520
|
|
01115 *********IF MAPL-COVERED-YRQ (MAPL-COV-IDX) = MQTR-YRQ DTSBU520
|
|
01116 *************MOVE 'Y' TO WRK-MQTR-IN-OPEN-MAPL DTSBU520
|
|
01117 *********END-IF DTSBU520
|
|
01118 *****END-PERFORM. DTSBU520
|
|
01119 DTSBU520
|
|
01120 *****PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU520
|
|
01121 *P5511-EXIT. DTSBU520
|
|
01122 *****EXIT. DTSBU520
|
|
01123 EJECT DTSBU520
|
|
01124 P5800-MQTR-SCAN. DTSBU520
|
|
01125 MOVE MSKL-REC TO MQTR-REC. DTSBU520
|
|
01126 DTSBU520
|
|
01127 ** IF L520-ANNUAL-RPT-WD-88 DTSBU520
|
|
01128 * MOVE MQTR-YRQ TO WRK-ANN-YRQ DTSBU520
|
|
01129 * IF WRK-ANN-CCYY = WRK-ANN-RPT-YEAR DTSBU520
|
|
01130 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU520
|
|
01131 * GO TO P5800-EXIT DTSBU520
|
|
01132 * END-IF DTSBU520
|
|
01133 ** END-IF. DTSBU520
|
|
01134 DTSBU520
|
|
01135 PERFORM P5900-PROCESS-MQTR THRU P5900-EXIT. DTSBU520
|
|
01136 DTSBU520
|
|
01137 IF L521-APPLIC-AMT > +0 DTSBU520
|
|
01138 MOVE MQTR-YRQ TO HOLD-MQTR-YRQ DTSBU520
|
|
01139 GO TO P5800-EXIT. DTSBU520
|
|
01140 DTSBU520
|
|
01141 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU520
|
|
01142 P5800-EXIT. DTSBU520
|
|
01143 EXIT. DTSBU520
|
|
01144 SKIP3 DTSBU520
|
|
01145 P5900-PROCESS-MQTR. DTSBU520
|
|
01146 ***** DTSBU520
|
|
01147 * DTSBU520
|
|
01148 * NOTE: IF ACCOUNT SEQUENCE (UI, SUR,ETC) IS MODIFIED DTSBU520
|
|
01149 * OR IF NEW ACCOUNTS ARE ADDED, THEN MAKE DTSBU520
|
|
01150 * CORRESPONDING MODIFICATIONS IN DTSBD372:P4221. DTSBU520
|
|
01151 * DTSBU520
|
|
01152 ***** DTSBU520
|
|
01153 DTSBU520
|
|
01154 *& DTSBU520
|
|
01155 IF MPRF-EMP-NO = 020852 OR 031484 DTSBU520
|
|
01156 MOVE HOLD-CREDIT-AMT TO AMT-DISP DTSBU520
|
|
01157 DISPLAY 'BU520 P5900 WRK-IND: ' DTSBU520
|
|
01158 WRK-PREF-APPLIC-IND ' ' MQTR-YRQ DTSBU520
|
|
01159 END-IF. DTSBU520
|
|
01160 *& DTSBU520
|
|
01161 MOVE +0 TO HOLD-ACCT-SUB. DTSBU520
|
|
01162 DTSBU520
|
|
01163 IF WRK-PREF-APPLIC-IND NOT = SPACE DTSBU520
|
|
01164 MOVE WRK-PREF-APPLIC-IND TO HOLD-ACCT-IND DTSBU520
|
|
01165 PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT DTSBU520
|
|
01166 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
01167 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU520
|
|
01168 DTSBU520
|
|
01169 IF HOLD-ACCT-SUB = +0 DTSBU520
|
|
01170 MOVE CACT-ACCT-UI TO HOLD-ACCT-IND DTSBU520
|
|
01171 PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT DTSBU520
|
|
01172 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
01173 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU520
|
|
01174 DTSBU520
|
|
01175 IF HOLD-ACCT-SUB = +0 DTSBU520
|
|
01176 MOVE CACT-ACCT-SUR TO HOLD-ACCT-IND DTSBU520
|
|
01177 PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT DTSBU520
|
|
01178 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
01179 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU520
|
|
01180 DTSBU520
|
|
01181 IF HOLD-ACCT-SUB = +0 DTSBU520
|
|
01182 MOVE CACT-ACCT-INT TO HOLD-ACCT-IND DTSBU520
|
|
01183 PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT DTSBU520
|
|
01184 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
01185 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU520
|
|
01186 DTSBU520
|
|
01187 IF HOLD-ACCT-SUB = +0 DTSBU520
|
|
01188 MOVE CACT-ACCT-LATE-PEN TO HOLD-ACCT-IND DTSBU520
|
|
01189 PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT DTSBU520
|
|
01190 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
01191 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU520
|
|
01192 DTSBU520
|
|
01193 IF HOLD-ACCT-SUB = +0 DTSBU520
|
|
01194 MOVE CACT-ACCT-NSF-PEN TO HOLD-ACCT-IND DTSBU520
|
|
01195 PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT DTSBU520
|
|
01196 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
01197 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU520
|
|
01198 DTSBU520
|
|
01199 IF HOLD-ACCT-SUB = +0 DTSBU520
|
|
01200 MOVE CACT-ACCT-MISC-PEN TO HOLD-ACCT-IND DTSBU520
|
|
01201 PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT DTSBU520
|
|
01202 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU520
|
|
01203 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU520
|
|
01204 DTSBU520
|
|
01205 IF HOLD-ACCT-SUB = +0 DTSBU520
|
|
01206 GO TO P5900-EXIT. DTSBU520
|
|
01207 DTSBU520
|
|
01208 DTSBU520
|
|
01209 IF MQTR-BALANCE-AMT (HOLD-ACCT-SUB) < HOLD-CREDIT-AMT DTSBU520
|
|
01210 MOVE MQTR-BALANCE-AMT (HOLD-ACCT-SUB) DTSBU520
|
|
01211 TO L521-APPLIC-AMT DTSBU520
|
|
01212 ELSE DTSBU520
|
|
01213 MOVE HOLD-CREDIT-AMT TO L521-APPLIC-AMT. DTSBU520
|
|
01214 DTSBU520
|
|
01215 MOVE MQTR-ACCT-IND (HOLD-ACCT-SUB) TO L521-APPLIC-ACCT-IND. DTSBU520
|
|
01216 DTSBU520
|
|
01217 MOVE MQTR-YRQ TO L521-APPLIC-YRQ. DTSBU520
|
|
01218 DTSBU520
|
|
01219 *& DTSBU520
|
|
01220 IF MPRF-EMP-NO = 020852 OR 031484 DTSBU520
|
|
01221 MOVE MQTR-BALANCE-AMT (HOLD-ACCT-SUB) TO AMT-DISP DTSBU520
|
|
01222 MOVE HOLD-CREDIT-AMT TO AMT-DISP1 DTSBU520
|
|
01223 MOVE L521-APPLIC-AMT TO AMT-DISP2 DTSBU520
|
|
01224 DISPLAY 'BU520 P5900: ' MQTR-YRQ DTSBU520
|
|
01225 ' ' MQTR-ACCT-IND (HOLD-ACCT-SUB) DTSBU520
|
|
01226 ' QBAL ' AMT-DISP ' HOLD ' AMT-DISP1 DTSBU520
|
|
01227 DISPLAY ' 521AMT ' AMT-DISP2 DTSBU520
|
|
01228 END-IF. DTSBU520
|
|
01229 *& DTSBU520
|
|
01230 P5900-EXIT. DTSBU520
|
|
01231 EXIT. DTSBU520
|
|
01232 SKIP3 DTSBU520
|
|
01233 P5910-SCAN-FOR-BALANCE. DTSBU520
|
|
01234 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = HOLD-ACCT-IND DTSBU520
|
|
01235 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 DTSBU520
|
|
01236 SET HOLD-ACCT-SUB TO MQTR-ACCT-IDX. DTSBU520
|
|
01237 P5910-EXIT. DTSBU520
|
|
01238 EXIT. DTSBU520
|
|
01239 EJECT DTSBU520
|
|
01240 S004-FROM-5. DTSBU520
|
|
01241 SET L004-FROM-5 TO TRUE. DTSBU520
|
|
01242 GO TO S004-QTR. DTSBU520
|
|
01243 DTSBU520
|
|
01244 S004-QTR. DTSBU520
|
|
01245 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU520
|
|
01246 S004-EXIT. DTSBU520
|
|
01247 EXIT. DTSBU520
|
|
01248 DTSBU520
|
|
01249 S521-APPLIC-PROCESS. DTSBU520
|
|
01250 CALL 'DTSBU521' USING L521-LINK-AREA DTSBU520
|
|
01251 LBCM-LINK-AREA DTSBU520
|
|
01252 MPRF-REC. DTSBU520
|
|
01253 S521-EXIT. DTSBU520
|
|
01254 EXIT. DTSBU520
|
|
01255 SKIP3 DTSBU520
|
|
01256 S542-MODIFY-MDST. DTSBU520
|
|
01257 MOVE 'DTSBU520' TO L542-CALLED-BY. DTSBU520
|
|
01258 MOVE LBCM-TRN-DOC-NO TO L542-TRN-DOC-NO. DTSBU520
|
|
01259 DTSBU520
|
|
01260 CALL 'DTSBU542' USING L542-LINK-AREA DTSBU520
|
|
01261 MPRF-REC DTSBU520
|
|
01262 MDST-REC. DTSBU520
|
|
01263 S542-EXIT. DTSBU520
|
|
01264 EXIT. DTSBU520
|
|
01265 SKIP3 DTSBU520
|
|
01266 *S590-CR-TOL. DTSBU520
|
|
01267 *****SET L590-CR-TOL-88 TO TRUE. DTSBU520
|
|
01268 *****MOVE +0 TO L590-YRQ. DTSBU520
|
|
01269 *****MOVE MDST-DOC-NO TO L590-PAY-DOC-NO. DTSBU520
|
|
01270 *****GO TO S590-EMP-CLEANUP. DTSBU520
|
|
01271 DTSBU520
|
|
01272 *S590-EMP-CLEANUP. DTSBU520
|
|
01273 *****MOVE LBCM-TRN-DOC-NO TO L590-TOL-DOC-NO. DTSBU520
|
|
01274 DTSBU520
|
|
01275 *****CALL 'DTSBU590' USING L590-LINK-AREA DTSBU520
|
|
01276 ***************************LBCM-LINK-AREA DTSBU520
|
|
01277 ***************************MPRF-REC. DTSBU520
|
|
01278 *S590-EXIT. DTSBU520
|
|
01279 *****EXIT. DTSBU520
|
|
01280 SKIP3 DTSBU520
|
|
01281 S910-READ. DTSBU520
|
|
01282 SET L910-READ-88 TO TRUE. DTSBU520
|
|
01283 GO TO S910-MSTR-IO. DTSBU520
|
|
01284 DTSBU520
|
|
01285 S910-START-BROWSE. DTSBU520
|
|
01286 SET L910-START-BROWSE-88 TO TRUE. DTSBU520
|
|
01287 GO TO S910-MSTR-IO. DTSBU520
|
|
01288 DTSBU520
|
|
01289 S910-READ-NEXT. DTSBU520
|
|
01290 SET L910-READ-NEXT-88 TO TRUE. DTSBU520
|
|
01291 GO TO S910-MSTR-IO. DTSBU520
|
|
01292 DTSBU520
|
|
01293 *S910-COUNT. DTSBU520
|
|
01294 *****SET L910-COUNT-88 TO TRUE. DTSBU520
|
|
01295 *****GO TO S910-MSTR-IO. DTSBU520
|
|
01296 DTSBU520
|
|
01297 S910-WRITE. DTSBU520
|
|
01298 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU520
|
|
01299 SET L910-WRITE-88 TO TRUE. DTSBU520
|
|
01300 GO TO S910-MSTR-IO. DTSBU520
|
|
01301 DTSBU520
|
|
01302 S910-REWRITE. DTSBU520
|
|
01303 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU520
|
|
01304 SET L910-REWRITE-88 TO TRUE. DTSBU520
|
|
01305 GO TO S910-MSTR-IO. DTSBU520
|
|
01306 DTSBU520
|
|
01307 S910-DELETE. DTSBU520
|
|
01308 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU520
|
|
01309 SET L910-DELETE-88 TO TRUE. DTSBU520
|
|
01310 GO TO S910-MSTR-IO. DTSBU520
|
|
01311 DTSBU520
|
|
01312 S910-MSTR-IO. DTSBU520
|
|
01313 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU520
|
|
01314 MSKL-REC. DTSBU520
|
|
01315 S910-EXIT. DTSBU520
|
|
01316 EXIT. DTSBU520
|
|
01317 SKIP3 DTSBU520
|
|
01318 S946-R907-WRITE. DTSBU520
|
|
01319 CALL 'DTSBU946' USING R907-REC. DTSBU520
|
|
01320 S946-EXIT. DTSBU520
|
|
01321 EXIT. DTSBU520
|
|
01322 SKIP3 DTSBU520
|
|
01323 S999-ABEND. DTSBU520
|
|
01324 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU520
|
|
01325 S999-EXIT. DTSBU520
|
|
01326 EXIT. DTSBU520
|