00001  IDENTIFICATION DIVISION.                                         03/05/04
00002  PROGRAM-ID.             EFTBD140.                                EFTBD140
00003  AUTHOR.                 NORTHROP GRUMMAN.                           LV118
00004  DATE-WRITTEN.           JULY 2003.                                  CL131
00005  DATE-COMPILED.                                                   EFTBD140
00006      SKIP3                                                        EFTBD140
00007 *****                                                             EFTBD140
00008 *                                                                 EFTBD140
00009 *    FUNCTION:  READ THE DAILY FILE OF ELECTRONIC REPORT DATA        CL131
00010 *               SENT FROM GOVONE WEB REPORTING SYSTEM TO DOES.       CL195
00011 *               IT BUILDS DTSIT027 QUARTERLY TAX RPT TRANS REC       CL105
00012 *               AND WRITES THESE RECORDS TO THE DAILY BTC FILE       CL243
00013 *               WHICH IS INPUT TO THE NIGHTLY ACCOUNTING UPDATE.     CL131
00014 *               IT ALSO WRITES DTSIW001 WAGE TRANSACTION RECORD      CL**8
00015 *               TO THE WTC FILE.                                     CL**8
00016 *               THE QUARTERLY REPORT PROCESSING PROGRAM (DTSBD371)   CL131
00017 *               WILL RELEASE THE WAGE TRANSACTIONS FOR PROCESSING    CL131
00018 *               WHEN IT SUCCESSFULLY ADDS A QUARTERLY REPORT RECS    CL138
00019 *               (MRPT) TO THE TAX MASTER FILE.                       CL131
00020 *                                                                    CL131
00021 *    MODIFICATION LOG:                                            EFTBD140
00022 *                                                                 EFTBD140
00023 *    07/01/03  INITIAL DEVELOPMENT                                   CL131
00024 *              WORK ORDER:                      PROGRAMMER: RW1      CL**3
00025 *                                                                    CL**3
00026 *    99/99/99  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**3
00027 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**3
00028 *              WORK ORDER:                      PROGRAMMER: XXX      CL**3
00029 *                                                                 EFTBD140
00030 *  DESCRIPTION:                                                   EFTBD140
00031 *                                                                 EFTBD140
00032 *    INITIATION:                                                  EFTBD140
00033 *      NONE                                                          CL*91
00034 *                                                                 EFTBD140
00035 *    INPUT FILE FORMATS:                                             CL131
00036 *      EFTIFDPT  PAYMENT TRANSACTION                                 CL131
00037 *      EFTIFQTF  QUARTERLY TAX REPORT TRANSACTION                    CL131
00038 *      EFTIFCQW  EMPLOYEE CURRENT QUARTER WAGES                      CL248
00039 *                                                                    CL131
00040 *    OUTPUT FILE FORMATS:                                            CL131
00041 *      DTSIT027  QUARTERLY TAX REPORT TRANSACTION                    CL138
00042 *      DTSIW001  WAGE TRANSACTION                                    CL131
00043 *                                                                    CL*50
00044 *    PROCESSING:                                                  EFTBD140
00045 *      SORT THE TRANSACTIONS BY TRACE NUMBER AND RECORD TYPE.        CL132
00046 *      THIS WILL GROUP ALL RECORDS FROM THE SAME QUARTERLY           CL131
00047 *      REPORT TRANSACTION TOGETHER. WITHIN THE TRACE NUMBER,         CL131
00048 *      THE RECORDS WILL BE IN THE FOLLOWING ORDER: REPORT            CL131
00049 *      RECORD, PAYMENT RECORD, WAGE RECORDS. TRANSACTION FOR         CL131
00050 *      PAYMENT OF A BALANCE DUE OCCURS SINGLY, AND HAVE NO           CL131
00051 *      RELATED RECORDS.                                              CL131
00052 *      ALL RECORDS WITH THE SAME TRACE NUMBER ARE PART OF THE        CL131
00053 *      TRANSACTION (I.E., A COMPLETE QUARTERLY REPORT CONSISTS       CL131
00054 *      OF THE TAX PORTION OF THE REPORT, THE PAYMENT AND THE         CL131
00055 *      WAGES).                                                       CL131
00056 *                                                                    CL131
00057 *    TERMINATION:                                                 EFTBD140
00058 *      OUTPUT STATISTICAL RECORDS COUNT.                             CL*50
00059 *                                                                 EFTBD140
00060 *    RECORDS READ:                                                EFTBD140
00061 *      MASTER:                                                       CL**3
00062 *        VSAM MPRF FILE                                              CL188
00063 *                                                                    CL**3
00064 *      ALTERNATE INDEX:                                           EFTBD140
00065 *        NONE.                                                    EFTBD140
00066 *                                                                 EFTBD140
00067 *      REFERENCE:                                                 EFTBD140
00068 *        NONE.                                                    EFTBD140
00069 *                                                                 EFTBD140
00070 *    RECORDS UPDATED:                                                CL**3
00071 *        NONE                                                        CL249
00072 *                                                                 EFTBD140
00073 *    REPORT RECORDS WRITTEN:                                      EFTBD140
00074 *        R907 ERROR REPORT RECORDS.                                  CL188
00075 *                                                                    CL*50
00076 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                   CL241
00077 *        T027 RECORDS                                                CL243
00078 *                                                                    CL131
00079 *    WAGE TRANSACTION COLLECTION RECORDS WRITTEN:                    CL131
00080 *        W001 RECORDS                                                CL131
00081 *                                                                 EFTBD140
00082 *    MODULES CALLED:                                              EFTBD140
00083 *        DTSBU001  DATE CONVERSION/EDIT.                          EFTBD140
00084 *        DTSBU004  QUARERLY SUMMARY REPORT REC.                      CL*47
00085 *        DTSBU910  VSAM MASTER FILES I/O.                            CL*74
00086 *        DTSBU927  VARIABLE LENGTH RECORDS BTC OUTPUT.               CL*96
00087 *        DTSBU941  VARIABLE LENGTH RECORDS INPUT 1.                  CL134
00088 *        DTSBU947  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 2.      CL133
00089 *        DTSBU983  BATCH WAGE TRANSACTION FILE INPUT/OUTPUT.         CL176
00090 *                                                                    CL176
00091 *    VERMONT REFERENCE:                                           EFTBD140
00092 *        NONE.                                                    EFTBD140
00093 *                                                                 EFTBD140
00094 *****                                                             EFTBD140
00095      SKIP3                                                           CL*13
00096  ENVIRONMENT DIVISION.                                            EFTBD140
00097                                                                      CL*58
00098  INPUT-OUTPUT SECTION.                                               CL*58
00099                                                                      CL*86
00100  FILE-CONTROL.                                                       CL*86
00101       SELECT WAGE-TRAN-FILE ASSIGN TO DTSFW001                       CL*86
00102              FILE STATUS IS WAGE-STATUS.                             CL*86
00103                                                                      CL*58
00104  DATA DIVISION.                                                      CL*86
00105                                                                      CL*86
00106  FILE SECTION.                                                       CL*86
00107                                                                      CL*86
00108  FD  WAGE-TRAN-FILE                                                  CL*86
00109      RECORDING MODE IS F                                             CL*94
00110      LABEL RECORDS ARE STANDARD                                      CL*94
00111      BLOCK CONTAINS 0 CHARACTERS.                                    CL*86
00112      SKIP1                                                           CL*86
00113  01  WAGE-TRAN-REC.                                                  CL*86
00114  ++INCLUDE DTSIWSKL                                                  CL*86
00115                                                                      CL*32
00116                                                                      CL*32
00117  WORKING-STORAGE SECTION.                                         EFTBD140
001175 77  PAN-VALET PICTURE X(24) VALUE '118EFTBD140  03/05/04'.       EFTBD140
00118                                                                      CL*40
00119  01  WRK-AREA.                                                    EFTBD140
00120      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +140.   CL197
00121      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'EFTBD140'.   CL197
00122      05  WRK-ABEND-MSG               PIC  X(60).                     CL*83
00123                                                                      CL*69
00124      05  EFT-STATUS                  PIC  X(02).                     CL*58
00125          88 EFT-STATUS-OK-88          VALUE '00'.                    CL*58
00126          88 EFT-STATUS-EOF-88         VALUE '10'.                    CL177
00127                                                                      CL*32
00128      05  WAGE-STATUS                 PIC  X(02).                     CL*86
00129          88 WAGE-STATUS-OK-88          VALUE '00'.                   CL*86
00130          88 WAGE-STATUS-EOF-88         VALUE '10'.                   CL*86
00131                                                                      CL*86
00132      05  WRK-TRACE-IND               PIC  X(01)  VALUE SPACES.       CL*90
00133                                                                      CL*58
00134      05  WRK-TOT-WAGE                PIC S9(11)V99      VALUE +0.    CL*70
00135      05  WRK-EXCESS-WAGE             PIC S9(09)V99      VALUE +0.    CL*70
00136                                                                      CL*91
00137      05  WRK-MOPO-T002-IND           PIC  X(01).                     CL*91
00138          88 WRK-MOPO-T002-YES-88         VALUE 'Y'.                  CL*91
00139          88 WRK-MOPO-T002-NO-88          VALUE 'N'.                  CL*91
00140                                                                      CL*93
00141      05  WRK-MOPO-IND                PIC  X(01).                     CL*93
00142          88 WRK-MOPO-FOUND-YES-88       VALUE 'Y'.                   CL*93
00143          88 WRK-MOPO-FOUND-NO-88        VALUE 'N'.                   CL*93
00144                                                                      CL*93
00145      05  ERR-UNEXPECTED-WAGE-IND     PIC  X(01).                     CL*65
00146          88  ERR-UNEXPECTED-WAGE-YES-88  VALUE 'Y'.                  CL*65
00147          88  ERR-UNEXPECTED-WAGE-NO-88   VALUE 'N'.                  CL*65
00148                                                                   EFTBD140
00149      05  ERR-T027-PASS-EDITS-IND     PIC  X(01).                     CL*65
00150          88  ERR-T027-PASS-EDITS-YES-88  VALUE 'Y'.                  CL*65
00151          88  ERR-T027-PASS-EDITS-NO-88   VALUE 'N'.                  CL*65
00152                                                                      CL239
00153      05  DISP-DATE                   PIC  X(10)  VALUE SPACES.       CL*92
00154      05  DISP-TIME                   PIC  X(08)  VALUE SPACES.       CL*92
00155      05  WRK-SYS-TIME                PIC  X(06)  VALUE SPACES.       CL*92
00156      05  WRK-SYS-DATE                PIC  X(08)  VALUE SPACES.       CL*92
00157      05  WRK-CURR-YR                 PIC  9(04)  VALUE ZEROS.        CL*92
00158      05  WRK-CURR-YRQ                PIC S9(05)  COMP-3.             CL154
00159                                                                      CL154
00160      05  WRK-L001-JUL-DATE           PIC  9(7) VALUE ZERO.           CL*79
00161      05  FILLER REDEFINES WRK-L001-JUL-DATE.                         CL*79
00162          10  WRK-JULIAN-YR-1ST-3     PIC  9(3).                      CL*79
00163          10  WRK-JULIAN-YR-DAYS      PIC  9(4).                      CL*79
00164                                                                      CL150
00165      05  WRK-PSEUDO-BATCH-NO         PIC  9(05) VALUE ZERO.          CL*79
00166      05  FILLER REDEFINES WRK-PSEUDO-BATCH-NO.                       CL*79
00167          10  WRK-PSEUDO-YR-DAYS      PIC  9(04).                     CL*79
00168          10  WRK-PSEUDO-BATCH-SEQ    PIC  9(01).                     CL*79
00169                                                                      CL150
00170      05  WRK-PSEUDO-ITEM-NO          PIC  9(03)  VALUE 0.            CL*79
00171      05  WRK-SEQ-NO                  PIC  9(07)  VALUE 0.            CL*68
00172                                                                      CL150
00173      05  WRK-YRQ-AREA                PIC  9(05).                     CL*78
00174      05  FILLER REDEFINES WRK-YRQ-AREA.                              CL*78
00175          10  WRK-YRQ-CCYY            PIC  9(04).                     CL*78
00176          10  WRK-YRQ-Q               PIC  9(01).                     CL*78
00177                                                                      CL*78
00178      05  WRK-EMP-NO                  PIC  9(06)  VALUE 0.            CL138
00179      05  WRK-CURR-PAY-TRACE-NO       PIC  9(13)  VALUE 0.            CL*65
00180      05  WRK-RPT-REC-CNT             PIC S9(07)  COMP-3 VALUE +0.    CL*65
00181      05  WRK-PAY-REC-CNT             PIC S9(07)  COMP-3 VALUE +0.    CL*65
00182      05  WRK-WAGE-REC-CNT            PIC S9(07)  COMP-3 VALUE +0.    CL*65
00183      05  WRK-T027-CNT                PIC S9(07)  COMP-3 VALUE +0.    CL*65
00184      05  WRK-W001-CNT                PIC S9(07)  COMP-3 VALUE +0.    CL*65
00185      05  WRK-R907-CNT                PIC S9(07)  COMP-3 VALUE +0.    CL*65
00186      05  WRK-FAIL-EDITS-CNT          PIC S9(07)  COMP-3 VALUE +0.    CL*65
00187      05  WRK-T002-CONTACT-CNT        PIC S9(07)  COMP-3 VALUE +0.    CL*92
00188      05  WRK-L076-NAME               PIC  X(32)  VALUE SPACES.       CL116
00189                                                                      CL*92
00190      05  WRK-MSG-TEXT.                                               CL112
00191          10 WRK-MSG-LINE             PIC  X(32).                     CL116
00192          10 FILLER                   PIC  X(02)  VALUE SPACES.       CL112
00193          10 FILLER                   PIC  X(14)  VALUE               CL168
00194                                       'FQTF-EMP-NO = '.              CL168
00195 *        10 WRK-ERR-PAY-AMT          PIC  9(06)9.99.                 CL124
00196          10 WRK-ERR-PAY-AMT          PIC  X(10).                     CL124
00197          10 WRK-ERR-EMP-NO-X REDEFINES WRK-ERR-PAY-AMT.              CL115
00198             15  WRK-ERR-EMP-NO       PIC  X(06).                     CL112
00199             15  FIL-EMP-NO           PIC  X(04).                     CL114
00200          10 WRK-ERR-PAY-TRACE-NO-X REDEFINES WRK-ERR-PAY-AMT.        CL115
00201             15  WRK-ERR-PAY-TRACE-NO PIC  X(05).                     CL114
00202             15  FIL-PAY-TRACE-NO     PIC  X(05).                     CL115
00203          10 WRK-ERR-PAY-DATE-X REDEFINES WRK-ERR-PAY-AMT.            CL115
00204             15  WRK-ERR-PAY-DATE     PIC  X(08).                     CL112
00205             15  FIL-PAY-DATE         PIC  X(02).                     CL114
00206          10 WRK-ERR-PAY-TIME-X REDEFINES WRK-ERR-PAY-AMT.            CL115
00207             15  WRK-ERR-PAY-TIME     PIC  X(06).                     CL112
00208             15  FIL-PAY-TIME         PIC  X(04).                     CL114
00209                                                                      CL166
00210      05  MSG1-AREA.                                                  CL*67
00211          10  MSG1-ID           PIC X(03) VALUE '101'.                CL*67
00212          10  MSG1-TEXT.                                              CL*67
00213              15  FILLER        PIC X(30)                             CL*67
00214                    VALUE 'TOTAL WAGES DO NOT =  REPORTED'.           CL*99
00215              15  FILLER        PIC X(30)                             CL*67
00216                    VALUE ' TOTAL WAGES OR NO WAGES RECS '.           CL*99
00217              15  FILLER        PIC X(02) VALUE SPACES.               CL*67
00218              15  MSG1-TRACE-NO PIC 9(13).                            CL*67
00219                                                                      CL169
00220      05  MSG2-AREA.                                                  CL*67
00221          10  MSG2-ID           PIC X(03) VALUE '102'.                CL*67
00222          10  MSG2-TEXT.                                              CL*67
00223              15  FILLER        PIC X(30)                             CL*67
00224                    VALUE 'DUPLICATE PAYMENT FOUND       '.           CL*82
00225              15  FILLER        PIC X(30)                             CL*67
00226                    VALUE '                              '.           CL*82
00227              15  FILLER        PIC X(02) VALUE SPACES.               CL*67
00228              15  MSG2-TRACE-NO PIC 9(13).                            CL*67
00229                                                                      CL*67
00230      05  MSG3-AREA.                                                  CL*67
00231          10  MSG3-ID           PIC X(03) VALUE '103'.                CL*67
00232          10  MSG3-TEXT.                                              CL*67
00233              15  FILLER        PIC X(30)                             CL*67
00234                    VALUE 'PAYMENT FOUND WITHOUT REPORT  '.           CL*82
00235              15  FILLER        PIC X(30)                             CL*67
00236                    VALUE '                              '.           CL*82
00237              15  FILLER        PIC X(02) VALUE SPACES.               CL*67
00238              15  MSG3-TRACE-NO PIC 9(13).                            CL*67
00239                                                                      CL*67
00240      05  MSG4-AREA.                                                  CL*67
00241          10  MSG4-ID           PIC X(03) VALUE '104'.                CL*67
00242          10  MSG4-TEXT.                                              CL*67
00243              15  FILLER        PIC X(30)                             CL*67
00244                    VALUE 'PAYMENT AMT ON PAYMENT RECORD '.           CL*97
00245              15  FILLER        PIC X(30)                             CL*67
00246                    VALUE 'NOT = PAYMENT AMT ON REPORT   '.           CL*97
00247              15  FILLER        PIC X(02) VALUE SPACES.               CL*67
00248              15  MSG4-TRACE-NO PIC 9(13).                            CL*67
00249                                                                      CL*67
00250      05  MSG5-AREA.                                                  CL*67
00251          10  MSG5-ID           PIC X(03) VALUE '105'.                CL*67
00252          10  MSG5-TEXT.                                              CL*67
00253              15  FILLER        PIC X(30)                             CL*67
00254                    VALUE 'WAGE RECORD FOUND WITHOUT REPO'.           CL*82
00255              15  FILLER        PIC X(30)                             CL*67
00256                    VALUE 'RT                            '.           CL*82
00257              15  FILLER        PIC X(02) VALUE SPACES.               CL*67
00258              15  MSG5-TRACE-NO PIC 9(13).                            CL*67
00259                                                                      CL*67
00260      05  MSG6-AREA.                                                  CL*67
00261          10  MSG6-ID           PIC X(03) VALUE '106'.                CL*67
00262          10  MSG6-TEXT.                                              CL*67
00263              15  FILLER        PIC X(30)                             CL*67
00264                    VALUE 'WAGE RECORD FOUND, BUT WAGES A'.           CL*82
00265              15  FILLER        PIC X(30)                             CL*67
00266                    VALUE 'RE SUBMITTED ON TAPE          '.           CL*82
00267              15  FILLER        PIC X(02) VALUE SPACES.               CL*67
00268              15  MSG6-TRACE-NO PIC 9(13).                            CL*67
00269                                                                      CL*67
00270      05  MSG7-AREA.                                                  CL*67
00271          10  MSG7-ID           PIC X(03) VALUE '107'.                CL*67
00272          10  MSG7-TEXT.                                              CL*67
00273              15  FILLER        PIC X(30)                             CL*67
00274                    VALUE 'WAGE RECORD FOUND, BUT ZERO WA'.           CL*82
00275              15  FILLER        PIC X(30)                             CL*67
00276                    VALUE 'GES REPORTED                  '.           CL*82
00277              15  FILLER        PIC X(02) VALUE SPACES.               CL*67
00278              15  MSG7-TRACE-NO PIC 9(13).                            CL*67
00279                                                                      CL*67
00280      05  MSG8-AREA.                                                  CL*81
00281          10  MSG8-ID           PIC X(03) VALUE '108'.                CL*81
00282          10  MSG8-TEXT.                                              CL*81
00283              15  FILLER        PIC X(30)                             CL*81
00284                    VALUE 'NO MATCHING PAYMENT FOR REPORT'.           CL*82
00285              15  FILLER        PIC X(30)                             CL*81
00286                    VALUE '                              '.           CL*82
00287              15  FILLER        PIC X(02) VALUE SPACES.               CL*81
00288              15  MSG8-TRACE-NO PIC 9(13).                            CL*81
00289                                                                      CL*93
00290      05  MSG9-AREA.                                                  CL*93
00291          10  MSG9-ID           PIC X(03) VALUE '109'.                CL*93
00292          10  MSG9-TEXT.                                              CL*93
00293              15  FILLER        PIC X(30)                             CL*93
00294                    VALUE 'FQTF REPORT NAME IS INVALID   '.           CL*93
00295              15  FILLER        PIC X(30)                             CL*93
00296                    VALUE '                              '.           CL*93
00297              15  FILLER        PIC X(02) VALUE SPACES.               CL*93
00298              15  MSG9-TRACE-NO PIC 9(13).                            CL*93
00299                                                                      CL*81
00300                                                                      CL166
00301      05  WRK-ERROR-IND               PIC  X(01).                     CL152
00302          88 WRK-ERROR-YES-88                VALUE 'Y'.               CL152
00303          88 WRK-ERROR-NO-88                 VALUE 'N'.               CL152
00304                                                                      CL159
00305      05  WRK-FIRST-READ-IND          PIC  X(01).                     CL159
00306          88 WRK-FIRST-READ-YES-88           VALUE 'Y'.               CL159
00307          88 WRK-FIRST-READ-NO-88            VALUE 'N'.               CL159
00308                                                                      CL*76
00309      05  WRK-MPRF-IND                PIC  X(01).                  EFTBD140
00310          88 WRK-MPRF-YES-88                 VALUE 'Y'.            EFTBD140
00311          88 WRK-MPRF-NO-88                  VALUE 'N'.            EFTBD140
00312                                                                      CL143
00313      05  WRK-FQTF-REC-WRITE-IND      PIC  X(01).                     CL143
00314          88 WRK-FQTF-REC-WRITE-YES-88       VALUE 'Y'.               CL143
00315          88 WRK-FQTF-REC-WRITE-NO-88        VALUE 'N'.               CL143
00316                                                                      CL*16
00317  01  WRK-PAYMENT-DATE                PIC X(08).                      CL*85
00318  01  WRK-PAYMENT-DATE-9 REDEFINES WRK-PAYMENT-DATE                   CL*85
00319                                      PIC 9(08).                      CL*85
00320  01  WRK-PAYMENT-CCYYMMDD REDEFINES WRK-PAYMENT-DATE.                CL*85
00321      10 WRK-DATE-CCYY                PIC  9(04).                     CL*90
00322      10 WRK-DATE-MM                  PIC  9(02).                     CL*90
00323      10 WRK-DATE-DD                  PIC  9(02).                     CL*90
00324                                                                      CL*84
00325  01  WRK-PAYMENT-TIME                PIC X(06).                      CL*85
00326  01  WRK-PAYMENT-TIME-9 REDEFINES WRK-PAYMENT-TIME                   CL*85
00327                                      PIC 9(06).                      CL*85
00328  01  WRK-PAYMENT-HHMMSS REDEFINES WRK-PAYMENT-TIME.                  CL101
00329      10 WRK-TIME-HH                  PIC  9(02).                     CL*90
00330      10 WRK-TIME-MM                  PIC  9(02).                     CL*90
00331      10 WRK-TIME-SS                  PIC  9(02).                     CL*90
00332                                                                      CL*74
00333  01  FQTF-REC.                                                       CL137
00334  ++INCLUDE EFTIFQTF                                                  CL137
00335      SKIP3                                                           CL*58
00336  01  FDPT-REC.                                                       CL137
00337  ++INCLUDE EFTIFDPT                                                  CL137
00338      SKIP3                                                           CL137
00339  01  FCQW-REC.                                                       CL183
00340  ++INCLUDE EFTIFCQW                                                  CL183
00341      SKIP3                                                           CL137
00342  01  T027-REC.                                                       CL219
00343  ++INCLUDE DTSIT027                                                  CL219
00344      SKIP3                                                           CL219
00345  01  T002-REC.                                                       CL*91
00346  ++INCLUDE DTSIT002                                                  CL*91
00347      SKIP3                                                           CL*91
00348  01  R907-REC.                                                       CL219
00349  ++INCLUDE DTSIR907                                                  CL219
00350      SKIP3                                                           CL219
00351  01  L001-LINK-AREA.                                              EFTBD140
00352  ++INCLUDE DTSIL001                                               EFTBD140
00353      EJECT                                                        EFTBD140
00354  01  L003-LINK-AREA.                                                 CL*56
00355  ++INCLUDE DTSIL003                                                  CL*56
00356      EJECT                                                           CL*24
00357  01  L004-LINK-AREA.                                                 CL*56
00358  ++INCLUDE DTSIL004                                                  CL*56
00359      EJECT                                                           CL*56
00360  01  L005-COMM-AREA.                                                 CL*61
00361  ++INCLUDE DTSIL005                                                  CL*61
00362      EJECT                                                           CL100
00363  01  L516-LINK-AREA.                                              EFTBD140
00364  ++INCLUDE DTSIL516                                               EFTBD140
00365      EJECT                                                           CL*92
00366  01  L076-LINK-AREA.                                                 CL116
00367  ++INCLUDE DTSIL076                                                  CL116
00368      EJECT                                                           CL*92
00369  01  L910-LINK-AREA.                                                 CL*94
00370  ++INCLUDE DTSIL910                                                  CL*94
00371      EJECT                                                           CL*94
00372  01  MSKL-REC.                                                       CL*70
00373  ++INCLUDE DTSIMSKL                                                  CL*70
00374      EJECT                                                           CL*70
00375  01  MPRF-REC.                                                       CL*70
00376  ++INCLUDE DTSIMPRF                                                  CL*70
00377      EJECT                                                           CL211
00378  01  MQTR-REC.                                                       CL*70
00379  ++INCLUDE DTSIMQTR                                                  CL*70
00380      EJECT                                                           CL*70
00381  01  MOPO-REC.                                                       CL*92
00382  ++INCLUDE DTSIMOPO                                                  CL*92
00383      EJECT                                                           CL*92
00384  01  L927-LINK-AREA.                                                 CL212
00385  ++INCLUDE DTSIL927                                                  CL212
00386      EJECT                                                           CL212
00387  01  TSKL-REC.                                                       CL212
00388  ++INCLUDE DTSITSKL                                                  CL212
00389      EJECT                                                           CL212
00390  01  L985-LINK-AREA.                                                 CL*48
00391  ++INCLUDE DTSIL985                                                  CL*48
00392                                                                      CL*68
00393  01  W001-REC.                                                       CL*68
00394 *    05  W001-LENGTH               PIC S9(04) COMP.                  CL*86
00395 *    05  W001-DATA.                                                  CL*86
00396  ++INCLUDE DTSIW001                                                  CL*68
00397                                                                      CL200
00398  LINKAGE SECTION.                                                    CL200
00399  01  EFT-REC-TYPE-LINK-AREA.                                         CL200
00400  ++INCLUDE EFTIL100                                                  CL200
00401  01  RSKL-REC.                                                       CL200
00402  ++INCLUDE EFTIRSKL                                                  CL200
00403      EJECT                                                           CL200
00404                                                                      CL200
00405  PROCEDURE DIVISION USING                                            CL201
00406                     EFT-REC-TYPE-LINK-AREA                           CL201
00407                     RSKL-REC.                                        CL211
00408                                                                      CL201
00409       IF EFT-L100-CMD-INIT-88                                        CL201
00410          PERFORM I0000-INITIALIZE THRU I0000-EXIT                    CL201
00411       ELSE                                                           CL201
00412         IF EFT-L100-CMD-PROCESS-88                                   CL201
00413            PERFORM P0000-PROCESS THRU P0000-EXIT                     CL201
00414         ELSE                                                         CL201
00415           IF EFT-L100-CMD-TERMINATE-88                               CL*16
00416              PERFORM T0000-TERMINATE THRU T0000-EXIT                 CL201
00417           ELSE                                                       CL201
00418              DISPLAY 'INVALID CALL FROM BD100 '                      CL*69
00419              PERFORM S999-ABEND THRU S999-EXIT.                      CL201
00420                                                                      CL201
00421      GOBACK.                                                      EFTBD140
00422      EJECT                                                        EFTBD140
00423  I0000-INITIALIZE.                                                EFTBD140
00424      MOVE WRK-MOD-NAME         TO R907-MODULE-NAME                   CL*71
00425                                   L985-MOD-NAME.                     CL*71
00426      MOVE LENGTH OF R907-REC   TO R907-LENGTH.                       CL*67
00427 ***  MOVE LENGTH OF W001-DATA  TO W001-LENGTH.                       CL*86
00428      MOVE LENGTH OF T027-REC   TO T027-LENGTH.                       CL*67
00429      MOVE LENGTH OF T002-REC   TO T002-LENGTH.                       CL*91
00430                                                                      CL*91
00431      PERFORM I1000-SYS-DATE    THRU I1000-EXIT.                      CL*74
00432      PERFORM I2000-OPEN-FILES  THRU I2000-EXIT.                      CL*86
00433      PERFORM I3000-INIT-RECS   THRU I3000-EXIT.                      CL*62
00434                                                                      CL179
00435  I0000-EXIT.                                                      EFTBD140
00436      EXIT.                                                        EFTBD140
00437                                                                      CL107
00438  I1000-SYS-DATE.                                                     CL*72
00439      SET L005-FROM-SYS       TO TRUE.                                CL151
00440      PERFORM S005-SYS-DATE   THRU S005-EXIT.                         CL151
00441      MOVE L005-DATE          TO DISP-DATE.                           CL151
00442      MOVE L005-TIME          TO DISP-TIME.                           CL151
00443      MOVE L005-SLASH-DATE    TO WRK-SYS-DATE.                        CL151
00444      MOVE L005-DISPLAY-TIME  TO WRK-SYS-TIME.                        CL151
00445      MOVE L005-SLASH-8-YR    TO WRK-CURR-YR.                         CL151
00446                                                                      CL151
00447      MOVE L005-DATE          TO L001-FED-8-DATE-9.                   CL151
00448      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                         CL151
00449      MOVE L001-JUL-DATE      TO WRK-L001-JUL-DATE.                   CL*79
00450      MOVE WRK-JULIAN-YR-DAYS TO WRK-PSEUDO-YR-DAYS.                  CL*79
00451      MOVE ZERO               TO WRK-PSEUDO-BATCH-SEQ.                CL*79
00452      MOVE 1                  TO WRK-PSEUDO-ITEM-NO.                  CL*79
00453                                                                      CL*72
00454      MOVE L005-DATE          TO L004-DATE.                           CL154
00455      SET L004-FROM-DATE      TO TRUE.                                CL154
00456      PERFORM S004-YRQ        THRU S004-EXIT.                         CL154
00457      MOVE L004-QTR-5-9       TO WRK-CURR-YRQ.                        CL154
00458                                                                      CL154
00459      DISPLAY '    '.                                                 CL*72
00460      DISPLAY 'CURRENT DATE ' DISP-DATE                               CL*69
00461              '  CURRENT-TIME ' DISP-TIME                             CL*69
00462              '  CURRENT YEAR ' WRK-CURR-YR                           CL*70
00463              '  STARTING BATCH ' WRK-PSEUDO-BATCH-NO                 CL*79
00464              '  ITEM ' WRK-PSEUDO-ITEM-NO.                           CL*79
00465                                                                      CL*69
00466  I1000-EXIT.                                                         CL*72
00467      EXIT.                                                           CL*72
00468                                                                      CL**1
00469  I2000-OPEN-FILES.                                                   CL*86
00470      OPEN OUTPUT WAGE-TRAN-FILE.                                     CL*86
00471      IF NOT WAGE-STATUS-OK-88                                        CL*86
00472         DISPLAY 'WAGE FILE OPEN ERROR: ' WAGE-STATUS                 CL*87
00473         PERFORM S999-ABEND THRU S999-EXIT.                           CL*86
00474                                                                      CL*86
00475                                                                      CL*86
00476  I2000-EXIT.                                                         CL*86
00477      EXIT.                                                           CL*86
00478                                                                      CL*58
00479  I3000-INIT-RECS.                                                    CL*62
00480      INITIALIZE            FQTF-DATA-AREA                            CL*62
00481                            FDPT-DATA-AREA                            CL*62
00482                            FCQW-DATA-AREA.                           CL*62
00483                                                                      CL*62
00484      MOVE ZERO          TO T027-EMP-NO                               CL*84
00485                            T027-SYS-DATE                             CL*84
00486                            T027-SYS-TIME                             CL*84
00487                            T027-PSEUDO-BATCH-NO                      CL*84
00488                            T027-PSEUDO-ITEM-NO                       CL*84
00489                            T027-YRQ                                  CL*84
00490                            T027-TOT-WAGE                             CL*84
00491                            T027-EXCESS-WAGE                          CL*84
00492                            T027-TAX-WAGE                             CL*84
00493                            T027-REMIT-AMT                            CL*84
00494                            T027-TOTAL-EMPL-CNT                       CL*84
00495                            T027-1ST-MTH-EMPL-CNT                     CL*84
00496                            T027-2ND-MTH-EMPL-CNT                     CL*84
00497                            T027-3RD-MTH-EMPL-CNT                     CL*84
00498                            T027-RECEIVED-DATE                        CL*84
00499                            T027-DEPOSIT-DATE                         CL*84
00500                            T027-TRACE-NO.                            CL*84
00501                                                                      CL*84
00502      MOVE SPACES        TO T027-ORIGIN                               CL*84
00503                            T027-TRN-TYPE                             CL*84
00504                            T027-NAME-CHECK                           CL*84
00505                            T027-RPT-TYPE                             CL*84
00506                            T027-WAIVE-BOTH-IND                       CL*84
00507                            T027-WAIVE-INT-IND                        CL*84
00508                            T027-WAIVE-LATE-PEN-IND                   CL*84
00509                            T027-RESPONSIBLE-ACTIVITY                 CL*84
00510                            T027-RESPONSIBLE-OP-ID                    CL*84
00511                            T027-PASSED-FULL-EDITS-IND.               CL*84
00512                                                                      CL*84
00513      MOVE ZERO          TO W001-BATCH-NO                             CL*84
00514                            W001-ITEM-NO                              CL*84
00515                            W001-SEQ-NO                               CL*84
00516                            W001-EMP-NO                               CL*84
00517                            W001-SSN                                  CL*84
00518                            W001-SSN-ERR-ID                           CL*84
00519                            W001-NAME-ERR-ID                          CL*84
00520                            W001-YRQ                                  CL*84
00521                            W001-WAGE-CHNG                            CL*84
00522                            W001-WAGE-ERR-ID                          CL*84
00523                            W001-CURR-WAGE                            CL*84
00524                            W001-TAX-WAGE                             CL*84
00525                            W001-PRIOR-WAGE                           CL*84
00526                            W001-RECEIVED-DATE                        CL*84
00527                            W001-RECEIVED-TIME.                       CL*84
00528                                                                      CL*84
00529      MOVE SPACES        TO W001-NAME                                 CL*84
00530                            W001-RESPONSIBLE-OP-ID                    CL*84
00531                            W001-SOURCE.                              CL*84
00532                                                                      CL*84
00533  I3000-EXIT.                                                         CL*62
00534      EXIT.                                                           CL*62
00535                                                                      CL*91
00536  I4000-INIT-T002.                                                    CL*91
00537                                                                      CL*93
00538      SET WRK-MOPO-T002-NO-88  TO TRUE.                               CL*91
00539      SET WRK-MOPO-FOUND-NO-88 TO TRUE.                               CL*93
00540                                                                      CL*93
00541      MOVE ZERO          TO T002-EMP-NO                               CL*91
00542                            T002-SYS-DATE                             CL*91
00543                            T002-SYS-TIME.                            CL*91
00544                                                                      CL*91
00545      MOVE SPACES        TO T002-ORIGIN                               CL*91
00546                            T002-DATA-AREA.                           CL*91
00547                                                                      CL*91
00548  I4000-EXIT.                                                         CL*91
00549      EXIT.                                                           CL*91
00550                                                                      CL*91
00551 ***************************************************************      CL*89
00552 *      SORT THE TRANSACTIONS BY TRACE NUMBER AND RECORD TYPE. *      CL*89
00553 *      THIS WILL GROUP ALL RECORDS FROM THE SAME QUARTERLY    *      CL*89
00554 *      REPORT TRANSACTION TOGETHER. WITHIN THE TRACE NUMBER,  *      CL*89
00555 *      THE RECORDS WILL BE IN THE FOLLOWING ORDER: REPORT     *      CL*89
00556 *      RECORD, PAYMENT RECORD, WAGE RECORDS. TRANSACTION FOR  *      CL*89
00557 *      PAYMENT OF A BALANCE DUE OCCURS SINGLY, AND HAVE NO    *      CL*89
00558 *      RELATED RECORDS.                                       *      CL*89
00559 ***************************************************************      CL*89
00560                                                                   EFTBD140
00561  P0000-PROCESS.                                                   EFTBD140
00562      EVALUATE TRUE                                                   CL*62
00563         WHEN RSKL-TYPE-QTR-TAX-RPT-88                                CL*62
00564            PERFORM P1000-REPORT    THRU P1000-EXIT                   CL*62
00565                                                                      CL236
00566         WHEN RSKL-TYPE-PAYMENT-88                                    CL*62
00567            PERFORM P2000-PAYMENT   THRU P2000-EXIT                   CL*62
00568                                                                      CL*62
00569         WHEN RSKL-TYPE-WAGE-IMP-88                                   CL*62
00570            PERFORM P3000-WAGE      THRU P3000-EXIT                   CL*62
00571                                                                      CL*62
00572         WHEN OTHER                                                   CL*62
00573            DISPLAY 'INVALID RECORD TYPE ' RSKL-REC-TYPE              CL*62
00574               '  ' RSKL-SUB-TYPE                                     CL*62
00575                                                                      CL*62
00576      END-EVALUATE.                                                   CL*62
00577                                                                      CL*62
00578                                                                      CL232
00579  P0000-EXIT.                                                      EFTBD140
00580      EXIT.                                                        EFTBD140
00581                                                                      CL*72
00582 ***************************************************************      CL*88
00583 * FOR EACH TAX FILE REPORT RECORD, A T027 TRANSACTION RECORD  *      CL*88
00584 * WILL BE CREATED. IF THE PAYMENT AMOUNT NOT MATCHED THE TAX  *      CL*88
00585 * FILE REPORT AMOUNT A R907 ERROR RECORD WILL BE WRITTE AND   *      CL*88
00586 * PRESENTS ON THE R907 ERRORS REPORT.                         *      CL*88
00587 ***************************************************************      CL*88
00588                                                                      CL*88
00589  P1000-REPORT.                                                       CL*62
00590      ADD +1                          TO WRK-RPT-REC-CNT.             CL*69
00591      IF FQTF-TRACE-NO > ZERO                                         CL*62
00592         PERFORM P1100-CHK-TOT-WAGE   THRU P1100-EXIT                 CL*69
00593      END-IF.                                                         CL*62
00594                                                                      CL*62
00595      PERFORM I3000-INIT-RECS         THRU I3000-EXIT.                CL*62
00596                                                                      CL*62
00597      MOVE ZERO                       TO WRK-TOT-WAGE                 CL*65
00598                                         WRK-CURR-PAY-TRACE-NO.       CL*65
00599                                                                      CL*65
00600      SET ERR-T027-PASS-EDITS-YES-88  TO TRUE.                        CL*65
00601      SET ERR-UNEXPECTED-WAGE-NO-88   TO TRUE.                        CL*65
00602                                                                      CL*65
00603      MOVE RSKL-REC                   TO FQTF-REC.                    CL*63
00604                                                                      CL*63
00605      PERFORM P1200-EDIT-FQTF         THRU P1200-EXIT.             EFTBD140
00606      PERFORM P1300-WRITE-T027        THRU P1300-EXIT.             EFTBD140
00607      PERFORM P1400-WRITE-T002        THRU P1400-EXIT.                CL*90
00608                                                                      CL*62
00609  P1000-EXIT.                                                         CL*62
00610      EXIT.                                                           CL*62
00611                                                                      CL*63
00612  P1100-CHK-TOT-WAGE.                                                 CL*63
00613                                                                      CL*63
00614      IF WRK-TOT-WAGE               NOT = FQTF-TOTAL-WAGES AND        CL110
00615         FQTF-WAGE-RPT-IND  = 'Y'                                     CL110
00616         MOVE MSG1-ID               TO R907-MSG-ID                    CL*67
00617 *       MOVE FCQW-EMP-NO           TO R907-EMP-NO                    CL101
00618         MOVE FQTF-EMP-NO           TO R907-EMP-NO                    CL101
00619 *       MOVE FCQW-EMPL-TRACE-NO    TO MSG1-TRACE-NO                  CL*98
00620         MOVE FQTF-TRACE-NO         TO MSG1-TRACE-NO                  CL*98
00621         MOVE MSG1-TEXT             TO R907-MSG-TEXT                  CL*67
00622         PERFORM S946-WRITE-R907    THRU S946-EXIT                    CL*63
00623         ADD +1                     TO WRK-R907-CNT                   CL*68
00624         DISPLAY 'BD140 P1100 TOT WAGE <> REP WAGE OR NO WAGE RECS'   CL100
00625           '  FCQW-EMP-NO = ' FCQW-EMP-NO '  ' ' FQTF-EMP-NO = '      CL102
00626              FQTF-EMP-NO                                             CL*96
00627      END-IF.                                                         CL*63
00628                                                                      CL*63
00629  P1100-EXIT.                                                         CL*63
00630      EXIT.                                                           CL*63
00631                                                                      CL*63
00632  P1200-EDIT-FQTF.                                                 EFTBD140
00633      PERFORM P1210-READ-MPRF      THRU P1210-EXIT.                EFTBD140
00634      IF WRK-MPRF-NO-88                                            EFTBD140
00635         GO TO P1200-EXIT                                          EFTBD140
00636      ELSE                                                         EFTBD140
00637         PERFORM P1220-LIABILITY   THRU P1220-EXIT                 EFTBD140
00638         PERFORM P1230-READ-MQTR   THRU P1230-EXIT                 EFTBD140
00639      END-IF.                                                      EFTBD140
00640  P1200-EXIT.                                                      EFTBD140
00641      EXIT.                                                        EFTBD140
00642                                                                   EFTBD140
00643  P1210-READ-MPRF.                                                 EFTBD140
00644      MOVE LOW-VALUE               TO MSKL-KEY-AREA.               EFTBD140
00645      MOVE FQTF-EMP-NO             TO MSKL-EMP-NO.                 EFTBD140
00646      SET MSKL-PRF-88              TO TRUE.                        EFTBD140
00647      PERFORM S910-READ            THRU S910-EXIT.                 EFTBD140
00648      IF L910-NO-REC-88                                            EFTBD140
00649         SET ERR-T027-PASS-EDITS-NO-88 TO TRUE                        CL*65
00650         SET WRK-MPRF-NO-88        TO TRUE                         EFTBD140
00651         DISPLAY 'BD140 P1210 NO MPRF ' FQTF-EMP-NO                   CL*77
00652         GO TO P1210-EXIT                                          EFTBD140
00653      ELSE                                                         EFTBD140
00654         SET WRK-MPRF-YES-88       TO TRUE                         EFTBD140
00655         MOVE MSKL-REC             TO MPRF-REC.                    EFTBD140
00656                                                                   EFTBD140
00657      IF NOT MPRF-CLASS-SUB-88                                     EFTBD140
00658         DISPLAY 'BD140 P1210 NOT SUB ' FQTF-EMP-NO                   CL*77
00659         SET ERR-T027-PASS-EDITS-NO-88 TO TRUE.                       CL*65
00660                                                                   EFTBD140
00661      IF MPRF-NOT-WRITTEN-OFF-88                                   EFTBD140
00662         NEXT SENTENCE                                             EFTBD140
00663      ELSE                                                         EFTBD140
00664         DISPLAY 'BD140 P1210 WRITE-OFF ' FQTF-EMP-NO                 CL*77
00665         SET ERR-T027-PASS-EDITS-NO-88 TO TRUE.                       CL*65
00666                                                                   EFTBD140
00667  P1210-EXIT.                                                      EFTBD140
00668      EXIT.                                                        EFTBD140
00669                                                                   EFTBD140
00670  P1220-LIABILITY.                                                 EFTBD140
00671      MOVE FQTF-YRQ                TO L516-YRQ.                       CL103
00672      PERFORM S516-LIABILITY-INFO THRU S516-EXIT.                  EFTBD140
00673      IF L516-NOT-LIABLE-88                                        EFTBD140
00674         DISPLAY 'BD140 P1220 NOT LIAB ' FQTF-EMP-NO                  CL*77
00675         SET ERR-T027-PASS-EDITS-NO-88 TO TRUE.                       CL*65
00676                                                                   EFTBD140
00677      IF MPRF-CLASS-RATED-88                                       EFTBD140
00678         IF L516-NO-RATE-88                                        EFTBD140
00679            DISPLAY 'BD140 P1220 NO RATE ' FQTF-EMP-NO                CL*77
00680            SET ERR-T027-PASS-EDITS-NO-88 TO TRUE.                    CL*65
00681                                                                   EFTBD140
00682  P1220-EXIT.                                                      EFTBD140
00683      EXIT.                                                        EFTBD140
00684                                                                   EFTBD140
00685  P1230-READ-MQTR.                                                 EFTBD140
00686      MOVE LOW-VALUES              TO MQTR-KEY-AREA.               EFTBD140
00687      MOVE MPRF-EMP-NO             TO MQTR-EMP-NO.                 EFTBD140
00688      SET MQTR-QTR-88              TO TRUE.                        EFTBD140
00689      MOVE FQTF-YRQ                TO MQTR-YRQ.                       CL103
00690      MOVE MQTR-KEY-AREA           TO MSKL-KEY-AREA                EFTBD140
00691      PERFORM S910-READ            THRU S910-EXIT.                 EFTBD140
00692      IF L910-NO-REC-88                                            EFTBD140
00693         NEXT SENTENCE                                             EFTBD140
00694      ELSE                                                         EFTBD140
00695         MOVE MSKL-REC             TO MQTR-REC                     EFTBD140
00696         IF MQTR-CURR-RCVD-88                                      EFTBD140
00697            DISPLAY 'BD140 P1230 RPT RCVD ' FQTF-EMP-NO               CL*77
00698            SET ERR-T027-PASS-EDITS-NO-88 TO TRUE.                    CL*65
00699                                                                   EFTBD140
00700  P1230-EXIT.                                                      EFTBD140
00701      EXIT.                                                        EFTBD140
00702                                                                   EFTBD140
00703  P1300-WRITE-T027.                                                EFTBD140
00704      MOVE 0                         TO WRK-SEQ-NO.                   CL*79
00705                                                                      CL*79
00706      MOVE FQTF-EMP-NO               TO T027-EMP-NO.                  CL*74
00707      MOVE 'WEBTXRPT'                TO T027-ORIGIN.                  CL*63
00708      MOVE L005-DATE                 TO T027-SYS-DATE.                CL*63
00709      MOVE L005-TIME                 TO T027-SYS-TIME.                CL*63
00710      SET  T027-WEB-RPT-88           TO TRUE.                         CL*63
00711                                                                      CL*63
00712      IF WRK-PSEUDO-ITEM-NO < 999                                     CL*79
00713         ADD 1                       TO WRK-PSEUDO-ITEM-NO            CL*79
00714      ELSE                                                            CL*63
00715         ADD 1                       TO WRK-PSEUDO-BATCH-NO           CL*79
00716         MOVE 1                      TO WRK-PSEUDO-ITEM-NO            CL*83
00717      END-IF.                                                         CL*83
00718                                                                      CL*63
00719      MOVE WRK-PSEUDO-BATCH-NO       TO T027-PSEUDO-BATCH-NO.         CL*79
00720      MOVE WRK-PSEUDO-ITEM-NO        TO T027-PSEUDO-ITEM-NO.          CL*79
00721                                                                      CL*63
00722      MOVE MPRF-PRIMARY-NAME         TO T027-NAME-CHECK.           EFTBD140
00723      SET  T027-ORIG-88              TO TRUE.                         CL*63
00724      MOVE FQTF-YRQ                  TO T027-YRQ.                     CL103
00725      MOVE FQTF-TOTAL-WAGES          TO T027-TOT-WAGE.                CL*63
00726      COMPUTE WRK-EXCESS-WAGE =                                       CL*63
00727        (FQTF-TOTAL-WAGES - FQTF-TOTAL-TAXABLE-WAGES).                CL*63
00728      MOVE WRK-EXCESS-WAGE           TO T027-EXCESS-WAGE.             CL*63
00729      MOVE FQTF-TOTAL-TAXABLE-WAGES  TO T027-TAX-WAGE.                CL*63
00730      MOVE FQTF-PAYMENT-AMOUNT       TO T027-REMIT-AMT.               CL*63
00731      SET  T027-WAIVE-BOTH-NO-88     TO TRUE.                         CL*63
00732      SET  T027-WAIVE-INT-NO-88      TO TRUE.                         CL*75
00733      SET  T027-WAIVE-LATE-PEN-NO-88 TO TRUE.                         CL*63
00734      MOVE FQTF-WORKER-CNT-1ST-MON   TO T027-1ST-MTH-EMPL-CNT.        CL*63
00735      MOVE FQTF-WORKER-CNT-2ND-MON   TO T027-2ND-MTH-EMPL-CNT.        CL*63
00736      MOVE FQTF-WORKER-CNT-3RD-MON   TO T027-3RD-MTH-EMPL-CNT.        CL*63
00737      COMPUTE T027-TOTAL-EMPL-CNT =                                   CL*63
00738         (FQTF-WORKER-CNT-1ST-MON +                                   CL*63
00739          FQTF-WORKER-CNT-2ND-MON +                                   CL*63
00740          FQTF-WORKER-CNT-3RD-MON).                                   CL*63
00741      MOVE FQTF-FILING-DATE          TO T027-RECEIVED-DATE.           CL*63
00742                                                                      CL*63
00743      MOVE T027-RECEIVED-DATE        TO L001-FED-8-DATE-9.            CL*63
00744      PERFORM S001-FROM-FED-8        THRU S001-EXIT.                  CL*63
00745      SET L003-NOT-WORK-DAY          TO TRUE.                         CL*63
00746      PERFORM P1310-WORK-DAY-LOOP    THRU P1310-EXIT               EFTBD140
00747          UNTIL L003-IS-WORK-DAY.                                     CL*63
00748      MOVE L001-FED-8-DATE-9         TO T027-DEPOSIT-DATE.            CL*63
00749                                                                      CL*63
00750      MOVE FQTF-TRACE-NO             TO T027-TRACE-NO.                CL*76
00751                                                                      CL*76
00752      MOVE 'VOL'                    TO T027-RESPONSIBLE-ACTIVITY.     CL*63
00753      MOVE SPACES                   TO T027-RESPONSIBLE-OP-ID.        CL*63
00754                                                                      CL*63
00755 *&                                                                   CL*85
00756      DISPLAY 'BD140 P1300 PASS EDITS '                               CL*85
00757         ERR-T027-PASS-EDITS-IND.                                     CL*85
00758 *&                                                                   CL*85
00759      IF ERR-T027-PASS-EDITS-NO-88                                    CL*65
00760         SET T027-PASSED-FULL-EDITS-NO-88   TO TRUE                EFTBD140
00761      ELSE                                                         EFTBD140
00762         SET T027-PASSED-FULL-EDITS-YES-88  TO TRUE.               EFTBD140
00763                                                                   EFTBD140
00764      MOVE T027-REC                  TO TSKL-REC.                     CL*63
00765      PERFORM S927-WRITE             THRU S927-EXIT.                  CL*63
00766      ADD 1                          TO WRK-T027-CNT.                 CL*69
00767                                                                      CL*63
00768  P1300-EXIT.                                                      EFTBD140
00769      EXIT.                                                           CL*63
00770                                                                      CL*63
00771  P1310-WORK-DAY-LOOP.                                             EFTBD140
00772      ADD +1 TO L001-JUL-ABS-DAY.                                  EFTBD140
00773                                                                   EFTBD140
00774      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    EFTBD140
00775                                                                   EFTBD140
00776      MOVE L001-FED-8-DATE-9 TO L003-DATE.                         EFTBD140
00777                                                                   EFTBD140
00778      PERFORM S003-AGENCY-DAY THRU S003-EXIT.                      EFTBD140
00779                                                                   EFTBD140
00780  P1310-EXIT.                                                      EFTBD140
00781      EXIT.                                                        EFTBD140
00782                                                                      CL*90
00783  P1400-WRITE-T002.                                                   CL*90
00784                                                                      CL*91
00785      PERFORM I4000-INIT-T002      THRU I4000-EXIT                    CL*91
00786      PERFORM P1410-MOPO           THRU P1410-EXIT                    CL*92
00787      PERFORM P1420-CONT-NAME      THRU P1420-EXIT                    CL*92
00788      PERFORM P1430-CONT-PHONE     THRU P1430-EXIT                    CL*92
00789                                                                      CL*91
00790      IF WRK-MOPO-T002-YES-88                                         CL*91
00791         PERFORM P1440-MOPO-T002  THRU P1440-EXIT.                    CL*91
00792                                                                      CL*90
00793  P1400-EXIT.                                                         CL*90
00794      EXIT.                                                           CL*90
00795                                                                      CL*91
00796  P1410-MOPO.                                                         CL*91
00797                                                                      CL*91
00798      MOVE LOW-VALUES  TO MOPO-KEY-AREA.                              CL*91
00799      MOVE MPRF-EMP-NO TO MOPO-EMP-NO.                                CL*91
00800      SET MOPO-OPO-88  TO TRUE.                                       CL*91
00801      MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA.                            CL*91
00802                                                                      CL*91
00803      PERFORM S910-START-BROWSE THRU S910-EXIT.                       CL*91
00804      IF L910-NO-REC-88                                               CL*91
00805         NEXT SENTENCE                                                CL*91
00806      ELSE                                                            CL*91
00807         PERFORM                                                      CL*91
00808           UNTIL L910-NO-REC-88                                       CL*91
00809           OR WRK-MOPO-FOUND-YES-88                                   CL*91
00810              MOVE MSKL-REC    TO MOPO-REC                            CL108
00811              IF MOPO-TYPE-RPT-BSNS-88                                CL112
00812                 MOVE MOPO-REC TO MSKL-REC                            CL*91
00813                 DISPLAY 'MOPO FOU ' MOPO-VOICE-1                     CL108
00814                 SET WRK-MOPO-FOUND-YES-88  TO TRUE                   CL108
00815              ELSE                                                    CL*91
00816                 PERFORM S910-READ-NEXT   THRU S910-EXIT              CL*91
00817              END-IF                                                  CL*91
00818         END-PERFORM                                                  CL*91
00819      END-IF.                                                         CL*91
00820                                                                      CL*91
00821  P1410-EXIT.                                                         CL*91
00822      EXIT.                                                           CL*91
00823                                                                      CL*91
00824  P1420-CONT-NAME.                                                    CL*91
00825                                                                      CL*91
00826      IF FQTF-LAST-NAME = SPACES                                      CL*92
00827         SET WRK-MOPO-T002-NO-88   TO TRUE                            CL113
00828         DISPLAY 'T002 NOT ADDED NO NAME ' FQTF-EMP-NO                CL114
00829         GO TO P1420-EXIT.                                            CL*91
00830                                                                      CL113
00831      MOVE FQTF-FIRST-NAME           TO L076-NAMEF                    CL116
00832      MOVE FQTF-MIDDLE-INITIAL       TO L076-NAMEI                    CL116
00833      MOVE FQTF-LAST-NAME            TO L076-NAMEL                    CL116
00834                                                                      CL*91
00835      PERFORM S076-NAME              THRU S076-EXIT                   CL116
00836      IF L076-NAME-INVALID                                            CL116
00837        SET WRK-MOPO-T002-NO-88   TO TRUE                             CL113
00838        MOVE FQTF-EMP-NO        TO R907-EMP-NO                        CL*93
00839        MOVE FQTF-TRACE-NO      TO MSG9-TRACE-NO                      CL*93
00840        MOVE MSG9-TEXT          TO R907-MSG-TEXT                      CL*93
00841        PERFORM S946-WRITE-R907 THRU S946-EXIT                        CL*93
00842        MOVE SPACES             TO T002-CONTACT-NAME                  CL*91
00843        GO TO P1420-EXIT.                                             CL*91
00844                                                                      CL*91
00845        MOVE L076-NAM              TO T002-CONTACT-NAME               CL116
00846        SET WRK-MOPO-T002-YES-88   TO TRUE.                           CL113
00847                                                                      CL*91
00848  P1420-EXIT.                                                         CL*91
00849      EXIT.                                                           CL*91
00850                                                                      CL*91
00851  P1430-CONT-PHONE.                                                   CL*91
00852                                                                      CL*91
00853       IF FQTF-FILING-TEL-NO = SPACES                                 CL*92
00854         SET WRK-MOPO-T002-NO-88   TO TRUE                            CL113
00855         DISPLAY 'T002 NOT ADDED NO TEL  ' FQTF-EMP-NO                CL115
00856          GO TO P1430-EXIT.                                           CL*91
00857                                                                      CL*91
00858          MOVE FQTF-FILING-TEL-NO    TO T002-CONTACT-VOICE            CL*92
00859          SET WRK-MOPO-T002-YES-88   TO TRUE.                         CL*91
00860                                                                      CL*91
00861  P1430-EXIT.                                                         CL*91
00862      EXIT.                                                           CL*91
00863                                                                      CL*91
00864  P1440-MOPO-T002.                                                    CL*91
00865      MOVE MPRF-EMP-NO               TO T002-EMP-NO.                  CL*91
00866      MOVE 'AUTOSTATUS'              TO T002-ORIGIN.                  CL*91
00867      MOVE L005-DATE                 TO T002-SYS-DATE.                CL*91
00868      MOVE L005-TIME                 TO T002-SYS-TIME.                CL*91
00869                                                                      CL*91
00870      IF WRK-MOPO-FOUND-YES-88                                        CL*91
00871         SET T002-UPD-CONTACT-88     TO TRUE                          CL*91
00872      ELSE                                                            CL*91
00873         SET T002-ADD-CONTACT-88     TO TRUE                          CL*91
00874      END-IF.                                                         CL*91
00875                                                                      CL*91
00876      SET T002-CONTACT-RPT-BSNS-88   TO TRUE.                         CL112
00877                                                                      CL*91
00878      MOVE ZEROS                  TO T002-CONTACT-SSN                 CL113
00879      MOVE SPACES                 TO T002-CONTACT-TITLE               CL113
00880      MOVE SPACES                 TO T002-CONTACT-FAX                 CL113
00881      MOVE SPACES                 TO T002-CONTACT-EMAIL               CL113
00882      MOVE T002-REC               TO TSKL-REC.                        CL*91
00883      PERFORM S927-WRITE          THRU S927-EXIT.                     CL*92
00884      ADD +1  TO WRK-T002-CONTACT-CNT.                                CL*91
00885                                                                      CL*91
00886  P1440-EXIT.                                                         CL*91
00887      EXIT.                                                           CL*91
00888                                                                      CL*91
00889  P2000-PAYMENT.                                                      CL*62
00890      ADD +1                             TO WRK-PAY-REC-CNT.          CL*69
00891      MOVE RSKL-REC                      TO FDPT-REC.                 CL*65
00892                                                                      CL*65
00893      IF WRK-CURR-PAY-TRACE-NO > ZERO                                 CL*66
00894         IF FDPT-EMP-NO  = FQTF-EMP-NO                                CL*65
00895            PERFORM P2100-DUPLICATE-ERR   THRU P2100-EXIT             CL*67
00896         ELSE                                                         CL*65
00897            PERFORM P2200-MISSING-RPT-ERR THRU P2200-EXIT             CL*67
00898         END-IF                                                       CL*65
00899      ELSE                                                            CL*66
00900         MOVE FDPT-EMP-NO TO WRK-CURR-PAY-TRACE-NO                    CL*69
00901      END-IF.                                                         CL*63
00902                                                                      CL*63
00903      IF FDPT-PAYMENT-TRACE-NO          NOT = FQTF-TRACE-NO           CL*70
00904      OR FDPT-EMP-NO                    NOT = FQTF-EMP-NO             CL*69
00905         PERFORM P2200-MISSING-RPT-ERR  THRU P2200-EXIT               CL*69
00906      ELSE                                                            CL*69
00907         IF FDPT-PAYMENT-AMOUNT         NOT = FQTF-PAYMENT-AMOUNT     CL*69
00908            PERFORM P2300-PAYMENT-ERR   THRU P2300-EXIT               CL*69
00909         END-IF                                                       CL*62
00910      END-IF.                                                         CL*62
00911                                                                      CL*62
00912  P2000-EXIT.                                                         CL*62
00913      EXIT.                                                           CL*62
00914                                                                      CL*62
00915  P2100-DUPLICATE-ERR.                                             EFTBD140
00916                                                                   EFTBD140
00917      MOVE MSG2-ID               TO R907-MSG-ID                       CL*67
00918      MOVE FDPT-EMP-NO           TO R907-EMP-NO                       CL*67
00919      MOVE FDPT-PAYMENT-TRACE-NO TO MSG2-TRACE-NO                     CL*70
00920      MOVE MSG2-TEXT             TO R907-MSG-TEXT                     CL*67
00921      PERFORM S946-WRITE-R907    THRU S946-EXIT.                   EFTBD140
00922      DISPLAY 'BD140 P2100 DUP PMT ' FDPT-EMP-NO                      CL*77
00923      ADD +1                     TO WRK-R907-CNT.                     CL*68
00924                                                                   EFTBD140
00925  P2100-EXIT.                                                      EFTBD140
00926      EXIT.                                                        EFTBD140
00927                                                                   EFTBD140
00928  P2200-MISSING-RPT-ERR.                                              CL*70
00929      MOVE MSG3-ID               TO R907-MSG-ID                       CL*67
00930      MOVE FDPT-EMP-NO           TO R907-EMP-NO                       CL*67
00931      MOVE FDPT-PAYMENT-TRACE-NO TO MSG3-TRACE-NO                     CL*70
00932      MOVE MSG3-TEXT             TO R907-MSG-TEXT                     CL*67
00933      PERFORM S946-WRITE-R907    THRU S946-EXIT.                   EFTBD140
00934      DISPLAY 'BD140 P2200 MISS RPT ' FDPT-EMP-NO                     CL*77
00935      ADD +1                     TO WRK-R907-CNT.                     CL*68
00936                                                                   EFTBD140
00937  P2200-EXIT.                                                      EFTBD140
00938      EXIT.                                                        EFTBD140
00939                                                                   EFTBD140
00940  P2300-PAYMENT-ERR.                                               EFTBD140
00941      MOVE MSG4-ID               TO R907-MSG-ID                       CL*67
00942      MOVE FDPT-EMP-NO           TO R907-EMP-NO                       CL*67
00943      MOVE FDPT-PAYMENT-TRACE-NO TO MSG4-TRACE-NO                     CL*70
00944      MOVE MSG4-TEXT             TO R907-MSG-TEXT                     CL*67
00945      PERFORM S946-WRITE-R907    THRU S946-EXIT.                   EFTBD140
00946      DISPLAY 'BD140 P2300 PAY ERR ' FDPT-EMP-NO                      CL*77
00947      ADD +1                     TO WRK-R907-CNT.                     CL*68
00948                                                                   EFTBD140
00949  P2300-EXIT.                                                      EFTBD140
00950      EXIT.                                                        EFTBD140
00951                                                                   EFTBD140
00952  P3000-WAGE.                                                         CL*63
00953      ADD +1                               TO WRK-WAGE-REC-CNT.       CL*69
00954      MOVE RSKL-REC                        TO FCQW-REC.               CL*67
00955                                                                      CL*63
00956      ADD FCQW-EMPL-WAGES                  TO WRK-TOT-WAGE.           CL*67
00957                                                                      CL*63
00958      PERFORM P3100-EDIT-CQW               THRU P3100-EXIT.           CL*79
00959                                                                      CL*80
00960      PERFORM P3200-WRITE-W001             THRU P3200-EXIT.           CL*80
00961                                                                      CL*80
00962  P3000-EXIT.                                                         CL*63
00963      EXIT.                                                           CL*63
00964                                                                      CL*63
00965  P3100-EDIT-CQW.                                                     CL*79
00966      IF (FCQW-EMPL-TRACE-NO               NOT = FQTF-TRACE-NO)       CL104
00967      OR (FCQW-EMP-NO                      NOT = FQTF-EMP-NO)         CL104
00968         PERFORM P3110-MISSING-REPORT-ERR  THRU P3110-EXIT            CL*80
00969      END-IF.                                                         CL*80
00970                                                                      CL*80
00971      IF FQTF-WAGE-RPT-NO-88                                          CL*80
00972         PERFORM P3120-UNEXPECTED-WAGE-ERR  THRU P3120-EXIT           CL*80
00973      END-IF.                                                         CL*80
00974                                                                      CL*80
00975      IF FQTF-TOTAL-WAGES                   = ZERO                    CL*80
00976         PERFORM P3130-ZERO-WAGE-ERR        THRU P3130-EXIT           CL*80
00977      END-IF.                                                         CL*81
00978                                                                      CL*80
00979      IF FQTF-PAYMENT-AMOUNT = ZERO                                   CL111
00980         NEXT SENTENCE                                                CL111
00981      ELSE                                                            CL111
00982      IF FDPT-PAYMENT-TRACE-NO              = ZERO                    CL*80
00983         PERFORM P3140-MISSING-PAYMENT      THRU P3140-EXIT           CL*80
00984      END-IF.                                                         CL*81
00985                                                                      CL*80
00986  P3100-EXIT.                                                         CL*79
00987      EXIT.                                                           CL*79
00988                                                                      CL*79
00989  P3110-MISSING-REPORT-ERR.                                           CL*80
00990      MOVE MSG5-ID               TO R907-MSG-ID                       CL*67
00991      MOVE FCQW-EMP-NO           TO R907-EMP-NO                       CL*67
00992      MOVE FCQW-EMPL-TRACE-NO    TO MSG5-TRACE-NO                     CL*70
00993      MOVE MSG5-TEXT             TO R907-MSG-TEXT                     CL*67
00994                                                                      CL*67
00995      PERFORM S946-WRITE-R907    THRU S946-EXIT.                      CL*67
00996      DISPLAY 'BD140 P3110 MSG5 '                                     CL117
00997      DISPLAY '  CQW ' FCQW-EMP-NO ' ' FCQW-EMPL-TRACE-NO             CL118
00998      DISPLAY '  QTF ' FQTF-EMP-NO ' ' FQTF-TRACE-NO                  CL117
00999      ADD +1                     TO WRK-R907-CNT.                     CL*68
01000                                                                      CL*67
01001  P3110-EXIT.                                                         CL*80
01002      EXIT.                                                        EFTBD140
01003                                                                   EFTBD140
01004  P3120-UNEXPECTED-WAGE-ERR.                                          CL*80
01005      IF ERR-UNEXPECTED-WAGE-YES-88                                   CL*67
01006         GO TO P3120-EXIT                                             CL*80
01007      ELSE                                                            CL*63
01008         SET ERR-UNEXPECTED-WAGE-YES-88  TO TRUE.                     CL*67
01009                                                                      CL*63
01010      MOVE MSG6-ID               TO R907-MSG-ID                       CL*67
01011      MOVE FCQW-EMP-NO           TO R907-EMP-NO                       CL*67
01012      MOVE FCQW-EMPL-TRACE-NO    TO MSG6-TRACE-NO                     CL*70
01013      MOVE MSG6-TEXT             TO R907-MSG-TEXT                     CL*67
01014                                                                      CL*67
01015      DISPLAY 'BD140 P3120 UNEXPECT ' FCQW-EMP-NO                     CL*80
01016      PERFORM S946-WRITE-R907    THRU S946-EXIT.                      CL*67
01017      ADD +1                     TO WRK-R907-CNT.                     CL*68
01018                                                                      CL*67
01019  P3120-EXIT.                                                         CL*80
01020      EXIT.                                                           CL*63
01021                                                                      CL*63
01022  P3130-ZERO-WAGE-ERR.                                                CL*80
01023      MOVE MSG7-ID               TO R907-MSG-ID                       CL*67
01024      MOVE FCQW-EMP-NO           TO R907-EMP-NO                       CL*67
01025      MOVE FCQW-EMPL-TRACE-NO    TO MSG7-TRACE-NO                     CL*70
01026      MOVE MSG7-TEXT             TO R907-MSG-TEXT                     CL*67
01027                                                                      CL*67
01028      DISPLAY 'BD140 P3130 ZERO WAGE '                                CL117
01029      DISPLAY '  CQW ' FCQW-EMP-NO ' ' FCQW-EMPL-WAGES                CL117
01030      DISPLAY '  QTF ' FQTF-EMP-NO ' ' FQTF-TOTAL-WAGES               CL117
01031      PERFORM S946-WRITE-R907    THRU S946-EXIT.                      CL*67
01032      ADD +1                     TO WRK-R907-CNT.                     CL*68
01033                                                                      CL*67
01034  P3130-EXIT.                                                         CL*80
01035      EXIT.                                                        EFTBD140
01036                                                                   EFTBD140
01037  P3140-MISSING-PAYMENT.                                              CL*80
01038      MOVE MSG8-ID               TO R907-MSG-ID                       CL*80
01039      MOVE FCQW-EMP-NO           TO R907-EMP-NO                       CL*80
01040      MOVE FCQW-EMPL-TRACE-NO    TO MSG8-TRACE-NO                     CL*80
01041      MOVE MSG8-TEXT             TO R907-MSG-TEXT                     CL*80
01042                                                                      CL*80
01043      DISPLAY 'BD140 P3140 MISS PAY ' FCQW-EMP-NO                     CL*80
01044      PERFORM S946-WRITE-R907    THRU S946-EXIT.                      CL*80
01045      ADD +1                     TO WRK-R907-CNT.                     CL*80
01046                                                                      CL*80
01047  P3140-EXIT.                                                         CL*80
01048      EXIT.                                                           CL*80
01049                                                                      CL*80
01050  P3200-WRITE-W001.                                                   CL*80
01051      MOVE WRK-PSEUDO-BATCH-NO       TO W001-BATCH-NO.                CL*79
01052      MOVE WRK-PSEUDO-ITEM-NO        TO W001-ITEM-NO.                 CL*79
01053      ADD 1                          TO WRK-SEQ-NO.                   CL*68
01054      MOVE WRK-SEQ-NO                TO W001-SEQ-NO.                  CL*68
01055      MOVE FCQW-EMP-NO               TO W001-EMP-NO.                  CL*68
01056      MOVE FCQW-SSN                  TO W001-SSN.                     CL*68
01057      SET W001-SSN-VALID-88          TO TRUE.                         CL*68
01058      MOVE FCQW-FIRST-NAME           TO W001-FIRST-NAME.              CL*68
01059      MOVE FCQW-MIDDLE-INITIAL       TO W001-MID-INIT.                CL*68
01060      MOVE FCQW-LAST-NAME            TO W001-LAST-NAME.               CL*68
01061      SET W001-NAME-VALID-88         TO TRUE.                         CL*68
01062      MOVE FCQW-YEAR                 TO WRK-YRQ-CCYY.                 CL*78
01063      MOVE FCQW-QTR                  TO WRK-YRQ-Q.                    CL*78
01064      MOVE WRK-YRQ-AREA              TO W001-YRQ.                     CL*78
01065      MOVE FCQW-EMPL-WAGES           TO W001-WAGE-CHNG.               CL*68
01066      SET W001-WAGE-VALID-88         TO TRUE.                         CL*68
01067      MOVE ZERO                      TO W001-CURR-WAGE                CL*68
01068                                        W001-TAX-WAGE                 CL*68
01069                                        W001-PRIOR-WAGE.              CL*68
01070      IF T027-RECEIVED-DATE = ZERO                                    CL*84
01071         MOVE L005-DATE              TO W001-RECEIVED-DATE            CL*84
01072      ELSE                                                            CL*84
01073         MOVE T027-RECEIVED-DATE     TO W001-RECEIVED-DATE.           CL*84
01074      MOVE L005-TIME                 TO W001-RECEIVED-TIME.           CL*68
01075      MOVE SPACES                    TO W001-RESPONSIBLE-OP-ID.       CL*68
01076                                                                      CL*68
01077      MOVE W001-REC                  TO WAGE-TRAN-REC.                CL*86
01078      WRITE WAGE-TRAN-REC.                                            CL*86
01079      IF NOT WAGE-STATUS-OK-88                                        CL*86
01080         DISPLAY 'CANNOT WRITE WAGE: ' WAGE-STATUS.                   CL*87
01081 ***  PERFORM S985B-WRITE            THRU S985B-EXIT.                 CL*86
01082      ADD +1                         TO WRK-W001-CNT.                 CL*68
01083                                                                      CL*68
01084  P3200-EXIT.                                                         CL*80
01085      EXIT.                                                           CL*68
01086                                                                      CL*68
01087  T0000-TERMINATE.                                                 EFTBD140
01088 ***  PERFORM S985C-CLOSE  THRU S985C-EXIT.                           CL*73
01089      CLOSE WAGE-TRAN-FILE.                                           CL*86
01090                                                                      CL*59
01091      DISPLAY ' '.                                                    CL221
01092      DISPLAY ' '.                                                    CL221
01093                                                                      CL*71
01094      DISPLAY '*** EFTBD140 TERMINATION STATISTICS ***'.              CL197
01095                                                                      CL*71
01096      DISPLAY '  '.                                                   CL237
01097      DISPLAY 'REPORT TRANSACTION COUNT                      :'       CL*69
01098              WRK-RPT-REC-CNT.                                        CL*69
01099                                                                      CL223
01100      DISPLAY '  '.                                                   CL*98
01101      DISPLAY 'PAYMENT TRANSACTION COUNT                     :'       CL*69
01102              WRK-PAY-REC-CNT.                                        CL*69
01103                                                                      CL*98
01104      DISPLAY '  '.                                                   CL*79
01105      DISPLAY 'WAGE TRANSACTION COUNT                        :'       CL*69
01106              WRK-WAGE-REC-CNT.                                       CL*69
01107                                                                      CL*69
01108      DISPLAY '  '.                                                   CL*79
01109      DISPLAY 'T027 QUARTERLY TAX RPT OUTPUT TRAN (BTC FILE) :'       CL106
01110              WRK-T027-CNT.                                           CL*69
01111                                                                      CL*95
01112      DISPLAY 'T002 CONTACT STATUS TRANS RECS CNT (BTC FILE) :'       CL107
01113              WRK-T002-CONTACT-CNT.                                   CL*95
01114                                                                      CL190
01115      DISPLAY '  '.                                                   CL*79
01116      DISPLAY 'W001 WAGES OUTPUT TRANS REC COUNT (BWTC FILE) :'       CL106
01117              WRK-W001-CNT.                                           CL*69
01118                                                                      CL*92
01119      DISPLAY '  '.                                                   CL*95
01120      DISPLAY 'R907 ERROR REPORT RECORD COUNT                :'       CL*92
01121              WRK-R907-CNT.                                           CL*92
01122                                                                      CL*92
01123  T0000-EXIT.                                                      EFTBD140
01124      EXIT.                                                        EFTBD140
01125      EJECT                                                        EFTBD140
01126                                                                      CL*59
01127  S001-FROM-FED-8.                                                    CL108
01128      SET L001-FROM-FED-8 TO TRUE.                                    CL108
01129      GO TO S001-DATE.                                                CL108
01130                                                                      CL108
01131  S001-FROM-ABS-DAY.                                                  CL108
01132      SET L001-FROM-ABS-DAY TO TRUE.                                  CL108
01133      GO TO S001-DATE.                                                CL108
01134                                                                      CL108
01135  S001-FROM-CAL-6.                                                    CL108
01136      SET L001-FROM-CAL-6 TO TRUE.                                    CL108
01137      GO TO S001-DATE.                                                CL108
01138                                                                      CL108
01139  S001-DATE.                                                          CL108
01140      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL108
01141  S001-EXIT.                                                          CL108
01142      EXIT.                                                           CL108
01143                                                                      CL*56
01144  S003-AGENCY-DAY.                                                    CL*56
01145      SET L003-AGENCY-DAY TO TRUE.                                    CL*56
01146      GO TO S003-WORK-DAY.                                            CL*56
01147                                                                      CL*56
01148  S003-WORK-DAY.                                                      CL*56
01149      CALL 'DTSBU003' USING L003-LINK-AREA.                           CL*56
01150  S003-EXIT.                                                          CL*56
01151      EXIT.                                                           CL*56
01152                                                                      CL*56
01153  S004-FROM-3.                                                        CL*24
01154      SET L004-FROM-3        TO TRUE.                                 CL*24
01155      GO TO S004-YRQ.                                                 CL*24
01156                                                                      CL*24
01157  S004-YRQ.                                                           CL*24
01158      CALL 'DTSBU004' USING L004-LINK-AREA.                           CL*24
01159                                                                      CL*24
01160  S004-EXIT.                                                          CL*24
01161      EXIT.                                                           CL*24
01162                                                                      CL*24
01163  S005-SYS-DATE.                                                      CL*61
01164      CALL 'DTSBU005' USING L005-COMM-AREA.                           CL*61
01165                                                                      CL*61
01166  S005-EXIT.                                                          CL*61
01167      EXIT.                                                           CL*61
01168                                                                      CL*78
01169  S516-LIABILITY-INFO.                                             EFTBD140
01170      CALL 'DTSBU516' USING L516-LINK-AREA                         EFTBD140
01171                            MPRF-REC.                              EFTBD140
01172  S516-EXIT.                                                       EFTBD140
01173      EXIT.                                                        EFTBD140
01174                                                                   EFTBD140
01175  S076-NAME.                                                          CL116
01176      CALL 'DTSBU076' USING L076-LINK-AREA.                           CL116
01177                                                                      CL*92
01178  S076-EXIT.                                                          CL116
01179      EXIT.                                                           CL*92
01180                                                                      CL*92
01181  S910-OPEN-READ.                                                     CL*70
01182      SET L910-OPEN-READ-88 TO TRUE.                                  CL*70
01183      GO TO S910-MSTR-IO.                                             CL*70
01184                                                                      CL*70
01185  S910-OPEN-UPDATE-NO-AIX.                                            CL*70
01186      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                         CL*70
01187      GO TO S910-MSTR-IO.                                             CL*70
01188                                                                      CL*70
01189  S910-READ.                                                          CL*70
01190      SET L910-READ-88 TO TRUE.                                       CL*70
01191      GO TO S910-MSTR-IO.                                             CL*70
01192                                                                      CL*70
01193  S910-START-BROWSE.                                                  CL*70
01194      SET L910-START-BROWSE-88 TO TRUE.                               CL*70
01195      GO TO S910-MSTR-IO.                                             CL*70
01196                                                                      CL*13
01197  S910-READ-NEXT.                                                     CL*70
01198      SET L910-READ-NEXT-88 TO TRUE.                                  CL*70
01199      GO TO S910-MSTR-IO.                                             CL*70
01200                                                                      CL*70
01201  S910-COUNT.                                                         CL*70
01202      SET L910-COUNT-88 TO TRUE.                                      CL*70
01203      GO TO S910-MSTR-IO.                                             CL*70
01204                                                                      CL*70
01205  S910-WRITE.                                                         CL*70
01206      SET L910-WRITE-88 TO TRUE.                                      CL*70
01207      GO TO S910-MSTR-IO.                                             CL*70
01208                                                                      CL*70
01209  S910-REWRITE.                                                       CL*70
01210      SET L910-REWRITE-88 TO TRUE.                                    CL*70
01211      GO TO S910-MSTR-IO.                                             CL*70
01212                                                                      CL*70
01213  S910-CLOSE.                                                         CL*70
01214      SET L910-CLOSE-88     TO TRUE.                                  CL*70
01215      GO TO S910-MSTR-IO.                                             CL*70
01216                                                                      CL*70
01217  S910-MSTR-IO.                                                       CL*70
01218      CALL 'DTSBU910' USING L910-LINK-AREA                            CL*70
01219                            MSKL-REC.                                 CL*70
01220  S910-EXIT.                                                          CL*70
01221      EXIT.                                                           CL*70
01222                                                                      CL212
01223  S927-WRITE.                                                         CL212
01224      SET L927-WRITE-88 TO TRUE.                                      CL212
01225      GO TO S927-BTC-O.                                               CL212
01226                                                                      CL212
01227  S927-BTC-O.                                                         CL212
01228      CALL 'DTSBU927' USING L927-LINK-AREA                            CL212
01229                            TSKL-REC.                                 CL212
01230  S927-EXIT.                                                          CL212
01231      EXIT.                                                           CL212
01232                                                                      CL215
01233                                                                      CL*48
01234  S985A-OPEN.                                                         CL*71
01235      SET L985-OPEN-UPDATE-88 TO TRUE.                                CL*71
01236      CALL 'DTSBU985' USING L985-LINK-AREA                            CL*71
01237                            W001-REC.                                 CL*71
01238  S985A-EXIT.                                                         CL*71
01239      EXIT.                                                           CL*71
01240                                                                      CL*71
01241  S985B-WRITE.                                                        CL*71
01242      SET L985-WRITE-88 TO TRUE.                                      CL*48
01243      CALL 'DTSBU985' USING L985-LINK-AREA                            CL*48
01244                            W001-REC.                                 CL*68
01245  S985B-EXIT.                                                         CL*71
01246      EXIT.                                                           CL*48
01247                                                                      CL*48
01248  S985C-CLOSE.                                                        CL*71
01249      SET L985-CLOSE-88       TO TRUE.                                CL*71
01250      CALL 'DTSBU985' USING L985-LINK-AREA                            CL*71
01251                            W001-REC.                                 CL*71
01252  S985C-EXIT.                                                         CL*71
01253      EXIT.                                                           CL*71
01254                                                                      CL*71
01255  S946-WRITE-R907.                                                    CL*41
01256      CALL 'DTSBU946' USING R907-REC.                                 CL*40
01257                                                                      CL218
01258  S946-EXIT.                                                          CL*49
01259      EXIT.                                                           CL218
01260                                                                      CL**9
01261  S999-ABEND.                                                      EFTBD140
01262      DISPLAY '*** EFTBD140 ABENDING : '                              CL197
01263              WRK-ABEND-MSG.                                          CL*83
01264                                                                   EFTBD140
01265      CALL 'DTSBU999' USING WRK-ABEND-CD.                          EFTBD140
01266  S999-EXIT.                                                       EFTBD140
01267      EXIT.                                                        EFTBD140
