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
