giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
DUTAS/Batch/DTSBD372.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

3318 lines
262 KiB
COBOL
Raw Permalink Blame History

00001 IDENTIFICATION DIVISION. 05/20/13
00002 PROGRAM-ID. DTSBD372. DTSBD372
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV072
00004 DATE-WRITTEN. JANUARY 1991. DTSBD372
00005 DATE-COMPILED. DTSBD372
00006 SKIP3 DTSBD372
00007 ***** DTSBD372
00008 * DTSBD372
00009 * DTSBD372
00010 * FUNCTION: PAYMENT TRANSACTION PROCESSING. DTSBD372
00011 * DTSBD372
00012 * DTSBD372
00013 * MODIFICATION LOG: DTSBD372
00014 * DTSBD372
00015 * 01/25/92 INITIAL DEVELOPMENT. DTSBD372
00016 * WORK ORDER: PROGRAMMER: TCL DTSBD372
00017 * DTSBD372
00018 * 05/19/95 ADD PAYMENT REVERSAL WHICH APPLIES UNIVERSALLY DTSBD372
00019 * TO THE EMPLOYER'S CREDITS. DTSBD372
00020 * WORK ORDER: CR077 PROGRAMMER: RHC DTSBD372
00021 * DTSBD372
00022 * 06/13/95 CHANGE TO CREDIT TOLERANCE LOGIC REMOVES IT FROM DTSBD372
00023 * THIS PROGRAM. DTSBD372
00024 * WORK ORDER: CR094 PROGRAMMER: RHC DTSBD372
00025 * DTSBD372
00026 * 12/19/1998 REVIEWED AND MODIFIED FOR DC. DTSBD372
00027 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD372
00028 * DTSBD372
00029 * 02/27/1999 MODIFIED FOR DC SELF INSURED EMPLOYER TAX DUE DTSBD372
00030 * DATE REQUIREMENT. DTSBD372
00031 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD372
00032 * DTSBD372
00033 * 03/27/1999 MODIFIED TO WRITE A MEVL RECORD OCCURRENCE DTSBD372
00034 * WHEN A REFUND IS PROCESSED. DTSBD372
00035 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD372
00036 * DTSBD372
00037 * 05/15/1999 ADD LOGIC TO PREVENT WRITING A NEW MQTR RECORD DTSBD372
00038 * WITH MQTR-YRQ <= LBCM-PICKUP-YRQ. DTSBD372
00039 * REFERENCE: PICKUP YRQ PROGRAMMER: EHH DTSBD372
00040 * DTSBD372
00041 * 07/28/1999 L102-TAX-DUE-DATE AND L102-RPT-DUE-DATE ADDED DTSBD372
00042 * TO DTSBU102 LINKAGE AREA. DTSBD372
00043 * REFERENCE: ORDERS FROM MS STERN PROGRAMM: EHH DTSBD372
00044 * DTSBD372
00045 * 08/26/1999 CHANGED THE NO-GOOD CHECK PENALTY AMOUNT FROM DTSBD372
00046 * $15.00 TO $50.00. THE WORKING-STORAGE DATA DTSBD372
00047 * ELEMENT AFFECTED IS NSF-AUTO-CHARGE-AMT. DTSBD372
00048 * REFERENCE: DIR00054 PROGRAMM: GD DTSBD372
00049 * DTSBD372
00050 * 02/22/2003 INITIALIZED L520-ANNUAL-RPT-IND IN P4000, DTSBD372
00051 * P6000, P7000. CORECTED PROBLEM THAT DTSBD372
00052 * RESULTED IN ABEND. DTSBD372
00053 * REFERENCE: PROGRAMM: GD DTSBD372
00054 * DTSBD372
00055 * 07/25/2003 CHANGED BOUNCED CHECK FEE TO $65.00 DTSBD372
00056 * REFERENCE: CHANGE IN DC FEE PROGRAMM: GD DTSBD372
00057 * DTSBD372
00058 * 03/25/2004 CHANGED BOUNCED CHECK FEE TO $75.00 DTSBD372
00059 * REFERENCE: CHANGE IN DC FEE PROGRAMM: GD DTSBD372
00060 * DTSBD372
00061 * 04/02/2004 CHANGED BOUNCED CHECK FEE BACK TO $65.00 DTSBD372
00062 * THE CHANGE TO $75.00 WAS ONLY A PROPOSAL, DTSBD372
00063 * AND NEVER WENT INTO EFFECT. DTSBD372
00064 * REFERENCE: CHANGE IN DC FEE PROGRAMM: GD DTSBD372
00065 * DTSBD372
00066 * DTSBD372
00067 * 01/25/2005 MODIFIED PROGRAM TO READ THE MNTE FILE FOR DTSBD372
00068 * A NSF RECORD. IF A NSF RECORD IS FOUND CREATE DTSBD372
00069 * A 319 BATCH RECORD TO INFORM EMPLOYER OF DTSBD372
00070 * RETRUNED CHECK. DTSBD372
00071 * REFERENCE: RETURNED CHECK PROGRAMM: ZL1 DTSBD372
00072 * DTSBD372
00073 * 03/21/2005 MODIFIED FOR NEW PENALTY REQUIREMENTS. DTSBD372
00074 * PASS RECEIVED DATE OF NG TRANSACTION RATHER DTSBD372
00075 * THAN RECEIVED DATE OF ORIGINAL PAYMENT TO DTSBD372
00076 * DTSBU102. DTSBD372
00077 * REFERENCE: DIR107 PROGRAMM: GD DTSBD372
00078 * DTSBD372
00079 * 11/08/2005 MODIFIED S6000 (MEVL) TO INCLUDE OPERATOR ID. DTSBD372
00080 * REFERENCE: PROGRAMM: GD DTSBD372
00081 * DTSBD372
00082 * 02/20/2006 PENALTY AND INTEREST CALCULATIONS MODIFIED DTSBD372
00083 * TO EXCLUDE SUR-TAX: P2031A, P2030, P2831A. DTSBD372
00084 * REFERENCE: ADMIN ASSESS PROGRAMMER: GD DTSBD372
00085 * DTSBD372
00086 * 09/10/2007 MODIFIED P4600 TO MOVE LBCM-CURR-RUN-DATE DTSBD372
00087 * TO NEW FIELD L102-CURR-RUN-DATE. DTSBD372
00088 * REFERENCE: PROGRAMMER: ZL1 DTSBD372
00089 * DTSBD372
00090 * 02/11/2008 TWO MODIFICATIONS: DTSBD372
00091 * CHANGED FOR NEW PENALTY AND INTEREST RULE: DTSBD372
00092 * ADMIN ASSESS INCLUDED IN P & I CALCULATION DTSBD372
00093 * FOR QTRS >= 2008/1 (ACTUAL START QTR IS DTSBD372
00094 * RETURNED FROM CALL TO DTSBU109). P4600. DTSBD372
00095 * AUTOMATIC REFUND REQUEST PROCESS: DTSBD372
00096 * ADDED CODE TO FORMAT MRFD RECORD AND BUILD DTSBD372
00097 * NEW VERSION OF R303 RECORD. DTSBD372
00098 * REFERENCE: PROGRAMMER: GD DTSBD372
00099 * DTSBD372
00100 * 08/19/2010 MODIFIED S2100 TO ADD THE CHECK SCAN DATE DTSBD372
00101 * AND CHECK SEQUENCE NUMBER TO THE MPAY RECORD. DTSBD372
00102 * THIS DATA EXISTS WHEN THE APAY TRANSACTION DTSBD372
00103 * WAS CREATED FROM THE WEB CHECK-SCANNING PROCESS. DTSBD372
00104 * REFERENCE: PROGRAMMER: GD DTSBD372
00105 * DTSBD372
00106 * 03/10/2011 MODIFIED FOR NP AND NR TRANSACTIONS FOR DTSBD372
00107 * NON-DOES CHECKS. DTSBD372
00108 * REFERENCE: PROGRAMMER: GD DTSBD372
00109 * DTSBD372
00110 * 04/12/2011 MODIFIED FOR NH (NON-DOES CHECK RETURNED DTSBD372
00111 * BY BANK) TRANSACTION. DTSBD372
00112 * REFERENCE: PROGRAMMER: GD DTSBD372
00113 * DTSBD372
00114 * DTSBD372
00115 * 09/14/2012 REMOVED CHANGES FOR NH (NON-DOES CHECK RETURNED DTSBD372
00116 * BY BANK) TRANSACTION. DTSBD372
00117 * REFERENCE: PROGRAMMER: ZL1 DTSBD372
00118 * DTSBD372
00119 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD372
00120 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD372
00121 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD372
00122 * DTSBD372
00123 * DTSBD372
00124 * DESCRIPTION: DTSBD372
00125 * DTSBD372
00126 * PROCESS ACCOUNTING PAYMENT TRANSACTIONS. DTSBD372
00127 * DTSBD372
00128 * DTSBD372
00129 * MASTER FILE RECORDS READ: DTSBD372
00130 * DTSBD372
00131 * MQTR DTSBD372
00132 * MRPT DTSBD372
00133 * MPAY DTSBD372
00134 * MDST DTSBD372
00135 * MREV DTSBD372
00136 * DTSBD372
00137 * DTSBD372
00138 * MASTER FILE RECORDS UPDATED: DTSBD372
00139 * DTSBD372
00140 * MQTR (WRITE, REWRITE) DTSBD372
00141 * MPAY (WRITE, REWRITE) DTSBD372
00142 * MDST (WRITE, REWRITE, DELETE) DTSBD372
00143 * MREV (WRITE, REWRITE, DELETE) DTSBD372
00144 * MTCK (WRITE) DTSBD372
00145 * DTSBD372
00146 * DTSBD372
00147 * REPORT RECORDS WRITTEN: DTSBD372
00148 * DTSBD372
00149 * R303 REFUND REQUEST. DTSBD372
00150 * R318 EFT PAYMENT REPORT. DTSBD372
00151 * R907 ERROR. DTSBD372
00152 * DTSBD372
00153 * DTSBD372
00154 * MODULES CALLED: DTSBD372
00155 * DTSBD372
00156 * DTSBU001 DATE EDIT AND CONVERSION. DTSBD372
00157 * DTSBU004 QUARTER EDIT AND CONVERSION. DTSBD372
00158 * DTSBU111 LOOKUP ADDRESS. DTSBD372
00159 * DTSBU112 FORMAT ADDRESS. DTSBD372
00160 * DTSBU511 MQTR RECORD INITIALIZATION. DTSBD372
00161 * DTSBU516 LOOKUP LIABILITY INFORMATION FOR GIVEN DTSBD372
00162 * EMPLOYER IN A SPECIFIED QUARTER. DTSBD372
00163 * DTSBU520 PAYMENT APPLICATION. DTSBD372
00164 * DTSBU521 APPLY/REVERSE A PAYMENT DISTRIBUTION. DTSBD372
00165 * DTSBU530 WRITE OFF/REVERSE WRITE OFF PROCESSING. DTSBD372
00166 * DTSBU541 MODIFY A SPECIFIED CHARGED, WAIVED, TOLERATED, DTSBD372
00167 * OR WRITTEN OFF AMOUNT. DTSBD372
00168 * DTSBU542 MDST MAINTENANCE. DTSBD372
00169 * DTSBU590 EMPLOYER CLEANUP. DTSBD372
00170 * DTSBU910 MASTER FILE I/O. DTSBD372
00171 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD372
00172 * DTSBD372
00173 ***** DTSBD372
00174 SKIP3 DTSBD372
00175 ENVIRONMENT DIVISION. DTSBD372
00176 INPUT-OUTPUT SECTION. DTSBD372
00177 DTSBD372
00178 FILE-CONTROL. DTSBD372
00179 DTSBD372
00180 SELECT X306-EXP-FILE ASSIGN TO DTSFX306 DTSBD372
00181 FILE STATUS IS X306-STATUS. DTSBD372
00182 DTSBD372
00183 EJECT DTSBD372
00184 DATA DIVISION. DTSBD372
00185 FILE SECTION. DTSBD372
00186 DTSBD372
00187 FD X306-EXP-FILE DTSBD372
00188 RECORDING MODE IS F DTSBD372
00189 BLOCK CONTAINS 0 RECORDS DTSBD372
00190 LABEL RECORDS ARE OMITTED. DTSBD372
00191 DTSBD372
00192 01 X306-REC PIC X(109). DTSBD372
00193 SKIP3 DTSBD372
00194 WORKING-STORAGE SECTION. DTSBD372
001945 77 PAN-VALET PICTURE X(24) VALUE '072DTSBD372 05/20/13'. DTSBD372
00195 77 PAN-VALET PICTURE X(24) VALUE '001DTSBD372 05/09/13'. DTSBD372
00196 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD372 03/14/13'. DTSBD372
00197 77 PAN-VALET PICTURE X(24) VALUE '070DTSBD372 10/10/12'. DTSBD372
00198 77 PAN-VALET PICTURE X(24) VALUE '009DTSBD372 09/18/12'. DTSBD372
00199 SKIP3 DTSBD372
00200 01 WRK-AREA. DTSBD372
00201 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +372.DTSBD372
00202 DTSBD372
00203 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD372'.DTSBD372
00204 DTSBD372
00205 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD372
00206 DTSBD372
00207 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBD372
00208 VALUE +999999999. DTSBD372
00209 DTSBD372
00210 05 X306-STATUS PIC X(02). DTSBD372
00211 88 X306-STATUS-OK-88 VALUE '00'. DTSBD372
00212 DTSBD372
00213 05 NSF-AUTO-CHARGE-AMT PIC S9(03)V9(02) COMP-3 DTSBD372
00214 VALUE +65.00. DTSBD372
00215 DTSBD372
00216 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBD372
00217 DTSBD372
00218 05 WRK-NULL-DOC-NO. DTSBD372
00219 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. DTSBD372
00220 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. DTSBD372
00221 DTSBD372
00222 DTSBD372
00223 05 WRK-AMT1 PIC S9(09)V9(02) COMP-3. DTSBD372
00224 05 WRK-REMIT-AMT PIC S9(09)V9(02) VALUE ZEROS. DTSBD372
00225 DTSBD372
00226 05 WRK-DSTRB-AVAIL-AMT PIC S9(09)V9(02) COMP-3. DTSBD372
00227 DTSBD372
00228 05 WRK-DSTRB-CREDIT-AMT PIC S9(09)V9(02) COMP-3. DTSBD372
00229 DTSBD372
00230 05 WRK-DSTRB-REFUND-AMT PIC S9(09)V9(02) COMP-3. DTSBD372
00231 DTSBD372
00232 05 WRK-REFUND-AMT PIC S9(09)V9(02) COMP-3. DTSBD372
00233 DTSBD372
00234 05 WRK-ACCUM-AMT PIC S9(09)V9(02) COMP-3. DTSBD372
00235 DTSBD372
00236 05 WRK-MREV-AMT PIC S9(09)V9(02) COMP-3. DTSBD372
00237 DTSBD372
00238 05 WRK-TIMELY-PAYMENTS PIC S9(09)V9(02) COMP-3. DTSBD372
00239 DTSBD372
00240 05 PRE-UPDATE-WRITE-OFF-DATE PIC S9(09) COMP-3. DTSBD372
00241 88 PRE-UPDATE-NOT-WRITTEN-OFF-88 VALUE +0. DTSBD372
00242 DTSBD372
00243 05 WRK-REVERSE-TYPE-IND PIC X(01). DTSBD372
00244 88 WRK-REVERSE-INT-88 VALUE 'I'. DTSBD372
00245 88 WRK-REVERSE-ALL-88 VALUE 'A'. DTSBD372
00246 DTSBD372
00247 05 WRK-ACCT-IND PIC X(02). DTSBD372
00248 88 WRK-ACCT-CREDIT-AVAIL VALUE 'CA'. DTSBD372
00249 88 WRK-ACCT-CREDIT-TOL VALUE 'CT'. DTSBD372
00250 DTSBD372
00251 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3. DTSBD372
00252 DTSBD372
00253 05 WRK-MRFD-DATA. DTSBD372
00254 10 WRK-CFO-AGENCY PIC X(03) VALUE 'UIU'. DTSBD372
00255 10 WRK-CFO-TYPE PIC X(01) VALUE 'X'. DTSBD372
00256 10 WRK-REFUND-DATE PIC 9(08). DTSBD372
00257 10 WRK-CFO-BATCH-NO PIC 9(03) VALUE ZERO. DTSBD372
00258 10 WRK-CFO-SEQ-NO PIC 9(05) VALUE ZERO. DTSBD372
00259 10 WRK-CURR-DOC-NO. DTSBD372
00260 15 FILLER PIC X(02) VALUE 'VI'. DTSBD372
00261 15 WRK-VOUCHER-NO PIC 9(06). DTSBD372
00262 10 WRK-CFO-CURR-DOC-NO-SFX PIC X(03) VALUE '001'. DTSBD372
00263 05 WRK-MHDR-VOUCHER-NO PIC 9(08). DTSBD372
00264 05 FILLER REDEFINES WRK-MHDR-VOUCHER-NO. DTSBD372
00265 10 FILLER PIC X(02). DTSBD372
00266 10 WRK-MHDR-VOUCHER-NO-6 PIC 9(06). DTSBD372
00267 05 WRK-JUL-DATE PIC 9(07). DTSBD372
00268 05 FILLER REDEFINES WRK-JUL-DATE. DTSBD372
00269 10 FILLER PIC X(04). DTSBD372
00270 10 WRK-JUL-DATE-3 PIC 9(03). DTSBD372
00271 DTSBD372
00272 05 WRK-MNTE-NSF-DATA. DTSBD372
00273 07 WRK-MNTE-TEXT-LINE1 PIC X(72) VALUE SPACES. DTSBD372
00274 07 WRK-MNTE-TEXT-LINE2 PIC X(72) VALUE SPACES. DTSBD372
00275 07 WRK-MNTE-TEXT-LINE3. DTSBD372
00276 10 DESC-LINE1 PIC X(16) VALUE SPACES. DTSBD372
00277 10 DESC-LINE1-DATE. DTSBD372
00278 12 WRK-MNTE-CHECK-MO PIC X(02) VALUE SPACES. DTSBD372
00279 12 SLASH1 PIC X(01) VALUE '/'. DTSBD372
00280 12 WRK-MNTE-CHECK-DA PIC X(02) VALUE SPACES. DTSBD372
00281 12 SLASH2 PIC X(01) VALUE '/'. DTSBD372
00282 12 WRK-MNTE-CHECK-YR PIC X(02) VALUE SPACES. DTSBD372
00283 10 FILLER PIC X(48) VALUE SPACES. DTSBD372
00284 07 WRK-MNTE-TEXT-LINE4. DTSBD372
00285 10 DESC-LINE2 PIC X(16) VALUE SPACES. DTSBD372
00286 10 WRK-MNTE-CHECK-NO PIC 9(10) VALUE ZEROS. DTSBD372
00287 10 FILLER PIC X(49) VALUE SPACES. DTSBD372
00288 07 WRK-MNTE-TEXT-LINE5. DTSBD372
00289 10 DESC-LINE3 PIC X(16) VALUE SPACES. DTSBD372
00290 10 WRK-MNTE-REASON PIC X(56). DTSBD372
00291 07 WRK-MNTE-TEXT-LINE6. DTSBD372
00292 10 DESC-LINE4 PIC X(16) VALUE SPACES. DTSBD372
00293 10 WRK-MNTE-REASON-DESC PIC X(55) VALUE SPACES. DTSBD372
00294 05 WRK-MDST-DOC-NO PIC X(05). DTSBD372
00295 DTSBD372
00296 05 DSTRB-MODIFY-IND PIC X(01). DTSBD372
00297 DTSBD372
00298 05 WRK-DSTRB-MATCHED-IND PIC X(01). DTSBD372
00299 DTSBD372
00300 05 HOLD-MDST-SUB PIC S9(04) COMP. DTSBD372
00301 DTSBD372
00302 05 WRK-LAST-USED-REFUND-NO PIC 9(08). DTSBD372
00303 05 FILLER REDEFINES WRK-LAST-USED-REFUND-NO. DTSBD372
00304 10 WRK-LAST-USED-REFUND-PREFIX PIC 9(04). DTSBD372
00305 10 WRK-LAST-USED-REFUND-SUFFIX PIC 9(04). DTSBD372
00306 DTSBD372
00307 05 WRK-AMT-DISP PIC --------9.99. DTSBD372
00308 05 WRK-DISPLAY-REFUND-AMT-X PIC X(14). DTSBD372
00309 05 WRK-DISPLAY-REFUND-AMT DTSBD372
00310 REDEFINES WRK-DISPLAY-REFUND-AMT-X DTSBD372
00311 PIC ZZZZZZ,ZZ9.99-. DTSBD372
00312 DTSBD372
00313 05 WRK-LAST-OR-RECEIVED-DATE PIC S9(09) COMP-3. DTSBD372
00314 DTSBD372
00315 05 WRK-TIMELY-SI-PAY-AMT PIC S9(09)V99 COMP-3. DTSBD372
00316 DTSBD372
00317 05 LATE-PEN-SUB PIC S9(04) COMP. DTSBD372
00318 DTSBD372
00319 05 NSF-PEN-SUB PIC S9(04) COMP. DTSBD372
00320 DTSBD372
00321 05 WRK-PURSUED-RPT-IND PIC X(01). DTSBD372
00322 DTSBD372
00323 DTSBD372
00324 05 WRK-RVR-OCCURS-MAX PIC S9(04) COMP DTSBD372
00325 VALUE +400. DTSBD372
00326 DTSBD372
00327 05 WRK-RVR-OCCURS-SUB PIC S9(04) COMP. DTSBD372
00328 DTSBD372
00329 05 WRK-RVR-OCCURS-CNT PIC S9(04) COMP. DTSBD372
00330 DTSBD372
00331 05 WRK-RVR-HOLD-AREA OCCURS 400 TIMES DTSBD372
00332 INDEXED BY WRK-RVR-IDX. DTSBD372
00333 10 WRK-RVR-YRQ PIC S9(05) COMP-3. DTSBD372
00334 10 WRK-RVR-AMT PIC S9(09)V9(02) COMP-3. DTSBD372
00335 DTSBD372
00336 05 WRK-RVR-MAX-YRQ PIC S9(05) COMP-3. DTSBD372
00337 DTSBD372
00338 05 WRK-RVR-MAX-AMT PIC S9(09)V9(02) COMP-3. DTSBD372
00339 DTSBD372
00340 DTSBD372
00341 05 WRK-TRIGGER-DATE PIC S9(09) COMP-3. DTSBD372
00342 DTSBD372
00343 05 WRK-APPLIC-TRACE-NO PIC S9(13) COMP-3. DTSBD372
00344 DTSBD372
00345 DTSBD372
00346 05 EVL-TEXT PIC X(50). DTSBD372
00347 EJECT DTSBD372
00348 01 MSG-TABLE. DTSBD372
00349 05 MSG1-INVALID-TRN-CD. DTSBD372
00350 10 MSG1-ID PIC X(11) VALUE 'DTSBD372321'. DTSBD372
00351 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'INVALID PAY TY'. DTSBD372
00352 10 MSG1-LONG-TEXT. DTSBD372
00353 15 FILLER PIC X(30) DTSBD372
00354 VALUE 'TRANSACTION FAILED - PAYMENT T'. DTSBD372
00355 15 FILLER PIC X(30) DTSBD372
00356 VALUE 'YPE NOT VALID '. DTSBD372
00357 DTSBD372
00358 05 MSG2-DUPLICATE-TRAN. DTSBD372
00359 10 MSG2-ID PIC X(11) VALUE 'DTSBD372307'. DTSBD372
00360 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'DUPLICATE TRAN'. DTSBD372
00361 10 MSG2-LONG-TEXT. DTSBD372
00362 15 FILLER PIC X(30) DTSBD372
00363 VALUE 'TRANSACTION FAILED - DUPLICATE'. DTSBD372
00364 15 FILLER PIC X(30) DTSBD372
00365 VALUE ' TRANSACTION '. DTSBD372
00366 DTSBD372
00367 05 MSG3-INVALID-REMIT-AMT. DTSBD372
00368 10 MSG3-ID PIC X(11) VALUE 'DTSBD372323'. DTSBD372
00369 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'INVLID RMT AMT'. DTSBD372
00370 10 MSG3-LONG-TEXT. DTSBD372
00371 15 FILLER PIC X(30) DTSBD372
00372 VALUE 'TRANSACTION FAILED - REMIT AMO'. DTSBD372
00373 15 FILLER PIC X(30) DTSBD372
00374 VALUE 'UNT NOT VALID '. DTSBD372
00375 DTSBD372
00376 05 MSG4-ORIG-PAY-INVALID. DTSBD372
00377 10 MSG4-ID PIC X(11) VALUE 'DTSBD372324'. DTSBD372
00378 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'ORG PAY INVLID'. DTSBD372
00379 10 MSG4-LONG-TEXT. DTSBD372
00380 15 FILLER PIC X(30) DTSBD372
00381 VALUE 'TRANSACTION FAILED - NOT COMPA'. DTSBD372
00382 15 FILLER PIC X(30) DTSBD372
00383 VALUE 'TIBLE WITH ORIGINAL PAYMENT '. DTSBD372
00384 DTSBD372
00385 05 MSG5-INVALID-MPAY-APPLIC. DTSBD372
00386 10 MSG5-ID PIC X(11) VALUE 'DTSBD372325'. DTSBD372
00387 10 MSG5-SHORT-TEXT PIC X(20) VALUE 'MPAY APPLY ERR'. DTSBD372
00388 10 MSG5-LONG-TEXT. DTSBD372
00389 15 FILLER PIC X(30) DTSBD372
00390 VALUE 'TRANSACTION FAILED - INCONSIST'. DTSBD372
00391 15 FILLER PIC X(30) DTSBD372
00392 VALUE 'ENT PAYMENT APPLY ENCOUNTERED '. DTSBD372
00393 DTSBD372
00394 05 MSG6-RPTS-PURSUED. DTSBD372
00395 10 MSG6-ID PIC X(11) VALUE 'DTSBD372326'. DTSBD372
00396 10 MSG6-SHORT-TEXT PIC X(20) VALUE 'MISSING REPORT'. DTSBD372
00397 10 MSG6-LONG-TEXT. DTSBD372
00398 15 FILLER PIC X(30) DTSBD372
00399 VALUE 'TRANSACTION FAILED - REPORT(S)'. DTSBD372
00400 15 FILLER PIC X(30) DTSBD372
00401 VALUE ' ARE PURSUED BY COLLECTIONS '. DTSBD372
00402 DTSBD372
00403 05 MSG7-UNWRITE-OFF. DTSBD372
00404 10 MSG7-ID. DTSBD372
00405 15 MSG7-ID1 PIC X(08) VALUE 'DTSBD372'. DTSBD372
00406 15 MSG7-ID2 PIC X(03) VALUE '327'. DTSBD372
00407 10 MSG7-SHORT-TEXT PIC X(20) VALUE 'SUSP/UNWRITE-OFF'.DTSBD372
00408 10 MSG7-LONG-TEXT. DTSBD372
00409 15 FILLER PIC X(30) DTSBD372
00410 VALUE 'SUSP REVERSED / PAY APPLIED / '. DTSBD372
00411 15 FILLER PIC X(30) DTSBD372
00412 VALUE 'IF NECESSARY, SUSP REAPPLIED '. DTSBD372
00413 DTSBD372
00414 05 MSG8-NO-REFUND-VOUCHER. DTSBD372
00415 10 MSG8-ID. DTSBD372
00416 15 MSG8-ID1 PIC X(08) VALUE 'DTSBD372'. DTSBD372
00417 15 MSG8-ID2 PIC X(03) VALUE '328'. DTSBD372
00418 10 MSG8-SHORT-TEXT PIC X(20) DTSBD372
00419 VALUE 'NO REFUND VOUCHER'. DTSBD372
00420 10 MSG8-LONG-TEXT. DTSBD372
00421 15 FILLER PIC X(30) DTSBD372
00422 VALUE 'TRANSACTION FAILED - ALL REFUN'. DTSBD372
00423 15 FILLER PIC X(30) DTSBD372
00424 VALUE 'D VOUCHER NUMBERS EXPENDED '. DTSBD372
00425 DTSBD372
00426 05 MSG9-ESTIMATED-RATE. DTSBD372
00427 10 MSG9-ID. DTSBD372
00428 15 MSG9-ID1 PIC X(08) VALUE 'DTSBD372'. DTSBD372
00429 15 MSG9-ID2 PIC X(03) VALUE '329'. DTSBD372
00430 10 MSG9-SHORT-TEXT PIC X(20) DTSBD372
00431 VALUE 'ESTIMATED RATE '. DTSBD372
00432 10 MSG9-LONG-TEXT. DTSBD372
00433 15 FILLER PIC X(30) DTSBD372
00434 VALUE 'QUARTER ADDED WITH ESTIMATED R'. DTSBD372
00435 15 FILLER PIC X(12) DTSBD372
00436 VALUE 'ATE. YRQ = '. DTSBD372
00437 15 MSG9-YRQ PIC 9(05). DTSBD372
00438 DTSBD372
00439 05 MSG10-NON-DOES-EMP-ONLY. DTSBD372
00440 10 MSG10-ID. DTSBD372
00441 15 MSG10-ID1 PIC X(08) VALUE 'DTSBD372'. DTSBD372
00442 15 MSG10-ID2 PIC X(03) VALUE '330'. DTSBD372
00443 10 MSG10-SHORT-TEXT PIC X(20) DTSBD372
00444 VALUE 'NON-DOES EMP ONLY'. DTSBD372
00445 10 MSG10-LONG-TEXT. DTSBD372
00446 15 FILLER PIC X(30) DTSBD372
00447 VALUE 'NP TRANS ONLY FOR NON-DOES ACC'. DTSBD372
00448 15 FILLER PIC X(12) DTSBD372
00449 VALUE 'OUNT NBR. '. DTSBD372
00450 DTSBD372
00451 05 MSG11-DOC-NO-REQUIRED. DTSBD372
00452 10 MSG11-ID. DTSBD372
00453 15 MSG11-ID1 PIC X(08) VALUE 'DTSBD372'. DTSBD372
00454 15 MSG11-ID2 PIC X(03) VALUE '331'. DTSBD372
00455 10 MSG11-SHORT-TEXT PIC X(20) DTSBD372
00456 VALUE 'DOC NO REQUIRED '. DTSBD372
00457 10 MSG11-LONG-TEXT. DTSBD372
00458 15 FILLER PIC X(30) DTSBD372
00459 VALUE 'DOC NUMBER REQUIRED FOR NR TRA'. DTSBD372
00460 15 FILLER PIC X(12) DTSBD372
00461 VALUE 'NSATION. '. DTSBD372
00462 DTSBD372
00463 EJECT DTSBD372
00464 01 EVL-TABLE. DTSBD372
00465 05 EVL1-TEXT. DTSBD372
00466 10 FILLER PIC X(21) DTSBD372
00467 VALUE 'REFUND PROCESSED. #: '. DTSBD372
00468 10 EVL1-CURR-DOC-NO PIC X(08). DTSBD372
00469 10 FILLER PIC X(07) DTSBD372
00470 VALUE ' AMT:'. DTSBD372
00471 10 EVL1-REFUND-AMT PIC ZZZZZZ,ZZ9.99-. DTSBD372
00472 EJECT DTSBD372
00473 01 L910-LINK-AREA. DTSBD372
00474 ++INCLUDE DTSIL910 DTSBD372
00475 SKIP3 DTSBD372
00476 01 L810-LINK-AREA. DTSBD372
00477 ++INCLUDE DTSIL810 DTSBD372
00478 SKIP3 DTSBD372
00479 01 MSKL-REC. DTSBD372
00480 ++INCLUDE DTSIMSKL DTSBD372
00481 SKIP3 DTSBD372
00482 01 MPAY-REC. DTSBD372
00483 ++INCLUDE DTSIMPAY DTSBD372
00484 SKIP3 DTSBD372
00485 01 MDST-REC. DTSBD372
00486 ++INCLUDE DTSIMDST DTSBD372
00487 SKIP3 DTSBD372
00488 01 MNTE-REC. DTSBD372
00489 ++INCLUDE DTSIMNTE DTSBD372
00490 SKIP3 DTSBD372
00491 01 MREV-REC. DTSBD372
00492 ++INCLUDE DTSIMREV DTSBD372
00493 SKIP3 DTSBD372
00494 01 MQTR-REC. DTSBD372
00495 ++INCLUDE DTSIMQTR DTSBD372
00496 SKIP3 DTSBD372
00497 01 MRPT-REC. DTSBD372
00498 ++INCLUDE DTSIMRPT DTSBD372
00499 SKIP3 DTSBD372
00500 01 MRFD-REC. DTSBD372
00501 ++INCLUDE DTSIMRFD DTSBD372
00502 SKIP3 DTSBD372
00503 01 MTCK-REC. DTSBD372
00504 ++INCLUDE DTSIMTCK DTSBD372
00505 SKIP3 DTSBD372
00506 01 MEVL-REC. DTSBD372
00507 ++INCLUDE DTSIMEVL DTSBD372
00508 EJECT DTSBD372
00509 01 L001-LINK-AREA. DTSBD372
00510 ++INCLUDE DTSIL001 DTSBD372
00511 SKIP3 DTSBD372
00512 01 L004-LINK-AREA. DTSBD372
00513 ++INCLUDE DTSIL004 DTSBD372
00514 SKIP3 DTSBD372
00515 01 L005-LINK-AREA. DTSBD372
00516 ++INCLUDE DTSIL005 DTSBD372
00517 SKIP3 DTSBD372
00518 01 L061-LINK-AREA. DTSBD372
00519 ++INCLUDE DTSIL061 DTSBD372
00520 DTSBD372
00521 01 L102-LINK-AREA. DTSBD372
00522 ++INCLUDE DTSIL102 DTSBD372
00523 SKIP3 DTSBD372
00524 01 L109-LINK-AREA. DTSBD372
00525 ++INCLUDE DTSIL109 DTSBD372
00526 SKIP3 DTSBD372
00527 01 L111-LINK-AREA. DTSBD372
00528 ++INCLUDE DTSIL111 DTSBD372
00529 SKIP3 DTSBD372
00530 01 L112-LINK-AREA. DTSBD372
00531 ++INCLUDE DTSIL112 DTSBD372
00532 SKIP3 DTSBD372
00533 01 L516-LINK-AREA. DTSBD372
00534 ++INCLUDE DTSIL516 DTSBD372
00535 SKIP3 DTSBD372
00536 01 L520-LINK-AREA. DTSBD372
00537 ++INCLUDE DTSIL520 DTSBD372
00538 SKIP3 DTSBD372
00539 01 L521-LINK-AREA. DTSBD372
00540 ++INCLUDE DTSIL521 DTSBD372
00541 SKIP3 DTSBD372
00542 01 L530-LINK-AREA. DTSBD372
00543 ++INCLUDE DTSIL530 DTSBD372
00544 SKIP3 DTSBD372
00545 01 L541-LINK-AREA. DTSBD372
00546 ++INCLUDE DTSIL541 DTSBD372
00547 SKIP3 DTSBD372
00548 01 L542-LINK-AREA. DTSBD372
00549 ++INCLUDE DTSIL542 DTSBD372
00550 SKIP3 DTSBD372
00551 01 L590-LINK-AREA. DTSBD372
00552 ++INCLUDE DTSIL590 DTSBD372
00553 EJECT DTSBD372
00554 01 R303-REC. DTSBD372
00555 ++INCLUDE DTSIR303 DTSBD372
00556 SKIP3 DTSBD372
00557 01 R318-REC. DTSBD372
00558 ++INCLUDE DTSIR318 DTSBD372
00559 SKIP3 DTSBD372
00560 01 R319-REC. DTSBD372
00561 ++INCLUDE DTSIR319 DTSBD372
00562 SKIP3 DTSBD372
00563 01 R907-REC. DTSBD372
00564 ++INCLUDE DTSIR907 DTSBD372
00565 EJECT DTSBD372
00566 01 WRK-X306-REC. DTSBD372
00567 ++INCLUDE DTSIX306 DTSBD372
00568 EJECT DTSBD372
00569 01 MMAX-LITERALS. DTSBD372
00570 ++INCLUDE DTSIMMAX DTSBD372
00571 SKIP3 DTSBD372
00572 01 CACT-LITERALS. DTSBD372
00573 ++INCLUDE DTSICACT DTSBD372
00574 EJECT DTSBD372
00575 LINKAGE SECTION. DTSBD372
00576 SKIP3 DTSBD372
00577 01 LBCM-LINK-AREA. DTSBD372
00578 ++INCLUDE DTSILBCM DTSBD372
00579 EJECT DTSBD372
00580 01 MPRF-REC. DTSBD372
00581 ++INCLUDE DTSIMPRF DTSBD372
00582 EJECT DTSBD372
00583 01 APAY-REC. DTSBD372
00584 ++INCLUDE DTSIAPAY DTSBD372
00585 EJECT DTSBD372
00586 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD372
00587 MPRF-REC DTSBD372
00588 APAY-REC. DTSBD372
00589 DTSBD372
00590 DTSBD372
00591 IF FIRST-TIME-IND = 'Y' DTSBD372
00592 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBD372
00593 MOVE 'N' TO FIRST-TIME-IND. DTSBD372
00594 DTSBD372
00595 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD372
00596 DTSBD372
00597 DTSBD372
00598 GOBACK. DTSBD372
00599 EJECT DTSBD372
00600 I0000-FIRST-TIME. DTSBD372
00601 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD372
00602 DTSBD372
00603 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD372
00604 R907-MODULE-NAME. DTSBD372
00605 DTSBD372
00606 MOVE LENGTH OF R303-REC TO R303-LENGTH. DTSBD372
00607 DTSBD372
00608 MOVE LENGTH OF R318-REC TO R318-LENGTH. DTSBD372
00609 MOVE LENGTH OF R319-REC TO R319-LENGTH. DTSBD372
00610 DTSBD372
00611 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD372
00612 DTSBD372
00613 MOVE +0 TO WRK-NULL-BATCH-NO DTSBD372
00614 WRK-NULL-ITEM-NO. DTSBD372
00615 DTSBD372
00616 *& COMMENTED OUT UNTIL DTSBU109 IS MOVED TO PROD. DTSBD372
00617 * PERFORM S109-PEN-INT-START-YRQ THRU S109-EXIT. DTSBD372
00618 * MOVE L109-PEN-INT-START-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBD372
00619 MOVE 20081 TO WRK-FIRST-PEN-INT-YRQ. DTSBD372
00620 *& DTSBD372
00621 DTSBD372
00622 PERFORM I1000-CFO-REFUND-DATA THRU I1000-EXIT. DTSBD372
00623 DTSBD372
00624 PERFORM I2000-OPEN-FILE THRU I2000-EXIT. DTSBD372
00625 DTSBD372
00626 I0000-EXIT. DTSBD372
00627 EXIT. DTSBD372
00628 EJECT DTSBD372
00629 I1000-CFO-REFUND-DATA. DTSBD372
00630 MOVE LBCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBD372
00631 MOVE L001-FED-8-DATE-X TO WRK-REFUND-DATE. DTSBD372
00632 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD372
00633 MOVE L001-JUL-DATE TO WRK-JUL-DATE. DTSBD372
00634 ** IF L001-FED-8-MO > 09 DTSBD372
00635 * MOVE L001-FED-8-YR TO WRK-FISCAL-YEAR DTSBD372
00636 * ELSE DTSBD372
00637 * SUBTRACT 1 FROM L001-FED-8-YR DTSBD372
00638 * MOVE L001-FED-8-YR TO WRK-FISCAL-YEAR DTSBD372
00639 ** END-IF. DTSBD372
00640 MOVE WRK-JUL-DATE-3 TO WRK-CFO-BATCH-NO. DTSBD372
00641 MOVE ZERO TO WRK-CFO-SEQ-NO. DTSBD372
00642 DTSBD372
00643 DISPLAY 'CFO REFUND DATA:'. DTSBD372
00644 DISPLAY ' DATE ' WRK-REFUND-DATE. DTSBD372
00645 DISPLAY ' BATCH ' WRK-CFO-BATCH-NO. DTSBD372
00646 ** DISPLAY ' FISCAL YR ' WRK-FISCAL-YEAR. DTSBD372
00647 DTSBD372
00648 I1000-EXIT. DTSBD372
00649 EXIT. DTSBD372
00650 DTSBD372
00651 I2000-OPEN-FILE. DTSBD372
00652 OPEN OUTPUT X306-EXP-FILE. DTSBD372
00653 IF X306-STATUS-OK-88 DTSBD372
00654 NEXT SENTENCE DTSBD372
00655 ELSE DTSBD372
00656 DISPLAY 'CANNOT OPEN X306 EXPORT FILE ' DTSBD372
00657 X306-STATUS DTSBD372
00658 PERFORM S999-ABEND THRU S999-EXIT DTSBD372
00659 END-IF. DTSBD372
00660 DTSBD372
00661 I2000-EXIT. DTSBD372
00662 EXIT. DTSBD372
00663 DTSBD372
00664 P0000-PROCESS. DTSBD372
00665 MOVE ZERO TO WRK-APPLIC-TRACE-NO. DTSBD372
00666 DTSBD372
00667 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBD372
00668 DTSBD372
00669 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBD372
00670 DTSBD372
00671 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBD372
00672 DTSBD372
00673 SET MPAY-PAY-88 TO TRUE. DTSBD372
00674 DTSBD372
00675 MOVE APAY-DOC-NO TO MPAY-DOC-NO. DTSBD372
00676 DTSBD372
00677 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
00678 DTSBD372
00679 PERFORM S910-READ THRU S910-EXIT. DTSBD372
00680 DTSBD372
00681 IF L910-OK-88 DTSBD372
00682 MOVE MSG2-DUPLICATE-TRAN TO LBCM-TRN-MSG-AREA DTSBD372
00683 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00684 GO TO P0000-EXIT. DTSBD372
00685 DTSBD372
00686 DTSBD372
00687 PERFORM P1000-EDIT THRU P1000-EXIT. DTSBD372
00688 DTSBD372
00689 IF LBCM-TRN-NOT-OK-88 DTSBD372
00690 GO TO P0000-EXIT. DTSBD372
00691 DTSBD372
00692 DTSBD372
00693 SET LBCM-EMP-ACCOUNTING-YES-88 TO TRUE. DTSBD372
00694 DTSBD372
00695 MOVE MPRF-WRITE-OFF-DATE TO PRE-UPDATE-WRITE-OFF-DATE. DTSBD372
00696 DTSBD372
00697 IF PRE-UPDATE-NOT-WRITTEN-OFF-88 DTSBD372
00698 NEXT SENTENCE DTSBD372
00699 ELSE DTSBD372
00700 MOVE PRE-UPDATE-WRITE-OFF-DATE TO L530-WRITE-OFF-DATE DTSBD372
00701 PERFORM S530-REVERSE-WRITE-OFF THRU S530-EXIT. DTSBD372
00702 DTSBD372
00703 PERFORM P2000-UPDATE THRU P2000-EXIT. DTSBD372
00704 DTSBD372
00705 IF PRE-UPDATE-NOT-WRITTEN-OFF-88 DTSBD372
00706 NEXT SENTENCE DTSBD372
00707 ELSE DTSBD372
00708 MOVE PRE-UPDATE-WRITE-OFF-DATE TO L530-WRITE-OFF-DATE DTSBD372
00709 PERFORM S530-WRITE-OFF THRU S530-EXIT DTSBD372
00710 MOVE MSG7-ID2 TO R907-MSG-ID DTSBD372
00711 MOVE MSG7-LONG-TEXT TO R907-MSG-TEXT DTSBD372
00712 PERFORM S946-R907-WRITE THRU S946-EXIT. DTSBD372
00713 P0000-EXIT. DTSBD372
00714 EXIT. DTSBD372
00715 EJECT DTSBD372
00716 P1000-EDIT. DTSBD372
00717 MOVE APAY-PAY-TYPE TO MPAY-PAY-TYPE. DTSBD372
00718 DTSBD372
00719 EVALUATE TRUE DTSBD372
00720 WHEN MPAY-PAYMENT-88 DTSBD372
00721 PERFORM P1100-PAYMENT-EDIT THRU P1100-EXIT DTSBD372
00722 DTSBD372
00723 WHEN APAY-PAY-REV-88 DTSBD372
00724 OR APAY-NG-CHECK-88 DTSBD372
00725 OR APAY-NON-DOES-REV-88 DTSBD372
00726 * OR APAY-NON-DOES-NSF-88 DTSBD372
00727 PERFORM P1200-PAY-REV-EDIT THRU P1200-EXIT DTSBD372
00728 DTSBD372
00729 WHEN APAY-REFUND-88 DTSBD372
00730 PERFORM P1300-REFUND-EDIT THRU P1300-EXIT DTSBD372
00731 DTSBD372
00732 WHEN APAY-REF-REV-88 DTSBD372
00733 PERFORM P1400-REF-REV-EDIT THRU P1400-EXIT DTSBD372
00734 DTSBD372
00735 WHEN OTHER DTSBD372
00736 MOVE MSG1-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA DTSBD372
00737 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00738 END-EVALUATE. DTSBD372
00739 DTSBD372
00740 P1000-EXIT. DTSBD372
00741 EXIT. DTSBD372
00742 EJECT DTSBD372
00743 P1100-PAYMENT-EDIT. DTSBD372
00744 IF APAY-REMIT-AMT <= +0 DTSBD372
00745 MOVE MSG3-INVALID-REMIT-AMT TO LBCM-TRN-MSG-AREA DTSBD372
00746 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00747 GO TO P1100-EXIT DTSBD372
00748 END-IF. DTSBD372
00749 DTSBD372
00750 IF APAY-NON-DOES-PAY-88 DTSBD372
00751 IF APAY-EMP-NO NOT = LBCM-NON-DOES-EMP-NO DTSBD372
00752 MOVE MSG10-NON-DOES-EMP-ONLY TO LBCM-TRN-MSG-AREA DTSBD372
00753 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00754 GO TO P1100-EXIT DTSBD372
00755 END-IF DTSBD372
00756 END-IF. DTSBD372
00757 DTSBD372
00758 P1100-EXIT. DTSBD372
00759 EXIT. DTSBD372
00760 EJECT DTSBD372
00761 P1200-PAY-REV-EDIT. DTSBD372
00762 IF APAY-REMIT-AMT >= +0 DTSBD372
00763 MOVE MSG3-INVALID-REMIT-AMT TO LBCM-TRN-MSG-AREA DTSBD372
00764 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00765 GO TO P1200-EXIT DTSBD372
00766 END-IF. DTSBD372
00767 DTSBD372
00768 IF APAY-NON-DOES-REV-88 DTSBD372
00769 * OR APAY-NON-DOES-NSF-88 DTSBD372
00770 IF APAY-EMP-NO NOT = LBCM-NON-DOES-EMP-NO DTSBD372
00771 MOVE MSG10-NON-DOES-EMP-ONLY TO LBCM-TRN-MSG-AREA DTSBD372
00772 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00773 GO TO P1200-EXIT DTSBD372
00774 END-IF DTSBD372
00775 IF APAY-APPLIC-DOC-NO = WRK-NULL-DOC-NO DTSBD372
00776 MOVE MSG11-DOC-NO-REQUIRED TO LBCM-TRN-MSG-AREA DTSBD372
00777 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00778 GO TO P1200-EXIT DTSBD372
00779 END-IF DTSBD372
00780 END-IF. DTSBD372
00781 DTSBD372
00782 IF APAY-APPLIC-DOC-NO NOT = WRK-NULL-DOC-NO DTSBD372
00783 PERFORM S1100-READ-APAY-APPLIC THRU S1100-EXIT DTSBD372
00784 IF L910-NO-REC-88 DTSBD372
00785 OR NOT MPAY-PAYMENT-88 DTSBD372
00786 MOVE MSG4-ORIG-PAY-INVALID TO LBCM-TRN-MSG-AREA DTSBD372
00787 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00788 GO TO P1200-EXIT DTSBD372
00789 ELSE DTSBD372
00790 MOVE MPAY-TRACE-NO TO WRK-APPLIC-TRACE-NO. DTSBD372
00791 DTSBD372
00792 COMPUTE WRK-AMT1 = APAY-REMIT-AMT * -1. DTSBD372
00793 DTSBD372
00794 MOVE +0 TO WRK-DSTRB-AVAIL-AMT. DTSBD372
00795 DTSBD372
00796 PERFORM P1210-AVAILABILITY-CHECK THRU P1210-EXIT. DTSBD372
00797 DTSBD372
00798 IF LBCM-TRN-NOT-OK-88 DTSBD372
00799 GO TO P1200-EXIT. DTSBD372
00800 DTSBD372
00801 IF WRK-AMT1 > WRK-DSTRB-AVAIL-AMT DTSBD372
00802 MOVE MSG5-INVALID-MPAY-APPLIC TO LBCM-TRN-MSG-AREA DTSBD372
00803 SET LBCM-TRN-NOT-OK-88 TO TRUE. DTSBD372
00804 P1200-EXIT. DTSBD372
00805 EXIT. DTSBD372
00806 SKIP3 DTSBD372
00807 P1210-AVAILABILITY-CHECK. DTSBD372
00808 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
00809 DTSBD372
00810 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
00811 DTSBD372
00812 SET MDST-DST-88 TO TRUE. DTSBD372
00813 DTSBD372
00814 IF APAY-APPLIC-DOC-NO = WRK-NULL-DOC-NO DTSBD372
00815 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
00816 DTSBD372
00817 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
00818 DTSBD372
00819 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
00820 DTSBD372
00821 PERFORM P1211-SCAN-MDST THRU P1211-EXIT DTSBD372
00822 UNTIL L910-NO-REC-88. DTSBD372
00823 P1210-EXIT. DTSBD372
00824 EXIT. DTSBD372
00825 SKIP3 DTSBD372
00826 P1211-SCAN-MDST. DTSBD372
00827 MOVE MSKL-REC TO MDST-REC. DTSBD372
00828 DTSBD372
00829 IF APAY-APPLIC-DOC-NO = MDST-DOC-NO DTSBD372
00830 OR APAY-APPLIC-DOC-NO = WRK-NULL-DOC-NO DTSBD372
00831 PERFORM P1212-SCAN-ACCT THRU P1212-EXIT DTSBD372
00832 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
00833 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD372
00834 DTSBD372
00835 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
00836 DTSBD372
00837 PERFORM S910-READ THRU S910-EXIT. DTSBD372
00838 DTSBD372
00839 IF L910-NO-REC-88 DTSBD372
00840 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
00841 DTSBD372
00842 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
00843 P1211-EXIT. DTSBD372
00844 EXIT. DTSBD372
00845 SKIP3 DTSBD372
00846 P1212-SCAN-ACCT. DTSBD372
00847 MOVE 'N' TO WRK-DSTRB-MATCHED-IND. DTSBD372
00848 DTSBD372
00849 IF MDST-CREDIT-REC-88 DTSBD372
00850 PERFORM P1213-CREDIT-REC THRU P1213-EXIT DTSBD372
00851 ELSE DTSBD372
00852 PERFORM P1214-NOT-CREDIT-REC THRU P1214-EXIT. DTSBD372
00853 DTSBD372
00854 IF WRK-DSTRB-MATCHED-IND = 'Y' DTSBD372
00855 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-DSTRB-AVAIL-AMT. DTSBD372
00856 P1212-EXIT. DTSBD372
00857 EXIT. DTSBD372
00858 SKIP3 DTSBD372
00859 P1213-CREDIT-REC. DTSBD372
00860 IF (MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)) DTSBD372
00861 OR DTSBD372
00862 (MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX)) DTSBD372
00863 NEXT SENTENCE DTSBD372
00864 ELSE DTSBD372
00865 GO TO P1213-EXIT. DTSBD372
00866 DTSBD372
00867 IF APAY-APPLIC-YRQ = +0 DTSBD372
00868 NEXT SENTENCE DTSBD372
00869 ELSE DTSBD372
00870 GO TO P1213-EXIT. DTSBD372
00871 DTSBD372
00872 IF (APAY-APPLIC-IND = SPACES) DTSBD372
00873 OR DTSBD372
00874 (APAY-CREDIT-88) DTSBD372
00875 MOVE 'Y' TO WRK-DSTRB-MATCHED-IND. DTSBD372
00876 P1213-EXIT. DTSBD372
00877 EXIT. DTSBD372
00878 SKIP3 DTSBD372
00879 P1214-NOT-CREDIT-REC. DTSBD372
00880 IF (APAY-APPLIC-YRQ = +0) DTSBD372
00881 OR DTSBD372
00882 (APAY-APPLIC-YRQ = MDST-YRQ) DTSBD372
00883 NEXT SENTENCE DTSBD372
00884 ELSE DTSBD372
00885 GO TO P1214-EXIT. DTSBD372
00886 DTSBD372
00887 IF (APAY-APPLIC-IND = SPACES) DTSBD372
00888 OR DTSBD372
00889 (APAY-APPLIC-IND = MDST-ACCT-IND (MDST-ACCT-IDX)) DTSBD372
00890 NEXT SENTENCE DTSBD372
00891 ELSE DTSBD372
00892 GO TO P1214-EXIT. DTSBD372
00893 DTSBD372
00894 *& DTSBD372
00895 IF MPRF-EMP-NO = 046599 DTSBD372
00896 MOVE L521-APPLIC-AMT TO WRK-AMT-DISP DTSBD372
00897 DISPLAY 'DTSBD372 P1214 CALL BU520 ' MPRF-EMP-NO DTSBD372
00898 ' DOC ' MDST-DOC-NO DTSBD372
00899 ' YRQ ' MDST-YRQ DTSBD372
00900 ' IND ' MDST-ACCT-IND (MDST-ACCT-IDX) DTSBD372
00901 ' AMT ' WRK-AMT-DISP DTSBD372
00902 END-IF. DTSBD372
00903 *& DTSBD372
00904 MOVE MDST-DOC-NO TO L521-MPAY-DOC-NO. DTSBD372
00905 DTSBD372
00906 MOVE MDST-RECEIVED-DATE TO L521-RECEIVED-DATE. DTSBD372
00907 DTSBD372
00908 SET L521-WAIVE-INT-NO-88 TO TRUE. DTSBD372
00909 DTSBD372
00910 COMPUTE L521-APPLIC-AMT = MDST-AMT (MDST-ACCT-IDX) * -1. DTSBD372
00911 DTSBD372
00912 MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO L521-APPLIC-ACCT-IND. DTSBD372
00913 DTSBD372
00914 MOVE MDST-YRQ TO L521-APPLIC-YRQ. DTSBD372
00915 DTSBD372
00916 PERFORM S521-DSTRB-CHECK THRU S521-EXIT. DTSBD372
00917 DTSBD372
00918 IF L521-VALID-88 DTSBD372
00919 MOVE 'Y' TO WRK-DSTRB-MATCHED-IND DTSBD372
00920 ELSE DTSBD372
00921 MOVE MSG5-INVALID-MPAY-APPLIC TO LBCM-TRN-MSG-AREA DTSBD372
00922 SET LBCM-TRN-NOT-OK-88 TO TRUE. DTSBD372
00923 P1214-EXIT. DTSBD372
00924 EXIT. DTSBD372
00925 EJECT DTSBD372
00926 P1300-REFUND-EDIT. DTSBD372
00927 IF APAY-REMIT-AMT >= +0 DTSBD372
00928 MOVE MSG3-INVALID-REMIT-AMT TO LBCM-TRN-MSG-AREA DTSBD372
00929 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00930 GO TO P1300-EXIT. DTSBD372
00931 DTSBD372
00932 COMPUTE WRK-AMT1 = APAY-REMIT-AMT * -1. DTSBD372
00933 DTSBD372
00934 IF WRK-AMT1 > MPRF-TOT-CREDIT-AMT DTSBD372
00935 MOVE MSG3-INVALID-REMIT-AMT TO LBCM-TRN-MSG-AREA DTSBD372
00936 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00937 GO TO P1300-EXIT. DTSBD372
00938 DTSBD372
00939 *****IF MPRF-PURSUED-RPT-CNT > +0 DTSBD372
00940 *********MOVE MSG6-RPTS-PURSUED TO LBCM-TRN-MSG-AREA DTSBD372
00941 *********SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00942 *********GO TO P1300-EXIT. DTSBD372
00943 DTSBD372
00944 MOVE +0 TO WRK-DSTRB-CREDIT-AMT. DTSBD372
00945 DTSBD372
00946 PERFORM P1310-AVAILABILITY-CHECK THRU P1310-EXIT. DTSBD372
00947 DTSBD372
00948 IF WRK-DSTRB-CREDIT-AMT < WRK-AMT1 DTSBD372
00949 MOVE MSG5-INVALID-MPAY-APPLIC TO LBCM-TRN-MSG-AREA DTSBD372
00950 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00951 GO TO P1300-EXIT. DTSBD372
00952 DTSBD372
00953 MOVE LBCM-LAST-USED-REFUND-NO TO WRK-LAST-USED-REFUND-NO. DTSBD372
00954 DTSBD372
00955 IF WRK-LAST-USED-REFUND-SUFFIX = 9999 DTSBD372
00956 MOVE MSG8-NO-REFUND-VOUCHER TO LBCM-TRN-MSG-AREA DTSBD372
00957 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
00958 GO TO P1300-EXIT. DTSBD372
00959 P1300-EXIT. DTSBD372
00960 EXIT. DTSBD372
00961 SKIP3 DTSBD372
00962 P1310-AVAILABILITY-CHECK. DTSBD372
00963 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
00964 DTSBD372
00965 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
00966 DTSBD372
00967 SET MDST-DST-88 TO TRUE. DTSBD372
00968 DTSBD372
00969 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
00970 DTSBD372
00971 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
00972 DTSBD372
00973 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
00974 DTSBD372
00975 PERFORM P1311-SCAN-MDST THRU P1311-EXIT DTSBD372
00976 UNTIL L910-NO-REC-88. DTSBD372
00977 P1310-EXIT. DTSBD372
00978 EXIT. DTSBD372
00979 SKIP3 DTSBD372
00980 P1311-SCAN-MDST. DTSBD372
00981 MOVE MSKL-REC TO MDST-REC. DTSBD372
00982 DTSBD372
00983 IF MDST-CREDIT-REC-88 DTSBD372
00984 NEXT SENTENCE DTSBD372
00985 ELSE DTSBD372
00986 SET L910-NO-REC-88 TO TRUE DTSBD372
00987 GO TO P1311-EXIT. DTSBD372
00988 DTSBD372
00989 PERFORM DTSBD372
00990 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
00991 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
00992 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBD372
00993 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-DSTRB-CREDIT-AMT DTSBD372
00994 END-IF DTSBD372
00995 END-PERFORM. DTSBD372
00996 DTSBD372
00997 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
00998 P1311-EXIT. DTSBD372
00999 EXIT. DTSBD372
01000 EJECT DTSBD372
01001 P1400-REF-REV-EDIT. DTSBD372
01002 IF APAY-REMIT-AMT <= +0 DTSBD372
01003 MOVE MSG3-INVALID-REMIT-AMT TO LBCM-TRN-MSG-AREA DTSBD372
01004 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
01005 GO TO P1400-EXIT. DTSBD372
01006 DTSBD372
01007 PERFORM S1100-READ-APAY-APPLIC THRU S1100-EXIT. DTSBD372
01008 DTSBD372
01009 IF L910-NO-REC-88 DTSBD372
01010 MOVE MSG4-ORIG-PAY-INVALID TO LBCM-TRN-MSG-AREA DTSBD372
01011 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
01012 GO TO P1400-EXIT. DTSBD372
01013 DTSBD372
01014 COMPUTE WRK-AMT1 = APAY-REMIT-AMT * -1. DTSBD372
01015 DTSBD372
01016 IF (MPAY-REFUND-88) DTSBD372
01017 AND DTSBD372
01018 (MPAY-REMIT-AMT = WRK-AMT1) DTSBD372
01019 NEXT SENTENCE DTSBD372
01020 ELSE DTSBD372
01021 MOVE MSG4-ORIG-PAY-INVALID TO LBCM-TRN-MSG-AREA DTSBD372
01022 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD372
01023 GO TO P1400-EXIT. DTSBD372
01024 DTSBD372
01025 MOVE +0 TO WRK-DSTRB-REFUND-AMT. DTSBD372
01026 DTSBD372
01027 PERFORM P1410-AVAILABILITY-CHECK THRU P1410-EXIT. DTSBD372
01028 DTSBD372
01029 IF WRK-DSTRB-REFUND-AMT NOT = APAY-REMIT-AMT DTSBD372
01030 MOVE MSG5-INVALID-MPAY-APPLIC TO LBCM-TRN-MSG-AREA DTSBD372
01031 SET LBCM-TRN-NOT-OK-88 TO TRUE. DTSBD372
01032 P1400-EXIT. DTSBD372
01033 EXIT. DTSBD372
01034 SKIP3 DTSBD372
01035 P1410-AVAILABILITY-CHECK. DTSBD372
01036 MOVE LOW-VALUES TO MREV-KEY-AREA. DTSBD372
01037 DTSBD372
01038 MOVE MPRF-EMP-NO TO MREV-EMP-NO. DTSBD372
01039 DTSBD372
01040 SET MREV-REV-88 TO TRUE. DTSBD372
01041 DTSBD372
01042 MOVE MREV-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01043 DTSBD372
01044 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
01045 DTSBD372
01046 PERFORM P1411-SCAN-MREV THRU P1411-EXIT DTSBD372
01047 UNTIL L910-NO-REC-88. DTSBD372
01048 P1410-EXIT. DTSBD372
01049 EXIT. DTSBD372
01050 SKIP3 DTSBD372
01051 P1411-SCAN-MREV. DTSBD372
01052 MOVE MSKL-REC TO MREV-REC. DTSBD372
01053 DTSBD372
01054 IF APAY-APPLIC-DOC-NO = MREV-PU-RF-PR-DOC-NO DTSBD372
01055 IF MREV-REFUND-88 DTSBD372
01056 PERFORM P1412-CHECK-PAYMENT THRU P1412-EXIT. DTSBD372
01057 DTSBD372
01058 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
01059 P1411-EXIT. DTSBD372
01060 EXIT. DTSBD372
01061 SKIP3 DTSBD372
01062 P1412-CHECK-PAYMENT. DTSBD372
01063 MOVE LOW-VALUES TO MPAY-DOC-NO. DTSBD372
01064 DTSBD372
01065 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBD372
01066 DTSBD372
01067 SET MPAY-PAY-88 TO TRUE. DTSBD372
01068 DTSBD372
01069 MOVE MREV-PA-DOC-NO TO MPAY-DOC-NO. DTSBD372
01070 DTSBD372
01071 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01072 DTSBD372
01073 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01074 DTSBD372
01075 IF L910-OK-88 DTSBD372
01076 MOVE MSKL-REC TO MPAY-REC DTSBD372
01077 IF MPAY-PAYMENT-88 DTSBD372
01078 ADD MREV-AMT TO WRK-DSTRB-REFUND-AMT. DTSBD372
01079 DTSBD372
01080 MOVE MREV-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01081 DTSBD372
01082 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01083 DTSBD372
01084 IF L910-NO-REC-88 DTSBD372
01085 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
01086 P1412-EXIT. DTSBD372
01087 EXIT. DTSBD372
01088 EJECT DTSBD372
01089 P2000-UPDATE. DTSBD372
01090 MOVE APAY-PAY-TYPE TO MPAY-PAY-TYPE. DTSBD372
01091 DTSBD372
01092 EVALUATE TRUE DTSBD372
01093 WHEN MPAY-PAYMENT-88 DTSBD372
01094 PERFORM P3000-PAYMENT-UPDATE THRU P3000-EXIT DTSBD372
01095 DTSBD372
01096 WHEN APAY-PAY-REV-88 DTSBD372
01097 AND APAY-APPLIC-DOC-NO = WRK-NULL-DOC-NO DTSBD372
01098 PERFORM P7000-UNIV-PR-UPDATE THRU P7000-EXIT DTSBD372
01099 DTSBD372
01100 WHEN APAY-PAY-REV-88 DTSBD372
01101 OR APAY-NG-CHECK-88 DTSBD372
01102 OR APAY-NON-DOES-REV-88 DTSBD372
01103 * OR APAY-NON-DOES-NSF-88 DTSBD372
01104 PERFORM P4000-PAY-REV-UPDATE THRU P4000-EXIT DTSBD372
01105 DTSBD372
01106 WHEN APAY-REFUND-88 DTSBD372
01107 PERFORM P5000-REFUND-UPDATE THRU P5000-EXIT DTSBD372
01108 DTSBD372
01109 WHEN APAY-REF-REV-88 DTSBD372
01110 PERFORM P6000-REF-REV-UPDATE THRU P6000-EXIT DTSBD372
01111 DTSBD372
01112 WHEN OTHER DTSBD372
01113 PERFORM S999-ABEND THRU S999-EXIT DTSBD372
01114 END-EVALUATE. DTSBD372
01115 DTSBD372
01116 P2000-EXIT. DTSBD372
01117 EXIT. DTSBD372
01118 EJECT DTSBD372
01119 P3000-PAYMENT-UPDATE. DTSBD372
01120 PERFORM S2100-MPAY-FROM-APAY THRU S2100-EXIT. DTSBD372
01121 DTSBD372
01122 MOVE MPAY-REC TO MSKL-REC. DTSBD372
01123 DTSBD372
01124 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
01125 DTSBD372
01126 ******************************** DTSBD372
01127 * WRITE R318 RECORD FOR EFT PAYMENTS. EXCLUDE PAYMENTS DTSBD372
01128 * ASSOCIATED WITH REPORTS. DTSBD372
01129 ******************************** DTSBD372
01130 IF MPAY-PA-PAY-88 DTSBD372
01131 AND MPAY-TRACE-NO > ZERO DTSBD372
01132 PERFORM P3100-WRITE-R318 THRU P3100-EXIT. DTSBD372
01133 DTSBD372
01134 PERFORM S3100-INITIALIZE-MDST THRU S3100-EXIT. DTSBD372
01135 DTSBD372
01136 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. DTSBD372
01137 DTSBD372
01138 MOVE MPAY-REMIT-AMT TO L542-AMT. DTSBD372
01139 DTSBD372
01140 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBD372
01141 DTSBD372
01142 PERFORM S4100-MDST-UPDATE THRU S4100-EXIT. DTSBD372
01143 DTSBD372
01144 DTSBD372
01145 IF APAY-APPLIC-YRQ = +0 DTSBD372
01146 SET L520-NO-PREF-88 TO TRUE DTSBD372
01147 ELSE DTSBD372
01148 IF APAY-APPLIC-IND = SPACES DTSBD372
01149 SET L520-PREF-YRQ-88 TO TRUE DTSBD372
01150 ELSE DTSBD372
01151 SET L520-PREF-YRQ-IND-88 TO TRUE. DTSBD372
01152 DTSBD372
01153 *& DTSBD372
01154 * IF MPRF-EMP-NO = 046599 DTSBD372
01155 * DISPLAY 'DTSBD372 P3000 CALL BU520 ' MPRF-EMP-NO DTSBD372
01156 * ' DOC ' APAY-DOC-NO DTSBD372
01157 * ' YRQ ' APAY-APPLIC-YRQ DTSBD372
01158 * ' IND ' APAY-APPLIC-IND DTSBD372
01159 * ' ANN ' APAY-ANNUAL-RPT-IND DTSBD372
01160 * END-IF. DTSBD372
01161 *& DTSBD372
01162 MOVE APAY-DOC-NO TO L520-PREF-PAY-DOC-NO. DTSBD372
01163 DTSBD372
01164 MOVE APAY-APPLIC-YRQ TO L520-PREF-APPLIC-YRQ. DTSBD372
01165 DTSBD372
01166 MOVE APAY-APPLIC-IND TO L520-PREF-APPLIC-IND. DTSBD372
01167 DTSBD372
01168 MOVE APAY-ANNUAL-RPT-IND TO L520-ANNUAL-RPT-IND. DTSBD372
01169 DTSBD372
01170 MOVE ZERO TO L520-WITHDRAW-ANN-YRQ. DTSBD372
01171 DTSBD372
01172 SET L520-LAST-ANN-QTR-NULL-88 TO TRUE. DTSBD372
01173 DTSBD372
01174 *& MOVE WRK-FIRST-PEN-INT-YRQ TO L520-FIRST-PEN-INT-YRQ. DTSBD372
01175 DTSBD372
01176 PERFORM S520-APPLY-CREDIT THRU S520-EXIT. DTSBD372
01177 P3000-EXIT. DTSBD372
01178 EXIT. DTSBD372
01179 DTSBD372
01180 P3100-WRITE-R318. DTSBD372
01181 MOVE MPRF-EMP-NO TO R318-EMP-NO. DTSBD372
01182 DTSBD372
01183 IF MPRF-MDPC-EXISTS-88 DTSBD372
01184 SET R318-RPT-TYPE-DPC-88 TO TRUE DTSBD372
01185 ELSE DTSBD372
01186 SET R318-RPT-TYPE-REG-88 TO TRUE. DTSBD372
01187 DTSBD372
01188 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBD372
01189 MOVE L061-FLD-REP-ID TO R318-FIELD-REP-ID. DTSBD372
01190 DTSBD372
01191 MOVE LBCM-CURR-RUN-DATE TO R318-RUN-DATE. DTSBD372
01192 DTSBD372
01193 MOVE MPAY-DOC-NO TO R318-DOC-NO. DTSBD372
01194 DTSBD372
01195 MOVE MPAY-TRACE-NO TO R318-TRACE-NO. DTSBD372
01196 DTSBD372
01197 MOVE MPAY-REMIT-AMT TO R318-REMIT-AMT. DTSBD372
01198 DTSBD372
01199 MOVE ZERO TO R318-APPLIC-BATCH-NO DTSBD372
01200 R318-APPLIC-ITEM-NO. DTSBD372
01201 DTSBD372
01202 *& DTSBD372
01203 DISPLAY 'BD372 P3100 CALL S946'. DTSBD372
01204 *& DTSBD372
01205 PERFORM S946-R318-WRITE THRU S946-EXIT. DTSBD372
01206 DTSBD372
01207 P3100-EXIT. DTSBD372
01208 EXIT. DTSBD372
01209 EJECT DTSBD372
01210 P4000-PAY-REV-UPDATE. DTSBD372
01211 COMPUTE WRK-AMT1 = APAY-REMIT-AMT * -1. DTSBD372
01212 DTSBD372
01213 MOVE +0 TO WRK-RVR-OCCURS-CNT. DTSBD372
01214 DTSBD372
01215 PERFORM P4100-REVERSE-DSTRB THRU P4100-EXIT DTSBD372
01216 UNTIL WRK-AMT1 NOT > +0. DTSBD372
01217 DTSBD372
01218 PERFORM S2100-MPAY-FROM-APAY THRU S2100-EXIT. DTSBD372
01219 DTSBD372
01220 MOVE MPAY-REC TO MSKL-REC. DTSBD372
01221 DTSBD372
01222 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
01223 DTSBD372
01224 ******************************** DTSBD372
01225 * WRITE R318 RECORD FOR EFT REVERSALS. DTSBD372
01226 ******************************** DTSBD372
01227 IF WRK-APPLIC-TRACE-NO > ZERO DTSBD372
01228 PERFORM P4800-WRITE-R318 THRU P4800-EXIT. DTSBD372
01229 DTSBD372
01230 DTSBD372
01231 PERFORM S3200-INITIALIZE-MREV THRU S3200-EXIT. DTSBD372
01232 DTSBD372
01233 MOVE APAY-APPLIC-DOC-NO TO MREV-PA-DOC-NO. DTSBD372
01234 DTSBD372
01235 EVALUATE TRUE DTSBD372
01236 WHEN APAY-NG-CHECK-88 DTSBD372
01237 SET MREV-NG-CHECK-88 TO TRUE DTSBD372
01238 WHEN APAY-NON-DOES-REV-88 DTSBD372
01239 SET MREV-NON-DOES-REV-88 TO TRUE DTSBD372
01240 * WHEN APAY-NON-DOES-NSF-88 DTSBD372
01241 * SET MREV-NON-DOES-NSF-88 TO TRUE DTSBD372
01242 WHEN OTHER DTSBD372
01243 SET MREV-REVERSE-88 TO TRUE DTSBD372
01244 END-EVALUATE. DTSBD372
01245 DTSBD372
01246 COMPUTE MREV-AMT = APAY-REMIT-AMT * -1. DTSBD372
01247 DTSBD372
01248 MOVE MREV-REC TO MSKL-REC. DTSBD372
01249 DTSBD372
01250 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
01251 DTSBD372
01252 DTSBD372
01253 IF APAY-NG-CHECK-88 DTSBD372
01254 DTSBD372
01255 DISPLAY 'APAY NG ' APAY-EMP-NO ' ' APAY-BATCH-NO ' ' DTSBD372
01256 APAY-ITEM-NO ' ' APAY-RECEIVED-DATE DTSBD372
01257 DTSBD372
01258 PERFORM P4600-LATE-PAY-PEN THRU P4600-EXIT DTSBD372
01259 PERFORM P4700-NSF-PENALTY THRU P4700-EXIT DTSBD372
01260 PERFORM P4900-WRITE-R319 THRU P4900-EXIT. DTSBD372
01261 DTSBD372
01262 DTSBD372
01263 SET L520-NO-PREF-88 TO TRUE. DTSBD372
01264 SET L520-ANNUAL-RPT-NULL-88 TO TRUE. DTSBD372
01265 MOVE ZERO TO L520-WITHDRAW-ANN-YRQ. DTSBD372
01266 SET L520-LAST-ANN-QTR-NULL-88 TO TRUE. DTSBD372
01267 DTSBD372
01268 MOVE WRK-NULL-DOC-NO TO L520-PREF-PAY-DOC-NO. DTSBD372
01269 DTSBD372
01270 MOVE +0 TO L520-PREF-APPLIC-YRQ. DTSBD372
01271 DTSBD372
01272 MOVE SPACE TO L520-PREF-APPLIC-IND. DTSBD372
01273 DTSBD372
01274 PERFORM S520-APPLY-CREDIT THRU S520-EXIT. DTSBD372
01275 P4000-EXIT. DTSBD372
01276 EXIT. DTSBD372
01277 SKIP3 DTSBD372
01278 P4100-REVERSE-DSTRB. DTSBD372
01279 MOVE +0 TO HOLD-MDST-SUB. DTSBD372
01280 DTSBD372
01281 PERFORM P4200-LOCATE-DSTRB THRU P4200-EXIT. DTSBD372
01282 DTSBD372
01283 IF HOLD-MDST-SUB = +0 DTSBD372
01284 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
01285 DTSBD372
01286 PERFORM P4300-MODIFY-MDST THRU P4300-EXIT. DTSBD372
01287 DTSBD372
01288 IF MDST-CREDIT-REC-88 DTSBD372
01289 NEXT SENTENCE DTSBD372
01290 ELSE DTSBD372
01291 PERFORM P4400-MODIFY-MQTR THRU P4400-EXIT. DTSBD372
01292 P4100-EXIT. DTSBD372
01293 EXIT. DTSBD372
01294 SKIP3 DTSBD372
01295 P4200-LOCATE-DSTRB. DTSBD372
01296 IF (APAY-APPLIC-YRQ = +0) DTSBD372
01297 AND DTSBD372
01298 (APAY-APPLIC-IND = SPACES OR APAY-CREDIT-88) DTSBD372
01299 PERFORM P4210-LOCATE-AVAIL-CREDIT THRU P4210-EXIT. DTSBD372
01300 DTSBD372
01301 IF HOLD-MDST-SUB NOT = +0 DTSBD372
01302 GO TO P4200-EXIT. DTSBD372
01303 DTSBD372
01304 DTSBD372
01305 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
01306 DTSBD372
01307 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
01308 DTSBD372
01309 SET MDST-DST-88 TO TRUE. DTSBD372
01310 DTSBD372
01311 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01312 DTSBD372
01313 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
01314 DTSBD372
01315 PERFORM P4220-LOCATE-APPLIED-MONEY THRU P4220-EXIT DTSBD372
01316 UNTIL (L910-NO-REC-88) DTSBD372
01317 OR DTSBD372
01318 (HOLD-MDST-SUB NOT = +0). DTSBD372
01319 DTSBD372
01320 IF HOLD-MDST-SUB NOT = +0 DTSBD372
01321 GO TO P4200-EXIT. DTSBD372
01322 DTSBD372
01323 IF (APAY-APPLIC-YRQ = +0) DTSBD372
01324 AND DTSBD372
01325 (APAY-APPLIC-IND = SPACES OR APAY-CREDIT-88) DTSBD372
01326 PERFORM P4230-LOCATE-TOL-CREDIT THRU P4230-EXIT. DTSBD372
01327 P4200-EXIT. DTSBD372
01328 EXIT. DTSBD372
01329 SKIP3 DTSBD372
01330 P4210-LOCATE-AVAIL-CREDIT. DTSBD372
01331 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
01332 DTSBD372
01333 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
01334 DTSBD372
01335 SET MDST-DST-88 TO TRUE. DTSBD372
01336 DTSBD372
01337 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
01338 DTSBD372
01339 MOVE APAY-APPLIC-DOC-NO TO MDST-DOC-NO. DTSBD372
01340 DTSBD372
01341 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01342 DTSBD372
01343 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01344 DTSBD372
01345 IF L910-NO-REC-88 DTSBD372
01346 GO TO P4210-EXIT. DTSBD372
01347 DTSBD372
01348 MOVE MSKL-REC TO MDST-REC. DTSBD372
01349 DTSBD372
01350 PERFORM DTSBD372
01351 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01352 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01353 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBD372
01354 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01355 END-IF DTSBD372
01356 END-PERFORM. DTSBD372
01357 P4210-EXIT. DTSBD372
01358 EXIT. DTSBD372
01359 SKIP3 DTSBD372
01360 P4220-LOCATE-APPLIED-MONEY. DTSBD372
01361 MOVE MSKL-REC TO MDST-REC. DTSBD372
01362 DTSBD372
01363 PERFORM P4221-PROCESS-MDST THRU P4221-EXIT. DTSBD372
01364 DTSBD372
01365 IF HOLD-MDST-SUB = +0 DTSBD372
01366 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
01367 P4220-EXIT. DTSBD372
01368 EXIT. DTSBD372
01369 SKIP3 DTSBD372
01370 P4221-PROCESS-MDST. DTSBD372
01371 IF MDST-CREDIT-REC-88 DTSBD372
01372 GO TO P4221-EXIT. DTSBD372
01373 DTSBD372
01374 IF MDST-DOC-NO NOT = APAY-APPLIC-DOC-NO DTSBD372
01375 GO TO P4221-EXIT. DTSBD372
01376 DTSBD372
01377 IF (APAY-APPLIC-YRQ = +0) DTSBD372
01378 OR DTSBD372
01379 (APAY-APPLIC-YRQ = MDST-YRQ) DTSBD372
01380 NEXT SENTENCE DTSBD372
01381 ELSE DTSBD372
01382 GO TO P4221-EXIT. DTSBD372
01383 DTSBD372
01384 IF APAY-APPLIC-IND = SPACES DTSBD372
01385 NEXT SENTENCE DTSBD372
01386 ELSE DTSBD372
01387 PERFORM DTSBD372
01388 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01389 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01390 IF MDST-ACCT-IND (MDST-ACCT-IDX) = APAY-APPLIC-IND DTSBD372
01391 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01392 END-IF DTSBD372
01393 END-PERFORM DTSBD372
01394 GO TO P4221-EXIT. DTSBD372
01395 DTSBD372
01396 PERFORM DTSBD372
01397 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01398 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01399 IF MDST-ACCT-MISC-PEN-88 (MDST-ACCT-IDX) DTSBD372
01400 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01401 END-IF DTSBD372
01402 END-PERFORM. DTSBD372
01403 DTSBD372
01404 IF HOLD-MDST-SUB NOT = +0 DTSBD372
01405 GO TO P4221-EXIT. DTSBD372
01406 DTSBD372
01407 PERFORM DTSBD372
01408 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01409 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01410 IF MDST-ACCT-NSF-PEN-88 (MDST-ACCT-IDX) DTSBD372
01411 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01412 END-IF DTSBD372
01413 END-PERFORM. DTSBD372
01414 DTSBD372
01415 IF HOLD-MDST-SUB NOT = +0 DTSBD372
01416 GO TO P4221-EXIT. DTSBD372
01417 DTSBD372
01418 PERFORM DTSBD372
01419 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01420 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01421 IF MDST-ACCT-LATE-PEN-88 (MDST-ACCT-IDX) DTSBD372
01422 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01423 END-IF DTSBD372
01424 END-PERFORM. DTSBD372
01425 DTSBD372
01426 IF HOLD-MDST-SUB NOT = +0 DTSBD372
01427 GO TO P4221-EXIT. DTSBD372
01428 DTSBD372
01429 PERFORM DTSBD372
01430 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01431 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01432 IF MDST-ACCT-INT-88 (MDST-ACCT-IDX) DTSBD372
01433 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01434 END-IF DTSBD372
01435 END-PERFORM. DTSBD372
01436 DTSBD372
01437 IF HOLD-MDST-SUB NOT = +0 DTSBD372
01438 GO TO P4221-EXIT. DTSBD372
01439 DTSBD372
01440 PERFORM DTSBD372
01441 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01442 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01443 IF MDST-ACCT-SUR-88 (MDST-ACCT-IDX) DTSBD372
01444 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01445 END-IF DTSBD372
01446 END-PERFORM. DTSBD372
01447 DTSBD372
01448 IF HOLD-MDST-SUB NOT = +0 DTSBD372
01449 GO TO P4221-EXIT. DTSBD372
01450 DTSBD372
01451 PERFORM DTSBD372
01452 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01453 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01454 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBD372
01455 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01456 END-IF DTSBD372
01457 END-PERFORM. DTSBD372
01458 DTSBD372
01459 IF HOLD-MDST-SUB NOT = +0 DTSBD372
01460 GO TO P4221-EXIT. DTSBD372
01461 P4221-EXIT. DTSBD372
01462 EXIT. DTSBD372
01463 SKIP3 DTSBD372
01464 P4230-LOCATE-TOL-CREDIT. DTSBD372
01465 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
01466 DTSBD372
01467 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
01468 DTSBD372
01469 SET MDST-DST-88 TO TRUE. DTSBD372
01470 DTSBD372
01471 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
01472 DTSBD372
01473 MOVE APAY-APPLIC-DOC-NO TO MDST-DOC-NO. DTSBD372
01474 DTSBD372
01475 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01476 DTSBD372
01477 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01478 DTSBD372
01479 IF L910-NO-REC-88 DTSBD372
01480 GO TO P4230-EXIT. DTSBD372
01481 DTSBD372
01482 MOVE MSKL-REC TO MDST-REC. DTSBD372
01483 DTSBD372
01484 PERFORM DTSBD372
01485 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
01486 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01487 IF MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSBD372
01488 SET HOLD-MDST-SUB TO MDST-ACCT-IDX DTSBD372
01489 END-IF DTSBD372
01490 END-PERFORM. DTSBD372
01491 P4230-EXIT. DTSBD372
01492 EXIT. DTSBD372
01493 SKIP3 DTSBD372
01494 P4300-MODIFY-MDST. DTSBD372
01495 IF MDST-AMT (HOLD-MDST-SUB) < WRK-AMT1 DTSBD372
01496 MOVE MDST-AMT (HOLD-MDST-SUB) TO L542-AMT DTSBD372
01497 ELSE DTSBD372
01498 MOVE WRK-AMT1 TO L542-AMT. DTSBD372
01499 DTSBD372
01500 COMPUTE WRK-AMT1 = WRK-AMT1 - L542-AMT. DTSBD372
01501 DTSBD372
01502 COMPUTE L542-AMT = L542-AMT * -1. DTSBD372
01503 DTSBD372
01504 MOVE MDST-ACCT-IND (HOLD-MDST-SUB) TO L542-ACCT-IND. DTSBD372
01505 DTSBD372
01506 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBD372
01507 DTSBD372
01508 PERFORM S4100-MDST-UPDATE THRU S4100-EXIT. DTSBD372
01509 P4300-EXIT. DTSBD372
01510 EXIT. DTSBD372
01511 SKIP3 DTSBD372
01512 P4400-MODIFY-MQTR. DTSBD372
01513 *& DTSBD372
01514 IF MPRF-EMP-NO = 046599 DTSBD372
01515 MOVE L542-AMT TO WRK-AMT-DISP DTSBD372
01516 DISPLAY 'DTSBD372 P4400 CALL BU520 ' MPRF-EMP-NO DTSBD372
01517 ' DOC ' MDST-DOC-NO DTSBD372
01518 ' YRQ ' MDST-YRQ DTSBD372
01519 ' IND ' L542-ACCT-IND DTSBD372
01520 ' AMT ' WRK-AMT-DISP DTSBD372
01521 END-IF. DTSBD372
01522 *& DTSBD372
01523 MOVE MDST-DOC-NO TO L521-MPAY-DOC-NO. DTSBD372
01524 DTSBD372
01525 MOVE MDST-RECEIVED-DATE TO L521-RECEIVED-DATE. DTSBD372
01526 DTSBD372
01527 SET L521-WAIVE-INT-NO-88 TO TRUE. DTSBD372
01528 DTSBD372
01529 MOVE L542-AMT TO L521-APPLIC-AMT. DTSBD372
01530 DTSBD372
01531 MOVE L542-ACCT-IND TO L521-APPLIC-ACCT-IND. DTSBD372
01532 DTSBD372
01533 MOVE MDST-YRQ TO L521-APPLIC-YRQ. DTSBD372
01534 DTSBD372
01535 PERFORM S521-DSTRB-UPDATE THRU S521-EXIT. DTSBD372
01536 DTSBD372
01537 DTSBD372
01538 COMPUTE L521-APPLIC-AMT = L521-APPLIC-AMT * -1. DTSBD372
01539 DTSBD372
01540 MOVE +0 TO WRK-RVR-OCCURS-SUB. DTSBD372
01541 DTSBD372
01542 PERFORM DTSBD372
01543 VARYING WRK-RVR-IDX FROM 1 BY 1 DTSBD372
01544 UNTIL WRK-RVR-IDX > WRK-RVR-OCCURS-CNT DTSBD372
01545 IF WRK-RVR-YRQ (WRK-RVR-IDX) = MDST-YRQ DTSBD372
01546 SET WRK-RVR-OCCURS-SUB TO WRK-RVR-IDX DTSBD372
01547 END-IF DTSBD372
01548 END-PERFORM. DTSBD372
01549 DTSBD372
01550 IF WRK-RVR-OCCURS-SUB > +0 DTSBD372
01551 ADD L521-APPLIC-AMT TO WRK-RVR-AMT (WRK-RVR-OCCURS-SUB) DTSBD372
01552 GO TO P4400-EXIT. DTSBD372
01553 DTSBD372
01554 IF WRK-RVR-OCCURS-CNT < WRK-RVR-OCCURS-MAX DTSBD372
01555 ADD +1 TO WRK-RVR-OCCURS-CNT DTSBD372
01556 MOVE MDST-YRQ TO WRK-RVR-YRQ (WRK-RVR-OCCURS-CNT) DTSBD372
01557 MOVE L521-APPLIC-AMT TO WRK-RVR-AMT (WRK-RVR-OCCURS-CNT).DTSBD372
01558 P4400-EXIT. DTSBD372
01559 EXIT. DTSBD372
01560 EJECT DTSBD372
01561 P4600-LATE-PAY-PEN. DTSBD372
01562 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBD372
01563 DTSBD372
01564 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBD372
01565 DTSBD372
01566 SET MPAY-PAY-88 TO TRUE. DTSBD372
01567 DTSBD372
01568 MOVE APAY-APPLIC-DOC-NO TO MPAY-DOC-NO. DTSBD372
01569 DTSBD372
01570 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01571 DTSBD372
01572 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01573 DTSBD372
01574 IF L910-NO-REC-88 DTSBD372
01575 GO TO P4600-EXIT. DTSBD372
01576 DTSBD372
01577 MOVE MSKL-REC TO MPAY-REC. DTSBD372
01578 DTSBD372
01579 IF MPRF-CLASS-RATED-88 DTSBD372
01580 IF MPAY-OR-PAY-88 DTSBD372
01581 NEXT SENTENCE DTSBD372
01582 ELSE DTSBD372
01583 GO TO P4600-EXIT DTSBD372
01584 END-IF DTSBD372
01585 END-IF. DTSBD372
01586 DTSBD372
01587 DTSBD372
01588 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD372
01589 DTSBD372
01590 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD372
01591 DTSBD372
01592 SET MQTR-QTR-88 TO TRUE. DTSBD372
01593 DTSBD372
01594 MOVE MPAY-APPLIC-YRQ TO MQTR-YRQ. DTSBD372
01595 DTSBD372
01596 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01597 DTSBD372
01598 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01599 DTSBD372
01600 IF L910-NO-REC-88 DTSBD372
01601 GO TO P4600-EXIT. DTSBD372
01602 DTSBD372
01603 MOVE MSKL-REC TO MQTR-REC. DTSBD372
01604 DTSBD372
01605 IF MQTR-CURR-RCVD-88 DTSBD372
01606 NEXT SENTENCE DTSBD372
01607 ELSE DTSBD372
01608 GO TO P4600-EXIT. DTSBD372
01609 DTSBD372
01610 DTSBD372
01611 MOVE +0 TO WRK-LAST-OR-RECEIVED-DATE. DTSBD372
01612 DTSBD372
01613 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBD372
01614 DTSBD372
01615 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBD372
01616 DTSBD372
01617 SET MRPT-RPT-88 TO TRUE. DTSBD372
01618 DTSBD372
01619 MOVE MQTR-YRQ TO MRPT-YRQ. DTSBD372
01620 DTSBD372
01621 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01622 DTSBD372
01623 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
01624 DTSBD372
01625 PERFORM P4610-MRPT-SCAN THRU P4610-EXIT DTSBD372
01626 UNTIL L910-NO-REC-88. DTSBD372
01627 DTSBD372
01628 IF MPRF-CLASS-SELF-INS-88 DTSBD372
01629 NEXT SENTENCE DTSBD372
01630 ELSE DTSBD372
01631 IF WRK-LAST-OR-RECEIVED-DATE > MPAY-RECEIVED-DATE DTSBD372
01632 GO TO P4600-EXIT. DTSBD372
01633 DTSBD372
01634 MOVE MPRF-EMP-CLASS TO L102-EMP-CLASS. DTSBD372
01635 DTSBD372
01636 MOVE LBCM-CURR-RUN-DATE TO L102-CURR-RUN-DATE. DTSBD372
01637 DTSBD372
01638 *** MOVE MPAY-RECEIVED-DATE TO L102-TRAN-RECEIVED-DATE. DTSBD372
01639 MOVE APAY-RECEIVED-DATE TO L102-TRAN-RECEIVED-DATE. DTSBD372
01640 DTSBD372
01641 MOVE APAY-WAIVE-LATE-PEN-IND TO L102-WAIVE-LATE-PEN-IND. DTSBD372
01642 DTSBD372
01643 MOVE LBCM-LAST-PEN-ASSESSED-YRQ DTSBD372
01644 TO L102-LAST-PEN-ASSESSED-YRQ. DTSBD372
01645 DTSBD372
01646 * IF MPAY-TRACE-NO NOT = ZERO DTSBD372
01647 * SET L102-ELECTRONIC-RPT-YES-88 TO TRUE DTSBD372
01648 * ELSE DTSBD372
01649 * SET L102-ELECTRONIC-RPT-NO-88 TO TRUE DTSBD372
01650 * END-IF. DTSBD372
01651 DTSBD372
01652 MOVE MPAY-RECEIVED-DATE TO L102-OR-RECEIVED-DATE. DTSBD372
01653 DTSBD372
01654 MOVE MQTR-YRQ TO L102-MQTR-YRQ. DTSBD372
01655 DTSBD372
01656 MOVE MQTR-TAX-DUE-DATE TO L102-TAX-DUE-DATE. DTSBD372
01657 DTSBD372
01658 MOVE MQTR-RPT-DUE-DATE TO L102-RPT-DUE-DATE. DTSBD372
01659 DTSBD372
01660 MOVE +0 TO L102-LATE-PEN-CHARGED-AMT DTSBD372
01661 L102-TAX-CHARGED-AMT DTSBD372
01662 L102-TAX-BALANCE-AMT. DTSBD372
01663 DTSBD372
01664 ********************************************************** DTSBD372
01665 * FOR QTRS >= THE QTR RETURNED FROM DTSBU109, DTSBD372
01666 * INCLUDE ADMIN ASSESS IN THE PENALTY AND INTEREST DTSBD372
01667 * CALCULATION, ALONG WITH UI TAX. DTSBD372
01668 * FOR EARLIER QUARTERS, INCLUDE ONLY UI TAX. DTSBD372
01669 ********************************************************** DTSBD372
01670 PERFORM DTSBD372
01671 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD372
01672 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD372
01673 EVALUATE TRUE DTSBD372
01674 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBD372
01675 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD372
01676 TO L102-LATE-PEN-CHARGED-AMT DTSBD372
01677 DTSBD372
01678 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD372
01679 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD372
01680 TO L102-TAX-CHARGED-AMT DTSBD372
01681 *ZL1 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD372
01682 *ZL1 TO L102-TAX-BALANCE-AMT DTSBD372
01683 DTSBD372
01684 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBD372
01685 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBD372
01686 AND MPRF-CLASS-RATED-88 DTSBD372
01687 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD372
01688 TO L102-TAX-CHARGED-AMT DTSBD372
01689 END-IF DTSBD372
01690 END-EVALUATE DTSBD372
01691 END-PERFORM. DTSBD372
01692 DTSBD372
01693 MOVE MQTR-PEN-AREA TO L102-PEN-AREA. DTSBD372
01694 DTSBD372
01695 * MOVE ZERO TO WRK-TIMELY-SI-PAY-AMT. DTSBD372
01696 MOVE ZERO TO WRK-TIMELY-PAYMENTS. DTSBD372
01697 DTSBD372
01698 * IF MPRF-CLASS-SELF-INS-88 DTSBD372
01699 PERFORM P4620-TIMLEY-PAYMENT THRU P4620-EXIT. DTSBD372
01700 DTSBD372
01701 COMPUTE L102-TAX-BALANCE-AMT = DTSBD372
01702 (L102-TAX-BALANCE-AMT - WRK-TIMELY-PAYMENTS). DTSBD372
01703 DTSBD372
01704 * MOVE WRK-TIMELY-SI-PAY-AMT TO L102-TIMELY-SI-PAY-AMT. DTSBD372
01705 DTSBD372
01706 PERFORM S102-NSF-PAY-REVERSAL THRU S102-EXIT. DTSBD372
01707 DTSBD372
01708 DTSBD372
01709 IF L102-LATE-PEN-CHARGE-CHNG < +0 AND DTSBD372
01710 L102-LATE-PEN-CHARGE-CHNG < +0 DTSBD372
01711 GO TO P4600-EXIT. DTSBD372
01712 DTSBD372
01713 IF L102-LATE-PEN-WAIVE-CHNG > L102-LATE-PEN-CHARGE-CHNG DTSBD372
01714 MOVE L102-LATE-PEN-CHARGE-CHNG DTSBD372
01715 TO L102-LATE-PEN-WAIVE-CHNG. DTSBD372
01716 DTSBD372
01717 IF (L102-LATE-PEN-CHARGE-CHNG = +0) DTSBD372
01718 AND DTSBD372
01719 (L102-LATE-PEN-WAIVE-CHNG = +0) DTSBD372
01720 GO TO P4600-EXIT. DTSBD372
01721 DTSBD372
01722 DTSBD372
01723 MOVE +0 TO LATE-PEN-SUB. DTSBD372
01724 DTSBD372
01725 PERFORM DTSBD372
01726 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD372
01727 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD372
01728 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBD372
01729 SET LATE-PEN-SUB TO MQTR-ACCT-IDX DTSBD372
01730 END-IF DTSBD372
01731 END-PERFORM. DTSBD372
01732 DTSBD372
01733 IF LATE-PEN-SUB = +0 DTSBD372
01734 IF MQTR-ACCT-CNT < MMAX-QTR-ACCT-MAX DTSBD372
01735 ADD +1 TO MQTR-ACCT-CNT DTSBD372
01736 SET MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-CNT) DTSBD372
01737 TO TRUE DTSBD372
01738 MOVE +0 DTSBD372
01739 TO MQTR-CHARGED-AMT (MQTR-ACCT-CNT) DTSBD372
01740 MQTR-PAID-AMT (MQTR-ACCT-CNT) DTSBD372
01741 MQTR-WAIVED-AMT (MQTR-ACCT-CNT) DTSBD372
01742 MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-CNT) DTSBD372
01743 MQTR-TOLER-AMT (MQTR-ACCT-CNT) DTSBD372
01744 MQTR-BALANCE-AMT (MQTR-ACCT-CNT) DTSBD372
01745 MOVE MQTR-ACCT-CNT TO LATE-PEN-SUB DTSBD372
01746 ELSE DTSBD372
01747 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
01748 DTSBD372
01749 DTSBD372
01750 IF L102-LATE-PEN-CHARGE-CHNG NOT = +0 DTSBD372
01751 MOVE L102-LATE-PEN-CHARGE-CHNG TO L541-AMT DTSBD372
01752 MOVE LATE-PEN-SUB TO L541-ACCT-SUB DTSBD372
01753 MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD372
01754 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD372
01755 DTSBD372
01756 IF L102-LATE-PEN-WAIVE-CHNG NOT = +0 DTSBD372
01757 MOVE L102-LATE-PEN-WAIVE-CHNG TO L541-AMT DTSBD372
01758 MOVE LATE-PEN-SUB TO L541-ACCT-SUB DTSBD372
01759 MOVE CACT-CAT-WAIVED TO L541-CAT-IND DTSBD372
01760 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD372
01761 DTSBD372
01762 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBD372
01763 DTSBD372
01764 MOVE MQTR-REC TO MSKL-REC. DTSBD372
01765 DTSBD372
01766 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD372
01767 P4600-EXIT. DTSBD372
01768 EXIT. DTSBD372
01769 SKIP3 DTSBD372
01770 P4610-MRPT-SCAN. DTSBD372
01771 MOVE MSKL-REC TO MRPT-REC. DTSBD372
01772 DTSBD372
01773 IF MRPT-YRQ NOT = MQTR-YRQ DTSBD372
01774 SET L910-NO-REC-88 TO TRUE DTSBD372
01775 GO TO P4610-EXIT. DTSBD372
01776 DTSBD372
01777 IF MRPT-ORIG-88 DTSBD372
01778 IF MRPT-RECEIVED-DATE > WRK-LAST-OR-RECEIVED-DATE DTSBD372
01779 MOVE MRPT-RECEIVED-DATE TO WRK-LAST-OR-RECEIVED-DATE.DTSBD372
01780 DTSBD372
01781 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
01782 P4610-EXIT. DTSBD372
01783 EXIT. DTSBD372
01784 DTSBD372
01785 P4620-TIMLEY-PAYMENT. DTSBD372
01786 MOVE LOW-VALUE TO MDST-KEY-AREA. DTSBD372
01787 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
01788 SET MDST-DST-88 TO TRUE. DTSBD372
01789 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01790 DTSBD372
01791 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
01792 IF L910-OK-88 DTSBD372
01793 PERFORM P4621-SCAN-MDST THRU P4621-EXIT DTSBD372
01794 UNTIL L910-NO-REC-88. DTSBD372
01795 DTSBD372
01796 P4620-EXIT. DTSBD372
01797 EXIT. DTSBD372
01798 DTSBD372
01799 P4621-SCAN-MDST. DTSBD372
01800 MOVE MSKL-REC TO MDST-REC. DTSBD372
01801 DTSBD372
01802 IF (MDST-YRQ = MQTR-YRQ DTSBD372
01803 AND MDST-RECEIVED-DATE <= MQTR-TAX-DUE-DATE) DTSBD372
01804 PERFORM DTSBD372
01805 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBD372
01806 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
01807 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBD372
01808 ADD MDST-AMT (MDST-ACCT-IDX) DTSBD372
01809 TO WRK-TIMELY-PAYMENTS DTSBD372
01810 END-IF DTSBD372
01811 IF MDST-ACCT-SUR-88 (MDST-ACCT-IDX) DTSBD372
01812 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBD372
01813 ADD MDST-AMT (MDST-ACCT-IDX) DTSBD372
01814 TO WRK-TIMELY-PAYMENTS DTSBD372
01815 END-IF DTSBD372
01816 END-IF DTSBD372
01817 END-PERFORM. DTSBD372
01818 DTSBD372
01819 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
01820 DTSBD372
01821 P4621-EXIT. DTSBD372
01822 EXIT. DTSBD372
01823 EJECT DTSBD372
01824 P4700-NSF-PENALTY. DTSBD372
01825 IF APAY-NSF-PEN-CHARGE-NO-88 DTSBD372
01826 GO TO P4700-EXIT. DTSBD372
01827 DTSBD372
01828 MOVE +0 TO WRK-RVR-MAX-YRQ DTSBD372
01829 WRK-RVR-MAX-AMT. DTSBD372
01830 DTSBD372
01831 PERFORM DTSBD372
01832 VARYING WRK-RVR-IDX FROM 1 BY 1 DTSBD372
01833 UNTIL WRK-RVR-IDX > WRK-RVR-OCCURS-CNT DTSBD372
01834 IF WRK-RVR-AMT (WRK-RVR-IDX) > WRK-RVR-MAX-AMT DTSBD372
01835 MOVE WRK-RVR-YRQ (WRK-RVR-IDX) TO WRK-RVR-MAX-YRQ DTSBD372
01836 MOVE WRK-RVR-AMT (WRK-RVR-IDX) TO WRK-RVR-MAX-AMT DTSBD372
01837 END-IF DTSBD372
01838 END-PERFORM. DTSBD372
01839 DTSBD372
01840 IF WRK-RVR-MAX-YRQ > +0 DTSBD372
01841 MOVE WRK-RVR-MAX-YRQ TO L004-QTR-5-9 DTSBD372
01842 PERFORM S004-FROM-5 THRU S004-EXIT DTSBD372
01843 IF L004-INVALID-QTR DTSBD372
01844 MOVE +0 TO WRK-RVR-MAX-YRQ. DTSBD372
01845 DTSBD372
01846 IF WRK-RVR-MAX-YRQ > +0 DTSBD372
01847 NEXT SENTENCE DTSBD372
01848 ELSE DTSBD372
01849 MOVE APAY-RECEIVED-DATE TO L004-DATE DTSBD372
01850 PERFORM S004-FROM-DATE THRU S004-EXIT DTSBD372
01851 IF L004-VALID-QTR DTSBD372
01852 MOVE L004-QTR-5-9 TO WRK-RVR-MAX-YRQ DTSBD372
01853 ELSE DTSBD372
01854 GO TO P4700-EXIT. DTSBD372
01855 DTSBD372
01856 DTSBD372
01857 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD372
01858 DTSBD372
01859 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD372
01860 DTSBD372
01861 SET MQTR-QTR-88 TO TRUE. DTSBD372
01862 DTSBD372
01863 MOVE WRK-RVR-MAX-YRQ TO MQTR-YRQ. DTSBD372
01864 DTSBD372
01865 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01866 DTSBD372
01867 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01868 DTSBD372
01869 IF (L910-NO-REC-88) DTSBD372
01870 AND DTSBD372
01871 (WRK-RVR-MAX-YRQ <= LBCM-PICKUP-YRQ) DTSBD372
01872 PERFORM P4710-PICKUP-YRQ THRU P4710-EXIT. DTSBD372
01873 DTSBD372
01874 IF L910-NO-REC-88 DTSBD372
01875 PERFORM S5100-MQTR-INITIALIZATION THRU S5100-EXIT DTSBD372
01876 MOVE MQTR-REC TO MSKL-REC DTSBD372
01877 PERFORM S910-WRITE THRU S910-EXIT DTSBD372
01878 ELSE DTSBD372
01879 MOVE MSKL-REC TO MQTR-REC. DTSBD372
01880 DTSBD372
01881 DTSBD372
01882 MOVE +0 TO NSF-PEN-SUB. DTSBD372
01883 DTSBD372
01884 PERFORM DTSBD372
01885 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD372
01886 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD372
01887 IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBD372
01888 SET NSF-PEN-SUB TO MQTR-ACCT-IDX DTSBD372
01889 END-IF DTSBD372
01890 END-PERFORM. DTSBD372
01891 DTSBD372
01892 IF NSF-PEN-SUB = +0 DTSBD372
01893 IF MQTR-ACCT-CNT < MMAX-QTR-ACCT-MAX DTSBD372
01894 ADD +1 TO MQTR-ACCT-CNT DTSBD372
01895 SET MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) TO TRUE DTSBD372
01896 MOVE +0 DTSBD372
01897 TO MQTR-CHARGED-AMT (MQTR-ACCT-CNT) DTSBD372
01898 MQTR-PAID-AMT (MQTR-ACCT-CNT) DTSBD372
01899 MQTR-WAIVED-AMT (MQTR-ACCT-CNT) DTSBD372
01900 MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-CNT) DTSBD372
01901 MQTR-TOLER-AMT (MQTR-ACCT-CNT) DTSBD372
01902 MQTR-BALANCE-AMT (MQTR-ACCT-CNT) DTSBD372
01903 MOVE MQTR-ACCT-CNT TO NSF-PEN-SUB DTSBD372
01904 ELSE DTSBD372
01905 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
01906 DTSBD372
01907 DTSBD372
01908 MOVE NSF-AUTO-CHARGE-AMT TO L541-AMT. DTSBD372
01909 DTSBD372
01910 MOVE NSF-PEN-SUB TO L541-ACCT-SUB. DTSBD372
01911 DTSBD372
01912 MOVE CACT-CAT-CHARGED TO L541-CAT-IND. DTSBD372
01913 DTSBD372
01914 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD372
01915 DTSBD372
01916 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBD372
01917 DTSBD372
01918 MOVE MQTR-REC TO MSKL-REC. DTSBD372
01919 DTSBD372
01920 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD372
01921 P4700-EXIT. DTSBD372
01922 EXIT. DTSBD372
01923 SKIP3 DTSBD372
01924 P4710-PICKUP-YRQ. DTSBD372
01925 MOVE LBCM-PICKUP-YRQ TO L004-QTR-5-9. DTSBD372
01926 DTSBD372
01927 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD372
01928 DTSBD372
01929 IF L004-INVALID-QTR DTSBD372
01930 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
01931 DTSBD372
01932 ADD +1 TO L004-ABS-QTR. DTSBD372
01933 DTSBD372
01934 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD372
01935 DTSBD372
01936 IF L004-INVALID-QTR DTSBD372
01937 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
01938 DTSBD372
01939 MOVE L004-QTR-5-9 TO WRK-RVR-MAX-YRQ. DTSBD372
01940 DTSBD372
01941 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD372
01942 DTSBD372
01943 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD372
01944 DTSBD372
01945 SET MQTR-QTR-88 TO TRUE. DTSBD372
01946 DTSBD372
01947 MOVE WRK-RVR-MAX-YRQ TO MQTR-YRQ. DTSBD372
01948 DTSBD372
01949 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01950 DTSBD372
01951 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01952 P4710-EXIT. DTSBD372
01953 EXIT. DTSBD372
01954 EJECT DTSBD372
01955 P4800-WRITE-R318. DTSBD372
01956 MOVE MPRF-EMP-NO TO R318-EMP-NO. DTSBD372
01957 DTSBD372
01958 SET R318-RPT-TYPE-REV-88 TO TRUE. DTSBD372
01959 DTSBD372
01960 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBD372
01961 MOVE L061-FLD-REP-ID TO R318-FIELD-REP-ID. DTSBD372
01962 DTSBD372
01963 MOVE LBCM-CURR-RUN-DATE TO R318-RUN-DATE. DTSBD372
01964 DTSBD372
01965 MOVE MPAY-DOC-NO TO R318-DOC-NO. DTSBD372
01966 DTSBD372
01967 MOVE WRK-APPLIC-TRACE-NO TO R318-TRACE-NO. DTSBD372
01968 DTSBD372
01969 MOVE MPAY-REMIT-AMT TO R318-REMIT-AMT. DTSBD372
01970 DTSBD372
01971 MOVE MPAY-APPLIC-DOC-NO TO R318-APPLIC-DOC-NO. DTSBD372
01972 DTSBD372
01973 DTSBD372
01974 PERFORM S946-R318-WRITE THRU S946-EXIT. DTSBD372
01975 DTSBD372
01976 P4800-EXIT. DTSBD372
01977 EXIT. DTSBD372
01978 EJECT DTSBD372
01979 P4900-WRITE-R319. DTSBD372
01980 MOVE ZEROS TO WRK-REMIT-AMT. DTSBD372
01981 MOVE LOW-VALUES TO MNTE-REC. DTSBD372
01982 DTSBD372
01983 MOVE APAY-EMP-NO TO MNTE-EMP-NO. DTSBD372
01984 DTSBD372
01985 SET MNTE-NTE-88 TO TRUE. DTSBD372
01986 DTSBD372
01987 MOVE APAY-NSF-MNTE-ABSTIME TO MNTE-KEY-ESTB-ABSTIME. DTSBD372
01988 DTSBD372
01989 MOVE MNTE-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
01990 DTSBD372
01991 PERFORM S910-READ THRU S910-EXIT. DTSBD372
01992 DTSBD372
01993 IF L910-NO-REC-88 DTSBD372
01994 GO TO P4900-EXIT. DTSBD372
01995 DTSBD372
01996 MOVE MSKL-REC TO MNTE-REC. DTSBD372
01997 DTSBD372
01998 MOVE MNTE-TEXT(1) TO WRK-MNTE-TEXT-LINE1. DTSBD372
01999 MOVE MNTE-TEXT(2) TO WRK-MNTE-TEXT-LINE2. DTSBD372
02000 MOVE MNTE-TEXT(3) TO WRK-MNTE-TEXT-LINE3. DTSBD372
02001 MOVE MNTE-TEXT(4) TO WRK-MNTE-TEXT-LINE4. DTSBD372
02002 MOVE MNTE-TEXT(5) TO WRK-MNTE-TEXT-LINE5. DTSBD372
02003 DTSBD372
02004 MOVE MNTE-EMP-NO TO R319-EMP-NO. DTSBD372
02005 DTSBD372
02006 MOVE LBCM-CURR-MAIL-DATE TO R319-CURR-MAIL-DATE. DTSBD372
02007 MOVE MPRF-PRIMARY-NAME TO R319-PRIMARY-NAME DTSBD372
02008 DTSBD372
02009 MOVE APAY-BATCH-NO TO R319-BATCH-NO. DTSBD372
02010 MOVE APAY-ITEM-NO TO R319-ITEM-NO. DTSBD372
02011 COMPUTE WRK-REMIT-AMT = APAY-REMIT-AMT * -1. DTSBD372
02012 MOVE WRK-REMIT-AMT TO R319-CHECK-AMT DTSBD372
02013 DTSBD372
02014 MOVE WRK-MNTE-CHECK-NO TO R319-CHECK-NO. DTSBD372
02015 DTSBD372
02016 MOVE DESC-LINE1-DATE TO R319-CHECK-DATE. DTSBD372
02017 MOVE WRK-MNTE-REASON TO R319-REASON. DTSBD372
02018 DTSBD372
02019 MOVE ALL '?' TO R319-FMT-ADDR. DTSBD372
02020 DTSBD372
02021 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBD372
02022 DTSBD372
02023 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBD372
02024 DTSBD372
02025 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBD372
02026 DTSBD372
02027 IF L111-ADDR-FOUND-88 DTSBD372
02028 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE DTSBD372
02029 SET L112-ANCHOR-LAST-88 TO TRUE DTSBD372
02030 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSBD372
02031 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBD372
02032 PERFORM S112-FORMAT-ADDR THRU S112-EXIT DTSBD372
02033 MOVE L112-MAILING-ADDRESS TO R319-FMT-ADDR. DTSBD372
02034 DTSBD372
02035 *& DTSBD372
02036 DISPLAY 'BD372 P4900 CALL S946 EMP NO ' MPRF-EMP-NO. DTSBD372
02037 *& DTSBD372
02038 PERFORM S946-R319-WRITE THRU S946-EXIT. DTSBD372
02039 DTSBD372
02040 P4900-EXIT. DTSBD372
02041 EXIT. DTSBD372
02042 EJECT DTSBD372
02043 P5000-REFUND-UPDATE. DTSBD372
02044 DISPLAY 'BD372 REFUND ' APAY-EMP-NO ' ' APAY-BATCH-NO DTSBD372
02045 ' ' APAY-ITEM-NO. DTSBD372
02046 COMPUTE WRK-REFUND-AMT = APAY-REMIT-AMT * -1. DTSBD372
02047 DTSBD372
02048 IF APAY-APPLIC-DOC-NO NOT = WRK-NULL-DOC-NO DTSBD372
02049 PERFORM P5100-DIRECT-REFUND THRU P5100-EXIT. DTSBD372
02050 DTSBD372
02051 PERFORM P5200-DISTRIBUTE-REFUND THRU P5200-EXIT DTSBD372
02052 UNTIL WRK-REFUND-AMT NOT > +0. DTSBD372
02053 DTSBD372
02054 PERFORM S2100-MPAY-FROM-APAY THRU S2100-EXIT. DTSBD372
02055 DTSBD372
02056 ADD +1 TO LBCM-LAST-USED-REFUND-NO. DTSBD372
02057 DTSBD372
02058 MOVE LBCM-LAST-USED-REFUND-NO TO MPAY-REFUND-VOUCHER-NUMBER. DTSBD372
02059 DTSBD372
02060 MOVE MPAY-REC TO MSKL-REC. DTSBD372
02061 DTSBD372
02062 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
02063 DTSBD372
02064 PERFORM P5010-BUILD-MRFD THRU P5010-EXIT. DTSBD372
02065 DTSBD372
02066 PERFORM P5020-BUILD-R303 THRU P5020-EXIT. DTSBD372
02067 DTSBD372
02068 PERFORM P5030-BUILD-MTCK THRU P5030-EXIT. DTSBD372
02069 DTSBD372
02070 PERFORM P5040-BUILD-X306 THRU P5040-EXIT. DTSBD372
02071 DTSBD372
02072 DTSBD372
02073 MOVE R303-CURR-DOC-NO TO EVL1-CURR-DOC-NO. DTSBD372
02074 DTSBD372
02075 MOVE R303-REFUND-AMT TO EVL1-REFUND-AMT. DTSBD372
02076 DTSBD372
02077 MOVE EVL1-TEXT TO EVL-TEXT. DTSBD372
02078 DTSBD372
02079 PERFORM S6000-WRITE-MEVL THRU S6000-EXIT. DTSBD372
02080 P5000-EXIT. DTSBD372
02081 EXIT. DTSBD372
02082 DTSBD372
02083 P5010-BUILD-MRFD. DTSBD372
02084 MOVE LOW-VALUES TO MRFD-REC. DTSBD372
02085 DTSBD372
02086 MOVE MPRF-EMP-NO TO MRFD-EMP-NO. DTSBD372
02087 SET MRFD-RFD-88 TO TRUE. DTSBD372
02088 MOVE APAY-DOC-NO TO MRFD-TAX-DOC-NO. DTSBD372
02089 MOVE +0 TO MRFD-PURGE-DATE. DTSBD372
02090 SET MRFD-RF-88 TO TRUE. DTSBD372
02091 MOVE APAY-REMIT-AMT TO MRFD-REFUND-AMT. DTSBD372
02092 MOVE WRK-CFO-AGENCY TO MRFD-CFO-AGENCY. DTSBD372
02093 MOVE WRK-CFO-TYPE TO MRFD-CFO-TYPE. DTSBD372
02094 MOVE WRK-REFUND-DATE TO MRFD-CFO-REQUEST-DATE. DTSBD372
02095 MOVE WRK-CFO-BATCH-NO TO MRFD-CFO-BATCH-NO. DTSBD372
02096 ADD 1 TO WRK-CFO-SEQ-NO. DTSBD372
02097 MOVE WRK-CFO-SEQ-NO TO MRFD-CFO-SEQ-NO. DTSBD372
02098 MOVE LBCM-LAST-USED-REFUND-NO DTSBD372
02099 TO WRK-MHDR-VOUCHER-NO. DTSBD372
02100 MOVE WRK-MHDR-VOUCHER-NO-6 TO WRK-VOUCHER-NO. DTSBD372
02101 MOVE WRK-CURR-DOC-NO TO MRFD-CURR-DOC-NO. DTSBD372
02102 MOVE WRK-CFO-CURR-DOC-NO-SFX TO MRFD-CURR-DOC-NO-SFX. DTSBD372
02103 MOVE APAY-RESPONSIBLE-OP-ID TO MRFD-RESPONSIBLE-OP-ID. DTSBD372
02104 MOVE ZEROS TO MRFD-CFO-CHECK-DATE. DTSBD372
02105 MOVE SPACES TO MRFD-CFO-CHECK-NO. DTSBD372
02106 MOVE ZEROS TO MRFD-CFO-APPROVAL-DATE. DTSBD372
02107 MOVE APAY-APPLIC-BATCH-NO TO MRFD-PAY-BATCH-NO. DTSBD372
02108 MOVE APAY-APPLIC-ITEM-NO TO MRFD-PAY-ITEM-NO. DTSBD372
02109 SET MRFD-NOT-CONVERTED-88 TO TRUE. DTSBD372
02110 MOVE LBCM-CURR-RUN-DATE TO MRFD-ESTB-DATE DTSBD372
02111 MRFD-CHNG-DATE. DTSBD372
02112 DTSBD372
02113 MOVE MRFD-REC TO MSKL-REC. DTSBD372
02114 DTSBD372
02115 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
02116 DTSBD372
02117 DISPLAY '******************************************'. DTSBD372
02118 DISPLAY 'BD372 CFO REFUND '. DTSBD372
02119 DISPLAY ' EMP ' MRFD-EMP-NO. DTSBD372
02120 DISPLAY ' TAX BATCH ' MRFD-TAX-BATCH-NO. DTSBD372
02121 DISPLAY ' TAX ITEM ' MRFD-TAX-ITEM-NO. DTSBD372
02122 DISPLAY ' PAY BATCH ' MRFD-PAY-BATCH-NO. DTSBD372
02123 DISPLAY ' PAY ITEM ' MRFD-PAY-ITEM-NO. DTSBD372
02124 DISPLAY ' AGENCY ' MRFD-CFO-AGENCY. DTSBD372
02125 DISPLAY ' TYPE ' MRFD-CFO-TYPE. DTSBD372
02126 DISPLAY ' REQUEST DT ' MRFD-CFO-REQUEST-DATE. DTSBD372
02127 DISPLAY ' CFO BATCH ' MRFD-CFO-BATCH-NO. DTSBD372
02128 DISPLAY ' CFO SEQ ' MRFD-CFO-SEQ-NO. DTSBD372
02129 DISPLAY ' CURR DOC ' MRFD-CURR-DOC-NO. DTSBD372
02130 DISPLAY ' DOC SFX ' MRFD-CURR-DOC-NO-SFX. DTSBD372
02131 DISPLAY '******************************************'. DTSBD372
02132 P5010-EXIT. DTSBD372
02133 EXIT. DTSBD372
02134 DTSBD372
02135 P5020-BUILD-R303. DTSBD372
02136 MOVE MPRF-EMP-NO TO R303-EMP-NO. DTSBD372
02137 DTSBD372
02138 MOVE WRK-CFO-AGENCY TO R303-CFO-AGENCY. DTSBD372
02139 DTSBD372
02140 MOVE WRK-CFO-TYPE TO R303-CFO-TYPE. DTSBD372
02141 DTSBD372
02142 MOVE WRK-REFUND-DATE TO R303-CFO-REQUEST-DATE. DTSBD372
02143 DTSBD372
02144 MOVE WRK-CFO-BATCH-NO TO R303-CFO-BATCH-NO. DTSBD372
02145 DTSBD372
02146 MOVE WRK-CFO-SEQ-NO TO R303-CFO-SEQ-NO. DTSBD372
02147 DTSBD372
02148 MOVE WRK-CURR-DOC-NO TO R303-CURR-DOC-NO. DTSBD372
02149 DTSBD372
02150 MOVE LBCM-CURR-MAIL-DATE TO R303-CURR-MAIL-DATE. DTSBD372
02151 DTSBD372
02152 *** MOVE LBCM-CURR-RUN-DATE TO R303-CURR-RUN-DATE. DTSBD372
02153 DTSBD372
02154 COMPUTE R303-REFUND-AMT = APAY-REMIT-AMT * -1. DTSBD372
02155 DTSBD372
02156 MOVE MPRF-FEIN TO R303-FEIN. DTSBD372
02157 DTSBD372
02158 MOVE MPRF-PRIMARY-NAME TO R303-PRIMARY-NAME. DTSBD372
02159 DTSBD372
02160 MOVE ALL '?' TO R303-ADDRESS DTSBD372
02161 R303-FMT-ADDR. DTSBD372
02162 DTSBD372
02163 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBD372
02164 DTSBD372
02165 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBD372
02166 DTSBD372
02167 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBD372
02168 DTSBD372
02169 IF L111-ADDR-FOUND-88 DTSBD372
02170 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE DTSBD372
02171 SET L112-ANCHOR-LAST-88 TO TRUE DTSBD372
02172 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSBD372
02173 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBD372
02174 PERFORM S112-FORMAT-ADDR THRU S112-EXIT DTSBD372
02175 MOVE L111-ADDRESS TO R303-ADDRESS DTSBD372
02176 MOVE L112-MAILING-ADDRESS TO R303-FMT-ADDR DTSBD372
02177 END-IF. DTSBD372
02178 DTSBD372
02179 PERFORM S946-R303-WRITE THRU S946-EXIT. DTSBD372
02180 DTSBD372
02181 P5020-EXIT. DTSBD372
02182 EXIT. DTSBD372
02183 DTSBD372
02184 P5030-BUILD-MTCK. DTSBD372
02185 MOVE LOW-VALUES TO MTCK-REC. DTSBD372
02186 DTSBD372
02187 MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSBD372
02188 DTSBD372
02189 SET MTCK-TCK-88 TO TRUE. DTSBD372
02190 DTSBD372
02191 ADD +1 TO LBCM-EMP-ABSTIME. DTSBD372
02192 DTSBD372
02193 MOVE LBCM-EMP-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBD372
02194 DTSBD372
02195 MOVE +0 TO MTCK-PURGE-DATE. DTSBD372
02196 DTSBD372
02197 SET MTCK-TYPE-MANUAL-88 TO TRUE. DTSBD372
02198 DTSBD372
02199 MOVE LBCM-CURR-MAIL-DATE TO L001-FED-8-DATE-9. DTSBD372
02200 DTSBD372
02201 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD372
02202 DTSBD372
02203 IF L001-INVALID-DATE DTSBD372
02204 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
02205 DTSBD372
02206 MOVE LBCM-LAST-USED-REFUND-NO TO WRK-LAST-USED-REFUND-NO. DTSBD372
02207 DTSBD372
02208 MOVE R303-REFUND-AMT TO WRK-DISPLAY-REFUND-AMT. DTSBD372
02209 DTSBD372
02210 MOVE SPACES TO MTCK-TEXT (1). DTSBD372
02211 DTSBD372
02212 STRING DTSBD372
02213 'REFUND VOUCHER ' DELIMITED BY SIZE DTSBD372
02214 WRK-LAST-USED-REFUND-PREFIX (3:2) DELIMITED BY SIZE DTSBD372
02215 ' ' DELIMITED BY SIZE DTSBD372
02216 WRK-LAST-USED-REFUND-SUFFIX DELIMITED BY SIZE DTSBD372
02217 ' IN AMOUNT OF ' DELIMITED BY SIZE DTSBD372
02218 WRK-DISPLAY-REFUND-AMT-X DELIMITED BY SIZE DTSBD372
02219 INTO DTSBD372
02220 MTCK-TEXT (1). DTSBD372
02221 DTSBD372
02222 MOVE SPACES TO MTCK-TEXT (2). DTSBD372
02223 DTSBD372
02224 STRING DTSBD372
02225 'WAS ISSUED ON ' DELIMITED BY SIZE DTSBD372
02226 L001-SLASH-8-DATE DELIMITED BY SIZE DTSBD372
02227 '.' DELIMITED BY SIZE DTSBD372
02228 INTO DTSBD372
02229 MTCK-TEXT (2). DTSBD372
02230 DTSBD372
02231 MOVE SPACES TO MTCK-TEXT (3). DTSBD372
02232 DTSBD372
02233 MOVE DTSBD372
02234 'PLEASE CONFIRM FMS ISSUED A REFUND CHECK.' DTSBD372
02235 TO MTCK-TEXT (4). DTSBD372
02236 DTSBD372
02237 MOVE +4 TO MTCK-TEXT-CNT. DTSBD372
02238 DTSBD372
02239 ADD +14 TO L001-JUL-ABS-DAY. DTSBD372
02240 DTSBD372
02241 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBD372
02242 DTSBD372
02243 IF L001-INVALID-DATE DTSBD372
02244 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
02245 DTSBD372
02246 MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE. DTSBD372
02247 DTSBD372
02248 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE. DTSBD372
02249 DTSBD372
02250 SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSBD372
02251 DTSBD372
02252 MOVE 'TAXACCT' TO MTCK-DEST-OP-ID. DTSBD372
02253 DTSBD372
02254 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSBD372
02255 DTSBD372
02256 MOVE LBCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSBD372
02257 MTCK-CHNG-DATE. DTSBD372
02258 DTSBD372
02259 MOVE MTCK-REC TO MSKL-REC. DTSBD372
02260 DTSBD372
02261 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
02262 DTSBD372
02263 P5030-EXIT. DTSBD372
02264 EXIT. DTSBD372
02265 DTSBD372
02266 P5040-BUILD-X306. DTSBD372
02267 SET X306-TYPE-TO-CFO-88 TO TRUE. DTSBD372
02268 MOVE MRFD-EMP-NO TO X306-EMP-NO. DTSBD372
02269 MOVE MRFD-TAX-BATCH-NO TO X306-TAX-BATCH. DTSBD372
02270 MOVE MRFD-TAX-ITEM-NO TO X306-TAX-ITEM. DTSBD372
02271 MOVE APAY-APPLIC-BATCH-NO TO X306-APPLIC-BATCH. DTSBD372
02272 MOVE APAY-APPLIC-ITEM-NO TO X306-APPLIC-ITEM. DTSBD372
02273 MOVE MRFD-CFO-AGENCY TO X306-BATCH-AGY. DTSBD372
02274 MOVE MRFD-CFO-TYPE TO X306-BATCH-TYPE. DTSBD372
02275 MOVE WRK-REFUND-DATE TO L001-FED-8-DATE-9. DTSBD372
02276 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD372
02277 MOVE L001-SLASH-8-DATE TO X306-BATCH-DATE. DTSBD372
02278 MOVE MRFD-CFO-BATCH-NO TO X306-BATCH-NUMBER. DTSBD372
02279 MOVE MRFD-CFO-SEQ-NO TO X306-BATCH-SEQUENCE. DTSBD372
02280 MOVE MRFD-CURR-DOC-NO TO X306-CURR-DOC-NO. DTSBD372
02281 MOVE MRFD-CURR-DOC-NO-SFX TO X306-CURR-DOC-NO-SFX. DTSBD372
02282 MOVE MRFD-RESPONSIBLE-OP-ID TO X306-OPID. DTSBD372
02283 MOVE ZEROS TO X306-CHECK-DATE. DTSBD372
02284 MOVE SPACES TO X306-CHECK-NO. DTSBD372
02285 MOVE SPACES TO X306-APPROVAL-DATE. DTSBD372
02286 DTSBD372
02287 WRITE X306-REC FROM WRK-X306-REC. DTSBD372
02288 DTSBD372
02289 P5040-EXIT. DTSBD372
02290 EXIT. DTSBD372
02291 DTSBD372
02292 P5100-DIRECT-REFUND. DTSBD372
02293 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
02294 DTSBD372
02295 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
02296 DTSBD372
02297 SET MDST-DST-88 TO TRUE. DTSBD372
02298 DTSBD372
02299 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
02300 DTSBD372
02301 MOVE APAY-APPLIC-DOC-NO TO MDST-DOC-NO. DTSBD372
02302 DTSBD372
02303 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02304 DTSBD372
02305 PERFORM S910-READ THRU S910-EXIT. DTSBD372
02306 DTSBD372
02307 IF L910-NO-REC-88 DTSBD372
02308 GO TO P5100-EXIT. DTSBD372
02309 DTSBD372
02310 MOVE MDST-DOC-NO TO WRK-MDST-DOC-NO. DTSBD372
02311 DTSBD372
02312 PERFORM P5300-PROCESS-MDST THRU P5300-EXIT. DTSBD372
02313 P5100-EXIT. DTSBD372
02314 EXIT. DTSBD372
02315 SKIP3 DTSBD372
02316 P5200-DISTRIBUTE-REFUND. DTSBD372
02317 MOVE ALL-NINES-DATE TO WRK-RECEIVED-DATE. DTSBD372
02318 DTSBD372
02319 MOVE WRK-NULL-DOC-NO TO WRK-MDST-DOC-NO. DTSBD372
02320 DTSBD372
02321 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
02322 DTSBD372
02323 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
02324 DTSBD372
02325 SET MDST-DST-88 TO TRUE. DTSBD372
02326 DTSBD372
02327 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
02328 DTSBD372
02329 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02330 DTSBD372
02331 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
02332 DTSBD372
02333 PERFORM P5210-SCAN-FOR-CREDIT THRU P5210-EXIT DTSBD372
02334 UNTIL L910-NO-REC-88. DTSBD372
02335 DTSBD372
02336 IF WRK-MDST-DOC-NO = WRK-NULL-DOC-NO DTSBD372
02337 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
02338 DTSBD372
02339 PERFORM P5300-PROCESS-MDST THRU P5300-EXIT. DTSBD372
02340 P5200-EXIT. DTSBD372
02341 EXIT. DTSBD372
02342 SKIP3 DTSBD372
02343 P5210-SCAN-FOR-CREDIT. DTSBD372
02344 MOVE MSKL-REC TO MDST-REC. DTSBD372
02345 DTSBD372
02346 IF NOT MDST-CREDIT-REC-88 DTSBD372
02347 SET L910-NO-REC-88 TO TRUE DTSBD372
02348 GO TO P5210-EXIT. DTSBD372
02349 DTSBD372
02350 IF MDST-RECEIVED-DATE NOT < WRK-RECEIVED-DATE DTSBD372
02351 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD372
02352 GO TO P5210-EXIT. DTSBD372
02353 DTSBD372
02354 PERFORM P5211-MDST-DSTRB-LOOP THRU P5211-EXIT DTSBD372
02355 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
02356 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD372
02357 DTSBD372
02358 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
02359 P5210-EXIT. DTSBD372
02360 EXIT. DTSBD372
02361 SKIP3 DTSBD372
02362 P5211-MDST-DSTRB-LOOP. DTSBD372
02363 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBD372
02364 MOVE MDST-RECEIVED-DATE TO WRK-RECEIVED-DATE DTSBD372
02365 MOVE MDST-DOC-NO TO WRK-MDST-DOC-NO. DTSBD372
02366 P5211-EXIT. DTSBD372
02367 EXIT. DTSBD372
02368 SKIP3 DTSBD372
02369 P5300-PROCESS-MDST. DTSBD372
02370 MOVE +0 TO WRK-ACCUM-AMT. DTSBD372
02371 DTSBD372
02372 DTSBD372
02373 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
02374 DTSBD372
02375 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
02376 DTSBD372
02377 SET MDST-DST-88 TO TRUE. DTSBD372
02378 DTSBD372
02379 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
02380 DTSBD372
02381 MOVE WRK-MDST-DOC-NO TO MDST-DOC-NO. DTSBD372
02382 DTSBD372
02383 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02384 DTSBD372
02385 PERFORM S910-READ THRU S910-EXIT. DTSBD372
02386 DTSBD372
02387 IF L910-NO-REC-88 DTSBD372
02388 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
02389 DTSBD372
02390 MOVE MSKL-REC TO MDST-REC. DTSBD372
02391 DTSBD372
02392 PERFORM P5320-MDST-SCAN THRU P5320-EXIT DTSBD372
02393 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
02394 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD372
02395 DTSBD372
02396 IF WRK-ACCUM-AMT = +0 DTSBD372
02397 GO TO P5300-EXIT. DTSBD372
02398 DTSBD372
02399 PERFORM P5340-ESTB-MREV THRU P5340-EXIT. DTSBD372
02400 P5300-EXIT. DTSBD372
02401 EXIT. DTSBD372
02402 SKIP3 DTSBD372
02403 P5320-MDST-SCAN. DTSBD372
02404 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBD372
02405 PERFORM P5321-MDST-MODIFY THRU P5321-EXIT DTSBD372
02406 SET MDST-ACCT-IDX TO MDST-ACCT-CNT. DTSBD372
02407 P5320-EXIT. DTSBD372
02408 EXIT. DTSBD372
02409 SKIP3 DTSBD372
02410 P5321-MDST-MODIFY. DTSBD372
02411 IF MDST-AMT (MDST-ACCT-IDX) > WRK-REFUND-AMT DTSBD372
02412 MOVE WRK-REFUND-AMT TO L542-AMT DTSBD372
02413 MOVE +0 TO WRK-REFUND-AMT DTSBD372
02414 ELSE DTSBD372
02415 MOVE MDST-AMT (MDST-ACCT-IDX) TO L542-AMT DTSBD372
02416 COMPUTE WRK-REFUND-AMT DTSBD372
02417 = WRK-REFUND-AMT - MDST-AMT (MDST-ACCT-IDX). DTSBD372
02418 DTSBD372
02419 ADD L542-AMT TO WRK-ACCUM-AMT. DTSBD372
02420 DTSBD372
02421 COMPUTE L542-AMT = L542-AMT * -1. DTSBD372
02422 DTSBD372
02423 MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO L542-ACCT-IND. DTSBD372
02424 DTSBD372
02425 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBD372
02426 DTSBD372
02427 PERFORM S4100-MDST-UPDATE THRU S4100-EXIT. DTSBD372
02428 P5321-EXIT. DTSBD372
02429 EXIT. DTSBD372
02430 SKIP3 DTSBD372
02431 P5340-ESTB-MREV. DTSBD372
02432 PERFORM S3200-INITIALIZE-MREV THRU S3200-EXIT. DTSBD372
02433 DTSBD372
02434 MOVE MDST-DOC-NO TO MREV-PA-DOC-NO. DTSBD372
02435 DTSBD372
02436 SET MREV-REFUND-88 TO TRUE. DTSBD372
02437 DTSBD372
02438 MOVE WRK-ACCUM-AMT TO MREV-AMT. DTSBD372
02439 DTSBD372
02440 MOVE MREV-REC TO MSKL-REC. DTSBD372
02441 DTSBD372
02442 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
02443 P5340-EXIT. DTSBD372
02444 EXIT. DTSBD372
02445 EJECT DTSBD372
02446 P6000-REF-REV-UPDATE. DTSBD372
02447 PERFORM P6100-REVERSAL THRU P6100-EXIT. DTSBD372
02448 DTSBD372
02449 PERFORM S2100-MPAY-FROM-APAY THRU S2100-EXIT. DTSBD372
02450 DTSBD372
02451 MOVE MPAY-REC TO MSKL-REC. DTSBD372
02452 DTSBD372
02453 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
02454 DTSBD372
02455 DTSBD372
02456 SET L520-NO-PREF-88 TO TRUE. DTSBD372
02457 SET L520-ANNUAL-RPT-NULL-88 TO TRUE. DTSBD372
02458 MOVE ZERO TO L520-WITHDRAW-ANN-YRQ. DTSBD372
02459 SET L520-LAST-ANN-QTR-NULL-88 TO TRUE. DTSBD372
02460 DTSBD372
02461 MOVE WRK-NULL-DOC-NO TO L520-PREF-PAY-DOC-NO. DTSBD372
02462 DTSBD372
02463 MOVE +0 TO L520-PREF-APPLIC-YRQ. DTSBD372
02464 DTSBD372
02465 MOVE SPACE TO L520-PREF-APPLIC-IND. DTSBD372
02466 DTSBD372
02467 PERFORM S520-APPLY-CREDIT THRU S520-EXIT. DTSBD372
02468 P6000-EXIT. DTSBD372
02469 EXIT. DTSBD372
02470 SKIP3 DTSBD372
02471 P6100-REVERSAL. DTSBD372
02472 MOVE LOW-VALUES TO MREV-KEY-AREA. DTSBD372
02473 DTSBD372
02474 MOVE MPRF-EMP-NO TO MREV-EMP-NO. DTSBD372
02475 DTSBD372
02476 SET MREV-REV-88 TO TRUE. DTSBD372
02477 DTSBD372
02478 MOVE MREV-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02479 DTSBD372
02480 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
02481 DTSBD372
02482 PERFORM P6110-SCAN-MREV THRU P6110-EXIT DTSBD372
02483 UNTIL L910-NO-REC-88. DTSBD372
02484 P6100-EXIT. DTSBD372
02485 EXIT. DTSBD372
02486 SKIP3 DTSBD372
02487 P6110-SCAN-MREV. DTSBD372
02488 MOVE MSKL-REC TO MREV-REC. DTSBD372
02489 DTSBD372
02490 IF (MREV-PU-RF-PR-DOC-NO = APAY-APPLIC-DOC-NO) DTSBD372
02491 AND DTSBD372
02492 (MREV-REFUND-88) DTSBD372
02493 PERFORM P6120-PROCESS-MREV THRU P6120-EXIT DTSBD372
02494 ELSE DTSBD372
02495 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
02496 P6110-EXIT. DTSBD372
02497 EXIT. DTSBD372
02498 SKIP3 DTSBD372
02499 P6120-PROCESS-MREV. DTSBD372
02500 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBD372
02501 DTSBD372
02502 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBD372
02503 DTSBD372
02504 SET MPAY-PAY-88 TO TRUE. DTSBD372
02505 DTSBD372
02506 MOVE MREV-PA-DOC-NO TO MPAY-DOC-NO. DTSBD372
02507 DTSBD372
02508 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02509 DTSBD372
02510 PERFORM S910-READ THRU S910-EXIT. DTSBD372
02511 DTSBD372
02512 IF L910-OK-88 DTSBD372
02513 MOVE MSKL-REC TO MPAY-REC DTSBD372
02514 IF MPAY-PAYMENT-88 DTSBD372
02515 MOVE LOW-VALUES TO MDST-KEY-AREA DTSBD372
02516 MOVE MPRF-EMP-NO TO MDST-EMP-NO DTSBD372
02517 SET MDST-DST-88 TO TRUE DTSBD372
02518 SET MDST-CREDIT-REC-88 TO TRUE DTSBD372
02519 MOVE MREV-PA-DOC-NO TO MDST-DOC-NO DTSBD372
02520 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA DTSBD372
02521 PERFORM S910-READ THRU S910-EXIT DTSBD372
02522 IF L910-OK-88 DTSBD372
02523 PERFORM P6121-MODIFY-MDST THRU P6121-EXIT DTSBD372
02524 ELSE DTSBD372
02525 PERFORM P6122-ESTABLISH-MDST THRU P6122-EXIT. DTSBD372
02526 DTSBD372
02527 MOVE MREV-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02528 DTSBD372
02529 PERFORM S910-READ THRU S910-EXIT. DTSBD372
02530 DTSBD372
02531 IF L910-NO-REC-88 DTSBD372
02532 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
02533 DTSBD372
02534 PERFORM S910-DELETE THRU S910-EXIT. DTSBD372
02535 DTSBD372
02536 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
02537 P6120-EXIT. DTSBD372
02538 EXIT. DTSBD372
02539 SKIP3 DTSBD372
02540 P6121-MODIFY-MDST. DTSBD372
02541 MOVE MSKL-REC TO MDST-REC. DTSBD372
02542 DTSBD372
02543 MOVE MREV-AMT TO L542-AMT. DTSBD372
02544 DTSBD372
02545 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. DTSBD372
02546 DTSBD372
02547 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBD372
02548 DTSBD372
02549 PERFORM S4100-MDST-UPDATE THRU S4100-EXIT. DTSBD372
02550 P6121-EXIT. DTSBD372
02551 EXIT. DTSBD372
02552 SKIP3 DTSBD372
02553 P6122-ESTABLISH-MDST. DTSBD372
02554 PERFORM S3100-INITIALIZE-MDST THRU S3100-EXIT. DTSBD372
02555 DTSBD372
02556 MOVE MREV-PA-DOC-NO TO MDST-DOC-NO. DTSBD372
02557 DTSBD372
02558 MOVE MPAY-RECEIVED-DATE TO MDST-RECEIVED-DATE. DTSBD372
02559 DTSBD372
02560 MOVE MREV-AMT TO L542-AMT. DTSBD372
02561 DTSBD372
02562 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. DTSBD372
02563 DTSBD372
02564 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBD372
02565 DTSBD372
02566 PERFORM S4100-MDST-UPDATE THRU S4100-EXIT. DTSBD372
02567 P6122-EXIT. DTSBD372
02568 EXIT. DTSBD372
02569 EJECT DTSBD372
02570 P7000-UNIV-PR-UPDATE. DTSBD372
02571 COMPUTE WRK-AMT1 = APAY-REMIT-AMT * -1. DTSBD372
02572 DTSBD372
02573 DTSBD372
02574 SET WRK-ACCT-CREDIT-AVAIL TO TRUE. DTSBD372
02575 DTSBD372
02576 MOVE HIGH-VALUE TO WRK-MDST-DOC-NO. DTSBD372
02577 DTSBD372
02578 PERFORM P7100-UNIV-PR-CREDITS THRU P7100-EXIT DTSBD372
02579 UNTIL WRK-AMT1 <= +0 DTSBD372
02580 OR WRK-MDST-DOC-NO = WRK-NULL-DOC-NO. DTSBD372
02581 DTSBD372
02582 DTSBD372
02583 SET WRK-ACCT-CREDIT-TOL TO TRUE. DTSBD372
02584 DTSBD372
02585 MOVE HIGH-VALUE TO WRK-MDST-DOC-NO. DTSBD372
02586 DTSBD372
02587 PERFORM P7100-UNIV-PR-CREDITS THRU P7100-EXIT DTSBD372
02588 UNTIL WRK-AMT1 <= +0 DTSBD372
02589 OR WRK-MDST-DOC-NO = WRK-NULL-DOC-NO. DTSBD372
02590 DTSBD372
02591 IF WRK-MDST-DOC-NO = WRK-NULL-DOC-NO DTSBD372
02592 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
02593 DTSBD372
02594 DTSBD372
02595 PERFORM S2100-MPAY-FROM-APAY THRU S2100-EXIT. DTSBD372
02596 DTSBD372
02597 MOVE MPAY-REC TO MSKL-REC. DTSBD372
02598 DTSBD372
02599 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
02600 DTSBD372
02601 DTSBD372
02602 SET L520-NO-PREF-88 TO TRUE. DTSBD372
02603 SET L520-ANNUAL-RPT-NULL-88 TO TRUE. DTSBD372
02604 MOVE ZERO TO L520-WITHDRAW-ANN-YRQ. DTSBD372
02605 SET L520-LAST-ANN-QTR-NULL-88 TO TRUE. DTSBD372
02606 DTSBD372
02607 MOVE WRK-NULL-DOC-NO TO L520-PREF-PAY-DOC-NO. DTSBD372
02608 DTSBD372
02609 MOVE +0 TO L520-PREF-APPLIC-YRQ. DTSBD372
02610 DTSBD372
02611 MOVE SPACE TO L520-PREF-APPLIC-IND. DTSBD372
02612 DTSBD372
02613 PERFORM S520-APPLY-CREDIT THRU S520-EXIT. DTSBD372
02614 P7000-EXIT. DTSBD372
02615 EXIT. DTSBD372
02616 SKIP3 DTSBD372
02617 P7100-UNIV-PR-CREDITS. DTSBD372
02618 MOVE +0 TO WRK-RECEIVED-DATE DTSBD372
02619 WRK-MREV-AMT DTSBD372
02620 HOLD-MDST-SUB. DTSBD372
02621 DTSBD372
02622 MOVE WRK-NULL-DOC-NO TO WRK-MDST-DOC-NO. DTSBD372
02623 DTSBD372
02624 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
02625 DTSBD372
02626 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
02627 DTSBD372
02628 SET MDST-DST-88 TO TRUE. DTSBD372
02629 DTSBD372
02630 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
02631 DTSBD372
02632 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02633 DTSBD372
02634 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD372
02635 DTSBD372
02636 PERFORM P7110-UNIV-PR-CREDIT-SCAN THRU P7110-EXIT DTSBD372
02637 UNTIL L910-NO-REC-88. DTSBD372
02638 DTSBD372
02639 IF WRK-MDST-DOC-NO = WRK-NULL-DOC-NO DTSBD372
02640 GO TO P7100-EXIT. DTSBD372
02641 DTSBD372
02642 DTSBD372
02643 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD372
02644 DTSBD372
02645 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
02646 DTSBD372
02647 SET MDST-DST-88 TO TRUE. DTSBD372
02648 DTSBD372
02649 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
02650 DTSBD372
02651 MOVE WRK-MDST-DOC-NO TO MDST-DOC-NO. DTSBD372
02652 DTSBD372
02653 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02654 DTSBD372
02655 PERFORM S910-READ THRU S910-EXIT. DTSBD372
02656 DTSBD372
02657 IF L910-NO-REC-88 DTSBD372
02658 PERFORM S999-ABEND THRU S999-EXIT. DTSBD372
02659 DTSBD372
02660 MOVE MSKL-REC TO MDST-REC. DTSBD372
02661 DTSBD372
02662 PERFORM P7120-UNIV-PR-MDST-MODIFY THRU P7120-EXIT. DTSBD372
02663 DTSBD372
02664 IF WRK-MREV-AMT NOT = +0 DTSBD372
02665 PERFORM P7130-UNIV-PR-ESTB-MREV THRU P7130-EXIT. DTSBD372
02666 P7100-EXIT. DTSBD372
02667 EXIT. DTSBD372
02668 SKIP3 DTSBD372
02669 P7110-UNIV-PR-CREDIT-SCAN. DTSBD372
02670 MOVE MSKL-REC TO MDST-REC. DTSBD372
02671 DTSBD372
02672 IF NOT MDST-CREDIT-REC-88 DTSBD372
02673 SET L910-NO-REC-88 TO TRUE DTSBD372
02674 GO TO P7110-EXIT. DTSBD372
02675 DTSBD372
02676 IF MDST-RECEIVED-DATE > WRK-RECEIVED-DATE DTSBD372
02677 PERFORM P7111-UNIV-PR-SEARCH THRU P7111-EXIT DTSBD372
02678 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
02679 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD372
02680 DTSBD372
02681 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD372
02682 P7110-EXIT. DTSBD372
02683 EXIT. DTSBD372
02684 SKIP3 DTSBD372
02685 P7111-UNIV-PR-SEARCH. DTSBD372
02686 IF MDST-ACCT-IND (MDST-ACCT-IDX) = WRK-ACCT-IND DTSBD372
02687 MOVE MDST-RECEIVED-DATE TO WRK-RECEIVED-DATE DTSBD372
02688 MOVE MDST-DOC-NO TO WRK-MDST-DOC-NO DTSBD372
02689 SET HOLD-MDST-SUB TO MDST-ACCT-IDX. DTSBD372
02690 P7111-EXIT. DTSBD372
02691 EXIT. DTSBD372
02692 SKIP3 DTSBD372
02693 P7120-UNIV-PR-MDST-MODIFY. DTSBD372
02694 IF MDST-AMT (HOLD-MDST-SUB) < WRK-AMT1 DTSBD372
02695 MOVE MDST-AMT (HOLD-MDST-SUB) TO L542-AMT DTSBD372
02696 ELSE DTSBD372
02697 MOVE WRK-AMT1 TO L542-AMT. DTSBD372
02698 DTSBD372
02699 COMPUTE WRK-AMT1 = WRK-AMT1 - L542-AMT. DTSBD372
02700 DTSBD372
02701 MOVE L542-AMT TO WRK-MREV-AMT. DTSBD372
02702 DTSBD372
02703 COMPUTE L542-AMT = L542-AMT * -1. DTSBD372
02704 DTSBD372
02705 MOVE MDST-ACCT-IND (HOLD-MDST-SUB) TO L542-ACCT-IND. DTSBD372
02706 DTSBD372
02707 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBD372
02708 DTSBD372
02709 PERFORM S4100-MDST-UPDATE THRU S4100-EXIT. DTSBD372
02710 P7120-EXIT. DTSBD372
02711 EXIT. DTSBD372
02712 SKIP3 DTSBD372
02713 P7130-UNIV-PR-ESTB-MREV. DTSBD372
02714 PERFORM S3200-INITIALIZE-MREV THRU S3200-EXIT. DTSBD372
02715 DTSBD372
02716 DTSBD372
02717 MOVE MDST-DOC-NO TO MREV-PA-DOC-NO. DTSBD372
02718 DTSBD372
02719 SET MREV-REVERSE-88 TO TRUE. DTSBD372
02720 DTSBD372
02721 MOVE WRK-MREV-AMT TO MREV-AMT. DTSBD372
02722 DTSBD372
02723 MOVE MREV-REC TO MSKL-REC. DTSBD372
02724 DTSBD372
02725 MOVE MREV-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02726 DTSBD372
02727 PERFORM S910-READ THRU S910-EXIT. DTSBD372
02728 DTSBD372
02729 IF L910-NO-REC-88 DTSBD372
02730 MOVE MREV-REC TO MSKL-REC DTSBD372
02731 PERFORM S910-WRITE THRU S910-EXIT DTSBD372
02732 ELSE DTSBD372
02733 MOVE MSKL-REC TO MREV-REC DTSBD372
02734 ADD WRK-MREV-AMT TO MREV-AMT DTSBD372
02735 MOVE LBCM-CURR-RUN-DATE TO MREV-CHNG-DATE DTSBD372
02736 MOVE MREV-REC TO MSKL-REC DTSBD372
02737 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD372
02738 P7130-EXIT. DTSBD372
02739 EXIT. DTSBD372
02740 EJECT DTSBD372
02741 S1100-READ-APAY-APPLIC. DTSBD372
02742 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBD372
02743 DTSBD372
02744 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBD372
02745 DTSBD372
02746 SET MPAY-PAY-88 TO TRUE. DTSBD372
02747 DTSBD372
02748 MOVE APAY-APPLIC-DOC-NO TO MPAY-DOC-NO. DTSBD372
02749 DTSBD372
02750 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02751 DTSBD372
02752 PERFORM S910-READ THRU S910-EXIT. DTSBD372
02753 DTSBD372
02754 MOVE MSKL-REC TO MPAY-REC. DTSBD372
02755 S1100-EXIT. DTSBD372
02756 EXIT. DTSBD372
02757 EJECT DTSBD372
02758 S2100-MPAY-FROM-APAY. DTSBD372
02759 MOVE LOW-VALUES TO MPAY-REC. DTSBD372
02760 DTSBD372
02761 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBD372
02762 DTSBD372
02763 SET MPAY-PAY-88 TO TRUE. DTSBD372
02764 DTSBD372
02765 MOVE APAY-DOC-NO TO MPAY-DOC-NO. DTSBD372
02766 DTSBD372
02767 MOVE +0 TO MPAY-PURGE-DATE. DTSBD372
02768 DTSBD372
02769 MOVE APAY-PAY-TYPE TO MPAY-PAY-TYPE. DTSBD372
02770 DTSBD372
02771 MOVE APAY-REMIT-AMT TO MPAY-REMIT-AMT. DTSBD372
02772 DTSBD372
02773 MOVE APAY-WAIVE-INT-IND TO MPAY-WAIVE-INT-IND. DTSBD372
02774 DTSBD372
02775 MOVE APAY-WAIVE-LATE-PEN-IND TO MPAY-WAIVE-LATE-PEN-IND. DTSBD372
02776 DTSBD372
02777 MOVE APAY-NSF-PEN-CHARGE-IND TO MPAY-NSF-PEN-CHARGE-IND. DTSBD372
02778 DTSBD372
02779 MOVE APAY-RECEIVED-DATE TO MPAY-RECEIVED-DATE. DTSBD372
02780 DTSBD372
02781 MOVE APAY-DEPOSIT-DATE TO MPAY-DEPOSIT-DATE. DTSBD372
02782 DTSBD372
02783 MOVE APAY-APPLIC-YRQ TO MPAY-APPLIC-YRQ. DTSBD372
02784 DTSBD372
02785 MOVE APAY-APPLIC-IND TO MPAY-APPLIC-IND. DTSBD372
02786 DTSBD372
02787 MOVE APAY-APPLIC-DOC-NO TO MPAY-APPLIC-DOC-NO. DTSBD372
02788 DTSBD372
02789 MOVE +0 TO MPAY-REFUND-VOUCHER-NUMBER. DTSBD372
02790 DTSBD372
02791 MOVE APAY-RESPONSIBLE-ACTIVITY TO MPAY-RESPONSIBLE-ACTIVITY. DTSBD372
02792 DTSBD372
02793 MOVE APAY-RESPONSIBLE-OP-ID TO MPAY-RESPONSIBLE-OP-ID. DTSBD372
02794 DTSBD372
02795 IF APAY-TRACE-NO NOT NUMERIC DTSBD372
02796 MOVE ZERO TO MPAY-TRACE-NO DTSBD372
02797 ELSE DTSBD372
02798 MOVE APAY-TRACE-NO TO MPAY-TRACE-NO. DTSBD372
02799 DTSBD372
02800 IF APAY-CHECK-SCAN-DT NOT NUMERIC DTSBD372
02801 MOVE ZERO TO MPAY-CHECK-SCAN-DT DTSBD372
02802 ELSE DTSBD372
02803 MOVE APAY-CHECK-SCAN-DT TO MPAY-CHECK-SCAN-DT DTSBD372
02804 END-IF. DTSBD372
02805 DTSBD372
02806 IF APAY-CHECK-SEQUENCE NOT NUMERIC DTSBD372
02807 MOVE ZERO TO MPAY-CHECK-SEQUENCE DTSBD372
02808 ELSE DTSBD372
02809 MOVE APAY-CHECK-SEQUENCE TO MPAY-CHECK-SEQUENCE DTSBD372
02810 END-IF. DTSBD372
02811 DTSBD372
02812 SET MPAY-NOT-CONVERTED-88 TO TRUE. DTSBD372
02813 DTSBD372
02814 MOVE LBCM-CURR-RUN-DATE TO MPAY-ESTB-DATE DTSBD372
02815 MPAY-CHNG-DATE. DTSBD372
02816 S2100-EXIT. DTSBD372
02817 EXIT. DTSBD372
02818 EJECT DTSBD372
02819 S3100-INITIALIZE-MDST. DTSBD372
02820 MOVE LOW-VALUES TO MDST-REC. DTSBD372
02821 DTSBD372
02822 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD372
02823 DTSBD372
02824 SET MDST-DST-88 TO TRUE. DTSBD372
02825 DTSBD372
02826 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD372
02827 DTSBD372
02828 MOVE APAY-DOC-NO TO MDST-DOC-NO. DTSBD372
02829 DTSBD372
02830 MOVE +0 TO MDST-PURGE-DATE. DTSBD372
02831 DTSBD372
02832 MOVE APAY-RECEIVED-DATE TO MDST-RECEIVED-DATE. DTSBD372
02833 DTSBD372
02834 SET MDST-NOT-CONVERTED-88 TO TRUE. DTSBD372
02835 DTSBD372
02836 MOVE LBCM-CURR-RUN-DATE TO MDST-ESTB-DATE DTSBD372
02837 MDST-CHNG-DATE. DTSBD372
02838 DTSBD372
02839 MOVE +0 TO MDST-ACCT-CNT. DTSBD372
02840 S3100-EXIT. DTSBD372
02841 EXIT. DTSBD372
02842 SKIP3 DTSBD372
02843 S3200-INITIALIZE-MREV. DTSBD372
02844 MOVE LOW-VALUES TO MREV-REC. DTSBD372
02845 DTSBD372
02846 MOVE MPRF-EMP-NO TO MREV-EMP-NO. DTSBD372
02847 DTSBD372
02848 SET MREV-REV-88 TO TRUE. DTSBD372
02849 DTSBD372
02850 MOVE WRK-NULL-DOC-NO TO MREV-PA-DOC-NO. DTSBD372
02851 DTSBD372
02852 MOVE APAY-DOC-NO TO MREV-PU-RF-PR-DOC-NO. DTSBD372
02853 DTSBD372
02854 MOVE +0 TO MREV-PURGE-DATE. DTSBD372
02855 DTSBD372
02856 MOVE SPACE TO MREV-FATE. DTSBD372
02857 DTSBD372
02858 MOVE +0 TO MREV-AMT. DTSBD372
02859 DTSBD372
02860 SET MREV-NOT-CONVERTED-88 TO TRUE. DTSBD372
02861 DTSBD372
02862 MOVE LBCM-CURR-RUN-DATE TO MREV-ESTB-DATE DTSBD372
02863 MREV-CHNG-DATE. DTSBD372
02864 S3200-EXIT. DTSBD372
02865 EXIT. DTSBD372
02866 EJECT DTSBD372
02867 S4100-MDST-UPDATE. DTSBD372
02868 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. DTSBD372
02869 DTSBD372
02870 *****IF MDST-CREDIT-REC-88 DTSBD372
02871 *********PERFORM DTSBD372
02872 ***********VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD372
02873 ***********UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD372
02874 *************IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBD372
02875 *****************PERFORM S4110-TOLERANCE-CHECK THRU S4110-EXIT DTSBD372
02876 *************END-IF DTSBD372
02877 *********END-PERFORM. DTSBD372
02878 DTSBD372
02879 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD372
02880 DTSBD372
02881 PERFORM S910-READ THRU S910-EXIT. DTSBD372
02882 DTSBD372
02883 IF L910-NO-REC-88 DTSBD372
02884 IF MDST-ACCT-CNT = +0 DTSBD372
02885 NEXT SENTENCE DTSBD372
02886 ELSE DTSBD372
02887 MOVE MDST-REC TO MSKL-REC DTSBD372
02888 PERFORM S910-WRITE THRU S910-EXIT DTSBD372
02889 ELSE DTSBD372
02890 IF MDST-ACCT-CNT = +0 DTSBD372
02891 PERFORM S910-DELETE THRU S910-EXIT DTSBD372
02892 ELSE DTSBD372
02893 MOVE MDST-REC TO MSKL-REC DTSBD372
02894 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD372
02895 S4100-EXIT. DTSBD372
02896 EXIT. DTSBD372
02897 SKIP3 DTSBD372
02898 *S4110-TOLERANCE-CHECK. DTSBD372
02899 *****IF (MDST-AMT (MDST-ACCT-IDX) = +0) DTSBD372
02900 *********************OR DTSBD372
02901 ********(MDST-AMT (MDST-ACCT-IDX) > LBCM-CR-TOL-MAX) DTSBD372
02902 *********NEXT SENTENCE DTSBD372
02903 *****ELSE DTSBD372
02904 *********PERFORM S590-CR-TOL THRU S590-EXIT. DTSBD372
02905 *S4110-EXIT. DTSBD372
02906 *****EXIT. DTSBD372
02907 EJECT DTSBD372
02908 S5100-MQTR-INITIALIZATION. DTSBD372
02909 PERFORM S511-MQTR-INIT THRU S511-EXIT. DTSBD372
02910 DTSBD372
02911 SET MQTR-NOT-CONVERTED-88 TO TRUE. DTSBD372
02912 DTSBD372
02913 MOVE LBCM-CURR-RUN-DATE TO MQTR-ESTB-DATE DTSBD372
02914 MQTR-CHNG-DATE. DTSBD372
02915 DTSBD372
02916 MOVE MQTR-YRQ TO L516-YRQ. DTSBD372
02917 DTSBD372
02918 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD372
02919 DTSBD372
02920 IF L516-ESTIMATED-RATE-88 DTSBD372
02921 MOVE MQTR-YRQ TO MSG9-YRQ DTSBD372
02922 MOVE MSG9-ID2 TO R907-MSG-ID DTSBD372
02923 MOVE MSG9-LONG-TEXT TO R907-MSG-TEXT DTSBD372
02924 PERFORM S946-R907-WRITE THRU S946-EXIT. DTSBD372
02925 DTSBD372
02926 IF L516-LIABLE-88 DTSBD372
02927 SET MQTR-CURR-NOT-DUE-88 TO TRUE DTSBD372
02928 ELSE DTSBD372
02929 SET MQTR-CURR-NOT-LIABLE-88 TO TRUE. DTSBD372
02930 DTSBD372
02931 IF MQTR-YRQ > LBCM-LAST-UC30-DEL-MAIL-YRQ DTSBD372
02932 SET MQTR-MISS-NOT-YET-RUN-88 TO TRUE DTSBD372
02933 ELSE DTSBD372
02934 SET MQTR-MISS-NOT-LIABLE-88 TO TRUE. DTSBD372
02935 DTSBD372
02936 MOVE L516-UI-RATE TO MQTR-UI-RATE. DTSBD372
02937 DTSBD372
02938 MOVE L516-DEFAULT-TAX-DUE-DATE TO MQTR-TAX-DUE-DATE DTSBD372
02939 DTSBD372
02940 MOVE L516-DEFAULT-RPT-DUE-DATE TO MQTR-RPT-DUE-DATE. DTSBD372
02941 DTSBD372
02942 PERFORM S5110-SET-CURR-RPT-TYPE THRU S5110-EXIT. DTSBD372
02943 S5100-EXIT. DTSBD372
02944 EXIT. DTSBD372
02945 S5110-SET-CURR-RPT-TYPE. DTSBD372
02946 IF MQTR-CURR-NOT-DUE-88 OR MQTR-CURR-DELINQ-88 DTSBD372
02947 NEXT SENTENCE DTSBD372
02948 ELSE DTSBD372
02949 GO TO S5110-EXIT. DTSBD372
02950 DTSBD372
02951 PERFORM S5111-DECR-PURSUED-RPT-CNT THRU S5111-EXIT. DTSBD372
02952 DTSBD372
02953 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBD372
02954 DTSBD372
02955 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD372
02956 DTSBD372
02957 IF MQTR-RPT-DUE-DATE = L004-QTR-DEFAULT-DUE-DATE DTSBD372
02958 IF MQTR-YRQ > LBCM-LAST-UC30-DEL-MAIL-YRQ DTSBD372
02959 SET MQTR-CURR-NOT-DUE-88 TO TRUE DTSBD372
02960 ELSE DTSBD372
02961 SET MQTR-CURR-DELINQ-88 TO TRUE DTSBD372
02962 ELSE DTSBD372
02963 IF MQTR-RPT-DUE-DATE > LBCM-CURR-RUN-DATE DTSBD372
02964 SET MQTR-CURR-NOT-DUE-88 TO TRUE DTSBD372
02965 MOVE MQTR-RPT-DUE-DATE TO WRK-TRIGGER-DATE DTSBD372
02966 PERFORM S5112-GENERATE-LTE-TCK THRU S5112-EXIT DTSBD372
02967 ELSE DTSBD372
02968 SET MQTR-CURR-DELINQ-88 TO TRUE. DTSBD372
02969 DTSBD372
02970 MOVE MQTR-PURSUED-RPT-IND TO WRK-PURSUED-RPT-IND. DTSBD372
02971 DTSBD372
02972 PERFORM S5113-SET-PURSUED-RPT-IND THRU S5113-EXIT. DTSBD372
02973 DTSBD372
02974 PERFORM S5114-INCR-PURSUED-RPT-CNT THRU S5114-EXIT. DTSBD372
02975 S5110-EXIT. DTSBD372
02976 EXIT. DTSBD372
02977 SKIP3 DTSBD372
02978 S5111-DECR-PURSUED-RPT-CNT. DTSBD372
02979 IF MQTR-RPT-IS-PURSUED-88 DTSBD372
02980 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT. DTSBD372
02981 S5111-EXIT. DTSBD372
02982 EXIT. DTSBD372
02983 SKIP3 DTSBD372
02984 S5112-GENERATE-LTE-TCK. DTSBD372
02985 MOVE LOW-VALUES TO MTCK-REC. DTSBD372
02986 DTSBD372
02987 MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSBD372
02988 DTSBD372
02989 SET MTCK-TCK-88 TO TRUE. DTSBD372
02990 DTSBD372
02991 ADD +1 TO LBCM-EMP-ABSTIME. DTSBD372
02992 DTSBD372
02993 MOVE LBCM-EMP-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBD372
02994 DTSBD372
02995 MOVE +0 TO MTCK-PURGE-DATE DTSBD372
02996 MTCK-TEXT-CNT. DTSBD372
02997 DTSBD372
02998 SET MTCK-TYPE-CHK-LATE-88 TO TRUE. DTSBD372
02999 DTSBD372
03000 MOVE WRK-TRIGGER-DATE TO MTCK-TRIGGER-DATE. DTSBD372
03001 DTSBD372
03002 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE. DTSBD372
03003 DTSBD372
03004 SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSBD372
03005 DTSBD372
03006 SET MTCK-DEST-SYSTEM-88 TO TRUE. DTSBD372
03007 DTSBD372
03008 MOVE MQTR-YRQ TO MTCK-LTE-YRQ. DTSBD372
03009 DTSBD372
03010 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSBD372
03011 DTSBD372
03012 MOVE LBCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSBD372
03013 MTCK-CHNG-DATE. DTSBD372
03014 DTSBD372
03015 MOVE MTCK-REC TO MSKL-REC. DTSBD372
03016 DTSBD372
03017 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
03018 S5112-EXIT. DTSBD372
03019 EXIT. DTSBD372
03020 SKIP3 DTSBD372
03021 S5113-SET-PURSUED-RPT-IND. DTSBD372
03022 IF (MPRF-NOT-WRITTEN-OFF-88) DTSBD372
03023 AND DTSBD372
03024 (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88) DTSBD372
03025 AND DTSBD372
03026 (MQTR-YRQ NOT < LBCM-FIRST-PURSUED-RPT-YRQ) DTSBD372
03027 SET MQTR-RPT-IS-PURSUED-88 TO TRUE DTSBD372
03028 ELSE DTSBD372
03029 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE. DTSBD372
03030 DTSBD372
03031 IF WRK-PURSUED-RPT-IND = 'N' DTSBD372
03032 IF MQTR-RPT-IS-PURSUED-88 DTSBD372
03033 PERFORM S590-QTR-PURSUED THRU S590-EXIT. DTSBD372
03034 S5113-EXIT. DTSBD372
03035 EXIT. DTSBD372
03036 SKIP3 DTSBD372
03037 S5114-INCR-PURSUED-RPT-CNT. DTSBD372
03038 IF MQTR-RPT-IS-PURSUED-88 DTSBD372
03039 ADD +1 TO MPRF-PURSUED-RPT-CNT. DTSBD372
03040 S5114-EXIT. DTSBD372
03041 EXIT. DTSBD372
03042 EJECT DTSBD372
03043 S6000-WRITE-MEVL. DTSBD372
03044 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD372
03045 DTSBD372
03046 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. DTSBD372
03047 DTSBD372
03048 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD372
03049 DTSBD372
03050 DTSBD372
03051 MOVE LOW-VALUES TO MEVL-REC. DTSBD372
03052 DTSBD372
03053 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBD372
03054 DTSBD372
03055 SET MEVL-EVL-88 TO TRUE. DTSBD372
03056 DTSBD372
03057 MOVE L005-DATE TO MEVL-DATE. DTSBD372
03058 DTSBD372
03059 MOVE L005-TIME TO MEVL-TIME. DTSBD372
03060 DTSBD372
03061 DTSBD372
03062 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBD372
03063 DTSBD372
03064 DTSBD372
03065 MOVE EVL-TEXT TO MEVL-TEXT. DTSBD372
03066 DTSBD372
03067 **** SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBD372
03068 MOVE MPAY-RESPONSIBLE-OP-ID TO MEVL-SOURCE. DTSBD372
03069 DTSBD372
03070 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBD372
03071 DTSBD372
03072 MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBD372
03073 MEVL-CHNG-DATE. DTSBD372
03074 DTSBD372
03075 DTSBD372
03076 MOVE MEVL-REC TO MSKL-REC. DTSBD372
03077 DTSBD372
03078 PERFORM S910-WRITE THRU S910-EXIT. DTSBD372
03079 S6000-EXIT. DTSBD372
03080 EXIT. DTSBD372
03081 EJECT DTSBD372
03082 S001-FROM-FED-8. DTSBD372
03083 SET L001-FROM-FED-8 TO TRUE. DTSBD372
03084 GO TO S001-DATE. DTSBD372
03085 DTSBD372
03086 S001-FROM-ABS-DAY. DTSBD372
03087 SET L001-FROM-ABS-DAY TO TRUE. DTSBD372
03088 GO TO S001-DATE. DTSBD372
03089 DTSBD372
03090 S001-DATE. DTSBD372
03091 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD372
03092 S001-EXIT. DTSBD372
03093 EXIT. DTSBD372
03094 SKIP3 DTSBD372
03095 S004-FROM-5. DTSBD372
03096 SET L004-FROM-5 TO TRUE. DTSBD372
03097 GO TO S004-QTR. DTSBD372
03098 DTSBD372
03099 S004-FROM-DATE. DTSBD372
03100 SET L004-FROM-DATE TO TRUE. DTSBD372
03101 GO TO S004-QTR. DTSBD372
03102 DTSBD372
03103 S004-FROM-ABS. DTSBD372
03104 SET L004-FROM-ABS TO TRUE. DTSBD372
03105 GO TO S004-QTR. DTSBD372
03106 DTSBD372
03107 S004-QTR. DTSBD372
03108 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD372
03109 S004-EXIT. DTSBD372
03110 EXIT. DTSBD372
03111 SKIP3 DTSBD372
03112 S005-FROM-ABSTIME. DTSBD372
03113 SET L005-FROM-ABSTIME TO TRUE. DTSBD372
03114 GO TO S005-ABSTIME. DTSBD372
03115 DTSBD372
03116 S005-ABSTIME. DTSBD372
03117 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD372
03118 S005-EXIT. DTSBD372
03119 EXIT. DTSBD372
03120 SKIP3 DTSBD372
03121 S061-DETERMINE-FLD-REP. DTSBD372
03122 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSBD372
03123 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBD372
03124 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBD372
03125 S061-EXIT. DTSBD372
03126 EXIT. DTSBD372
03127 DTSBD372
03128 S102-NSF-PAY-REVERSAL. DTSBD372
03129 SET L102-NSF-PAY-REVERSAL-88 TO TRUE. DTSBD372
03130 GO TO S102-LATE-PAY-PEN-CHARGE. DTSBD372
03131 DTSBD372
03132 S102-LATE-PAY-PEN-CHARGE. DTSBD372
03133 CALL 'DTSBU102' USING L102-LINK-AREA. DTSBD372
03134 S102-EXIT. DTSBD372
03135 EXIT. DTSBD372
03136 DTSBD372
03137 *& COMMENTED OUT UNTIL DTSBU109 IS MOVED TO PROD. DTSBD372
03138 *S109-PEN-INT-START-YRQ. DTSBD372
03139 * SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBD372
03140 * CALL 'DTSBU109' USING L109-LINK-AREA. DTSBD372
03141 * DTSBD372
03142 *S109-EXIT. DTSBD372
03143 EXIT. DTSBD372
03144 DTSBD372
03145 S111-LOOKUP-ADDR. DTSBD372
03146 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBD372
03147 DTSBD372
03148 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBD372
03149 S111-EXIT. DTSBD372
03150 EXIT. DTSBD372
03151 SKIP3 DTSBD372
03152 S112-FORMAT-ADDR. DTSBD372
03153 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBD372
03154 S112-EXIT. DTSBD372
03155 EXIT. DTSBD372
03156 SKIP3 DTSBD372
03157 S511-MQTR-INIT. DTSBD372
03158 CALL 'DTSBU511' USING MQTR-REC. DTSBD372
03159 S511-EXIT. DTSBD372
03160 EXIT. DTSBD372
03161 SKIP3 DTSBD372
03162 S516-LIABILITY-INFO. DTSBD372
03163 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD372
03164 MPRF-REC. DTSBD372
03165 S516-EXIT. DTSBD372
03166 EXIT. DTSBD372
03167 SKIP3 DTSBD372
03168 S520-APPLY-CREDIT. DTSBD372
03169 CALL 'DTSBU520' USING L520-LINK-AREA DTSBD372
03170 LBCM-LINK-AREA DTSBD372
03171 MPRF-REC. DTSBD372
03172 S520-EXIT. DTSBD372
03173 EXIT. DTSBD372
03174 SKIP3 DTSBD372
03175 S521-DSTRB-CHECK. DTSBD372
03176 SET L521-CHECK-VALIDITY-88 TO TRUE. DTSBD372
03177 GO TO S521-DSTRB-PROCESS. DTSBD372
03178 DTSBD372
03179 S521-DSTRB-UPDATE. DTSBD372
03180 SET L521-UPDATE-88 TO TRUE. DTSBD372
03181 GO TO S521-DSTRB-PROCESS. DTSBD372
03182 DTSBD372
03183 S521-DSTRB-PROCESS. DTSBD372
03184 CALL 'DTSBU521' USING L521-LINK-AREA DTSBD372
03185 LBCM-LINK-AREA DTSBD372
03186 MPRF-REC. DTSBD372
03187 S521-EXIT. DTSBD372
03188 EXIT. DTSBD372
03189 SKIP3 DTSBD372
03190 S530-WRITE-OFF. DTSBD372
03191 SET L530-WRITE-OFF-88 TO TRUE. DTSBD372
03192 GO TO S530-WRITE-OFF-REV-WRITE-OFF. DTSBD372
03193 DTSBD372
03194 S530-REVERSE-WRITE-OFF. DTSBD372
03195 SET L530-REVERSE-WRITE-OFF-88 TO TRUE. DTSBD372
03196 GO TO S530-WRITE-OFF-REV-WRITE-OFF. DTSBD372
03197 DTSBD372
03198 S530-WRITE-OFF-REV-WRITE-OFF. DTSBD372
03199 CALL 'DTSBU530' USING L530-LINK-AREA DTSBD372
03200 LBCM-LINK-AREA DTSBD372
03201 MPRF-REC. DTSBD372
03202 S530-EXIT. DTSBD372
03203 EXIT. DTSBD372
03204 SKIP3 DTSBD372
03205 S541-MODIFY-AMT. DTSBD372
03206 MOVE APAY-DOC-NO TO L541-TRN-DOC-NO. DTSBD372
03207 DTSBD372
03208 CALL 'DTSBU541' USING L541-LINK-AREA DTSBD372
03209 MPRF-REC DTSBD372
03210 MQTR-REC. DTSBD372
03211 S541-EXIT. DTSBD372
03212 EXIT. DTSBD372
03213 SKIP3 DTSBD372
03214 S542-MDST-MAINTENANCE. DTSBD372
03215 MOVE 'DTSBD372' TO L542-CALLED-BY. DTSBD372
03216 MOVE APAY-DOC-NO TO L542-TRN-DOC-NO. DTSBD372
03217 DTSBD372
03218 CALL 'DTSBU542' USING L542-LINK-AREA DTSBD372
03219 MPRF-REC DTSBD372
03220 MDST-REC. DTSBD372
03221 S542-EXIT. DTSBD372
03222 EXIT. DTSBD372
03223 SKIP3 DTSBD372
03224 *S590-CR-TOL. DTSBD372
03225 *****SET L590-CR-TOL-88 TO TRUE. DTSBD372
03226 *****MOVE +0 TO L590-YRQ. DTSBD372
03227 *****MOVE MDST-DOC-NO TO L590-PAY-DOC-NO. DTSBD372
03228 *****GO TO S590-EMP-CLEANUP. DTSBD372
03229 DTSBD372
03230 *S590-EMP-CLEANUP. DTSBD372
03231 *****MOVE APAY-DOC-NO TO L590-TOL-DOC-NO. DTSBD372
03232 DTSBD372
03233 *****CALL 'DTSBU590' USING L590-LINK-AREA DTSBD372
03234 ***************************LBCM-LINK-AREA DTSBD372
03235 ***************************MPRF-REC. DTSBD372
03236 *S590-EXIT. DTSBD372
03237 *****EXIT. DTSBD372
03238 SKIP3 DTSBD372
03239 S590-QTR-PURSUED. DTSBD372
03240 SET L590-QTR-PURSUED-88 TO TRUE. DTSBD372
03241 MOVE MQTR-YRQ TO L590-YRQ. DTSBD372
03242 MOVE WRK-NULL-DOC-NO TO L590-PAY-DOC-NO DTSBD372
03243 L590-TOL-DOC-NO DTSBD372
03244 GO TO S590-EMP-CLEANUP. DTSBD372
03245 DTSBD372
03246 S590-EMP-CLEANUP. DTSBD372
03247 CALL 'DTSBU590' USING L590-LINK-AREA DTSBD372
03248 LBCM-LINK-AREA DTSBD372
03249 MPRF-REC. DTSBD372
03250 S590-EXIT. DTSBD372
03251 EXIT. DTSBD372
03252 SKIP3 DTSBD372
03253 S910-READ. DTSBD372
03254 SET L910-READ-88 TO TRUE. DTSBD372
03255 GO TO S910-MSTR-IO. DTSBD372
03256 DTSBD372
03257 S910-START-BROWSE. DTSBD372
03258 SET L910-START-BROWSE-88 TO TRUE. DTSBD372
03259 GO TO S910-MSTR-IO. DTSBD372
03260 DTSBD372
03261 S910-READ-NEXT. DTSBD372
03262 SET L910-READ-NEXT-88 TO TRUE. DTSBD372
03263 GO TO S910-MSTR-IO. DTSBD372
03264 DTSBD372
03265 *S910-COUNT. DTSBD372
03266 *****SET L910-COUNT-88 TO TRUE. DTSBD372
03267 *****GO TO S910-MSTR-IO. DTSBD372
03268 DTSBD372
03269 S910-WRITE. DTSBD372
03270 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD372
03271 SET L910-WRITE-88 TO TRUE. DTSBD372
03272 GO TO S910-MSTR-IO. DTSBD372
03273 DTSBD372
03274 S910-REWRITE. DTSBD372
03275 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD372
03276 SET L910-REWRITE-88 TO TRUE. DTSBD372
03277 GO TO S910-MSTR-IO. DTSBD372
03278 DTSBD372
03279 S910-DELETE. DTSBD372
03280 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD372
03281 SET L910-DELETE-88 TO TRUE. DTSBD372
03282 GO TO S910-MSTR-IO. DTSBD372
03283 DTSBD372
03284 S910-MSTR-IO. DTSBD372
03285 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD372
03286 MSKL-REC. DTSBD372
03287 S910-EXIT. DTSBD372
03288 EXIT. DTSBD372
03289 SKIP3 DTSBD372
03290 S946-R303-WRITE. DTSBD372
03291 CALL 'DTSBU946' USING R303-REC. DTSBD372
03292 GO TO S946-EXIT. DTSBD372
03293 DTSBD372
03294 S946-R318-WRITE. DTSBD372
03295 DISPLAY 'BD372 S946 ' R318-EMP-NO DTSBD372
03296 ' ' R318-TRACE-NO. DTSBD372
03297 CALL 'DTSBU946' USING R318-REC. DTSBD372
03298 GO TO S946-EXIT. DTSBD372
03299 DTSBD372
03300 S946-R319-WRITE. DTSBD372
03301 DISPLAY 'BD372 S946 ' R319-EMP-NO DTSBD372
03302 ' ' R319-BATCH-NO. DTSBD372
03303 CALL 'DTSBU946' USING R319-REC. DTSBD372
03304 GO TO S946-EXIT. DTSBD372
03305 DTSBD372
03306 S946-R907-WRITE. DTSBD372
03307 CALL 'DTSBU946' USING R907-REC. DTSBD372
03308 GO TO S946-EXIT. DTSBD372
03309 DTSBD372
03310 S946-EXIT. DTSBD372
03311 EXIT. DTSBD372
03312 SKIP3 DTSBD372
03313 S999-ABEND. DTSBD372
03314 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD372
03315 S999-EXIT. DTSBD372
03316 EXIT. DTSBD372
Reference in New Issue View Git Blame Copy Permalink