00001  IDENTIFICATION DIVISION.                                         05/14/10
00002  PROGRAM-ID.             DTSBX343.                                DTSBX343
00003  AUTHOR.                 NGC.                                        LV019
00004  DATE-WRITTEN.           OCTOBER 2007.                            DTSBX343
00005  DATE-COMPILED.                                                   DTSBX343
00006      SKIP3                                                        DTSBX343
00007 *****                                                             DTSBX343
00008 *                                                                 DTSBX343
00009 *    FUNCTION:  INTERNAL WEB MAINFRAME EXTRACT - ACCOUNTING       DTSBX343
00010 *               >>> INITIAL CONVERSION  <<<                       DTSBX343
00011 *                                                                 DTSBX343
00012 *               DTSBX342 IS FOR THE DAILY INCREMENTAL UPDATE      DTSBX343
00013 *                                                                 DTSBX343
00014 *    MODIFICATION LOG:                                            DTSBX343
00015 *                                                                 DTSBX343
00016 *    10/22/2007  INITIAL DEVELOPMENT.                             DTSBX343
00017 *                REFERENCE:                     PROGRAMMER: GD    DTSBX343
00018 *                                                                 DTSBX343
00019 *    04/17/2008  CORRECTED SELECTION FOR REPORTS IN P3100.        DTSBX343
00020 *                THE PROCESS THAT ATTEMPTED TO COMBINE 4          DTSBX343
00021 *                QUARTERLY REPORTS INTO ONE ANNUAL REPORT         DTSBX343
00022 *                HAD A PROBLEM WITH THE READS AND RESULTED        DTSBX343
00023 *                IN SOME NON-ANNUAL REPORTS BEING BYPASSED.       DTSBX343
00024 *                THE ANNUAL REPORTS ARE NOW WRITTEN IN            DTSBX343
00025 *                EXACTLY THE SAME WAY AS QUARTERLY REPORTS.       DTSBX343
00026 *                REFERENCE:                     PROGRAMMER: GD    DTSBX343
00027 *                                                                 DTSBX343
00028 *    03/02/2009  MODIFIED P5000 (PAY DISTRIBUTION) TO SELECT      DTSBX343
00029 *                RECORDS FOR ALL EMPLOYERS - NOT JUST THOSE       DTSBX343
00030 *                WITH CREDITS.                                    DTSBX343
00031 *                REFERENCE:                     PROGRAMMER: GD    DTSBX343
00032 *                                                                 DTSBX343
00033 *    03/11/2009  MODIFIED FOR INCREMENTAL UPDATE OF ACCOUNTING    DTSBX343
00034 *                TRANSACTION FILES.  PARAGRAPHS AFFECTED:         DTSBX343
00035 *                P2110, P3110, P3210, P3310.                      DTSBX343
00036 *                NEW, TEMPORARY, FILES ADDED FOR INCREMENTAL      DTSBX343
00037 *                RECORDS FOR TESTING. THE REGULAR FILES CONTINUE  DTSBX343
00038 *                TO BE PRODUCED FOR THE PRODUCTION DATABASE.      DTSBX343
00039 *                REFERENCE:                     PROGRAMMER: GD    DTSBX343
00040 *                                                                 DTSBX343
00041 *    11/05/2009  REMOVED TRAN AND ACCT FILES - ONLY THE           DTSBX343
00042 *                INCREMENTALLY UPDATED VERSIONS WILL BE WRITTEN.  DTSBX343
00043 *                REFERENCE:                     PROGRAMMER: GD    DTSBX343
00044 *                                                                 DTSBX343
00045 *    01/22/2010  MODIFIED PROCESS THAT SETS BALANCE DUE IN        DTSBX343
00046 *                P1210-BAL-DUE. IF CURRENT DATE < THE TAX DUE     DTSBX343
00047 *                DATE FOR THE QUARTER, SET THE BALANCE DUE TO 0.  DTSBX343
00048 *                REFERENCE:                     PROGRAMMER: GD    DTSBX343
00049 *                                                                 DTSBX343
00050 *    04/05/2010  ADDED TAX DUE DATE TO TA1-QUARTER TABLE.         DTSBX343
00051 *                ADDED RECEIVED DATE TO TA3-ACCT-DETAIL TABLE.    DTSBX343
00052 *                ADDED RESP ACTIVITY AND RESP OPID TO             DTSBX343
00053 *                TA2-TRAN-DETAIL.                                 DTSBX343
00054 *                REFERENCE:                     PROGRAMMER: GD    DTSBX343
00055 *                                                                 DTSBX343
00056 *    05/14/2010  CORRECTED ORDER OF FIELDS IN W-QTR-REC TO        DTSBX343
00057 *                MATCH ORDER EXPECTED IN SQL SERVER DATABASE.     DTSBX343
00058 *                REFERENCE:                     PROGRAMMER: GD    DTSBX343
00059 *                                                                 DTSBX343
00060 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX343
00061 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX343
00062 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBX343
00063 *                                                                 DTSBX343
00064 *                                                                 DTSBX343
00065 *  DESCRIPTION:                                                   DTSBX343
00066 *                                                                 DTSBX343
00067 *                                                                 DTSBX343
00068 *    INITIATION:                                                  DTSBX343
00069 *                                                                 DTSBX343
00070 *                                                                 DTSBX343
00071 *                                                                 DTSBX343
00072 *    PROCESSING:                                                  DTSBX343
00073 *                                                                 DTSBX343
00074 *                                                                 DTSBX343
00075 *    TERMINATION:                                                 DTSBX343
00076 *                                                                 DTSBX343
00077 *                                                                 DTSBX343
00078 *                                                                 DTSBX343
00079 *    RECORDS READ:                                                DTSBX343
00080 *                                                                 DTSBX343
00081 *      MASTER:                                                    DTSBX343
00082 *                                                                 DTSBX343
00083 *        MQTR                                                     DTSBX343
00084 *        MJRN                                                     DTSBX343
00085 *        MPAY                                                     DTSBX343
00086 *        MRPT                                                     DTSBX343
00087 *        MADJ                                                     DTSBX343
00088 *                                                                 DTSBX343
00089 *                                                                 DTSBX343
00090 *      ALTERNATE INDEX:                                           DTSBX343
00091 *                                                                 DTSBX343
00092 *        NONE.                                                    DTSBX343
00093 *                                                                 DTSBX343
00094 *                                                                 DTSBX343
00095 *      REFERENCE:                                                 DTSBX343
00096 *                                                                 DTSBX343
00097 *                                                                 DTSBX343
00098 *                                                                 DTSBX343
00099 *    RECORDS UPDATED:                                             DTSBX343
00100 *                                                                 DTSBX343
00101 *        NONE                                                     DTSBX343
00102 *                                                                 DTSBX343
00103 *                                                                 DTSBX343
00104 *    OUTPUT RECORDS WRITTEN:                                      DTSBX343
00105 *                                                                 DTSBX343
00106 *        DTSBX331                                                 DTSBX343
00107 *                                                                 DTSBX343
00108 *                                                                 DTSBX343
00109 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBX343
00110 *                                                                 DTSBX343
00111 *        NONE.                                                    DTSBX343
00112 *                                                                 DTSBX343
00113 *                                                                 DTSBX343
00114 *    MODULES CALLED:                                              DTSBX343
00115 *                                                                 DTSBX343
00116 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBX343
00117 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBX343
00118 *        DTSBU910  MASTER FILE I/O.                               DTSBX343
00119 *                                                                 DTSBX343
00120 *                                                                 DTSBX343
00121 *                                                                 DTSBX343
00122 *****                                                             DTSBX343
00123      SKIP3                                                        DTSBX343
00124  ENVIRONMENT DIVISION.                                            DTSBX343
00125  INPUT-OUTPUT SECTION.                                            DTSBX343
00126  FILE-CONTROL.                                                    DTSBX343
00127 **   SELECT ACCT-FILE               ASSIGN TO DTSFACC1            DTSBX343
00128 **      FILE STATUS IS ACCT-STATUS.                               DTSBX343
00129                                                                   DTSBX343
00130      SELECT ACCT-FILE-INCR          ASSIGN TO DTSFACC3            DTSBX343
00131         FILE STATUS IS ACCT-I-STATUS.                             DTSBX343
00132                                                                   DTSBX343
00133 **   SELECT TRAN-FILE               ASSIGN TO DTSFTRN1            DTSBX343
00134 **      FILE STATUS IS TRAN-STATUS.                               DTSBX343
00135                                                                   DTSBX343
00136      SELECT TRAN-FILE-INCR          ASSIGN TO DTSFTRN3            DTSBX343
00137         FILE STATUS IS TRAN-I-STATUS.                             DTSBX343
00138                                                                   DTSBX343
00139      SELECT QTR-FILE               ASSIGN TO DTSFQTR1             DTSBX343
00140         FILE STATUS IS QTR-STATUS.                                DTSBX343
00141                                                                   DTSBX343
00142      SELECT SUMMARY-FILE           ASSIGN TO DTSFSUM1             DTSBX343
00143             FILE STATUS IS SUMMARY-STATUS.                        DTSBX343
00144                                                                   DTSBX343
00145      SELECT PAY-DIST-FILE          ASSIGN TO DTSFDST1             DTSBX343
00146             FILE STATUS IS PAYDIST-STATUS.                        DTSBX343
00147                                                                   DTSBX343
00148  DATA DIVISION.                                                   DTSBX343
00149  FILE SECTION.                                                    DTSBX343
00150  FD  ACCT-FILE-INCR                                               DTSBX343
00151      RECORDING MODE IS F                                          DTSBX343
00152      LABEL RECORDS ARE STANDARD                                   DTSBX343
00153      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX343
00154                                                                   DTSBX343
00155  01  ACCT-INCR-REC                 PIC  X(72).                    DTSBX343
00156                                                                   DTSBX343
00157  FD  TRAN-FILE-INCR                                               DTSBX343
00158      RECORDING MODE IS F                                          DTSBX343
00159      LABEL RECORDS ARE STANDARD                                   DTSBX343
00160      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX343
00161                                                                   DTSBX343
00162  01  TRAN-INCR-REC                 PIC  X(141).                   DTSBX343
00163                                                                   DTSBX343
00164  FD  QTR-FILE                                                     DTSBX343
00165      RECORDING MODE IS F                                          DTSBX343
00166      LABEL RECORDS ARE STANDARD                                   DTSBX343
00167      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX343
00168                                                                   DTSBX343
00169  01  QTR-REC                       PIC  X(63).                    DTSBX343
00170                                                                   DTSBX343
00171  FD  SUMMARY-FILE                                                 DTSBX343
00172      RECORDING MODE IS F.                                         DTSBX343
00173  01  SUMMARY-REC             PIC X(73).                           DTSBX343
00174                                                                   DTSBX343
00175  FD  PAY-DIST-FILE                                                DTSBX343
00176      RECORDING MODE IS F.                                         DTSBX343
00177  01  PAY-DIST-REC            PIC X(50).                           DTSBX343
00178                                                                   DTSBX343
00179  WORKING-STORAGE SECTION.                                         DTSBX343
001795 77  PAN-VALET PICTURE X(24) VALUE '019DTSBX343  05/14/10'.       DTSBX343
00180      SKIP3                                                        DTSBX343
00181  01  W-AREA.                                                      DTSBX343
00182      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE +343.DTSBX343
00183                                                                   DTSBX343
00184                                                                   DTSBX343
00185      05  ABEND-MSG                   PIC  X(60).                  DTSBX343
00186                                                                   DTSBX343
00187      05  PARM-STATUS                 PIC  X(02).                  DTSBX343
00188          88  PARM-STATUS-OK-88           VALUE '00'.              DTSBX343
00189      05  ACCT-STATUS                 PIC  X(02).                  DTSBX343
00190          88  ACCT-STATUS-OK-88        VALUE '00'.                 DTSBX343
00191          88  ACCT-STATUS-EOF-88       VALUE '10'.                 DTSBX343
00192      05  ACCT-I-STATUS               PIC  X(02).                  DTSBX343
00193          88  ACCT-I-STATUS-OK-88        VALUE '00'.               DTSBX343
00194          88  ACCT-I-STATUS-EOF-88       VALUE '10'.               DTSBX343
00195      05  TRAN-STATUS                 PIC  X(02).                  DTSBX343
00196          88  TRAN-STATUS-OK-88        VALUE '00'.                 DTSBX343
00197      05  TRAN-I-STATUS               PIC  X(02).                  DTSBX343
00198          88  TRAN-I-STATUS-OK-88        VALUE '00'.               DTSBX343
00199      05  QTR-STATUS                  PIC  X(02).                  DTSBX343
00200          88  QTR-STATUS-OK-88         VALUE '00'.                 DTSBX343
00201      05  QCOLL-STATUS                PIC  X(02).                  DTSBX343
00202          88  QCOLL-STATUS-OK-88        VALUE '00'.                DTSBX343
00203      05  SUMMARY-STATUS              PIC  X(02).                  DTSBX343
00204          88  SUMMARY-STATUS-OK-88      VALUE '00'.                DTSBX343
00205      05  PAYDIST-STATUS              PIC  X(02).                  DTSBX343
00206          88  PAYDIST-STATUS-OK-88      VALUE '00'.                DTSBX343
00207                                                                   DTSBX343
00208      05  EMP-STATUS                  PIC  X(02).                  DTSBX343
00209          88  EMP-STATUS-OK-88         VALUE '00'.                 DTSBX343
00210                                                                   DTSBX343
00211      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.        DTSBX343
00212          88  W-ERROR-YES-88           VALUE 'Y'.                  DTSBX343
00213          88  W-ERROR-NO-88            VALUE 'N'.                  DTSBX343
00214                                                                   DTSBX343
00215      05  W-RPT-COMPLETE-IND          PIC  X(01).                  DTSBX343
00216          88  W-RPT-COMPLETE-YES-88    VALUE 'Y'.                  DTSBX343
00217          88  W-RPT-COMPLETE-NO-88     VALUE 'N'.                  DTSBX343
00218          88  W-RPT-COMPLETE-NULL-88 VALUE ' '.                    DTSBX343
00219                                                                   DTSBX343
00220      05  W-UI-CHARGE-IND             PIC  X(01).                  DTSBX343
00221          88  W-UI-CHARGE-YES-88       VALUE 'Y'.                  DTSBX343
00222          88  W-UI-CHARGE-NO-88        VALUE 'N'.                  DTSBX343
00223      05  W-LP-CHARGE-IND             PIC  X(01).                  DTSBX343
00224          88  W-LP-CHARGE-YES-88       VALUE 'Y'.                  DTSBX343
00225          88  W-LP-CHARGE-NO-88        VALUE 'N'.                  DTSBX343
00226                                                                   DTSBX343
00227      05  W-STATUS-CD                 PIC  X(02).                  DTSBX343
00228          88  W-STATUS-WITHDRAWN-88    VALUE '04', '05'.           DTSBX343
00229                                                                   DTSBX343
00230      05  CONV-QTR-SUB             PIC S9(04)  COMP.               DTSBX343
00231      05  QSUB                     PIC S9(04)  COMP.               DTSBX343
00232      05  QMAX                     PIC S9(04)  COMP VALUE +400.    DTSBX343
00233      05  ACCT-TABLE    OCCURS 400 TIMES.                          DTSBX343
00234          10  TBL-YRQ                PIC S9(05)     COMP-3.        DTSBX343
00235          10  TBL-JRN-IND            PIC  X(01).                   DTSBX343
00236              88  TBL-JRN-GOOD-88     VALUE '0'.                   DTSBX343
00237              88  TBL-JRN-BAD-88      VALUE '1'.                   DTSBX343
00238          10  Q-UI-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00239          10  Q-UI-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00240          10  Q-UI-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00241          10  Q-UI-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00242          10  Q-UI-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00243          10  Q-UI-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00244          10  J-UI-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00245          10  J-UI-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00246          10  J-UI-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00247          10  J-UI-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00248          10  J-UI-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00249          10  J-UI-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00250          10  Q-INT-CHG              PIC S9(11)V99  COMP-3.        DTSBX343
00251          10  Q-INT-PD               PIC S9(11)V99  COMP-3.        DTSBX343
00252          10  Q-INT-WV               PIC S9(11)V99  COMP-3.        DTSBX343
00253          10  Q-INT-WO               PIC S9(11)V99  COMP-3.        DTSBX343
00254          10  Q-INT-TL               PIC S9(11)V99  COMP-3.        DTSBX343
00255          10  Q-INT-BAL              PIC S9(11)V99  COMP-3.        DTSBX343
00256          10  J-INT-CHG              PIC S9(11)V99  COMP-3.        DTSBX343
00257          10  J-INT-PD               PIC S9(11)V99  COMP-3.        DTSBX343
00258          10  J-INT-WV               PIC S9(11)V99  COMP-3.        DTSBX343
00259          10  J-INT-WO               PIC S9(11)V99  COMP-3.        DTSBX343
00260          10  J-INT-TL               PIC S9(11)V99  COMP-3.        DTSBX343
00261          10  J-INT-BAL              PIC S9(11)V99  COMP-3.        DTSBX343
00262          10  Q-LP-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00263          10  Q-LP-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00264          10  Q-LP-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00265          10  Q-LP-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00266          10  Q-LP-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00267          10  Q-LP-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00268          10  J-LP-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00269          10  J-LP-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00270          10  J-LP-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00271          10  J-LP-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00272          10  J-LP-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00273          10  J-LP-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00274          10  Q-NP-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00275          10  Q-NP-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00276          10  Q-NP-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00277          10  Q-NP-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00278          10  Q-NP-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00279          10  Q-NP-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00280          10  J-NP-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00281          10  J-NP-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00282          10  J-NP-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00283          10  J-NP-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00284          10  J-NP-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00285          10  J-NP-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00286          10  Q-MP-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00287          10  Q-MP-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00288          10  Q-MP-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00289          10  Q-MP-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00290          10  Q-MP-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00291          10  Q-MP-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00292          10  J-MP-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00293          10  J-MP-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00294          10  J-MP-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00295          10  J-MP-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00296          10  J-MP-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00297          10  J-MP-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00298          10  Q-SU-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00299          10  Q-SU-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00300          10  Q-SU-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00301          10  Q-SU-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00302          10  Q-SU-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00303          10  Q-SU-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00304          10  J-SU-CHG               PIC S9(11)V99  COMP-3.        DTSBX343
00305          10  J-SU-PD                PIC S9(11)V99  COMP-3.        DTSBX343
00306          10  J-SU-WV                PIC S9(11)V99  COMP-3.        DTSBX343
00307          10  J-SU-WO                PIC S9(11)V99  COMP-3.        DTSBX343
00308          10  J-SU-TL                PIC S9(11)V99  COMP-3.        DTSBX343
00309          10  J-SU-BAL               PIC S9(11)V99  COMP-3.        DTSBX343
00310                                                                   DTSBX343
00311      05  W-AMT                      PIC S9(11)V99   COMP-3.       DTSBX343
00312      05  W-TOT-CHG                  PIC S9(11)V99   COMP-3        DTSBX343
00313                                       VALUE +0.                   DTSBX343
00314      05  W-TOT-PD                   PIC S9(11)V99   COMP-3        DTSBX343
00315                                       VALUE +0.                   DTSBX343
00316      05  W-TOT-CREDIT               PIC S9(11)V99   COMP-3        DTSBX343
00317                                       VALUE +0.                   DTSBX343
00318      05  W-CREDIT-CORRECT           PIC S9(11)V99   COMP-3        DTSBX343
00319                                       VALUE +0.                   DTSBX343
00320                                                                   DTSBX343
00321      05  W-DEFAULT-DATE           PIC  X(10)                      DTSBX343
00322                                     VALUE '12/31/1994'.           DTSBX343
00323                                                                   DTSBX343
00324      05  W-MPRF-CNT               PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00325      05  W-MJRN-READ-CNT          PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00326      05  W-ERROR-CNT              PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00327      05  W-ACCT-CNT               PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00328      05  W-ACCT-CNT-INCR          PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00329      05  W-TRAN-CNT               PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00330      05  W-TRAN-CNT-INCR          PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00331      05  W-SUMMARY-CNT            PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00332      05  W-RPT-CNT                PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00333      05  W-ANN-RPT-CNT            PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00334      05  W-PAY-CNT                PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00335      05  W-PAY-DIST-CNT           PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00336      05  W-ADJ-CNT                PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00337      05  W-QTR-CNT                PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00338      05  W-CR-CNT                 PIC S9(07)    COMP-3 VALUE +0.  DTSBX343
00339      05  W-BATCH                  PIC S9(05)    COMP-3 VALUE +0.  DTSBX343
00340      05  W-ITEM                   PIC S9(03)    COMP-3 VALUE +0.  DTSBX343
00341      05  ADJ-CHG                  PIC S9(09)V99 COMP-3.           DTSBX343
00342      05  ADJ-PD                   PIC S9(09)V99 COMP-3.           DTSBX343
00343      05  ADJ-WV                   PIC S9(09)V99 COMP-3.           DTSBX343
00344      05  ADJ-WO                   PIC S9(09)V99 COMP-3.           DTSBX343
00345      05  ADJ-TL                   PIC S9(09)V99 COMP-3.           DTSBX343
00346      05  W-CHG                    PIC S9(09)V99 COMP-3.           DTSBX343
00347      05  W-PD                     PIC S9(09)V99 COMP-3.           DTSBX343
00348      05  W-WV                     PIC S9(09)V99 COMP-3.           DTSBX343
00349      05  W-WO                     PIC S9(09)V99 COMP-3.           DTSBX343
00350      05  W-TL                     PIC S9(09)V99 COMP-3.           DTSBX343
00351      05  W-BAL                    PIC S9(09)V99 COMP-3.           DTSBX343
00352      05  W-QTR-BAL                PIC S9(11)V99 COMP-3.           DTSBX343
00353      05  W-RATE                   PIC S9(03)V9(04) COMP-3.        DTSBX343
00354      05  W-JC-BATCH               PIC S9(05)       COMP-3         DTSBX343
00355                                     VALUE +00010.                 DTSBX343
00356      05  W-JC-ITEM                PIC S9(03)       COMP-3         DTSBX343
00357                                     VALUE +0.                     DTSBX343
00358                                                                   DTSBX343
00359      05  ASUB                     PIC S9(04)  COMP.               DTSBX343
00360      05  ASUB1                    PIC S9(04)  COMP.               DTSBX343
00361      05  ASUB-MAX                 PIC S9(04)  COMP VALUE +50.     DTSBX343
00362      05  ASUB-LAST                PIC S9(04)  COMP VALUE +0.      DTSBX343
00363      05  ANN-RPT-TABLE OCCURS 50 TIMES.                           DTSBX343
00364          10  W-ANN-RPT-TYPE         PIC  X(02).                   DTSBX343
00365          10  W-ANN-YRQ              PIC  9(05).                   DTSBX343
00366          10  FILLER REDEFINES W-ANN-YRQ.                          DTSBX343
00367              15  W-ANN-YRQ-CCYY     PIC  9(04).                   DTSBX343
00368              15  W-ANN-YRQ-Q        PIC  9(01).                   DTSBX343
00369                                                                   DTSBX343
00370          10  W-ANN-BATCH            PIC S9(05)      COMP-3.       DTSBX343
00371          10  W-ANN-ITEM             PIC S9(03)      COMP-3.       DTSBX343
00372          10  W-ANN-RATE             PIC S9(03)V9(04) COMP-3.      DTSBX343
00373          10  W-ANN-REMIT            PIC S9(09)V99   COMP-3.       DTSBX343
00374          10  W-ANN-TOT-WAGE         PIC S9(09)V99   COMP-3.       DTSBX343
00375          10  W-ANN-TAX-WAGE         PIC S9(09)V99   COMP-3.       DTSBX343
00376          10  W-ANN-EXCESS-WAGE      PIC S9(09)V99   COMP-3.       DTSBX343
00377          10  W-ANN-RCVD-DT          PIC S9(09)      COMP-3.       DTSBX343
00378          10  W-ANN-PROCESS-DT       PIC S9(09)      COMP-3.       DTSBX343
00379                                                                   DTSBX343
00380      05  W-LAST-ANN-YRQ             PIC S9(05)      COMP-3.       DTSBX343
00381                                                                   DTSBX343
00382      05  W-ACCT-REC.                                              DTSBX343
00383          10  ACCT-EMP-NO                PIC 9(06).                DTSBX343
00384          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00385          10  ACCT-YRQ                   PIC X(06).                DTSBX343
00386          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00387          10  ACCT-BATCH                 PIC 9(05).                DTSBX343
00388          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00389          10  ACCT-ITEM                  PIC 9(03).                DTSBX343
00390          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00391          10  ACCT-TRAN                  PIC X(02).                DTSBX343
00392          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00393          10  ACCT-ROW                   PIC X(02).                DTSBX343
00394          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00395          10  ACCT-COL                   PIC X(02).                DTSBX343
00396          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00397          10  ACCT-AMT                   PIC ---------9.99.        DTSBX343
00398          10  ACCT-AMT-9 REDEFINES ACCT-AMT  PIC 9(10).99.         DTSBX343
00399          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00400          10  ACCT-CAT                   PIC X(01).                DTSBX343
00401          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00402          10  ACCT-PROCESS-DT            PIC X(10).                DTSBX343
00403          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00404          10  ACCT-SOURCE                PIC X(01).                DTSBX343
00405              88  ACCT-SOURCE-CR-DB-88    VALUE '1'.               DTSBX343
00406              88  ACCT-SOURCE-STATUS-88   VALUE '2'.               DTSBX343
00407              88  ACCT-SOURCE-ERROR-88    VALUE '3'.               DTSBX343
00408          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00409          10  ACCT-RCVD-DT               PIC X(10).                DTSBX343
00410                                                                   DTSBX343
00411      05  W-TRAN-REC.                                              DTSBX343
00412          10  TRAN-EMP-NO                PIC 9(06).                DTSBX343
00413          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00414          10  TRAN-YRQ                   PIC X(06).                DTSBX343
00415          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00416          10  TRAN-BATCH                 PIC 9(05).                DTSBX343
00417          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00418          10  TRAN-ITEM                  PIC 9(03).                DTSBX343
00419          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00420          10  TRAN-TRANS                 PIC X(02).                DTSBX343
00421          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00422          10  TRAN-AMT                   PIC --------9.99.         DTSBX343
00423          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00424          10  TRAN-TOT-WAGE              PIC ----------9.99.       DTSBX343
00425          10  TRAN-TOT-WAGE-X REDEFINES TRAN-TOT-WAGE              DTSBX343
00426                                         PIC X(14).                DTSBX343
00427          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00428          10  TRAN-TAX-WAGE              PIC ----------9.99.       DTSBX343
00429          10  TRAN-TAX-WAGE-X REDEFINES TRAN-TAX-WAGE              DTSBX343
00430                                         PIC X(14).                DTSBX343
00431          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00432          10  TRAN-EXC-WAGE              PIC ----------9.99.       DTSBX343
00433          10  TRAN-EXC-WAGE-X REDEFINES TRAN-EXC-WAGE              DTSBX343
00434                                         PIC X(14).                DTSBX343
00435          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00436          10  TRAN-RATE                  PIC Z9.9.                 DTSBX343
00437          10  TRAN-RATE-X REDEFINES TRAN-RATE                      DTSBX343
00438                                         PIC X(04).                DTSBX343
00439          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00440          10  TRAN-ACCT                  PIC X(02).                DTSBX343
00441          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00442          10  TRAN-CAT                   PIC X(01).                DTSBX343
00443          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00444          10  TRAN-SOURCE                PIC X(01).                DTSBX343
00445              88  TRAN-SOURCE-CR-DB-88    VALUE '1'.               DTSBX343
00446              88  TRAN-SOURCE-STATUS-88   VALUE '2'.               DTSBX343
00447              88  TRAN-SOURCE-ERROR-88    VALUE '3'.               DTSBX343
00448          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00449          10  TRAN-RCVD-DT               PIC X(10).                DTSBX343
00450          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00451          10  TRAN-PROCESS-DT            PIC X(10).                DTSBX343
00452          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00453          10  TRAN-APPLIC-BATCH          PIC 9(05).                DTSBX343
00454          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00455          10  TRAN-APPLIC-ITEM           PIC 9(03).                DTSBX343
00456          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00457          10  TRAN-RESP-ACTIVITY         PIC X(03).                DTSBX343
00458          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00459          10  TRAN-RESP-OPID             PIC X(08).                DTSBX343
00460                                                                   DTSBX343
00461      05  W-QTR-REC.                                               DTSBX343
00462          10  QTR-EMP-NO                 PIC 9(06).                DTSBX343
00463          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00464          10  QTR-QUARTER                PIC X(06).                DTSBX343
00465          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00466          10  QTR-RPT-STATUS             PIC X(01).                DTSBX343
00467          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00468          10  QTR-RPT-DUE-DT             PIC X(10).                DTSBX343
00469          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00470          10  QTR-PROCESS-DT             PIC X(10).                DTSBX343
00471          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00472          10  QTR-BAL-DUE                PIC ----------9.99.       DTSBX343
00473          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00474          10  QTR-TAX-DUE-DT             PIC X(10).                DTSBX343
00475                                                                   DTSBX343
00476      05  W-SUMMARY-REC.                                           DTSBX343
00477          10  SUMMARY-PROCESS-DT         PIC X(10).                DTSBX343
00478          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00479          10  SUMMARY-MESSAGE            PIC X(40).                DTSBX343
00480          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00481          10  SUMMARY-EMP-NO             PIC 9(06).                DTSBX343
00482          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00483          10  SUMMARY-BATCH              PIC 9(05).                DTSBX343
00484          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00485          10  SUMMARY-ITEM               PIC 9(03).                DTSBX343
00486          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00487          10  SUMMARY-TRAN               PIC X(02).                DTSBX343
00488          10  FILLER                     PIC X(01) VALUE ','.      DTSBX343
00489          10  SUMMARY-SOURCE             PIC X(01).                DTSBX343
00490              88  SUMMARY-SOURCE-CR-DB-88 VALUE '1'.               DTSBX343
00491              88  SUMMARY-SOURCE-STATUS-88 VALUE '2'.              DTSBX343
00492              88  SUMMARY-SOURCE-ERROR-88 VALUE '3'.               DTSBX343
00493                                                                   DTSBX343
00494      05  W-PAY-DIST-REC.                                          DTSBX343
00495          10  DST-EMP-NO              PIC  9(06).                  DTSBX343
00496          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX343
00497          10  DST-BATCH               PIC  9(05).                  DTSBX343
00498          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX343
00499          10  DST-ITEM                PIC  9(03).                  DTSBX343
00500          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX343
00501          10  DST-QTR                 PIC  X(06).                  DTSBX343
00502          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX343
00503          10  DST-ACCT                PIC  X(02).                  DTSBX343
00504          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX343
00505          10  DST-AMT                 PIC  --------9.99.           DTSBX343
00506          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX343
00507          10  DST-CHNG-DT             PIC  X(10).                  DTSBX343
00508                                                                   DTSBX343
00509      05  W-CURR-UI-TOT            PIC S9(11)V99 COMP-3            DTSBX343
00510                                    VALUE +0.                      DTSBX343
00511                                                                   DTSBX343
00512      05  DISPLAY-CNT                PIC  Z(06)9.                  DTSBX343
00513                                                                   DTSBX343
00514      05  DISPLAY-AMT1-X              PIC  X(14).                  DTSBX343
00515      05  DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X                    DTSBX343
00516                                      PIC  ---,---,--9.99.         DTSBX343
00517      05  DISPLAY-AMT2-X              PIC  X(14).                  DTSBX343
00518      05  DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X                    DTSBX343
00519                                      PIC  ---,---,--9.99.         DTSBX343
00520      05  DISPLAY-AMT3-X              PIC  X(14).                  DTSBX343
00521      05  DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X                    DTSBX343
00522                                      PIC  ---,---,--9.99.         DTSBX343
00523      05  DISPLAY-AMT4-X              PIC  X(14).                  DTSBX343
00524      05  DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X                    DTSBX343
00525                                      PIC  ---,---,--9.99.         DTSBX343
00526      EJECT                                                        DTSBX343
00527  01  L001-LINK-AREA.                                              DTSBX343
00528  ++INCLUDE DTSIL001                                               DTSBX343
00529      EJECT                                                        DTSBX343
00530  01  L004-LINK-AREA.                                              DTSBX343
00531  ++INCLUDE DTSIL004                                               DTSBX343
00532      EJECT                                                        DTSBX343
00533  01  L005-LINK-AREA.                                              DTSBX343
00534  ++INCLUDE DTSIL005                                               DTSBX343
00535                                                                   DTSBX343
00536  01  L910-LINK-AREA.                                              DTSBX343
00537  ++INCLUDE DTSIL910                                               DTSBX343
00538      SKIP3                                                        DTSBX343
00539  01  MSKL-REC.                                                    DTSBX343
00540  ++INCLUDE DTSIMSKL                                               DTSBX343
00541      SKIP3                                                        DTSBX343
00542  01  MHDR-REC.                                                    DTSBX343
00543  ++INCLUDE DTSIMHDR                                               DTSBX343
00544      SKIP3                                                        DTSBX343
00545  01  MQTR-REC.                                                    DTSBX343
00546  ++INCLUDE DTSIMQTR                                               DTSBX343
00547      SKIP3                                                        DTSBX343
00548  01  MJRN-REC.                                                    DTSBX343
00549  ++INCLUDE DTSIMJRN                                               DTSBX343
00550      SKIP3                                                        DTSBX343
00551  01  MRPT-REC.                                                    DTSBX343
00552  ++INCLUDE DTSIMRPT                                               DTSBX343
00553      SKIP3                                                        DTSBX343
00554  01  MADJ-REC.                                                    DTSBX343
00555  ++INCLUDE DTSIMADJ                                               DTSBX343
00556      SKIP3                                                        DTSBX343
00557  01  MPAY-REC.                                                    DTSBX343
00558  ++INCLUDE DTSIMPAY                                               DTSBX343
00559      SKIP3                                                        DTSBX343
00560  01  MDST-REC.                                                    DTSBX343
00561  ++INCLUDE DTSIMDST                                               DTSBX343
00562      SKIP3                                                        DTSBX343
00563  01  MRTE-REC.                                                    DTSBX343
00564  ++INCLUDE DTSIMRTE                                               DTSBX343
00565      SKIP3                                                        DTSBX343
00566  01  MEVL-REC.                                                    DTSBX343
00567  ++INCLUDE DTSIMEVL                                               DTSBX343
00568      SKIP3                                                        DTSBX343
00569  01  MSOL-REC.                                                    DTSBX343
00570  ++INCLUDE DTSIMSOL                                               DTSBX343
00571      SKIP3                                                        DTSBX343
00572  01  MFSC-REC.                                                    DTSBX343
00573  ++INCLUDE DTSIMFSC                                               DTSBX343
00574      SKIP3                                                        DTSBX343
00575  01  MTAD-REC.                                                    DTSBX343
00576  ++INCLUDE DTSIMTAD                                               DTSBX343
00577      SKIP3                                                        DTSBX343
00578  01  MTAA-REC.                                                    DTSBX343
00579  ++INCLUDE DTSIMTAA                                               DTSBX343
00580      SKIP3                                                        DTSBX343
00581  01  MLOG-REC.                                                    DTSBX343
00582  ++INCLUDE DTSIMLOG                                               DTSBX343
00583      SKIP3                                                        DTSBX343
00584  01  L931-LINK-AREA.                                              DTSBX343
00585  ++INCLUDE DTSIL931                                               DTSBX343
00586      SKIP3                                                        DTSBX343
00587  01  FSKL-REC.                                                    DTSBX343
00588  ++INCLUDE DTSIFSKL                                               DTSBX343
00589      SKIP3                                                        DTSBX343
00590  01  FQTR-REC.                                                    DTSBX343
00591  ++INCLUDE DTSIFQTR                                               DTSBX343
00592                                                                   DTSBX343
00593  LINKAGE SECTION.                                                 DTSBX343
00594                                                                   DTSBX343
00595  01  LX34-LINK-AREA.                                              DTSBX343
00596  ++INCLUDE DTSILX34                                               DTSBX343
00597                                                                   DTSBX343
00598  01  MPRF-REC.                                                    DTSBX343
00599  ++INCLUDE DTSIMPRF                                               DTSBX343
00600      EJECT                                                        DTSBX343
00601  PROCEDURE DIVISION USING LX34-LINK-AREA                          DTSBX343
00602                           MPRF-REC.                               DTSBX343
00603                                                                   DTSBX343
00604      EVALUATE TRUE                                                DTSBX343
00605        WHEN LX34-INITIALIZE-88                                    DTSBX343
00606           PERFORM I0000-INITIALIZE     THRU I0000-EXIT            DTSBX343
00607        WHEN LX34-PROCESS-88                                       DTSBX343
00608           PERFORM P0000-PROCESS        THRU P0000-EXIT            DTSBX343
00609        WHEN LX34-TERMINATE-88                                     DTSBX343
00610           PERFORM T0000-TERMINATE      THRU T0000-EXIT            DTSBX343
00611      END-EVALUATE.                                                DTSBX343
00612                                                                   DTSBX343
00613      GOBACK.                                                      DTSBX343
00614                                                                   DTSBX343
00615  I0000-INITIALIZE.                                                DTSBX343
00616      PERFORM I2000-OPEN-FILES      THRU I2000-EXIT.               DTSBX343
00617                                                                   DTSBX343
00618  I0000-EXIT.                                                      DTSBX343
00619      EXIT.                                                        DTSBX343
00620                                                                   DTSBX343
00621  I2000-OPEN-FILES.                                                DTSBX343
00622 **   OPEN OUTPUT ACCT-FILE.                                       DTSBX343
00623 *    IF NOT ACCT-STATUS-OK-88                                     DTSBX343
00624 *       DISPLAY 'BX343 ACCT FILE OPEN ERROR: ' ACCT-STATUS        DTSBX343
00625 *       MOVE 'FILE OPEN ERROR'                                    DTSBX343
00626 *              TO ABEND-MSG                                       DTSBX343
00627 *       PERFORM S999-ABEND THRU S999-EXIT                         DTSBX343
00628 **   END-IF.                                                      DTSBX343
00629                                                                   DTSBX343
00630      OPEN OUTPUT ACCT-FILE-INCR.                                  DTSBX343
00631      IF NOT ACCT-I-STATUS-OK-88                                   DTSBX343
00632         DISPLAY 'BX343 ACCT INCR OPEN ERROR: ' ACCT-I-STATUS      DTSBX343
00633         MOVE 'FILE OPEN ERROR'                                    DTSBX343
00634                TO ABEND-MSG                                       DTSBX343
00635         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX343
00636      END-IF.                                                      DTSBX343
00637                                                                   DTSBX343
00638 **   OPEN OUTPUT TRAN-FILE.                                       DTSBX343
00639 *    IF NOT TRAN-STATUS-OK-88                                     DTSBX343
00640 *       DISPLAY 'BX343 TRAN FILE OPEN ERROR: ' TRAN-STATUS        DTSBX343
00641 *       MOVE 'FILE OPEN ERROR'                                    DTSBX343
00642 *              TO ABEND-MSG                                       DTSBX343
00643 *       PERFORM S999-ABEND THRU S999-EXIT                         DTSBX343
00644 **   END-IF.                                                      DTSBX343
00645                                                                   DTSBX343
00646      OPEN OUTPUT TRAN-FILE-INCR.                                  DTSBX343
00647      IF NOT TRAN-I-STATUS-OK-88                                   DTSBX343
00648         DISPLAY 'BX343 TRAN FILE INCR ERROR: ' TRAN-I-STATUS      DTSBX343
00649         MOVE 'FILE OPEN ERROR'                                    DTSBX343
00650                TO ABEND-MSG                                       DTSBX343
00651         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX343
00652      END-IF.                                                      DTSBX343
00653                                                                   DTSBX343
00654      OPEN OUTPUT QTR-FILE.                                        DTSBX343
00655      IF NOT QTR-STATUS-OK-88                                      DTSBX343
00656         DISPLAY 'BX343 QTR FILE OPEN ERROR: ' QTR-STATUS          DTSBX343
00657         MOVE 'FILE OPEN ERROR'                                    DTSBX343
00658                TO ABEND-MSG                                       DTSBX343
00659         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX343
00660      END-IF.                                                      DTSBX343
00661                                                                   DTSBX343
00662      OPEN OUTPUT SUMMARY-FILE.                                    DTSBX343
00663      IF NOT SUMMARY-STATUS-OK-88                                  DTSBX343
00664         DISPLAY 'BX343 SUMMARY FILE OPEN ERROR: '                 DTSBX343
00665             SUMMARY-STATUS                                        DTSBX343
00666         MOVE 'FILE OPEN ERROR'                                    DTSBX343
00667                TO ABEND-MSG                                       DTSBX343
00668         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX343
00669      END-IF.                                                      DTSBX343
00670                                                                   DTSBX343
00671      OPEN OUTPUT PAY-DIST-FILE.                                   DTSBX343
00672      IF NOT PAYDIST-STATUS-OK-88                                  DTSBX343
00673         DISPLAY 'BX343 PAY DIST FILE OPEN ERROR: '                DTSBX343
00674             PAYDIST-STATUS                                        DTSBX343
00675         MOVE 'FILE OPEN ERROR'                                    DTSBX343
00676                TO ABEND-MSG                                       DTSBX343
00677         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX343
00678      END-IF.                                                      DTSBX343
00679                                                                   DTSBX343
00680  I2000-EXIT.                                                      DTSBX343
00681      EXIT.                                                        DTSBX343
00682                                                                   DTSBX343
00683  P0000-PROCESS.                                                   DTSBX343
00684      PERFORM P0100-INIT-TABLE        THRU P0100-EXIT.             DTSBX343
00685                                                                   DTSBX343
00686      PERFORM P1000-QUARTER              THRU P1000-EXIT           DTSBX343
00687      PERFORM P2000-ACCTS-RECEIVABLE     THRU P2000-EXIT           DTSBX343
00688      PERFORM P3000-TRANSACTION-DETAIL   THRU P3000-EXIT           DTSBX343
00689      PERFORM P4000-CORRECTIONS          THRU P4000-EXIT.          DTSBX343
00690 **   IF MPRF-TOT-CREDIT-AMT > ZERO                                DTSBX343
00691         PERFORM P5000-PAY-DISTRIBUTION  THRU P5000-EXIT.          DTSBX343
00692 **   END-IF.                                                      DTSBX343
00693                                                                   DTSBX343
00694  P0000-EXIT.                                                      DTSBX343
00695      EXIT.                                                        DTSBX343
00696                                                                   DTSBX343
00697  P0100-INIT-TABLE.                                                DTSBX343
00698      PERFORM                                                      DTSBX343
00699        VARYING QSUB FROM +1 BY +1                                 DTSBX343
00700        UNTIL QSUB > QMAX                                          DTSBX343
00701          SET TBL-JRN-GOOD-88 (QSUB)  TO TRUE                      DTSBX343
00702          MOVE +0                    TO TBL-YRQ (QSUB)             DTSBX343
00703                                        Q-UI-CHG (QSUB)            DTSBX343
00704                                        Q-UI-PD (QSUB)             DTSBX343
00705                                        Q-UI-WV (QSUB)             DTSBX343
00706                                        Q-UI-WO (QSUB)             DTSBX343
00707                                        Q-UI-TL (QSUB)             DTSBX343
00708                                        Q-UI-BAL (QSUB)            DTSBX343
00709                                        J-UI-CHG (QSUB)            DTSBX343
00710                                        J-UI-PD (QSUB)             DTSBX343
00711                                        J-UI-WV (QSUB)             DTSBX343
00712                                        J-UI-WO (QSUB)             DTSBX343
00713                                        J-UI-TL (QSUB)             DTSBX343
00714                                        Q-INT-CHG (QSUB)           DTSBX343
00715                                        Q-INT-PD (QSUB)            DTSBX343
00716                                        Q-INT-WV (QSUB)            DTSBX343
00717                                        Q-INT-WO (QSUB)            DTSBX343
00718                                        Q-INT-TL (QSUB)            DTSBX343
00719                                        Q-INT-BAL (QSUB)           DTSBX343
00720                                        J-INT-CHG (QSUB)           DTSBX343
00721                                        J-INT-PD (QSUB)            DTSBX343
00722                                        J-INT-WV (QSUB)            DTSBX343
00723                                        J-INT-WO (QSUB)            DTSBX343
00724                                        J-INT-TL (QSUB)            DTSBX343
00725                                        Q-LP-CHG (QSUB)            DTSBX343
00726                                        Q-LP-PD (QSUB)             DTSBX343
00727                                        Q-LP-WV (QSUB)             DTSBX343
00728                                        Q-LP-WO (QSUB)             DTSBX343
00729                                        Q-LP-TL (QSUB)             DTSBX343
00730                                        Q-LP-BAL (QSUB)            DTSBX343
00731                                        J-LP-CHG (QSUB)            DTSBX343
00732                                        J-LP-PD (QSUB)             DTSBX343
00733                                        J-LP-WV (QSUB)             DTSBX343
00734                                        J-LP-WO (QSUB)             DTSBX343
00735                                        J-LP-TL (QSUB)             DTSBX343
00736                                        Q-NP-CHG (QSUB)            DTSBX343
00737                                        Q-NP-PD (QSUB)             DTSBX343
00738                                        Q-NP-WV (QSUB)             DTSBX343
00739                                        Q-NP-WO (QSUB)             DTSBX343
00740                                        Q-NP-TL (QSUB)             DTSBX343
00741                                        Q-NP-BAL (QSUB)            DTSBX343
00742                                        J-NP-CHG (QSUB)            DTSBX343
00743                                        J-NP-PD (QSUB)             DTSBX343
00744                                        J-NP-WV (QSUB)             DTSBX343
00745                                        J-NP-WO (QSUB)             DTSBX343
00746                                        J-NP-TL (QSUB)             DTSBX343
00747                                        Q-MP-CHG (QSUB)            DTSBX343
00748                                        Q-MP-PD (QSUB)             DTSBX343
00749                                        Q-MP-WV (QSUB)             DTSBX343
00750                                        Q-MP-WO (QSUB)             DTSBX343
00751                                        Q-MP-TL (QSUB)             DTSBX343
00752                                        Q-MP-BAL (QSUB)            DTSBX343
00753                                        J-MP-CHG (QSUB)            DTSBX343
00754                                        J-MP-PD (QSUB)             DTSBX343
00755                                        J-MP-WV (QSUB)             DTSBX343
00756                                        J-MP-WO (QSUB)             DTSBX343
00757                                        J-MP-TL (QSUB)             DTSBX343
00758                                        Q-SU-CHG (QSUB)            DTSBX343
00759                                        Q-SU-PD (QSUB)             DTSBX343
00760                                        Q-SU-WV (QSUB)             DTSBX343
00761                                        Q-SU-WO (QSUB)             DTSBX343
00762                                        Q-SU-TL (QSUB)             DTSBX343
00763                                        Q-SU-BAL (QSUB)            DTSBX343
00764                                        J-SU-CHG (QSUB)            DTSBX343
00765                                        J-SU-PD (QSUB)             DTSBX343
00766                                        J-SU-WV (QSUB)             DTSBX343
00767                                        J-SU-WO (QSUB)             DTSBX343
00768                                        J-SU-TL (QSUB)             DTSBX343
00769      END-PERFORM.                                                 DTSBX343
00770                                                                   DTSBX343
00771  P0100-EXIT.                                                      DTSBX343
00772      EXIT.                                                        DTSBX343
00773                                                                   DTSBX343
00774  P1000-QUARTER.                                                   DTSBX343
00775      MOVE LOW-VALUES                   TO MQTR-KEY-AREA.          DTSBX343
00776      MOVE MPRF-EMP-NO                  TO MQTR-EMP-NO.            DTSBX343
00777      SET MQTR-QTR-88                   TO TRUE.                   DTSBX343
00778      MOVE MQTR-KEY-AREA                TO MSKL-KEY-AREA.          DTSBX343
00779      PERFORM S910-START-BROWSE         THRU S910-EXIT.            DTSBX343
00780      PERFORM UNTIL L910-NO-REC-88                                 DTSBX343
00781         MOVE MSKL-REC                  TO MQTR-REC                DTSBX343
00782         PERFORM P1100-SAVE-QTR         THRU P1100-EXIT            DTSBX343
00783         PERFORM P1200-BUILD-QTR        THRU P1200-EXIT            DTSBX343
00784         PERFORM S910-READ-NEXT         THRU S910-EXIT             DTSBX343
00785      END-PERFORM.                                                 DTSBX343
00786                                                                   DTSBX343
00787  P1000-EXIT.                                                      DTSBX343
00788      EXIT.                                                        DTSBX343
00789                                                                   DTSBX343
00790  P1100-SAVE-QTR.                                                  DTSBX343
00791      MOVE MQTR-YRQ                   TO L004-QTR-5-9.             DTSBX343
00792      PERFORM S004-FROM-5             THRU S004-EXIT.              DTSBX343
00793      MOVE L004-ABS-QTR               TO QSUB.                     DTSBX343
00794                                                                   DTSBX343
00795      MOVE MQTR-YRQ                   TO TBL-YRQ (QSUB).           DTSBX343
00796                                                                   DTSBX343
00797      SET W-UI-CHARGE-NO-88           TO TRUE.                     DTSBX343
00798      SET W-LP-CHARGE-NO-88           TO TRUE.                     DTSBX343
00799                                                                   DTSBX343
00800      PERFORM                                                      DTSBX343
00801        VARYING MQTR-ACCT-IDX FROM +1 BY +1                        DTSBX343
00802        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBX343
00803          PERFORM P1105-GET-AMTS         THRU P1105-EXIT           DTSBX343
00804          EVALUATE TRUE                                            DTSBX343
00805            WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                   DTSBX343
00806              PERFORM P1110-TABLE-UI     THRU P1110-EXIT           DTSBX343
00807                                                                   DTSBX343
00808            WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX)                  DTSBX343
00809              PERFORM P1111-TABLE-INT    THRU P1111-EXIT           DTSBX343
00810                                                                   DTSBX343
00811            WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)             DTSBX343
00812              PERFORM P1112-TABLE-LP     THRU P1112-EXIT           DTSBX343
00813                                                                   DTSBX343
00814            WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)             DTSBX343
00815              PERFORM P1113-TABLE-MP     THRU P1113-EXIT           DTSBX343
00816                                                                   DTSBX343
00817            WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)              DTSBX343
00818              PERFORM P1114-TABLE-NP     THRU P1114-EXIT           DTSBX343
00819                                                                   DTSBX343
00820            WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                  DTSBX343
00821              PERFORM P1115-TABLE-SU     THRU P1115-EXIT           DTSBX343
00822                                                                   DTSBX343
00823          END-EVALUATE                                             DTSBX343
00824      END-PERFORM.                                                 DTSBX343
00825                                                                   DTSBX343
00826      IF MQTR-YRQ  < 20001                                         DTSBX343
00827         IF W-UI-CHARGE-NO-88                                      DTSBX343
00828         AND W-LP-CHARGE-NO-88                                     DTSBX343
00829            SET TBL-JRN-BAD-88 (QSUB)   TO TRUE                    DTSBX343
00830         END-IF                                                    DTSBX343
00831      END-IF.                                                      DTSBX343
00832                                                                   DTSBX343
00833 *    IF MQTR-EMP-NO = 030450                                      DTSBX343
00834 *       IF MQTR-YRQ > 20041                                       DTSBX343
00835 *          IF W-UI-BAL NOT = ZERO                                 DTSBX343
00836 *          OR W-LP-BAL NOT = ZERO                                 DTSBX343
00837 *          OR W-NP-BAL NOT = ZERO                                 DTSBX343
00838 *          OR W-INT-BAL NOT = ZERO                                DTSBX343
00839 *             DISPLAY 'P1100 ' MPRF-EMP-NO '  ' MQTR-YRQ.         DTSBX343
00840                                                                   DTSBX343
00841                                                                   DTSBX343
00842  P1100-EXIT.                                                      DTSBX343
00843      EXIT.                                                        DTSBX343
00844                                                                   DTSBX343
00845  P1105-GET-AMTS.                                                  DTSBX343
00846      MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX)     TO W-CHG.          DTSBX343
00847      MOVE MQTR-PAID-AMT (MQTR-ACCT-IDX)        TO W-PD.           DTSBX343
00848      MOVE MQTR-WAIVED-AMT (MQTR-ACCT-IDX)      TO W-WV.           DTSBX343
00849      MOVE MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) TO W-WO.           DTSBX343
00850      MOVE MQTR-TOLER-AMT (MQTR-ACCT-IDX)       TO W-TL.           DTSBX343
00851      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)     TO W-BAL.          DTSBX343
00852                                                                   DTSBX343
00853  P1105-EXIT.                                                      DTSBX343
00854      EXIT.                                                        DTSBX343
00855                                                                   DTSBX343
00856  P1110-TABLE-UI.                                                  DTSBX343
00857      IF W-CHG > ZERO                                              DTSBX343
00858         SET W-UI-CHARGE-YES-88       TO TRUE                      DTSBX343
00859      END-IF.                                                      DTSBX343
00860                                                                   DTSBX343
00861      ADD W-CHG                       TO Q-UI-CHG (QSUB).          DTSBX343
00862      ADD W-PD                        TO Q-UI-PD (QSUB).           DTSBX343
00863      ADD W-WV                        TO Q-UI-WV (QSUB).           DTSBX343
00864      ADD W-WO                        TO Q-UI-WO (QSUB).           DTSBX343
00865      ADD W-TL                        TO Q-UI-TL (QSUB).           DTSBX343
00866      ADD W-BAL                       TO Q-UI-BAL (QSUB).          DTSBX343
00867                                                                   DTSBX343
00868 **   IF MPRF-EMP-NO = 062362 OR 073765                            DTSBX343
00869 *       MOVE Q-UI-BAL (QSUB) TO DISPLAY-AMT1                      DTSBX343
00870 *       DISPLAY 'P1110 ' MPRF-EMP-NO '  ' MQTR-YRQ                DTSBX343
00871 *          '  UI ' DISPLAY-AMT1                                   DTSBX343
00872 **   END-IF.                                                      DTSBX343
00873                                                                   DTSBX343
00874  P1110-EXIT.                                                      DTSBX343
00875      EXIT.                                                        DTSBX343
00876                                                                   DTSBX343
00877  P1111-TABLE-INT.                                                 DTSBX343
00878      ADD W-CHG                       TO Q-INT-CHG (QSUB).         DTSBX343
00879      ADD W-PD                        TO Q-INT-PD (QSUB).          DTSBX343
00880      ADD W-WV                        TO Q-INT-WV (QSUB).          DTSBX343
00881      ADD W-WO                        TO Q-INT-WO (QSUB).          DTSBX343
00882      ADD W-TL                        TO Q-INT-TL (QSUB).          DTSBX343
00883      ADD W-BAL                       TO Q-INT-BAL (QSUB).         DTSBX343
00884                                                                   DTSBX343
00885  P1111-EXIT.                                                      DTSBX343
00886      EXIT.                                                        DTSBX343
00887                                                                   DTSBX343
00888  P1112-TABLE-LP.                                                  DTSBX343
00889      IF W-CHG > ZERO                                              DTSBX343
00890         SET W-LP-CHARGE-YES-88       TO TRUE                      DTSBX343
00891      END-IF.                                                      DTSBX343
00892                                                                   DTSBX343
00893      ADD W-CHG                       TO Q-LP-CHG (QSUB).          DTSBX343
00894      ADD W-PD                        TO Q-LP-PD (QSUB).           DTSBX343
00895      ADD W-WV                        TO Q-LP-WV (QSUB).           DTSBX343
00896      ADD W-WO                        TO Q-LP-WO (QSUB).           DTSBX343
00897      ADD W-TL                        TO Q-LP-TL (QSUB).           DTSBX343
00898      ADD W-BAL                       TO Q-LP-BAL (QSUB).          DTSBX343
00899                                                                   DTSBX343
00900 **   IF MPRF-EMP-NO = 137540                                      DTSBX343
00901 *       MOVE Q-LP-BAL (QSUB) TO DISPLAY-AMT2                      DTSBX343
00902 *       DISPLAY 'P1112 ' MPRF-EMP-NO '  ' MQTR-YRQ                DTSBX343
00903 *          '  PEN ' DISPLAY-AMT2                                  DTSBX343
00904 **   END-IF.                                                      DTSBX343
00905                                                                   DTSBX343
00906  P1112-EXIT.                                                      DTSBX343
00907      EXIT.                                                        DTSBX343
00908                                                                   DTSBX343
00909  P1113-TABLE-MP.                                                  DTSBX343
00910      ADD W-CHG                       TO Q-MP-CHG (QSUB).          DTSBX343
00911      ADD W-PD                        TO Q-MP-PD (QSUB).           DTSBX343
00912      ADD W-WV                        TO Q-MP-WV (QSUB).           DTSBX343
00913      ADD W-WO                        TO Q-MP-WO (QSUB).           DTSBX343
00914      ADD W-TL                        TO Q-MP-TL (QSUB).           DTSBX343
00915      ADD W-BAL                       TO Q-MP-BAL (QSUB).          DTSBX343
00916                                                                   DTSBX343
00917  P1113-EXIT.                                                      DTSBX343
00918      EXIT.                                                        DTSBX343
00919                                                                   DTSBX343
00920  P1114-TABLE-NP.                                                  DTSBX343
00921      ADD W-CHG                       TO Q-NP-CHG (QSUB).          DTSBX343
00922      ADD W-PD                        TO Q-NP-PD (QSUB).           DTSBX343
00923      ADD W-WV                        TO Q-NP-WV (QSUB).           DTSBX343
00924      ADD W-WO                        TO Q-NP-WO (QSUB).           DTSBX343
00925      ADD W-TL                        TO Q-NP-TL (QSUB).           DTSBX343
00926      ADD W-BAL                       TO Q-NP-BAL (QSUB).          DTSBX343
00927                                                                   DTSBX343
00928  P1114-EXIT.                                                      DTSBX343
00929      EXIT.                                                        DTSBX343
00930                                                                   DTSBX343
00931  P1115-TABLE-SU.                                                  DTSBX343
00932      ADD W-CHG                       TO Q-SU-CHG (QSUB).          DTSBX343
00933      ADD W-PD                        TO Q-SU-PD (QSUB).           DTSBX343
00934      ADD W-WV                        TO Q-SU-WV (QSUB).           DTSBX343
00935      ADD W-WO                        TO Q-SU-WO (QSUB).           DTSBX343
00936      ADD W-TL                        TO Q-SU-TL (QSUB).           DTSBX343
00937      ADD W-BAL                       TO Q-SU-BAL (QSUB).          DTSBX343
00938                                                                   DTSBX343
00939  P1115-EXIT.                                                      DTSBX343
00940      EXIT.                                                        DTSBX343
00941                                                                   DTSBX343
00942                                                                   DTSBX343
00943  P1200-BUILD-QTR.                                                 DTSBX343
00944      MOVE MQTR-YRQ                TO L004-QTR-5-9.                DTSBX343
00945      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBX343
00946      MOVE L004-ABS-QTR            TO LX34-SUB.                    DTSBX343
00947      IF LX34-QTR-EXISTS-YES-88 (LX34-SUB)                         DTSBX343
00948         GO TO P1200-EXIT                                          DTSBX343
00949      ELSE                                                         DTSBX343
00950         SET LX34-QTR-EXISTS-YES-88 (LX34-SUB)  TO TRUE            DTSBX343
00951      END-IF.                                                      DTSBX343
00952                                                                   DTSBX343
00953      MOVE ZERO                           TO W-QTR-BAL.            DTSBX343
00954      IF MPRF-TOT-BALANCE-AMT > ZERO                               DTSBX343
00955      AND MQTR-TAX-DUE-DATE < LX34-CURR-RUN-DATE                   DTSBX343
00956         PERFORM P1210-BAL-DUE            THRU P1210-EXIT          DTSBX343
00957      END-IF.                                                      DTSBX343
00958                                                                   DTSBX343
00959      MOVE MQTR-EMP-NO                    TO QTR-EMP-NO.           DTSBX343
00960      MOVE MQTR-YRQ                       TO L004-QTR-5-9.         DTSBX343
00961      PERFORM S004-FROM-5                 THRU S004-EXIT.          DTSBX343
00962      IF L004-VALID-QTR                                            DTSBX343
00963         MOVE L004-SLASH-5-QTR            TO QTR-QUARTER           DTSBX343
00964      ELSE                                                         DTSBX343
00965         GO TO P1200-EXIT                                          DTSBX343
00966      END-IF.                                                      DTSBX343
00967      MOVE MQTR-CURR-RPT-TYPE             TO QTR-RPT-STATUS.       DTSBX343
00968      MOVE MQTR-RPT-DUE-DATE              TO L001-FED-8-DATE-9.    DTSBX343
00969      PERFORM S001-FROM-FED-8             THRU S001-EXIT.          DTSBX343
00970      MOVE L001-SLASH-8-DATE              TO QTR-RPT-DUE-DT.       DTSBX343
00971      MOVE MQTR-TAX-DUE-DATE              TO L001-FED-8-DATE-9.    DTSBX343
00972      PERFORM S001-FROM-FED-8             THRU S001-EXIT.          DTSBX343
00973      MOVE L001-SLASH-8-DATE              TO QTR-TAX-DUE-DT.       DTSBX343
00974      MOVE W-QTR-BAL                      TO QTR-BAL-DUE.          DTSBX343
00975                                                                   DTSBX343
00976      MOVE MQTR-ESTB-DATE                 TO L001-FED-8-DATE-9.    DTSBX343
00977      PERFORM S001-FROM-FED-8             THRU S001-EXIT.          DTSBX343
00978      IF L001-VALID-DATE                                           DTSBX343
00979         MOVE L001-SLASH-8-DATE           TO QTR-PROCESS-DT        DTSBX343
00980      ELSE                                                         DTSBX343
00981         MOVE W-DEFAULT-DATE              TO QTR-PROCESS-DT        DTSBX343
00982      END-IF.                                                      DTSBX343
00983                                                                   DTSBX343
00984      IF QTR-PROCESS-DT = W-DEFAULT-DATE                           DTSBX343
00985         MOVE MQTR-CHNG-DATE              TO L001-FED-8-DATE-9     DTSBX343
00986         PERFORM S001-FROM-FED-8          THRU S001-EXIT           DTSBX343
00987         IF L001-VALID-DATE                                        DTSBX343
00988            MOVE L001-SLASH-8-DATE        TO QTR-PROCESS-DT        DTSBX343
00989         END-IF                                                    DTSBX343
00990      END-IF.                                                      DTSBX343
00991                                                                   DTSBX343
00992      WRITE QTR-REC    FROM W-QTR-REC                              DTSBX343
00993      IF NOT QTR-STATUS-OK-88                                      DTSBX343
00994         DISPLAY 'CANNOT WRITE TO QTR FILE '                       DTSBX343
00995            '  ' QTR-STATUS '  ' QTR-EMP-NO                        DTSBX343
00996      ELSE                                                         DTSBX343
00997         ADD +1 TO W-QTR-CNT                                       DTSBX343
00998      END-IF.                                                      DTSBX343
00999                                                                   DTSBX343
01000  P1200-EXIT.                                                      DTSBX343
01001      EXIT.                                                        DTSBX343
01002                                                                   DTSBX343
01003  P1210-BAL-DUE.                                                   DTSBX343
01004      PERFORM                                                      DTSBX343
01005        VARYING MQTR-ACCT-IDX FROM +1 BY +1                        DTSBX343
01006        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBX343
01007           IF MPRF-CLASS-SELF-INS-88                               DTSBX343
01008           AND MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                    DTSBX343
01009              CONTINUE                                             DTSBX343
01010           ELSE                                                    DTSBX343
01011              ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                 DTSBX343
01012                                      TO W-QTR-BAL                 DTSBX343
01013           END-IF                                                  DTSBX343
01014      END-PERFORM.                                                 DTSBX343
01015                                                                   DTSBX343
01016  P1210-EXIT.                                                      DTSBX343
01017      EXIT.                                                        DTSBX343
01018                                                                   DTSBX343
01019                                                                   DTSBX343
01020  P2000-ACCTS-RECEIVABLE.                                          DTSBX343
01021      MOVE ZERO                       TO W-TOT-CREDIT.             DTSBX343
01022                                                                   DTSBX343
01023      MOVE LOW-VALUES                 TO MJRN-KEY-AREA.            DTSBX343
01024      MOVE MPRF-EMP-NO                TO MJRN-EMP-NO.              DTSBX343
01025      SET MJRN-JRN-88                 TO TRUE.                     DTSBX343
01026      MOVE MJRN-KEY-AREA              TO MSKL-KEY-AREA.            DTSBX343
01027      PERFORM S910-START-BROWSE       THRU S910-EXIT.              DTSBX343
01028      PERFORM UNTIL L910-NO-REC-88                                 DTSBX343
01029         MOVE MSKL-REC                TO MJRN-REC                  DTSBX343
01030         ADD +1                       TO W-MJRN-READ-CNT           DTSBX343
01031         IF NOT MJRN-TRAN-CNVR-88                                  DTSBX343
01032            PERFORM P2100-BUILD-ACCT     THRU P2100-EXIT           DTSBX343
01033         END-IF                                                    DTSBX343
01034         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBX343
01035      END-PERFORM.                                                 DTSBX343
01036                                                                   DTSBX343
01037 **   MOVE MPRF-TOT-CREDIT-AMT TO DISPLAY-AMT1.                    DTSBX343
01038 **   MOVE W-TOT-CREDIT        TO DISPLAY-AMT2.                    DTSBX343
01039      IF W-TOT-CREDIT NOT = MPRF-TOT-CREDIT-AMT                    DTSBX343
01040         PERFORM P2010-CORRECT-CR           THRU P2010-EXIT        DTSBX343
01041 **      DISPLAY 'CREDIT ' MPRF-EMP-NO                             DTSBX343
01042 **         '  MPRF ' DISPLAY-AMT1                                 DTSBX343
01043 **         '  ' DISPLAY-AMT2                                      DTSBX343
01044      END-IF.                                                      DTSBX343
01045  P2000-EXIT.                                                      DTSBX343
01046      EXIT.                                                        DTSBX343
01047                                                                   DTSBX343
01048  P2010-CORRECT-CR.                                                DTSBX343
01049      PERFORM S1000-CORRECTION-BATCH   THRU S1000-EXIT.            DTSBX343
01050      MOVE W-JC-BATCH                  TO ACCT-BATCH               DTSBX343
01051      MOVE W-JC-ITEM                   TO ACCT-ITEM.               DTSBX343
01052                                                                   DTSBX343
01053      MOVE MPRF-EMP-NO                 TO ACCT-EMP-NO.             DTSBX343
01054      MOVE SPACES                      TO ACCT-YRQ.                DTSBX343
01055      MOVE 'CR'                        TO ACCT-ROW.                DTSBX343
01056      MOVE 'PD'                        TO ACCT-COL.                DTSBX343
01057      COMPUTE W-CREDIT-CORRECT =                                   DTSBX343
01058         (MPRF-TOT-CREDIT-AMT - W-TOT-CREDIT).                     DTSBX343
01059      MOVE W-CREDIT-CORRECT            TO ACCT-AMT.                DTSBX343
01060      MOVE 'JC'                        TO ACCT-TRAN                DTSBX343
01061      MOVE 'B'                         TO ACCT-CAT.                DTSBX343
01062      MOVE W-DEFAULT-DATE            TO ACCT-RCVD-DT               DTSBX343
01063                                        ACCT-PROCESS-DT.           DTSBX343
01064                                                                   DTSBX343
01065      SET ACCT-SOURCE-CR-DB-88         TO TRUE.                    DTSBX343
01066                                                                   DTSBX343
01067 **   WRITE ACCT-REC   FROM W-ACCT-REC                             DTSBX343
01068 *    IF NOT ACCT-STATUS-OK-88                                     DTSBX343
01069 *       DISPLAY 'CANNOT WRITE TO ACCT FILE '                      DTSBX343
01070 *          '  ' ACCT-STATUS '  ' ACCT-EMP-NO                      DTSBX343
01071 *    ELSE                                                         DTSBX343
01072 *       ADD +1 TO W-ACCT-CNT                                      DTSBX343
01073 *       ADD +1 TO W-CR-CNT                                        DTSBX343
01074 **   END-IF.                                                      DTSBX343
01075                                                                   DTSBX343
01076  P2010-EXIT.                                                      DTSBX343
01077      EXIT.                                                        DTSBX343
01078                                                                   DTSBX343
01079  P2100-BUILD-ACCT.                                                DTSBX343
01080      PERFORM                                                      DTSBX343
01081        VARYING MJRN-OCC-IDX FROM +1 BY +1                         DTSBX343
01082        UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT                          DTSBX343
01083          IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX)                     DTSBX343
01084             ADD MJRN-AMT (MJRN-OCC-IDX)    TO W-TOT-CREDIT        DTSBX343
01085             PERFORM P2110-WRITE-ACCT       THRU P2110-EXIT        DTSBX343
01086          ELSE                                                     DTSBX343
01087             MOVE MJRN-YRQ (MJRN-OCC-IDX)   TO L004-QTR-5-9        DTSBX343
01088             PERFORM S004-FROM-5            THRU S004-EXIT         DTSBX343
01089             MOVE L004-SLASH-5-QTR          TO ACCT-YRQ            DTSBX343
01090             MOVE L004-ABS-QTR              TO QSUB                DTSBX343
01091             IF TBL-JRN-GOOD-88 (QSUB)                             DTSBX343
01092                PERFORM P2110-WRITE-ACCT    THRU P2110-EXIT        DTSBX343
01093                PERFORM P2120-SAVE-JRN      THRU P2120-EXIT        DTSBX343
01094             END-IF                                                DTSBX343
01095          END-IF                                                   DTSBX343
01096      END-PERFORM.                                                 DTSBX343
01097                                                                   DTSBX343
01098  P2100-EXIT.                                                      DTSBX343
01099      EXIT.                                                        DTSBX343
01100                                                                   DTSBX343
01101  P2110-WRITE-ACCT.                                                DTSBX343
01102      IF MJRN-YRQ (MJRN-OCC-IDX) =  99999                          DTSBX343
01103         MOVE SPACES                       TO ACCT-YRQ             DTSBX343
01104      ELSE                                                         DTSBX343
01105         MOVE MJRN-YRQ (MJRN-OCC-IDX)      TO L004-QTR-5-9         DTSBX343
01106         PERFORM S004-FROM-5               THRU S004-EXIT          DTSBX343
01107         MOVE L004-SLASH-5-QTR             TO ACCT-YRQ             DTSBX343
01108      END-IF.                                                      DTSBX343
01109                                                                   DTSBX343
01110      MOVE MJRN-BATCH-NO                   TO ACCT-BATCH.          DTSBX343
01111      MOVE MJRN-ITEM-NO                    TO ACCT-ITEM.           DTSBX343
01112      MOVE MPRF-EMP-NO                     TO ACCT-EMP-NO.         DTSBX343
01113      MOVE MJRN-TRAN-TYPE                  TO ACCT-TRAN.           DTSBX343
01114      MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX)    TO ACCT-ROW.            DTSBX343
01115      MOVE MJRN-ACCT-COL (MJRN-OCC-IDX)    TO ACCT-COL.            DTSBX343
01116      IF ACCT-ROW = 'CR'                                           DTSBX343
01117         MOVE MJRN-AMT (MJRN-OCC-IDX)      TO ACCT-AMT             DTSBX343
01118      ELSE                                                         DTSBX343
01119         IF ACCT-COL NOT = 'CH'                                    DTSBX343
01120            COMPUTE ACCT-AMT =                                     DTSBX343
01121              (MJRN-AMT (MJRN-OCC-IDX) * -1)                       DTSBX343
01122         ELSE                                                      DTSBX343
01123            MOVE MJRN-AMT (MJRN-OCC-IDX)   TO ACCT-AMT             DTSBX343
01124         END-IF                                                    DTSBX343
01125      END-IF.                                                      DTSBX343
01126                                                                   DTSBX343
01127      MOVE MJRN-TRAN-CATEGORY              TO ACCT-CAT.            DTSBX343
01128      MOVE MJRN-ESTB-DATE                  TO L001-FED-8-DATE-9.   DTSBX343
01129      PERFORM S001-FROM-FED-8              THRU S001-EXIT.         DTSBX343
01130      IF L001-VALID-DATE                                           DTSBX343
01131         MOVE L001-SLASH-8-DATE            TO ACCT-PROCESS-DT      DTSBX343
01132      ELSE                                                         DTSBX343
01133         MOVE LX34-SYS-DATE                TO ACCT-PROCESS-DT      DTSBX343
01134      END-IF.                                                      DTSBX343
01135      MOVE MJRN-RECEIVED-DATE              TO L001-FED-8-DATE-9.   DTSBX343
01136      PERFORM S001-FROM-FED-8              THRU S001-EXIT.         DTSBX343
01137      IF L001-VALID-DATE                                           DTSBX343
01138         MOVE L001-SLASH-8-DATE            TO ACCT-RCVD-DT         DTSBX343
01139      ELSE                                                         DTSBX343
01140         MOVE LX34-SYS-DATE                TO ACCT-RCVD-DT         DTSBX343
01141      END-IF.                                                      DTSBX343
01142      SET ACCT-SOURCE-CR-DB-88             TO TRUE.                DTSBX343
01143                                                                   DTSBX343
01144 **   WRITE ACCT-REC   FROM W-ACCT-REC                             DTSBX343
01145 *    IF NOT ACCT-STATUS-OK-88                                     DTSBX343
01146 *       DISPLAY 'CANNOT WRITE TO ACCT FILE '                      DTSBX343
01147 *          '  ' ACCT-STATUS '  ' ACCT-EMP-NO                      DTSBX343
01148 *    ELSE                                                         DTSBX343
01149 *       ADD +1 TO W-ACCT-CNT                                      DTSBX343
01150 **   END-IF.                                                      DTSBX343
01151                                                                   DTSBX343
01152 *** SELECT ONLY JOURNAL ENTRIES FROM MOST RECENT DATE.  ***       DTSBX343
01153      IF MJRN-ESTB-DATE = LX34-PRIOR-RUN-DATE                      DTSBX343
01154         WRITE ACCT-INCR-REC   FROM W-ACCT-REC                     DTSBX343
01155         IF NOT ACCT-I-STATUS-OK-88                                DTSBX343
01156            DISPLAY 'CANNOT WRITE TO ACCT FILE INCR '              DTSBX343
01157               '  ' ACCT-I-STATUS '  ' ACCT-EMP-NO                 DTSBX343
01158         ELSE                                                      DTSBX343
01159            ADD +1 TO W-ACCT-CNT-INCR                              DTSBX343
01160         END-IF                                                    DTSBX343
01161      END-IF.                                                      DTSBX343
01162                                                                   DTSBX343
01163 **   IF MPRF-EMP-NO = 156293                                      DTSBX343
01164 *       DISPLAY 'P2110   ' MPRF-EMP-NO '  ' ACCT-YRQ              DTSBX343
01165 *          '  ' ACCT-BATCH '/' ACCT-ITEM                          DTSBX343
01166 *       DISPLAY '   ' ACCT-ROW '  ' ACCT-COL                      DTSBX343
01167 *          '  ' ACCT-TRAN '  ' ACCT-AMT                           DTSBX343
01168 **   END-IF.                                                      DTSBX343
01169                                                                   DTSBX343
01170  P2110-EXIT.                                                      DTSBX343
01171      EXIT.                                                        DTSBX343
01172                                                                   DTSBX343
01173  P2120-SAVE-JRN.                                                  DTSBX343
01174      MOVE MJRN-YRQ (MJRN-OCC-IDX)        TO L004-QTR-5-9.         DTSBX343
01175      PERFORM S004-FROM-5                 THRU S004-EXIT.          DTSBX343
01176      IF L004-INVALID-QTR                                          DTSBX343
01177         GO TO P2120-EXIT                                          DTSBX343
01178      ELSE                                                         DTSBX343
01179         MOVE L004-ABS-QTR                TO QSUB                  DTSBX343
01180         IF TBL-YRQ (QSUB) = ZERO                                  DTSBX343
01181            MOVE L004-QTR-5-9             TO TBL-YRQ (QSUB)        DTSBX343
01182         END-IF                                                    DTSBX343
01183      END-IF.                                                      DTSBX343
01184                                                                   DTSBX343
01185      EVALUATE TRUE                                                DTSBX343
01186        WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'UI'                   DTSBX343
01187           PERFORM P2121-TABLE-UI    THRU P2121-EXIT               DTSBX343
01188                                                                   DTSBX343
01189        WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'LP'                   DTSBX343
01190           PERFORM P2122-TABLE-LP    THRU P2122-EXIT               DTSBX343
01191                                                                   DTSBX343
01192        WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'NP'                   DTSBX343
01193           PERFORM P2123-TABLE-NP    THRU P2123-EXIT               DTSBX343
01194                                                                   DTSBX343
01195        WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'MP'                   DTSBX343
01196           PERFORM P2124-TABLE-MP    THRU P2124-EXIT               DTSBX343
01197                                                                   DTSBX343
01198        WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'I '                   DTSBX343
01199           PERFORM P2125-TABLE-INT   THRU P2125-EXIT               DTSBX343
01200                                                                   DTSBX343
01201        WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'SU'                   DTSBX343
01202           PERFORM P2126-TABLE-SU    THRU P2126-EXIT               DTSBX343
01203                                                                   DTSBX343
01204      END-EVALUATE.                                                DTSBX343
01205                                                                   DTSBX343
01206 **   IF MJRN-EMP-NO = 062362 OR 073765                            DTSBX343
01207 *       MOVE J-UI-CHG (QSUB) TO DISPLAY-AMT1                      DTSBX343
01208 *       MOVE Q-UI-CHG (QSUB) TO DISPLAY-AMT2                      DTSBX343
01209 *       MOVE J-UI-PD (QSUB) TO DISPLAY-AMT3                       DTSBX343
01210 *       MOVE Q-UI-PD (QSUB) TO DISPLAY-AMT4                       DTSBX343
01211 *       DISPLAY 'P2121 ' MPRF-EMP-NO '  ' L004-QTR-5-9            DTSBX343
01212 *          '  ' MJRN-ACCT-COL (MJRN-OCC-IDX)                      DTSBX343
01213 *          '  Q CHG ' DISPLAY-AMT2                                DTSBX343
01214 *          '  J CHG ' DISPLAY-AMT1                                DTSBX343
01215 *          '  Q PD ' DISPLAY-AMT4                                 DTSBX343
01216 *          '  J PD ' DISPLAY-AMT3                                 DTSBX343
01217 **   END-IF.                                                      DTSBX343
01218  P2120-EXIT.                                                      DTSBX343
01219      EXIT.                                                        DTSBX343
01220                                                                   DTSBX343
01221  P2121-TABLE-UI.                                                  DTSBX343
01222      EVALUATE TRUE                                                DTSBX343
01223        WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                    DTSBX343
01224           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-CHG (QSUB)          DTSBX343
01225        WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX)                       DTSBX343
01226           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-PD (QSUB)           DTSBX343
01227        WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX)                     DTSBX343
01228           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-WV (QSUB)           DTSBX343
01229        WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX)                DTSBX343
01230           ADD MJRN-AMT (MJRN-OCC-IDX)                             DTSBX343
01231                                 TO J-UI-WO (QSUB)                 DTSBX343
01232        WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                  DTSBX343
01233           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-TL (QSUB)           DTSBX343
01234      END-EVALUATE.                                                DTSBX343
01235                                                                   DTSBX343
01236 **   IF MPRF-EMP-NO = 137540                                      DTSBX343
01237 *       MOVE J-UI-CHG (QSUB) TO DISPLAY-AMT1                      DTSBX343
01238 *       MOVE J-UI-PD (QSUB) TO DISPLAY-AMT2                       DTSBX343
01239 *       DISPLAY 'P2121 ' MPRF-EMP-NO                              DTSBX343
01240 *          '  ' MJRN-YRQ (MJRN-OCC-IDX)                           DTSBX343
01241 *          '  UI CH ' DISPLAY-AMT1                                DTSBX343
01242 *          '  UI PD ' DISPLAY-AMT2                                DTSBX343
01243 **   END-IF.                                                      DTSBX343
01244  P2121-EXIT.                                                      DTSBX343
01245      EXIT.                                                        DTSBX343
01246                                                                   DTSBX343
01247  P2122-TABLE-LP.                                                  DTSBX343
01248      EVALUATE TRUE                                                DTSBX343
01249        WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                    DTSBX343
01250           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-CHG (QSUB)          DTSBX343
01251        WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX)                       DTSBX343
01252           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-PD (QSUB)           DTSBX343
01253        WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX)                     DTSBX343
01254           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-WV (QSUB)           DTSBX343
01255        WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX)                DTSBX343
01256           ADD MJRN-AMT (MJRN-OCC-IDX)                             DTSBX343
01257                                 TO J-LP-WO (QSUB)                 DTSBX343
01258        WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                  DTSBX343
01259           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-TL (QSUB)           DTSBX343
01260      END-EVALUATE.                                                DTSBX343
01261                                                                   DTSBX343
01262 **   IF MPRF-EMP-NO = 137540                                      DTSBX343
01263 *       MOVE J-LP-CHG (QSUB) TO DISPLAY-AMT1                      DTSBX343
01264 *       MOVE J-LP-PD (QSUB) TO DISPLAY-AMT2                       DTSBX343
01265 *       DISPLAY 'P2122 ' MPRF-EMP-NO                              DTSBX343
01266 *          '  ' MJRN-YRQ (MJRN-OCC-IDX)                           DTSBX343
01267 *          '  LP CH ' DISPLAY-AMT1                                DTSBX343
01268 *          '  LP PD ' DISPLAY-AMT2                                DTSBX343
01269 **   END-IF.                                                      DTSBX343
01270  P2122-EXIT.                                                      DTSBX343
01271      EXIT.                                                        DTSBX343
01272                                                                   DTSBX343
01273  P2123-TABLE-NP.                                                  DTSBX343
01274      EVALUATE TRUE                                                DTSBX343
01275        WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                    DTSBX343
01276           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-CHG (QSUB)          DTSBX343
01277        WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX)                       DTSBX343
01278           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-PD (QSUB)           DTSBX343
01279        WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX)                     DTSBX343
01280           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-WV (QSUB)           DTSBX343
01281        WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX)                DTSBX343
01282           ADD MJRN-AMT (MJRN-OCC-IDX)                             DTSBX343
01283                                 TO J-NP-WO (QSUB)                 DTSBX343
01284        WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                  DTSBX343
01285           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-TL (QSUB)           DTSBX343
01286      END-EVALUATE.                                                DTSBX343
01287                                                                   DTSBX343
01288  P2123-EXIT.                                                      DTSBX343
01289      EXIT.                                                        DTSBX343
01290                                                                   DTSBX343
01291  P2124-TABLE-MP.                                                  DTSBX343
01292      EVALUATE TRUE                                                DTSBX343
01293        WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                    DTSBX343
01294           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-CHG (QSUB)          DTSBX343
01295        WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX)                       DTSBX343
01296           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-PD (QSUB)           DTSBX343
01297        WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX)                     DTSBX343
01298           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-WV (QSUB)           DTSBX343
01299        WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX)                DTSBX343
01300           ADD MJRN-AMT (MJRN-OCC-IDX)                             DTSBX343
01301                                 TO J-MP-WO (QSUB)                 DTSBX343
01302        WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                  DTSBX343
01303           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-TL (QSUB)           DTSBX343
01304      END-EVALUATE.                                                DTSBX343
01305                                                                   DTSBX343
01306  P2124-EXIT.                                                      DTSBX343
01307      EXIT.                                                        DTSBX343
01308                                                                   DTSBX343
01309  P2125-TABLE-INT.                                                 DTSBX343
01310      EVALUATE TRUE                                                DTSBX343
01311        WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                    DTSBX343
01312           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-CHG (QSUB)         DTSBX343
01313        WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX)                       DTSBX343
01314           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-PD (QSUB)          DTSBX343
01315        WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX)                     DTSBX343
01316           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-WV (QSUB)          DTSBX343
01317        WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX)                DTSBX343
01318           ADD MJRN-AMT (MJRN-OCC-IDX)                             DTSBX343
01319                                 TO J-INT-WO (QSUB)                DTSBX343
01320        WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                  DTSBX343
01321           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-TL (QSUB)          DTSBX343
01322      END-EVALUATE.                                                DTSBX343
01323                                                                   DTSBX343
01324  P2125-EXIT.                                                      DTSBX343
01325      EXIT.                                                        DTSBX343
01326                                                                   DTSBX343
01327  P2126-TABLE-SU.                                                  DTSBX343
01328      EVALUATE TRUE                                                DTSBX343
01329        WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                    DTSBX343
01330           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-CHG (QSUB)          DTSBX343
01331        WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX)                       DTSBX343
01332           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-PD (QSUB)           DTSBX343
01333        WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX)                     DTSBX343
01334           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-WV (QSUB)           DTSBX343
01335        WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX)                DTSBX343
01336           ADD MJRN-AMT (MJRN-OCC-IDX)                             DTSBX343
01337                                 TO J-SU-WO (QSUB)                 DTSBX343
01338        WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                  DTSBX343
01339           ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-TL (QSUB)           DTSBX343
01340      END-EVALUATE.                                                DTSBX343
01341                                                                   DTSBX343
01342  P2126-EXIT.                                                      DTSBX343
01343      EXIT.                                                        DTSBX343
01344                                                                   DTSBX343
01345                                                                   DTSBX343
01346  P3000-TRANSACTION-DETAIL.                                        DTSBX343
01347      PERFORM P3100-REPORTS          THRU P3100-EXIT.              DTSBX343
01348      PERFORM P3200-PAYMENT          THRU P3200-EXIT.              DTSBX343
01349      PERFORM P3300-ADJUSTMENT       THRU P3300-EXIT.              DTSBX343
01350                                                                   DTSBX343
01351  P3000-EXIT.                                                      DTSBX343
01352      EXIT.                                                        DTSBX343
01353                                                                   DTSBX343
01354                                                                   DTSBX343
01355  P3100-REPORTS.                                                   DTSBX343
01356      MOVE LOW-VALUES                TO MRPT-KEY-AREA.             DTSBX343
01357      MOVE MPRF-EMP-NO               TO MRPT-EMP-NO.               DTSBX343
01358      SET MRPT-RPT-88                TO TRUE.                      DTSBX343
01359      MOVE MRPT-KEY-AREA             TO MSKL-KEY-AREA.             DTSBX343
01360      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBX343
01361      IF L910-NO-REC-88                                            DTSBX343
01362         GO TO P3100-EXIT                                          DTSBX343
01363      ELSE                                                         DTSBX343
01364         PERFORM                                                   DTSBX343
01365           UNTIL L910-NO-REC-88                                    DTSBX343
01366             MOVE MSKL-REC                   TO MRPT-REC           DTSBX343
01367             IF MRPT-STATUS-CHNG-YES-88                            DTSBX343
01368                PERFORM P3130-STATUS-CHANGE  THRU P3130-EXIT       DTSBX343
01369             END-IF                                                DTSBX343
01370             PERFORM P3110-WRITE             THRU P3110-EXIT       DTSBX343
01371 **          IF MRPT-ESTB-DATE > 20070731                          DTSBX343
01372 *           OR MRPT-YRQ > 20031                                   DTSBX343
01373 *              IF MRPT-ANNUAL-YES-88                              DTSBX343
01374 *                 PERFORM P3120-ANNUAL      THRU P3120-EXIT       DTSBX343
01375 *              ELSE                                               DTSBX343
01376 *                 PERFORM P3110-WRITE       THRU P3110-EXIT       DTSBX343
01377 *                 PERFORM S910-READ-NEXT    THRU S910-EXIT        DTSBX343
01378 *              END-IF                                             DTSBX343
01379 **          END-IF                                                DTSBX343
01380             PERFORM S910-READ-NEXT          THRU S910-EXIT        DTSBX343
01381         END-PERFORM                                               DTSBX343
01382      END-IF.                                                      DTSBX343
01383                                                                   DTSBX343
01384  P3100-EXIT.                                                      DTSBX343
01385      EXIT.                                                        DTSBX343
01386                                                                   DTSBX343
01387  P3110-WRITE.                                                     DTSBX343
01388      MOVE MRPT-RPT-TYPE             TO TRAN-TRANS.                DTSBX343
01389      MOVE MRPT-BATCH-NO             TO TRAN-BATCH.                DTSBX343
01390      MOVE MRPT-ITEM-NO              TO TRAN-ITEM.                 DTSBX343
01391      MOVE MPRF-EMP-NO               TO TRAN-EMP-NO.               DTSBX343
01392      MOVE MRPT-YRQ                  TO L004-QTR-5-9               DTSBX343
01393      PERFORM S004-FROM-5            THRU S004-EXIT                DTSBX343
01394      MOVE L004-SLASH-5-QTR          TO TRAN-YRQ                   DTSBX343
01395      MOVE MRPT-REMIT-AMT            TO TRAN-AMT.                  DTSBX343
01396      MOVE MRPT-TOT-WAGE             TO TRAN-TOT-WAGE.             DTSBX343
01397      MOVE MRPT-TAX-WAGE             TO TRAN-TAX-WAGE.             DTSBX343
01398      MOVE MRPT-EXCESS-WAGE          TO TRAN-EXC-WAGE.             DTSBX343
01399      IF MPRF-CLASS-SELF-INS-88                                    DTSBX343
01400         MOVE ZERO                   TO TRAN-RATE                  DTSBX343
01401      ELSE                                                         DTSBX343
01402         COMPUTE W-RATE = (MRPT-UI-RATE * 100)                     DTSBX343
01403         MOVE W-RATE                 TO TRAN-RATE                  DTSBX343
01404      END-IF                                                       DTSBX343
01405      MOVE SPACES                    TO TRAN-ACCT.                 DTSBX343
01406      MOVE ZEROS                     TO TRAN-APPLIC-BATCH          DTSBX343
01407                                        TRAN-APPLIC-ITEM.          DTSBX343
01408      IF MRPT-ANNUAL-YES-88                                        DTSBX343
01409         MOVE 'T'                       TO TRAN-CAT                DTSBX343
01410      ELSE                                                         DTSBX343
01411         MOVE 'R'                       TO TRAN-CAT                DTSBX343
01412      END-IF.                                                      DTSBX343
01413      SET TRAN-SOURCE-CR-DB-88       TO TRUE.                      DTSBX343
01414      MOVE MRPT-RECEIVED-DATE        TO L001-FED-8-DATE-9.         DTSBX343
01415      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
01416      MOVE L001-SLASH-8-DATE         TO TRAN-RCVD-DT.              DTSBX343
01417      MOVE MRPT-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBX343
01418      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
01419      IF L001-VALID-DATE                                           DTSBX343
01420         MOVE L001-SLASH-8-DATE      TO TRAN-PROCESS-DT            DTSBX343
01421      ELSE                                                         DTSBX343
01422         MOVE TRAN-RCVD-DT           TO TRAN-PROCESS-DT            DTSBX343
01423      END-IF.                                                      DTSBX343
01424                                                                   DTSBX343
01425      MOVE MRPT-RESPONSIBLE-ACTIVITY  TO TRAN-RESP-ACTIVITY.       DTSBX343
01426      MOVE MRPT-RESPONSIBLE-OP-ID     TO TRAN-RESP-OPID.           DTSBX343
01427                                                                   DTSBX343
01428 **   WRITE TRAN-REC   FROM W-TRAN-REC                             DTSBX343
01429 *    IF NOT TRAN-STATUS-OK-88                                     DTSBX343
01430 *       DISPLAY 'CANNOT WRITE TO TRAN FILE '                      DTSBX343
01431 *          '  ' TRAN-STATUS '  ' TRAN-EMP-NO                      DTSBX343
01432 *    ELSE                                                         DTSBX343
01433 *       ADD +1 TO W-TRAN-CNT                                      DTSBX343
01434 *                 W-RPT-CNT                                       DTSBX343
01435 **   END-IF.                                                      DTSBX343
01436                                                                   DTSBX343
01437 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE.  ***          DTSBX343
01438      IF MRPT-ESTB-DATE = LX34-PRIOR-RUN-DATE                      DTSBX343
01439         WRITE TRAN-INCR-REC   FROM W-TRAN-REC                     DTSBX343
01440         IF NOT TRAN-I-STATUS-OK-88                                DTSBX343
01441            DISPLAY 'CANNOT WRITE TO TRAN INCR FILE '              DTSBX343
01442               '  ' TRAN-I-STATUS '  ' TRAN-EMP-NO                 DTSBX343
01443         ELSE                                                      DTSBX343
01444            ADD +1 TO W-TRAN-CNT-INCR                              DTSBX343
01445         END-IF                                                    DTSBX343
01446      END-IF.                                                      DTSBX343
01447                                                                   DTSBX343
01448  P3110-EXIT.                                                      DTSBX343
01449      EXIT.                                                        DTSBX343
01450                                                                   DTSBX343
01451 *P3120-ANNUAL.                                                    DTSBX343
01452 **   DISPLAY 'ANNUAL ' MPRF-EMP-NO '  ' MRPT-YRQ.                 DTSBX343
01453 *                                                                 DTSBX343
01454 *    PERFORM P3122-INIT-ANN-TBL     THRU P3122-EXIT.              DTSBX343
01455 *                                                                 DTSBX343
01456 *    SET W-RPT-COMPLETE-NULL-88     TO TRUE.                      DTSBX343
01457 *                                                                 DTSBX343
01458 *    MOVE MRPT-YRQ                  TO L004-QTR-5-9.              DTSBX343
01459 *    MOVE 4                         TO L004-QTR-5-Q.              DTSBX343
01460 *    MOVE L004-QTR-5-9              TO W-LAST-ANN-YRQ.            DTSBX343
01461 *                                                                 DTSBX343
01462 *    MOVE MRPT-BATCH-NO             TO W-BATCH.                   DTSBX343
01463 *    MOVE MRPT-ITEM-NO              TO W-ITEM.                    DTSBX343
01464 *                                                                 DTSBX343
01465 *    PERFORM                                                      DTSBX343
01466 *      UNTIL L910-NO-REC-88 OR W-RPT-COMPLETE-YES-88              DTSBX343
01467 *        MOVE MSKL-REC                  TO MRPT-REC               DTSBX343
01468 *        IF MRPT-YRQ > W-LAST-ANN-YRQ                             DTSBX343
01469 *        OR MPRF-EMP-NO                                           DTSBX343
01470 *           SET W-RPT-COMPLETE-YES-88 TO TRUE                     DTSBX343
01471 *        ELSE                                                     DTSBX343
01472 *           PERFORM P3121-SUM-DATA  THRU P3121-EXIT               DTSBX343
01473 *           PERFORM S910-READ-NEXT  THRU S910-EXIT                DTSBX343
01474 *        END-IF                                                   DTSBX343
01475 *    END-PERFORM.                                                 DTSBX343
01476 *                                                                 DTSBX343
01477 *    PERFORM                                                      DTSBX343
01478 *      VARYING ASUB FROM +1 BY +1                                 DTSBX343
01479 *      UNTIL ASUB > ASUB-LAST                                     DTSBX343
01480 *         PERFORM P3123-WRITE       THRU P3123-EXIT               DTSBX343
01481 *    END-PERFORM.                                                 DTSBX343
01482 *                                                                 DTSBX343
01483 *                                                                 DTSBX343
01484 *P3120-EXIT.                                                      DTSBX343
01485 *    EXIT.                                                        DTSBX343
01486 *                                                                 DTSBX343
01487 *P3121-SUM-DATA.                                                  DTSBX343
01488 *    MOVE +0                        TO ASUB.                      DTSBX343
01489 *    PERFORM                                                      DTSBX343
01490 *      VARYING ASUB1 FROM +1 BY +1                                DTSBX343
01491 *      UNTIL ASUB > +0                                            DTSBX343
01492 *      OR ASUB1 > ASUB-LAST                                       DTSBX343
01493 *        IF W-ANN-BATCH (ASUB1) = MRPT-BATCH-NO                   DTSBX343
01494 *        AND W-ANN-ITEM (ASUB1) = MRPT-ITEM-NO                    DTSBX343
01495 *           MOVE ASUB1              TO ASUB                       DTSBX343
01496 *        END-IF                                                   DTSBX343
01497 *    END-PERFORM.                                                 DTSBX343
01498 *                                                                 DTSBX343
01499 *    IF ASUB = ZERO                                               DTSBX343
01500 *       ADD +1                      TO ASUB-LAST                  DTSBX343
01501 *       MOVE ASUB-LAST              TO ASUB                       DTSBX343
01502 *    ELSE                                                         DTSBX343
01503 *       ADD MRPT-REMIT-AMT     TO W-ANN-REMIT (ASUB)              DTSBX343
01504 *       ADD MRPT-TOT-WAGE      TO W-ANN-TOT-WAGE (ASUB)           DTSBX343
01505 *       ADD MRPT-TAX-WAGE      TO W-ANN-TAX-WAGE (ASUB)           DTSBX343
01506 *       ADD MRPT-EXCESS-WAGE   TO W-ANN-EXCESS-WAGE (ASUB)        DTSBX343
01507 *       GO TO P3121-EXIT                                          DTSBX343
01508 *    END-IF.                                                      DTSBX343
01509 *                                                                 DTSBX343
01510 *    MOVE MRPT-RPT-TYPE                                           DTSBX343
01511 *         TO W-ANN-RPT-TYPE (ASUB).                               DTSBX343
01512 *    MOVE MRPT-YRQ             TO W-ANN-YRQ (ASUB).               DTSBX343
01513 *    MOVE MRPT-BATCH-NO        TO W-ANN-BATCH (ASUB).             DTSBX343
01514 *    MOVE MRPT-ITEM-NO         TO W-ANN-ITEM (ASUB).              DTSBX343
01515 *    ADD MRPT-REMIT-AMT        TO W-ANN-REMIT (ASUB).             DTSBX343
01516 *    ADD MRPT-TOT-WAGE         TO W-ANN-TOT-WAGE (ASUB).          DTSBX343
01517 *    ADD MRPT-TAX-WAGE         TO W-ANN-TAX-WAGE (ASUB).          DTSBX343
01518 *    ADD MRPT-EXCESS-WAGE      TO W-ANN-EXCESS-WAGE (ASUB).       DTSBX343
01519 *    MOVE MRPT-UI-RATE         TO W-ANN-RATE (ASUB).              DTSBX343
01520 *    MOVE MRPT-RECEIVED-DATE   TO W-ANN-RCVD-DT (ASUB).           DTSBX343
01521 *    MOVE MRPT-ESTB-DATE       TO W-ANN-PROCESS-DT (ASUB).        DTSBX343
01522 *                                                                 DTSBX343
01523 *P3121-EXIT.                                                      DTSBX343
01524 *    EXIT.                                                        DTSBX343
01525 *                                                                 DTSBX343
01526 *P3122-INIT-ANN-TBL.                                              DTSBX343
01527 *    MOVE ZERO                TO ASUB-LAST.                       DTSBX343
01528 *    PERFORM                                                      DTSBX343
01529 *      VARYING ASUB FROM +1 BY +1                                 DTSBX343
01530 *      UNTIL ASUB > ASUB-MAX                                      DTSBX343
01531 *        MOVE SPACES          TO W-ANN-RPT-TYPE (ASUB)            DTSBX343
01532 *        MOVE ZERO            TO W-ANN-YRQ (ASUB)                 DTSBX343
01533 *                                W-ANN-RATE (ASUB)                DTSBX343
01534 *                                W-ANN-REMIT (ASUB)               DTSBX343
01535 *                                W-ANN-BATCH (ASUB)               DTSBX343
01536 *                                W-ANN-ITEM (ASUB)                DTSBX343
01537 *                                W-ANN-TOT-WAGE (ASUB)            DTSBX343
01538 *                                W-ANN-TAX-WAGE (ASUB)            DTSBX343
01539 *                                W-ANN-EXCESS-WAGE (ASUB)         DTSBX343
01540 *                                W-ANN-RCVD-DT (ASUB)             DTSBX343
01541 *                                W-ANN-PROCESS-DT (ASUB)          DTSBX343
01542 *    END-PERFORM.                                                 DTSBX343
01543 *                                                                 DTSBX343
01544 *P3122-EXIT.                                                      DTSBX343
01545 *    EXIT.                                                        DTSBX343
01546 *                                                                 DTSBX343
01547 *P3123-WRITE.                                                     DTSBX343
01548 *    MOVE W-ANN-RPT-TYPE (ASUB)      TO TRAN-TRANS.               DTSBX343
01549 *    MOVE W-ANN-BATCH (ASUB)         TO TRAN-BATCH.               DTSBX343
01550 *    MOVE W-ANN-ITEM (ASUB)          TO TRAN-ITEM.                DTSBX343
01551 *    MOVE MPRF-EMP-NO                TO TRAN-EMP-NO.              DTSBX343
01552 *    MOVE 1                          TO W-ANN-YRQ-Q (ASUB).       DTSBX343
01553 *    MOVE W-ANN-YRQ (ASUB)           TO L004-QTR-5-9              DTSBX343
01554 *    PERFORM S004-FROM-5             THRU S004-EXIT               DTSBX343
01555 *    MOVE L004-SLASH-5-QTR           TO TRAN-YRQ                  DTSBX343
01556 *    MOVE W-ANN-REMIT (ASUB)         TO TRAN-AMT.                 DTSBX343
01557 *    MOVE W-ANN-TOT-WAGE (ASUB)      TO TRAN-TOT-WAGE.            DTSBX343
01558 *    MOVE W-ANN-TAX-WAGE (ASUB)      TO TRAN-TAX-WAGE.            DTSBX343
01559 *    MOVE W-ANN-EXCESS-WAGE (ASUB) TO TRAN-EXC-WAGE.              DTSBX343
01560 *    COMPUTE W-RATE = (W-ANN-RATE (ASUB) * 100).                  DTSBX343
01561 *    MOVE W-RATE                     TO TRAN-RATE.                DTSBX343
01562 *    MOVE SPACES                     TO TRAN-ACCT.                DTSBX343
01563 *    MOVE 'T'                        TO TRAN-CAT.                 DTSBX343
01564 *    SET TRAN-SOURCE-CR-DB-88        TO TRUE.                     DTSBX343
01565 *    MOVE W-ANN-RCVD-DT (ASUB)       TO L001-FED-8-DATE-9.        DTSBX343
01566 *    PERFORM S001-FROM-FED-8         THRU S001-EXIT.              DTSBX343
01567 *    MOVE L001-SLASH-8-DATE          TO TRAN-RCVD-DT.             DTSBX343
01568 *    MOVE W-ANN-PROCESS-DT (ASUB)    TO L001-FED-8-DATE-9.        DTSBX343
01569 *    PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
01570 *    MOVE L001-SLASH-8-DATE         TO TRAN-PROCESS-DT.           DTSBX343
01571 *                                                                 DTSBX343
01572 *    WRITE TRAN-REC   FROM W-TRAN-REC.                            DTSBX343
01573 *    IF NOT TRAN-STATUS-OK-88                                     DTSBX343
01574 *       DISPLAY 'CANNOT WRITE TO TRAN FILE '                      DTSBX343
01575 *          '  ' TRAN-STATUS '  ' TRAN-EMP-NO                      DTSBX343
01576 *    ELSE                                                         DTSBX343
01577 *       ADD +1 TO W-TRAN-CNT                                      DTSBX343
01578 *                 W-ANN-RPT-CNT                                   DTSBX343
01579 *    END-IF.                                                      DTSBX343
01580 *                                                                 DTSBX343
01581 *P3123-EXIT.                                                      DTSBX343
01582 *    EXIT.                                                        DTSBX343
01583                                                                   DTSBX343
01584  P3130-STATUS-CHANGE.                                             DTSBX343
01585 ***  DISPLAY 'STATUS ' MRPT-EMP-NO '  ' MRPT-BATCH-NO             DTSBX343
01586 ***     '  ' MRPT-ITEM-NO.                                        DTSBX343
01587      MOVE LX34-PRIOR-RUN-DATE     TO L001-FED-8-DATE-9.           DTSBX343
01588      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX343
01589      MOVE L001-SLASH-8-DATE       TO SUMMARY-PROCESS-DT.          DTSBX343
01590      MOVE 'STATUS CHANGE '        TO SUMMARY-MESSAGE.             DTSBX343
01591      MOVE MRPT-EMP-NO             TO SUMMARY-EMP-NO               DTSBX343
01592                                                                   DTSBX343
01593      MOVE MRPT-BATCH-NO           TO SUMMARY-BATCH.               DTSBX343
01594      MOVE MRPT-ITEM-NO            TO SUMMARY-ITEM.                DTSBX343
01595      MOVE MRPT-RPT-TYPE           TO SUMMARY-TRAN.                DTSBX343
01596      SET SUMMARY-SOURCE-STATUS-88 TO TRUE                         DTSBX343
01597                                                                   DTSBX343
01598      WRITE SUMMARY-REC            FROM W-SUMMARY-REC.             DTSBX343
01599      ADD  +1 TO W-SUMMARY-CNT.                                    DTSBX343
01600                                                                   DTSBX343
01601  P3130-EXIT.                                                      DTSBX343
01602      EXIT.                                                        DTSBX343
01603                                                                   DTSBX343
01604  P3200-PAYMENT.                                                   DTSBX343
01605      MOVE LOW-VALUES                TO MPAY-KEY-AREA.             DTSBX343
01606      MOVE MPRF-EMP-NO               TO MPAY-EMP-NO.               DTSBX343
01607      SET MPAY-PAY-88 TO TRUE.                                     DTSBX343
01608      MOVE MPAY-KEY-AREA             TO MSKL-KEY-AREA.             DTSBX343
01609      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBX343
01610      IF L910-NO-REC-88                                            DTSBX343
01611         GO TO P3200-EXIT                                          DTSBX343
01612      ELSE                                                         DTSBX343
01613         PERFORM                                                   DTSBX343
01614           UNTIL L910-NO-REC-88                                    DTSBX343
01615             MOVE MSKL-REC               TO MPAY-REC               DTSBX343
01616             PERFORM P3210-WRITE         THRU P3210-EXIT           DTSBX343
01617 *&          IF MPAY-ESTB-DATE = LECM-PRIOR-RUN-DATE               DTSBX343
01618 *              DISPLAY 'P3200  ' MPRF-EMP-NO '  ' MPAY-BATCH-NO   DTSBX343
01619 *                 '  ' MPAY-ITEM-NO                               DTSBX343
01620 *              PERFORM P3210-WRITE      THRU P3210-EXIT           DTSBX343
01621 *&          END-IF                                                DTSBX343
01622             PERFORM S910-READ-NEXT      THRU S910-EXIT            DTSBX343
01623         END-PERFORM                                               DTSBX343
01624      END-IF.                                                      DTSBX343
01625                                                                   DTSBX343
01626  P3200-EXIT.                                                      DTSBX343
01627      EXIT.                                                        DTSBX343
01628                                                                   DTSBX343
01629  P3210-WRITE.                                                     DTSBX343
01630      MOVE MPAY-PAY-TYPE             TO TRAN-TRANS.                DTSBX343
01631      IF MPAY-APPLIC-YRQ > ZERO                                    DTSBX343
01632         MOVE MPAY-APPLIC-YRQ        TO L004-QTR-5-9               DTSBX343
01633         PERFORM S004-FROM-5         THRU S004-EXIT                DTSBX343
01634         MOVE L004-SLASH-5-QTR       TO TRAN-YRQ                   DTSBX343
01635      ELSE                                                         DTSBX343
01636         MOVE SPACES                 TO TRAN-YRQ                   DTSBX343
01637      END-IF.                                                      DTSBX343
01638      MOVE MPRF-EMP-NO               TO TRAN-EMP-NO.               DTSBX343
01639      MOVE MPAY-BATCH-NO             TO TRAN-BATCH.                DTSBX343
01640      MOVE MPAY-ITEM-NO              TO TRAN-ITEM.                 DTSBX343
01641      MOVE MPAY-REMIT-AMT            TO TRAN-AMT.                  DTSBX343
01642                                                                   DTSBX343
01643      MOVE ZERO                      TO TRAN-TAX-WAGE              DTSBX343
01644                                        TRAN-TOT-WAGE              DTSBX343
01645                                        TRAN-EXC-WAGE              DTSBX343
01646                                        TRAN-RATE.                 DTSBX343
01647      MOVE MPAY-APPLIC-IND           TO TRAN-ACCT.                 DTSBX343
01648      MOVE MPAY-APPLIC-BATCH-NO      TO TRAN-APPLIC-BATCH.         DTSBX343
01649      MOVE MPAY-APPLIC-ITEM-NO       TO TRAN-APPLIC-ITEM.          DTSBX343
01650      MOVE 'P'                       TO TRAN-CAT.                  DTSBX343
01651      SET TRAN-SOURCE-CR-DB-88       TO TRUE.                      DTSBX343
01652      MOVE MPAY-RECEIVED-DATE        TO L001-FED-8-DATE-9.         DTSBX343
01653      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
01654      MOVE L001-SLASH-8-DATE         TO TRAN-RCVD-DT.              DTSBX343
01655      MOVE MPAY-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBX343
01656      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
01657      IF L001-VALID-DATE                                           DTSBX343
01658         MOVE L001-SLASH-8-DATE      TO TRAN-PROCESS-DT            DTSBX343
01659      ELSE                                                         DTSBX343
01660         MOVE TRAN-RCVD-DT           TO TRAN-PROCESS-DT            DTSBX343
01661 **      MOVE W-DEFAULT-DATE         TO TRAN-PROCESS-DT            DTSBX343
01662      END-IF.                                                      DTSBX343
01663                                                                   DTSBX343
01664      MOVE MPAY-RESPONSIBLE-ACTIVITY  TO TRAN-RESP-ACTIVITY.       DTSBX343
01665      MOVE MPAY-RESPONSIBLE-OP-ID     TO TRAN-RESP-OPID.           DTSBX343
01666                                                                   DTSBX343
01667 **   WRITE TRAN-REC   FROM W-TRAN-REC                             DTSBX343
01668 *    IF NOT TRAN-STATUS-OK-88                                     DTSBX343
01669 *       DISPLAY 'CANNOT WRITE TO TRAN FILE '                      DTSBX343
01670 *          '  ' TRAN-STATUS '  ' TRAN-EMP-NO                      DTSBX343
01671 *    ELSE                                                         DTSBX343
01672 *       ADD +1 TO W-TRAN-CNT                                      DTSBX343
01673 *                 W-PAY-CNT                                       DTSBX343
01674 **   END-IF.                                                      DTSBX343
01675                                                                   DTSBX343
01676 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE.  ***          DTSBX343
01677      IF MPAY-ESTB-DATE = LX34-PRIOR-RUN-DATE                      DTSBX343
01678         WRITE TRAN-INCR-REC   FROM W-TRAN-REC                     DTSBX343
01679         IF NOT TRAN-I-STATUS-OK-88                                DTSBX343
01680            DISPLAY 'CANNOT WRITE TO TRAN FILE '                   DTSBX343
01681               '  ' TRAN-I-STATUS '  ' TRAN-EMP-NO                 DTSBX343
01682         ELSE                                                      DTSBX343
01683            ADD +1 TO W-TRAN-CNT                                   DTSBX343
01684         END-IF                                                    DTSBX343
01685      END-IF.                                                      DTSBX343
01686                                                                   DTSBX343
01687  P3210-EXIT.                                                      DTSBX343
01688      EXIT.                                                        DTSBX343
01689                                                                   DTSBX343
01690  P3300-ADJUSTMENT.                                                DTSBX343
01691      MOVE LOW-VALUES                TO MADJ-KEY-AREA.             DTSBX343
01692      MOVE MPRF-EMP-NO               TO MADJ-EMP-NO.               DTSBX343
01693      SET MADJ-ADJ-88 TO TRUE.                                     DTSBX343
01694      MOVE MADJ-KEY-AREA             TO MSKL-KEY-AREA.             DTSBX343
01695      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBX343
01696      IF L910-NO-REC-88                                            DTSBX343
01697         GO TO P3300-EXIT                                          DTSBX343
01698      ELSE                                                         DTSBX343
01699         PERFORM                                                   DTSBX343
01700           UNTIL L910-NO-REC-88                                    DTSBX343
01701             MOVE MSKL-REC               TO MADJ-REC               DTSBX343
01702             PERFORM P3310-WRITE         THRU P3310-EXIT           DTSBX343
01703 *&          IF MADJ-ESTB-DATE = LECM-PRIOR-RUN-DATE               DTSBX343
01704 *              PERFORM P3310-WRITE      THRU P3310-EXIT           DTSBX343
01705 *&          END-IF                                                DTSBX343
01706             PERFORM S910-READ-NEXT      THRU S910-EXIT            DTSBX343
01707         END-PERFORM                                               DTSBX343
01708      END-IF.                                                      DTSBX343
01709                                                                   DTSBX343
01710  P3300-EXIT.                                                      DTSBX343
01711      EXIT.                                                        DTSBX343
01712                                                                   DTSBX343
01713  P3310-WRITE.                                                     DTSBX343
01714      IF MADJ-CHRG-88                                              DTSBX343
01715      OR MADJ-WAIVE-88                                             DTSBX343
01716      OR MADJ-TOLER-88                                             DTSBX343
01717      OR MADJ-WRITE-OFF-88                                         DTSBX343
01718      OR MADJ-WRITE-OFF-REV-88                                     DTSBX343
01719         NEXT SENTENCE                                             DTSBX343
01720      ELSE                                                         DTSBX343
01721         GO TO P3310-EXIT                                          DTSBX343
01722      END-IF.                                                      DTSBX343
01723      MOVE MADJ-ADJ-TYPE             TO TRAN-TRANS.                DTSBX343
01724      MOVE MADJ-BATCH-NO             TO TRAN-BATCH.                DTSBX343
01725      MOVE MADJ-ITEM-NO              TO TRAN-ITEM.                 DTSBX343
01726      IF MADJ-APPLIC-YRQ > ZERO                                    DTSBX343
01727         MOVE MADJ-APPLIC-YRQ        TO L004-QTR-5-9               DTSBX343
01728         PERFORM S004-FROM-5         THRU S004-EXIT                DTSBX343
01729         MOVE L004-SLASH-5-QTR       TO TRAN-YRQ                   DTSBX343
01730      ELSE                                                         DTSBX343
01731         MOVE SPACES                 TO TRAN-YRQ                   DTSBX343
01732      END-IF.                                                      DTSBX343
01733      MOVE MPRF-EMP-NO               TO TRAN-EMP-NO.               DTSBX343
01734      MOVE MADJ-AMT                  TO TRAN-AMT.                  DTSBX343
01735                                                                   DTSBX343
01736      MOVE ZERO                      TO TRAN-TOT-WAGE              DTSBX343
01737                                        TRAN-TAX-WAGE              DTSBX343
01738                                        TRAN-EXC-WAGE              DTSBX343
01739                                        TRAN-RATE.                 DTSBX343
01740      MOVE MADJ-APPLIC-IND           TO TRAN-ACCT.                 DTSBX343
01741      MOVE MADJ-APPLIC-BATCH-NO      TO TRAN-APPLIC-BATCH.         DTSBX343
01742      MOVE MADJ-APPLIC-ITEM-NO       TO TRAN-APPLIC-ITEM.          DTSBX343
01743      MOVE 'A'                       TO TRAN-CAT.                  DTSBX343
01744      SET TRAN-SOURCE-CR-DB-88       TO TRUE.                      DTSBX343
01745      MOVE MADJ-RECEIVED-DATE        TO L001-FED-8-DATE-9.         DTSBX343
01746      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
01747      MOVE L001-SLASH-8-DATE         TO TRAN-RCVD-DT.              DTSBX343
01748      MOVE MADJ-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBX343
01749      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
01750      IF L001-VALID-DATE                                           DTSBX343
01751         MOVE L001-SLASH-8-DATE      TO TRAN-PROCESS-DT            DTSBX343
01752      ELSE                                                         DTSBX343
01753 **      MOVE W-DEFAULT-DATE         TO TRAN-PROCESS-DT            DTSBX343
01754         MOVE TRAN-RCVD-DT           TO TRAN-PROCESS-DT            DTSBX343
01755      END-IF.                                                      DTSBX343
01756                                                                   DTSBX343
01757      MOVE MADJ-RESPONSIBLE-ACTIVITY  TO TRAN-RESP-ACTIVITY.       DTSBX343
01758      MOVE MADJ-RESPONSIBLE-OP-ID     TO TRAN-RESP-OPID.           DTSBX343
01759                                                                   DTSBX343
01760 **   WRITE TRAN-REC   FROM W-TRAN-REC                             DTSBX343
01761 *    IF NOT TRAN-STATUS-OK-88                                     DTSBX343
01762 *       DISPLAY 'CANNOT WRITE TO TRAN FILE '                      DTSBX343
01763 *          '  ' TRAN-STATUS '  ' TRAN-EMP-NO                      DTSBX343
01764 *    ELSE                                                         DTSBX343
01765 *       ADD +1 TO W-TRAN-CNT                                      DTSBX343
01766 *                 W-ADJ-CNT                                       DTSBX343
01767 **   END-IF.                                                      DTSBX343
01768                                                                   DTSBX343
01769 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE.  ***          DTSBX343
01770      IF MADJ-ESTB-DATE = LX34-PRIOR-RUN-DATE                      DTSBX343
01771         WRITE TRAN-INCR-REC   FROM W-TRAN-REC                     DTSBX343
01772         IF NOT TRAN-I-STATUS-OK-88                                DTSBX343
01773            DISPLAY 'CANNOT WRITE TO TRAN INCR FILE '              DTSBX343
01774               '  ' TRAN-I-STATUS '  ' TRAN-EMP-NO                 DTSBX343
01775         ELSE                                                      DTSBX343
01776            ADD +1 TO W-TRAN-CNT                                   DTSBX343
01777         END-IF                                                    DTSBX343
01778      END-IF.                                                      DTSBX343
01779                                                                   DTSBX343
01780  P3310-EXIT.                                                      DTSBX343
01781      EXIT.                                                        DTSBX343
01782                                                                   DTSBX343
01783  P4000-CORRECTIONS.                                               DTSBX343
01784      PERFORM                                                      DTSBX343
01785        VARYING QSUB FROM +1 BY +1                                 DTSBX343
01786        UNTIL QSUB > QMAX                                          DTSBX343
01787           IF (Q-UI-CHG (QSUB)         NOT = J-UI-CHG (QSUB)       DTSBX343
01788           OR   Q-UI-PD (QSUB)      NOT = J-UI-PD (QSUB)           DTSBX343
01789           OR   Q-UI-WV (QSUB)      NOT = J-UI-WV (QSUB)           DTSBX343
01790           OR   Q-UI-WO (QSUB) NOT = J-UI-WO (QSUB)                DTSBX343
01791           OR   Q-UI-TL (QSUB)      NOT = J-UI-TL (QSUB))          DTSBX343
01792              PERFORM P4100-CORRECT-UI   THRU P4100-EXIT           DTSBX343
01793           END-IF                                                  DTSBX343
01794           IF (Q-INT-CHG (QSUB)      NOT = J-INT-CHG (QSUB)        DTSBX343
01795           OR   Q-INT-PD (QSUB)     NOT = J-INT-PD (QSUB)          DTSBX343
01796           OR   Q-INT-WV (QSUB) NOT = J-INT-WV (QSUB)              DTSBX343
01797           OR   Q-INT-WO (QSUB) NOT = J-INT-WO (QSUB)              DTSBX343
01798           OR   Q-INT-TL (QSUB)     NOT = J-INT-TL (QSUB))         DTSBX343
01799              PERFORM P4200-CORRECT-INT  THRU P4200-EXIT           DTSBX343
01800           END-IF                                                  DTSBX343
01801           IF (Q-LP-CHG (QSUB)       NOT = J-LP-CHG (QSUB)         DTSBX343
01802           OR   Q-LP-PD (QSUB)      NOT = J-LP-PD (QSUB)           DTSBX343
01803           OR   Q-LP-WV (QSUB)      NOT = J-LP-WV (QSUB)           DTSBX343
01804           OR   Q-LP-WO (QSUB) NOT = J-LP-WO (QSUB)                DTSBX343
01805           OR   Q-LP-TL (QSUB)      NOT = J-LP-TL (QSUB))          DTSBX343
01806              PERFORM P4300-CORRECT-LP  THRU P4300-EXIT            DTSBX343
01807           END-IF                                                  DTSBX343
01808           IF (Q-NP-CHG (QSUB)       NOT = J-NP-CHG (QSUB)         DTSBX343
01809           OR   Q-NP-PD (QSUB)      NOT = J-NP-PD (QSUB)           DTSBX343
01810           OR   Q-NP-WV (QSUB)      NOT = J-NP-WV (QSUB)           DTSBX343
01811           OR   Q-NP-WO (QSUB) NOT = J-NP-WO (QSUB)                DTSBX343
01812           OR   Q-NP-TL (QSUB)      NOT = J-NP-TL (QSUB))          DTSBX343
01813              PERFORM P4400-CORRECT-NP  THRU P4400-EXIT            DTSBX343
01814           END-IF                                                  DTSBX343
01815           IF (Q-MP-CHG (QSUB)       NOT = J-MP-CHG (QSUB)         DTSBX343
01816           OR   Q-MP-PD (QSUB)      NOT = J-MP-PD (QSUB)           DTSBX343
01817           OR   Q-MP-WV (QSUB)      NOT = J-MP-WV (QSUB)           DTSBX343
01818           OR   Q-MP-WO (QSUB) NOT =  J-MP-WO (QSUB)               DTSBX343
01819           OR   Q-MP-TL (QSUB)      NOT = J-MP-TL (QSUB))          DTSBX343
01820              PERFORM P4500-CORRECT-MP  THRU P4500-EXIT            DTSBX343
01821           END-IF                                                  DTSBX343
01822           IF (Q-SU-CHG (QSUB)       NOT = J-SU-CHG (QSUB)         DTSBX343
01823           OR   Q-SU-PD (QSUB)      NOT = J-SU-PD (QSUB)           DTSBX343
01824           OR   Q-SU-WV (QSUB)      NOT = J-SU-WV (QSUB)           DTSBX343
01825           OR   Q-SU-WO (QSUB) NOT = J-SU-WO (QSUB)                DTSBX343
01826           OR   Q-SU-TL (QSUB)      NOT = J-SU-TL (QSUB))          DTSBX343
01827              PERFORM P4600-CORRECT-SU  THRU P4600-EXIT            DTSBX343
01828           END-IF                                                  DTSBX343
01829      END-PERFORM.                                                 DTSBX343
01830                                                                   DTSBX343
01831  P4000-EXIT.                                                      DTSBX343
01832      EXIT.                                                        DTSBX343
01833                                                                   DTSBX343
01834  P4100-CORRECT-UI.                                                DTSBX343
01835      IF TBL-JRN-BAD-88 (QSUB)                                     DTSBX343
01836         GO TO P4100-EXIT                                          DTSBX343
01837      ELSE                                                         DTSBX343
01838         ADD +1   TO W-ERROR-CNT                                   DTSBX343
01839      END-IF.                                                      DTSBX343
01840                                                                   DTSBX343
01841      MOVE 'UI'                  TO ACCT-ROW.                      DTSBX343
01842                                                                   DTSBX343
01843      MOVE ZERO                  TO ADJ-CHG                        DTSBX343
01844                                    ADJ-PD                         DTSBX343
01845                                    ADJ-WV                         DTSBX343
01846                                    ADJ-WO                         DTSBX343
01847                                    ADJ-TL.                        DTSBX343
01848                                                                   DTSBX343
01849      COMPUTE ADJ-CHG = (Q-UI-CHG (QSUB) - J-UI-CHG (QSUB)).       DTSBX343
01850      COMPUTE ADJ-PD  = (Q-UI-PD  (QSUB) - J-UI-PD  (QSUB)).       DTSBX343
01851      COMPUTE ADJ-WV  = (Q-UI-WV  (QSUB) - J-UI-WV  (QSUB)).       DTSBX343
01852      COMPUTE ADJ-WO  = (Q-UI-WO  (QSUB) - J-UI-WO  (QSUB)).       DTSBX343
01853      COMPUTE ADJ-TL  = (Q-UI-TL  (QSUB) - J-UI-TL  (QSUB)).       DTSBX343
01854                                                                   DTSBX343
01855 **   DISPLAY 'P4900 Q CHG ' Q-UI-CHG (QSUB)                       DTSBX343
01856 *       '  Q PD ' Q-UI-PD (QSUB)                                  DTSBX343
01857 *    DISPLAY '      J CHG ' J-UI-CHG (QSUB)                       DTSBX343
01858 **      '  J PD ' J-UI-PD (QSUB).                                 DTSBX343
01859      PERFORM P4900-WRITE-ACCT         THRU P4900-EXIT.            DTSBX343
01860                                                                   DTSBX343
01861  P4100-EXIT.                                                      DTSBX343
01862      EXIT.                                                        DTSBX343
01863                                                                   DTSBX343
01864  P4200-CORRECT-INT.                                               DTSBX343
01865      IF TBL-JRN-BAD-88 (QSUB)                                     DTSBX343
01866         GO TO P4200-EXIT                                          DTSBX343
01867      ELSE                                                         DTSBX343
01868         ADD +1   TO W-ERROR-CNT                                   DTSBX343
01869      END-IF.                                                      DTSBX343
01870                                                                   DTSBX343
01871      MOVE 'I '                  TO ACCT-ROW.                      DTSBX343
01872                                                                   DTSBX343
01873      MOVE ZERO                  TO ADJ-CHG                        DTSBX343
01874                                    ADJ-PD                         DTSBX343
01875                                    ADJ-WV                         DTSBX343
01876                                    ADJ-WO                         DTSBX343
01877                                    ADJ-TL.                        DTSBX343
01878                                                                   DTSBX343
01879      COMPUTE ADJ-CHG = (Q-INT-CHG (QSUB) - J-INT-CHG (QSUB)).     DTSBX343
01880      COMPUTE ADJ-PD  = (Q-INT-PD (QSUB) - J-INT-PD (QSUB)).       DTSBX343
01881      COMPUTE ADJ-WV  = (Q-INT-WV (QSUB) - J-INT-WV (QSUB)).       DTSBX343
01882      COMPUTE ADJ-WO  = (Q-INT-WO (QSUB) - J-INT-WO (QSUB)).       DTSBX343
01883      COMPUTE ADJ-TL  = (Q-INT-TL (QSUB) - J-INT-TL (QSUB)).       DTSBX343
01884                                                                   DTSBX343
01885      PERFORM P4900-WRITE-ACCT         THRU P4900-EXIT.            DTSBX343
01886                                                                   DTSBX343
01887  P4200-EXIT.                                                      DTSBX343
01888      EXIT.                                                        DTSBX343
01889                                                                   DTSBX343
01890  P4300-CORRECT-LP.                                                DTSBX343
01891      IF TBL-JRN-BAD-88 (QSUB)                                     DTSBX343
01892 **      DISPLAY 'P4300 LP ' MPRF-EMP-NO '  '                      DTSBX343
01893 **         TBL-YRQ (QSUB)                                         DTSBX343
01894         GO TO P4300-EXIT                                          DTSBX343
01895      ELSE                                                         DTSBX343
01896         ADD +1   TO W-ERROR-CNT                                   DTSBX343
01897      END-IF.                                                      DTSBX343
01898                                                                   DTSBX343
01899      MOVE 'LP'                  TO ACCT-ROW.                      DTSBX343
01900                                                                   DTSBX343
01901      MOVE ZERO                  TO ADJ-CHG                        DTSBX343
01902                                    ADJ-PD                         DTSBX343
01903                                    ADJ-WV                         DTSBX343
01904                                    ADJ-WO                         DTSBX343
01905                                    ADJ-TL.                        DTSBX343
01906                                                                   DTSBX343
01907      COMPUTE ADJ-CHG = (Q-LP-CHG (QSUB) - J-LP-CHG (QSUB)).       DTSBX343
01908      COMPUTE ADJ-PD  = (Q-LP-PD (QSUB) - J-LP-PD (QSUB)).         DTSBX343
01909      COMPUTE ADJ-WV  = (Q-LP-WV (QSUB) - J-LP-WV (QSUB)).         DTSBX343
01910      COMPUTE ADJ-WO  = (Q-LP-WO  (QSUB) - J-LP-WO (QSUB)).        DTSBX343
01911      COMPUTE ADJ-TL  = (Q-LP-TL (QSUB) - J-LP-TL  (QSUB)).        DTSBX343
01912                                                                   DTSBX343
01913      PERFORM P4900-WRITE-ACCT         THRU P4900-EXIT.            DTSBX343
01914                                                                   DTSBX343
01915  P4300-EXIT.                                                      DTSBX343
01916      EXIT.                                                        DTSBX343
01917                                                                   DTSBX343
01918  P4400-CORRECT-NP.                                                DTSBX343
01919      IF TBL-JRN-BAD-88 (QSUB)                                     DTSBX343
01920 **      DISPLAY 'P4400 NP ' MPRF-EMP-NO '  '                      DTSBX343
01921 **         TBL-YRQ (QSUB)                                         DTSBX343
01922         GO TO P4400-EXIT                                          DTSBX343
01923      ELSE                                                         DTSBX343
01924         ADD +1   TO W-ERROR-CNT                                   DTSBX343
01925      END-IF.                                                      DTSBX343
01926                                                                   DTSBX343
01927      MOVE 'NP'                  TO ACCT-ROW.                      DTSBX343
01928                                                                   DTSBX343
01929      MOVE ZERO                  TO ADJ-CHG                        DTSBX343
01930                                    ADJ-PD                         DTSBX343
01931                                    ADJ-WV                         DTSBX343
01932                                    ADJ-WO                         DTSBX343
01933                                    ADJ-TL.                        DTSBX343
01934                                                                   DTSBX343
01935      COMPUTE ADJ-CHG = (Q-NP-CHG (QSUB) - J-NP-CHG (QSUB)).       DTSBX343
01936      COMPUTE ADJ-PD  = (Q-NP-PD (QSUB) - J-NP-PD (QSUB)).         DTSBX343
01937      COMPUTE ADJ-WV  = (Q-NP-WV (QSUB) - J-NP-WV (QSUB)).         DTSBX343
01938      COMPUTE ADJ-WO  = (Q-NP-WO  (QSUB) - J-NP-WO (QSUB)).        DTSBX343
01939      COMPUTE ADJ-TL  = (Q-NP-TL (QSUB) - J-NP-TL  (QSUB)).        DTSBX343
01940                                                                   DTSBX343
01941      PERFORM P4900-WRITE-ACCT         THRU P4900-EXIT.            DTSBX343
01942                                                                   DTSBX343
01943  P4400-EXIT.                                                      DTSBX343
01944      EXIT.                                                        DTSBX343
01945                                                                   DTSBX343
01946  P4500-CORRECT-MP.                                                DTSBX343
01947      IF TBL-JRN-BAD-88 (QSUB)                                     DTSBX343
01948 **      DISPLAY 'P4500 MP ' MPRF-EMP-NO '  '                      DTSBX343
01949 **         TBL-YRQ (QSUB)                                         DTSBX343
01950         GO TO P4500-EXIT                                          DTSBX343
01951      ELSE                                                         DTSBX343
01952         ADD +1   TO W-ERROR-CNT                                   DTSBX343
01953      END-IF.                                                      DTSBX343
01954                                                                   DTSBX343
01955      MOVE 'MP'                  TO ACCT-ROW.                      DTSBX343
01956                                                                   DTSBX343
01957      MOVE ZERO                  TO ADJ-CHG                        DTSBX343
01958                                    ADJ-PD                         DTSBX343
01959                                    ADJ-WV                         DTSBX343
01960                                    ADJ-WO                         DTSBX343
01961                                    ADJ-TL.                        DTSBX343
01962                                                                   DTSBX343
01963      COMPUTE ADJ-CHG = (Q-MP-CHG (QSUB) - J-MP-CHG (QSUB)).       DTSBX343
01964      COMPUTE ADJ-PD  = (Q-MP-PD (QSUB) - J-MP-PD (QSUB)).         DTSBX343
01965      COMPUTE ADJ-WV  = (Q-MP-WV (QSUB) - J-MP-WV (QSUB)).         DTSBX343
01966      COMPUTE ADJ-WO  = (Q-MP-WO  (QSUB) - J-MP-WO (QSUB)).        DTSBX343
01967      COMPUTE ADJ-TL  = (Q-MP-TL (QSUB) - J-MP-TL  (QSUB)).        DTSBX343
01968                                                                   DTSBX343
01969      PERFORM P4900-WRITE-ACCT         THRU P4900-EXIT.            DTSBX343
01970                                                                   DTSBX343
01971  P4500-EXIT.                                                      DTSBX343
01972      EXIT.                                                        DTSBX343
01973                                                                   DTSBX343
01974  P4600-CORRECT-SU.                                                DTSBX343
01975      IF TBL-JRN-BAD-88 (QSUB)                                     DTSBX343
01976 **      DISPLAY 'P4600 SU ' MPRF-EMP-NO '  '                      DTSBX343
01977 **         TBL-YRQ (QSUB)                                         DTSBX343
01978         GO TO P4600-EXIT                                          DTSBX343
01979      ELSE                                                         DTSBX343
01980         ADD +1   TO W-ERROR-CNT                                   DTSBX343
01981      END-IF.                                                      DTSBX343
01982                                                                   DTSBX343
01983      MOVE 'SU'                  TO ACCT-ROW.                      DTSBX343
01984                                                                   DTSBX343
01985      MOVE ZERO                  TO ADJ-CHG                        DTSBX343
01986                                    ADJ-PD                         DTSBX343
01987                                    ADJ-WV                         DTSBX343
01988                                    ADJ-WO                         DTSBX343
01989                                    ADJ-TL.                        DTSBX343
01990                                                                   DTSBX343
01991      COMPUTE ADJ-CHG = (Q-SU-CHG (QSUB) - J-SU-CHG (QSUB)).       DTSBX343
01992      COMPUTE ADJ-PD  = (Q-SU-PD (QSUB) - J-SU-PD (QSUB)).         DTSBX343
01993      COMPUTE ADJ-WV  = (Q-SU-WV (QSUB) - J-SU-WV (QSUB)).         DTSBX343
01994      COMPUTE ADJ-WO  = (Q-SU-WO  (QSUB) - J-SU-WO (QSUB)).        DTSBX343
01995      COMPUTE ADJ-TL  = (Q-SU-TL (QSUB) - J-SU-TL  (QSUB)).        DTSBX343
01996                                                                   DTSBX343
01997      PERFORM P4900-WRITE-ACCT         THRU P4900-EXIT.            DTSBX343
01998                                                                   DTSBX343
01999  P4600-EXIT.                                                      DTSBX343
02000      EXIT.                                                        DTSBX343
02001                                                                   DTSBX343
02002  P4900-WRITE-ACCT.                                                DTSBX343
02003      IF ADJ-CHG NOT = ZERO                                        DTSBX343
02004         MOVE 'CH'                   TO ACCT-COL                   DTSBX343
02005         MOVE ADJ-CHG                TO ACCT-AMT                   DTSBX343
02006         PERFORM P4910-WRITE         THRU P4910-EXIT               DTSBX343
02007      END-IF.                                                      DTSBX343
02008                                                                   DTSBX343
02009      IF ADJ-PD    NOT = ZERO                                      DTSBX343
02010         MOVE 'PD'                   TO ACCT-COL                   DTSBX343
02011         COMPUTE ADJ-PD = (ADJ-PD * -1)                            DTSBX343
02012         MOVE ADJ-PD                 TO ACCT-AMT                   DTSBX343
02013         PERFORM P4910-WRITE         THRU P4910-EXIT               DTSBX343
02014      END-IF.                                                      DTSBX343
02015                                                                   DTSBX343
02016      IF ADJ-WV    NOT = ZERO                                      DTSBX343
02017         MOVE 'WV'                   TO ACCT-COL                   DTSBX343
02018         COMPUTE ADJ-WV = (ADJ-WV * -1)                            DTSBX343
02019         MOVE ADJ-WV                 TO ACCT-AMT                   DTSBX343
02020         PERFORM P4910-WRITE         THRU P4910-EXIT               DTSBX343
02021      END-IF.                                                      DTSBX343
02022                                                                   DTSBX343
02023      IF ADJ-WO    NOT = ZERO                                      DTSBX343
02024         MOVE 'WO'                   TO ACCT-COL                   DTSBX343
02025         COMPUTE ADJ-WO = (ADJ-WO * -1)                            DTSBX343
02026         MOVE ADJ-WO                 TO ACCT-AMT                   DTSBX343
02027         PERFORM P4910-WRITE         THRU P4910-EXIT               DTSBX343
02028      END-IF.                                                      DTSBX343
02029                                                                   DTSBX343
02030      IF ADJ-TL    NOT = ZERO                                      DTSBX343
02031         MOVE 'TL'                   TO ACCT-COL                   DTSBX343
02032         COMPUTE ADJ-TL = (ADJ-TL * -1)                            DTSBX343
02033         MOVE ADJ-TL                 TO ACCT-AMT                   DTSBX343
02034         PERFORM P4910-WRITE         THRU P4910-EXIT               DTSBX343
02035      END-IF.                                                      DTSBX343
02036                                                                   DTSBX343
02037  P4900-EXIT.                                                      DTSBX343
02038      EXIT.                                                        DTSBX343
02039                                                                   DTSBX343
02040  P4910-WRITE.                                                     DTSBX343
02041 **   DISPLAY 'P4910 ADJ JRN  ' TBL-YRQ (QSUB).                    DTSBX343
02042                                                                   DTSBX343
02043      PERFORM S1000-CORRECTION-BATCH   THRU S1000-EXIT.            DTSBX343
02044      MOVE W-JC-BATCH                  TO ACCT-BATCH               DTSBX343
02045      MOVE W-JC-ITEM                   TO ACCT-ITEM.               DTSBX343
02046                                                                   DTSBX343
02047      MOVE MPRF-EMP-NO                 TO ACCT-EMP-NO.             DTSBX343
02048      MOVE TBL-YRQ (QSUB)              TO L004-QTR-5-9.            DTSBX343
02049      PERFORM S004-FROM-5              THRU S004-EXIT.             DTSBX343
02050      MOVE L004-SLASH-5-QTR            TO ACCT-YRQ.                DTSBX343
02051      MOVE 'JC'                        TO ACCT-TRAN                DTSBX343
02052      MOVE 'B'                         TO ACCT-CAT.                DTSBX343
02053 **   MOVE W-DEFAULT-DATE            TO L001-FED-8-DATE-9.         DTSBX343
02054      MOVE L004-QTR-DEFAULT-DUE-DATE TO L001-FED-8-DATE-9.         DTSBX343
02055      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
02056      IF L001-VALID-DATE                                           DTSBX343
02057         MOVE L001-SLASH-8-DATE      TO ACCT-PROCESS-DT            DTSBX343
02058                                        ACCT-RCVD-DT               DTSBX343
02059      END-IF.                                                      DTSBX343
02060                                                                   DTSBX343
02061      SET ACCT-SOURCE-CR-DB-88         TO TRUE.                    DTSBX343
02062                                                                   DTSBX343
02063 **   WRITE ACCT-REC   FROM W-ACCT-REC                             DTSBX343
02064 *    IF NOT ACCT-STATUS-OK-88                                     DTSBX343
02065 *       DISPLAY 'CANNOT WRITE TO ACCT FILE '                      DTSBX343
02066 *          '  ' ACCT-STATUS '  ' ACCT-EMP-NO                      DTSBX343
02067 *    ELSE                                                         DTSBX343
02068 *       ADD +1 TO W-ACCT-CNT                                      DTSBX343
02069 **   END-IF.                                                      DTSBX343
02070                                                                   DTSBX343
02071 **   IF MPRF-EMP-NO = 010021                                      DTSBX343
02072 *       DISPLAY 'P4910   ' MPRF-EMP-NO '  ' ACCT-YRQ              DTSBX343
02073 *          '  ' ACCT-BATCH '/' ACCT-ITEM                          DTSBX343
02074 *       DISPLAY '   ' ACCT-ROW '  ' ACCT-COL                      DTSBX343
02075 *          '  ' ACCT-TRAN '  ' ACCT-AMT                           DTSBX343
02076 **   END-IF.                                                      DTSBX343
02077  P4910-EXIT.                                                      DTSBX343
02078      EXIT.                                                        DTSBX343
02079                                                                   DTSBX343
02080  P5000-PAY-DISTRIBUTION.                                          DTSBX343
02081      MOVE LOW-VALUES                TO MDST-KEY-AREA.             DTSBX343
02082      MOVE MPRF-EMP-NO               TO MDST-EMP-NO.               DTSBX343
02083      SET MDST-DST-88 TO TRUE.                                     DTSBX343
02084      MOVE MDST-KEY-AREA             TO MSKL-KEY-AREA.             DTSBX343
02085      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBX343
02086      PERFORM   UNTIL L910-NO-REC-88                               DTSBX343
02087         MOVE MSKL-REC                TO MDST-REC                  DTSBX343
02088         PERFORM P5100-BUILD-OUTPUT   THRU P5100-EXIT              DTSBX343
02089         MOVE MDST-REC                TO MSKL-REC                  DTSBX343
02090         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBX343
02091      END-PERFORM.                                                 DTSBX343
02092                                                                   DTSBX343
02093  P5000-EXIT.                                                      DTSBX343
02094      EXIT.                                                        DTSBX343
02095                                                                   DTSBX343
02096  P5100-BUILD-OUTPUT.                                              DTSBX343
02097      MOVE MDST-EMP-NO               TO DST-EMP-NO.                DTSBX343
02098      MOVE MDST-BATCH-NO             TO DST-BATCH.                 DTSBX343
02099      MOVE MDST-ITEM-NO              TO DST-ITEM.                  DTSBX343
02100      MOVE MDST-YRQ                  TO L004-QTR-5-9.              DTSBX343
02101      PERFORM S004-FROM-5            THRU S004-EXIT.               DTSBX343
02102      MOVE L004-SLASH-5-QTR          TO DST-QTR                    DTSBX343
02103      MOVE MDST-CHNG-DATE            TO L001-FED-8-DATE-9.         DTSBX343
02104      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX343
02105      MOVE L001-SLASH-8-DATE         TO DST-CHNG-DT.               DTSBX343
02106      IF L001-INVALID-DATE                                         DTSBX343
02107         DISPLAY 'P5100 INVALID MDST-CHNG-DATE '                   DTSBX343
02108            MDST-EMP-NO '  ' MDST-BATCH-NO                         DTSBX343
02109               '  ' MDST-ITEM-NO                                   DTSBX343
02110         GO TO P5100-EXIT                                          DTSBX343
02111      ELSE                                                         DTSBX343
02112         PERFORM                                                   DTSBX343
02113           VARYING MDST-ACCT-IDX FROM +1 BY +1                     DTSBX343
02114           UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT                     DTSBX343
02115             MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO DST-ACCT        DTSBX343
02116             MOVE MDST-AMT (MDST-ACCT-IDX)      TO DST-AMT         DTSBX343
02117             PERFORM P5110-WRITE                THRU P5110-EXIT    DTSBX343
02118         END-PERFORM                                               DTSBX343
02119      END-IF.                                                      DTSBX343
02120                                                                   DTSBX343
02121  P5100-EXIT.                                                      DTSBX343
02122      EXIT.                                                        DTSBX343
02123                                                                   DTSBX343
02124  P5110-WRITE.                                                     DTSBX343
02125      WRITE PAY-DIST-REC    FROM W-PAY-DIST-REC.                   DTSBX343
02126      IF NOT PAYDIST-STATUS-OK-88                                  DTSBX343
02127         DISPLAY 'CANNOT WRITE TO PAY DIST FILE '                  DTSBX343
02128            '  ' PAYDIST-STATUS '  ' DST-EMP-NO                    DTSBX343
02129      ELSE                                                         DTSBX343
02130         ADD +1 TO W-PAY-DIST-CNT                                  DTSBX343
02131      END-IF.                                                      DTSBX343
02132                                                                   DTSBX343
02133  P5110-EXIT.                                                      DTSBX343
02134      EXIT.                                                        DTSBX343
02135                                                                   DTSBX343
02136  T0000-TERMINATE.                                                 DTSBX343
02137 **   CLOSE ACCT-FILE                                              DTSBX343
02138      CLOSE ACCT-FILE-INCR                                         DTSBX343
02139            QTR-FILE                                               DTSBX343
02140 **         TRAN-FILE                                              DTSBX343
02141            TRAN-FILE-INCR                                         DTSBX343
02142            SUMMARY-FILE                                           DTSBX343
02143            PAY-DIST-FILE.                                         DTSBX343
02144                                                                   DTSBX343
02145      MOVE W-CURR-UI-TOT     TO DISPLAY-AMT1.                      DTSBX343
02146      DISPLAY '*********************************************'.     DTSBX343
02147      DISPLAY '**   DTSBX343 TERMINATION STATISTICS       **'.     DTSBX343
02148      DISPLAY '**                                         **'.     DTSBX343
02149      DISPLAY '**  QUARTERS        ' W-QTR-CNT                     DTSBX343
02150                                       '                  **'.     DTSBX343
02151      DISPLAY '**  ACOUNTING       ' W-ACCT-CNT                    DTSBX343
02152                                       '                  **'.     DTSBX343
02153      DISPLAY '**  ACOUNTING INCR  ' W-ACCT-CNT-INCR               DTSBX343
02154                                       '                  **'.     DTSBX343
02155      DISPLAY '**  TRANSACTIONS    ' W-TRAN-CNT                    DTSBX343
02156                                       '                  **'.     DTSBX343
02157      DISPLAY '**  TRANSACTIONS INCR ' W-TRAN-CNT-INCR             DTSBX343
02158                                       '                  **'.     DTSBX343
02159      DISPLAY '**     REPORTS      ' W-RPT-CNT                     DTSBX343
02160                                       '                  **'.     DTSBX343
02161      DISPLAY '**     ANN REPORTS  ' W-ANN-RPT-CNT                 DTSBX343
02162                                       '                  **'.     DTSBX343
02163      DISPLAY '**     PAYMENTS     ' W-PAY-CNT                     DTSBX343
02164                                       '                  **'.     DTSBX343
02165      DISPLAY '**     PAY DIST     ' W-PAY-DIST-CNT                DTSBX343
02166                                       '                  **'.     DTSBX343
02167      DISPLAY '**     ADJUST       ' W-ADJ-CNT                     DTSBX343
02168                                       '                  **'.     DTSBX343
02169      DISPLAY '**  ERRORS          ' W-ERROR-CNT                   DTSBX343
02170                                       '                  **'.     DTSBX343
02171      DISPLAY '**  CREDITS CORRECTED ' W-CR-CNT                    DTSBX343
02172                                       '                  **'.     DTSBX343
02173      DISPLAY '**  LAST JC BATCH/ITEM '                            DTSBX343
02174         W-JC-BATCH '/' W-JC-ITEM                                  DTSBX343
02175                                       '                  **'.     DTSBX343
02176      DISPLAY '**                                         **'.     DTSBX343
02177      DISPLAY '**                                         **'.     DTSBX343
02178      DISPLAY '*********************************************'.     DTSBX343
02179                                                                   DTSBX343
02180 ***  PERFORM T1000-ACCT-TOT    THRU T1000-EXIT.                   DTSBX343
02181                                                                   DTSBX343
02182  T0000-EXIT.                                                      DTSBX343
02183      EXIT.                                                        DTSBX343
02184                                                                   DTSBX343
02185 *T1000-ACCT-TOT.                                                  DTSBX343
02186 *    OPEN INPUT ACCT-FILE.                                        DTSBX343
02187 *    IF NOT ACCT-STATUS-OK-88                                     DTSBX343
02188 *       DISPLAY 'T1000 ACCT FILE OPEN ERROR: ' ACCT-STATUS        DTSBX343
02189 *       MOVE 'FILE OPEN ERROR'                                    DTSBX343
02190 *              TO ABEND-MSG                                       DTSBX343
02191 *       PERFORM S999-ABEND THRU S999-EXIT                         DTSBX343
02192 *    END-IF.                                                      DTSBX343
02193 *                                                                 DTSBX343
02194 *    READ ACCT-FILE INTO W-ACCT-REC.                              DTSBX343
02195 *    IF NOT ACCT-STATUS-OK-88                                     DTSBX343
02196 *       DISPLAY 'T1000 ACCT FILE EMPTY: ' ACCT-STATUS             DTSBX343
02197 *    ELSE                                                         DTSBX343
02198 *       PERFORM UNTIL ACCT-STATUS-EOF-88                          DTSBX343
02199 *          IF ACCT-ROW = 'UI'                                     DTSBX343
02200 *             EVALUATE TRUE                                       DTSBX343
02201 *                WHEN ACCT-COL = 'CH'                             DTSBX343
02202 *                   ADD ACCT-AMT-9      TO W-TOT-CHG              DTSBX343
02203 *                WHEN ACCT-COL = 'PD'                             DTSBX343
02204 *                   ADD ACCT-AMT-9      TO W-TOT-PD               DTSBX343
02205 *             END-EVALUATE                                        DTSBX343
02206 *          END-IF                                                 DTSBX343
02207 *       END-PERFORM                                               DTSBX343
02208 *    END-IF.                                                      DTSBX343
02209 *                                                                 DTSBX343
02210 *    CLOSE ACCT-FILE.                                             DTSBX343
02211 *    MOVE W-TOT-CHG         TO DISPLAY-AMT1.                      DTSBX343
02212 *    MOVE W-TOT-PD          TO DISPLAY-AMT2.                      DTSBX343
02213 *    DISPLAY 'BX343 UI CHARGED ' DISPLAY-AMT1.                    DTSBX343
02214 *    DISPLAY '      UI PAID    ' DISPLAY-AMT2.                    DTSBX343
02215 *    COMPUTE W-AMT = (W-TOT-CHG - W-TOT-PD).                      DTSBX343
02216 *    MOVE W-AMT              TO DISPLAY-AMT3.                     DTSBX343
02217 *    DISPLAY '      BALANCE    ' DISPLAY-AMT3.                    DTSBX343
02218 *                                                                 DTSBX343
02219 *T1000-EXIT.                                                      DTSBX343
02220 *    EXIT.                                                        DTSBX343
02221                                                                   DTSBX343
02222  S001-FROM-FED-8.                                                 DTSBX343
02223      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX343
02224      GO TO S001-DATE.                                             DTSBX343
02225                                                                   DTSBX343
02226  S001-FROM-ABS-DAY.                                               DTSBX343
02227      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX343
02228      GO TO S001-DATE.                                             DTSBX343
02229                                                                   DTSBX343
02230  S001-FROM-CAL-6.                                                 DTSBX343
02231      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBX343
02232      GO TO S001-DATE.                                             DTSBX343
02233                                                                   DTSBX343
02234  S001-DATE.                                                       DTSBX343
02235      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX343
02236  S001-EXIT.                                                       DTSBX343
02237      EXIT.                                                        DTSBX343
02238      SKIP3                                                        DTSBX343
02239  S004-FROM-5.                                                     DTSBX343
02240      SET L004-FROM-5 TO TRUE.                                     DTSBX343
02241      GO TO S004-QTR.                                              DTSBX343
02242                                                                   DTSBX343
02243  S004-FROM-ABS.                                                   DTSBX343
02244      SET L004-FROM-ABS TO TRUE.                                   DTSBX343
02245      GO TO S004-QTR.                                              DTSBX343
02246                                                                   DTSBX343
02247  S004-FROM-3.                                                     DTSBX343
02248      SET L004-FROM-3 TO TRUE.                                     DTSBX343
02249      GO TO S004-QTR.                                              DTSBX343
02250                                                                   DTSBX343
02251  S004-FROM-DATE.                                                  DTSBX343
02252      SET L004-FROM-DATE TO TRUE.                                  DTSBX343
02253      GO TO S004-QTR.                                              DTSBX343
02254                                                                   DTSBX343
02255  S004-QTR.                                                        DTSBX343
02256                                                                   DTSBX343
02257      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX343
02258                                                                   DTSBX343
02259  S004-EXIT.                                                       DTSBX343
02260      EXIT.                                                        DTSBX343
02261      SKIP3                                                        DTSBX343
02262  S005-FROM-DATE-TIME.                                             DTSBX343
02263      SET L005-FROM-DATE-TIME TO TRUE.                             DTSBX343
02264      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBX343
02265  S005-EXIT.                                                       DTSBX343
02266      EXIT.                                                        DTSBX343
02267                                                                   DTSBX343
02268  S910-OPEN-READ.                                                  DTSBX343
02269      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX343
02270      GO TO S910-MSTR-IO.                                          DTSBX343
02271                                                                   DTSBX343
02272  S910-READ.                                                       DTSBX343
02273      SET L910-READ-88 TO TRUE.                                    DTSBX343
02274      GO TO S910-MSTR-IO.                                          DTSBX343
02275                                                                   DTSBX343
02276  S910-START-BROWSE.                                               DTSBX343
02277      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX343
02278      GO TO S910-MSTR-IO.                                          DTSBX343
02279                                                                   DTSBX343
02280  S910-READ-NEXT.                                                  DTSBX343
02281      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX343
02282      GO TO S910-MSTR-IO.                                          DTSBX343
02283                                                                   DTSBX343
02284  S910-COUNT.                                                      DTSBX343
02285      SET L910-COUNT-88 TO TRUE.                                   DTSBX343
02286      GO TO S910-MSTR-IO.                                          DTSBX343
02287                                                                   DTSBX343
02288  S910-REWRITE.                                                    DTSBX343
02289      SET L910-REWRITE-88 TO TRUE.                                 DTSBX343
02290      GO TO S910-MSTR-IO.                                          DTSBX343
02291                                                                   DTSBX343
02292  S910-CLOSE.                                                      DTSBX343
02293      SET L910-CLOSE-88   TO TRUE.                                 DTSBX343
02294      GO TO S910-MSTR-IO.                                          DTSBX343
02295                                                                   DTSBX343
02296  S910-MSTR-IO.                                                    DTSBX343
02297      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX343
02298                            MSKL-REC.                              DTSBX343
02299  S910-EXIT.                                                       DTSBX343
02300      EXIT.                                                        DTSBX343
02301      SKIP3                                                        DTSBX343
02302                                                                   DTSBX343
02303  S931-READ.                                                       DTSBX343
02304      SET L931-READ-88 TO TRUE.                                    DTSBX343
02305      GO TO S931-REF-IO.                                           DTSBX343
02306                                                                   DTSBX343
02307  S931-REF-IO.                                                     DTSBX343
02308      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBX343
02309                            FSKL-REC.                              DTSBX343
02310  S931-EXIT.                                                       DTSBX343
02311      EXIT.                                                        DTSBX343
02312                                                                   DTSBX343
02313  S1000-CORRECTION-BATCH.                                          DTSBX343
02314      IF W-JC-ITEM < +999                                          DTSBX343
02315         ADD +1            TO W-JC-ITEM                            DTSBX343
02316      ELSE                                                         DTSBX343
02317         ADD +1            TO W-JC-BATCH                           DTSBX343
02318         MOVE +1           TO W-JC-ITEM                            DTSBX343
02319      END-IF.                                                      DTSBX343
02320                                                                   DTSBX343
02321  S1000-EXIT.                                                      DTSBX343
02322      EXIT.                                                        DTSBX343
02323                                                                   DTSBX343
02324  S999-ABEND.                                                      DTSBX343
02325      DISPLAY '*** DTSBX343 ABENDING.  '                           DTSBX343
02326              ABEND-MSG.                                           DTSBX343
02327                                                                   DTSBX343
02328      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBX343
02329  S999-EXIT.                                                       DTSBX343
02330      EXIT.                                                        DTSBX343
