00001  IDENTIFICATION DIVISION.                                         09/11/08
00002  PROGRAM-ID.             DTSBX342.                                DTSBX342
00003  AUTHOR.                 NGC.                                        LV004
00004  DATE-WRITTEN.           OCTOBER 2007.                            DTSBX342
00005  DATE-COMPILED.                                                   DTSBX342
00006      SKIP3                                                        DTSBX342
00007 *****                                                             DTSBX342
00008 *                                                                 DTSBX342
00009 *    FUNCTION:  INTERNAL WEB MAINFRAME EXTRACT - ACCOUNTING       DTSBX342
00010 *               >>>  DAILY INCREMENTAL UPDATE  <<<                DTSBX342
00011 *               FOR INITIAL CONVERSION, USE DTSBX343              DTSBX342
00012 *                                                                 DTSBX342
00013 *    MODIFICATION LOG:                                            DTSBX342
00014 *                                                                 DTSBX342
00015 *    10/22/2007  INITIAL DEVELOPMENT.                             DTSBX342
00016 *                REFERENCE:                     PROGRAMMER: GD    DTSBX342
00017 *                                                                 DTSBX342
00018 *    04/27/2008  CORRECTED SELECTION FOR REPORTS IN P3100.        DTSBX342
00019 *                THE PROCESS THAT ATTEMPTED TO COMBINE 4          DTSBX342
00020 *                QUARTERLY REPORTS INTO ONE ANNUAL REPORT         DTSBX342
00021 *                HAD A PROBLEM WITH THE READS AND RESULTED        DTSBX342
00022 *                IN SOME NON-ANNUAL REPORTS BEING BYPASSED.       DTSBX342
00023 *                THE ANNUAL REPORTS ARE NOW WRITTEN IN            DTSBX342
00024 *                EXACTLY THE SAME WAY AS QUARTERLY REPORTS.       DTSBX342
00025 *                REFERENCE:                     PROGRAMMER: GD    DTSBX342
00026 *                                                                 DTSBX342
00027 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX342
00028 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX342
00029 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBX342
00030 *                                                                 DTSBX342
00031 *                                                                 DTSBX342
00032 *  DESCRIPTION:                                                   DTSBX342
00033 *                                                                 DTSBX342
00034 *                                                                 DTSBX342
00035 *    INITIATION:                                                  DTSBX342
00036 *                                                                 DTSBX342
00037 *                                                                 DTSBX342
00038 *                                                                 DTSBX342
00039 *    PROCESSING:                                                  DTSBX342
00040 *                                                                 DTSBX342
00041 *                                                                 DTSBX342
00042 *    TERMINATION:                                                 DTSBX342
00043 *                                                                 DTSBX342
00044 *                                                                 DTSBX342
00045 *                                                                 DTSBX342
00046 *    RECORDS READ:                                                DTSBX342
00047 *                                                                 DTSBX342
00048 *      MASTER:                                                    DTSBX342
00049 *                                                                 DTSBX342
00050 *        MSOL                                                     DTSBX342
00051 *        MQTR                                                     DTSBX342
00052 *                                                                 DTSBX342
00053 *                                                                 DTSBX342
00054 *      ALTERNATE INDEX:                                           DTSBX342
00055 *                                                                 DTSBX342
00056 *        NONE.                                                    DTSBX342
00057 *                                                                 DTSBX342
00058 *                                                                 DTSBX342
00059 *      REFERENCE:                                                 DTSBX342
00060 *                                                                 DTSBX342
00061 *                                                                 DTSBX342
00062 *                                                                 DTSBX342
00063 *    RECORDS UPDATED:                                             DTSBX342
00064 *                                                                 DTSBX342
00065 *        NONE                                                     DTSBX342
00066 *                                                                 DTSBX342
00067 *                                                                 DTSBX342
00068 *    OUTPUT RECORDS WRITTEN:                                      DTSBX342
00069 *                                                                 DTSBX342
00070 *        DTSBX331                                                 DTSBX342
00071 *                                                                 DTSBX342
00072 *                                                                 DTSBX342
00073 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBX342
00074 *                                                                 DTSBX342
00075 *        NONE.                                                    DTSBX342
00076 *                                                                 DTSBX342
00077 *                                                                 DTSBX342
00078 *    MODULES CALLED:                                              DTSBX342
00079 *                                                                 DTSBX342
00080 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBX342
00081 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBX342
00082 *        DTSBU910  MASTER FILE I/O.                               DTSBX342
00083 *                                                                 DTSBX342
00084 *                                                                 DTSBX342
00085 *                                                                 DTSBX342
00086 *****                                                             DTSBX342
00087      SKIP3                                                        DTSBX342
00088  ENVIRONMENT DIVISION.                                            DTSBX342
00089  INPUT-OUTPUT SECTION.                                            DTSBX342
00090  FILE-CONTROL.                                                    DTSBX342
00091      SELECT ACCT-FILE               ASSIGN TO DTSFACC2            DTSBX342
00092         FILE STATUS IS ACCT-STATUS.                               DTSBX342
00093                                                                   DTSBX342
00094      SELECT TRAN-FILE               ASSIGN TO DTSFTRN2            DTSBX342
00095         FILE STATUS IS TRAN-STATUS.                               DTSBX342
00096                                                                   DTSBX342
00097      SELECT QTR-FILE               ASSIGN TO DTSFQTR2             DTSBX342
00098         FILE STATUS IS QTR-STATUS.                                DTSBX342
00099                                                                   DTSBX342
00100      SELECT SUMMARY-FILE           ASSIGN TO DTSFSUM2             DTSBX342
00101             FILE STATUS IS SUMMARY-STATUS.                        DTSBX342
00102                                                                   DTSBX342
00103      SELECT PAY-DIST-FILE          ASSIGN TO DTSFDST2             DTSBX342
00104             FILE STATUS IS PAYDIST-STATUS.                        DTSBX342
00105                                                                   DTSBX342
00106  DATA DIVISION.                                                   DTSBX342
00107  FILE SECTION.                                                    DTSBX342
00108  FD  ACCT-FILE                                                    DTSBX342
00109      RECORDING MODE IS F                                          DTSBX342
00110      LABEL RECORDS ARE STANDARD                                   DTSBX342
00111      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX342
00112                                                                   DTSBX342
00113  01  ACCT-REC                      PIC  X(61).                    DTSBX342
00114                                                                   DTSBX342
00115  FD  TRAN-FILE                                                    DTSBX342
00116      RECORDING MODE IS F                                          DTSBX342
00117      LABEL RECORDS ARE STANDARD                                   DTSBX342
00118      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX342
00119                                                                   DTSBX342
00120  01  TRAN-REC                      PIC  X(128).                   DTSBX342
00121                                                                   DTSBX342
00122  FD  QTR-FILE                                                     DTSBX342
00123      RECORDING MODE IS F                                          DTSBX342
00124      LABEL RECORDS ARE STANDARD                                   DTSBX342
00125      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX342
00126                                                                   DTSBX342
00127  01  QTR-REC                       PIC  X(52).                    DTSBX342
00128                                                                   DTSBX342
00129  FD  SUMMARY-FILE                                                 DTSBX342
00130      RECORDING MODE IS F.                                         DTSBX342
00131  01  SUMMARY-REC             PIC X(73).                           DTSBX342
00132                                                                   DTSBX342
00133  FD  PAY-DIST-FILE                                                DTSBX342
00134      RECORDING MODE IS F.                                         DTSBX342
00135  01  PAY-DIST-REC            PIC X(50).                           DTSBX342
00136                                                                   DTSBX342
00137  WORKING-STORAGE SECTION.                                         DTSBX342
001375 77  PAN-VALET PICTURE X(24) VALUE '004DTSBX342  09/11/08'.       DTSBX342
00138      SKIP3                                                        DTSBX342
00139  01  W-AREA.                                                      DTSBX342
00140      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE +342.DTSBX342
00141                                                                   DTSBX342
00142                                                                   DTSBX342
00143      05  ABEND-MSG                   PIC  X(60).                  DTSBX342
00144                                                                   DTSBX342
00145      05  PARM-STATUS                 PIC  X(02).                  DTSBX342
00146          88  PARM-STATUS-OK-88           VALUE '00'.              DTSBX342
00147      05  ACCT-STATUS                 PIC  X(02).                  DTSBX342
00148          88  ACCT-STATUS-OK-88        VALUE '00'.                 DTSBX342
00149          88  ACCT-STATUS-EOF-88       VALUE '10'.                 DTSBX342
00150      05  TRAN-STATUS                 PIC  X(02).                  DTSBX342
00151          88  TRAN-STATUS-OK-88        VALUE '00'.                 DTSBX342
00152      05  QTR-STATUS                  PIC  X(02).                  DTSBX342
00153          88  QTR-STATUS-OK-88         VALUE '00'.                 DTSBX342
00154      05  SUMMARY-STATUS              PIC  X(02).                  DTSBX342
00155          88  SUMMARY-STATUS-OK-88      VALUE '00'.                DTSBX342
00156      05  PAYDIST-STATUS              PIC  X(02).                  DTSBX342
00157          88  PAYDIST-STATUS-OK-88      VALUE '00'.                DTSBX342
00158                                                                   DTSBX342
00159      05  EMP-STATUS                  PIC  X(02).                  DTSBX342
00160          88  EMP-STATUS-OK-88         VALUE '00'.                 DTSBX342
00161                                                                   DTSBX342
00162      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.        DTSBX342
00163          88  W-ERROR-YES-88           VALUE 'Y'.                  DTSBX342
00164          88  W-ERROR-NO-88            VALUE 'N'.                  DTSBX342
00165                                                                   DTSBX342
00166      05  W-RPT-COMPLETE-IND          PIC  X(01).                  DTSBX342
00167          88  W-RPT-COMPLETE-YES-88    VALUE 'Y'.                  DTSBX342
00168          88  W-RPT-COMPLETE-NO-88     VALUE 'N'.                  DTSBX342
00169          88  W-RPT-COMPLETE-NULL-88 VALUE ' '.                    DTSBX342
00170                                                                   DTSBX342
00171      05  W-UI-CHARGE-IND             PIC  X(01).                  DTSBX342
00172          88  W-UI-CHARGE-YES-88       VALUE 'Y'.                  DTSBX342
00173          88  W-UI-CHARGE-NO-88        VALUE 'N'.                  DTSBX342
00174      05  W-LP-CHARGE-IND             PIC  X(01).                  DTSBX342
00175          88  W-LP-CHARGE-YES-88       VALUE 'Y'.                  DTSBX342
00176          88  W-LP-CHARGE-NO-88        VALUE 'N'.                  DTSBX342
00177                                                                   DTSBX342
00178      05  W-STATUS-CD                 PIC  X(02).                  DTSBX342
00179          88  W-STATUS-WITHDRAWN-88    VALUE '04', '05'.           DTSBX342
00180                                                                   DTSBX342
00181      05  CONV-QTR-SUB               PIC S9(04)  COMP.             DTSBX342
00182      05  QSUB                       PIC S9(04)  COMP.             DTSBX342
00183      05  QMAX                       PIC S9(04)  COMP VALUE +400.  DTSBX342
00184      05  QTR-TABLE                  OCCURS 400 TIMES.             DTSBX342
00185          10  TBL-QTR-IND            PIC  X(01).                   DTSBX342
00186              88  TBL-QTR-YES-88      VALUE 'Y'.                   DTSBX342
00187              88  TBL-QTR-NO-88       VALUE 'N'.                   DTSBX342
00188                                                                   DTSBX342
00189      05  W-AMT                      PIC S9(11)V99   COMP-3.       DTSBX342
00190      05  W-TOT-CHG                  PIC S9(11)V99   COMP-3        DTSBX342
00191                                       VALUE +0.                   DTSBX342
00192      05  W-TOT-PD                   PIC S9(11)V99   COMP-3        DTSBX342
00193                                       VALUE +0.                   DTSBX342
00194                                                                   DTSBX342
00195      05  W-DEFAULT-DATE           PIC  X(10)                      DTSBX342
00196                                     VALUE '12/31/1994'.           DTSBX342
00197                                                                   DTSBX342
00198      05  W-MPRF-CNT               PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00199      05  W-MJRN-READ-CNT          PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00200      05  W-ERROR-CNT              PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00201      05  W-ACCT-CNT               PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00202      05  W-TRAN-CNT               PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00203      05  W-RPT-CNT                PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00204      05  W-ANN-RPT-CNT            PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00205      05  W-PAY-CNT                PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00206      05  W-ADJ-CNT                PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00207      05  W-QTR-CNT                PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00208      05  W-SUMMARY-CNT            PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00209      05  W-PAY-DIST-CNT           PIC S9(07)    COMP-3 VALUE +0.  DTSBX342
00210      05  W-BATCH                  PIC S9(05)    COMP-3 VALUE +0.  DTSBX342
00211      05  W-ITEM                   PIC S9(03)    COMP-3 VALUE +0.  DTSBX342
00212      05  ADJ-CHG                  PIC S9(09)V99 COMP-3.           DTSBX342
00213      05  ADJ-PD                   PIC S9(09)V99 COMP-3.           DTSBX342
00214      05  ADJ-WV                   PIC S9(09)V99 COMP-3.           DTSBX342
00215      05  ADJ-WO                   PIC S9(09)V99 COMP-3.           DTSBX342
00216      05  ADJ-TL                   PIC S9(09)V99 COMP-3.           DTSBX342
00217      05  W-CHG                    PIC S9(09)V99 COMP-3.           DTSBX342
00218      05  W-PD                     PIC S9(09)V99 COMP-3.           DTSBX342
00219      05  W-WV                     PIC S9(09)V99 COMP-3.           DTSBX342
00220      05  W-WO                     PIC S9(09)V99 COMP-3.           DTSBX342
00221      05  W-TL                     PIC S9(09)V99 COMP-3.           DTSBX342
00222      05  W-BAL                    PIC S9(09)V99 COMP-3.           DTSBX342
00223      05  W-QTR-BAL                PIC S9(11)V99 COMP-3.           DTSBX342
00224      05  W-RATE                   PIC S9(03)V9(04) COMP-3.        DTSBX342
00225                                                                   DTSBX342
00226      05  ASUB                     PIC S9(04)  COMP.               DTSBX342
00227      05  ASUB1                    PIC S9(04)  COMP.               DTSBX342
00228      05  ASUB-MAX                 PIC S9(04)  COMP VALUE +50.     DTSBX342
00229      05  ASUB-LAST                PIC S9(04)  COMP VALUE +0.      DTSBX342
00230      05  ANN-RPT-TABLE OCCURS 50 TIMES.                           DTSBX342
00231          10  W-ANN-RPT-TYPE         PIC  X(02).                   DTSBX342
00232          10  W-ANN-YRQ              PIC  9(05).                   DTSBX342
00233          10  FILLER REDEFINES W-ANN-YRQ.                          DTSBX342
00234              15  W-ANN-YRQ-CCYY     PIC  9(04).                   DTSBX342
00235              15  W-ANN-YRQ-Q        PIC  9(01).                   DTSBX342
00236                                                                   DTSBX342
00237          10  W-ANN-BATCH            PIC S9(05)      COMP-3.       DTSBX342
00238          10  W-ANN-ITEM             PIC S9(03)      COMP-3.       DTSBX342
00239          10  W-ANN-RATE             PIC S9(03)V9(04) COMP-3.      DTSBX342
00240          10  W-ANN-REMIT            PIC S9(09)V99   COMP-3.       DTSBX342
00241          10  W-ANN-TOT-WAGE         PIC S9(09)V99   COMP-3.       DTSBX342
00242          10  W-ANN-TAX-WAGE         PIC S9(09)V99   COMP-3.       DTSBX342
00243          10  W-ANN-EXCESS-WAGE      PIC S9(09)V99   COMP-3.       DTSBX342
00244          10  W-ANN-RCVD-DT          PIC S9(09)      COMP-3.       DTSBX342
00245          10  W-ANN-PROCESS-DT       PIC S9(09)      COMP-3.       DTSBX342
00246                                                                   DTSBX342
00247      05  W-LAST-ANN-YRQ             PIC S9(05)      COMP-3.       DTSBX342
00248                                                                   DTSBX342
00249      05  W-ACCT-REC.                                              DTSBX342
00250          10  ACCT-EMP-NO                PIC 9(06).                DTSBX342
00251          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00252          10  ACCT-YRQ                   PIC X(06).                DTSBX342
00253          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00254          10  ACCT-BATCH                 PIC 9(05).                DTSBX342
00255          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00256          10  ACCT-ITEM                  PIC 9(03).                DTSBX342
00257          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00258          10  ACCT-TRAN                  PIC X(02).                DTSBX342
00259          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00260          10  ACCT-ROW                   PIC X(02).                DTSBX342
00261          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00262          10  ACCT-COL                   PIC X(02).                DTSBX342
00263          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00264          10  ACCT-AMT                   PIC ---------9.99.        DTSBX342
00265          10  ACCT-AMT-9 REDEFINES ACCT-AMT  PIC 9(10).99.         DTSBX342
00266          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00267          10  ACCT-CAT                   PIC X(01).                DTSBX342
00268          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00269          10  ACCT-PROCESS-DT            PIC X(10).                DTSBX342
00270          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00271          10  ACCT-SOURCE                PIC X(01).                DTSBX342
00272              88  ACCT-SOURCE-CR-DB-88    VALUE '1'.               DTSBX342
00273              88  ACCT-SOURCE-STATUS-88   VALUE '2'.               DTSBX342
00274              88  ACCT-SOURCE-ERROR-88    VALUE '3'.               DTSBX342
00275                                                                   DTSBX342
00276      05  W-TRAN-REC.                                              DTSBX342
00277          10  TRAN-EMP-NO                PIC 9(06).                DTSBX342
00278          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00279          10  TRAN-YRQ                   PIC X(06).                DTSBX342
00280          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00281          10  TRAN-BATCH                 PIC 9(05).                DTSBX342
00282          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00283          10  TRAN-ITEM                  PIC 9(03).                DTSBX342
00284          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00285          10  TRAN-TRANS                 PIC X(02).                DTSBX342
00286          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00287          10  TRAN-AMT                   PIC --------9.99.         DTSBX342
00288          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00289          10  TRAN-TOT-WAGE              PIC ----------9.99.       DTSBX342
00290          10  TRAN-TOT-WAGE-X REDEFINES TRAN-TOT-WAGE              DTSBX342
00291                                         PIC X(14).                DTSBX342
00292          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00293          10  TRAN-TAX-WAGE              PIC ----------9.99.       DTSBX342
00294          10  TRAN-TAX-WAGE-X REDEFINES TRAN-TAX-WAGE              DTSBX342
00295                                         PIC X(14).                DTSBX342
00296          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00297          10  TRAN-EXC-WAGE              PIC ----------9.99.       DTSBX342
00298          10  TRAN-EXC-WAGE-X REDEFINES TRAN-EXC-WAGE              DTSBX342
00299                                         PIC X(14).                DTSBX342
00300          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00301          10  TRAN-RATE                  PIC Z9.9.                 DTSBX342
00302          10  TRAN-RATE-X REDEFINES TRAN-RATE                      DTSBX342
00303                                         PIC X(04).                DTSBX342
00304          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00305          10  TRAN-ACCT                  PIC X(02).                DTSBX342
00306          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00307          10  TRAN-CAT                   PIC X(01).                DTSBX342
00308          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00309          10  TRAN-SOURCE                PIC X(01).                DTSBX342
00310              88  TRAN-SOURCE-CR-DB-88    VALUE '1'.               DTSBX342
00311              88  TRAN-SOURCE-STATUS-88   VALUE '2'.               DTSBX342
00312              88  TRAN-SOURCE-ERROR-88    VALUE '3'.               DTSBX342
00313          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00314          10  TRAN-RCVD-DT               PIC X(10).                DTSBX342
00315          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00316          10  TRAN-PROCESS-DT            PIC X(10).                DTSBX342
00317          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00318          10  TRAN-APPLIC-BATCH          PIC 9(05).                DTSBX342
00319          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00320          10  TRAN-APPLIC-ITEM           PIC 9(03).                DTSBX342
00321                                                                   DTSBX342
00322      05  W-QTR-REC.                                               DTSBX342
00323          10  QTR-EMP-NO                 PIC 9(06).                DTSBX342
00324          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00325          10  QTR-QUARTER                PIC X(06).                DTSBX342
00326          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00327          10  QTR-RPT-STATUS             PIC X(01).                DTSBX342
00328          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00329          10  QTR-DUE-DT                 PIC X(10).                DTSBX342
00330          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00331          10  QTR-BAL-DUE                PIC ----------9.99.       DTSBX342
00332          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00333          10  QTR-PROCESS-DT             PIC X(10).                DTSBX342
00334                                                                   DTSBX342
00335      05  W-SUMMARY-REC.                                           DTSBX342
00336          10  SUMMARY-PROCESS-DT         PIC X(10).                DTSBX342
00337          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00338          10  SUMMARY-MESSAGE            PIC X(40).                DTSBX342
00339          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00340          10  SUMMARY-EMP-NO             PIC 9(06).                DTSBX342
00341          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00342          10  SUMMARY-BATCH              PIC 9(05).                DTSBX342
00343          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00344          10  SUMMARY-ITEM               PIC 9(03).                DTSBX342
00345          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00346          10  SUMMARY-TRAN               PIC X(02).                DTSBX342
00347          10  FILLER                     PIC X(01) VALUE ','.      DTSBX342
00348          10  SUMMARY-SOURCE             PIC X(01).                DTSBX342
00349              88  SUMMARY-SOURCE-CR-DB-88 VALUE '1'.               DTSBX342
00350              88  SUMMARY-SOURCE-STATUS-88 VALUE '2'.              DTSBX342
00351              88  SUMMARY-SOURCE-ERROR-88 VALUE '3'.               DTSBX342
00352                                                                   DTSBX342
00353      05  W-PAY-DIST-REC.                                          DTSBX342
00354          10  DST-EMP-NO              PIC  9(06).                  DTSBX342
00355          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX342
00356          10  DST-BATCH               PIC  9(05).                  DTSBX342
00357          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX342
00358          10  DST-ITEM                PIC  9(03).                  DTSBX342
00359          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX342
00360          10  DST-QTR                 PIC  X(06).                  DTSBX342
00361          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX342
00362          10  DST-ACCT                PIC  X(02).                  DTSBX342
00363          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX342
00364          10  DST-AMT                 PIC  --------9.99.           DTSBX342
00365          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX342
00366          10  DST-CHNG-DT             PIC  X(10).                  DTSBX342
00367                                                                   DTSBX342
00368      05  W-CURR-UI-TOT            PIC S9(11)V99 COMP-3            DTSBX342
00369                                    VALUE +0.                      DTSBX342
00370                                                                   DTSBX342
00371      05  DISPLAY-CNT                PIC  Z(06)9.                  DTSBX342
00372                                                                   DTSBX342
00373      05  DISPLAY-AMT1-X              PIC  X(14).                  DTSBX342
00374      05  DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X                    DTSBX342
00375                                      PIC  ---,---,--9.99.         DTSBX342
00376      05  DISPLAY-AMT2-X              PIC  X(14).                  DTSBX342
00377      05  DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X                    DTSBX342
00378                                      PIC  ---,---,--9.99.         DTSBX342
00379      05  DISPLAY-AMT3-X              PIC  X(14).                  DTSBX342
00380      05  DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X                    DTSBX342
00381                                      PIC  ---,---,--9.99.         DTSBX342
00382      05  DISPLAY-AMT4-X              PIC  X(14).                  DTSBX342
00383      05  DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X                    DTSBX342
00384                                      PIC  ---,---,--9.99.         DTSBX342
00385      EJECT                                                        DTSBX342
00386  01  L001-LINK-AREA.                                              DTSBX342
00387  ++INCLUDE DTSIL001                                               DTSBX342
00388      EJECT                                                        DTSBX342
00389  01  L004-LINK-AREA.                                              DTSBX342
00390  ++INCLUDE DTSIL004                                               DTSBX342
00391      EJECT                                                        DTSBX342
00392  01  L005-LINK-AREA.                                              DTSBX342
00393  ++INCLUDE DTSIL005                                               DTSBX342
00394                                                                   DTSBX342
00395  01  L910-LINK-AREA.                                              DTSBX342
00396  ++INCLUDE DTSIL910                                               DTSBX342
00397      SKIP3                                                        DTSBX342
00398  01  MSKL-REC.                                                    DTSBX342
00399  ++INCLUDE DTSIMSKL                                               DTSBX342
00400      SKIP3                                                        DTSBX342
00401  01  MHDR-REC.                                                    DTSBX342
00402  ++INCLUDE DTSIMHDR                                               DTSBX342
00403      SKIP3                                                        DTSBX342
00404  01  MQTR-REC.                                                    DTSBX342
00405  ++INCLUDE DTSIMQTR                                               DTSBX342
00406      SKIP3                                                        DTSBX342
00407  01  MJRN-REC.                                                    DTSBX342
00408  ++INCLUDE DTSIMJRN                                               DTSBX342
00409      SKIP3                                                        DTSBX342
00410  01  MRPT-REC.                                                    DTSBX342
00411  ++INCLUDE DTSIMRPT                                               DTSBX342
00412      SKIP3                                                        DTSBX342
00413  01  MADJ-REC.                                                    DTSBX342
00414  ++INCLUDE DTSIMADJ                                               DTSBX342
00415      SKIP3                                                        DTSBX342
00416  01  MPAY-REC.                                                    DTSBX342
00417  ++INCLUDE DTSIMPAY                                               DTSBX342
00418      SKIP3                                                        DTSBX342
00419  01  MRTE-REC.                                                    DTSBX342
00420  ++INCLUDE DTSIMRTE                                               DTSBX342
00421      SKIP3                                                        DTSBX342
00422  01  MEVL-REC.                                                    DTSBX342
00423  ++INCLUDE DTSIMEVL                                               DTSBX342
00424      SKIP3                                                        DTSBX342
00425  01  MSOL-REC.                                                    DTSBX342
00426  ++INCLUDE DTSIMSOL                                               DTSBX342
00427      SKIP3                                                        DTSBX342
00428  01  MFSC-REC.                                                    DTSBX342
00429  ++INCLUDE DTSIMFSC                                               DTSBX342
00430      SKIP3                                                        DTSBX342
00431  01  MTAD-REC.                                                    DTSBX342
00432  ++INCLUDE DTSIMTAD                                               DTSBX342
00433      SKIP3                                                        DTSBX342
00434  01  MTAA-REC.                                                    DTSBX342
00435  ++INCLUDE DTSIMTAA                                               DTSBX342
00436      SKIP3                                                        DTSBX342
00437  01  MLOG-REC.                                                    DTSBX342
00438  ++INCLUDE DTSIMLOG                                               DTSBX342
00439      SKIP3                                                        DTSBX342
00440  01  MDST-REC.                                                    DTSBX342
00441  ++INCLUDE DTSIMDST                                               DTSBX342
00442      SKIP3                                                        DTSBX342
00443  01  L931-LINK-AREA.                                              DTSBX342
00444  ++INCLUDE DTSIL931                                               DTSBX342
00445      SKIP3                                                        DTSBX342
00446  01  FSKL-REC.                                                    DTSBX342
00447  ++INCLUDE DTSIFSKL                                               DTSBX342
00448      SKIP3                                                        DTSBX342
00449  01  FQTR-REC.                                                    DTSBX342
00450  ++INCLUDE DTSIFQTR                                               DTSBX342
00451                                                                   DTSBX342
00452  LINKAGE SECTION.                                                 DTSBX342
00453                                                                   DTSBX342
00454  01  LX34-LINK-AREA.                                              DTSBX342
00455  ++INCLUDE DTSILX34                                               DTSBX342
00456                                                                   DTSBX342
00457  01  MPRF-REC.                                                    DTSBX342
00458  ++INCLUDE DTSIMPRF                                               DTSBX342
00459      EJECT                                                        DTSBX342
00460  PROCEDURE DIVISION USING LX34-LINK-AREA                          DTSBX342
00461                           MPRF-REC.                               DTSBX342
00462                                                                   DTSBX342
00463      EVALUATE TRUE                                                DTSBX342
00464        WHEN LX34-INITIALIZE-88                                    DTSBX342
00465           PERFORM I0000-INITIALIZE     THRU I0000-EXIT            DTSBX342
00466        WHEN LX34-PROCESS-88                                       DTSBX342
00467           PERFORM P0000-PROCESS        THRU P0000-EXIT            DTSBX342
00468        WHEN LX34-TERMINATE-88                                     DTSBX342
00469           PERFORM T0000-TERMINATE      THRU T0000-EXIT            DTSBX342
00470      END-EVALUATE.                                                DTSBX342
00471                                                                   DTSBX342
00472      GOBACK.                                                      DTSBX342
00473                                                                   DTSBX342
00474  I0000-INITIALIZE.                                                DTSBX342
00475      PERFORM I2000-OPEN-FILES      THRU I2000-EXIT.               DTSBX342
00476                                                                   DTSBX342
00477  I0000-EXIT.                                                      DTSBX342
00478      EXIT.                                                        DTSBX342
00479                                                                   DTSBX342
00480  I2000-OPEN-FILES.                                                DTSBX342
00481      OPEN OUTPUT ACCT-FILE.                                       DTSBX342
00482      IF NOT ACCT-STATUS-OK-88                                     DTSBX342
00483         DISPLAY 'ACCT FILE OPEN ERROR: ' ACCT-STATUS              DTSBX342
00484         MOVE 'FILE OPEN ERROR'                                    DTSBX342
00485                TO ABEND-MSG                                       DTSBX342
00486         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX342
00487      END-IF.                                                      DTSBX342
00488                                                                   DTSBX342
00489      OPEN OUTPUT TRAN-FILE.                                       DTSBX342
00490      IF NOT TRAN-STATUS-OK-88                                     DTSBX342
00491         DISPLAY 'TRAN FILE OPEN ERROR: ' TRAN-STATUS              DTSBX342
00492         MOVE 'FILE OPEN ERROR'                                    DTSBX342
00493                TO ABEND-MSG                                       DTSBX342
00494         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX342
00495      END-IF.                                                      DTSBX342
00496                                                                   DTSBX342
00497      OPEN OUTPUT QTR-FILE.                                        DTSBX342
00498      IF NOT QTR-STATUS-OK-88                                      DTSBX342
00499         DISPLAY 'QTR FILE OPEN ERROR: ' QTR-STATUS                DTSBX342
00500         MOVE 'FILE OPEN ERROR'                                    DTSBX342
00501                TO ABEND-MSG                                       DTSBX342
00502         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX342
00503      END-IF.                                                      DTSBX342
00504                                                                   DTSBX342
00505      OPEN OUTPUT SUMMARY-FILE                                     DTSBX342
00506      IF NOT SUMMARY-STATUS-OK-88                                  DTSBX342
00507         DISPLAY 'SUM FILE OPEN ERROR: ' SUMMARY-STATUS            DTSBX342
00508         MOVE 'FILE OPEN ERROR'                                    DTSBX342
00509                TO ABEND-MSG                                       DTSBX342
00510         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX342
00511      END-IF.                                                      DTSBX342
00512                                                                   DTSBX342
00513      OPEN OUTPUT PAY-DIST-FILE.                                   DTSBX342
00514      IF NOT PAYDIST-STATUS-OK-88                                  DTSBX342
00515         DISPLAY 'BX343 PAY DIST FILE OPEN ERROR: '                DTSBX342
00516             PAYDIST-STATUS                                        DTSBX342
00517         MOVE 'FILE OPEN ERROR'                                    DTSBX342
00518                TO ABEND-MSG                                       DTSBX342
00519         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX342
00520      END-IF.                                                      DTSBX342
00521                                                                   DTSBX342
00522  I2000-EXIT.                                                      DTSBX342
00523      EXIT.                                                        DTSBX342
00524                                                                   DTSBX342
00525  P0000-PROCESS.                                                   DTSBX342
00526      PERFORM P0100-INIT-TABLE        THRU P0100-EXIT.             DTSBX342
00527                                                                   DTSBX342
00528      PERFORM P2000-ACCTS-RECEIVABLE     THRU P2000-EXIT           DTSBX342
00529      PERFORM P3000-TRANSACTION-DETAIL   THRU P3000-EXIT           DTSBX342
00530      PERFORM P4000-UPDATE-QTRS          THRU P4000-EXIT.          DTSBX342
00531      IF MPRF-TOT-CREDIT-AMT > ZERO                                DTSBX342
00532         PERFORM P5000-PAY-DISTRIBUTION  THRU P5000-EXIT           DTSBX342
00533      END-IF.                                                      DTSBX342
00534                                                                   DTSBX342
00535  P0000-EXIT.                                                      DTSBX342
00536      EXIT.                                                        DTSBX342
00537                                                                   DTSBX342
00538  P0100-INIT-TABLE.                                                DTSBX342
00539      PERFORM                                                      DTSBX342
00540        VARYING QSUB FROM +1 BY +1                                 DTSBX342
00541        UNTIL QSUB > QMAX                                          DTSBX342
00542          SET TBL-QTR-NO-88 (QSUB)  TO TRUE                        DTSBX342
00543      END-PERFORM.                                                 DTSBX342
00544                                                                   DTSBX342
00545  P0100-EXIT.                                                      DTSBX342
00546      EXIT.                                                        DTSBX342
00547                                                                   DTSBX342
00548                                                                   DTSBX342
00549  P2000-ACCTS-RECEIVABLE.                                          DTSBX342
00550      MOVE LOW-VALUES                 TO MJRN-KEY-AREA.            DTSBX342
00551      MOVE MPRF-EMP-NO                TO MJRN-EMP-NO.              DTSBX342
00552      SET MJRN-JRN-88                 TO TRUE.                     DTSBX342
00553      MOVE LX34-ABSTIME               TO MJRN-ESTB-ABSTIME.        DTSBX342
00554      MOVE MJRN-KEY-AREA              TO MSKL-KEY-AREA.            DTSBX342
00555      PERFORM S910-START-BROWSE       THRU S910-EXIT.              DTSBX342
00556      PERFORM UNTIL L910-NO-REC-88                                 DTSBX342
00557         MOVE MSKL-REC                TO MJRN-REC                  DTSBX342
00558         ADD +1                       TO W-MJRN-READ-CNT           DTSBX342
00559         IF MJRN-ESTB-DATE = LX34-PRIOR-RUN-DATE                   DTSBX342
00560            PERFORM P2100-BUILD-ACCT  THRU P2100-EXIT              DTSBX342
00561         END-IF                                                    DTSBX342
00562         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBX342
00563      END-PERFORM.                                                 DTSBX342
00564                                                                   DTSBX342
00565  P2000-EXIT.                                                      DTSBX342
00566      EXIT.                                                        DTSBX342
00567                                                                   DTSBX342
00568  P2100-BUILD-ACCT.                                                DTSBX342
00569      PERFORM                                                      DTSBX342
00570        VARYING MJRN-OCC-IDX FROM +1 BY +1                         DTSBX342
00571        UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT                          DTSBX342
00572           PERFORM P2110-WRITE-ACCT    THRU P2110-EXIT             DTSBX342
00573      END-PERFORM.                                                 DTSBX342
00574                                                                   DTSBX342
00575  P2100-EXIT.                                                      DTSBX342
00576      EXIT.                                                        DTSBX342
00577                                                                   DTSBX342
00578  P2110-WRITE-ACCT.                                                DTSBX342
00579      IF MJRN-YRQ (MJRN-OCC-IDX) =  99999                          DTSBX342
00580         MOVE SPACES                     TO ACCT-YRQ               DTSBX342
00581      ELSE                                                         DTSBX342
00582         MOVE MJRN-YRQ (MJRN-OCC-IDX)    TO L004-QTR-5-9           DTSBX342
00583         PERFORM S004-FROM-5             THRU S004-EXIT            DTSBX342
00584         MOVE L004-SLASH-5-QTR           TO ACCT-YRQ               DTSBX342
00585         MOVE L004-ABS-QTR               TO QSUB                   DTSBX342
00586         SET TBL-QTR-YES-88 (QSUB)       TO TRUE                   DTSBX342
00587         DISPLAY 'P2000 ACCT ' MPRF-EMP-NO                         DTSBX342
00588           '  ' MJRN-YRQ (MJRN-OCC-IDX)                            DTSBX342
00589           '  ' QSUB                                               DTSBX342
00590      END-IF.                                                      DTSBX342
00591                                                                   DTSBX342
00592      MOVE MJRN-BATCH-NO                 TO ACCT-BATCH.            DTSBX342
00593      MOVE MJRN-ITEM-NO                  TO ACCT-ITEM.             DTSBX342
00594      MOVE MPRF-EMP-NO                   TO ACCT-EMP-NO.           DTSBX342
00595      MOVE MJRN-TRAN-TYPE                TO ACCT-TRAN.             DTSBX342
00596      MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX)  TO ACCT-ROW.              DTSBX342
00597      MOVE MJRN-ACCT-COL (MJRN-OCC-IDX)  TO ACCT-COL.              DTSBX342
00598      IF ACCT-ROW = 'CR'                                           DTSBX342
00599         MOVE MJRN-AMT (MJRN-OCC-IDX)    TO ACCT-AMT               DTSBX342
00600      ELSE                                                         DTSBX342
00601         IF ACCT-COL NOT = 'CH'                                    DTSBX342
00602            COMPUTE ACCT-AMT =                                     DTSBX342
00603              (MJRN-AMT (MJRN-OCC-IDX) * -1)                       DTSBX342
00604         ELSE                                                      DTSBX342
00605            MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT               DTSBX342
00606         END-IF                                                    DTSBX342
00607      END-IF.                                                      DTSBX342
00608                                                                   DTSBX342
00609      MOVE MJRN-TRAN-CATEGORY            TO ACCT-CAT.              DTSBX342
00610      MOVE MJRN-ESTB-DATE                TO L001-FED-8-DATE-9.     DTSBX342
00611      PERFORM S001-FROM-FED-8            THRU S001-EXIT.           DTSBX342
00612      IF L001-VALID-DATE                                           DTSBX342
00613         MOVE L001-SLASH-8-DATE          TO ACCT-PROCESS-DT        DTSBX342
00614      ELSE                                                         DTSBX342
00615         MOVE LX34-SYS-DATE              TO ACCT-PROCESS-DT        DTSBX342
00616      END-IF.                                                      DTSBX342
00617      SET ACCT-SOURCE-CR-DB-88           TO TRUE.                  DTSBX342
00618                                                                   DTSBX342
00619      WRITE ACCT-REC                     FROM W-ACCT-REC           DTSBX342
00620      IF NOT ACCT-STATUS-OK-88                                     DTSBX342
00621         DISPLAY 'CANNOT WRITE TO ACCT FILE '                      DTSBX342
00622            '  ' ACCT-STATUS '  ' ACCT-EMP-NO                      DTSBX342
00623      ELSE                                                         DTSBX342
00624         ADD +1                          TO W-ACCT-CNT             DTSBX342
00625      END-IF.                                                      DTSBX342
00626                                                                   DTSBX342
00627 **   IF MPRF-EMP-NO = 122233                                      DTSBX342
00628 *       DISPLAY 'P2110   ' MPRF-EMP-NO '  ' ACCT-YRQ              DTSBX342
00629 *          '  ' ACCT-BATCH '/' ACCT-ITEM                          DTSBX342
00630 *       DISPLAY '   ' ACCT-ROW '  ' ACCT-COL                      DTSBX342
00631 *          '  ' ACCT-TRAN '  ' ACCT-AMT                           DTSBX342
00632 **   END-IF.                                                      DTSBX342
00633                                                                   DTSBX342
00634  P2110-EXIT.                                                      DTSBX342
00635      EXIT.                                                        DTSBX342
00636                                                                   DTSBX342
00637                                                                   DTSBX342
00638  P3000-TRANSACTION-DETAIL.                                        DTSBX342
00639      PERFORM P3100-REPORTS          THRU P3100-EXIT.              DTSBX342
00640      PERFORM P3200-PAYMENT          THRU P3200-EXIT.              DTSBX342
00641      PERFORM P3300-ADJUSTMENT       THRU P3300-EXIT.              DTSBX342
00642                                                                   DTSBX342
00643  P3000-EXIT.                                                      DTSBX342
00644      EXIT.                                                        DTSBX342
00645                                                                   DTSBX342
00646                                                                   DTSBX342
00647  P3100-REPORTS.                                                   DTSBX342
00648      MOVE LOW-VALUES                TO MRPT-KEY-AREA.             DTSBX342
00649      MOVE MPRF-EMP-NO               TO MRPT-EMP-NO.               DTSBX342
00650      SET MRPT-RPT-88                TO TRUE.                      DTSBX342
00651      MOVE MRPT-KEY-AREA             TO MSKL-KEY-AREA.             DTSBX342
00652      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBX342
00653      IF L910-NO-REC-88                                            DTSBX342
00654         GO TO P3100-EXIT                                          DTSBX342
00655      ELSE                                                         DTSBX342
00656         PERFORM                                                   DTSBX342
00657           UNTIL L910-NO-REC-88                                    DTSBX342
00658             MOVE MSKL-REC                     TO MRPT-REC         DTSBX342
00659             IF MRPT-ESTB-DATE = LX34-PRIOR-RUN-DATE               DTSBX342
00660                IF MRPT-STATUS-CHNG-YES-88                         DTSBX342
00661                   PERFORM P3130-STATUS-CHANGE THRU P3130-EXIT     DTSBX342
00662                END-IF                                             DTSBX342
00663                PERFORM P3110-WRITE            THRU P3110-EXIT     DTSBX342
00664             END-IF                                                DTSBX342
00665             PERFORM S910-READ-NEXT            THRU S910-EXIT      DTSBX342
00666         END-PERFORM                                               DTSBX342
00667      END-IF.                                                      DTSBX342
00668                                                                   DTSBX342
00669  P3100-EXIT.                                                      DTSBX342
00670      EXIT.                                                        DTSBX342
00671                                                                   DTSBX342
00672  P3110-WRITE.                                                     DTSBX342
00673      MOVE MRPT-RPT-TYPE             TO TRAN-TRANS.                DTSBX342
00674      MOVE MRPT-BATCH-NO             TO TRAN-BATCH.                DTSBX342
00675      MOVE MRPT-ITEM-NO              TO TRAN-ITEM.                 DTSBX342
00676      MOVE MPRF-EMP-NO               TO TRAN-EMP-NO.               DTSBX342
00677      MOVE MRPT-YRQ                  TO L004-QTR-5-9.              DTSBX342
00678      PERFORM S004-FROM-5            THRU S004-EXIT.               DTSBX342
00679      MOVE L004-SLASH-5-QTR          TO TRAN-YRQ.                  DTSBX342
00680      MOVE L004-ABS-QTR              TO QSUB.                      DTSBX342
00681      SET TBL-QTR-YES-88 (QSUB)      TO TRUE.                      DTSBX342
00682      DISPLAY 'P3110 RPT ' MPRF-EMP-NO                             DTSBX342
00683         '  ' MRPT-YRQ                                             DTSBX342
00684         '  ' QSUB.                                                DTSBX342
00685      MOVE MRPT-REMIT-AMT            TO TRAN-AMT.                  DTSBX342
00686      MOVE MRPT-TOT-WAGE             TO TRAN-TOT-WAGE.             DTSBX342
00687      MOVE MRPT-TAX-WAGE             TO TRAN-TAX-WAGE.             DTSBX342
00688      MOVE MRPT-EXCESS-WAGE          TO TRAN-EXC-WAGE.             DTSBX342
00689      IF MPRF-CLASS-SELF-INS-88                                    DTSBX342
00690         MOVE ZERO                   TO TRAN-RATE                  DTSBX342
00691      ELSE                                                         DTSBX342
00692         COMPUTE W-RATE = (MRPT-UI-RATE * 100)                     DTSBX342
00693         MOVE W-RATE                 TO TRAN-RATE                  DTSBX342
00694      END-IF                                                       DTSBX342
00695      MOVE SPACES                    TO TRAN-ACCT.                 DTSBX342
00696      MOVE ZEROS                     TO TRAN-APPLIC-BATCH          DTSBX342
00697                                        TRAN-APPLIC-ITEM.          DTSBX342
00698      IF MRPT-ANNUAL-YES-88                                        DTSBX342
00699         MOVE 'T'                    TO TRAN-CAT                   DTSBX342
00700      ELSE                                                         DTSBX342
00701         MOVE 'R'                    TO TRAN-CAT                   DTSBX342
00702      END-IF.                                                      DTSBX342
00703      SET TRAN-SOURCE-CR-DB-88       TO TRUE.                      DTSBX342
00704      MOVE MRPT-RECEIVED-DATE        TO L001-FED-8-DATE-9.         DTSBX342
00705      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX342
00706      MOVE L001-SLASH-8-DATE         TO TRAN-RCVD-DT.              DTSBX342
00707      MOVE MRPT-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBX342
00708      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX342
00709      IF L001-VALID-DATE                                           DTSBX342
00710         MOVE L001-SLASH-8-DATE      TO TRAN-PROCESS-DT            DTSBX342
00711      ELSE                                                         DTSBX342
00712         MOVE TRAN-RCVD-DT           TO TRAN-PROCESS-DT            DTSBX342
00713      END-IF.                                                      DTSBX342
00714                                                                   DTSBX342
00715      WRITE TRAN-REC   FROM W-TRAN-REC                             DTSBX342
00716      IF NOT TRAN-STATUS-OK-88                                     DTSBX342
00717         DISPLAY 'CANNOT WRITE TO TRAN FILE '                      DTSBX342
00718            '  ' TRAN-STATUS '  ' TRAN-EMP-NO                      DTSBX342
00719      ELSE                                                         DTSBX342
00720         ADD +1 TO W-TRAN-CNT                                      DTSBX342
00721                   W-RPT-CNT                                       DTSBX342
00722      END-IF.                                                      DTSBX342
00723                                                                   DTSBX342
00724  P3110-EXIT.                                                      DTSBX342
00725      EXIT.                                                        DTSBX342
00726                                                                   DTSBX342
00727 *P3120-ANNUAL.                                                    DTSBX342
00728 **   DISPLAY 'ANNUAL ' MPRF-EMP-NO '  ' MRPT-YRQ.                 DTSBX342
00729 *                                                                 DTSBX342
00730 *    PERFORM P3122-INIT-ANN-TBL     THRU P3122-EXIT.              DTSBX342
00731 *                                                                 DTSBX342
00732 *    SET W-RPT-COMPLETE-NULL-88     TO TRUE.                      DTSBX342
00733 *                                                                 DTSBX342
00734 *    MOVE MRPT-YRQ                  TO L004-QTR-5-9.              DTSBX342
00735 *    MOVE 4                         TO L004-QTR-5-Q.              DTSBX342
00736 *    MOVE L004-QTR-5-9              TO W-LAST-ANN-YRQ.            DTSBX342
00737 *                                                                 DTSBX342
00738 *    MOVE MRPT-BATCH-NO             TO W-BATCH.                   DTSBX342
00739 *    MOVE MRPT-ITEM-NO              TO W-ITEM.                    DTSBX342
00740 *                                                                 DTSBX342
00741 *    PERFORM                                                      DTSBX342
00742 *      UNTIL L910-NO-REC-88 OR W-RPT-COMPLETE-YES-88              DTSBX342
00743 *        MOVE MSKL-REC                  TO MRPT-REC               DTSBX342
00744 *        IF MRPT-YRQ > W-LAST-ANN-YRQ                             DTSBX342
00745 *        OR MPRF-EMP-NO                                           DTSBX342
00746 *           SET W-RPT-COMPLETE-YES-88 TO TRUE                     DTSBX342
00747 *        ELSE                                                     DTSBX342
00748 *           PERFORM P3121-SUM-DATA  THRU P3121-EXIT               DTSBX342
00749 *           PERFORM S910-READ-NEXT  THRU S910-EXIT                DTSBX342
00750 *        END-IF                                                   DTSBX342
00751 *    END-PERFORM.                                                 DTSBX342
00752 *                                                                 DTSBX342
00753 *    PERFORM                                                      DTSBX342
00754 *      VARYING ASUB FROM +1 BY +1                                 DTSBX342
00755 *      UNTIL ASUB > ASUB-LAST                                     DTSBX342
00756 *         PERFORM P3123-WRITE       THRU P3123-EXIT               DTSBX342
00757 *    END-PERFORM.                                                 DTSBX342
00758 *                                                                 DTSBX342
00759 *                                                                 DTSBX342
00760 *P3120-EXIT.                                                      DTSBX342
00761 *    EXIT.                                                        DTSBX342
00762 *                                                                 DTSBX342
00763 *P3121-SUM-DATA.                                                  DTSBX342
00764 *    MOVE +0                        TO ASUB.                      DTSBX342
00765 *    PERFORM                                                      DTSBX342
00766 *      VARYING ASUB1 FROM +1 BY +1                                DTSBX342
00767 *      UNTIL ASUB > +0                                            DTSBX342
00768 *      OR ASUB1 > ASUB-LAST                                       DTSBX342
00769 *        IF W-ANN-BATCH (ASUB1) = MRPT-BATCH-NO                   DTSBX342
00770 *        AND W-ANN-ITEM (ASUB1) = MRPT-ITEM-NO                    DTSBX342
00771 *           MOVE ASUB1              TO ASUB                       DTSBX342
00772 *        END-IF                                                   DTSBX342
00773 *    END-PERFORM.                                                 DTSBX342
00774 *                                                                 DTSBX342
00775 *    IF ASUB = ZERO                                               DTSBX342
00776 *       ADD +1                      TO ASUB-LAST                  DTSBX342
00777 *       MOVE ASUB-LAST              TO ASUB                       DTSBX342
00778 *    ELSE                                                         DTSBX342
00779 *       ADD MRPT-REMIT-AMT     TO W-ANN-REMIT (ASUB)              DTSBX342
00780 *       ADD MRPT-TOT-WAGE      TO W-ANN-TOT-WAGE (ASUB)           DTSBX342
00781 *       ADD MRPT-TAX-WAGE      TO W-ANN-TAX-WAGE (ASUB)           DTSBX342
00782 *       ADD MRPT-EXCESS-WAGE   TO W-ANN-EXCESS-WAGE (ASUB)        DTSBX342
00783 *       GO TO P3121-EXIT                                          DTSBX342
00784 *    END-IF.                                                      DTSBX342
00785 *                                                                 DTSBX342
00786 *    MOVE MRPT-RPT-TYPE                                           DTSBX342
00787 *         TO W-ANN-RPT-TYPE (ASUB).                               DTSBX342
00788 *    MOVE MRPT-YRQ             TO W-ANN-YRQ (ASUB).               DTSBX342
00789 *    MOVE MRPT-BATCH-NO        TO W-ANN-BATCH (ASUB).             DTSBX342
00790 *    MOVE MRPT-ITEM-NO         TO W-ANN-ITEM (ASUB).              DTSBX342
00791 *    ADD MRPT-REMIT-AMT        TO W-ANN-REMIT (ASUB).             DTSBX342
00792 *    ADD MRPT-TOT-WAGE         TO W-ANN-TOT-WAGE (ASUB).          DTSBX342
00793 *    ADD MRPT-TAX-WAGE         TO W-ANN-TAX-WAGE (ASUB).          DTSBX342
00794 *    ADD MRPT-EXCESS-WAGE      TO W-ANN-EXCESS-WAGE (ASUB).       DTSBX342
00795 *    MOVE MRPT-UI-RATE         TO W-ANN-RATE (ASUB).              DTSBX342
00796 *    MOVE MRPT-RECEIVED-DATE   TO W-ANN-RCVD-DT (ASUB).           DTSBX342
00797 *    MOVE MRPT-ESTB-DATE       TO W-ANN-PROCESS-DT (ASUB).        DTSBX342
00798 *                                                                 DTSBX342
00799 *P3121-EXIT.                                                      DTSBX342
00800 *    EXIT.                                                        DTSBX342
00801 *                                                                 DTSBX342
00802 *P3122-INIT-ANN-TBL.                                              DTSBX342
00803 *    MOVE ZERO                TO ASUB-LAST.                       DTSBX342
00804 *    PERFORM                                                      DTSBX342
00805 *      VARYING ASUB FROM +1 BY +1                                 DTSBX342
00806 *      UNTIL ASUB > ASUB-MAX                                      DTSBX342
00807 *        MOVE SPACES          TO W-ANN-RPT-TYPE (ASUB)            DTSBX342
00808 *        MOVE ZERO            TO W-ANN-YRQ (ASUB)                 DTSBX342
00809 *                                W-ANN-RATE (ASUB)                DTSBX342
00810 *                                W-ANN-REMIT (ASUB)               DTSBX342
00811 *                                W-ANN-BATCH (ASUB)               DTSBX342
00812 *                                W-ANN-ITEM (ASUB)                DTSBX342
00813 *                                W-ANN-TOT-WAGE (ASUB)            DTSBX342
00814 *                                W-ANN-TAX-WAGE (ASUB)            DTSBX342
00815 *                                W-ANN-EXCESS-WAGE (ASUB)         DTSBX342
00816 *                                W-ANN-RCVD-DT (ASUB)             DTSBX342
00817 *                                W-ANN-PROCESS-DT (ASUB)          DTSBX342
00818 *    END-PERFORM.                                                 DTSBX342
00819 *                                                                 DTSBX342
00820 *P3122-EXIT.                                                      DTSBX342
00821 *    EXIT.                                                        DTSBX342
00822 *                                                                 DTSBX342
00823 *P3123-WRITE.                                                     DTSBX342
00824 *    MOVE W-ANN-RPT-TYPE (ASUB)      TO TRAN-TRANS.               DTSBX342
00825 *    MOVE W-ANN-BATCH (ASUB)         TO TRAN-BATCH.               DTSBX342
00826 *    MOVE W-ANN-ITEM (ASUB)          TO TRAN-ITEM.                DTSBX342
00827 *    MOVE MPRF-EMP-NO                TO TRAN-EMP-NO.              DTSBX342
00828 *    MOVE 1                          TO W-ANN-YRQ-Q (ASUB).       DTSBX342
00829 *    MOVE W-ANN-YRQ (ASUB)           TO L004-QTR-5-9              DTSBX342
00830 *    PERFORM S004-FROM-5             THRU S004-EXIT               DTSBX342
00831 *    MOVE L004-SLASH-5-QTR           TO TRAN-YRQ                  DTSBX342
00832 *    MOVE L004-ABS-QTR               TO QSUB.                     DTSBX342
00833 *    SET TBL-QTR-YES-88 (QSUB)       TO TRUE.                     DTSBX342
00834 *    MOVE W-ANN-REMIT (ASUB)         TO TRAN-AMT.                 DTSBX342
00835 *    MOVE W-ANN-TOT-WAGE (ASUB)      TO TRAN-TOT-WAGE.            DTSBX342
00836 *    MOVE W-ANN-TAX-WAGE (ASUB)      TO TRAN-TAX-WAGE.            DTSBX342
00837 *    MOVE W-ANN-EXCESS-WAGE (ASUB) TO TRAN-EXC-WAGE.              DTSBX342
00838 *    COMPUTE W-RATE = (W-ANN-RATE (ASUB) * 100).                  DTSBX342
00839 *    MOVE W-RATE                     TO TRAN-RATE.                DTSBX342
00840 *    MOVE SPACES                     TO TRAN-ACCT.                DTSBX342
00841 *    MOVE 'T'                        TO TRAN-CAT.                 DTSBX342
00842 *    SET TRAN-SOURCE-CR-DB-88        TO TRUE.                     DTSBX342
00843 *    MOVE W-ANN-RCVD-DT (ASUB)       TO L001-FED-8-DATE-9.        DTSBX342
00844 *    PERFORM S001-FROM-FED-8         THRU S001-EXIT.              DTSBX342
00845 *    MOVE L001-SLASH-8-DATE          TO TRAN-RCVD-DT.             DTSBX342
00846 *    MOVE W-ANN-PROCESS-DT (ASUB)    TO L001-FED-8-DATE-9.        DTSBX342
00847 *    PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX342
00848 *    MOVE L001-SLASH-8-DATE         TO TRAN-PROCESS-DT.           DTSBX342
00849 *                                                                 DTSBX342
00850 *    WRITE TRAN-REC   FROM W-TRAN-REC.                            DTSBX342
00851 *    IF NOT TRAN-STATUS-OK-88                                     DTSBX342
00852 *       DISPLAY 'CANNOT WRITE TO TRAN FILE '                      DTSBX342
00853 *          '  ' TRAN-STATUS '  ' TRAN-EMP-NO                      DTSBX342
00854 *    ELSE                                                         DTSBX342
00855 *       ADD +1 TO W-TRAN-CNT                                      DTSBX342
00856 *                 W-ANN-RPT-CNT                                   DTSBX342
00857 *    END-IF.                                                      DTSBX342
00858 *                                                                 DTSBX342
00859 *P3123-EXIT.                                                      DTSBX342
00860 *    EXIT.                                                        DTSBX342
00861                                                                   DTSBX342
00862  P3130-STATUS-CHANGE.                                             DTSBX342
00863 ***  DISPLAY 'STATUS ' MRPT-EMP-NO '  ' MRPT-BATCH-NO             DTSBX342
00864 ***     '  ' MRPT-ITEM-NO.                                        DTSBX342
00865      MOVE LX34-PRIOR-RUN-DATE     TO L001-FED-8-DATE-9.           DTSBX342
00866      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX342
00867      MOVE L001-SLASH-8-DATE       TO SUMMARY-PROCESS-DT.          DTSBX342
00868      MOVE 'STATUS CHANGE '        TO SUMMARY-MESSAGE.             DTSBX342
00869      MOVE MRPT-EMP-NO             TO SUMMARY-EMP-NO               DTSBX342
00870                                                                   DTSBX342
00871      MOVE MRPT-BATCH-NO           TO SUMMARY-BATCH.               DTSBX342
00872      MOVE MRPT-ITEM-NO            TO SUMMARY-ITEM.                DTSBX342
00873      MOVE MRPT-RPT-TYPE           TO SUMMARY-TRAN.                DTSBX342
00874      SET SUMMARY-SOURCE-STATUS-88 TO TRUE                         DTSBX342
00875                                                                   DTSBX342
00876      WRITE SUMMARY-REC            FROM W-SUMMARY-REC.             DTSBX342
00877      ADD  +1 TO W-SUMMARY-CNT.                                    DTSBX342
00878                                                                   DTSBX342
00879  P3130-EXIT.                                                      DTSBX342
00880      EXIT.                                                        DTSBX342
00881                                                                   DTSBX342
00882  P3200-PAYMENT.                                                   DTSBX342
00883      MOVE LOW-VALUES                TO MPAY-KEY-AREA.             DTSBX342
00884      MOVE MPRF-EMP-NO               TO MPAY-EMP-NO.               DTSBX342
00885      SET MPAY-PAY-88 TO TRUE.                                     DTSBX342
00886      MOVE MPAY-KEY-AREA             TO MSKL-KEY-AREA.             DTSBX342
00887      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBX342
00888      IF L910-NO-REC-88                                            DTSBX342
00889         GO TO P3200-EXIT                                          DTSBX342
00890      ELSE                                                         DTSBX342
00891         PERFORM                                                   DTSBX342
00892           UNTIL L910-NO-REC-88                                    DTSBX342
00893             MOVE MSKL-REC               TO MPAY-REC               DTSBX342
00894             IF MPAY-ESTB-DATE = LX34-PRIOR-RUN-DATE               DTSBX342
00895                PERFORM P3210-WRITE      THRU P3210-EXIT           DTSBX342
00896             END-IF                                                DTSBX342
00897             PERFORM S910-READ-NEXT      THRU S910-EXIT            DTSBX342
00898         END-PERFORM                                               DTSBX342
00899      END-IF.                                                      DTSBX342
00900                                                                   DTSBX342
00901  P3200-EXIT.                                                      DTSBX342
00902      EXIT.                                                        DTSBX342
00903                                                                   DTSBX342
00904  P3210-WRITE.                                                     DTSBX342
00905      MOVE MPAY-PAY-TYPE             TO TRAN-TRANS.                DTSBX342
00906      IF MPAY-APPLIC-YRQ > ZERO                                    DTSBX342
00907         MOVE MPAY-APPLIC-YRQ        TO L004-QTR-5-9               DTSBX342
00908         PERFORM S004-FROM-5         THRU S004-EXIT                DTSBX342
00909         MOVE L004-SLASH-5-QTR       TO TRAN-YRQ                   DTSBX342
00910      ELSE                                                         DTSBX342
00911         MOVE SPACES                 TO TRAN-YRQ                   DTSBX342
00912      END-IF.                                                      DTSBX342
00913      MOVE MPRF-EMP-NO               TO TRAN-EMP-NO.               DTSBX342
00914      MOVE MPAY-BATCH-NO             TO TRAN-BATCH.                DTSBX342
00915      MOVE MPAY-ITEM-NO              TO TRAN-ITEM.                 DTSBX342
00916      MOVE MPAY-REMIT-AMT            TO TRAN-AMT.                  DTSBX342
00917                                                                   DTSBX342
00918      MOVE ZERO                      TO TRAN-TAX-WAGE              DTSBX342
00919                                        TRAN-TOT-WAGE              DTSBX342
00920                                        TRAN-EXC-WAGE              DTSBX342
00921                                        TRAN-RATE.                 DTSBX342
00922      MOVE MPAY-APPLIC-IND           TO TRAN-ACCT.                 DTSBX342
00923      MOVE MPAY-APPLIC-BATCH-NO      TO TRAN-APPLIC-BATCH.         DTSBX342
00924      MOVE MPAY-APPLIC-ITEM-NO       TO TRAN-APPLIC-ITEM.          DTSBX342
00925      MOVE 'P'                       TO TRAN-CAT.                  DTSBX342
00926      SET TRAN-SOURCE-CR-DB-88       TO TRUE.                      DTSBX342
00927      MOVE MPAY-RECEIVED-DATE        TO L001-FED-8-DATE-9.         DTSBX342
00928      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX342
00929      MOVE L001-SLASH-8-DATE         TO TRAN-RCVD-DT.              DTSBX342
00930      MOVE MPAY-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBX342
00931      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX342
00932      IF L001-VALID-DATE                                           DTSBX342
00933         MOVE L001-SLASH-8-DATE      TO TRAN-PROCESS-DT            DTSBX342
00934      ELSE                                                         DTSBX342
00935         MOVE TRAN-RCVD-DT           TO TRAN-PROCESS-DT            DTSBX342
00936 **      MOVE W-DEFAULT-DATE         TO TRAN-PROCESS-DT            DTSBX342
00937      END-IF.                                                      DTSBX342
00938                                                                   DTSBX342
00939      WRITE TRAN-REC   FROM W-TRAN-REC                             DTSBX342
00940      IF NOT TRAN-STATUS-OK-88                                     DTSBX342
00941         DISPLAY 'CANNOT WRITE TO TRAN FILE '                      DTSBX342
00942            '  ' TRAN-STATUS '  ' TRAN-EMP-NO                      DTSBX342
00943      ELSE                                                         DTSBX342
00944         ADD +1 TO W-TRAN-CNT                                      DTSBX342
00945                   W-PAY-CNT                                       DTSBX342
00946      END-IF.                                                      DTSBX342
00947                                                                   DTSBX342
00948  P3210-EXIT.                                                      DTSBX342
00949      EXIT.                                                        DTSBX342
00950                                                                   DTSBX342
00951  P3300-ADJUSTMENT.                                                DTSBX342
00952      MOVE LOW-VALUES                TO MADJ-KEY-AREA.             DTSBX342
00953      MOVE MPRF-EMP-NO               TO MADJ-EMP-NO.               DTSBX342
00954      SET MADJ-ADJ-88 TO TRUE.                                     DTSBX342
00955      MOVE MADJ-KEY-AREA             TO MSKL-KEY-AREA.             DTSBX342
00956      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBX342
00957      IF L910-NO-REC-88                                            DTSBX342
00958         GO TO P3300-EXIT                                          DTSBX342
00959      ELSE                                                         DTSBX342
00960         PERFORM                                                   DTSBX342
00961           UNTIL L910-NO-REC-88                                    DTSBX342
00962             MOVE MSKL-REC               TO MADJ-REC               DTSBX342
00963             IF MADJ-ESTB-DATE = LX34-PRIOR-RUN-DATE               DTSBX342
00964                PERFORM P3310-WRITE      THRU P3310-EXIT           DTSBX342
00965             END-IF                                                DTSBX342
00966             PERFORM S910-READ-NEXT      THRU S910-EXIT            DTSBX342
00967         END-PERFORM                                               DTSBX342
00968      END-IF.                                                      DTSBX342
00969                                                                   DTSBX342
00970  P3300-EXIT.                                                      DTSBX342
00971      EXIT.                                                        DTSBX342
00972                                                                   DTSBX342
00973  P3310-WRITE.                                                     DTSBX342
00974      IF MADJ-CHRG-88                                              DTSBX342
00975      OR MADJ-WAIVE-88                                             DTSBX342
00976      OR MADJ-TOLER-88                                             DTSBX342
00977      OR MADJ-WRITE-OFF-88                                         DTSBX342
00978      OR MADJ-WRITE-OFF-REV-88                                     DTSBX342
00979         NEXT SENTENCE                                             DTSBX342
00980      ELSE                                                         DTSBX342
00981         GO TO P3310-EXIT                                          DTSBX342
00982      END-IF.                                                      DTSBX342
00983                                                                   DTSBX342
00984      MOVE MADJ-ADJ-TYPE             TO TRAN-TRANS.                DTSBX342
00985      MOVE MADJ-BATCH-NO             TO TRAN-BATCH.                DTSBX342
00986      MOVE MADJ-ITEM-NO              TO TRAN-ITEM.                 DTSBX342
00987      IF MADJ-APPLIC-YRQ > ZERO                                    DTSBX342
00988         MOVE MADJ-APPLIC-YRQ        TO L004-QTR-5-9               DTSBX342
00989         PERFORM S004-FROM-5         THRU S004-EXIT                DTSBX342
00990         MOVE L004-SLASH-5-QTR       TO TRAN-YRQ                   DTSBX342
00991         MOVE L004-ABS-QTR           TO QSUB                       DTSBX342
00992         SET TBL-QTR-YES-88 (QSUB)   TO TRUE                       DTSBX342
00993         DISPLAY 'P3310 ADJ ' MPRF-EMP-NO                          DTSBX342
00994            '  ' MADJ-APPLIC-YRQ                                   DTSBX342
00995            '  ' QSUB                                              DTSBX342
00996      ELSE                                                         DTSBX342
00997         MOVE SPACES                 TO TRAN-YRQ                   DTSBX342
00998      END-IF.                                                      DTSBX342
00999      MOVE MPRF-EMP-NO               TO TRAN-EMP-NO.               DTSBX342
01000      MOVE MADJ-AMT                  TO TRAN-AMT.                  DTSBX342
01001                                                                   DTSBX342
01002      MOVE ZERO                      TO TRAN-TOT-WAGE              DTSBX342
01003                                        TRAN-TAX-WAGE              DTSBX342
01004                                        TRAN-EXC-WAGE              DTSBX342
01005                                        TRAN-RATE.                 DTSBX342
01006      MOVE MADJ-APPLIC-IND           TO TRAN-ACCT.                 DTSBX342
01007      MOVE MADJ-APPLIC-BATCH-NO      TO TRAN-APPLIC-BATCH.         DTSBX342
01008      MOVE MADJ-APPLIC-ITEM-NO       TO TRAN-APPLIC-ITEM.          DTSBX342
01009      MOVE 'A'                       TO TRAN-CAT.                  DTSBX342
01010      SET TRAN-SOURCE-CR-DB-88       TO TRUE.                      DTSBX342
01011      MOVE MADJ-RECEIVED-DATE        TO L001-FED-8-DATE-9.         DTSBX342
01012      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX342
01013      MOVE L001-SLASH-8-DATE         TO TRAN-RCVD-DT.              DTSBX342
01014      MOVE MADJ-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBX342
01015      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX342
01016      IF L001-VALID-DATE                                           DTSBX342
01017         MOVE L001-SLASH-8-DATE      TO TRAN-PROCESS-DT            DTSBX342
01018      ELSE                                                         DTSBX342
01019         MOVE TRAN-RCVD-DT           TO TRAN-PROCESS-DT            DTSBX342
01020 **      MOVE W-DEFAULT-DATE         TO TRAN-PROCESS-DT            DTSBX342
01021      END-IF.                                                      DTSBX342
01022                                                                   DTSBX342
01023      WRITE TRAN-REC   FROM W-TRAN-REC                             DTSBX342
01024      IF NOT TRAN-STATUS-OK-88                                     DTSBX342
01025         DISPLAY 'CANNOT WRITE TO TRAN FILE '                      DTSBX342
01026            '  ' TRAN-STATUS '  ' TRAN-EMP-NO                      DTSBX342
01027      ELSE                                                         DTSBX342
01028         ADD +1 TO W-TRAN-CNT                                      DTSBX342
01029                   W-ADJ-CNT                                       DTSBX342
01030      END-IF.                                                      DTSBX342
01031                                                                   DTSBX342
01032  P3310-EXIT.                                                      DTSBX342
01033      EXIT.                                                        DTSBX342
01034                                                                   DTSBX342
01035  P4000-UPDATE-QTRS.                                               DTSBX342
01036      PERFORM                                                      DTSBX342
01037        VARYING QSUB FROM +1 BY +1                                 DTSBX342
01038        UNTIL QSUB > QMAX                                          DTSBX342
01039           IF TBL-QTR-YES-88 (QSUB)                                DTSBX342
01040              PERFORM P4100-BUILD-QTR      THRU P4100-EXIT         DTSBX342
01041           END-IF                                                  DTSBX342
01042      END-PERFORM.                                                 DTSBX342
01043                                                                   DTSBX342
01044  P4000-EXIT.                                                      DTSBX342
01045      EXIT.                                                        DTSBX342
01046                                                                   DTSBX342
01047  P4100-BUILD-QTR.                                                 DTSBX342
01048      DISPLAY 'P4100 ' MPRF-EMP-NO '  ' MQTR-YRQ.                  DTSBX342
01049      MOVE LOW-VALUES                   TO MQTR-KEY-AREA.          DTSBX342
01050      MOVE MPRF-EMP-NO                  TO MQTR-EMP-NO.            DTSBX342
01051      SET MQTR-QTR-88                   TO TRUE.                   DTSBX342
01052      MOVE QSUB                         TO L004-ABS-QTR.           DTSBX342
01053      PERFORM S004-FROM-ABS             THRU S004-EXIT.            DTSBX342
01054      MOVE L004-QTR-5-9                 TO MQTR-YRQ.               DTSBX342
01055      MOVE MQTR-KEY-AREA                TO MSKL-KEY-AREA.          DTSBX342
01056      PERFORM S910-READ                 THRU S910-EXIT.            DTSBX342
01057      IF L910-NO-REC-88                                            DTSBX342
01058         GO TO P4100-EXIT                                          DTSBX342
01059      ELSE                                                         DTSBX342
01060         MOVE MSKL-REC             TO MQTR-REC                     DTSBX342
01061      END-IF.                                                      DTSBX342
01062                                                                   DTSBX342
01063 **   MOVE MQTR-YRQ                TO L004-QTR-5-9.                DTSBX342
01064 **   PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBX342
01065 **   MOVE L004-ABS-QTR            TO LX34-SUB.                    DTSBX342
01066      MOVE QSUB                    TO LX34-SUB.                    DTSBX342
01067      IF LX34-QTR-EXISTS-YES-88 (LX34-SUB)                         DTSBX342
01068         GO TO P4100-EXIT                                          DTSBX342
01069      ELSE                                                         DTSBX342
01070         SET LX34-QTR-EXISTS-YES-88 (LX34-SUB)  TO TRUE            DTSBX342
01071      END-IF.                                                      DTSBX342
01072                                                                   DTSBX342
01073      DISPLAY 'P4100 - 2 ' MPRF-EMP-NO '  ' MQTR-YRQ.              DTSBX342
01074      MOVE ZERO                           TO W-QTR-BAL.            DTSBX342
01075      IF MPRF-TOT-BALANCE-AMT > ZERO                               DTSBX342
01076         PERFORM P4110-BAL-DUE            THRU P4110-EXIT          DTSBX342
01077      END-IF.                                                      DTSBX342
01078                                                                   DTSBX342
01079      MOVE MQTR-EMP-NO                    TO QTR-EMP-NO.           DTSBX342
01080      MOVE MQTR-YRQ                       TO L004-QTR-5-9.         DTSBX342
01081      PERFORM S004-FROM-5                 THRU S004-EXIT.          DTSBX342
01082      IF L004-VALID-QTR                                            DTSBX342
01083         MOVE L004-SLASH-5-QTR            TO QTR-QUARTER           DTSBX342
01084      ELSE                                                         DTSBX342
01085         GO TO P4100-EXIT                                          DTSBX342
01086      END-IF.                                                      DTSBX342
01087      MOVE MQTR-CURR-RPT-TYPE             TO QTR-RPT-STATUS.       DTSBX342
01088      MOVE MQTR-RPT-DUE-DATE              TO L001-FED-8-DATE-9.    DTSBX342
01089      PERFORM S001-FROM-FED-8             THRU S001-EXIT.          DTSBX342
01090      MOVE L001-SLASH-8-DATE              TO QTR-DUE-DT.           DTSBX342
01091      MOVE W-QTR-BAL                      TO QTR-BAL-DUE.          DTSBX342
01092                                                                   DTSBX342
01093      MOVE MQTR-ESTB-DATE                 TO L001-FED-8-DATE-X.    DTSBX342
01094      PERFORM S001-FROM-FED-8             THRU S001-EXIT.          DTSBX342
01095      IF L001-VALID-DATE                                           DTSBX342
01096         MOVE L001-SLASH-8-DATE           TO QTR-PROCESS-DT        DTSBX342
01097      ELSE                                                         DTSBX342
01098         MOVE W-DEFAULT-DATE              TO QTR-PROCESS-DT        DTSBX342
01099      END-IF.                                                      DTSBX342
01100                                                                   DTSBX342
01101      IF QTR-PROCESS-DT = W-DEFAULT-DATE                           DTSBX342
01102         MOVE MQTR-CHNG-DATE              TO L001-FED-8-DATE-X     DTSBX342
01103         PERFORM S001-FROM-FED-8          THRU S001-EXIT           DTSBX342
01104         IF L001-VALID-DATE                                        DTSBX342
01105            MOVE L001-SLASH-8-DATE        TO QTR-PROCESS-DT        DTSBX342
01106         END-IF                                                    DTSBX342
01107      END-IF.                                                      DTSBX342
01108                                                                   DTSBX342
01109      WRITE QTR-REC    FROM W-QTR-REC                              DTSBX342
01110      IF NOT QTR-STATUS-OK-88                                      DTSBX342
01111         DISPLAY 'CANNOT WRITE TO QTR FILE '                       DTSBX342
01112            '  ' QTR-STATUS '  ' QTR-EMP-NO                        DTSBX342
01113      ELSE                                                         DTSBX342
01114         ADD +1 TO W-QTR-CNT                                       DTSBX342
01115      END-IF.                                                      DTSBX342
01116                                                                   DTSBX342
01117  P4100-EXIT.                                                      DTSBX342
01118      EXIT.                                                        DTSBX342
01119                                                                   DTSBX342
01120  P4110-BAL-DUE.                                                   DTSBX342
01121      PERFORM                                                      DTSBX342
01122        VARYING MQTR-ACCT-IDX FROM +1 BY +1                        DTSBX342
01123        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBX342
01124           ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO W-QTR-BAL       DTSBX342
01125      END-PERFORM.                                                 DTSBX342
01126                                                                   DTSBX342
01127  P4110-EXIT.                                                      DTSBX342
01128      EXIT.                                                        DTSBX342
01129                                                                   DTSBX342
01130  P5000-PAY-DISTRIBUTION.                                          DTSBX342
01131      MOVE LOW-VALUES                TO MDST-KEY-AREA.             DTSBX342
01132      MOVE MPRF-EMP-NO               TO MDST-EMP-NO.               DTSBX342
01133      SET MDST-DST-88 TO TRUE.                                     DTSBX342
01134      MOVE MDST-KEY-AREA             TO MSKL-KEY-AREA.             DTSBX342
01135      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBX342
01136      PERFORM   UNTIL L910-NO-REC-88                               DTSBX342
01137         MOVE MSKL-REC                TO MDST-REC                  DTSBX342
01138         PERFORM P5100-BUILD-OUTPUT   THRU P5100-EXIT              DTSBX342
01139         MOVE MDST-REC                TO MSKL-REC                  DTSBX342
01140         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBX342
01141      END-PERFORM.                                                 DTSBX342
01142                                                                   DTSBX342
01143  P5000-EXIT.                                                      DTSBX342
01144      EXIT.                                                        DTSBX342
01145                                                                   DTSBX342
01146  P5100-BUILD-OUTPUT.                                              DTSBX342
01147      IF MPRF-EMP-NO = 014121                                      DTSBX342
01148         DISPLAY 'P5100 ' MPRF-EMP-NO '  ' MDST-BATCH-NO           DTSBX342
01149            '  ' MDST-ITEM-NO                                      DTSBX342
01150      END-IF.                                                      DTSBX342
01151                                                                   DTSBX342
01152      MOVE MDST-EMP-NO               TO DST-EMP-NO.                DTSBX342
01153      MOVE MDST-BATCH-NO             TO DST-BATCH.                 DTSBX342
01154      MOVE MDST-ITEM-NO              TO DST-ITEM.                  DTSBX342
01155      MOVE MDST-YRQ                  TO L004-QTR-5-9.              DTSBX342
01156      PERFORM S004-FROM-5            THRU S004-EXIT.               DTSBX342
01157      MOVE L004-SLASH-5-QTR          TO DST-QTR                    DTSBX342
01158      MOVE MDST-CHNG-DATE            TO L001-FED-8-DATE-9.         DTSBX342
01159      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBX342
01160      MOVE L001-SLASH-8-DATE         TO DST-CHNG-DT.               DTSBX342
01161      IF L001-INVALID-DATE                                         DTSBX342
01162         DISPLAY 'P5100 INVALID MDST-CHNG-DATE '                   DTSBX342
01163            MDST-EMP-NO '  ' MDST-BATCH-NO                         DTSBX342
01164               '  ' MDST-ITEM-NO                                   DTSBX342
01165         GO TO P5100-EXIT                                          DTSBX342
01166      ELSE                                                         DTSBX342
01167         PERFORM                                                   DTSBX342
01168           VARYING MDST-ACCT-IDX FROM +1 BY +1                     DTSBX342
01169           UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT                     DTSBX342
01170             MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO DST-ACCT        DTSBX342
01171             MOVE MDST-AMT (MDST-ACCT-IDX)      TO DST-AMT         DTSBX342
01172             PERFORM P5110-WRITE                THRU P5110-EXIT    DTSBX342
01173         END-PERFORM                                               DTSBX342
01174      END-IF.                                                      DTSBX342
01175                                                                   DTSBX342
01176  P5100-EXIT.                                                      DTSBX342
01177      EXIT.                                                        DTSBX342
01178                                                                   DTSBX342
01179  P5110-WRITE.                                                     DTSBX342
01180      IF MPRF-EMP-NO = 014121                                      DTSBX342
01181         DISPLAY 'P5110 ' DST-EMP-NO '  ' DST-BATCH                DTSBX342
01182            '  ' DST-ITEM '  ' DST-ACCT '  ' DST-AMT               DTSBX342
01183      END-IF.                                                      DTSBX342
01184      WRITE PAY-DIST-REC    FROM W-PAY-DIST-REC.                   DTSBX342
01185      IF NOT PAYDIST-STATUS-OK-88                                  DTSBX342
01186         DISPLAY 'CANNOT WRITE TO PAY DIST FILE '                  DTSBX342
01187            '  ' PAYDIST-STATUS '  ' DST-EMP-NO                    DTSBX342
01188      ELSE                                                         DTSBX342
01189         ADD +1 TO W-PAY-DIST-CNT                                  DTSBX342
01190      END-IF.                                                      DTSBX342
01191                                                                   DTSBX342
01192  P5110-EXIT.                                                      DTSBX342
01193      EXIT.                                                        DTSBX342
01194                                                                   DTSBX342
01195  T0000-TERMINATE.                                                 DTSBX342
01196      CLOSE ACCT-FILE                                              DTSBX342
01197            QTR-FILE                                               DTSBX342
01198            TRAN-FILE                                              DTSBX342
01199            SUMMARY-FILE                                           DTSBX342
01200            PAY-DIST-FILE.                                         DTSBX342
01201                                                                   DTSBX342
01202      DISPLAY '*********************************************'.     DTSBX342
01203      DISPLAY '**   DTSBX342 TERMINATION STATISTICS       **'.     DTSBX342
01204      DISPLAY '**                                         **'.     DTSBX342
01205      DISPLAY '**  QUARTERS        ' W-QTR-CNT                     DTSBX342
01206                                       '                  **'.     DTSBX342
01207      DISPLAY '**  ACOUNTING       ' W-ACCT-CNT                    DTSBX342
01208                                       '                  **'.     DTSBX342
01209      DISPLAY '**  TRANSACTIONS    ' W-TRAN-CNT                    DTSBX342
01210                                       '                  **'.     DTSBX342
01211      DISPLAY '**     REPORTS      ' W-RPT-CNT                     DTSBX342
01212                                       '                  **'.     DTSBX342
01213      DISPLAY '**     ANN REPORTS  ' W-ANN-RPT-CNT                 DTSBX342
01214                                       '                  **'.     DTSBX342
01215      DISPLAY '**     PAYMENTS     ' W-PAY-CNT                     DTSBX342
01216                                       '                  **'.     DTSBX342
01217      DISPLAY '**     ADJUST       ' W-ADJ-CNT                     DTSBX342
01218                                       '                  **'.     DTSBX342
01219      DISPLAY '**   STATUS CHNG    ' W-SUMMARY-CNT                 DTSBX342
01220                                       '                  **'.     DTSBX342
01221      DISPLAY '**   PAY DIST       ' W-PAY-DIST-CNT                DTSBX342
01222                                       '                  **'.     DTSBX342
01223      DISPLAY '**                                         **'.     DTSBX342
01224      DISPLAY '**                                         **'.     DTSBX342
01225      DISPLAY '*********************************************'.     DTSBX342
01226                                                                   DTSBX342
01227                                                                   DTSBX342
01228  T0000-EXIT.                                                      DTSBX342
01229      EXIT.                                                        DTSBX342
01230                                                                   DTSBX342
01231                                                                   DTSBX342
01232  S001-FROM-FED-8.                                                 DTSBX342
01233      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX342
01234      GO TO S001-DATE.                                             DTSBX342
01235                                                                   DTSBX342
01236  S001-FROM-ABS-DAY.                                               DTSBX342
01237      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX342
01238      GO TO S001-DATE.                                             DTSBX342
01239                                                                   DTSBX342
01240  S001-FROM-CAL-6.                                                 DTSBX342
01241      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBX342
01242      GO TO S001-DATE.                                             DTSBX342
01243                                                                   DTSBX342
01244  S001-DATE.                                                       DTSBX342
01245      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX342
01246  S001-EXIT.                                                       DTSBX342
01247      EXIT.                                                        DTSBX342
01248      SKIP3                                                        DTSBX342
01249  S004-FROM-5.                                                     DTSBX342
01250      SET L004-FROM-5 TO TRUE.                                     DTSBX342
01251      GO TO S004-QTR.                                              DTSBX342
01252                                                                   DTSBX342
01253  S004-FROM-ABS.                                                   DTSBX342
01254      SET L004-FROM-ABS TO TRUE.                                   DTSBX342
01255      GO TO S004-QTR.                                              DTSBX342
01256                                                                   DTSBX342
01257  S004-FROM-3.                                                     DTSBX342
01258      SET L004-FROM-3 TO TRUE.                                     DTSBX342
01259      GO TO S004-QTR.                                              DTSBX342
01260                                                                   DTSBX342
01261  S004-FROM-DATE.                                                  DTSBX342
01262      SET L004-FROM-DATE TO TRUE.                                  DTSBX342
01263      GO TO S004-QTR.                                              DTSBX342
01264                                                                   DTSBX342
01265  S004-QTR.                                                        DTSBX342
01266                                                                   DTSBX342
01267      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX342
01268                                                                   DTSBX342
01269  S004-EXIT.                                                       DTSBX342
01270      EXIT.                                                        DTSBX342
01271      SKIP3                                                        DTSBX342
01272  S005-FROM-DATE-TIME.                                             DTSBX342
01273      SET L005-FROM-DATE-TIME TO TRUE.                             DTSBX342
01274      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBX342
01275  S005-EXIT.                                                       DTSBX342
01276      EXIT.                                                        DTSBX342
01277                                                                   DTSBX342
01278  S910-OPEN-READ.                                                  DTSBX342
01279      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX342
01280      GO TO S910-MSTR-IO.                                          DTSBX342
01281                                                                   DTSBX342
01282  S910-READ.                                                       DTSBX342
01283      SET L910-READ-88 TO TRUE.                                    DTSBX342
01284      GO TO S910-MSTR-IO.                                          DTSBX342
01285                                                                   DTSBX342
01286  S910-START-BROWSE.                                               DTSBX342
01287      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX342
01288      GO TO S910-MSTR-IO.                                          DTSBX342
01289                                                                   DTSBX342
01290  S910-READ-NEXT.                                                  DTSBX342
01291      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX342
01292      GO TO S910-MSTR-IO.                                          DTSBX342
01293                                                                   DTSBX342
01294  S910-COUNT.                                                      DTSBX342
01295      SET L910-COUNT-88 TO TRUE.                                   DTSBX342
01296      GO TO S910-MSTR-IO.                                          DTSBX342
01297                                                                   DTSBX342
01298  S910-REWRITE.                                                    DTSBX342
01299      SET L910-REWRITE-88 TO TRUE.                                 DTSBX342
01300      GO TO S910-MSTR-IO.                                          DTSBX342
01301                                                                   DTSBX342
01302  S910-CLOSE.                                                      DTSBX342
01303      SET L910-CLOSE-88   TO TRUE.                                 DTSBX342
01304      GO TO S910-MSTR-IO.                                          DTSBX342
01305                                                                   DTSBX342
01306  S910-MSTR-IO.                                                    DTSBX342
01307      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX342
01308                            MSKL-REC.                              DTSBX342
01309  S910-EXIT.                                                       DTSBX342
01310      EXIT.                                                        DTSBX342
01311      SKIP3                                                        DTSBX342
01312                                                                   DTSBX342
01313  S931-READ.                                                       DTSBX342
01314      SET L931-READ-88 TO TRUE.                                    DTSBX342
01315      GO TO S931-REF-IO.                                           DTSBX342
01316                                                                   DTSBX342
01317  S931-REF-IO.                                                     DTSBX342
01318      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBX342
01319                            FSKL-REC.                              DTSBX342
01320  S931-EXIT.                                                       DTSBX342
01321      EXIT.                                                        DTSBX342
01322                                                                   DTSBX342
01323  S999-ABEND.                                                      DTSBX342
01324      DISPLAY '*** DTSBE335 ABENDING.  '                           DTSBX342
01325              ABEND-MSG.                                           DTSBX342
01326                                                                   DTSBX342
01327      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBX342
01328  S999-EXIT.                                                       DTSBX342
01329      EXIT.                                                        DTSBX342
