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