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