00001  IDENTIFICATION DIVISION.                                         03/29/04
00002  PROGRAM-ID.             EFTBX100.                                EFTBX100
00003  AUTHOR.                 TRW.                                        LV255
00004  DATE-WRITTEN.           MARCH 2003.                                 CL**2
00005  DATE-COMPILED.                                                   EFTBX100
00006      SKIP3                                                        EFTBX100
00007 *****                                                             EFTBX100
00008 *                                                                 EFTBX100
00009 *                                                                 EFTBX100
00010 *    FUNCTION:  EXTRACT EMPLOYER DATA FOR IVR ELECTRONIC             CL**3
00011 *               PAYMENT (EFT). THE EXTRACT RUNS EVERY DAY.           CL**3
00012 *                                                                    CL236
00013 *    *** SPECIAL VERSION COMPILED IN HDVL TO USE NEW COPIES          CL182
00014 *    *** OF WGH FILE AND OTHER COMPONENTS CHANGED FOR WAGE           CL248
00015 *    *** UPDATES                                                     CL182
00016 *                                                                 EFTBX100
00017 *    MODIFICATION LOG:                                            EFTBX100
00018 *                                                                 EFTBX100
00019 *    03/07/2003  INITIAL DEVELOPMENT.                                CL**3
00020 *                REFERENCE: EFT                   PROGRAMM: GD       CL**3
00021 *                                                                 EFTBX100
00022 *    04/01/2003  PROGRAM MODIFIED TO ADD THE EMPLOYER STATUS         CL*39
00023 *                DATA, EMPLOYER RATE, REPORT DUE DATE, AND           CL*39
00024 *                PRIOR BALANCE DUE FOR IVR ELECTRONIC PAY-           CL*39
00025 *                MENT PROCESSING.                                    CL*39
00026 *                                               PROGRAMMER: RW1      CL*39
00027 *                                                                    CL234
00028 *    01/08/2004  MODIFIED PROCESS THAT DETERMINES CURRENT QTR        CL234
00029 *                REFERENCE: ENH051              PROGRAMMER: GD       CL234
00030 *                                                                    CL*39
00031 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL*39
00032 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL*39
00033 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL*39
00034 *                                                                 EFTBX100
00035 *  DESCRIPTION:                                                   EFTBX100
00036 *                                                                 EFTBX100
00037 *    SELECT EMPLOYERS MEETING EITHER OF THE FOLLOWING CRITERIA:      CL**3
00038 *       - THE EMPLOYER IS ACTIVE                                     CL**3
00039 *       - THE EMPLOYER IS INACTIVE AND HAS A BALANCE DUE.            CL**3
00040 *                                                                 EFTBX100
00041 *    RECORDS READ:                                                EFTBX100
00042 *                                                                 EFTBX100
00043 *      MASTER:                                                    EFTBX100
00044 *                                                                 EFTBX100
00045 *        MPRF                                                        CL**3
00046 *        MQTR                                                        CL**9
00047 *                                                                 EFTBX100
00048 *      ALTERNATE INDEX:                                           EFTBX100
00049 *                                                                 EFTBX100
00050 *        NONE.                                                    EFTBX100
00051 *                                                                 EFTBX100
00052 *      REFERENCE:                                                 EFTBX100
00053 *                                                                 EFTBX100
00054 *                                                                 EFTBX100
00055 *    RECORDS UPDATED:                                             EFTBX100
00056 *                                                                 EFTBX100
00057 *        NONE                                                        CL**3
00058 *                                                                    CL**3
00059 *    OUTPUT RECORDS WRITTEN:                                         CL**3
00060 *                                                                 EFTBX100
00061 *        EFT-EMP-STATUS  (RECORD LAYOUT: EFTFESR)                    CL125
00062 *                                                                    CL**3
00063 *    REPORT RECORDS WRITTEN:                                      EFTBX100
00064 *                                                                 EFTBX100
00065 *        NONE.                                                    EFTBX100
00066 *                                                                 EFTBX100
00067 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                EFTBX100
00068 *                                                                 EFTBX100
00069 *        NONE.                                                       CL**3
00070 *                                                                 EFTBX100
00071 *                                                                 EFTBX100
00072 *    MODULES CALLED:                                              EFTBX100
00073 *                                                                 EFTBX100
00074 *        DTSBU910  MASTER FILE I/O DRIVER.                        EFTBX100
00075 *        DTSBU946  WRITE VARIABLE OUTPUT RECORD(S).                  CL121
00076 *        DTSBU004  QUARTER CONVERSION/EDIT.                          CL*40
00077 *        DTSBU516  DETERMINE LIABILITY, DUE DATE,                    CL*40
00078 *                  AND RATE FOR A GIVEN QUARTER.                     CL*40
00079 *        DTSBU981  VSAM WAGES FILE I/O DRIVER.                       CL248
00080 *        DTSBU982  VSAM SSN-NAME FILE I/O DRIVER.                    CL188
00081 *                                                                    CL*75
00082 *****                                                             EFTBX100
00083                                                                   EFTBX100
00084  ENVIRONMENT DIVISION.                                            EFTBX100
00085  INPUT-OUTPUT SECTION.                                               CL**3
00086                                                                      CL**3
00087  FILE-CONTROL.                                                       CL**3
00088                                                                      CL**3
00089  DATA DIVISION.                                                   EFTBX100
00090  FILE SECTION.                                                       CL**3
00091                                                                      CL**3
00092  WORKING-STORAGE SECTION.                                         EFTBX100
000925 77  PAN-VALET PICTURE X(24) VALUE '255EFTBX100  03/29/04'.       EFTBX100
00093                                                                   EFTBX100
00094  01  WRK-AREA.                                                    EFTBX100
00095      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +100.   CL125
00096      05  ABEND-MSG                       PIC  X(60).              EFTBX100
00097      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'EFTBX100'.   CL125
00098                                                                   EFTBX100
00099      05  WRK-LAST-QTR-DAY            PIC S9(08)  COMP   VALUE +0.    CL234
00100      05  WRK-PERIOD-START            PIC S9(08)  COMP   VALUE +0.    CL234
00101      05  WRK-PERIOD-END              PIC S9(09)  COMP-3 VALUE +0.    CL234
00102                                                                      CL234
00103      05  WRK-EMP-SELECTED-IND            PIC  X(01).                 CL*62
00104          88  WRK-EMP-SELECTED-YES-88      VALUE 'Y'.                 CL*62
00105          88  WRK-EMP-SELECTED-NO-88       VALUE 'N'.                 CL*62
00106                                                                   EFTBX100
00107      05  WRK-MOPO-IND                  PIC X(01).                    CL217
00108          88 WRK-MOPO-FOUND-YES-88       VALUE 'Y'.                   CL217
00109          88 WRK-MOPO-FOUND-NO-88        VALUE 'N'.                   CL217
00110                                                                      CL217
00111      05  EFT-STATUS                  PIC  X(02).                     CL**3
00112          88 EFT-STATUS-OK-88      VALUE '00'.                        CL**3
00113                                                                   EFTBX100
00114      05  WRK-EMP-BALANCE          PIC S9(09)V99 COMP-3 VALUE +0.     CL**9
00115      05  WRK-TAX-DUE              PIC S9(09)V99 COMP-3 VALUE +0.     CL*13
00116      05  WRK-INT-DUE              PIC S9(09)V99 COMP-3 VALUE +0.     CL*13
00117      05  WRK-PEN-DUE              PIC S9(09)V99 COMP-3 VALUE +0.     CL*14
00118                                                                      CL**9
00119      05  WRK-MPRF-CNT             PIC S9(07) COMP-3 VALUE +0.        CL107
00120      05  WRK-TEST-CNT             PIC S9(07) COMP-3 VALUE +0.        CL128
00121      05  WRK-EFT-WRITTEN-CNTFESR PIC S9(07) COMP-3 VALUE +0.         CL123
00122      05  WRK-EFT-WRITTEN-CNTFEWR PIC S9(07) COMP-3 VALUE +0.         CL123
00123      05  WRK-SUCC-CNT             PIC S9(07) COMP-3 VALUE +0.        CL*75
00124      05  WRK-MISSING-WAGE-CNT     PIC S9(07) COMP-3 VALUE +0.        CL139
00125      05  WRK-MQTR-MISSING-CNT     PIC S9(07) COMP-3 VALUE +0.        CL183
00126      05  WRK-NO-WAGE-CNT          PIC S9(07) COMP-3 VALUE +0.        CL148
00127      05  WRK-WAGES-FOUND-CNT      PIC S9(07) COMP-3 VALUE +0.        CL149
00128      05  WRK-WAGES-OK-CNT         PIC S9(07) COMP-3 VALUE +0.        CL151
00129      05  WRK-WORKERS-CNT          PIC S9(07) COMP-3 VALUE +0.        CL152
00130      05  WRK-PCT                  PIC S9V9999 COMP-3 VALUE +0.       CL140
00131      05  WRK-BAL-DUE-CNT          PIC S9(07) COMP-3 VALUE +0.        CL**6
00132      05  WRK-TOT-BAL-DUE          PIC S9(11)V99 COMP-3 VALUE +0.     CL**6
00133                                                                      CL107
00134      05  WRK-SSN-ERROR            PIC S9(07) COMP-3 VALUE +0.        CL107
00135      05  WRK-SSN-ERROR-DISP       PIC --,---,--9.                    CL108
00136      05  WRK-AMT-DISP             PIC --,---,---,--9.99.             CL**7
00137      05  WRK-AMT-DISP1            PIC --,---,---,--9.99.             CL*11
00138      05  WRK-PCT-DISP             PIC ZZ9.9999-.                     CL142
00139      05  WRK-CURR-YRQ             PIC S9(05) COMP-3 VALUE +0.        CL*37
00140      05  WRK-CURR-YRQ-START       PIC S9(09) COMP-3 VALUE +0.        CL181
00141      05  WRK-CURR-YRQ-END         PIC S9(09) COMP-3 VALUE +0.        CL181
00142      05  WRK-LAST-RCVD-YRQ        PIC S9(05) COMP-3 VALUE +0.        CL111
00143      05  WRK-EARLIEST-YRQ         PIC S9(05) COMP-3 VALUE +0.        CL111
00144      05  WRK-DISP-CURR-YRQ        PIC X(05).                         CL*37
00145      05  WRK-MQTR-YTD-WAGE        PIC S9(11)V99 COMP-3 VALUE +0.     CL135
00146      05  WRK-WGH-YTD-WAGE         PIC S9(11)V99 COMP-3 VALUE +0.     CL248
00147                                                                      CL159
00148      05  WRK-CURR-QTR-AREA.                                          CL160
00149          15  WRK-CURR-QTR-5-X.                                       CL159
00150              20  WRK-CURR-QTR-5-YR PIC  9(04).                       CL159
00151              20  WRK-CURR-QTR-5-Q  PIC  9(01).                       CL159
00152          15  WRK-CURR-QTR-5-9 REDEFINES WRK-CURR-QTR-5-X             CL159
00153                                     PIC  9(05).                      CL159
00154                                                                      CL159
00155      05  WRK-FIRST-QTR-AREA.                                         CL*72
00156          15  WRK-FIRST-QTR-5-X.                                      CL*72
00157              20  WRK-FIRST-QTR-5-YR PIC  9(04).                      CL*72
00158              20  WRK-FIRST-QTR-5-Q  PIC  9(01).                      CL*72
00159          15  WRK-FIRST-QTR-5-9 REDEFINES WRK-FIRST-QTR-5-X           CL*72
00160                                     PIC  9(05).                      CL*72
00161                                                                      CL*72
00162      05  WRK-FOURTH-QTR-AREA.                                        CL*72
00163          15  WRK-FOURTH-QTR-5-X.                                     CL*72
00164              20  WRK-FOURTH-QTR-5-YR PIC 9(04).                      CL*72
00165              20  WRK-FOURTH-QTR-5-Q PIC  9(01).                      CL*72
00166          15  WRK-FOURTH-QTR-5-9 REDEFINES WRK-FOURTH-QTR-5-X         CL*72
00167                                     PIC  9(05).                      CL*72
00168                                                                      CL*72
00169      05  WRK-SSN-ERROR-IND          PIC  X(01).                      CL*72
00170          88  WRK-SSN-ERROR-YES-88          VALUE 'Y'.                CL*72
00171          88  WRK-SSN-ERROR-NO-88           VALUE 'N'.                CL*72
00172                                                                      CL*72
00173      05  TBL-SUB                  PIC S9(04) COMP.                   CL*72
00174      05  TBL-CNT                  PIC S9(04) COMP VALUE +0.          CL*72
00175      05  TBL-MAX                  PIC S9(04) COMP                    CL*72
00176                                          VALUE +5000.                CL110
00177      05  TBL-HIGHEST              PIC S9(04) COMP VALUE +0.          CL110
00178      05  SSN-SUB                  PIC S9(04) COMP.                   CL*72
00179      05  NXT-SUB                  PIC S9(04) COMP.                   CL*72
00180      05  WRK-MAX-SSN              PIC S9(09) COMP-3 VALUE +0.        CL*72
00181                                                                      CL*72
00182      05  WRK-INDEX-IND                      PIC  X(01).              CL*72
00183          88  WRK-INDEX-NULL-88           VALUE '0'.                  CL*72
00184          88  WRK-INDEX-POSITION-FOUND-88 VALUE '1'.                  CL*72
00185          88  WRK-INDEX-SSN-FOUND-88      VALUE '2'.                  CL*72
00186          88  WRK-INDEX-FOUND-88          VALUE '1' '2'.              CL*72
00187                                                                      CL*72
00188  01  WAGE-TABLE-AREA.                                                CL*72
00189      05  WAGE-TABLE OCCURS 5000 TIMES.                               CL110
00190          10  WAGE-SSN               PIC  9(09).                      CL*72
00191          10  WAGE-NAME-AREA.                                         CL*72
00192              15  WAGE-LAST-NAME     PIC  X(20).                      CL185
00193              15  WAGE-FIRST-NAME    PIC  X(15).                      CL*72
00194              15  WAGE-MI            PIC  X(01).                      CL*72
00195          10  WAGE-YTD-SUM           PIC S9(11)V9(02).                CL*72
00196      EJECT                                                        EFTBX100
00197                                                                      CL*72
00198  01  MSG-AREA.                                                    EFTBX100
00199      05  MSG1-AREA.                                               EFTBX100
00200          10  MSG1-ID                PIC  X(03)  VALUE '800'.         CL**4
00201          10  MSG1-TEXT.                                           EFTBX100
00202              15  FILLER             PIC  X(40)                    EFTBX100
00203                VALUE '                                        '.     CL**4
00204              15  FILLER             PIC  X(40)                    EFTBX100
00205                VALUE '                                        '.  EFTBX100
00206                                                                      CL209
00207  01  TALLY-AREA.                                                     CL209
00208      05  SLASH-NAME.                                                 CL212
00209          10  SLASH-NAME-CHAR OCCURS 34 TIMES PIC X(01).              CL212
00210      05  FIRST-NAME          PIC  X(15)      VALUE SPACE.            CL210
00211      05  MIDDLE-INIT         PIC  X(01)      VALUE SPACE.            CL212
00212      05  LAST-NAME           PIC  X(20)      VALUE SPACE.            CL210
00213      05  NSUB                PIC S9(04) COMP.                        CL240
00214      05  FSUB                PIC S9(04) COMP.                        CL240
00215      05  LSUB                PIC S9(04) COMP.                        CL240
00216      05  LAST-NAME-COMPLETE-IND  PIC  X(01).                         CL240
00217          88  LAST-NAME-COMPLETE-YES-88  VALUE 'Y'.                   CL240
00218          88  LAST-NAME-COMPLETE-NO-88  VALUE 'N'.                    CL240
00219      05  FIRST-NAME-COMPLETE-IND  PIC  X(01).                        CL240
00220          88  FIRST-NAME-COMPLETE-YES-88  VALUE 'Y'.                  CL240
00221          88  FIRST-NAME-COMPLETE-NO-88  VALUE 'N'.                   CL240
00222      05  MID-INIT-COMPLETE-IND  PIC  X(01).                          CL242
00223          88  MID-INIT-COMPLETE-YES-88  VALUE 'Y'.                    CL242
00224          88  MID-INIT-COMPLETE-NO-88  VALUE 'N'.                     CL242
00225      05  D-S                 PIC  X(02)      VALUE SPACE.            CL209
00226      05  SLASH-TALLY         PIC S9(04) COMP.                        CL209
00227      05  LAST-NAME-LEN       PIC S9(04) COMP.                        CL209
00228      05  FIRST-MID-LEN       PIC S9(04) COMP.                        CL212
00229      05  FIRST-NAME-LEN      PIC S9(04) COMP.                        CL212
00230      05  TOTAL-LEN           PIC S9(04) COMP.                        CL209
00231      EJECT                                                        EFTBX100
00232  01  FHDR-REC.                                                       CL123
00233  ++INCLUDE EFTIFHDR                                                  CL169
00234                                                                      CL*18
00235  01  FGRD-REC.                                                       CL179
00236  ++INCLUDE EFTIFGRD                                                  CL179
00237                                                                      CL179
00238  01  FESR-REC.                                                       CL123
00239  ++INCLUDE EFTIFESR                                                  CL123
00240                                                                      CL**8
00241  01  FEWR-REC.                                                       CL123
00242  ++INCLUDE EFTIFEWR                                                  CL123
00243                                                                      CL*72
00244  01  FTRL-REC.                                                       CL123
00245  ++INCLUDE EFTIFTRL                                                  CL169
00246                                                                      CL*18
00247  01  L001-LINK-AREA.                                                 CL235
00248  ++INCLUDE DTSIL001                                                  CL235
00249                                                                      CL234
00250  01  L003-LINK-AREA.                                                 CL234
00251  ++INCLUDE DTSIL003                                                  CL234
00252                                                                      CL234
00253  01  L004-LINK-AREA.                                                 CL*33
00254  ++INCLUDE DTSIL004                                                  CL*33
00255                                                                      CL*33
00256  01  L516-LINK-AREA.                                                 CL*33
00257  ++INCLUDE DTSIL516                                                  CL*33
00258                                                                      CL*32
00259  01  L600-LINK-AREA.                                                 CL*32
00260  ++INCLUDE DTSIL600                                                  CL*32
00261                                                                      CL*16
00262  01  L101-LINK-AREA.                                                 CL**8
00263  ++INCLUDE DTSIL101                                                  CL**8
00264                                                                      CL**9
00265  01  L910-LINK-AREA.                                                 CL**9
00266  ++INCLUDE DTSIL910                                                  CL**9
00267      SKIP3                                                           CL**9
00268  01  MSKL-REC.                                                       CL**9
00269  ++INCLUDE DTSIMSKL                                                  CL**9
00270      SKIP3                                                           CL**9
00271  01  MQTR-REC.                                                       CL**9
00272  ++INCLUDE DTSIMQTR                                                  CL**9
00273      SKIP3                                                           CL*28
00274  01  MFAE-REC.                                                       CL*28
00275  ++INCLUDE DTSIMFAE                                                  CL*28
00276      SKIP3                                                           CL*48
00277  01  MOPO-REC.                                                       CL216
00278  ++INCLUDE DTSIMOPO                                                  CL216
00279      EJECT                                                           CL*48
00280  01  MTAD-REC.                                                       CL216
00281  ++INCLUDE DTSIMTAD                                                  CL216
00282      EJECT                                                           CL216
00283  01  L931-LINK-AREA.                                                 CL179
00284  ++INCLUDE DTSIL931                                                  CL179
00285      EJECT                                                           CL179
00286  01  FSKL-REC.                                                       CL179
00287  ++INCLUDE DTSIFSKL                                                  CL179
00288      EJECT                                                           CL179
00289  01  FCYR-REC.                                                       CL179
00290  ++INCLUDE DTSIFCYR                                                  CL179
00291                                                                      CL179
00292  01  L981-LINK-AREA.                                                 CL248
00293  ++INCLUDE DTSIL981                                                  CL248
00294      SKIP3                                                           CL*72
00295  01  WWGH-REC.                                                       CL248
00296  ++INCLUDE DTSIWWGH                                                  CL248
00297      EJECT                                                           CL*72
00298  01  L982-LINK-AREA.                                                 CL185
00299  ++INCLUDE DTSIL982                                                  CL185
00300      SKIP3                                                           CL185
00301  01  WNAM-REC.                                                       CL185
00302  ++INCLUDE DTSIWNAM                                                  CL185
00303      EJECT                                                           CL185
00304                                                                      CL*72
00305  LINKAGE SECTION.                                                 EFTBX100
00306      SKIP3                                                        EFTBX100
00307  01  LECM-LINK-AREA.                                              EFTBX100
00308  ++INCLUDE DTSILECM                                               EFTBX100
00309                                                                      CL**8
00310  01  MPRF-LINK-REC.                                               EFTBX100
00311  ++INCLUDE DTSIMPRF                                               EFTBX100
00312      EJECT                                                        EFTBX100
00313  PROCEDURE DIVISION USING LECM-LINK-AREA                          EFTBX100
00314                           MPRF-LINK-REC.                          EFTBX100
00315                                                                   EFTBX100
00316      EVALUATE TRUE                                                EFTBX100
00317        WHEN LECM-PROCESS-88                                          CL*22
00318          PERFORM P0000-PROCESS THRU P0000-EXIT                    EFTBX100
00319                                                                   EFTBX100
00320        WHEN LECM-INITIALIZE-88                                       CL*22
00321          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 EFTBX100
00322                                                                   EFTBX100
00323        WHEN LECM-TERMINATE-88                                        CL*22
00324          PERFORM T0000-TERMINATE THRU T0000-EXIT                  EFTBX100
00325                                                                   EFTBX100
00326        WHEN OTHER                                                    CL*22
00327          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            EFTBX100
00328            TO ABEND-MSG                                           EFTBX100
00329          PERFORM S999-ABEND THRU S999-EXIT                           CL*22
00330      END-EVALUATE.                                                   CL*22
00331                                                                      CL*22
00332      GOBACK.                                                      EFTBX100
00333      EJECT                                                        EFTBX100
00334  I0000-INITIALIZE.                                                EFTBX100
00335      MOVE LECM-TRACE-IND        TO  L910-TRACE-IND                   CL*72
00336                                     L981-TRACE-IND                   CL248
00337                                     L982-TRACE-IND.                  CL186
00338      MOVE WRK-MOD-NAME          TO  L910-MOD-NAME                    CL**9
00339                                     L981-MOD-NAME                    CL248
00340                                     L982-MOD-NAME.                   CL186
00341                                                                      CL*73
00342      PERFORM I1000-SUBJECT-YRQ    THRU I1000-EXIT.                   CL*73
00343                                                                      CL*73
00344      PERFORM I2000-OPEN-FILE      THRU I2000-EXIT.                   CL*73
00345                                                                   EFTBX100
00346      SET LECM-MST-OPEN-READ-88    TO TRUE.                           CL*73
00347      SET LECM-REF-OPEN-READ-88    TO TRUE.                           CL179
00348                                                                   EFTBX100
00349      MOVE LENGTH OF FHDR-REC        TO FHDR-LENGTH.                  CL179
00350      MOVE LENGTH OF FGRD-REC        TO FGRD-LENGTH.                  CL179
00351      MOVE LENGTH OF FTRL-REC        TO FTRL-LENGTH.                  CL179
00352      MOVE LENGTH OF FESR-REC        TO FESR-LENGTH.                  CL179
00353      MOVE LENGTH OF FEWR-REC        TO FEWR-LENGTH.                  CL179
00354                                                                      CL179
00355      PERFORM I3000-WRITE-GLOBAL-REC THRU I3000-EXIT.                 CL179
00356      PERFORM I4000-WRITE-HEADER     THRU I4000-EXIT.                 CL179
00357                                                                      CL*19
00358  I0000-EXIT.                                                      EFTBX100
00359      EXIT.                                                        EFTBX100
00360                                                                      CL*73
00361  I1000-SUBJECT-YRQ.                                                  CL*73
00362      PERFORM I1100-LAST-QTR-WRK-DAY  THRU I1100-EXIT.                CL234
00363 ***  MOVE LECM-SYS-DATE     TO L004-DATE.                            CL234
00364 *&   SET CURRENT DATE FOR TESTING                                    CL163
00365 *&   MOVE 20021001          TO L004-DATE.                            CL179
00366                                                                      CL234
00367      MOVE LECM-CURR-RUN-DATE     TO L001-FED-8-DATE-9.               CL253
00368      PERFORM S001-FROM-FED-8     THRU S001-EXIT.                     CL253
00369      DISPLAY 'CURRENT DATE IS:    ' L001-SLASH-8-DATE.               CL253
00370                                                                      CL253
00371      MOVE LECM-CURR-RUN-DATE   TO L004-DATE.                         CL247
00372      PERFORM S004-FROM-DATE    THRU S004-EXIT.                       CL247
00373      SUBTRACT +1            FROM L004-ABS-QTR.                       CL247
00374      PERFORM S004-FROM-ABS  THRU S004-EXIT.                          CL247
00375      MOVE L004-QTR-5-9      TO WRK-FIRST-QTR-5-9                     CL159
00376                                WRK-FOURTH-QTR-5-9                    CL159
00377                                WRK-CURR-YRQ.                         CL159
00378                                                                      CL159
00379      MOVE L004-QTR-START-DATE  TO WRK-CURR-YRQ-START.                CL179
00380      MOVE L004-QTR-END-DATE    TO WRK-CURR-YRQ-END.                  CL179
00381                                                                      CL179
00382      MOVE WRK-CURR-YRQ      TO WRK-CURR-QTR-5-9.                     CL161
00383                                                                      CL159
00384      DISPLAY 'SUBJECT QUARTER IS: ' L004-SLASH-5-QTR                 CL253
00385         '  START ' WRK-CURR-YRQ-START                                CL234
00386         '  END ' WRK-CURR-YRQ-END.                                   CL234
00387                                                                      CL159
00388      IF WRK-CURR-QTR-5-Q = 1                                         CL159
00389         SUBTRACT 1 FROM WRK-FIRST-QTR-5-YR                           CL159
00390         SUBTRACT 1 FROM WRK-FOURTH-QTR-5-YR                          CL160
00391      END-IF.                                                         CL159
00392                                                                      CL159
00393      MOVE 1                 TO WRK-FIRST-QTR-5-Q.                    CL*73
00394      MOVE 4                 TO WRK-FOURTH-QTR-5-Q.                   CL*73
00395                                                                      CL*73
00396      MOVE WRK-FIRST-QTR-5-9 TO L004-QTR-5-9.                         CL111
00397      PERFORM S004-FROM-5    THRU S004-EXIT.                          CL111
00398      SUBTRACT +8 FROM L004-ABS-QTR.                                  CL111
00399      PERFORM S004-FROM-ABS  THRU S004-EXIT.                          CL111
00400      MOVE L004-QTR-5-9      TO WRK-EARLIEST-YRQ.                     CL111
00401                                                                      CL111
00402      IF WRK-CURR-QTR-5-Q = 1                                         CL159
00403         DISPLAY 'SUBJECT QTR IS FIRST'                               CL255
00404         DISPLAY 'USING PREVIOUS YEAR WAGES TO FIND SSNS'.            CL159
00405                                                                      CL159
00406      DISPLAY 'FIRST WAGE QUARTER: ' WRK-FIRST-QTR-5-9.               CL254
00407      DISPLAY 'LAST WAGE QUARTER : ' WRK-FOURTH-QTR-5-9.              CL254
00408      DISPLAY 'LAST REPORT CUTOFF QTR       : ' WRK-EARLIEST-YRQ.     CL111
00409                                                                      CL*73
00410  I1000-EXIT.                                                         CL*73
00411      EXIT.                                                           CL*73
00412                                                                      CL*73
00413  I1100-LAST-QTR-WRK-DAY.                                             CL234
00414      MOVE LECM-CURR-RUN-DATE     TO L004-DATE.                       CL247
00415      PERFORM S004-FROM-DATE      THRU S004-EXIT.                     CL234
00416      MOVE L004-QTR-END-DATE      TO L001-FED-8-DATE-9.               CL234
00417      PERFORM S001-FROM-FED-8     THRU S001-EXIT.                     CL234
00418      MOVE L001-JUL-ABS-DAY       TO WRK-LAST-QTR-DAY.                CL234
00419                                                                      CL234
00420      MOVE L004-QTR-START-DATE    TO L001-FED-8-DATE-9.               CL234
00421      PERFORM S001-FROM-FED-8     THRU S001-EXIT.                     CL234
00422      MOVE L001-JUL-ABS-DAY       TO WRK-PERIOD-START.                CL234
00423                                                                      CL234
00424      PERFORM I1110-PREV-WRK-DAY  THRU I1110-EXIT.                    CL234
00425                                                                      CL234
00426  I1100-EXIT.                                                         CL234
00427      EXIT.                                                           CL234
00428                                                                      CL234
00429  I1110-PREV-WRK-DAY.                                                 CL234
00430      MOVE WRK-LAST-QTR-DAY          TO L001-JUL-ABS-DAY.             CL234
00431      PERFORM S001-FROM-ABS-DAY      THRU S001-EXIT.                  CL234
00432      MOVE L001-FED-8-DATE-9         TO L003-DATE                     CL234
00433      PERFORM S003-AGENCY-DAY        THRU S003-EXIT                   CL234
00434      IF L003-IS-WORK-DAY                                             CL234
00435         NEXT SENTENCE                                                CL234
00436      ELSE                                                            CL234
00437         PERFORM                                                      CL234
00438           UNTIL L003-IS-WORK-DAY                                     CL234
00439           OR L001-JUL-ABS-DAY < WRK-PERIOD-START                     CL234
00440              SUBTRACT  +1  FROM L001-JUL-ABS-DAY                     CL234
00441              PERFORM S001-FROM-ABS-DAY THRU S001-EXIT                CL234
00442              MOVE L001-FED-8-DATE-9 TO L003-DATE                     CL234
00443              PERFORM S003-AGENCY-DAY THRU S003-EXIT                  CL234
00444         END-PERFORM                                                  CL234
00445      END-IF.                                                         CL234
00446                                                                      CL234
00447      IF L001-JUL-ABS-DAY < WRK-PERIOD-START                          CL234
00448          DISPLAY 'CANNOT FIND PREVIOUS WORK DAY'                     CL234
00449      ELSE                                                            CL234
00450         MOVE L001-FED-8-DATE-9      TO WRK-PERIOD-END                CL234
00451      END-IF.                                                         CL234
00452                                                                      CL234
00453  I1110-EXIT.                                                         CL234
00454      EXIT.                                                           CL234
00455                                                                      CL234
00456  I2000-OPEN-FILE.                                                    CL**3
00457 **   OPEN OUTPUT EFT-EMP-STATUS.                                     CL121
00458 **   IF EFT-STATUS-OK-88                                             CL121
00459 **      NEXT SENTENCE                                                CL121
00460 **   ELSE                                                            CL121
00461 **      DISPLAY 'OPEN ERROR ON EFT FILE ' EFT-STATUS                 CL121
00462 **      PERFORM S999-ABEND THRU S999-EXIT.                           CL121
00463                                                                      CL*52
00464      PERFORM S981A-OPEN-READ THRU S981A-EXIT.                        CL248
00465      PERFORM S982C-OPEN-READ THRU S982C-EXIT.                        CL186
00466                                                                      CL*73
00467  I2000-EXIT.                                                         CL**3
00468      EXIT.                                                           CL**3
00469                                                                      CL*19
00470  I3000-WRITE-GLOBAL-REC.                                             CL179
00471      PERFORM I3100-TAX-WAGE-BASE   THRU I3100-EXIT.                  CL179
00472                                                                      CL179
00473      SET FHDR-TYPE-GLOBAL-DATA-88  TO TRUE.                          CL179
00474      SET FHDR-SUB-TYPE-HEADER-88   TO TRUE.                          CL123
00475      MOVE LECM-SYS-DATE            TO FHDR-CREATE-DATE.              CL123
00476      PERFORM S946-WRITE-HEADER THRU S946-EXIT.                       CL179
00477                                                                      CL*73
00478      SET FGRD-TYPE-GLOBAL-DATA-88  TO TRUE.                          CL179
00479      SET FGRD-SUB-TYPE-DATA-88     TO TRUE.                          CL179
00480      MOVE WRK-CURR-YRQ             TO FGRD-CURR-QTR.                 CL179
00481      MOVE WRK-CURR-YRQ-START       TO FGRD-CURR-QTR-START.           CL179
00482      MOVE WRK-CURR-YRQ-END         TO FGRD-CURR-QTR-END.             CL179
00483      MOVE FCYR-TAXABLE-WAGE-BASE   TO FGRD-TAXABLE-WAGE-BASE.        CL179
00484      PERFORM S946-WRITE-GLOBAL THRU S946-EXIT.                       CL179
00485                                                                      CL179
00486      SET FTRL-TYPE-GLOBAL-DATA-88  TO TRUE.                          CL179
00487      SET FTRL-SUB-TYPE-TRAILER-88 TO TRUE.                           CL179
00488      MOVE 1                       TO FTRL-RECORD-CNT.                CL179
00489      MOVE ZERO                     TO FTRL-TOT-AMOUNT.               CL179
00490      PERFORM S946-WRITE-TRAILER THRU S946-EXIT.                      CL179
00491                                                                      CL179
00492  I3000-EXIT.                                                         CL*19
00493      EXIT.                                                           CL*19
00494                                                                      CL*19
00495  I3100-TAX-WAGE-BASE.                                                CL179
00496      MOVE LOW-VALUES TO FCYR-KEY-AREA.                               CL179
00497      SET FCYR-CYR-88 TO TRUE.                                        CL179
00498      MOVE WRK-CURR-YRQ   TO L004-QTR-5-9.                            CL179
00499      MOVE L004-QTR-5-YR TO FCYR-YR.                                  CL179
00500      MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA.                            CL179
00501                                                                      CL179
00502      PERFORM S931-READ THRU S931-EXIT.                               CL179
00503      IF L931-NO-REC-88                                               CL179
00504         DISPLAY 'CANNOT FIND TAXABLE WAGE BASE     '                 CL179
00505         PERFORM S999-ABEND        THRU S999-EXIT                     CL179
00506      ELSE                                                            CL179
00507         MOVE FSKL-REC TO FCYR-REC.                                   CL179
00508                                                                      CL179
00509  I3100-EXIT.                                                         CL179
00510      EXIT.                                                           CL179
00511                                                                      CL179
00512  I4000-WRITE-HEADER.                                                 CL179
00513                                                                      CL179
00514      SET FHDR-TYPE-EMP-STATUS-88   TO TRUE.                          CL179
00515      SET FHDR-SUB-TYPE-HEADER-88   TO TRUE.                          CL179
00516                                                                      CL179
00517      MOVE LECM-SYS-DATE            TO FHDR-CREATE-DATE.              CL179
00518 ***  MOVE SPACES                   TO FHDR-FILLER.                   CL179
00519                                                                      CL179
00520      PERFORM S946-WRITE-HEADER THRU S946-EXIT.                       CL179
00521 *    WRITE EFT-REC                FROM HEADER-REC.                   CL179
00522 *    IF EFT-STATUS-OK-88                                             CL179
00523 *       NEXT SENTENCE                                                CL179
00524 **   ELSE                                                            CL179
00525 *       DISPLAY 'BAD WRITE ON EFT Y810 HEADER REC. ' EFT-STATUS      CL179
00526 *       PERFORM S999-ABEND        THRU S999-EXIT.                    CL179
00527                                                                      CL179
00528      SET FHDR-TYPE-WAGE-EXP-88     TO TRUE.                          CL179
00529      SET FHDR-SUB-TYPE-HEADER-88   TO TRUE.                          CL179
00530                                                                      CL179
00531      MOVE LECM-SYS-DATE            TO FHDR-CREATE-DATE.              CL179
00532 ***  MOVE SPACES                   TO FHDR-FILLER.                   CL179
00533                                                                      CL179
00534      PERFORM S946-WRITE-HEADER THRU S946-EXIT.                       CL179
00535  I4000-EXIT.                                                         CL179
00536      EXIT.                                                           CL179
00537                                                                      CL179
00538  P0000-PROCESS.                                                   EFTBX100
00539      ADD +1 TO WRK-MPRF-CNT.                                         CL197
00540      SET WRK-EMP-SELECTED-YES-88 TO TRUE.                            CL*62
00541                                                                      CL*62
00542 *& >> COUNTER ADDED FOR TESTING  <<                                  CL*62
00543 *    IF WRK-MPRF-CNT > +100                                          CL230
00544 *        GO TO P0000-EXIT.                                           CL230
00545 *&                                                                   CL*62
00546                                                                      CL**3
00547 *&                                                                   CL199
00548 *    IF MPRF-EMP-NO = 139037                                         CL253
00549 *       DISPLAY '** P0000 ' MPRF-EMP-NO                              CL253
00550 *          '  MPRF ENROLLED ' MPRF-EFT-ENROLLED-IND                  CL253
00551 *    ELSE                                                            CL253
00552 *       IF MPRF-EFT-ENROLLED-YES-88                                  CL253
00553 *          DISPLAY '** ENROLLED ' MPRF-EMP-NO.                       CL253
00554 *&                                                                   CL199
00555      IF MPRF-CLASS-SUB-88                                            CL*33
00556          NEXT SENTENCE                                               CL*33
00557      ELSE                                                            CL*33
00558          GO TO P0000-EXIT.                                           CL*33
00559                                                                      CL*60
00560      PERFORM P1000-LIABILITY-DATA   THRU P1000-EXIT.                 CL*60
00561 *&                                                                   CL199
00562      IF MPRF-EMP-NO = 139037                                         CL251
00563         DISPLAY '** P1000 ' MPRF-EMP-NO                              CL199
00564            '  ' WRK-EMP-SELECTED-IND.                                CL199
00565 *&                                                                   CL199
00566      IF WRK-EMP-SELECTED-NO-88                                       CL*62
00567          GO TO P0000-EXIT.                                           CL178
00568                                                                      CL*62
00569      PERFORM P2000-FISCAL-AGENT     THRU P2000-EXIT.                 CL*60
00570                                                                      CL*70
00571      PERFORM P3000-BALANCE-DUE      THRU P3000-EXIT.                 CL*60
00572 *&                                                                   CL199
00573      IF MPRF-EMP-NO = 139037                                         CL251
00574         DISPLAY '** P3000 ' MPRF-EMP-NO                              CL199
00575            '  ' WRK-EMP-SELECTED-IND.                                CL199
00576 *&                                                                   CL199
00577      IF WRK-EMP-SELECTED-NO-88                                       CL111
00578          GO TO P0000-EXIT.                                           CL178
00579                                                                      CL*70
00580      PERFORM P4000-CURR-QTR-DATA    THRU P4000-EXIT.                 CL*60
00581                                                                      CL*70
00582      PERFORM P5000-ADDRESS          THRU P5000-EXIT.                 CL*60
00583 *&                                                                   CL199
00584      IF MPRF-EMP-NO = 139037                                         CL251
00585         DISPLAY '** P4000 ' MPRF-EMP-NO                              CL199
00586            '  ' WRK-EMP-SELECTED-IND.                                CL199
00587 *&                                                                   CL199
00588      IF WRK-EMP-SELECTED-NO-88                                       CL*62
00589          GO TO P0000-EXIT.                                           CL178
00590                                                                      CL*62
00591      PERFORM P5500-CONTACT          THRU P5500-EXIT.                 CL205
00592 *&                                                                   CL129
00593 *    IF WRK-TEST-CNT < +100                                          CL232
00594 *        ADD +1 TO WRK-TEST-CNT                                      CL232
00595 *        GO TO P0000-EXIT                                            CL232
00596 *    ELSE                                                            CL232
00597 *        MOVE +0 TO WRK-TEST-CNT.                                    CL232
00598 *&                                                                   CL129
00599      ADD +1 TO WRK-MPRF-CNT.                                         CL195
00600      PERFORM P6000-BUILD-FESR-REC   THRU P6000-EXIT.                 CL123
00601                                                                      CL*81
00602      PERFORM P7000-GET-WAGE-DATA    THRU P7000-EXIT.                 CL254
00603      IF TBL-CNT > ZERO                                               CL254
00604         IF WRK-SSN-ERROR-NO-88                                       CL254
00605            PERFORM P8000-WRITE-WAGES      THRU P8000-EXIT.           CL254
00606                                                                      CL196
00607 *&   TURN OFF TAXABLE WAGE CALCULATION FOR ALL EMPLOYERS             CL249
00608      SET FESR-CALC-TAX-WAGE-NO-88 TO TRUE.                           CL249
00609 *&                                                                   CL249
00610                                                                      CL249
00611 *&                                                                   CL199
00612      IF MPRF-EMP-NO = 139037                                         CL251
00613         DISPLAY '** WRITE ' MPRF-EMP-NO                              CL199
00614            '  ' WRK-EMP-SELECTED-IND.                                CL199
00615 *&                                                                   CL199
00616      ADD +1 TO WRK-EFT-WRITTEN-CNTFESR.                              CL196
00617      PERFORM S946-WRITE-FESR THRU S946-EXIT.                         CL254
00618                                                                      CL135
00619  P0000-EXIT.                                                      EFTBX100
00620      EXIT.                                                        EFTBX100
00621                                                                   EFTBX100
00622  P1000-LIABILITY-DATA.                                               CL*60
00623 *&                                                                   CL250
00624      IF MPRF-EMP-NO = 139037                                         CL251
00625         DISPLAY '** P1000 - 1 ' MPRF-EMP-NO                          CL250
00626            '  ' WRK-EMP-SELECTED-IND                                 CL250
00627      END-IF.                                                         CL250
00628 *&                                                                   CL250
00629      IF MPRF-SUSPEND-COLL-YES-88                                     CL111
00630      OR MPRF-WRITE-OFF-DATE > ZERO                                   CL112
00631      OR MPRF-PURSUED-RPT-CNT > 2                                     CL111
00632         IF MPRF-EFT-ENROLLED-NO-88                                   CL178
00633            MOVE 'N'  TO WRK-EMP-SELECTED-IND                         CL178
00634            GO TO P1000-EXIT                                          CL178
00635         END-IF                                                       CL178
00636      END-IF.                                                         CL111
00637                                                                      CL111
00638      IF MPRF-STATUS-INACT-88                                         CL127
00639         IF MPRF-TOT-BALANCE-AMT = ZERO                               CL127
00640            IF MPRF-EFT-ENROLLED-NO-88                                CL178
00641               MOVE 'N'  TO WRK-EMP-SELECTED-IND                      CL178
00642               GO TO P1000-EXIT                                       CL178
00643            END-IF                                                    CL178
00644         END-IF                                                       CL127
00645      END-IF.                                                         CL127
00646                                                                      CL159
00647      IF MPRF-CLASS-RATED-88                                          CL*60
00648           SET FESR-EMPL-RATED-88   TO TRUE                           CL123
00649      ELSE                                                            CL*60
00650         IF MPRF-CLASS-SELF-INS-88                                    CL*60
00651            SET FESR-EMPL-SELF-INSURED-88   TO TRUE                   CL123
00652         ELSE                                                         CL*60
00653            MOVE 'N'  TO WRK-EMP-SELECTED-IND                         CL*63
00654            GO TO P1000-EXIT                                          CL*60
00655         END-IF                                                       CL*60
00656      END-IF.                                                         CL*60
00657                                                                      CL*62
00658      MOVE WRK-CURR-YRQ      TO  L516-YRQ.                            CL*60
00659      PERFORM S516-LIABILITY THRU S516-EXIT.                          CL*60
00660                                                                      CL*60
00661      IF L516-LIABLE-88                                               CL*60
00662         SET FESR-LIAB-YES-88 TO TRUE                                 CL123
00663      ELSE                                                            CL*60
00664         SET FESR-LIAB-NO-88   TO TRUE                                CL123
00665      END-IF.                                                         CL*60
00666                                                                      CL*60
00667 *&                                                                   CL250
00668      IF MPRF-EMP-NO = 139037                                         CL251
00669         DISPLAY '** P1000 - 4 ' MPRF-EMP-NO                          CL250
00670            '  ' WRK-CURR-YRQ                                         CL250
00671            '  ' L516-LIABLE-IND                                      CL250
00672            '  ' L516-RATE-IND                                        CL250
00673      END-IF.                                                         CL250
00674 *&                                                                   CL250
00675      IF L516-ANN-SCHED-88                                            CL*60
00676         SET FESR-ANN-SCHED-88    TO TRUE                             CL123
00677      ELSE                                                            CL*60
00678         SET FESR-QTRLY-SCHED-88 TO TRUE                              CL123
00679      END-IF.                                                         CL*60
00680                                                                      CL*60
00681      MOVE ZEROS TO FESR-EMPLOYER-RATE.                               CL123
00682                                                                      CL*60
00683      IF MPRF-CLASS-RATED-88                                          CL*60
00684         IF L516-RATE-88                                              CL*60
00685             MOVE L516-UI-RATE TO FESR-EMPLOYER-RATE                  CL123
00686         ELSE                                                         CL*60
00687            SET FESR-LIAB-NO-88   TO TRUE.                            CL123
00688                                                                      CL*60
00689      MOVE L516-DEFAULT-RPT-DUE-DATE TO FESR-REPORT-DUE-DATE.         CL123
00690  P1000-EXIT.                                                         CL*60
00691      EXIT.                                                           CL*60
00692                                                                      CL*60
00693  P2000-FISCAL-AGENT.                                                 CL*60
00694      MOVE LOW-VALUES                TO  MFAE-KEY-AREA.               CL*60
00695      MOVE MPRF-EMP-NO               TO  MFAE-EMP-NO.                 CL*60
00696      SET MFAE-FAE-88                TO  TRUE.                        CL*60
00697      SET MFAE-SERVICE-UC30-88       TO  TRUE.                        CL*60
00698      MOVE MFAE-KEY-AREA             TO  MSKL-KEY-AREA.               CL*60
00699                                                                      CL*60
00700      PERFORM S910-READ        THRU  S910-EXIT.                       CL*60
00701                                                                      CL*60
00702      IF L910-NO-REC-88                                               CL*60
00703          SET FESR-FISCAL-AGENT-NO-88   TO TRUE                       CL123
00704      ELSE                                                            CL*60
00705          SET FESR-FISCAL-AGENT-YES-88 TO TRUE                        CL123
00706      END-IF.                                                         CL*60
00707                                                                      CL*60
00708  P2000-EXIT.                                                         CL*60
00709      EXIT.                                                           CL*60
00710                                                                      CL*60
00711 *P1010-SUCCESSOR.                                                    CL*62
00712 *    IF MPRF-STATUS-INACT-88                                         CL*62
00713 *       NEXT SENTENCE                                                CL*62
00714 *    ELSE                                                            CL*62
00715 *       GO TO P1010-EXIT.                                            CL*62
00716 *                                                                    CL*62
00717 *    MOVE MPRF-EMP-NO                TO L600-EMP-NO.                 CL*62
00718 *    MOVE 99999999                   TO L600-EXP-TRN-EFF-DATE.       CL*62
00719 *    CALL 'DTSBU600' USING L600-LINK-AREA.                           CL*62
00720 *    IF L600-SUCCESSOR-FOUND-88                                      CL*62
00721 *       ADD +1 TO WRK-SUCC-CNT                                       CL*62
00722 *       DISPLAY 'SUCCESSOR FOUND ' L600-ULTIMATE-SUCCESSOR.          CL*62
00723 *                                                                    CL*62
00724 *P1010-EXIT.                                                         CL*62
00725 *    EXIT.                                                           CL*62
00726                                                                      CL*16
00727  P3000-BALANCE-DUE.                                                  CL*60
00728      MOVE ZERO                      TO WRK-EMP-BALANCE               CL111
00729                                        WRK-LAST-RCVD-YRQ             CL135
00730                                        WRK-MQTR-YTD-WAGE.            CL135
00731                                                                      CL135
00732      MOVE LOW-VALUES                TO  MQTR-KEY-AREA.               CL**9
00733      MOVE MPRF-EMP-NO               TO  MQTR-EMP-NO.                 CL**9
00734      SET MQTR-QTR-88                TO  TRUE.                        CL**9
00735      MOVE MQTR-KEY-AREA             TO  MSKL-KEY-AREA.               CL**9
00736                                                                      CL**9
00737      PERFORM S910-START-BROWSE  THRU  S910-EXIT.                     CL**9
00738                                                                      CL**9
00739      PERFORM P3100-SCAN-MQTR  THRU  P3100-EXIT                       CL*60
00740          UNTIL L910-NO-REC-88.                                       CL**9
00741                                                                      CL**8
00742      IF MPRF-CLASS-SELF-INS-88                                       CL200
00743         NEXT SENTENCE                                                CL200
00744      ELSE                                                            CL200
00745         IF MPRF-STATUS-INACT-88                                      CL200
00746            IF WRK-LAST-RCVD-YRQ < WRK-EARLIEST-YRQ                   CL200
00747               IF MPRF-EFT-ENROLLED-NO-88                             CL200
00748                  MOVE 'N'  TO WRK-EMP-SELECTED-IND.                  CL200
00749                                                                      CL111
00750  P3000-EXIT.                                                         CL*60
00751      EXIT.                                                           CL**8
00752                                                                      CL**8
00753  P3100-SCAN-MQTR.                                                    CL*60
00754      MOVE MSKL-REC                   TO  MQTR-REC.                   CL**9
00755                                                                      CL**9
00756      IF MQTR-CURR-RCVD-88                                            CL111
00757         MOVE MQTR-YRQ                TO WRK-LAST-RCVD-YRQ.           CL111
00758                                                                      CL111
00759      PERFORM P3110-GET-BALANCES      THRU P3110-EXIT.                CL*63
00760                                                                      CL**9
00761      PERFORM P3120-GET-INTEREST      THRU P3120-EXIT.                CL*60
00762                                                                      CL**9
00763      PERFORM P3130-GET-YTD-WAGES     THRU P3130-EXIT.                CL135
00764                                                                      CL135
00765      PERFORM S910-READ-NEXT  THRU  S910-EXIT.                        CL**9
00766                                                                      CL**9
00767  P3100-EXIT.                                                         CL*60
00768      EXIT.                                                           CL**9
00769                                                                      CL**9
00770  P3110-GET-BALANCES.                                                 CL*60
00771      MOVE ZERO                       TO  WRK-TAX-DUE                 CL*12
00772                                          WRK-INT-DUE                 CL*14
00773                                          WRK-PEN-DUE.                CL*14
00774      PERFORM                                                         CL**9
00775        VARYING MQTR-ACCT-IDX  FROM 1 BY 1                            CL**9
00776          UNTIL MQTR-ACCT-IDX  GREATER THAN  MQTR-ACCT-CNT            CL**9
00777            EVALUATE TRUE                                             CL*14
00778              WHEN MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                   CL*14
00779                ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                  CL*14
00780                                       TO  WRK-TAX-DUE                CL*12
00781                                                                      CL*14
00782              WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX)                   CL*14
00783                 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                 CL*14
00784                                       TO  WRK-INT-DUE                CL*12
00785                                                                      CL*14
00786              WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)              CL*14
00787              OR   MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)               CL*14
00788              OR   MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)              CL*14
00789                 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                 CL*14
00790                                       TO  WRK-PEN-DUE                CL*14
00791            END-EVALUATE                                              CL*14
00792      END-PERFORM.                                                    CL**9
00793                                                                      CL**9
00794      COMPUTE WRK-EMP-BALANCE = WRK-EMP-BALANCE +                     CL*12
00795         (WRK-TAX-DUE + WRK-INT-DUE + WRK-PEN-DUE).                   CL*14
00796                                                                      CL**9
00797 *&                                                                   CL*11
00798 *    IF WRK-BAL-DUE-CNT < 100                                        CL*18
00799 *       IF WRK-TAX-DUE  > 0                                          CL*18
00800 *          MOVE WRK-TAX-DUE TO WRK-AMT-DISP                          CL*18
00801 *          MOVE WRK-INT-DUE TO WRK-AMT-DISP1                         CL*18
00802 *          DISPLAY MPRF-EMP-NO '  ' MQTR-YRQ                         CL*18
00803 *             '  TAX ' WRK-AMT-DISP                                  CL*18
00804 *             '  INT ' WRK-AMT-DISP1                                 CL*18
00805 *             '  PEN ' WRK-PEN-DUE.                                  CL*18
00806 *&                                                                   CL*11
00807  P3110-EXIT.                                                         CL*60
00808      EXIT.                                                           CL**9
00809                                                                      CL**9
00810  P3120-GET-INTEREST.                                                 CL*60
00811      MOVE WRK-TAX-DUE                  TO  L101-PAID-CHNG.           CL*12
00812      MOVE LECM-CURR-RUN-DATE           TO  L101-RECEIVED-DATE.       CL*19
00813      SET L101-WAIVE-INT-NO-88          TO  TRUE.                     CL**9
00814      MOVE MQTR-TAX-DUE-DATE            TO  L101-TAX-DUE-DATE.        CL**9
00815      MOVE MQTR-INT-AREA                TO  L101-INT-AREA.            CL**9
00816                                                                      CL**9
00817      PERFORM S101-PER-MONTH-NO  THRU  S101-EXIT.                     CL**9
00818                                                                      CL**9
00819      ADD L101-INT-CHARGE-CHNG          TO  WRK-EMP-BALANCE.          CL**9
00820                                                                      CL**9
00821      SUBTRACT L101-INT-WAIVE-CHNG  FROM  WRK-EMP-BALANCE.            CL**9
00822                                                                      CL**9
00823 *&                                                                   CL*11
00824 *    IF WRK-BAL-DUE-CNT < 100                                        CL*19
00825 *       IF WRK-TAX-DUE > 0                                           CL*19
00826 *          MOVE L101-INT-CHARGE-CHNG TO WRK-AMT-DISP                 CL*19
00827 *          MOVE WRK-EMP-BALANCE TO WRK-AMT-DISP1                     CL*19
00828 *          DISPLAY   '  INT ' WRK-AMT-DISP                           CL*19
00829 *             '  EMP ' WRK-AMT-DISP1.                                CL*19
00830 *&                                                                   CL*11
00831  P3120-EXIT.                                                         CL*60
00832      EXIT.                                                           CL**9
00833                                                                      CL*28
00834  P3130-GET-YTD-WAGES.                                                CL135
00835      IF MQTR-YRQ >= WRK-FIRST-QTR-5-9                                CL135
00836      AND MQTR-YRQ <= WRK-FOURTH-QTR-5-9                              CL136
00837         ADD MQTR-TOT-WAGE TO WRK-MQTR-YTD-WAGE.                      CL135
00838                                                                      CL135
00839  P3130-EXIT.                                                         CL135
00840      EXIT.                                                           CL135
00841                                                                      CL135
00842  P4000-CURR-QTR-DATA.                                                CL*60
00843      MOVE +0                        TO  WRK-WORKERS-CNT.             CL152
00844                                                                      CL152
00845      MOVE LOW-VALUES                TO  MQTR-KEY-AREA.               CL*61
00846      MOVE MPRF-EMP-NO               TO  MQTR-EMP-NO.                 CL*61
00847      SET MQTR-QTR-88                TO  TRUE.                        CL*61
00848      MOVE WRK-CURR-YRQ              TO  MQTR-YRQ.                    CL177
00849      MOVE MQTR-KEY-AREA             TO  MSKL-KEY-AREA.               CL*61
00850                                                                      CL*61
00851      PERFORM S910-READ  THRU  S910-EXIT.                             CL*61
00852      IF L910-NO-REC-88                                               CL*61
00853         SET FESR-QTR-REPORT-NO-88    TO TRUE                         CL229
00854         GO TO P4000-EXIT.                                            CL*61
00855                                                                      CL*41
00856      MOVE MSKL-REC                  TO  MQTR-REC.                    CL*41
00857 *&                                                                   CL226
00858      IF MPRF-EMP-NO = 040192 OR 011708                               CL233
00859         DISPLAY 'BX100 P4000 ' MPRF-EMP-NO                           CL226
00860            '  ' MQTR-CURR-RPT-TYPE '  ' MQTR-YRQ                     CL231
00861            '  DUE ' MQTR-RPT-DUE-DATE                                CL231
00862            '  TAX ' MQTR-TAX-WAGE.                                   CL231
00863 *&                                                                   CL226
00864                                                                      CL*41
00865      IF MQTR-RPT-DUE-DATE NOT = L516-DEFAULT-RPT-DUE-DATE            CL*41
00866          MOVE MQTR-RPT-DUE-DATE TO FESR-REPORT-DUE-DATE              CL123
00867      END-IF.                                                         CL*41
00868                                                                      CL*41
00869      IF MQTR-CURR-RCVD-88                                            CL237
00870         SET FESR-QTR-REPORT-YES-88   TO TRUE                         CL237
00871      ELSE                                                            CL237
00872         SET FESR-QTR-REPORT-NO-88    TO TRUE                         CL229
00873      END-IF.                                                         CL237
00874                                                                      CL*41
00875      IF MQTR-INT-CHARGE-MANUAL-88  OR                                CL*42
00876           (LECM-SYS-DATE >= MQTR-WAIVE-INT-START-DATE  AND           CL*42
00877            LECM-SYS-DATE <= MQTR-WAIVE-INT-END-DATE)                 CL*41
00878              SET FESR-CHRG-INTEREST-NO-88   TO TRUE                  CL123
00879      END-IF.                                                         CL*41
00880                                                                      CL*41
00881      IF MQTR-PEN-CHARGE-MANUAL-88  OR                                CL*42
00882           (LECM-SYS-DATE >= MQTR-WAIVE-PEN-START-DATE  AND           CL*42
00883            LECM-SYS-DATE <= MQTR-WAIVE-PEN-END-DATE)                 CL*41
00884              SET FESR-CHRG-PENALTY-NO-88   TO TRUE                   CL123
00885      END-IF.                                                         CL*41
00886                                                                      CL*41
00887      IF MQTR-1ST-MTH-NO-ENTRY-88                                     CL152
00888         NEXT SENTENCE                                                CL152
00889      ELSE                                                            CL152
00890         IF MQTR-1ST-MTH-EMPL-CNT > WRK-WORKERS-CNT                   CL152
00891            MOVE MQTR-1ST-MTH-EMPL-CNT TO WRK-WORKERS-CNT.            CL152
00892                                                                      CL152
00893      IF MQTR-2ND-MTH-NO-ENTRY-88                                     CL152
00894         NEXT SENTENCE                                                CL152
00895      ELSE                                                            CL152
00896         IF MQTR-2ND-MTH-EMPL-CNT > WRK-WORKERS-CNT                   CL152
00897            MOVE MQTR-2ND-MTH-EMPL-CNT TO WRK-WORKERS-CNT.            CL152
00898                                                                      CL152
00899      IF MQTR-3RD-MTH-NO-ENTRY-88                                     CL152
00900         NEXT SENTENCE                                                CL152
00901      ELSE                                                            CL152
00902         IF MQTR-3RD-MTH-EMPL-CNT > WRK-WORKERS-CNT                   CL152
00903            MOVE MQTR-3RD-MTH-EMPL-CNT TO WRK-WORKERS-CNT.            CL152
00904                                                                      CL152
00905  P4000-EXIT.                                                         CL*60
00906      EXIT.                                                           CL*41
00907                                                                      CL*48
00908  P5000-ADDRESS.                                                      CL*60
00909      MOVE LOW-VALUES  TO MTAD-KEY-AREA.                              CL*48
00910      MOVE MPRF-EMP-NO TO MTAD-EMP-NO.                                CL*48
00911      SET MTAD-TAD-88  TO TRUE.                                       CL*48
00912      SET MTAD-ID-TAX-MAILING-ADDR-88  TO TRUE.                       CL*48
00913                                                                      CL*48
00914      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                            CL*48
00915                                                                      CL*48
00916      PERFORM S910-READ         THRU S910-EXIT.                       CL*48
00917                                                                      CL*48
00918      IF L910-NO-REC-88                                               CL*48
00919         IF MPRF-EFT-ENROLLED-NO-88                                   CL178
00920            MOVE 'N'  TO WRK-EMP-SELECTED-IND                         CL178
00921         END-IF                                                       CL178
00922      ELSE                                                            CL*48
00923         MOVE MSKL-REC TO MTAD-REC                                    CL112
00924         IF MTAD-UC223-NO-88                                          CL112
00925            IF MPRF-EFT-ENROLLED-NO-88                                CL178
00926               MOVE 'N'  TO WRK-EMP-SELECTED-IND.                     CL178
00927                                                                      CL*48
00928  P5000-EXIT.                                                         CL*60
00929      EXIT.                                                           CL*49
00930                                                                      CL205
00931  P5500-CONTACT.                                                      CL205
00932      MOVE SPACES TO FESR-CONTACT-FIRST-NAME                          CL214
00933                     FESR-CONTACT-MI                                  CL214
00934                     FESR-CONTACT-LAST-NAME                           CL214
00935                     FESR-CONTACT-PHONE.                              CL221
00936                                                                      CL214
00937      MOVE LOW-VALUES  TO MOPO-KEY-AREA.                              CL206
00938      MOVE MPRF-EMP-NO TO MOPO-EMP-NO.                                CL206
00939      SET MOPO-OPO-88  TO TRUE.                                       CL206
00940      MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA.                            CL206
00941                                                                      CL206
00942      SET WRK-MOPO-FOUND-NO-88   TO TRUE.                             CL217
00943      PERFORM S910-START-BROWSE THRU S910-EXIT.                       CL206
00944      IF L910-NO-REC-88                                               CL206
00945         NEXT SENTENCE                                                CL206
00946      ELSE                                                            CL206
00947         PERFORM                                                      CL206
00948           UNTIL L910-NO-REC-88                                       CL206
00949           OR WRK-MOPO-FOUND-YES-88                                   CL206
00950              MOVE MSKL-REC             TO MOPO-REC                   CL206
00951              IF MOPO-TYPE-STATUS-88                                  CL206
00952 *    DISPLAY 'CONTACT - MOPO NAME FOUND ' MOPO-NAME                  CL227
00953                 SET WRK-MOPO-FOUND-YES-88   TO TRUE                  CL206
00954              ELSE                                                    CL206
00955                 PERFORM S910-READ-NEXT   THRU S910-EXIT              CL206
00956              END-IF                                                  CL206
00957         END-PERFORM                                                  CL206
00958      END-IF.                                                         CL206
00959                                                                      CL206
00960      IF WRK-MOPO-FOUND-YES-88                                        CL206
00961         MOVE MOPO-VOICE-1 TO FESR-CONTACT-PHONE                      CL221
00962         MOVE MOPO-NAME    TO SLASH-NAME                              CL221
00963         PERFORM P5600-PARSE-NAME THRU P5600-EXIT.                    CL220
00964                                                                      CL206
00965  P5500-EXIT.                                                         CL205
00966      EXIT.                                                           CL205
00967                                                                      CL205
00968  P5600-PARSE-NAME.                                                   CL208
00969 *&                                                                   CL239
00970 *    DISPLAY 'P5600 NAME ' SLASH-NAME '  ' MOPO-EMP-NO.              CL245
00971 *&                                                                   CL239
00972      MOVE +0          TO FSUB                                        CL239
00973                          LSUB.                                       CL239
00974      MOVE SPACES      TO FIRST-NAME                                  CL239
00975                          MIDDLE-INIT                                 CL239
00976                          LAST-NAME.                                  CL239
00977      SET FIRST-NAME-COMPLETE-NO-88  TO TRUE.                         CL239
00978      SET LAST-NAME-COMPLETE-NO-88   TO TRUE.                         CL239
00979      SET MID-INIT-COMPLETE-NO-88    TO TRUE.                         CL241
00980                                                                      CL239
00981      IF SLASH-NAME = SPACES                                          CL243
00982         MOVE SPACES   TO    FESR-CONTACT-LAST-NAME                   CL243
00983                             FESR-CONTACT-FIRST-NAME                  CL243
00984                             FESR-CONTACT-MI                          CL243
00985         GO TO P5600-EXIT.                                            CL243
00986                                                                      CL243
00987      PERFORM                                                         CL239
00988        VARYING NSUB FROM +1 BY +1                                    CL239
00989        UNTIL NSUB > +34                                              CL239
00990        OR MID-INIT-COMPLETE-YES-88                                   CL241
00991          IF FIRST-NAME-COMPLETE-YES-88                               CL239
00992             PERFORM P5630-MID-INIT       THRU P5630-EXIT             CL239
00993          ELSE                                                        CL239
00994             IF LAST-NAME-COMPLETE-YES-88                             CL239
00995                PERFORM P5620-FIRST-NAME  THRU P5620-EXIT             CL239
00996             ELSE                                                     CL239
00997                PERFORM P5610-LAST-NAME   THRU P5610-EXIT             CL239
00998             END-IF                                                   CL239
00999          END-IF                                                      CL239
01000      END-PERFORM.                                                    CL239
01001                                                                      CL239
01002      MOVE LAST-NAME   TO    FESR-CONTACT-LAST-NAME.                  CL243
01003      MOVE FIRST-NAME  TO    FESR-CONTACT-FIRST-NAME.                 CL243
01004      MOVE MIDDLE-INIT TO    FESR-CONTACT-MI.                         CL243
01005 *&                                                                   CL241
01006 *    DISPLAY '  P5600 ' FIRST-NAME '  ' MIDDLE-INIT                  CL245
01007 *       '  ' LAST-NAME.                                              CL245
01008 *&                                                                   CL241
01009 *    INSPECT SLASH-NAME TALLYING                                     CL239
01010 *            SLASH-TALLY   FOR ALL '/'.                              CL239
01011 *    INSPECT SLASH-NAME TALLYING                                     CL239
01012 *            LAST-NAME-LEN FOR CHARACTERS BEFORE INITIAL '/'.        CL239
01013 *    INSPECT SLASH-NAME TALLYING                                     CL239
01014 *            TOTAL-LEN     FOR CHARACTERS BEFORE INITIAL D-S.        CL239
01015                                                                      CL209
01016 **  CHECK FOR A VALID CONTACT NAME STRUCTURE  **                     CL211
01017 *    IF SLASH-TALLY  NOT = +1                                        CL239
01018 *       GO TO P5600-EXIT.                                            CL239
01019                                                                      CL213
01020 *-----------------------------------------------------------------   CL212
01021 *  REFORMAT.                                                         CL212
01022 *-----------------------------------------------------------------   CL212
01023                                                                      CL213
01024 *    IF SLASH-NAME-CHAR (TOTAL-LEN - 1) NOT GREATER SPACE            CL239
01025 *       MOVE SLASH-NAME-CHAR (TOTAL-LEN) TO FESR-CONTACT-MI          CL239
01026 *       COMPUTE FIRST-NAME-LEN =                                     CL239
01027 *               (TOTAL-LEN - ((LAST-NAME-LEN + 1) + 2))              CL239
01028 *    ELSE                                                            CL239
01029 *       COMPUTE FIRST-NAME-LEN =                                     CL239
01030 *               (TOTAL-LEN - (LAST-NAME-LEN - 1)).                   CL239
01031 *                                                                    CL239
01032 *    MOVE SLASH-NAME (1 : LAST-NAME-LEN) TO                          CL239
01033 *         FESR-CONTACT-LAST-NAME.                                    CL239
01034 *    MOVE SLASH-NAME (LAST-NAME-LEN + 2 : FIRST-NAME-LEN) TO         CL239
01035 *         FESR-CONTACT-FIRST-NAME.                                   CL239
01036                                                                      CL211
01037  P5600-EXIT.                                                         CL208
01038      EXIT.                                                           CL208
01039                                                                      CL208
01040  P5610-LAST-NAME.                                                    CL239
01041      IF SLASH-NAME-CHAR (NSUB) = '/'                                 CL239
01042         SET LAST-NAME-COMPLETE-YES-88 TO TRUE                        CL239
01043         GO TO P5610-EXIT                                             CL239
01044      ELSE                                                            CL239
01045         IF LSUB < +20                                                CL239
01046            ADD +1 TO LSUB                                            CL239
01047            MOVE SLASH-NAME-CHAR (NSUB) TO LAST-NAME (LSUB:1)         CL239
01048 *&                                                                   CL239
01049 *          DISPLAY '  P5610 LAST ' LAST-NAME                         CL245
01050 *&                                                                   CL239
01051         END-IF                                                       CL239
01052      END-IF.                                                         CL239
01053                                                                      CL239
01054  P5610-EXIT.                                                         CL239
01055      EXIT.                                                           CL239
01056                                                                      CL239
01057  P5620-FIRST-NAME.                                                   CL239
01058      IF SLASH-NAME-CHAR (NSUB) = SPACE                               CL239
01059         SET FIRST-NAME-COMPLETE-YES-88 TO TRUE                       CL239
01060         GO TO P5620-EXIT                                             CL239
01061      ELSE                                                            CL239
01062         IF FSUB < +15                                                CL239
01063            ADD +1 TO FSUB                                            CL239
01064            MOVE SLASH-NAME-CHAR (NSUB) TO FIRST-NAME (FSUB:1)        CL239
01065 *&                                                                   CL239
01066 *          DISPLAY '  P5620 FIRST ' FIRST-NAME                       CL245
01067 *&                                                                   CL239
01068         END-IF                                                       CL239
01069      END-IF.                                                         CL239
01070                                                                      CL239
01071  P5620-EXIT.                                                         CL239
01072      EXIT.                                                           CL239
01073                                                                      CL239
01074  P5630-MID-INIT.                                                     CL239
01075      IF MID-INIT-COMPLETE-NO-88                                      CL241
01076         MOVE SLASH-NAME-CHAR (NSUB) TO MIDDLE-INIT (1:1)             CL241
01077         SET MID-INIT-COMPLETE-YES-88 TO TRUE                         CL241
01078 *&                                                                   CL243
01079 *          DISPLAY '  P5630 MID ' MIDDLE-INIT                        CL245
01080 *&                                                                   CL243
01081      END-IF.                                                         CL241
01082                                                                      CL239
01083  P5630-EXIT.                                                         CL239
01084      EXIT.                                                           CL239
01085                                                                      CL239
01086  P6000-BUILD-FESR-REC.                                               CL123
01087 *    MOVE ZERO                    TO WRK-EMP-BALANCE.                CL*61
01088 *                                                                    CL*61
01089 *    IF MPRF-TOT-BALANCE-AMT > ZERO                                  CL*61
01090 *****   PERFORM P1010-SUCCESSOR   THRU P1010-EXIT                    CL*61
01091 *       PERFORM P1100-BALANCE-DUE THRU P1100-EXIT                    CL*67
01092 *       ADD +1                    TO WRK-BAL-DUE-CNT                 CL*67
01093 *       ADD WRK-EMP-BALANCE       TO WRK-TOT-BAL-DUE.                CL*67
01094                                                                      CL*61
01095      MOVE ZEROS                     TO FESR-CREDIT-AVAILABLE.        CL123
01096      SET FESR-CALC-TAX-WAGE-YES-88 TO TRUE.                          CL123
01097      SET FESR-CHRG-INTEREST-YES-88 TO TRUE.                          CL123
01098      SET FESR-CHRG-PENALTY-YES-88   TO TRUE.                         CL123
01099                                                                      CL*61
01100      SET FESR-TYPE-EMP-STATUS-88 TO TRUE.                            CL123
01101      SET FESR-SUB-TYPE-DATA-88    TO TRUE.                           CL123
01102                                                                      CL*61
01103      MOVE MPRF-EMP-NO             TO FESR-EMP-NO.                    CL123
01104      MOVE MPRF-FEIN               TO FESR-FEIN.                      CL123
01105                                                                      CL*61
01106      IF MPRF-PRIMARY-IS-ENTITY-88                                    CL*61
01107         MOVE MPRF-PRIMARY-NAME    TO FESR-ENTITY-NAME                CL123
01108         MOVE SPACES               TO FESR-TRADE-NAME                 CL123
01109      ELSE                                                            CL*61
01110         MOVE MPRF-ENTITY-NAME     TO FESR-ENTITY-NAME                CL123
01111         MOVE MPRF-PRIMARY-NAME    TO FESR-TRADE-NAME.                CL123
01112                                                                      CL*61
01113      MOVE MTAD-VOICE-1-AREA-CD    TO FESR-BUSINESS-AREA-CD.          CL123
01114      MOVE MTAD-VOICE-1-PREFIX     TO FESR-BUSINESS-PREFIX.           CL123
01115      MOVE MTAD-VOICE-1-SUFFIX     TO FESR-BUSINESS-SUFFIX.           CL123
01116      MOVE MTAD-VOICE-1-EXT        TO FESR-BUSINESS-EXT.              CL123
01117                                                                      CL*61
01118      MOVE MTAD-FAX-AREA-CD        TO FESR-FAX-AREA-CD.               CL123
01119      MOVE MTAD-FAX-PREFIX         TO FESR-FAX-PREFIX.                CL123
01120      MOVE MTAD-FAX-SUFFIX         TO FESR-FAX-SUFFIX.                CL123
01121                                                                      CL*61
01122      IF MTAD-EMAIL-ADDRESS = SPACES OR LOW-VALUES                    CL*61
01123         MOVE SPACES               TO FESR-EMAIL-ADDRESS              CL123
01124      ELSE                                                            CL*61
01125         MOVE MTAD-EMAIL-ADDRESS   TO FESR-EMAIL-ADDRESS.             CL123
01126                                                                      CL*61
01127      MOVE MTAD-ATTN-LINE        TO FESR-ATTN-LINE.                   CL123
01128 ***************************************************************      CL134
01129 * GOVONE REQUESTED THAT LINE 1 AND LINE 2 BE REVERSED                CL134
01130 * 5/13/2003 - GD                                                     CL134
01131 ***************************************************************      CL134
01132      MOVE MTAD-DELIV-LINE-1     TO FESR-STREET-ADDRESS-2.            CL134
01133      MOVE MTAD-DELIV-LINE-2     TO FESR-STREET-ADDRESS-1.            CL134
01134      MOVE MTAD-CITY             TO FESR-CITY.                        CL123
01135      MOVE MTAD-ST               TO FESR-STATE.                       CL123
01136      MOVE MTAD-ZIP              TO FESR-ZIP.                         CL123
01137                                                                      CL*61
01138      MOVE WRK-EMP-BALANCE         TO FESR-PRIOR-BALANCE-DUE.         CL123
01139                                                                      CL*61
01140  P6000-EXIT.                                                         CL206
01141      EXIT.                                                           CL*61
01142                                                                      CL*88
01143  P7000-GET-WAGE-DATA.                                                CL110
01144 *&                                                                   CL194
01145 *    IF MPRF-EMP-NO = 010169                                         CL201
01146 *       DISPLAY 'ENTER P7000 '                                       CL201
01147 *          WWGH-EMP-NO.                                              CL248
01148 *&                                                                   CL194
01149      PERFORM P7010-INIT-TABLE   THRU P7010-EXIT.                     CL*92
01150                                                                      CL*85
01151      MOVE ZERO                  TO TBL-SUB                           CL*85
01152                                    TBL-CNT                           CL*76
01153                                    WRK-MAX-SSN                       CL137
01154                                    WRK-WGH-YTD-WAGE.                 CL248
01155      SET WRK-SSN-ERROR-NO-88    TO TRUE.                             CL*76
01156                                                                      CL*76
01157      MOVE LOW-VALUES            TO  WWGH-KEY-AREA.                   CL248
01158      MOVE MPRF-EMP-NO           TO  WWGH-EMP-NO.                     CL248
01159      MOVE WRK-FIRST-QTR-5-9     TO  WWGH-YRQ.                        CL248
01160                                                                      CL*76
01161      PERFORM S981D-START-BROWSE  THRU S981D-EXIT.                    CL248
01162      IF L981-NO-REC-88                                               CL248
01163          GO TO P7000-EXIT                                            CL*78
01164      ELSE                                                            CL*76
01165         PERFORM P7100-SCAN-WAGES THRU P7100-EXIT                     CL*78
01166            UNTIL L981-NO-REC-88                                      CL248
01167            OR WRK-SSN-ERROR-YES-88.                                  CL115
01168                                                                      CL*76
01169      IF WRK-MQTR-YTD-WAGE NOT = ZERO                                 CL139
01170         IF WRK-WGH-YTD-WAGE = ZERO                                   CL248
01171            ADD +1 TO WRK-NO-WAGE-CNT                                 CL148
01172         ELSE                                                         CL148
01173            ADD +1 TO WRK-WAGES-FOUND-CNT                             CL149
01174            COMPUTE WRK-PCT =                                         CL148
01175               (WRK-WGH-YTD-WAGE / WRK-MQTR-YTD-WAGE)                 CL248
01176            IF WRK-PCT <= 1.05                                        CL148
01177            AND WRK-PCT >= 0.95                                       CL148
01178               ADD +1 TO WRK-WAGES-OK-CNT                             CL150
01179            ELSE                                                      CL148
01180               PERFORM P7001-DISPLAY  THRU P7001-EXIT                 CL150
01181            END-IF                                                    CL150
01182         END-IF                                                       CL150
01183      ELSE                                                            CL150
01184         IF WRK-WGH-YTD-WAGE NOT = ZERO                               CL248
01185            PERFORM P7002-DISPLAY  THRU P7002-EXIT                    CL150
01186         END-IF                                                       CL150
01187      END-IF.                                                         CL150
01188                                                                      CL135
01189  P7000-EXIT.                                                         CL*78
01190      EXIT.                                                           CL*76
01191                                                                      CL*76
01192  P7001-DISPLAY.                                                      CL150
01193      MOVE WRK-PCT TO WRK-PCT-DISP.                                   CL183
01194      SET FESR-CALC-TAX-WAGE-NO-88 TO TRUE.                           CL183
01195      ADD +1 TO WRK-MISSING-WAGE-CNT.                                 CL183
01196 *    DISPLAY 'MISSING WAGES ' MPRF-EMP-NO                            CL183
01197 *       '  MQTR ' WRK-MQTR-YTD-WAGE                                  CL183
01198 *       '  WGH ' WRK-WGH-YTD-WAGE                                    CL248
01199 *       '  PCT ' WRK-PCT-DISP                                        CL183
01200 *    DISPLAY '    MQTR CNT ' WRK-WORKERS-CNT                         CL183
01201 *       '  WGH CNT ' TBL-CNT.                                        CL248
01202                                                                      CL152
01203  P7001-EXIT.                                                         CL150
01204      EXIT.                                                           CL150
01205                                                                      CL150
01206  P7002-DISPLAY.                                                      CL150
01207      ADD +1 TO WRK-MQTR-MISSING-CNT.                                 CL183
01208 *    DISPLAY 'MQTR MISSING ' MPRF-EMP-NO                             CL183
01209 *       '  MQTR ' WRK-MQTR-YTD-WAGE                                  CL183
01210 *       '  WGH ' WRK-WGH-YTD-WAGE.                                   CL183
01211  P7002-EXIT.                                                         CL151
01212      EXIT.                                                           CL150
01213                                                                      CL150
01214  P7010-INIT-TABLE.                                                   CL*92
01215      PERFORM                                                         CL*92
01216        VARYING TBL-SUB FROM +1 BY +1                                 CL*92
01217        UNTIL TBL-SUB > TBL-MAX                                       CL*92
01218          MOVE ZEROS   TO  WAGE-SSN (TBL-SUB)                         CL*93
01219          MOVE SPACES  TO  WAGE-FIRST-NAME (TBL-SUB)                  CL*93
01220                           WAGE-MI (TBL-SUB)                          CL*93
01221                           WAGE-LAST-NAME (TBL-SUB)                   CL*93
01222          MOVE ZEROS   TO  WAGE-YTD-SUM (TBL-SUB)                     CL*93
01223       END-PERFORM.                                                   CL*92
01224                                                                      CL*92
01225  P7010-EXIT.                                                         CL*92
01226      EXIT.                                                           CL*92
01227                                                                      CL*92
01228  P7100-SCAN-WAGES.                                                   CL*79
01229 *&                                                                   CL194
01230 *    IF MPRF-EMP-NO = 010021                                         CL201
01231 *      DISPLAY 'ENTER P7100-SCAN-WAGES ' TBL-SUB '  ' TBL-CNT        CL201
01232 *         '  ' WWGH-SSN '  ' WWGH-EMP-NO '  ' WWGH-YRQ.              CL248
01233 *&                                                                   CL194
01234                                                                      CL*90
01235      IF (WWGH-EMP-NO                  NOT = MPRF-EMP-NO)  OR         CL248
01236         (WWGH-YRQ                     > WRK-FOURTH-QTR-5-9)          CL248
01237           SET L981-NO-REC-88            TO TRUE                      CL248
01238           GO TO P7100-EXIT                                           CL*78
01239      ELSE                                                            CL*76
01240         IF WWGH-SSN < +1000000                                       CL248
01241            NEXT SENTENCE                                             CL*76
01242         END-IF                                                       CL*76
01243         PERFORM P7110-FIND-INDEX      THRU P7110-EXIT                CL*78
01244         IF WRK-SSN-ERROR-NO-88                                       CL*76
01245            IF WRK-INDEX-SSN-FOUND-88                                 CL*76
01246               PERFORM P7300-ADD-WAGES THRU P7300-EXIT                CL159
01247            ELSE                                                      CL*76
01248               MOVE WWGH-SSN           TO WAGE-SSN (TBL-SUB)          CL248
01249               PERFORM P7300-ADD-WAGES THRU P7300-EXIT                CL159
01250               PERFORM P7200-GET-NAME  THRU P7200-EXIT                CL185
01251            END-IF                                                    CL*76
01252         ELSE                                                         CL*76
01253 **         DISPLAY 'SSN ERROR ' TBL-SUB '  ' TBL-CNT '  ' WWGH-SSN   CL248
01254 **           '  ' WWGH-EMP-NO                                        CL248
01255            ADD 1 TO WRK-SSN-ERROR                                    CL107
01256         END-IF                                                       CL*99
01257      END-IF.                                                         CL*99
01258                                                                      CL*76
01259      PERFORM S981E-READ-NEXT       THRU S981E-EXIT.                  CL248
01260                                                                      CL*76
01261 **   DISPLAY 'EXIT P7100-EXIT. '.                                    CL*98
01262  P7100-EXIT.                                                         CL*78
01263      EXIT.                                                           CL*76
01264                                                                      CL*76
01265  P7110-FIND-INDEX.                                                   CL*78
01266 *    DISPLAY 'P71-1 CNT ' TBL-CNT '  LAST SSN ' WRK-MAX-SSN          CL101
01267 *         '  TBL-SUB ' TBL-SUB.                                      CL101
01268      SET WRK-INDEX-NULL-88            TO TRUE.                       CL*76
01269                                                                      CL*76
01270      IF WWGH-SSN > WRK-MAX-SSN                                       CL248
01271         IF TBL-CNT < TBL-MAX                                         CL*76
01272            ADD +1                          TO TBL-CNT                CL*76
01273            MOVE TBL-CNT                    TO TBL-SUB                CL*76
01274            SET WRK-INDEX-POSITION-FOUND-88 TO TRUE                   CL*76
01275            MOVE WWGH-SSN                   TO WRK-MAX-SSN            CL248
01276         ELSE                                                         CL*76
01277            SET WRK-SSN-ERROR-YES-88        TO TRUE                   CL*76
01278         END-IF                                                       CL*76
01279      ELSE                                                            CL*76
01280         PERFORM P7111-SEARCH-TABLE         THRU P7111-EXIT           CL*78
01281         IF WRK-INDEX-POSITION-FOUND-88                               CL*76
01282            IF TBL-CNT < TBL-MAX                                      CL*76
01283               PERFORM P7112-INSERT-SSN     THRU P7112-EXIT           CL*78
01284            ELSE                                                      CL*76
01285               SET WRK-SSN-ERROR-YES-88     TO TRUE                   CL*76
01286            END-IF                                                    CL*76
01287         END-IF                                                       CL*76
01288      END-IF.                                                         CL*76
01289 *    DISPLAY 'P71-2 CNT ' TBL-CNT '  LAST SSN ' WRK-MAX-SSN          CL101
01290 *       '  IDX IND ' WRK-INDEX-IND '  TBL-SUB 'TBL-SUB.              CL101
01291  P7110-EXIT.                                                         CL*78
01292      EXIT.                                                           CL*76
01293                                                                      CL*76
01294  P7111-SEARCH-TABLE.                                                 CL*78
01295      PERFORM                                                         CL*76
01296         VARYING SSN-SUB FROM +1 BY +1                                CL*76
01297         UNTIL WRK-INDEX-FOUND-88                                     CL*76
01298         OR SSN-SUB > TBL-CNT                                         CL*76
01299            IF WAGE-SSN (SSN-SUB) = WWGH-SSN                          CL248
01300               SET WRK-INDEX-SSN-FOUND-88 TO TRUE                     CL*76
01301               MOVE SSN-SUB TO TBL-SUB                                CL*76
01302            ELSE                                                      CL*76
01303               IF WWGH-SSN < WAGE-SSN (SSN-SUB)                       CL248
01304                  MOVE SSN-SUB TO TBL-SUB                             CL*76
01305                  SET WRK-INDEX-POSITION-FOUND-88 TO TRUE             CL*76
01306               END-IF                                                 CL*76
01307            END-IF                                                    CL*76
01308      END-PERFORM.                                                    CL*76
01309                                                                      CL*76
01310  P7111-EXIT.                                                         CL*78
01311      EXIT.                                                           CL*76
01312  P7112-INSERT-SSN.                                                   CL*78
01313                                                                      CL*76
01314      PERFORM                                                         CL*76
01315        VARYING SSN-SUB FROM TBL-CNT BY -1                            CL*76
01316         UNTIL SSN-SUB < TBL-SUB                                      CL*76
01317          COMPUTE NXT-SUB = SSN-SUB + 1                               CL*76
01318          MOVE WAGE-SSN (SSN-SUB)     TO WAGE-SSN (NXT-SUB)           CL*76
01319          MOVE WAGE-NAME-AREA (SSN-SUB) TO WAGE-NAME-AREA (NXT-SUB)   CL*76
01320          MOVE WAGE-YTD-SUM (SSN-SUB) TO WAGE-YTD-SUM (NXT-SUB)       CL*76
01321          PERFORM P7112A-INIT-TBL-ENTRY  THRU P7112A-EXIT             CL184
01322      END-PERFORM.                                                    CL*76
01323                                                                      CL*76
01324      ADD +1             TO TBL-CNT.                                  CL*76
01325                                                                      CL*76
01326  P7112-EXIT.                                                         CL*78
01327      EXIT.                                                           CL*76
01328                                                                      CL*76
01329  P7112A-INIT-TBL-ENTRY.                                              CL184
01330      MOVE ZERO                  TO WAGE-SSN (SSN-SUB)                CL184
01331                                    WAGE-YTD-SUM (SSN-SUB).           CL184
01332      MOVE SPACES                TO WAGE-NAME-AREA (SSN-SUB).         CL184
01333                                                                      CL184
01334  P7112A-EXIT.                                                        CL184
01335      EXIT.                                                           CL184
01336                                                                      CL184
01337  P7200-GET-NAME.                                                     CL185
01338      IF WWGH-SSN = WAGE-SSN (TBL-SUB)                                CL248
01339      AND WAGE-NAME-AREA (TBL-SUB) > SPACES                           CL191
01340         GO TO P7200-EXIT.                                            CL189
01341                                                                      CL185
01342      MOVE LOW-VALUES            TO  WNAM-REC.                        CL185
01343      MOVE WWGH-SSN              TO  WNAM-SSN.                        CL248
01344                                                                      CL185
01345      PERFORM S982A-START-BROWSE THRU S982A-EXIT.                     CL185
01346      IF L982-OK-88                                                   CL186
01347         IF WNAM-SSN = WWGH-SSN                                       CL248
01348            IF WNAM-TYPE-FULL-88                                      CL204
01349 *&                                                                   CL188
01350 *             IF WWGH-EMP-NO = 010021                                CL248
01351 *                DISPLAY 'NAME ' WNAM-SSN '  ' WNAM-NAME             CL204
01352 *             END-IF                                                 CL204
01353 *&                                                                   CL193
01354               MOVE WNAM-NAME        TO WAGE-NAME-AREA (TBL-SUB)      CL204
01355            END-IF                                                    CL204
01356         END-IF                                                       CL193
01357      END-IF.                                                         CL193
01358                                                                      CL185
01359  P7200-EXIT.                                                         CL185
01360      EXIT.                                                           CL185
01361                                                                      CL*77
01362  P7300-ADD-WAGES.                                                    CL159
01363      IF WRK-CURR-QTR-5-Q = 1                                         CL159
01364         NEXT SENTENCE                                                CL159
01365      ELSE                                                            CL159
01366         ADD WWGH-EARNINGS       TO WAGE-YTD-SUM (TBL-SUB)            CL248
01367                                    WRK-WGH-YTD-WAGE                  CL248
01368      END-IF.                                                         CL159
01369                                                                      CL159
01370  P7300-EXIT.                                                         CL159
01371      EXIT.                                                           CL159
01372                                                                      CL159
01373  P8000-WRITE-WAGES.                                                  CL115
01374      IF TBL-CNT > TBL-HIGHEST                                        CL110
01375         MOVE TBL-CNT TO TBL-HIGHEST.                                 CL110
01376                                                                      CL110
01377      PERFORM P8100-WRITE-FEWR       THRU P8100-EXIT                  CL123
01378         VARYING TBL-SUB FROM +1 BY +1                                CL115
01379         UNTIL TBL-SUB > TBL-CNT.                                     CL117
01380                                                                      CL115
01381  P8000-EXIT.                                                         CL*77
01382      EXIT.                                                           CL*77
01383                                                                      CL115
01384  P8100-WRITE-FEWR.                                                   CL123
01385      SET FEWR-TYPE-WAGE-EXP-88      TO TRUE.                         CL123
01386      SET FEWR-SUB-TYPE-DATA-88      TO TRUE.                         CL123
01387                                                                      CL115
01388      MOVE MPRF-EMP-NO               TO FEWR-EMP-NO.                  CL123
01389      MOVE WAGE-SSN (TBL-SUB)        TO FEWR-EMPL-SSN.                CL123
01390      MOVE WAGE-FIRST-NAME (TBL-SUB) TO FEWR-FIRST-NAME.              CL192
01391      MOVE WAGE-MI (TBL-SUB)         TO FEWR-MIDDLE-INITIAL.          CL192
01392      MOVE WAGE-LAST-NAME (TBL-SUB)  TO FEWR-LAST-NAME.               CL192
01393      MOVE WAGE-YTD-SUM (TBL-SUB)    TO FEWR-YR-TO-DATE-WAGES.        CL123
01394 ***  MOVE SPACES                    TO FEWR-FILLER.                  CL131
01395                                                                      CL115
01396                                                                      CL121
01397      PERFORM S946-WRITE-FEWR        THRU S946-EXIT.                  CL123
01398                                                                      CL115
01399      ADD +1 TO WRK-EFT-WRITTEN-CNTFEWR.                              CL123
01400                                                                      CL115
01401  P8100-EXIT.                                                         CL115
01402      EXIT.                                                           CL115
01403                                                                      CL115
01404                                                                      CL*77
01405  T0000-TERMINATE.                                                 EFTBX100
01406                                                                      CL*53
01407      PERFORM T1000-WRITE-TRAILER  THRU T1000-EXIT.                   CL*19
01408                                                                      CL*19
01409      PERFORM T2000-WRITE-TRAILER  THRU T2000-EXIT.                   CL*74
01410                                                                      CL*74
01411      DISPLAY '*********************************************'.        CL**7
01412      DISPLAY '*  EFTBX100 TERMINATION STATISTICS'.                   CL125
01413      DISPLAY '*  '.                                                  CL**3
01414      DISPLAY '*      5% TOLERANCE '.                                 CL147
01415      DISPLAY '*  '.                                                  CL147
01416      DISPLAY '*     MPRF RECORDS READ      :          '              CL*75
01417         WRK-MPRF-CNT.                                                CL**3
01418      DISPLAY '* FESR EFT RECORDS WRITTEN  :          '               CL123
01419         WRK-EFT-WRITTEN-CNTFESR.                                     CL123
01420      DISPLAY '* FESR EMPLOYERS WITH BALANCE:         '               CL123
01421         WRK-BAL-DUE-CNT.                                             CL**6
01422      MOVE WRK-TOT-BAL-DUE TO WRK-AMT-DISP.                           CL**6
01423      DISPLAY '* FESR TOTAL BALANCE DUE:   : '                        CL123
01424         WRK-AMT-DISP.                                                CL**6
01425      DISPLAY '*     INT COMP DATE          : '                       CL*75
01426         LECM-CURR-RUN-DATE.                                          CL**9
01427 *    DISPLAY '*     SUCCESSORS             : '                       CL110
01428 *       WRK-SUCC-CNT.                                                CL110
01429      DISPLAY '                               '.                      CL*75
01430      DISPLAY '* FEWR EFT RECORDS WRITTEN  :          '               CL123
01431         WRK-EFT-WRITTEN-CNTFEWR.                                     CL123
01432                                                                      CL107
01433      DISPLAY '                               '.                      CL107
01434      DISPLAY 'MAX EMPLOYEES ' TBL-HIGHEST.                           CL110
01435      MOVE WRK-SSN-ERROR TO WRK-SSN-ERROR-DISP.                       CL107
01436      DISPLAY '* SSN ERRORS COUNT =         : '                       CL107
01437         WRK-SSN-ERROR-DISP.                                          CL107
01438      DISPLAY '                               '.                      CL149
01439      DISPLAY 'WAGES FOUND      '                                     CL149
01440         WRK-WAGES-FOUND-CNT.                                         CL149
01441      DISPLAY '                               '.                      CL152
01442      DISPLAY 'WAGES MATCH      '                                     CL152
01443         WRK-WAGES-OK-CNT.                                            CL152
01444      DISPLAY '                               '.                      CL139
01445      DISPLAY 'WAGE DIFFERENCES '                                     CL139
01446         WRK-MISSING-WAGE-CNT.                                        CL139
01447      DISPLAY '                               '.                      CL183
01448      DISPLAY 'MISSING QUARTER  '                                     CL183
01449         WRK-MQTR-MISSING-CNT.                                        CL183
01450      DISPLAY '                               '.                      CL148
01451      DISPLAY 'NO WAGES ON FILE '                                     CL148
01452         WRK-NO-WAGE-CNT.                                             CL148
01453      DISPLAY '*********************************************'.        CL**7
01454                                                                      CL**3
01455                                                                      CL*58
01456      PERFORM S981C-CLOSE THRU S981C-EXIT.                            CL248
01457      PERFORM S982D-CLOSE THRU S982D-EXIT.                            CL186
01458                                                                      CL*73
01459  T0000-EXIT.                                                      EFTBX100
01460      EXIT.                                                        EFTBX100
01461                                                                      CL*19
01462  T1000-WRITE-TRAILER.                                                CL*19
01463                                                                      CL*23
01464      SET FTRL-TYPE-EMP-STATUS-88   TO TRUE.                          CL123
01465      SET FTRL-SUB-TYPE-TRAILER-88 TO TRUE.                           CL123
01466                                                                      CL*26
01467      MOVE WRK-EFT-WRITTEN-CNTFESR TO FTRL-RECORD-CNT.                CL123
01468      MOVE ZERO                     TO FTRL-TOT-AMOUNT.               CL123
01469 *NO  MOVE WRK-TOT-BAL-DUE          TO FTRL-TOT-AMOUNT.               CL123
01470 ***  MOVE SPACES                   TO FTRL-FILLER.                   CL131
01471                                                                      CL*19
01472      PERFORM S946-WRITE-TRAILER THRU S946-EXIT.                      CL121
01473                                                                      CL121
01474                                                                      CL*19
01475  T1000-EXIT.                                                         CL*19
01476      EXIT.                                                           CL*19
01477  T2000-WRITE-TRAILER.                                                CL*74
01478                                                                      CL*74
01479      SET FTRL-TYPE-WAGE-EXP-88   TO TRUE.                            CL123
01480      SET FTRL-SUB-TYPE-TRAILER-88 TO TRUE.                           CL123
01481                                                                      CL*74
01482 **   INCREMENT RECORD COUNT BY 2 TO INCLUDE HEADER                   CL*74
01483 **   AND TRAILER RECORDS.                                            CL*74
01484 **                                                                   CL*74
01485      ADD +2 TO WRK-EFT-WRITTEN-CNTFEWR.                              CL123
01486      MOVE WRK-EFT-WRITTEN-CNTFEWR TO FTRL-RECORD-CNT.                CL123
01487      MOVE ZERO                     TO FTRL-TOT-AMOUNT.               CL123
01488 *NO  MOVE WRK-TOT-BAL-DUE          TO FTRL-TOT-AMOUNT.               CL123
01489 ***  MOVE SPACES                   TO FTRL-FILLER.                   CL131
01490                                                                      CL*74
01491      PERFORM S946-WRITE-TRAILER THRU S946-EXIT.                      CL121
01492                                                                      CL*74
01493  T2000-EXIT.                                                         CL*74
01494      EXIT.                                                           CL*74
01495                                                                      CL*74
01496  S001-FROM-FED-8.                                                    CL234
01497      SET L001-FROM-FED-8 TO TRUE.                                    CL234
01498      GO TO S001-DATE.                                                CL234
01499                                                                      CL234
01500  S001-FROM-ABS-DAY.                                                  CL234
01501      SET L001-FROM-ABS-DAY TO TRUE.                                  CL234
01502      GO TO S001-DATE.                                                CL234
01503                                                                      CL234
01504  S001-DATE.                                                          CL234
01505      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL234
01506  S001-EXIT.                                                          CL234
01507      EXIT.                                                           CL234
01508                                                                      CL234
01509  S003-AGENCY-DAY.                                                    CL234
01510      SET L003-AGENCY-DAY TO TRUE.                                    CL234
01511      GO TO S003-WORK-DAY.                                            CL234
01512                                                                      CL234
01513  S003-WORK-DAY.                                                      CL234
01514      CALL 'DTSBU003' USING L003-LINK-AREA.                           CL234
01515  S003-EXIT.                                                          CL234
01516      EXIT.                                                           CL234
01517                                                                      CL234
01518  S004-FROM-DATE.                                                     CL*33
01519      SET L004-FROM-DATE TO TRUE.                                     CL*33
01520      GO TO S004-QTR.                                                 CL*33
01521                                                                      CL*33
01522  S004-FROM-5.                                                        CL*33
01523      SET L004-FROM-5 TO TRUE.                                        CL*33
01524      GO TO S004-QTR.                                                 CL*33
01525                                                                      CL*33
01526  S004-FROM-ABS.                                                      CL*33
01527      SET L004-FROM-ABS TO TRUE.                                      CL*33
01528      GO TO S004-QTR.                                                 CL*33
01529                                                                      CL*33
01530  S004-FROM-3.                                                        CL*33
01531      SET L004-FROM-3 TO TRUE.                                        CL*33
01532      GO TO S004-QTR.                                                 CL*33
01533                                                                      CL*33
01534  S004-QTR.                                                           CL*33
01535      CALL 'DTSBU004' USING L004-LINK-AREA.                           CL*33
01536  S004-EXIT.                                                          CL*33
01537      EXIT.                                                           CL*33
01538                                                                      CL*33
01539  S101-PER-MONTH-NO.                                                  CL**8
01540      SET L101-PER-MONTH-NO-88 TO TRUE.                               CL**8
01541      GO TO S101-INT-CHARGE.                                          CL**8
01542                                                                      CL**8
01543  S101-INT-CHARGE.                                                    CL**8
01544      CALL 'DTSBU101' USING L101-LINK-AREA.                           CL**8
01545  S101-EXIT.                                                          CL**8
01546      EXIT.                                                           CL**8
01547                                                                      CL**8
01548  S516-LIABILITY.                                                     CL*33
01549      CALL 'DTSBU516' USING L516-LINK-AREA                            CL*33
01550                            MPRF-LINK-REC.                            CL*33
01551  S516-EXIT.                                                          CL*33
01552      EXIT.                                                           CL*33
01553                                                                      CL*33
01554  S910-OPEN-READ.                                                     CL*30
01555      SET L910-OPEN-READ-88 TO TRUE.                                  CL*30
01556      GO TO S910-MSTR-IO.                                             CL*30
01557                                                                      CL*30
01558  S910-OPEN-UPDATE-NO-AIX.                                            CL*30
01559      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                         CL*30
01560      GO TO S910-MSTR-IO.                                             CL*30
01561                                                                      CL*30
01562  S910-READ.                                                          CL*30
01563      SET L910-READ-88 TO TRUE.                                       CL*30
01564      GO TO S910-MSTR-IO.                                             CL*30
01565                                                                      CL*30
01566  S910-START-BROWSE.                                                  CL**9
01567      SET L910-START-BROWSE-88 TO TRUE.                               CL**9
01568      GO TO S910-MSTR-IO.                                             CL**9
01569                                                                      CL*30
01570  S910-READ-NEXT.                                                     CL**9
01571      SET L910-READ-NEXT-88 TO TRUE.                                  CL**9
01572      GO TO S910-MSTR-IO.                                             CL**9
01573                                                                      CL*30
01574  S910-MSTR-IO.                                                       CL**9
01575      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**9
01576                            MSKL-REC.                                 CL**9
01577  S910-EXIT.                                                          CL**9
01578      EXIT.                                                           CL**9
01579                                                                      CL*74
01580  S931-READ.                                                          CL179
01581      SET L931-READ-88 TO TRUE.                                       CL179
01582      GO TO S931-REF-IO.                                              CL179
01583      SKIP1                                                           CL179
01584  S931-REF-IO.                                                        CL179
01585      CALL 'DTSBU931' USING L931-LINK-AREA                            CL179
01586                            FSKL-REC.                                 CL179
01587  S931-EXIT. EXIT.                                                    CL179
01588                                                                      CL121
01589  S946-WRITE-HEADER.                                                  CL121
01590                                                                      CL121
01591       CALL 'DTSBU946' USING FHDR-REC.                                CL124
01592       GO TO S946-EXIT.                                               CL121
01593                                                                      CL121
01594  S946-WRITE-GLOBAL.                                                  CL179
01595                                                                      CL179
01596       CALL 'DTSBU946' USING FGRD-REC.                                CL179
01597       GO TO S946-EXIT.                                               CL179
01598                                                                      CL179
01599  S946-WRITE-FESR.                                                    CL123
01600                                                                      CL121
01601       CALL 'DTSBU946' USING FESR-REC.                                CL123
01602       GO TO S946-EXIT.                                               CL121
01603  S946-WRITE-FEWR.                                                    CL123
01604                                                                      CL121
01605       CALL 'DTSBU946' USING FEWR-REC.                                CL123
01606       GO TO S946-EXIT.                                               CL121
01607  S946-WRITE-TRAILER.                                                 CL121
01608                                                                      CL121
01609       CALL 'DTSBU946' USING FTRL-REC.                                CL124
01610       GO TO S946-EXIT.                                               CL121
01611  S946-EXIT.                                                          CL121
01612       EXIT.                                                          CL121
01613                                                                      CL121
01614  S981A-OPEN-READ.                                                    CL248
01615      SET L981-OPEN-READ-88 TO TRUE.                                  CL248
01616      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                          CL248
01617                                                                      CL*74
01618  S981A-EXIT.                                                         CL248
01619      EXIT.                                                           CL*74
01620                                                                      CL*74
01621  S981C-CLOSE.                                                        CL248
01622      SET L981-CLOSE-88 TO TRUE.                                      CL248
01623      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                          CL248
01624                                                                      CL*74
01625  S981C-EXIT.                                                         CL248
01626      EXIT.                                                           CL*74
01627                                                                      CL*74
01628  S981D-START-BROWSE.                                                 CL248
01629      SET L981-START-BROWSE-88 TO TRUE.                               CL248
01630      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                          CL248
01631                                                                      CL*74
01632  S981D-EXIT.                                                         CL248
01633      EXIT.                                                           CL*74
01634                                                                      CL*74
01635  S981E-READ-NEXT.                                                    CL248
01636      SET L981-READ-NEXT-88 TO TRUE.                                  CL248
01637      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                          CL248
01638                                                                      CL*74
01639  S981E-EXIT.                                                         CL248
01640      EXIT.                                                           CL*74
01641                                                                      CL*74
01642  S981Z-WAGE-I.                                                       CL248
01643      CALL 'DTSBU981' USING L981-LINK-AREA                            CL248
01644                            WWGH-REC.                                 CL248
01645  S981Z-EXIT.                                                         CL248
01646      EXIT.                                                           CL*74
01647                                                                      CL*74
01648  S982A-START-BROWSE.                                                 CL185
01649      SET L982-START-BROWSE-88 TO TRUE.                               CL185
01650      PERFORM S982Z-WNAM-IO THRU S982Z-EXIT.                          CL185
01651                                                                      CL185
01652  S982A-EXIT.                                                         CL185
01653      EXIT.                                                           CL185
01654                                                                      CL185
01655  S982C-OPEN-READ.                                                    CL185
01656      SET L982-OPEN-READ-88 TO TRUE.                                  CL185
01657      PERFORM S982Z-WNAM-IO THRU S982Z-EXIT.                          CL185
01658                                                                      CL185
01659  S982C-EXIT.                                                         CL185
01660      EXIT.                                                           CL185
01661                                                                      CL185
01662  S982D-CLOSE.                                                        CL185
01663      SET L982-CLOSE-88 TO TRUE.                                      CL185
01664      PERFORM S982Z-WNAM-IO THRU S982Z-EXIT.                          CL185
01665                                                                      CL185
01666  S982D-EXIT.                                                         CL185
01667      EXIT.                                                           CL185
01668                                                                      CL185
01669  S982Z-WNAM-IO.                                                      CL186
01670      CALL 'DTSBU982' USING L982-LINK-AREA                            CL185
01671                            WNAM-REC.                                 CL185
01672  S982Z-EXIT.                                                         CL185
01673      EXIT.                                                           CL185
01674                                                                      CL*74
01675  S999-ABEND.                                                      EFTBX100
01676      DISPLAY '*** DTSBE800 ABENDING.  '                              CL*25
01677              ABEND-MSG.                                           EFTBX100
01678                                                                   EFTBX100
01679      CALL 'DTSBU999' USING WRK-ABEND-CD.                          EFTBX100
01680  S999-EXIT.                                                       EFTBX100
01681      EXIT.                                                        EFTBX100
