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