00001  IDENTIFICATION DIVISION.                                         02/05/15
00002  PROGRAM-ID.             DTSBX438.                                DTSBX438
00003  AUTHOR.                 NGC.                                        LV082
00004  DATE-WRITTEN.           SEPT 2014.                                  CL*29
00005  DATE-COMPILED.                                                   DTSBX438
00006      SKIP3                                                        DTSBX438
00007 *****                                                             DTSBX438
00008 *                                                                 DTSBX438
00009 *    FUNCTION: CREATE REPORT FOR ALL DAILY TDEC REPORT PAYMENTS      CL*64
00010 *              FILE. PAYMENT WILL BE ADDED TO DUTAS FOR ESSP.        CL*28
00011 *    MODIFICATION HISTORY:                                        DTSBX438
00012 *                                                                 DTSBX438
00013 *    09-20-2014 INITIAL DEVELOPMENT                                  CL*19
00014 *               REFERENCE RFP: WEB REGISTRATION ESSP         ZL1     CL*19
00015 *                                                                    CL*19
00016 *                                                                 DTSBX438
00017 *    01-06-2015 MODIFIED PROGRAM TO PRODUCE REPORT OF ALL            CL*49
00018 *               TDEC CHECK DISPOSITION (PAID AND PENDING)    ZL1     CL*49
00019 *                                                                    CL*49
00020 *****                                                             DTSBX438
00021      SKIP3                                                        DTSBX438
00022  ENVIRONMENT DIVISION.                                            DTSBX438
00023  CONFIGURATION SECTION.                                              CL*51
00024  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                                  CL*51
00025                                                                      CL*51
00026  INPUT-OUTPUT SECTION.                                            DTSBX438
00027                                                                   DTSBX438
00028  FILE-CONTROL.                                                    DTSBX438
00029                                                                   DTSBX438
00030                                                                      CL*14
00031      SELECT TDEC-PAYT-FILE ASSIGN TO DTSFX145                        CL*34
00032         FILE STATUS IS TDEC-PAYT-STATUS.                             CL*28
00033                                                                      CL*14
00034                                                                      CL*16
00035      SELECT TDEC-PEND-FILE ASSIGN TO DTSPX145                        CL*34
00036         FILE STATUS IS BATCH-XREF-STATUS.                            CL*16
00037                                                                      CL*47
00038      SELECT REPT-PAID-FILE    ASSIGN TO X438RPT1                     CL*68
00039         FILE STATUS IS REPT-STATUS.                                  CL*47
00040                                                                      CL*47
00041      SELECT REPT-PEND-FILE    ASSIGN TO X438RPT2                     CL*68
00042         FILE STATUS IS REPT-STATUS.                                  CL*47
00043                                                                      CL*47
00044  DATA DIVISION.                                                   DTSBX438
00045                                                                   DTSBX438
00046  FILE SECTION.                                                    DTSBX438
00047                                                                   DTSBX438
00048                                                                      CL*14
00049  FD  TDEC-PAYT-FILE                                                  CL*28
00050      RECORDING MODE IS F                                             CL*14
00051      BLOCK CONTAINS 0 RECORDS                                        CL*14
00052      LABEL RECORDS ARE OMITTED.                                      CL*14
00053                                                                      CL*14
00054  01  TDEC-PAYT-REC.                                                  CL*30
00055      05  WEB-IMP-TYPE              PIC X(03).                        CL*30
00056          88  WEB-IMP-TYPE-PRF-88    VALUE '102'.                     CL*30
00057          88  WEB-IMP-TYPE-DETERM-88 VALUE '104'.                     CL*30
00058          88  WEB-IMP-TYPE-NAME-88   VALUE '106'.                     CL*30
00059          88  WEB-IMP-TYPE-RATE-88   VALUE '108'.                     CL*30
00060          88  WEB-IMP-TYPE-ADDR-88   VALUE '110'.                     CL*30
00061          88  WEB-IMP-TYPE-OPO-88    VALUE '120'.                     CL*30
00062          88  WEB-IMP-TYPE-REL-88    VALUE '130'.                     CL*30
00063 ***      88  WEB-IMP-TYPE-IND-88    VALUE '132'.                     CL*30
00064          88  WEB-IMP-TYPE-RPT-88    VALUE '140'.                     CL*30
00065          88  WEB-IMP-TYPE-WAGE-88   VALUE '144'.                     CL*30
00066          88  WEB-IMP-TYPE-PAY-88    VALUE '145'.                     CL*30
00067          88  WEB-IMP-TYPE-BHDR-88   VALUE '149'.                     CL*30
00068          88  WEB-TYPE-REG-88        VALUE '102' '104' '106'          CL*30
00069                                           '108' '130' '132'.         CL*30
00070          88  WEB-TYPE-RPT-88        VALUE '140' '144'.               CL*30
00071          88  WEB-TYPE-PAY-88        VALUE '145'.                     CL*30
00072          88  WEB-TYPE-PRF-88        VALUE '110' '120'.               CL*30
00073      05  FILLER                    PIC X(01).                        CL*30
00074      05  WEB-IMP-EMP-NO            PIC 9(06).                        CL*30
00075      05  FILLER                    PIC X(01).                        CL*30
00076      05  WEB-IMP-QTR               PIC X(06).                        CL*30
00077      05  FILLER                    PIC X(495).                       CL*30
00078                                                                      CL*30
00079                                                                      CL*14
00080                                                                      CL*16
00081  FD  TDEC-PEND-FILE                                                  CL*28
00082      RECORDING MODE IS F                                             CL*16
00083      BLOCK CONTAINS 0 RECORDS                                        CL*16
00084      LABEL RECORDS ARE OMITTED.                                      CL*16
00085                                                                      CL*16
00086  01  TDEC-PEND-REC                      PIC X(512).                  CL*30
00087                                                                      CL*48
00088  FD  REPT-PAID-FILE                                                  CL*47
00089      RECORDING MODE IS F                                             CL*47
00090      BLOCK CONTAINS 0 RECORDS                                        CL*47
00091      LABEL RECORDS ARE OMITTED.                                      CL*47
00092                                                                      CL*47
00093  01  REPT-PAID-REC           PIC X(133).                             CL*47
00094                                                                      CL*47
00095                                                                      CL*47
00096  FD  REPT-PEND-FILE                                                  CL*47
00097      RECORDING MODE IS F                                             CL*47
00098      BLOCK CONTAINS 0 RECORDS                                        CL*47
00099      LABEL RECORDS ARE OMITTED.                                      CL*47
00100                                                                      CL*47
00101  01  REPT-PEND-REC           PIC X(133).                             CL*47
00102                                                                      CL*47
00103                                                                      CL*16
00104  WORKING-STORAGE SECTION.                                         DTSBX438
001045 77  PAN-VALET PICTURE X(24) VALUE '082DTSBX438  02/05/15'.       DTSBX438
00105      SKIP3                                                        DTSBX438
00106  01  WRK-AREA.                                                    DTSBX438
00107      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE 428.    CL*18
00108      05  W-MOD-NAME                  PIC  X(08)  VALUE 'DTSBX429'.   CL*28
00109                                                                   DTSBX438
00110      05  W-PREV-REC-TYPE         PIC  X(03) VALUE SPACES.         DTSBX438
00111          88 W-PREV-REC-NULL-88    VALUE 'XXX'.                    DTSBX438
00112          88 W-PREV-REC-PRF-88     VALUE '102'.                    DTSBX438
00113          88 W-PREV-REC-DETERM-88  VALUE '104'.                    DTSBX438
00114          88 W-PREV-REC-NAME-88    VALUE '106'.                    DTSBX438
00115          88 W-PREV-REC-RATE-88    VALUE '108'.                    DTSBX438
00116          88 W-PREV-REC-ADDR-88    VALUE '110'.                    DTSBX438
00117          88 W-PREV-REC-OPO-88     VALUE '120'.                    DTSBX438
00118          88 W-PREV-REC-REL-88     VALUE '130'.                    DTSBX438
00119          88 W-PREV-REC-IND-88     VALUE '132'.                    DTSBX438
00120          88 W-PREV-REC-RPT-88     VALUE '140'.                    DTSBX438
00121          88 W-PREV-REC-WAGE-88    VALUE '144'.                    DTSBX438
00122          88 W-PREV-REC-PAY-88     VALUE '145'.                    DTSBX438
00123                                                                   DTSBX438
00124      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.        DTSBX438
00125          88 W-ERROR-YES-88            VALUE 'Y'.                  DTSBX438
00126          88 W-ERROR-NO-88             VALUE 'N'.                  DTSBX438
00127                                                                   DTSBX438
00128      05  W-FATAL-ERROR-IND           PIC  X(01) VALUE 'N'.        DTSBX438
00129          88 W-FATAL-ERROR-YES-88      VALUE 'Y'.                  DTSBX438
00130          88 W-FATAL-ERROR-NO-88       VALUE 'N'.                  DTSBX438
00131                                                                   DTSBX438
00132      05  BATCH-XREF-STATUS       PIC  X(02).                      DTSBX438
00133          88 BATCH-XREF-OK-88          VALUE '00'.                 DTSBX438
00134                                                                   DTSBX438
00135      05  W-EMP-FOUND-IND             PIC  X(01) VALUE 'N'.        DTSBX438
00136          88 W-EMP-FOUND-YES-88        VALUE 'Y'.                  DTSBX438
00137          88 W-EMP-FOUND-NO-88         VALUE 'N'.                  DTSBX438
00138                                                                   DTSBX438
00139      05  W-QTR-FOUND-IND             PIC  X(01) VALUE 'N'.           CL*21
00140          88 W-QTR-FOUND-YES-88        VALUE 'Y'.                     CL*21
00141          88 W-QTR-FOUND-NO-88         VALUE 'N'.                     CL*21
00142                                                                      CL*21
00143      05  TDEC-PAYT-STATUS           PIC  X(02) VALUE SPACES.         CL*28
00144          88 W-TDEC-PAYT-EOF-88       VALUE '10'.                     CL*28
00145          88 W-TDEC-PAYT-OK-88         VALUE '00'.                    CL*28
00146                                                                      CL*21
00147      05  REPT-STATUS                 PIC  X(02) VALUE SPACES.        CL*50
00148          88 REPT-STATUS-EOF-88       VALUE '10'.                     CL*50
00149          88 REPT-STATUS-OK-88         VALUE '00'.                    CL*50
00150                                                                      CL*50
00151      05  W-APAY-MAX              PIC S9(04) COMP VALUE +100.      DTSBX438
00152      05  W-APAY-LAST             PIC S9(04) COMP VALUE +0.        DTSBX438
00153      05  PSUB                    PIC S9(04) COMP VALUE +0.        DTSBX438
00154      05  W-APAY-TABLE.                                            DTSBX438
00155          10  W-APAY-ENTRY OCCURS 100 TIMES PIC X(96).             DTSBX438
00156                                                                   DTSBX438
00157      05  WRK-RETURN-CODE         PIC S9(01) VALUE +0.                CL*26
00158      05  W-EMP-NO                PIC S9(07) COMP-3.                  CL*26
00159      05  W-REPORT-QTR            PIC S9(05) COMP-3.               DTSBX438
00160      05  W-REMITTANCE            PIC S9(09)V99 VALUE 0.              CL*59
00161      05  W-TOT-REMITTANCE        PIC S9(09)V99 VALUE 0.              CL*59
00162      05  W-TOT-PAID-REMITTANCE   PIC S9(09)V99 VALUE 0.              CL*59
00163      05  W-TOT-PEND-REMITTANCE   PIC S9(09)V99 VALUE 0.              CL*59
00164      05  W-RECEIVED-DATE         PIC S9(09) COMP-3.               DTSBX438
00165      05  W-DEPOSIT-DATE          PIC S9(09) COMP-3.               DTSBX438
00166      05  W-CHK-SCAN-DATE         PIC S9(09) COMP-3.               DTSBX438
00167      05  W-REMIT-AMT             PIC S9(09)V99 COMP-3.            DTSBX438
00168      05  W-X145-TOT-REMIT-AMT    PIC S9(09)V99 VALUE 0.              CL*51
00169      05  W-TRAN-CNT              PIC S9(03)    COMP-3.            DTSBX438
00170      05  W-PEND-CNT              PIC  9(05)    VALUE 0.              CL*37
00171      05  W-X145-TRACE-NO         PIC  X(13)    VALUE SPACES.         CL*81
00172      05  W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO.                CL*82
00173          10  W-X145-TRACE-NO-A            PIC 9(08).                 CL*82
00174          10  W-X145-TRACE-NO-B            PIC 9(05).                 CL*82
00175      05  W-MPRF-CNT              PIC  9(05)    VALUE 0.              CL*37
00176      05  W-MQTR-CNT              PIC  9(05)    VALUE 0.              CL*37
00177      05  W-ERRO-CNT              PIC  9(05)    VALUE 0.              CL*37
00178      05  W-X145-ERR-CNT          PIC  9(05)    VALUE 0.              CL*58
00179      05  WRK-SYS-ABSTIME         PIC S9(15)    COMP-3 VALUE 0.       CL*16
00180                                                                   DTSBX438
00181      05  W-EARNINGS              PIC S9(09)V99.                   DTSBX438
00182      05  W-INTEGER               PIC  S9(11) COMP-3.                 CL*33
00183      05  W-FRACTION              PIC  SV9(11) COMP-3.                CL*33
00184      05  W-NUMBER                PIC  S9(11)V9(05) COMP-3.           CL*33
00185      05  SUB                     PIC  S9(4) COMP.                    CL*33
00186                                                                      CL*48
00187      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.     CL*48
00188      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.     CL*48
00189      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.     CL*48
00190                                                                      CL*48
00191                                                                   DTSBX438
00192      05  W-PAY-TYPE             PIC  X(02).                       DTSBX438
00193          88  W-PA-PAY-88             VALUE 'PA'.                  DTSBX438
00194          88  W-OR-PAY-88             VALUE 'OR'.                  DTSBX438
00195          88  W-EA-PAY-88             VALUE 'EA'.                  DTSBX438
00196          88  W-AU-PAY-88             VALUE 'AU'.                  DTSBX438
00197          88  W-FS-PAY-88             VALUE 'FS'.                  DTSBX438
00198          88  W-AC-PAY-88             VALUE 'AC'.                  DTSBX438
00199          88  W-ES-PAY-88             VALUE 'ES'.                  DTSBX438
00200          88  W-WD-PAY-88             VALUE 'WD'.                  DTSBX438
00201          88  W-PAY-REV-88            VALUE 'PR'.                  DTSBX438
00202          88  W-REFUND-88             VALUE 'RF'.                  DTSBX438
00203          88  W-REF-REV-88            VALUE 'RR'.                  DTSBX438
00204          88  W-NG-CHECK-88           VALUE 'NG'.                  DTSBX438
00205          88  W-VALID-PAY-88          VALUE 'PA' 'OR' 'EA' 'AU'    DTSBX438
00206                                            'FS' 'AC'.             DTSBX438
00207                                                                   DTSBX438
00208      05  W-SEQ-NO                PIC  9(07)  VALUE 0.             DTSBX438
00209                                                                   DTSBX438
00210      05  W-SLASH-DATE            PIC  X(10).                      DTSBX438
00211      05  FILLER REDEFINES W-SLASH-DATE.                           DTSBX438
00212          10  W-SLASH-DT-MM       PIC  X(02).                      DTSBX438
00213          10  FILLER              PIC  X(01).                      DTSBX438
00214          10  W-SLASH-DT-DD       PIC  X(02).                      DTSBX438
00215          10  FILLER              PIC  X(01).                      DTSBX438
00216          10  W-SLASH-DT-CCYY     PIC  X(04).                      DTSBX438
00217                                                                   DTSBX438
00218      05  W-SLASH-QTR             PIC  X(06).                      DTSBX438
00219      05  FILLER REDEFINES W-SLASH-QTR.                            DTSBX438
00220          10  W-SLASH-QTR-CCYY    PIC  X(04).                      DTSBX438
00221          10  FILLER              PIC  X(01).                      DTSBX438
00222          10  W-SLASH-QTR-Q       PIC  X(01).                      DTSBX438
00223                                                                   DTSBX438
00224 *  PAYMENT                                                        DTSBX438
00225      05  W-X212-CNT              PIC S9(07)  COMP-3 VALUE +0.        CL*16
00226                                                                   DTSBX438
00227      05  W-APAY-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX438
00228                                                                   DTSBX438
00229      05  W-T025-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX438
00230 *    05  WS-T025-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.       CL*57
00231                                                                   DTSBX438
00232      05  W-BX212-CNT             PIC S9(07)  COMP-3 VALUE +0.        CL*16
00233                                                                   DTSBX438
00234      05  W-X212-LENGTH           PIC S9(04)  COMP.                   CL*16
00235                                                                   DTSBX438
00236      05  W-AMT-DISP1             PIC ----------9.99.              DTSBX438
00237      05  W-AMT-DISP2             PIC ----------9.99.              DTSBX438
00238 *RW1                                                              DTSBX438
00239      05  WRK-R140-CNT            PIC S9(07) COMP-3 VALUE +0.      DTSBX438
00240      05  DISPLAY-CNT             PIC  Z(06)9.                     DTSBX438
00241      05  WRK-MPRF-EMP-NO         PIC  9(06).                      DTSBX438
00242 *RW2                                                              DTSBX438
00243                                                                   DTSBX438
00244  01  MESSAGE-AREA.                                                DTSBX438
00245 *** FATAL ERRORS MSG-A                                            DTSBX438
00246      05  MSG-A1.                                                  DTSBX438
00247          10  FILLER                            PIC X(32)          DTSBX438
00248              VALUE 'TYPE A REC NOT FIRST IN FILE: '.              DTSBX438
00249          10  MSG-A1-PREV-REC-TYPE              PIC X(01).         DTSBX438
00250                                                                   DTSBX438
00251  01  HEADER-1.                                                       CL*47
00252      05  FILLER                   PIC X(01) VALUE SPACES.            CL*47
00253      05  FILLER                   PIC X(49) VALUE '140R1'.           CL*47
00254      05  FILLER                   PIC X(60) VALUE                    CL*47
00255          'DISTRICT OF COLUMBIA'.                                     CL*47
00256      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL*47
00257      05  HDR1-LRCM-SYS-DATE       PIC X(10).                         CL*47
00258  01  HEADER-2.                                                       CL*47
00259      05  FILLER                   PIC X(54) VALUE SPACES.            CL*47
00260      05  FILLER                   PIC X(56) VALUE                    CL*47
00261          'TAX DIVISION'.                                             CL*47
00262      05  FILLER                   PIC X(06) VALUE 'TIME:'.           CL*47
00263      05  HDR2-LRCM-SYS-TIME       PIC X(08).                         CL*47
00264                                                                      CL*47
00265  01  HEADER-3.                                                       CL*47
00266      05  FILLER                   PIC X(01) VALUE SPACES.            CL*47
00267      05  FILLER                   PIC X(38) VALUE                    CL*47
00268          'ROUTE TO:  TAX ACCOUNTING STAFF'.                          CL*47
00269      05  HDR3-LITERAL             PIC X(43) VALUE                    CL*47
00270          '   ESSP DAILY PROCESSED ACH PAYMENTS'.                     CL*66
00271      05  FILLER                   PIC X(28) VALUE SPACES.            CL*47
00272      05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL*47
00273      05  HDR3-PAGE                PIC ZZ,ZZ9.                        CL*47
00274                                                                      CL*47
00275  01  HEADER-4.                                                       CL*47
00276      05  FILLER                   PIC X(01)  VALUE SPACES.           CL*47
00277      05  FILLER                   PIC X(132) VALUE SPACES.           CL*47
00278  01  HEADER-5.                                                       CL*47
00279      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*47
00280      05  FILLER                   PIC X(34)  VALUE                   CL*47
00281          'EMP NO   EMPLOYER NAME           '.                        CL*53
00282      05  FILLER                   PIC X(04)  VALUE SPACES.           CL*53
00283      05  FILLER                   PIC X(34)  VALUE                   CL*47
00284             'QTR   RECV-DATE         PAID-AMT'.                      CL*54
00285      05  FILLER                   PIC X(04)  VALUE SPACES.           CL*71
00286      05  FILLER                   PIC X(09)  VALUE                   CL*71
00287             'TRACE NO '.                                             CL*71
00288      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*47
00289      05  HDR5-NAME                PIC X(28)  VALUE                   CL*47
00290               ' DISPOSITION OF PAYMTS'.                              CL*64
00291                                                                      CL*47
00292  01  HEADER-6.                                                       CL*47
00293      05  FILLER                   PIC X(01)  VALUE SPACES.           CL*47
00294      05  FILLER                   PIC X(132) VALUE SPACES.           CL*47
00295                                                                      CL*48
00296  01  DETAIL-LINE-1.                                                  CL*47
00297      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*47
00298      15  X434-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL*47
00299      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*47
00300      15  X434-NAME-CHECK            PIC  X(24) VALUE SPACES.         CL*48
00301      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*47
00302      15  X434-QTR                   PIC  X(06).                      CL*47
00303      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*47
00304      15  X434-RCVD-DATE             PIC  X(10).                      CL*47
00305      15  FILLER                     PIC  X(05) VALUE SPACES.         CL*48
00306      15  X434-X145-REMIT            PIC   -------9.99.               CL*47
00307      15  FILLER                     PIC  X(05) VALUE SPACES.         CL*48
00308      15  X434-X145-TRACE            PIC  X(08) VALUE SPACES.         CL*72
00309      15  FILLER                     PIC  X(05) VALUE SPACES.         CL*71
00310      15  X434-MESSAGE               PIC  X(20).                      CL*48
00311                                                                      CL*47
00312  01  DETAIL-PEND-1.                                                  CL*47
00313      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*47
00314      15  P434-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL*47
00315      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*47
00316      15  P434-NAME-CHECK            PIC  X(24) VALUE SPACES.         CL*48
00317      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*47
00318      15  P434-QTR                   PIC  X(06).                      CL*47
00319      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*47
00320      15  P434-RCVD-DATE             PIC  X(10).                      CL*47
00321      15  FILLER                     PIC  X(05) VALUE SPACES.         CL*48
00322      15  P434-X145-REMIT            PIC  --------9.99.               CL*47
00323      15  FILLER                     PIC  X(05) VALUE SPACES.         CL*71
00324      15  P434-X145-TRACE            PIC  X(08) VALUE SPACES.         CL*71
00325      15  FILLER                     PIC  X(05) VALUE SPACES.         CL*48
00326      15  P434-MESSAGE               PIC  X(30).                      CL*47
00327                                                                      CL*47
00328  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.           CL*47
00329  01  FOOTING-LINE-2               PIC X(133) VALUE SPACES.           CL*47
00330                                                                      CL*47
00331  01  FOOTING-LINE-3.                                                 CL*47
00332      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*47
00333      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                       CL*47
00334      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*47
00335      05  FILLER                   PIC  X(45) VALUE                   CL*47
00336                    ' TOTAL ACH PAYMENTS RECEIVED'.                   CL*66
00337      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*47
00338                                                                      CL*47
00339  01  FOOTING-LINE-4.                                                 CL*47
00340      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*47
00341      05  WS-X145-ERR-CNT           PIC  ZZ,ZZ9.                      CL*47
00342      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*47
00343      05  FILLER                   PIC  X(34) VALUE                   CL*47
00344                     ' # OF ACH PAYMENTS HAD ERRORS '.                CL*66
00345      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*47
00346                                                                      CL*47
00347  01  FOOTING-LINE-5.                                                 CL*47
00348      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*47
00349      05  WS-X145-PEN-CNT           PIC  ZZ,ZZ9.                      CL*47
00350      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*47
00351      05  FILLER                   PIC  X(40) VALUE                   CL*47
00352                     ' # OF ACH PAYMTS WENT TO PENDING FILE '.        CL*66
00353      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*47
00354  01  FOOTING-LINE-6.                                                 CL*56
00355      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*56
00356      05  WS-T025-WRITE-CNT         PIC  ZZ,ZZ9.                      CL*56
00357      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*56
00358      05  FILLER                   PIC  X(45) VALUE                   CL*67
00359                ' # OF ACH PAYMENTS WAITING FOR PROCESSING '.         CL*66
00360      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*56
00361  01  FOOTING-LINE-7.                                                 CL*56
00362      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL*47
00363      05  WS-TOT-REMIT             PIC  $$$$$$$$9.99.                 CL*47
00364      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*47
00365      05  FILLER                   PIC  X(45) VALUE                   CL*47
00366                  ' TOTAL ACH PAYMENTS TO BE PROCESSED '.             CL*66
00367      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*47
00368                                                                      CL*47
00369  01  FOOTING-LINE-8.                                                 CL*56
00370      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL*56
00371      05  WS-TOTAL-REMIT           PIC  $$$$$$$$9.99.                 CL*56
00372      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*56
00373      05  FILLER                   PIC  X(45) VALUE                   CL*56
00374                       'TOTAL ACH PAYMENTS RECEIVED FROM ESSP'.       CL*66
00375      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*56
00376                                                                      CL*56
00377  01  FOOTING-LINE-13.                                                CL*47
00378      05  FILLER                   PIC X(25)  VALUE SPACES.           CL*47
00379      05  FILLER                   PIC  X(67) VALUE                   CL*47
00380           '*** END ESSP/DUTAS DAILY ACH PAYMNT PROCESSING ***'.      CL*66
00381  01  FOOTING-LINE-14              PIC  X(133) VALUE SPACES.          CL*47
00382                                                                      CL*47
00383                                                                      CL*47
00384                                                                      CL*47
00385  01  T025-REC.                                                    DTSBX438
00386  ++INCLUDE DTSIT025                                               DTSBX438
00387                                                                   DTSBX438
00388 *  REPORT                                                         DTSBX438
00389  01  X140-REC.                                                    DTSBX438
00390  ++INCLUDE DTSIX140                                               DTSBX438
00391                                                                   DTSBX438
00392 *  PAYMENT                                                        DTSBX438
00393  01  X145-REC.                                                    DTSBX438
00394  ++INCLUDE DTSIX145                                               DTSBX438
00395                                                                   DTSBX438
00396 *  ICESA-REPT-FILE                                                   CL*16
00397  01  X212-REC.                                                       CL*16
00398  ++INCLUDE DTSIX212                                                  CL*20
00399                                                                      CL*16
00400 *  BATCH - PSEUDO-BATCH XREF                                      DTSBX438
00401  01  X214-REC.                                                    DTSBX438
00402  ++INCLUDE DTSIX214                                               DTSBX438
00403                                                                   DTSBX438
00404 *  ERRORS                                                         DTSBX438
00405 *01  X907-REC.                                                    DTSBX438
00406 ***INCLUDE DTSIX907                                               DTSBX438
00407                                                                   DTSBX438
00408  01  L001-LINK-AREA.                                              DTSBX438
00409  ++INCLUDE DTSIL001                                               DTSBX438
00410                                                                   DTSBX438
00411  01  L003-LINK-AREA.                                              DTSBX438
00412  ++INCLUDE DTSIL003                                               DTSBX438
00413                                                                   DTSBX438
00414  01  L004-LINK-AREA.                                              DTSBX438
00415  ++INCLUDE DTSIL004                                               DTSBX438
00416                                                                   DTSBX438
00417                                                                      CL*16
00418  01  L005-LINK-AREA.                                                 CL*16
00419  ++INCLUDE DTSIL005                                                  CL*16
00420                                                                      CL*31
00421  01  L205-LINK-AREA.                                                 CL*31
00422  ++INCLUDE DTSIL205                                                  CL*31
00423                                                                      CL*16
00424  01  L910-LINK-AREA.                                              DTSBX438
00425  ++INCLUDE DTSIL910                                               DTSBX438
00426  01  MSKL-REC.                                                    DTSBX438
00427  ++INCLUDE DTSIMSKL                                               DTSBX438
00428                                                                   DTSBX438
00429  01  MHDR-REC.                                                    DTSBX438
00430  ++INCLUDE DTSIMHDR                                               DTSBX438
00431                                                                   DTSBX438
00432  01  MQTR-REC.                                                       CL*17
00433  ++INCLUDE DTSIMQTR                                                  CL*17
00434                                                                      CL*17
00435  01  MPRF-REC.                                                    DTSBX438
00436  ++INCLUDE DTSIMPRF                                               DTSBX438
00437                                                                   DTSBX438
00438  01  MPAY-REC.                                                    DTSBX438
00439  ++INCLUDE DTSIMPAY                                               DTSBX438
00440                                                                   DTSBX438
00441  01  MNTE-REC.                                                    DTSBX438
00442  ++INCLUDE DTSIMNTE                                               DTSBX438
00443                                                                   DTSBX438
00444  01  L921-LINK-AREA.                                              DTSBX438
00445  ++INCLUDE DTSIL921                                               DTSBX438
00446      SKIP3                                                        DTSBX438
00447  01  ISKL-REC.                                                    DTSBX438
00448  ++INCLUDE DTSIISKL                                               DTSBX438
00449      SKIP3                                                        DTSBX438
00450  01  IEIN-REC.                                                    DTSBX438
00451  ++INCLUDE DTSIIEIN                                               DTSBX438
00452                                                                   DTSBX438
00453  01  L923-LINK-AREA.                                              DTSBX438
00454  ++INCLUDE DTSIL923                                               DTSBX438
00455      EJECT                                                        DTSBX438
00456  01  ASKL-REC.                                                    DTSBX438
00457  ++INCLUDE DTSIASKL                                               DTSBX438
00458      EJECT                                                        DTSBX438
00459  01  AHDR-REC.                                                    DTSBX438
00460  ++INCLUDE DTSIAHDR                                               DTSBX438
00461      EJECT                                                        DTSBX438
00462  01  ARPT-REC.                                                    DTSBX438
00463  ++INCLUDE DTSIARPT                                               DTSBX438
00464      EJECT                                                        DTSBX438
00465  01  APAY-REC.                                                    DTSBX438
00466  ++INCLUDE DTSIAPAY                                               DTSBX438
00467                                                                   DTSBX438
00468  01  L927-LINK-AREA.                                              DTSBX438
00469  ++INCLUDE DTSIL927                                               DTSBX438
00470                                                                   DTSBX438
00471  01  TSKL-REC.                                                    DTSBX438
00472  ++INCLUDE DTSITSKL                                               DTSBX438
00473                                                                   DTSBX438
00474  01  L931-LINK-AREA.                                              DTSBX438
00475  ++INCLUDE DTSIL931                                               DTSBX438
00476                                                                   DTSBX438
00477  01  FSKL-REC.                                                    DTSBX438
00478  ++INCLUDE DTSIFSKL                                               DTSBX438
00479                                                                   DTSBX438
00480  01  R140-REC.                                                    DTSBX438
00481  ++INCLUDE DTSIR140                                               DTSBX438
00482                                                                   DTSBX438
00483  LINKAGE SECTION.                                                 DTSBX438
00484                                                                   DTSBX438
00485 *01  LX42-LINK-AREA.                                                 CL*14
00486 *++INCLUDE DTSILX42                                                  CL*14
00487                                                                   DTSBX438
00488  PROCEDURE DIVISION.                                                 CL*14
00489                                                                   DTSBX438
00490  DTSBX423-MAIN.                                                   DTSBX438
00491       PERFORM I0000-INITIATE        THRU I0000-EXIT.                 CL*27
00492                                                                   DTSBX438
00493       IF W-ERROR-YES-88                                              CL*27
00494       MOVE WRK-RETURN-CODE  TO RETURN-CODE                           CL*40
00495          GO TO DTSBX423-MAIN-EXIT.                                   CL*27
00496                                                                      CL*27
00497       PERFORM P0000-PROCESS         THRU P0000-EXIT.                 CL*27
00498                                                                   DTSBX438
00499       PERFORM T0000-TERMINATE       THRU T0000-EXIT.                 CL*27
00500       MOVE WRK-RETURN-CODE  TO RETURN-CODE.                          CL*40
00501                                                                   DTSBX438
00502                                                                   DTSBX438
00503  DTSBX423-MAIN-EXIT.                                              DTSBX438
00504      GOBACK.                                                      DTSBX438
00505                                                                   DTSBX438
00506  I0000-INITIATE.                                                  DTSBX438
00507      SET W-ERROR-NO-88                 TO TRUE.                   DTSBX438
00508      SET W-FATAL-ERROR-NO-88           TO TRUE.                   DTSBX438
00509      MOVE +0   TO WRK-RETURN-CODE                                    CL*25
00510                                                                   DTSBX438
00511      MOVE LENGTH OF R140-REC    TO R140-LENGTH.                   DTSBX438
00512      MOVE '140'                 TO R140-REC-TYPE.                 DTSBX438
00513                                                                   DTSBX438
00514      PERFORM I2000-OPEN-FILES           THRU I2000-EXIT.          DTSBX438
00515                                                                      CL*16
00516      PERFORM S005-FROM-SYS THRU S005-EXIT.                           CL*16
00517      MOVE L005-ABSTIME TO WRK-SYS-ABSTIME.                           CL*16
00518      MOVE L005-SLASH-DATE TO W-SLASH-DATE.                           CL*49
00519      DISPLAY  'SYS DATE ' W-SLASH-DATE.                              CL*49
00520      MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE.                        CL*49
00521                                                                      CL*16
00522      PERFORM S910-OPEN-READ   THRU S910-EXIT.                        CL*35
00523      PERFORM S927A-OPEN       THRU S927A-EXIT.                       CL*42
00524                                                                   DTSBX438
00525  I0000-EXIT.                                                      DTSBX438
00526      EXIT.                                                        DTSBX438
00527                                                                   DTSBX438
00528  I2000-OPEN-FILES.                                                DTSBX438
00529                                                                   DTSBX438
00530      OPEN INPUT    TDEC-PAYT-FILE.                                   CL*29
00531      IF W-TDEC-PAYT-EOF-88                                           CL*29
00532         DISPLAY 'NO TDEC PAYMENT FILES TO PROCESS    '               CL*29
00533         MOVE +3 TO WRK-RETURN-CODE                                   CL*27
00534          SET W-ERROR-YES-88           TO TRUE                        CL*27
00535      END-IF.                                                         CL*14
00536                                                                      CL*16
00537      OPEN OUTPUT   TDEC-PEND-FILE.                                   CL*29
00538      IF BATCH-XREF-OK-88                                             CL*16
00539         NEXT SENTENCE                                                CL*16
00540      ELSE                                                            CL*16
00541         DISPLAY 'CANNOT OPEN TDEC  PEND FILE '                       CL*29
00542            BATCH-XREF-STATUS                                         CL*16
00543         PERFORM S999-ABEND THRU S999-EXIT                            CL*16
00544      END-IF.                                                         CL*16
00545      OPEN OUTPUT   REPT-PEND-FILE.                                   CL*47
00546      IF REPT-STATUS-OK-88                                            CL*47
00547         NEXT SENTENCE                                                CL*47
00548      ELSE                                                            CL*47
00549         DISPLAY 'CANNOT OPEN REPORT PENDING FILE '                   CL*47
00550            REPT-STATUS                                               CL*47
00551         PERFORM S999-ABEND THRU S999-EXIT                            CL*47
00552      END-IF.                                                         CL*47
00553                                                                      CL*47
00554      OPEN OUTPUT   REPT-PAID-FILE.                                   CL*47
00555      IF REPT-STATUS-OK-88                                            CL*47
00556         NEXT SENTENCE                                                CL*47
00557      ELSE                                                            CL*47
00558         DISPLAY 'CANNOT OPEN REPORT PAID  FILE '                     CL*47
00559            REPT-STATUS                                               CL*47
00560         PERFORM S999-ABEND THRU S999-EXIT                            CL*47
00561      END-IF.                                                         CL*47
00562                                                                      CL*16
00563  I2000-EXIT.                                                      DTSBX438
00564      EXIT.                                                        DTSBX438
00565                                                                   DTSBX438
00566  P0000-PROCESS.                                                   DTSBX438
00567      READ TDEC-PAYT-FILE                                             CL*33
00568                                                                      CL*25
00569      IF W-TDEC-PAYT-EOF-88                                           CL*29
00570         DISPLAY 'TDEC  INPUT FILE IS EMPTY '                         CL*29
00571         MOVE +3   TO WRK-RETURN-CODE                                 CL*25
00572         GO TO P0000-EXIT                                             CL*25
00573      END-IF.                                                         CL*25
00574                                                                      CL*25
00575      PERFORM UNTIL W-TDEC-PAYT-EOF-88                                CL*29
00576         PERFORM P1100-PARSE-TDEC-PAYT-REC THRU P1100-EXIT            CL*30
00577       IF W-ERROR-NO-88                                               CL*31
00578         PERFORM P2100-PAYMENT THRU P2100-EXIT                        CL*25
00579       END-IF                                                         CL*31
00580         READ TDEC-PAYT-FILE                                          CL*33
00581      END-PERFORM.                                                    CL*25
00582                                                                      CL*25
00583                                                                   DTSBX438
00584  P0000-EXIT.                                                      DTSBX438
00585      EXIT.                                                        DTSBX438
00586  P1100-PARSE-TDEC-PAYT-REC.                                          CL*33
00587      SET W-ERROR-NO-88                 TO TRUE.                      CL*36
00588                                                                      CL*30
00589      PERFORM                                                         CL*30
00590        VARYING SUB FROM +1 BY +1                                     CL*30
00591        UNTIL SUB > +100                                              CL*30
00592        MOVE +0                  TO L205-FIELD-LENGTH (SUB)           CL*30
00593                                    L205-INTEGER (SUB)                CL*30
00594                                    L205-FRACTION (SUB)               CL*30
00595        MOVE SPACES              TO L205-TEXT (SUB)                   CL*30
00596                                    L205-DATE (SUB)                   CL*30
00597        SET L205-TYPE-TEXT-88 (SUB)  TO TRUE                          CL*30
00598      END-PERFORM.                                                    CL*30
00599                                                                      CL*30
00600      IF WEB-IMP-TYPE-PAY-88                                          CL*30
00601         PERFORM P1100J-SET-205-FIELDS  THRU P1100J-EXIT              CL*31
00602      ELSE                                                            CL*30
00603        SET W-ERROR-YES-88                TO TRUE                     CL*30
00604        DISPLAY ' RECORD IS NOT PAY TYPE '                            CL*30
00605      END-IF.                                                         CL*30
00606                                                                   DTSBX438
00607                                                                      CL*31
00608 *    DISPLAY ' **** GOING TO 205 EDIT ESSP RECS '                    CL*31
00609 *    DISPLAY ' **** '                                                CL*31
00610                                                                      CL*31
00611      IF W-ERROR-NO-88                                                CL*31
00612         MOVE TDEC-PAYT-REC  TO L205-INPUT-DATA                       CL*31
00613         CALL 'DTSBU205'  USING L205-LINK-AREA                        CL*31
00614         PERFORM P1100K-BUILD-X145-REC THRU P1100K-EXIT.              CL*31
00615                                                                      CL*31
00616                                                                      CL*31
00617  P1100-EXIT.                                                         CL*31
00618      EXIT.                                                           CL*31
00619                                                                      CL*31
00620  P1100J-SET-205-FIELDS.                                              CL*31
00621       DISPLAY 'P1100J-PAY ' TDEC-PAYT-REC(1:84).                     CL*31
00622       INITIALIZE X145-REC.                                           CL*31
00623       MOVE +12                      TO L205-LAST-FIELD.              CL*31
00624       MOVE +8                       TO L205-LAST-FIELD-LEN.          CL*31
00625                                                                      CL*31
00626       MOVE +3                       TO L205-FIELD-LENGTH (1).        CL*31
00627       SET L205-TYPE-TEXT-88 (1)     TO TRUE.                         CL*31
00628                                                                      CL*31
00629       MOVE +6                       TO L205-FIELD-LENGTH (2).        CL*31
00630       SET L205-TYPE-TEXT-88 (2)     TO TRUE.                         CL*31
00631                                                                      CL*31
00632       MOVE +6                       TO L205-FIELD-LENGTH (3).        CL*31
00633       SET L205-TYPE-TEXT-88 (3)     TO TRUE.                         CL*31
00634                                                                      CL*31
00635       MOVE +6                       TO L205-FIELD-LENGTH (4).        CL*31
00636       SET L205-TYPE-TEXT-88 (4)     TO TRUE.                         CL*31
00637       MOVE +3                       TO L205-FIELD-LENGTH (5).        CL*31
00638       SET L205-TYPE-TEXT-88 (5)     TO TRUE.                         CL*31
00639                                                                      CL*31
00640       MOVE +2                       TO L205-FIELD-LENGTH (6).        CL*31
00641       SET L205-TYPE-TEXT-88 (6)   TO TRUE.                           CL*31
00642                                                                      CL*31
00643       MOVE +2                       TO L205-FIELD-LENGTH (7).        CL*31
00644       SET L205-TYPE-TEXT-88 (7)     TO TRUE.                         CL*31
00645                                                                      CL*31
00646       MOVE +2                       TO L205-FIELD-LENGTH (8).        CL*31
00647       SET L205-TYPE-TEXT-88 (8)     TO TRUE.                         CL*31
00648                                                                      CL*31
00649       MOVE +14                      TO L205-FIELD-LENGTH (9).        CL*31
00650       SET L205-TYPE-NUMBER-88 (9)     TO TRUE.                       CL*31
00651        MOVE +10                      TO L205-FIELD-LENGTH (10).      CL*31
00652        SET L205-TYPE-TEXT-88 (10)    TO TRUE.                        CL*31
00653                                                                      CL*31
00654        MOVE +10                      TO L205-FIELD-LENGTH (11).      CL*31
00655        SET L205-TYPE-TEXT-88 (11)     TO TRUE.                       CL*31
00656                                                                      CL*31
00657        MOVE +8                       TO L205-FIELD-LENGTH (12).      CL*31
00658        SET L205-TYPE-TEXT-88 (12)     TO TRUE.                       CL*31
00659                                                                      CL*31
00660                                                                      CL*31
00661  P1100J-EXIT.                                                        CL*31
00662       EXIT.                                                          CL*31
00663                                                                      CL*31
00664  P1100K-BUILD-X145-REC.                                              CL*31
00665      MOVE L205-TEXT (1) (1:03)  TO X145-REC-TYPE.                    CL*31
00666                                                                      CL*31
00667      MOVE L205-TEXT (2) (1:06)  TO X145-EMP-NO.                      CL*31
00668                                                                      CL*31
00669      MOVE '0'                   TO X145-SOURCE.                      CL*31
00670                                                                      CL*31
00671      MOVE L205-TEXT (3) (1:06)  TO X145-QTR.                         CL*31
00672 *    DISPLAY 'X145 QTR ' X145-QTR.                                   CL*46
00673                                                                      CL*31
00674      MOVE L205-TEXT (8) (1:02)  TO X145-PAY-TYPE.                    CL*31
00675 *    DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE.                         CL*46
00676                                                                      CL*31
00677      MOVE L205-INTEGER (9)      TO W-INTEGER.                        CL*31
00678      MOVE L205-FRACTION (9)     TO W-FRACTION.                       CL*31
00679      COMPUTE W-NUMBER = W-INTEGER + W-FRACTION.                      CL*31
00680      MOVE W-NUMBER              TO X145-REMITTANCE.                  CL*31
00681 *    DISPLAY 'X145 PAY AMT  ' X145-REMITTANCE.                       CL*46
00682                                                                      CL*31
00683      MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE.                   CL*31
00684 *    DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE.                        CL*46
00685                                                                      CL*31
00686      MOVE L205-TEXT (12)        TO X145-TRACE-NO                     CL*78
00687                                    W-X145-TRACE-NO.                  CL*78
00688      DISPLAY 'X145 PAY NO   ' X145-TRACE-NO.                         CL*78
00689      DISPLAY 'W145 PAY NO   ' W-X145-TRACE-NO.                       CL*78
00690      DISPLAY 'N145 PAY NO   ' W-X145-TRACE-NO-N.                     CL*79
00691      DISPLAY 'A145 PAY NO   ' W-X145-TRACE-NO-A.                     CL*82
00692 *    MOVE X145-TRACE-NO       TO W-X145-TRACE-NO                     CL*74
00693                                                                      CL*31
00694                                                                      CL*31
00695      MOVE ZEROS                 TO X145-PSEUDO-BATCH.                CL*31
00696                                                                      CL*31
00697      MOVE ZEROS                 TO X145-PSEUDO-ITEM.                 CL*31
00698                                                                      CL*31
00699      MOVE SPACES                TO X145-APPLIC-ACCT.                 CL*31
00700                                                                      CL*31
00701      MOVE SPACES                TO X145-CHECK-SCAN-DT.               CL*31
00702                                                                      CL*31
00703      MOVE ZEROS                 TO X145-CHECK-SEQ-NBR.               CL*31
00704                                                                      CL*31
00705      MOVE 'N'                   TO X145-WAIVE-INTEREST.              CL*31
00706                                                                      CL*31
00707      MOVE 'N'                   TO X145-WAIVE-PENALTY.               CL*31
00708                                                                      CL*31
00709      MOVE 'VOL'                 TO X145-RESP-ACTIVITY.               CL*31
00710                                                                      CL*31
00711      MOVE 'WEBESSP '            TO X145-RESP-OPID.                   CL*69
00712                                                                      CL*31
00713  P1100K-EXIT.                                                        CL*31
00714       EXIT.                                                          CL*31
00715                                                                      CL*31
00716  P2100-PAYMENT.                                                   DTSBX438
00717      MOVE X145-EMP-NO                 TO W-EMP-NO.                   CL*29
00718 *    DISPLAY ' EMP NO ' W-EMP-NO.                                    CL*46
00719      SET W-EMP-FOUND-YES-88            TO TRUE.                      CL*47
00720                                                                   DTSBX438
00721      SET W-QTR-FOUND-NO-88            TO TRUE.                       CL*17
00722      SET W-ERROR-NO-88                TO TRUE                        CL*17
00723                                                                   DTSBX438
00724      ADD +1                            TO W-X212-CNT.                CL*29
00725                                                                      CL*29
00726      PERFORM P2110-EDIT-PAYMENT        THRU P2110-EXIT.              CL*29
00727                                                                      CL*47
00728      IF W-EMP-FOUND-NO-88 OR                                         CL*47
00729         W-ERROR-YES-88                                               CL*47
00730        ADD 1 TO W-PEND-CNT                                           CL*48
00731        ADD 1 TO W-MPRF-CNT                                           CL*48
00732        ADD 1 TO W-ERRO-CNT                                           CL*48
00733        ADD 1 TO W-X145-ERR-CNT                                       CL*57
00734        ADD  W-REMITTANCE TO W-TOT-PEND-REMITTANCE                    CL*57
00735        WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC                        CL*47
00736        MOVE R140-MESSAGE     TO  P434-MESSAGE                        CL*48
00737        PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT                  CL*48
00738        GO TO P2100-EXIT.                                             CL*47
00739                                                                      CL*47
00740                                                                      CL*29
00741                                                                      CL*48
00742      PERFORM P2120-SAVE-EXT-PAY  THRU P2120-EXIT                     CL*47
00743      ADD  W-REMITTANCE TO W-TOT-PAID-REMITTANCE                      CL*57
00744      MOVE 'RECEIVED          '   TO  P434-MESSAGE                    CL*65
00745      PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT.                   CL*48
00746                                                                   DTSBX438
00747  P2100-EXIT.                                                      DTSBX438
00748      EXIT.                                                        DTSBX438
00749                                                                   DTSBX438
00750  P2110-EDIT-PAYMENT.                                              DTSBX438
00751      MOVE X145-PAY-TYPE      TO W-PAY-TYPE.                          CL*69
00752      IF W-VALID-PAY-88                                               CL*69
00753        NEXT SENTENCE                                                 CL*69
00754      ELSE                                                            CL*69
00755         SET W-ERROR-YES-88    TO TRUE                                CL*69
00756         MOVE SPACES TO R140-MESSAGE                                  CL*69
00757         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*69
00758         STRING                                                       CL*69
00759            'INVALID PAYMENT TYPE '                                   CL*69
00760               X145-PAY-TYPE                                          CL*69
00761             DELIMITED BY SIZE                                        CL*69
00762             INTO R140-MESSAGE                                        CL*69
00763         END-STRING                                                   CL*69
00764         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*69
00765         DISPLAY R140-MESSAGE                                         CL*69
00766      END-IF.                                                         CL*69
00767                                                                   DTSBX438
00768      MOVE SPACES             TO W-SLASH-QTR.                         CL*24
00769      IF X145-QTR = SPACES                                            CL*29
00770        MOVE ZEROS               TO W-REPORT-QTR                   DTSBX438
00771      ELSE                                                         DTSBX438
00772         MOVE X145-QTR           TO W-SLASH-QTR                       CL*29
00773         MOVE W-SLASH-QTR-CCYY   TO L004-QTR-5-YR                  DTSBX438
00774         MOVE W-SLASH-QTR-Q      TO L004-QTR-5-Q                   DTSBX438
00775         PERFORM S004-FROM-5     THRU S004-EXIT                    DTSBX438
00776         IF NOT L004-VALID-QTR                                     DTSBX438
00777            SET W-ERROR-YES-88    TO TRUE                          DTSBX438
00778            MOVE SPACES TO R140-MESSAGE                            DTSBX438
00779            MOVE W-EMP-NO     TO R140-EMP-NO                       DTSBX438
00780            STRING                                                 DTSBX438
00781               'PEND: INV PAY QUARTER ' W-SLASH-QTR                   CL*63
00782                DELIMITED BY SIZE                                  DTSBX438
00783                INTO R140-MESSAGE                                  DTSBX438
00784            END-STRING                                             DTSBX438
00785            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX438
00786            DISPLAY R140-MESSAGE                                   DTSBX438
00787            MOVE +2   TO WRK-RETURN-CODE                              CL*25
00788         ELSE                                                      DTSBX438
00789            MOVE L004-QTR-5-9     TO W-REPORT-QTR                  DTSBX438
00790         END-IF                                                    DTSBX438
00791      END-IF.                                                      DTSBX438
00792                                                                   DTSBX438
00793      MOVE X145-REMITTANCE     TO W-REMITTANCE.                       CL*29
00794 *    DISPLAY 'WREMITTANCE  ' W-REMITTANCE.                           CL*46
00795 *    DISPLAY 'XREMITTANCE  ' X145-REMITTANCE.                        CL*46
00796                                                                      CL*38
00797      ADD  W-REMITTANCE     TO W-TOT-REMITTANCE.                      CL*57
00798      IF W-REMITTANCE = ZEROS                                         CL*39
00799 *       SET W-ERROR-YES-88  TO TRUE                                  CL*64
00800         MOVE SPACES TO R140-MESSAGE                                  CL*38
00801         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*38
00802         STRING                                                       CL*38
00803           'INVALID REMITTANCE AMOUNT ' X145-REMITTANCE               CL*38
00804             DELIMITED BY SIZE                                        CL*38
00805             INTO R140-MESSAGE                                        CL*38
00806         END-STRING                                                   CL*38
00807         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*38
00808         DISPLAY R140-MESSAGE                                         CL*38
00809 *          MOVE +2   TO WRK-RETURN-CODE                              CL*64
00810      END-IF.                                                         CL*38
00811                                                                      CL*38
00812                                                                   DTSBX438
00813      MOVE X145-RCVD-DATE      TO W-SLASH-DATE                        CL*30
00814      MOVE W-SLASH-DT-MM       TO L001-FED-8-MO                    DTSBX438
00815      MOVE W-SLASH-DT-DD       TO L001-FED-8-DA                    DTSBX438
00816      MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR                    DTSBX438
00817      PERFORM S001-FROM-FED-8  THRU S001-EXIT                      DTSBX438
00818      IF NOT L001-VALID-DATE                                       DTSBX438
00819         SET W-ERROR-YES-88  TO TRUE                               DTSBX438
00820         MOVE SPACES TO R140-MESSAGE                               DTSBX438
00821         MOVE W-EMP-NO     TO R140-EMP-NO                          DTSBX438
00822         STRING                                                    DTSBX438
00823            'INVALID PAY RECEIVED DATE ' X145-RCVD-DATE               CL*30
00824             DELIMITED BY SIZE                                     DTSBX438
00825             INTO R140-MESSAGE                                     DTSBX438
00826         END-STRING                                                DTSBX438
00827         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX438
00828         DISPLAY R140-MESSAGE                                      DTSBX438
00829            MOVE +2   TO WRK-RETURN-CODE                              CL*25
00830      ELSE                                                         DTSBX438
00831         MOVE L001-FED-8-DATE-9  TO W-RECEIVED-DATE                DTSBX438
00832      END-IF.                                                      DTSBX438
00833                                                                   DTSBX438
00834 *    MOVE X212-DEPOSIT-DT     TO W-SLASH-DATE                        CL*29
00835 *    MOVE W-SLASH-DT-MM       TO L001-FED-8-MO                       CL*29
00836 *    MOVE W-SLASH-DT-DD       TO L001-FED-8-DA                       CL*29
00837 *    MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR                       CL*29
00838 *    PERFORM S001-FROM-FED-8  THRU S001-EXIT                         CL*29
00839 *    IF NOT L001-VALID-DATE                                          CL*29
00840 *       SET W-ERROR-YES-88  TO TRUE                                  CL*29
00841 *       MOVE SPACES TO R140-MESSAGE                                  CL*29
00842 *       MOVE W-EMP-NO     TO R140-EMP-NO                             CL*29
00843 *       STRING                                                       CL*29
00844 *          'INVALID DEPOSIT DATE      ' X212-DEPOSIT-DT              CL*29
00845 *           DELIMITED BY SIZE                                        CL*29
00846 *           INTO R140-MESSAGE                                        CL*29
00847 *       END-STRING                                                   CL*29
00848 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*29
00849 *       DISPLAY R140-MESSAGE                                         CL*11
00850 *          MOVE +2   TO WRK-RETURN-CODE                              CL*29
00851 *    ELSE                                                            CL*29
00852 *       MOVE L001-FED-8-DATE-9  TO W-DEPOSIT-DATE                    CL*29
00853 *    END-IF.                                                         CL*11
00854                                                                   DTSBX438
00855      PERFORM P2112-CHECK-DATABASE   THRU P2112-EXIT.                 CL*17
00856  P2110-EXIT.                                                      DTSBX438
00857      EXIT.                                                        DTSBX438
00858                                                                   DTSBX438
00859  P2112-CHECK-DATABASE.                                            DTSBX438
00860      MOVE LOW-VALUE               TO MPRF-KEY-AREA.               DTSBX438
00861      MOVE W-EMP-NO                   TO MPRF-EMP-NO.              DTSBX438
00862      SET MPRF-PRF-88              TO TRUE.                        DTSBX438
00863      MOVE MPRF-KEY-AREA           TO MSKL-KEY-AREA.               DTSBX438
00864                                                                   DTSBX438
00865      PERFORM S910-READ            THRU S910-EXIT.                 DTSBX438
00866      IF L910-NO-REC-88                                            DTSBX438
00867         SET W-ERROR-YES-88  TO TRUE                                  CL*25
00868         SET W-EMP-FOUND-NO-88     TO TRUE                         DTSBX438
00869         DISPLAY 'PAYMENT: EMPLOYER NOT ON FILE ' W-EMP-NO            CL*45
00870         MOVE SPACES TO R140-MESSAGE                                  CL*15
00871         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*15
00872         STRING                                                       CL*15
00873            'PEND: EMP NOT ON DUTAS'                                  CL*62
00874               X145-EMP-NO                                            CL*30
00875             DELIMITED BY SIZE                                        CL*15
00876             INTO R140-MESSAGE                                        CL*15
00877         END-STRING                                                   CL*15
00878         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*15
00879            MOVE +2   TO WRK-RETURN-CODE                              CL*41
00880 *       DISPLAY R140-MESSAGE                                         CL*16
00881      ELSE                                                         DTSBX438
00882         MOVE MSKL-REC             TO MPRF-REC                     DTSBX438
00883         SET W-EMP-FOUND-YES-88    TO TRUE                         DTSBX438
00884      END-IF.                                                      DTSBX438
00885                                                                   DTSBX438
00886      IF W-EMP-FOUND-NO-88 OR                                         CL*62
00887         W-ERROR-YES-88                                               CL*62
00888 *      WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC                        CL*47
00889 *      ADD 1 TO W-PEND-CNT                                           CL*47
00890 *      ADD 1 TO W-MPRF-CNT                                           CL*47
00891 *      ADD 1 TO W-ERRO-CNT                                           CL*47
00892        GO TO P2112-EXIT.                                             CL*62
00893                                                                      CL*16
00894 *  IF EMPLOYER IS FOUND ON THE MPRF CHECK IF REPORT FOUND.           CL*16
00895 *  IF EITHER IS NOT FOUND WRITE T025  REC TO PENDING FILE.           CL*16
00896                                                                      CL*16
00897      MOVE LOW-VALUE               TO MQTR-KEY-AREA.                  CL*22
00898      MOVE W-EMP-NO                TO MQTR-EMP-NO.                    CL*17
00899      MOVE W-REPORT-QTR            TO MQTR-YRQ.                       CL*22
00900      SET MQTR-QTR-88              TO TRUE.                           CL*16
00901      MOVE MQTR-KEY-AREA           TO MSKL-KEY-AREA.                  CL*16
00902                                                                      CL*16
00903      PERFORM S910-READ            THRU S910-EXIT.                    CL*16
00904      IF L910-NO-REC-88                                               CL*16
00905 *       SET W-ERROR-YES-88  TO TRUE                                  CL*45
00906         SET W-QTR-FOUND-NO-88     TO TRUE                            CL*17
00907         DISPLAY 'PAYMENT: EMPL QTR NOT ON FILE ' W-EMP-NO            CL*45
00908         MOVE SPACES TO R140-MESSAGE                                  CL*16
00909         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*16
00910         STRING                                                       CL*16
00911            'REPT: QTR RPT NOT ON FILE '                              CL*64
00912               X145-EMP-NO   ' QTR' W-SLASH-QTR                       CL*30
00913             DELIMITED BY SIZE                                        CL*16
00914             INTO R140-MESSAGE                                        CL*16
00915         END-STRING                                                   CL*16
00916         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*16
00917 *          MOVE +2   TO WRK-RETURN-CODE                              CL*45
00918 *       DISPLAY R140-MESSAGE                                         CL*16
00919      ELSE                                                            CL*17
00920         SET W-QTR-FOUND-YES-88     TO TRUE                           CL*17
00921      END-IF.                                                         CL*16
00922                                                                      CL*16
00923 *    IF W-QTR-FOUND-NO-88 OR                                         CL*47
00924 *       W-ERROR-YES-88                                               CL*47
00925 *      WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC                        CL*45
00926 *      ADD 1 TO W-MQTR-CNT                                           CL*47
00927 *      ADD 1 TO W-ERRO-CNT                                           CL*47
00928 *      ADD 1 TO W-PEND-CNT.                                          CL*47
00929                                                                      CL*16
00930  P2112-EXIT.                                                      DTSBX438
00931      EXIT.                                                        DTSBX438
00932                                                                   DTSBX438
00933  P2120-SAVE-EXT-PAY.                                              DTSBX438
00934      DISPLAY 'PAYMENT OK ' X212-EMP-NBR.                             CL*69
00935      PERFORM S005-FROM-SYS THRU S005-EXIT.                           CL*69
00936                                                                      CL*69
00937      MOVE LENGTH OF T025-REC        TO T025-LENGTH                   CL*69
00938      MOVE '025'                     TO T025-REC-TYPE.                CL*69
00939                                                                      CL*69
00940      MOVE W-EMP-NO                  TO T025-EMP-NO.                  CL*69
00941      MOVE 'WEB PAY '                 TO T025-ORIGIN.                 CL*69
00942      MOVE L005-DATE                 TO T025-SYS-DATE.                CL*69
00943      MOVE L005-TIME                 TO T025-SYS-TIME.                CL*69
00944                                                                      CL*69
00945      IF W-REPORT-QTR > ZERO                                          CL*69
00946         MOVE W-REPORT-QTR           TO T025-APPLIC-YRQ               CL*69
00947         MOVE 'PA'                   TO T025-PAY-TYPE                 CL*69
00948      ELSE                                                            CL*69
00949      MOVE ZERO                   TO T025-APPLIC-YRQ                  CL*69
00950      MOVE 'PA'                   TO T025-PAY-TYPE                    CL*69
00951      END-IF.                                                         CL*69
00952                                                                   DTSBX438
00953      MOVE SPACES                    TO T025-APPLIC-IND.              CL*69
00954      MOVE ZERO                      TO T025-APPLIC-BATCH-NO          CL*69
00955                                        T025-APPLIC-ITEM-NO.          CL*69
00956                                                                   DTSBX438
00957      IF W-EMP-FOUND-YES-88                                           CL*69
00958         MOVE MPRF-PRIMARY-NAME (1:4)                                 CL*69
00959                                     TO T025-NAME-CHECK               CL*69
00960      ELSE                                                            CL*69
00961         MOVE SPACES                 TO T025-NAME-CHECK               CL*69
00962      END-IF.                                                         CL*69
00963                                                                   DTSBX438
00964      MOVE W-RECEIVED-DATE           TO T025-RECEIVED-DATE            CL*69
00965                                        T025-DEPOSIT-DATE.            CL*69
00966                                                                   DTSBX438
00967                                                                   DTSBX438
00968      MOVE W-REMITTANCE              TO T025-REMIT-AMT.               CL*69
00969                                                                   DTSBX438
00970 *    MOVE X145-TRACE-NO             TO W-X145-TRACE-NO.              CL*78
00971                                                                      CL*69
00972      IF X145-TRACE-NO > SPACES                                       CL*75
00973         MOVE W-X145-TRACE-NO-A         TO T025-TRACE-NO              CL*82
00974      ELSE                                                            CL*69
00975         MOVE ZEROS                     TO T025-TRACE-NO.             CL*69
00976                                                                      CL*69
00977      MOVE 'VOL'                    TO T025-RESPONSIBLE-ACTIVITY.     CL*69
00978      MOVE 'WEBESSP '               TO T025-RESPONSIBLE-OP-ID.        CL*69
00979                                                                   DTSBX438
00980      MOVE T025-REC                  TO TSKL-REC.                     CL*69
00981      PERFORM S927B-WRITE            THRU S927B-EXIT.                 CL*69
00982      ADD +1                         TO W-T025-WRITE-CNT.             CL*69
00983                                                                   DTSBX438
00984 **   DISPLAY 'BX423 PAYMENT ' X145-EMP-NO.                        DTSBX438
00985  P2120-EXIT.                                                      DTSBX438
00986      EXIT.                                                        DTSBX438
00987                                                                   DTSBX438
00988                                                                   DTSBX438
00989  P3000-WRITE-PAID-RPT.                                               CL*48
00990      MOVE X145-EMP-NO          TO  P434-EMP-NO                       CL*48
00991      MOVE X145-QTR             TO  P434-QTR                          CL*48
00992      IF W-EMP-FOUND-YES-88                                           CL*48
00993         MOVE MPRF-PRIMARY-NAME (1:24)                                CL*48
00994                                     TO P434-NAME-CHECK               CL*48
00995      ELSE                                                            CL*48
00996         MOVE SPACES                 TO P434-NAME-CHECK               CL*48
00997      END-IF.                                                         CL*48
00998                                                                      CL*48
00999      MOVE X145-RCVD-DATE       TO  P434-RCVD-DATE                    CL*48
01000      MOVE W-REMITTANCE         TO  P434-X145-REMIT                   CL*53
01001      MOVE X145-TRACE-NO        TO  P434-X145-TRACE                   CL*71
01002 *    ADD  W-REMITTANCE         TO  W-X145-TOT-REMIT-AMT.             CL*54
01003                                                                      CL*48
01004      PERFORM P4100-PRINT-HEADER THRU P4100-EXIT.                     CL*48
01005      WRITE REPT-PAID-REC FROM DETAIL-PEND-1  AFTER 1.                CL*48
01006      ADD  1    TO WS-LINE-CNT2.                                      CL*48
01007 *    ADD +1    TO WS-NUMBER-ONE.                                     CL*50
01008  P3000-EXIT.                                                         CL*48
01009      EXIT.                                                           CL*48
01010                                                                      CL*48
01011                                                                      CL*48
01012  P4100-PRINT-HEADER.                                                 CL*48
01013       IF WS-LINE-CNT GREATER 58 OR                                   CL*48
01014            WS-LINE-CNT2 GREATER 58                                   CL*48
01015          MOVE +0          TO WS-LINE-CNT                             CL*48
01016          MOVE +0          TO WS-LINE-CNT2                            CL*48
01017          ADD  +1          TO WS-PAGE-CNT                             CL*48
01018          MOVE WS-PAGE-CNT TO HDR3-PAGE                               CL*48
01019 *        MOVE   '  -/+   ----- MONTHLY COUNT' TO HDR5-NAME           CL*50
01020          WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE         CL*48
01021          WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1                   CL*48
01022          WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1                   CL*48
01023          WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1                   CL*48
01024 *        WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1                  CL*50
01025          WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1                   CL*48
01026          WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1                   CL*48
01027          ADD +6    TO WS-LINE-CNT2.                                  CL*48
01028  P4100-EXIT.                                                         CL*48
01029       EXIT.                                                          CL*48
01030                                                                      CL*48
01031                                                                      CL*48
01032                                                                   DTSBX438
01033  T0000-TERMINATE.                                                 DTSBX438
01034      IF WS-LINE-CNT2 > 52                                            CL*57
01035         PERFORM P4100-PRINT-HEADER THRU P4100-EXIT                   CL*55
01036      END-IF.                                                         CL*55
01037      MOVE W-X212-CNT     TO WS-FOOTING-CNT.                          CL*56
01038      MOVE W-T025-WRITE-CNT  TO WS-T025-WRITE-CNT.                    CL*56
01039      MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT.                         CL*61
01040      MOVE W-X145-ERR-CNT TO WS-X145-PEN-CNT.                         CL*61
01041      MOVE W-TOT-PAID-REMITTANCE TO WS-TOT-REMIT.                     CL*57
01042 *    MOVE W-TOT-REMIT-AMT TO WS-TOTAL-REMIT.                         CL*56
01043      MOVE W-TOT-REMITTANCE     TO WS-TOTAL-REMIT.                    CL*60
01044      WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1.                CL*55
01045      WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1.                CL*55
01046      WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1.                CL*55
01047      WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1.                CL*55
01048      WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1.                CL*55
01049 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1.                CL*65
01050      WRITE REPT-PAID-REC FROM FOOTING-LINE-7  AFTER 1.               CL*55
01051      WRITE REPT-PAID-REC FROM FOOTING-LINE-8  AFTER 1.               CL*56
01052      WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 3.               CL*60
01053      WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1.               CL*55
01054                                                                      CL*55
01055      DISPLAY ' '.                                                    CL*55
01056                                                                      CL*55
01057                                                                      CL*55
01058                                                                   DTSBX438
01059      CLOSE TDEC-PAYT-FILE TDEC-PEND-FILE.                            CL*29
01060                                                                   DTSBX438
01061      PERFORM S910-CLOSE       THRU S910-EXIT.                        CL*35
01062      PERFORM S927C-CLOSE      THRU S927C-EXIT.                       CL*43
01063      DISPLAY ' '.                                                 DTSBX438
01064                                                                   DTSBX438
01065      DISPLAY '*** DTSBX437 TERMINATION STATISTICS ***'.              CL*64
01066                                                                   DTSBX438
01067      DISPLAY ' '.                                                 DTSBX438
01068                                                                   DTSBX438
01069      DISPLAY '***  TDEC REPORT PAYMENTS  FOR DOES   *'.              CL*64
01070                                                                   DTSBX438
01071      DISPLAY ' '.                                                 DTSBX438
01072                                                                   DTSBX438
01073      PERFORM T2000-DISPLAY-TOTALS         THRU T2000-EXIT.        DTSBX438
01074                                                                   DTSBX438
01075      DISPLAY '***************************************'.           DTSBX438
01076                                                                   DTSBX438
01077  T0000-EXIT.                                                      DTSBX438
01078      EXIT.                                                        DTSBX438
01079                                                                   DTSBX438
01080                                                                   DTSBX438
01081  T2000-DISPLAY-TOTALS.                                            DTSBX438
01082      DISPLAY 'TDEC  PAYMENTS READ    :  '                            CL*64
01083              W-X212-CNT.                                             CL*17
01084                                                                      CL*17
01085      DISPLAY 'TOTAL PAYMENTS PROCESSD:  '                            CL*64
01086              W-T025-WRITE-CNT.                                    DTSBX438
01087                                                                   DTSBX438
01088      DISPLAY 'TOTAL PAYMTN HAD ERRORS:  '                            CL*64
01089              W-ERRO-CNT.                                             CL*17
01090                                                                      CL*17
01091      DISPLAY 'MPRF RECORDS NOT FOUND :  '                            CL*17
01092              W-MPRF-CNT.                                             CL*17
01093                                                                      CL*17
01094      DISPLAY 'MQTR RECORDS NOT FOUND :  '                            CL*17
01095              W-MQTR-CNT.                                             CL*17
01096                                                                      CL*17
01097      DISPLAY 'PENDING PAYMENT WRITTEN:  '                            CL*64
01098              W-PEND-CNT.                                             CL*17
01099                                                                      CL*17
01100                                                                   DTSBX438
01101      DISPLAY '  '.                                                DTSBX438
01102                                                                   DTSBX438
01103  T2000-EXIT.                                                      DTSBX438
01104      EXIT.                                                        DTSBX438
01105                                                                   DTSBX438
01106  S001-FROM-FED-8.                                                 DTSBX438
01107      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX438
01108      GO TO S001-DATE.                                             DTSBX438
01109                                                                   DTSBX438
01110  S001-FROM-CAL-8.                                                 DTSBX438
01111      SET L001-FROM-CAL-8 TO TRUE.                                 DTSBX438
01112      GO TO S001-DATE.                                             DTSBX438
01113                                                                   DTSBX438
01114  S001-FROM-ABS-DAY.                                               DTSBX438
01115      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX438
01116      GO TO S001-DATE.                                             DTSBX438
01117                                                                   DTSBX438
01118  S001-DATE.                                                       DTSBX438
01119      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX438
01120  S001-EXIT.                                                       DTSBX438
01121      EXIT.                                                        DTSBX438
01122                                                                   DTSBX438
01123  S003-AGENCY-DAY.                                                 DTSBX438
01124      SET L003-AGENCY-DAY TO TRUE.                                 DTSBX438
01125      GO TO S003-WORK-DAY.                                         DTSBX438
01126                                                                   DTSBX438
01127  S003-WORK-DAY.                                                   DTSBX438
01128      CALL 'DTSBU003' USING L003-LINK-AREA.                        DTSBX438
01129  S003-EXIT.                                                       DTSBX438
01130      EXIT.                                                        DTSBX438
01131                                                                   DTSBX438
01132  S004-FROM-5.                                                     DTSBX438
01133      SET L004-FROM-5        TO TRUE.                              DTSBX438
01134      GO TO S004-YRQ.                                              DTSBX438
01135                                                                   DTSBX438
01136  S004-FROM-DATE.                                                  DTSBX438
01137      SET L004-FROM-DATE     TO TRUE.                              DTSBX438
01138      GO TO S004-YRQ.                                              DTSBX438
01139                                                                   DTSBX438
01140  S004-FROM-ABS.                                                   DTSBX438
01141      SET L004-FROM-ABS      TO TRUE.                              DTSBX438
01142      GO TO S004-YRQ.                                              DTSBX438
01143                                                                   DTSBX438
01144  S004-YRQ.                                                        DTSBX438
01145      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX438
01146                                                                   DTSBX438
01147  S004-EXIT.                                                       DTSBX438
01148      EXIT.                                                        DTSBX438
01149  S005-FROM-SYS.                                                      CL*16
01150      SET L005-FROM-SYS TO TRUE.                                      CL*16
01151      GO TO S005-ABSTIME.                                             CL*16
01152                                                                      CL*16
01153  S005-FROM-ABSTIME.                                                  CL*16
01154      SET L005-FROM-ABSTIME TO TRUE.                                  CL*16
01155      GO TO S005-ABSTIME.                                             CL*16
01156                                                                      CL*16
01157  S005-ABSTIME.                                                       CL*16
01158      CALL 'DTSBU005' USING L005-LINK-AREA.                           CL*16
01159  S005-EXIT.                                                          CL*16
01160      EXIT.                                                           CL*16
01161                                                                      CL*32
01162  S205-WEB-EDITOR.                                                    CL*32
01163      CALL 'DTSBU205' USING L205-LINK-AREA.                           CL*32
01164  S205-EXIT.                                                          CL*32
01165      EXIT.                                                           CL*32
01166                                                                   DTSBX438
01167  S910-OPEN-READ.                                                     CL*35
01168      SET L910-OPEN-READ-88 TO TRUE.                                  CL*35
01169      GO TO S910-MSTR-IO.                                             CL*35
01170                                                                      CL*35
01171  S910-READ.                                                       DTSBX438
01172      SET L910-READ-88 TO TRUE.                                    DTSBX438
01173      GO TO S910-MSTR-IO.                                          DTSBX438
01174                                                                   DTSBX438
01175  S910-START-BROWSE.                                               DTSBX438
01176      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX438
01177      GO TO S910-MSTR-IO.                                          DTSBX438
01178                                                                   DTSBX438
01179  S910-READ-NEXT.                                                  DTSBX438
01180      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX438
01181      GO TO S910-MSTR-IO.                                          DTSBX438
01182                                                                   DTSBX438
01183  S910-CLOSE.                                                         CL*35
01184      SET L910-CLOSE-88     TO TRUE.                                  CL*35
01185      GO TO S910-MSTR-IO.                                             CL*35
01186                                                                   DTSBX438
01187  S910-MSTR-IO.                                                    DTSBX438
01188      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX438
01189                            MSKL-REC.                              DTSBX438
01190  S910-EXIT.                                                       DTSBX438
01191      EXIT.                                                        DTSBX438
01192                                                                   DTSBX438
01193 *S921-OPEN-READ.                                                  DTSBX438
01194 *    SET L921-OPEN-READ-88 TO TRUE.                               DTSBX438
01195 *    GO TO S921-AIX-IO.                                           DTSBX438
01196                                                                   DTSBX438
01197  S921-READ.                                                       DTSBX438
01198      SET L921-READ-88 TO TRUE.                                    DTSBX438
01199      GO TO S921-AIX-IO.                                           DTSBX438
01200                                                                   DTSBX438
01201  S921-START-BROWSE.                                               DTSBX438
01202      SET L921-START-BROWSE-88 TO TRUE.                            DTSBX438
01203      GO TO S921-AIX-IO.                                           DTSBX438
01204                                                                   DTSBX438
01205  S921-READ-NEXT.                                                  DTSBX438
01206      SET L921-READ-NEXT-88 TO TRUE.                               DTSBX438
01207      GO TO S921-AIX-IO.                                           DTSBX438
01208                                                                   DTSBX438
01209 *S921-CLOSE.                                                      DTSBX438
01210 *    SET L921-CLOSE-88 TO TRUE.                                   DTSBX438
01211 *    GO TO S921-AIX-IO.                                           DTSBX438
01212                                                                   DTSBX438
01213  S921-AIX-IO.                                                     DTSBX438
01214      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX438
01215                            ISKL-REC.                              DTSBX438
01216  S921-EXIT.                                                       DTSBX438
01217      EXIT.                                                        DTSBX438
01218                                                                   DTSBX438
01219  S923-OPEN-UPDATE.                                                DTSBX438
01220      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSBX438
01221      GO TO S923-ATC-CALL.                                         DTSBX438
01222                                                                   DTSBX438
01223  S923-WRITE.                                                      DTSBX438
01224      SET L923-WRITE-88 TO TRUE.                                   DTSBX438
01225      GO TO S923-ATC-CALL.                                         DTSBX438
01226                                                                   DTSBX438
01227  S923-CLOSE.                                                      DTSBX438
01228      SET L923-CLOSE-88 TO TRUE.                                   DTSBX438
01229      GO TO S923-ATC-CALL.                                         DTSBX438
01230                                                                   DTSBX438
01231  S923-ATC-CALL.                                                   DTSBX438
01232      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSBX438
01233                            ASKL-REC.                              DTSBX438
01234  S923-EXIT.                                                       DTSBX438
01235      EXIT.                                                        DTSBX438
01236                                                                   DTSBX438
01237  S927A-OPEN.                                                         CL*42
01238      SET L927-OPEN-UPDATE-88  TO TRUE.                               CL*42
01239      PERFORM S927Z-IO   THRU S927Z-EXIT.                             CL*42
01240                                                                      CL*42
01241  S927A-EXIT.                                                         CL*42
01242      EXIT.                                                           CL*42
01243                                                                   DTSBX438
01244  S927B-WRITE.                                                     DTSBX438
01245      SET L927-WRITE-88 TO TRUE.                                   DTSBX438
01246      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX438
01247                                                                   DTSBX438
01248  S927B-EXIT.                                                      DTSBX438
01249      EXIT.                                                        DTSBX438
01250                                                                   DTSBX438
01251  S927C-CLOSE.                                                        CL*42
01252      SET L927-CLOSE-88        TO TRUE.                               CL*42
01253      PERFORM S927Z-IO   THRU S927Z-EXIT.                             CL*42
01254                                                                      CL*42
01255  S927C-EXIT.                                                         CL*42
01256      EXIT.                                                           CL*42
01257                                                                   DTSBX438
01258  S927Z-IO.                                                        DTSBX438
01259      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBX438
01260                            TSKL-REC.                              DTSBX438
01261  S927Z-EXIT.                                                      DTSBX438
01262      EXIT.                                                        DTSBX438
01263                                                                   DTSBX438
01264  S931-OPEN-READ.                                                  DTSBX438
01265      SET L931-OPEN-READ-88 TO TRUE.                               DTSBX438
01266      GO TO S931-REF-IO.                                           DTSBX438
01267                                                                   DTSBX438
01268  S931-CLOSE.                                                      DTSBX438
01269      SET L931-CLOSE-88 TO TRUE.                                   DTSBX438
01270      GO TO S931-REF-IO.                                           DTSBX438
01271                                                                   DTSBX438
01272  S931-REF-IO.                                                     DTSBX438
01273      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBX438
01274                            FSKL-REC.                              DTSBX438
01275  S931-EXIT.                                                       DTSBX438
01276      EXIT.                                                        DTSBX438
01277                                                                   DTSBX438
01278  S946-WRITE-R140.                                                 DTSBX438
01279      CALL 'DTSBU946' USING R140-REC.                              DTSBX438
01280                                                                   DTSBX438
01281  S946-EXIT.                                                       DTSBX438
01282      EXIT.                                                        DTSBX438
01283                                                                   DTSBX438
01284  S999-ABEND.                                                      DTSBX438
01285      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBX438
01286  S999-EXIT.                                                       DTSBX438
01287      EXIT.                                                        DTSBX438
01288                                                                   DTSBX438
