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