00001  IDENTIFICATION DIVISION.                                         10/02/24
00002  PROGRAM-ID.             DTSBX655.                                DTSBX655
00003  AUTHOR.                 NGUPTA                                      LV238
00004  DATE-WRITTEN.           JAN2017                                     CL154
00005  DATE-COMPILED.                                                   DTSBX655
00006      SKIP3                                                        DTSBX655
00007 *****                                                             DTSBX655
00008 *                                                                 DTSBX655
00009 *    FUNCTION:  UPDATE MPRF RETURN MAIL FLAG TO Y AND ADD            CL217
00010 *              EVENT LOGH.                                           CL217
00011 *                                                                 DTSBX655
00012 *****                                                             DTSBX655
00013      SKIP3                                                        DTSBX655
00014  ENVIRONMENT DIVISION.                                            DTSBX655
00015      SKIP2                                                        DTSBX655
00016  CONFIGURATION SECTION.                                           DTSBX655
00017  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBX655
00018                                                                   DTSBX655
00019  INPUT-OUTPUT SECTION.                                            DTSBX655
00020                                                                   DTSBX655
00021  FILE-CONTROL.                                                    DTSBX655
00022      SELECT EMP-FILE1 ASSIGN TO EMPFILE1                             CL122
00023             FILE STATUS IS EXP-STATUS.                            DTSBX655
00024                                                                   DTSBX655
00025                                                                      CL*71
00026  DATA DIVISION.                                                   DTSBX655
00027                                                                   DTSBX655
00028  FILE SECTION.                                                    DTSBX655
00029                                                                   DTSBX655
00030  FD  EMP-FILE1                                                       CL122
00031      RECORDING MODE IS F.                                         DTSBX655
00032  01  EMP-REC1.                                                       CL122
00033 *    05  FILLER              PIC X(215).                             CL233
00034      05  INEMP-NO             PIC 9(06).                             CL217
00035      05  FILLER               PIC X(74).                             CL233
00036 *    05  FILLER               PIC X(331).                            CL233
00037      EJECT                                                        DTSBX655
00038                                                                   DTSBX655
00039                                                                      CL*71
00040  WORKING-STORAGE SECTION.                                         DTSBX655
000405 77  PAN-VALET PICTURE X(24) VALUE '238DTSBX655  10/02/24'.       DTSBX655
00041      SKIP3                                                        DTSBX655
00042  01  WRK-AREA.                                                    DTSBX655
00043      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +400.DTSBX655
00044      05  WRK-SYS-ABSTIME             PIC S9(15)  COMP-3 VALUE +0.    CL211
00045      05  WRK-ABSTIME           PIC S9(15)  COMP-3 VALUE +1000.       CL211
00046                                                                   DTSBX655
00047      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD400'.DTSBX655
00048                                                                   DTSBX655
00049 **   05  WRK-RPT-DATE                PIC S9(09)  COMP-3           DTSBX655
00050 *                                        VALUE +20070328.         DTSBX655
00051 *    05  WRK-YRQ                     PIC S9(05)  COMP-3           DTSBX655
00052 **                                       VALUE +20061.            DTSBX655
00053      05  WRK-RPT-DATE                PIC S9(09)  COMP-3           DTSBX655
00054                                          VALUE +20170124.            CL154
00055      05  WRK-YRQ                     PIC S9(05)  COMP-3           DTSBX655
00056                                          VALUE +0.                DTSBX655
00057      05  WRK-MPRF-REC-CNT            PIC S9(07)  COMP-3.             CL192
00058      05  WRK-RATE-TYPE-AREA.                                      DTSBX655
00059          10  WRK-RATE-YR-SCHED                 PIC  X(01).        DTSBX655
00060              88  WRK-RATE-YR-ANN-88        VALUE 'Y'.             DTSBX655
00061          10  WRK-RATE-YR-MINUS-1-SCHED         PIC  X(01).        DTSBX655
00062              88  WRK-RATE-YR-MINUS1-ANN-88 VALUE 'Y'.             DTSBX655
00063          10  WRK-RATE-YR-MINUS-2-SCHED         PIC  X(01).        DTSBX655
00064              88  WRK-RATE-YR-MINUS2-ANN-88 VALUE 'Y'.             DTSBX655
00065      05  FILLER REDEFINES WRK-RATE-TYPE-AREA   PIC X(03).         DTSBX655
00066          88  WRK-ESTIMATE-NEEDED-88     VALUE 'YYY' 'NYY'.        DTSBX655
00067          88  WRK-TRANSITION-YEAR-88     VALUE 'YYN' 'NYN'.        DTSBX655
00068          88  WRK-INIT-VALUES-88         VALUE 'NNN'.              DTSBX655
00069                                                                   DTSBX655
00070      05  WRK-CLASSIFIED-IND                    PIC X(01).         DTSBX655
00071          88  WRK-CLASSIFIED-YES-88      VALUE 'Y'.                DTSBX655
00072          88  WRK-CLASSIFIED-NO-88       VALUE 'N'.                DTSBX655
00073      05  WRK-EXIT-LOOP-IND                     PIC X(01).         DTSBX655
00074          88  WRK-EXIT-LOOP-YES-88       VALUE 'Y'.                DTSBX655
00075          88  WRK-EXIT-LOOP-NO-88        VALUE 'N'.                DTSBX655
00076      05  WRK-BATCH                             PIC S9(05) COMP-3. DTSBX655
00077      05  WRK-ITEM                              PIC S9(03) COMP-3. DTSBX655
00078      05  WRK-SEQ                               PIC 9(05)          DTSBX655
00079                                                 VALUE ZERO.       DTSBX655
00080      05  WRK-UCFE-FEIN                         PIC 9(09)          DTSBX655
00081                                             VALUE 000000000.      DTSBX655
00082      05  WRK-UCX-FEIN                          PIC 9(09)          DTSBX655
00083                                             VALUE 330000000.      DTSBX655
00084      05  WRK-CWC-FEIN                          PIC 9(09)          DTSBX655
00085                                             VALUE 440000000.      DTSBX655
00086      05  WRK-FED-EMP                           PIC 9(06).         DTSBX655
00087      05  FILLER REDEFINES WRK-FED-EMP.                            DTSBX655
00088          10  FILLER                            PIC X(02).         DTSBX655
00089          10  WRK-FED-EMP-3                     PIC X(01).         DTSBX655
00090              88  WRK-FED-EMP-BYPASS-88          VALUE '1'.        DTSBX655
00091          10  FILLER                            PIC 9(03).         DTSBX655
00092      05  WRK-ZIP                               PIC X(10).         DTSBX655
00093      05  FILLER REDEFINES WRK-ZIP.                                DTSBX655
00094          10  WRK-ZIP5                          PIC X(05).         DTSBX655
00095          10  FILLER                            PIC X(05).         DTSBX655
00096                                                                   DTSBX655
00097      05  WS-EMP-NO1                  PIC X(06).                      CL159
00098      05  EXP-STATUS                  PIC  X(02).                  DTSBX655
00099          88  EXP-STATUS-OK-88         VALUE '00'.                 DTSBX655
00100      05  EXP2-STATUS                 PIC  X(02).                     CL*71
00101          88  EXP2-STATUS-OK-88         VALUE '00'.                   CL*71
00102      05  WRK-ERROR-IND               PIC  X(01).                  DTSBX655
00103          88  WRK-ERROR-YES-88         VALUE 'Y'.                  DTSBX655
00104          88  WRK-ERROR-NO-88          VALUE 'N'.                  DTSBX655
00105      05  WRK-WRITE-REC-IND           PIC  X(01).                  DTSBX655
00106          88  WRK-WRITE-REC-YES-88     VALUE 'Y'.                  DTSBX655
00107          88  WRK-WRITE-REC-NO-88      VALUE 'N'.                  DTSBX655
00108      05  WRK-OP-ID                   PIC  X(08).                  DTSBX655
00109      05  WRK-ASSIGN                  PIC  9(09).                  DTSBX655
00110      05  FILLER REDEFINES WRK-ASSIGN.                             DTSBX655
00111          10  WRK-ASSIGN-CC           PIC  9(02).                  DTSBX655
00112          10  WRK-ASSIGN-YY           PIC  9(02).                  DTSBX655
00113          10  WRK-ASSIGN-NBR          PIC  9(05).                  DTSBX655
00114      05  WRK-FLD-ASSIGN.                                          DTSBX655
00115          10  WRK-FLD-ASSIGN-YEAR     PIC  9(02).                  DTSBX655
00116          10  FILLER                  PIC  X(01) VALUE SPACE.      DTSBX655
00117          10  WRK-FLD-ASSIGN-NBR      PIC  9(05).                  DTSBX655
00118      05  WRK-LIEN                    PIC  9(08).                     CL*25
00119      05  WRK-LIEN-X REDEFINES WRK-LIEN.                              CL*25
00120          10  FILLER                  PIC  X(02).                     CL*26
00121          10  WRK-LIEN6               PIC  X(06).                     CL*25
00122      05  WRK-LIEN-REF.                                               CL*23
00123          10  WRK-LIEN-YR             PIC  9(02).                     CL*23
00124          10  WRK-LIEN-NBR            PIC  9(04).                     CL*23
00125                                                                   DTSBX655
00126      05  WRK-IND-CODE                PIC  X(06).                  DTSBX655
00127      05  WRK-REC1.                                                DTSBX655
00128          10  REC1-EMP-NO             PIC 999999.                  DTSBX655
00129          10  FILLER                  PIC X(01) VALUE ';'.         DTSBX655
00130 **       10  REC1-NAME               PIC X(32).                      CL100
00131 **       10  REC1-EARLY-LIAB-DT      PIC X(32).                      CL110
00132          10  REC1-EARLY-LIAB-DT      PIC X(10).                      CL110
00133          10  FILLER                  PIC X(01) VALUE ';'.            CL*82
00134 **       10  REC1-YRQ2               PIC X(06).                      CL100
00135 **       10  FILLER                  PIC X(01) VALUE ';'.            CL100
00136          10  REC1-FIRS-DATE          PIC X(10).                      CL100
00137          10  FILLER                  PIC X(01) VALUE ';'.            CL*88
00138          10  REC1-PRIOR              PIC 9.9999.                     CL100
00139          10  FILLER                  PIC X(01) VALUE ';'.            CL*95
00140          10  REC1-CURR               PIC 9.9999.                     CL100
00141          10  FILLER                  PIC X(01) VALUE ';'.            CL*98
00142                                                                      CL*75
00143      05  WRK-REC1-OLD.                                               CL*15
00144          10  REC1-ESTB-DATE          PIC X(10).                      CL*98
00145          10  REC1-LIEN-NO            PIC 9(08).                      CL*98
00146          10  REC1-STATUS             PIC X(01).                      CL*98
00147          10  REC1-SOURCE             PIC X(02).                      CL*88
00148          10  REC1-YRQ                PIC X(06).                      CL*85
00149          10  REC1-OP-ID              PIC X(08).                      CL*75
00150          10  REC1-STATUS-OP-ID       PIC X(08).                      CL*75
00151          10  REC1-STMT-DATE          PIC X(10).                      CL*95
00152          10  REC1-STATUS-DATE        PIC X(10).                      CL*75
00153          10  REC1-BALANCE            PIC --------9.99.               CL*75
00154          10  REC1-FREQUENCY          PIC X(01).                      CL*75
00155          10  REC1-START-DATE         PIC X(10).                      CL*75
00156          10  REC1-TAX-DUE            PIC --------9.99.               CL*75
00157          10  REC1-DATA-ELEMENT       PIC X(40).                      CL*68
00158          10  REC1-PRE-MOD-VALUE      PIC X(40).                      CL*68
00159          10  REC1-POST-MOD-VALUE     PIC X(40).                      CL*68
00160          10  REC1-MLOG-DATE          PIC X(10).                      CL*68
00161          10  REC1-EMP-NAME           PIC X(40).                      CL*68
00162          10  REC1-CURR-RESERVE       PIC --------9.99.               CL*59
00163          10  REC1-ATTN               PIC X(40).                      CL*57
00164          10  REC1-STREET2            PIC X(40).                      CL*57
00165          10  REC1-STREET1            PIC X(40).                      CL*57
00166          10  REC1-CITY               PIC X(25).                      CL*57
00167          10  REC1-STATE              PIC X(02).                      CL*57
00168          10  REC1-ZIP                PIC X(10).                      CL*57
00169          10  REC1-PHONE              PIC X(15).                      CL*57
00170          10  REC1-FAX                PIC X(15).                      CL*57
00171          10  REC1-EMAIL              PIC X(40).                      CL*57
00172          10  REC1-ASSIGN             PIC X(08).                      CL*51
00173          10  REC1-ASSIGN-TYPE        PIC X(02).                      CL*51
00174          10  REC1-PROCESS-DATE       PIC X(10).                      CL*51
00175          10  REC1-COMP-DATE          PIC X(10).                      CL*51
00176          10  REC1-FLD-REP-ID         PIC X(02).                      CL*46
00177          10  REC1-INACT-OPID         PIC X(08).                      CL*43
00178          10  REC1-INACT-ENTER-DT     PIC X(10).                      CL*38
00179          10  REC1-OPO-NAME           PIC X(32).                      CL*27
00180          10  REC1-ELIG-CD            PIC 9(03).                      CL*17
00181          10  REC1-FEIN               PIC 9(09).                   DTSBX655
00182          10  REC1-COUNT              PIC 9(07).                   DTSBX655
00183          10  REC1-CLASS              PIC X(02).                   DTSBX655
00184          10  REC1-MLIN-STATUS        PIC X(01).                   DTSBX655
00185          10  REC1-BATCH              PIC 9(05).                   DTSBX655
00186          10  REC1-ITEM               PIC 9(03).                   DTSBX655
00187          10  REC1-RPTS-DUE           PIC 999.                     DTSBX655
00188          10  REC1-COMPLETE-DATE      PIC X(10).                   DTSBX655
00189          10  REC1-PAY-TYPE           PIC X(02).                   DTSBX655
00190          10  REC1-TAX-PAID           PIC --------9.99.            DTSBX655
00191          10  REC1-DEPOSIT-DATE       PIC X(10).                   DTSBX655
00192          10  REC1-NAICS              PIC X(06).                   DTSBX655
00193          10  REC1-SIC                PIC X(04).                   DTSBX655
00194          10  REC1-YEAR               PIC 9(04).                   DTSBX655
00195          10  REC1-AMT                PIC ----------9.99.          DTSBX655
00196          10  REC1-OPO-SSN            PIC X(09).                   DTSBX655
00197          10  REC1-PRIOR-RESERVE      PIC --------9.99.            DTSBX655
00198          10  REC1-INTEREST           PIC --------9.99.            DTSBX655
00199          10  REC1-BEN-CHG            PIC --------9.99.            DTSBX655
00200          10  REC1-AVG-TAX-WAGE       PIC --------9.99.            DTSBX655
00201          10  REC1-RATE-PCT           PIC 9.9.                     DTSBX655
00202          10  REC1-DUE-DATE           PIC X(10).                   DTSBX655
00203          10  REC1-INACT-YRQ          PIC X(06).                   DTSBX655
00204          10  REC1-RCVD-DATE          PIC X(10).                   DTSBX655
00205          10  REC1-TOT-WAGE           PIC ----------9.99.          DTSBX655
00206          10  REC1-SUR-BAL            PIC ----------9.99.          DTSBX655
00207          10  REC1-LP-BAL             PIC ----------9.99.          DTSBX655
00208          10  REC1-INT-BAL            PIC ----------9.99.          DTSBX655
00209          10  REC1-SEQ                PIC 999999.                  DTSBX655
00210          10  REC1-PRED               PIC 999999.                  DTSBX655
00211          10  REC1-REL-CD             PIC X(02).                   DTSBX655
00212          10  REC1-TRAN               PIC X(02).                   DTSBX655
00213          10  REC1-CREDIT             PIC --------9.99.            DTSBX655
00214          10  REC1-ACCOUNT            PIC X(02).                   DTSBX655
00215          10  REC1-NEW-RATE           PIC 9.9999.                  DTSBX655
00216          10  REC1-EMP-TYPE           PIC X(05).                   DTSBX655
00217          10  REC1-CHG                PIC --------9.99.            DTSBX655
00218          10  REC1-DESC               PIC X(40).                   DTSBX655
00219          10  REC1-LIAB-QTRS          PIC 999.                     DTSBX655
00220          10  REC1-ORG-TYPE           PIC X(03).                   DTSBX655
00221          10  REC1-LIAB-CD            PIC X(02).                   DTSBX655
00222          10  REC1-LP-CHG             PIC --------9.99.            DTSBX655
00223          10  REC1-INT-CHG            PIC --------9.99.            DTSBX655
00224          10  REC1-IND-CODE           PIC X(06).                   DTSBX655
00225          10  REC1-LIAB-ENTER-DATE    PIC X(10).                   DTSBX655
00226          10  REC1-INACT-CODE         PIC X(05).                   DTSBX655
00227              88  REC1-INACT-YES-88  VALUE 'INACT'.                DTSBX655
00228              88  REC1-INACT-NO-88  VALUE 'ACT  '.                 DTSBX655
00229          10  REC1-REACT              PIC X(05).                   DTSBX655
00230              88  REC1-REACT-NO-88 VALUE 'NEW  '.                  DTSBX655
00231              88  REC1-REACT-YES-88 VALUE 'REACT'.                 DTSBX655
00232          10  REC1-AREA               PIC X(03).                   DTSBX655
00233          10  REC1-PFX                PIC X(03).                   DTSBX655
00234          10  REC1-SFX                PIC X(04).                   DTSBX655
00235          10  REC1-EXT                PIC X(05).                   DTSBX655
00236          10  REC1-INT-CHARGE-IND     PIC  X(01).                     CL*84
00237             88  REC1-INT-CHARGE-MANUAL-88   VALUE 'M'.               CL*84
00238             88  REC1-INT-CHARGE-AUTO-88     VALUE 'A'.               CL*84
00239          10  FILLER                  PIC X(01) VALUE ';'.            CL*84
00240          10  REC1-INT-START-DATE1    PIC  X(10).                     CL*84
00241          10  FILLER                  PIC X(01) VALUE ';'.            CL*84
00242          10  REC1-INT-END-DATE1      PIC  X(10).                     CL*84
00243          10  FILLER                  PIC X(01) VALUE ';'.            CL*84
00244          10  REC1-INT-RATE1          PIC 9.9999.                     CL*84
00245          10  FILLER                  PIC X(01) VALUE ';'.            CL*84
00246          10  REC1-INT-START-DATE2    PIC  X(10).                     CL*84
00247          10  FILLER                  PIC X(01) VALUE ';'.            CL*84
00248          10  REC1-INT-END-DATE2      PIC  X(10).                     CL*84
00249          10  FILLER                  PIC X(01) VALUE ';'.            CL*84
00250          10  REC1-INT-RATE2          PIC 9.9999.                     CL*84
00251          10  FILLER                  PIC X(01) VALUE ';'.            CL*84
00252          10  REC1-WAIVE-INT-START-DATE  PIC  X(10).                  CL*84
00253          10  FILLER                  PIC X(01) VALUE ';'.            CL*84
00254          10  REC1-WAIVE-INT-END-DATE    PIC  X(10).                  CL*84
00255                                                                      CL*71
00256      05  WRK-REC2.                                                   CL*71
00257          10  REC2-EMP-NO             PIC 999999.                     CL*71
00258          10  FILLER                  PIC X(01) VALUE ';'.            CL*71
00259          10  REC2-ESTB-DATE          PIC X(10).                      CL*71
00260          10  FILLER                  PIC X(01) VALUE ';'.            CL*71
00261          10  REC2-QTR                PIC X(06).                      CL*71
00262                                                                      CL*71
00263      05  WRK-ABS-QTR1                PIC S9(04)  COMP-3           DTSBX655
00264                                             VALUE +0.             DTSBX655
00265      05  WRK-ABS-QTR2                PIC S9(04)  COMP-3           DTSBX655
00266                                             VALUE +0.             DTSBX655
00267      05  WRK-ABS-DATE1               PIC S9(08)  COMP.            DTSBX655
00268      05  WRK-ABS-DATE2               PIC S9(08)  COMP.            DTSBX655
00269      05  WRK-DIFF                    PIC S9(07)  COMP-3.          DTSBX655
00270      05  WRK-UNDER-30-CNT            PIC S9(04)  COMP-3           DTSBX655
00271                                             VALUE +0.             DTSBX655
00272      05  WRK-OVER-31-CNT             PIC S9(04)     COMP-3        DTSBX655
00273                                             VALUE +0.             DTSBX655
00274      05  WRK-MPRF-CNT                PIC S9(07)  COMP-3.          DTSBX655
00275      05  WRK-FISCAL-AGENT-CD         PIC  X(03).                  DTSBX655
00276      05  WRK-BNK-IND                 PIC  X(02).                  DTSBX655
00277      05  WRK-FIRST-NEW-EMP-NO        PIC S9(07)  COMP-3.          DTSBX655
00278 *&                             VALUE +123778.                     DTSBX655
00279      05  WRK-FEIN                    PIC  9(09).                  DTSBX655
00280      05  WRK-MQTR-BAL         PIC S9(11)V99  COMP-3 VALUE +0.     DTSBX655
00281      05  WRK-MQTR-BAL1        PIC S9(11)V99  COMP-3 VALUE +0.     DTSBX655
00282      05  WRK-MQTR-BAL2        PIC S9(11)V99  COMP-3 VALUE +0.     DTSBX655
00283      05  WRK-MQTR-BAL3        PIC S9(11)V99  COMP-3 VALUE +0.     DTSBX655
00284      05  WRK-RESERVE                 PIC S9(09)V99  COMP-3.       DTSBX655
00285      05  WRK-MQTR-CHG                PIC S9(09)V99  COMP-3.       DTSBX655
00286      05  WRK-MQTR-ANN-BAL            PIC S9(07)V99  COMP-3.       DTSBX655
00287      05  WRK-MQTR-PEN-BAL            PIC S9(07)V99  COMP-3.       DTSBX655
00288      05  WRK-MQTR-PEN-CHG            PIC S9(07)V99  COMP-3.       DTSBX655
00289      05  WRK-MQTR-INT-BAL            PIC S9(07)V99  COMP-3.       DTSBX655
00290      05  WRK-MQTR-INT-CHG            PIC S9(07)V99  COMP-3.       DTSBX655
00291      05  WRK-RECEIVED-DATE           PIC S9(09)  COMP-3              CL*91
00292                                        VALUE +0.                     CL*91
00293      05  WRK-RPT-BAL-CNT             PIC S9(07)  COMP-3.          DTSBX655
00294      05  WRK-RPT-CNT                 PIC S9(07)  COMP-3.          DTSBX655
00295      05  WRK-BAL-CNT                 PIC S9(07)  COMP-3.          DTSBX655
00296      05  WRK-REL-CNT                 PIC S9(07)  COMP-3.          DTSBX655
00297      05  WRK-RATED-CNT               PIC S9(07)  COMP-3.          DTSBX655
00298      05  WRK-SELF-INS-CNT            PIC S9(07)  COMP-3.          DTSBX655
00299      05  WRK-HOTEL-CNT            PIC S9(07)  COMP-3 VALUE +0.    DTSBX655
00300      05  WRK-TOT-EMPS             PIC S9(07)  COMP-3 VALUE +0.    DTSBX655
00301      05  WRK-TOT-WORKERS          PIC S9(11)  COMP-3 VALUE +0.    DTSBX655
00302      05  WRK-PURSUED-RPT-CNT         PIC S9(07)  COMP-3.          DTSBX655
00303      05  WRK-LATE-RPT-CNT            PIC S9(07)  COMP-3.          DTSBX655
00304      05  WRK-MEVL-REWRITE-CNT        PIC S9(03)  COMP-3 VALUE 0.     CL141
00305      05  WRK-MEVL-DELETED-CNT        PIC S9(03)  COMP-3 VALUE 0.     CL141
00306      05  WRK-MEVL-FOUND-CNT        PIC S9(03)  COMP-3 VALUE 0.       CL128
00307      05  WRK-MQTR-UPDATED-CNT        PIC S9(03)  COMP-3 VALUE 0.     CL128
00308      05  WRK-MQTR-FOUND-CNT        PIC S9(03)  COMP-3 VALUE 0.       CL128
00309      05  MPRF-REC-CNT              PIC S9(03)  COMP-3 VALUE 0.       CL128
00310      05  MPRF-WRK-CNT              PIC S9(03)  COMP-3 VALUE 0.       CL128
00311      05  IN-REC-CNT              PIC S9(03)  COMP-3 VALUE 0.         CL128
00312      05  WRK-UC30-SENT-CNT           PIC S9(07)  COMP-3.          DTSBX655
00313      05  WRK-UC30-RCVD-CNT           PIC S9(07)  COMP-3.          DTSBX655
00314      05  WRK-OVER-1000-CNT           PIC S9(07)  COMP-3.          DTSBX655
00315      05  WRK-UNDER-1000-CNT          PIC S9(07)  COMP-3.          DTSBX655
00316      05  WRK-HOUSEHOLD-PAYMENTS      PIC S9(11)V99  COMP-3.       DTSBX655
00317      05  WRK-TOT-WAGES               PIC S9(11)V99  COMP-3.       DTSBX655
00318      05  WRK-ALL-BNK-RATED           PIC S9(11)V99  COMP-3.       DTSBX655
00319      05  WRK-OPN-BNK-RATED           PIC S9(11)V99  COMP-3.       DTSBX655
00320      05  WRK-ALL-BNK-SI              PIC S9(11)V99  COMP-3.       DTSBX655
00321      05  WRK-OPN-BNK-SI              PIC S9(11)V99  COMP-3.       DTSBX655
00322      05  WRK-BOND-AMT                PIC S9(11)V99  COMP-3.       DTSBX655
00323      05  WRK-OVER-100-CNT            PIC S9(07)  COMP-3           DTSBX655
00324                                        VALUE +0.                  DTSBX655
00325      05  WRK-OVER-100-AMT            PIC S9(11)V99  COMP-3        DTSBX655
00326                                        VALUE +0.                  DTSBX655
00327      05  WRK-1-10-CNT                PIC S9(07)  COMP-3           DTSBX655
00328                                        VALUE +0.                  DTSBX655
00329      05  WRK-1-10-AMT                PIC S9(11)V99  COMP-3        DTSBX655
00330                                        VALUE +0.                  DTSBX655
00331      05  WRK-11-100-CNT              PIC S9(07)  COMP-3           DTSBX655
00332                                        VALUE +0.                  DTSBX655
00333      05  WRK-11-100-AMT              PIC S9(11)V99  COMP-3        DTSBX655
00334                                        VALUE +0.                  DTSBX655
00335      05  WRK-OVER-100-WRKRS          PIC S9(07)  COMP-3.          DTSBX655
00336      05  WRK-100-249-CNT             PIC S9(07)  COMP-3.          DTSBX655
00337      05  WRK-100-249-WRKRS           PIC S9(07)  COMP-3.          DTSBX655
00338      05  WRK-50-100-CNT              PIC S9(07)  COMP-3.          DTSBX655
00339      05  WRK-50-100-WRKRS            PIC S9(07)  COMP-3.          DTSBX655
00340      05  WRK-25-49-CNT               PIC S9(07)  COMP-3.          DTSBX655
00341      05  WRK-25-49-WRKRS             PIC S9(07)  COMP-3.          DTSBX655
00342      05  WRK-10-24-CNT               PIC S9(07)  COMP-3.          DTSBX655
00343      05  WRK-10-24-WRKRS             PIC S9(07)  COMP-3.          DTSBX655
00344      05  WRK-6-9-CNT                 PIC S9(07)  COMP-3.          DTSBX655
00345      05  WRK-5-9-WRKRS               PIC S9(07)  COMP-3.          DTSBX655
00346      05  WRK-5-CNT                   PIC S9(07)  COMP-3.          DTSBX655
00347      05  WRK-4-CNT                   PIC S9(07)  COMP-3.          DTSBX655
00348      05  WRK-3-CNT                   PIC S9(07)  COMP-3.          DTSBX655
00349      05  WRK-2-CNT                   PIC S9(07)  COMP-3.          DTSBX655
00350      05  WRK-1-CNT                   PIC S9(07)  COMP-3.          DTSBX655
00351      05  WRK-UNDER-5-CNT             PIC S9(07)  COMP-3.          DTSBX655
00352      05  WRK-UNDER-5-WRKRS           PIC S9(07)  COMP-3.          DTSBX655
00353      05  WRK-UNDER-10-CNT            PIC S9(07)  COMP-3.          DTSBX655
00354      05  WRK-OVER-10-CNT             PIC S9(07)  COMP-3.          DTSBX655
00355      05  WRK-UNDER-10-WRKRS          PIC S9(07)  COMP-3.          DTSBX655
00356      05  WRK-NO-EMPS-CNT             PIC S9(07)  COMP-3.          DTSBX655
00357      05  WRK-MRCT-TOT-WAGES          PIC S9(11)V99  COMP-3.       DTSBX655
00358      05  WRK-MRCT-TAX-WAGES          PIC S9(11)V99  COMP-3.       DTSBX655
00359      05  WRK-MRCT-UI-PAID            PIC S9(11)V99  COMP-3.       DTSBX655
00360      05  WRK-TOT-UI                  PIC S9(11)V99  COMP-3.       DTSBX655
00361      05  WRK-TOT-INT                 PIC S9(11)V99  COMP-3.       DTSBX655
00362      05  WRK-TOT-PEN                 PIC S9(11)V99  COMP-3.       DTSBX655
00363      05  WRK-MQTR-ANN-TOT-WAGE       PIC S9(12)V99  COMP-3.       DTSBX655
00364      05  WRK-MQTR-ANN-TAX-WAGE       PIC S9(12)V99  COMP-3.       DTSBX655
00365      05  WRK-MJRN-TOT-NEG-CHG        PIC S9(11)V99  COMP-3        DTSBX655
00366                                        VALUE +0.                  DTSBX655
00367      05  WRK-MQTR-TOT-UI-CHARGED     PIC S9(11)V99  COMP-3.       DTSBX655
00368      05  WRK-START-DATE              PIC S9(09) COMP-3.           DTSBX655
00369      05  WRK-END-DATE                PIC S9(09) COMP-3.           DTSBX655
00370      05  WRK-LIAB-DATE               PIC S9(09) COMP-3.           DTSBX655
00371      05  WRK-FIRST-LIAB-DATE         PIC S9(09) COMP-3.           DTSBX655
00372      05  WRK-ALL-NINES-DATE          PIC S9(09) COMP-3            DTSBX655
00373                                   VALUE +999999999.               DTSBX655
00374                                                                      CL104
00375      05  WRK-UI-RATE-CATEGORY       PIC  X(01).                      CL104
00376          88  WRK-CLASSIFIED-88          VALUE 'C'.                   CL104
00377          88  WRK-NONCLASSIFIED-88       VALUE 'N'.                   CL104
00378                                                                      CL104
00379                                                                      CL104
00380      05  WRK-BNK-PETITION-DATE       PIC 9(08).                   DTSBX655
00381      05  FILLER REDEFINES WRK-BNK-PETITION-DATE.                  DTSBX655
00382          10  WRK-BNK-PETITION-DATE-YYYY PIC 9(04).                DTSBX655
00383          10  WRK-BNK-PETITION-DATE-MM   PIC 9(02).                DTSBX655
00384          10  WRK-BNK-PETITION-DATE-DD   PIC 9(02).                DTSBX655
00385      05  WRK-BNK-PETITION-YRQ        PIC 9(05).                   DTSBX655
00386      05  FILLER REDEFINES WRK-BNK-PETITION-YRQ.                   DTSBX655
00387          10  WRK-BNK-PETITION-YRQ-YYYY PIC 9(04).                 DTSBX655
00388          10  WRK-BNK-PETITION-YRQ-Q    PIC 9(01).                 DTSBX655
00389      05  WRK-BNK-FIRST-BILL-YRQ      PIC S9(05) COMP-3.           DTSBX655
00390      05  WRK-EST-RPT-IND             PIC  X(01).                  DTSBX655
00391          88 WRK-EST-RPT-YES       VALUE 'Y'.                      DTSBX655
00392          88 WRK-EST-RPT-NO        VALUE 'N'.                      DTSBX655
00393                                                                   DTSBX655
00394      05  WRK-ZERO-FOUND-IND          PIC  X(01).                  DTSBX655
00395          88 WRK-ZERO-FOUND-YES-88 VALUE 'Y'.                      DTSBX655
00396          88 WRK-ZERO-FOUND-NO-88  VALUE 'N'.                      DTSBX655
00397                                                                   DTSBX655
00398      05  WRK-WITHDRAWN-IND           PIC  X(01).                  DTSBX655
00399          88 WRK-WITHDRAWN-YES     VALUE 'Y'.                      DTSBX655
00400          88 WRK-WITHDRAWN-NO      VALUE 'N'.                      DTSBX655
00401                                                                   DTSBX655
00402      05  WRK-ORIG-IND                PIC  X(01).                  DTSBX655
00403          88 WRK-ORIG-YES          VALUE 'Y'.                      DTSBX655
00404          88 WRK-ORIG-NO           VALUE 'N'.                      DTSBX655
00405                                                                   DTSBX655
00406      05  WRK-MQTR-CNT                PIC S9(07)  COMP-3.          DTSBX655
00407      05  WRK-MRPT-CNT                PIC S9(07)  COMP-3.          DTSBX655
00408      05  WRK-MSOL-CNT                PIC S9(07)  COMP-3.          DTSBX655
00409      05  WRK-MLIN-CNT                PIC S9(07)  COMP-3.          DTSBX655
00410      05  WRK-MFAS-CNT                PIC S9(07)  COMP-3.          DTSBX655
00411      05  WRK-MFAE-CNT                PIC S9(07)  COMP-3.          DTSBX655
00412      05  WRK-MPAY-CNT                PIC S9(07)  COMP-3.          DTSBX655
00413      05  WRK-MADJ-CNT                PIC S9(07)  COMP-3.          DTSBX655
00414      05  WRK-MJRN-CNT                PIC S9(08)  COMP-3.          DTSBX655
00415      05  WRK-MERA-CNT                PIC S9(08)  COMP-3.          DTSBX655
00416      05  WRK-MRTE-CNT                PIC S9(08)  COMP-3.          DTSBX655
00417      05  WRK-MRTE-CNT1               PIC S9(08)  COMP-3.          DTSBX655
00418      05  WRK-MLOG-CNT                PIC S9(08)  COMP-3.          DTSBX655
00419      05  WRK-MFSC-CNT                PIC S9(08)  COMP-3           DTSBX655
00420                                           VALUE +0.               DTSBX655
00421      05  WRK-CR-TOL-CNT              PIC S9(07)  COMP-3.          DTSBX655
00422      05  SUB                         PIC S9(04)  COMP.            DTSBX655
00423      05  RPT-SUB                     PIC S9(04)  COMP.            DTSBX655
00424      05  QTR-SUB                     PIC S9(04)  COMP.            DTSBX655
00425      05  WRK-QTR-AREA OCCURS 20  TIMES.                           DTSBX655
00426          10  WRK-QTR-YRQ             PIC S9(05)  COMP-3.          DTSBX655
00427          10  WRK-QTR-CHG             PIC S9(09)V99  COMP-3.       DTSBX655
00428          10  WRK-QTR-PAID            PIC S9(09)V99  COMP-3.       DTSBX655
00429          10  WRK-QTR-WAIVED          PIC S9(09)V99  COMP-3.       DTSBX655
00430          10  WRK-QTR-TOLERATED       PIC S9(09)V99  COMP-3.       DTSBX655
00431      05  WRK-JRN-AREA OCCURS 100  TIMES.                          DTSBX655
00432 ***      10  WRK-JRN-EMP-NO          PIC  9(06).                  DTSBX655
00433 ***      10  WRK-JRN-EMP-NAME        PIC  X(40).                  DTSBX655
00434          10  WRK-JRN-RCVD            PIC  X(10).                  DTSBX655
00435          10  WRK-JRN-TRAN            PIC  X(02).                  DTSBX655
00436          10  WRK-JRN-BATCH           PIC  9(05).                  DTSBX655
00437          10  WRK-JRN-ITEM            PIC  9(03).                  DTSBX655
00438          10  WRK-JRN-AMT             PIC  --------9.99.           DTSBX655
00439      05  WRK-TIMELY-PMT-AREA.                                     DTSBX655
00440          10  WRK-PEN-INT-BAL-CNT     PIC S9(07)  COMP-3.          DTSBX655
00441          10  WRK-INT-MANUAL-CNT      PIC S9(07)  COMP-3.          DTSBX655
00442          10  WRK-QTR-TAX-BAL         PIC S9(09)V9(02)  COMP-3.    DTSBX655
00443          10  WRK-QTR-TAX-CHG         PIC S9(09)V9(02)  COMP-3.    DTSBX655
00444          10  WRK-QTR-INT-PEN-BAL     PIC S9(09)V9(02)  COMP-3.    DTSBX655
00445          10  WRK-AVG-PMT             PIC S9(09)V9(02)  COMP-3.    DTSBX655
00446          10  WRK-TIMELY-PMT          PIC S9(09)V9(02)  COMP-3.    DTSBX655
00447          10  WRK-OLD-PEN-CHG         PIC S9(09)V9(02)  COMP-3.    DTSBX655
00448                                                                   DTSBX655
00449      05  WRK-PCT                     PIC S9(03)V9(04)  COMP-3     DTSBX655
00450                                          VALUE +0.                DTSBX655
00451      05  WRK-AVG-PCT                 PIC S9(09)V9(04)  COMP-3     DTSBX655
00452                                          VALUE +0.                DTSBX655
00453      05  WRK-PCT-DISP                PIC  Z(02)9.9999.            DTSBX655
00454      05  WRK-PCT-DISP1               PIC  Z(02)9.9999.            DTSBX655
00455      05  WRK-UI-RATE                 PIC S9(01)V9(04)  COMP-3.    DTSBX655
00456      05  DISP-UI-RATE1               PIC  9.9(04).                DTSBX655
00457      05  DISP-UI-RATE2               PIC  9.9(04).                DTSBX655
00458      05  AMT-DISP                    PIC  ---,---,--9.99.         DTSBX655
00459      05  AMT-DISP1                   PIC  Z(11)9.99-.             DTSBX655
00460      05  AMT-DISP2                   PIC  Z(11)9.99-.             DTSBX655
00461      05  AMT-DISP3                   PIC  Z(11)9-.                DTSBX655
00462      05  EMP-ACCT-DISP               PIC  9(06).                  DTSBX655
00463      05  EMP-SUCC-DISP               PIC  9(06).                  DTSBX655
00464      05  EMP-SUCC-DISP-X REDEFINES EMP-SUCC-DISP                  DTSBX655
00465                                      PIC  X(06).                  DTSBX655
00466      05  DISP-DATE1                  PIC  X(10).                  DTSBX655
00467      05  DISP-DATE2                  PIC  X(10).                  DTSBX655
00468      05  INACT-LBL                   PIC  X(10).                  DTSBX655
00469      05  WRK-MPRF-IND                PIC  X(01).                  DTSBX655
00470          88 WRK-MPRF-OK           VALUE 'Y'.                      DTSBX655
00471          88 WRK-MPRF-NO-REC       VALUE 'N'.                      DTSBX655
00472      05  WRK-MQTR-IND                PIC  X(01).                  DTSBX655
00473          88 WRK-MQTR-OK           VALUE 'Y'.                      DTSBX655
00474          88 WRK-MQTR-NO-REC       VALUE 'N'.                      DTSBX655
00475      05  WRK-MRPT-IND                PIC  X(01).                  DTSBX655
00476          88 WRK-MRPT-OK           VALUE 'Y'.                      DTSBX655
00477          88 WRK-MRPT-NO-REC       VALUE 'N'.                      DTSBX655
00478      05  WRK-MDST-IND                PIC  X(01).                  DTSBX655
00479          88 WRK-MDST-OK           VALUE 'Y'.                      DTSBX655
00480          88 WRK-MDST-NO-REC       VALUE 'N'.                      DTSBX655
00481      05  WRK-MEVL-IND                PIC  X(01).                  DTSBX655
00482          88 WRK-MEVL-OK           VALUE 'Y'.                      DTSBX655
00483          88 WRK-MEVL-NO-REC       VALUE 'N'.                      DTSBX655
00484      05  WRK-MLIN-IND                PIC  X(01).                  DTSBX655
00485          88 WRK-MLIN-OK           VALUE 'Y'.                      DTSBX655
00486          88 WRK-MLIN-NO-REC       VALUE 'N'.                      DTSBX655
00487      05  WRK-MDPC-IND                PIC  X(01).                  DTSBX655
00488          88 WRK-MDPC-OK           VALUE 'Y'.                      DTSBX655
00489          88 WRK-MDPC-NO-REC       VALUE 'N'.                      DTSBX655
00490      05  WRK-MFAS-IND                PIC  X(01).                  DTSBX655
00491          88 WRK-MFAS-OK           VALUE 'Y'.                      DTSBX655
00492          88 WRK-MFAS-NO-REC       VALUE 'N'.                      DTSBX655
00493      05  WRK-MFAE-IND                PIC  X(01).                  DTSBX655
00494          88 WRK-MFAE-OK           VALUE 'Y'.                      DTSBX655
00495          88 WRK-MFAE-NO-REC       VALUE 'N'.                      DTSBX655
00496      05  WRK-MSOL-IND                PIC  X(01).                  DTSBX655
00497          88 WRK-MSOL-OK           VALUE 'Y'.                      DTSBX655
00498          88 WRK-MSOL-NO-REC       VALUE 'N'.                      DTSBX655
00499      05  WRK-MLOG-IND                PIC  X(01).                  DTSBX655
00500          88 WRK-MLOG-OK           VALUE 'Y'.                      DTSBX655
00501          88 WRK-MLOG-NO-REC       VALUE 'N'.                      DTSBX655
00502          88 WRK-MLOG-COMPLETE     VALUE 'C'.                      DTSBX655
00503      05  WRK-MRPT-FOUND-IND          PIC X(01).                   DTSBX655
00504          88  WRK-MRPT-FOUND-YES   VALUE 'Y'.                      DTSBX655
00505          88  WRK-MRPT-FOUND-NO    VALUE 'N'.                      DTSBX655
00506      05  WRK-MTAD-FOUND-IND          PIC X(01).                      CL**6
00507          88  WRK-MTAD-FOUND-YES   VALUE 'Y'.                         CL**6
00508          88  WRK-MTAD-FOUND-NO    VALUE 'N'.                         CL**6
00509      05  WRK-CR-TOL-IND              PIC X(01).                   DTSBX655
00510          88  WRK-CR-TOL-YES       VALUE 'Y'.                      DTSBX655
00511          88  WRK-CR-TOL-NO        VALUE 'N'.                      DTSBX655
00512      05  WRK-DUP-FOUND-IND           PIC  X(01).                  DTSBX655
00513          88 WRK-DUP-FOUND-YES     VALUE 'Y'.                      DTSBX655
00514          88 WRK-DUP-FOUND-NO      VALUE 'N'.                      DTSBX655
00515      05  WRK-SELECT-IND              PIC  X(01).                  DTSBX655
00516          88 WRK-SELECT-YES-88     VALUE 'Y'.                      DTSBX655
00517          88 WRK-SELECT-NO-88      VALUE 'N'.                      DTSBX655
00518      05  WRK-LAST-MRPT-TYPE          PIC  X(02).                  DTSBX655
00519      05  WRK-DISP-AREA.                                           DTSBX655
00520          10  WRK-DISP-STAR           PIC X(01).                   DTSBX655
00521          10  FILLER                  PIC X(01) VALUE SPACE.       DTSBX655
00522          10  WRK-DISP-AMT            PIC Z(10)9.99-.              DTSBX655
00523                                                                   DTSBX655
00524      05  WRK-INACT-DATE              PIC S9(09)  COMP-3           DTSBX655
00525                                       VALUE +0.                   DTSBX655
00526      05  WRK-INACT-CODE              PIC  X(02).                  DTSBX655
00527      05  WRK-INACT-YRQ               PIC S9(05)  COMP-3           DTSBX655
00528                                       VALUE +0.                   DTSBX655
00529      05  WRK-LAST-YRQ                PIC S9(05)  COMP-3           DTSBX655
00530                                       VALUE +0.                   DTSBX655
00531      05  WRK-FIRST-LIAB-YRQ          PIC S9(05)  COMP-3           DTSBX655
00532                                       VALUE +0.                   DTSBX655
00533      05  WRK-LAST-LIAB-YRQ           PIC S9(05)  COMP-3           DTSBX655
00534                                       VALUE +0.                   DTSBX655
00535      05  WRK-NEXT-YRQ                PIC S9(05)  COMP-3           DTSBX655
00536                                       VALUE +0.                   DTSBX655
00537      05  WRK-UPDATED-CNT             PIC S9(07)  COMP-3.          DTSBX655
00538                                                                   DTSBX655
00539      05  PARM-REC-CNT                PIC S9(07)  COMP-3.          DTSBX655
00540                                                                   DTSBX655
00541      05  PARM-EOF-IND                    PIC  X(01).              DTSBX655
00542                                                                   DTSBX655
00543      05  WRK-EMP-NO                  PIC  9(06).                  DTSBX655
00544                                                                   DTSBX655
00545      05  WRK-TRACE-IND                   PIC  X(01).              DTSBX655
00546                                                                   DTSBX655
00547      05  WRK-MST-OPEN-IND                PIC  X(01).              DTSBX655
00548                                                                   DTSBX655
00549      05  WRK-REF-OPEN-IND                PIC  X(01).              DTSBX655
00550                                                                   DTSBX655
00551      05  WRK-SIC-SCAN-AREA.                                       DTSBX655
00552          10  WRK-RPT-FOUND-IND           PIC X(01).               DTSBX655
00553              88  WRK-RPT-FOUND-YES   VALUE 'Y'.                   DTSBX655
00554              88  WRK-RPT-FOUND-NO    VALUE 'N'.                   DTSBX655
00555          10  WRK-EMPL-CNT            PIC S9(07)  COMP-3.          DTSBX655
00556          10  WRK-SIC-4                   PIC X(04).               DTSBX655
00557          10  FILLER REDEFINES WRK-SIC-4.                          DTSBX655
00558              15  WRK-SIC-3               PIC X(03).               DTSBX655
00559              15  FILLER                  PIC X(01).               DTSBX655
00560          10  WRK-NO-SIC-CNT          PIC S9(07)  COMP-3.          DTSBX655
00561          10  WRK-SIC-7911-AREA.                                   DTSBX655
00562              15  WRK-SIC-7911-WORKERS    PIC S9(07)  COMP-3.      DTSBX655
00563              15  WRK-SIC-7911-BUSINESSES PIC S9(07)  COMP-3.      DTSBX655
00564          10  WRK-SIC-794-AREA.                                    DTSBX655
00565              15  WRK-SIC-794-WORKERS     PIC S9(07)  COMP-3.      DTSBX655
00566              15  WRK-SIC-794-BUSINESSES  PIC S9(07)  COMP-3.      DTSBX655
00567          10  WRK-SIC-799-AREA.                                    DTSBX655
00568              15  WRK-SIC-799-WORKERS     PIC S9(07)  COMP-3.      DTSBX655
00569              15  WRK-SIC-799-BUSINESSES  PIC S9(07)  COMP-3.      DTSBX655
00570          10  WRK-SIC-8351-AREA.                                   DTSBX655
00571              15  WRK-SIC-8351-WORKERS    PIC S9(07)  COMP-3.      DTSBX655
00572              15  WRK-SIC-8351-BUSINESSES PIC S9(07)  COMP-3.      DTSBX655
00573          10  WRK-SIC-8641-AREA.                                   DTSBX655
00574              15  WRK-SIC-8641-WORKERS    PIC S9(07)  COMP-3.      DTSBX655
00575              15  WRK-SIC-8641-BUSINESSES PIC S9(07)  COMP-3.      DTSBX655
00576          10  WRK-NAICS-6                 PIC X(06).               DTSBX655
00577          10  FILLER REDEFINES WRK-NAICS-6.                        DTSBX655
00578              15  WRK-NAICS-2             PIC X(02).               DTSBX655
00579              15  FILLER                  PIC X(04).               DTSBX655
00580 *RW1                                                              DTSBX655
00581      05  WRK-ABEND-MSG            PIC  X(60)  VALUE SPACES.       DTSBX655
00582      05  FIRST-TIME-IND           PIC  X(01)  VALUE 'Y'.          DTSBX655
00583      05  WS-NUMBER-ONE            PIC S9(05)  COMP-3 VALUE +0.    DTSBX655
00584                                                                   DTSBX655
00585      05  DISP-DATE                   PIC  X(08).                  DTSBX655
00586      05  DISP-TIME                   PIC  X(08).                  DTSBX655
00587                                                                   DTSBX655
00588      05  WS-LINE-CNT              PIC S9(02) COMP-3 VALUE 60.     DTSBX655
00589      05  WS-LINE-CNT2             PIC S9(02) COMP-3 VALUE +0.     DTSBX655
00590      05  WS-PAGE-CNT              PIC S9(03) COMP-3 VALUE +0.     DTSBX655
00591      05  WRK-T003-CNT                PIC S9(07)  COMP-3 VALUE +0.    CL184
00592                                                                   DTSBX655
00593 *    05  EVL-TEXT                        PIC  X(50).                 CL154
00594  01  MNT-LOG-AREA.                                                   CL183
00595      10  WRK-MNTE-MSG-LINE1.                                         CL183
00596          15 FILLER             PIC X(53) VALUE                       CL214
00597          'AT THE REQUEST OF PROGRAM, ACCT RETURN MAIL FLAG HAS '.    CL234
00598          15 FILLER             PIC X(20) VALUE                       CL217
00599          'BEEN UPDATED TO "Y" '.                                     CL238
00600      10  WRK-MNTE-MSG-LINE2.                                         CL183
00601          15 FILLER             PIC X(53) VALUE                       CL214
00602          '(BAD ADDRRESS).                                      '.    CL238
00603          15 FILLER             PIC X(19) VALUE                       CL214
00604          '                   '.                                      CL229
00605      10  WRK-MNTE-MSG-LINE3.                                         CL183
00606          15 FILLER             PIC X(53) VALUE                       CL214
00607          '                                                     '.    CL229
00608          15 FILLER             PIC X(19) VALUE                       CL214
00609          '                   '.                                      CL216
00610 *        'CORRESPONDENCE RESUMED.'.                                  CL198
00611 *                                                                    CL190
00612  01  HEADER-1.                                                    DTSBX655
00613      05  FILLER                   PIC X(01) VALUE SPACES.         DTSBX655
00614      05  FILLER                   PIC X(49) VALUE '016R1'.        DTSBX655
00615      05  FILLER                   PIC X(60) VALUE                 DTSBX655
00616          'DISTRICT OF COLUMBIA'.                                  DTSBX655
00617      05  FILLER                   PIC X(06) VALUE 'DATE:'.        DTSBX655
00618      05  HDR1-LRCM-SYS-DATE       PIC X(08).                      DTSBX655
00619                                                                   DTSBX655
00620  01  HEADER-2.                                                    DTSBX655
00621      05  FILLER                   PIC X(54) VALUE SPACES.         DTSBX655
00622      05  FILLER                   PIC X(56) VALUE                 DTSBX655
00623          'TAX DIVISION'.                                          DTSBX655
00624      05  FILLER                   PIC X(06) VALUE 'TIME:'.        DTSBX655
00625      05  HDR2-LRCM-SYS-TIME       PIC X(08).                      DTSBX655
00626                                                                   DTSBX655
00627  01  HEADER-3.                                                    DTSBX655
00628      05  FILLER                   PIC X(01) VALUE SPACES.         DTSBX655
00629      05  FILLER                   PIC X(38) VALUE                 DTSBX655
00630          'ROUTE TO:  ACCOUNTING UNIT'.                            DTSBX655
00631      05  HDR3-LITERAL             PIC X(43) VALUE                 DTSBX655
00632          '    EMPLOYERS REGISTERED SINCE 09/11/01    '.           DTSBX655
00633      05  FILLER                   PIC X(28) VALUE SPACES.         DTSBX655
00634      05  FILLER                   PIC X(06) VALUE 'PAGE:'.        DTSBX655
00635      05  HDR3-PAGE                PIC ZZ,ZZ9.                     DTSBX655
00636                                                                   DTSBX655
00637  01  HEADER-4.                                                    DTSBX655
00638      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBX655
00639      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBX655
00640                                                                   DTSBX655
00641  01  HEADER-5.                                                    DTSBX655
00642      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBX655
00643      05  FILLER                   PIC X(05)  VALUE SPACES.        DTSBX655
00644      05  FILLER                   PIC X(06)  VALUE                DTSBX655
00645                       'EMP NO'.                                   DTSBX655
00646      05  FILLER                   PIC X(05)  VALUE SPACES.        DTSBX655
00647      05  FILLER                   PIC X(12)  VALUE                DTSBX655
00648                       'PRIMARY NAME'.                             DTSBX655
00649      05  FILLER                   PIC X(28)  VALUE SPACES.        DTSBX655
00650      05  FILLER                   PIC X(04)  VALUE SPACES.        DTSBX655
00651      05  FILLER                   PIC X(14)  VALUE                DTSBX655
00652                       'LIABILITY DATE'.                           DTSBX655
00653      05  FILLER                   PIC X(04)  VALUE SPACES.        DTSBX655
00654      05  FILLER                   PIC X(13)  VALUE                DTSBX655
00655                       'INACTIVE DATE'.                            DTSBX655
00656      05  FILLER                   PIC X(12)  VALUE SPACES.        DTSBX655
00657      05  FILLER                   PIC X(18)  VALUE SPACES.        DTSBX655
00658                                                                   DTSBX655
00659  01  HEADER-6.                                                    DTSBX655
00660      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBX655
00661      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBX655
00662                                                                   DTSBX655
00663  01  DETAIL-LINE-1.                                               DTSBX655
00664      05  FILLER                  PIC  X(05)  VALUE SPACES.        DTSBX655
00665      05  WS-EMP-NO               PIC  999B999.                    DTSBX655
00666      05  FILLER                  PIC  X(02)  VALUE SPACES.        DTSBX655
00667      05  WS-PRIMARY-NAME         PIC  X(40).                      DTSBX655
00668      05  FILLER                  PIC  X(02)  VALUE SPACES.        DTSBX655
00669      05  WS-DATE1                PIC  X(10).                      DTSBX655
00670      05  FILLER                  PIC  X(02)  VALUE SPACES.        DTSBX655
00671      05  WS-DATE2                PIC  X(10).                      DTSBX655
00672 *    05  FILLER                  PIC  X(05)  VALUE SPACES.        DTSBX655
00673 *    05  WS-BALANCE-AMT          PIC  ZZZ,ZZZ,ZZ9.99.             DTSBX655
00674 *    05  FILLER                  PIC  X(09)  VALUE SPACES.        DTSBX655
00675 *    05  WS-PURSUED-RPT          PIC  ZZ9.                        DTSBX655
00676 *    05  FILLER                  PIC  X(10)  VALUE SPACES.        DTSBX655
00677 *    05  WS-DPC                  PIC  X(01).                      DTSBX655
00678 *    05  FILLER                  PIC  X(06)  VALUE SPACES.        DTSBX655
00679 *    05  WS-LIEN                 PIC  X(01).                      DTSBX655
00680 *    05  FILLER                  PIC  X(21)  VALUE SPACES.        DTSBX655
00681                                                                   DTSBX655
00682  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.        DTSBX655
00683  01  FOOTING-LINE-2               PIC X(133) VALUE SPACES.        DTSBX655
00684                                                                   DTSBX655
00685  01  FOOTING-LINE-3.                                              DTSBX655
00686      05  FILLER                   PIC  X(25)  VALUE SPACES.       DTSBX655
00687      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                    DTSBX655
00688      05  FILLER                   PIC  X(02)  VALUE SPACES.       DTSBX655
00689      05  FILLER                   PIC  X(43) VALUE                DTSBX655
00690                     'DEBIT WRITE OFF CANDIDATES LISTED ON REPORT'.DTSBX655
00691      05  FILLER                   PIC  X(23)  VALUE SPACES.       DTSBX655
00692  01  FOOTING-LINE-4               PIC X(133) VALUE SPACES.        DTSBX655
00693  01  FOOTING-LINE-5               PIC X(133) VALUE SPACES.        DTSBX655
00694  01  FOOTING-LINE-6.                                              DTSBX655
00695      05  FILLER                   PIC X(25)  VALUE SPACES.        DTSBX655
00696      05  FILLER                   PIC  X(17) VALUE                DTSBX655
00697                       '*** END OF REPORT'.                        DTSBX655
00698 *RW2                                                              DTSBX655
00699                                                                   DTSBX655
00700  01  TSKL-REC.                                                       CL183
00701  ++INCLUDE DTSITSKL                                                  CL183
00702      EJECT                                                           CL183
00703  01  T003-REC.                                                       CL183
00704  ++INCLUDE DTSIT003                                                  CL183
00705      EJECT                                                           CL183
00706  01  L001-LINK-AREA.                                              DTSBX655
00707  ++INCLUDE DTSIL001                                               DTSBX655
00708      EJECT                                                        DTSBX655
00709  01  L005-LINK-AREA.                                                 CL157
00710  ++INCLUDE DTSIL005                                               DTSBX655
00711      EJECT                                                        DTSBX655
00712  01  L331-LINK-AREA.                                                 CL209
00713  ++INCLUDE DTSIL331                                                  CL209
00714      EJECT                                                        DTSBX655
00715  01  L039-LINK-AREA.                                                 CL209
00716  ++INCLUDE DTSIL039                                                  CL209
00717      EJECT                                                           CL209
00718  01  L101-LINK-AREA.                                                 CL*23
00719  ++INCLUDE DTSIL101                                                  CL*23
00720      EJECT                                                        DTSBX655
00721  01  L102-LINK-AREA.                                                 CL*23
00722  ++INCLUDE DTSIL102                                                  CL*23
00723      EJECT                                                           CL*23
00724  01  L109-LINK-AREA.                                                 CL*23
00725  ++INCLUDE DTSIL109                                                  CL*23
00726                                                                      CL*23
00727  01  L054-LINK-AREA.                                              DTSBX655
00728  ++INCLUDE DTSIL054                                               DTSBX655
00729      EJECT                                                        DTSBX655
00730  01  L410-LINK-AREA.                                              DTSBX655
00731  ++INCLUDE DTSIL410                                               DTSBX655
00732      EJECT                                                        DTSBX655
00733  01  L600-LINK-AREA.                                              DTSBX655
00734  ++INCLUDE DTSIL600                                               DTSBX655
00735      EJECT                                                        DTSBX655
00736  01  L910-LINK-AREA.                                              DTSBX655
00737  ++INCLUDE DTSIL910                                               DTSBX655
00738      EJECT                                                        DTSBX655
00739  01  MSKL-REC.                                                    DTSBX655
00740  ++INCLUDE DTSIMSKL                                               DTSBX655
00741      EJECT                                                        DTSBX655
00742  01  MNTE-REC.                                                       CL183
00743  ++INCLUDE DTSIMNTE                                                  CL183
00744      EJECT                                                           CL183
00745  01  MHDR-REC.                                                    DTSBX655
00746  ++INCLUDE DTSIMHDR                                               DTSBX655
00747      EJECT                                                        DTSBX655
00748  01  MPRF-REC.                                                       CL164
00749  ++INCLUDE DTSIMPRF                                                  CL164
00750      EJECT                                                           CL164
00751  01  MQTR-REC.                                                    DTSBX655
00752  ++INCLUDE DTSIMQTR                                               DTSBX655
00753      EJECT                                                        DTSBX655
00754  01  MRPT-REC.                                                    DTSBX655
00755  ++INCLUDE DTSIMRPT                                               DTSBX655
00756      EJECT                                                        DTSBX655
00757  01  MSOL-REC.                                                    DTSBX655
00758  ++INCLUDE DTSIMSOL                                               DTSBX655
00759      EJECT                                                        DTSBX655
00760  01  MRCT-REC.                                                    DTSBX655
00761  ++INCLUDE DTSIMRCT                                               DTSBX655
00762      EJECT                                                        DTSBX655
00763  01  MREL-REC.                                                    DTSBX655
00764  ++INCLUDE DTSIMREL                                               DTSBX655
00765      EJECT                                                        DTSBX655
00766  01  MEVL-REC.                                                    DTSBX655
00767  ++INCLUDE DTSIMEVL                                               DTSBX655
00768      EJECT                                                        DTSBX655
00769  01  MLIN-REC.                                                    DTSBX655
00770  ++INCLUDE DTSIMLIN                                               DTSBX655
00771      EJECT                                                        DTSBX655
00772  01  MRTE-REC.                                                    DTSBX655
00773  ++INCLUDE DTSIMRTE                                               DTSBX655
00774      EJECT                                                        DTSBX655
00775  01  MDST-REC.                                                    DTSBX655
00776  ++INCLUDE DTSIMDST                                               DTSBX655
00777      EJECT                                                        DTSBX655
00778  01  MPAY-REC.                                                    DTSBX655
00779  ++INCLUDE DTSIMPAY                                               DTSBX655
00780      EJECT                                                        DTSBX655
00781  01  MADJ-REC.                                                    DTSBX655
00782  ++INCLUDE DTSIMADJ                                               DTSBX655
00783      EJECT                                                        DTSBX655
00784  01  MJRN-REC.                                                    DTSBX655
00785  ++INCLUDE DTSIMJRN                                               DTSBX655
00786      EJECT                                                        DTSBX655
00787  01  MERA-REC.                                                    DTSBX655
00788  ++INCLUDE DTSIMERA                                               DTSBX655
00789      EJECT                                                        DTSBX655
00790  01  MCOL-REC.                                                    DTSBX655
00791  ++INCLUDE DTSIMCOL                                               DTSBX655
00792      EJECT                                                        DTSBX655
00793  01  MFAS-REC.                                                    DTSBX655
00794  ++INCLUDE DTSIMFAS                                               DTSBX655
00795  01  MAUR-REC.                                                    DTSBX655
00796  ++INCLUDE DTSIMAUR                                               DTSBX655
00797      EJECT                                                        DTSBX655
00798  01  MFAE-REC.                                                    DTSBX655
00799  ++INCLUDE DTSIMFAE                                               DTSBX655
00800      EJECT                                                        DTSBX655
00801  01  MLOG-REC.                                                    DTSBX655
00802  ++INCLUDE DTSIMLOG                                               DTSBX655
00803      EJECT                                                        DTSBX655
00804  01  MOPO-REC.                                                    DTSBX655
00805  ++INCLUDE DTSIMOPO                                               DTSBX655
00806      EJECT                                                        DTSBX655
00807  01  MTAD-REC.                                                    DTSBX655
00808  ++INCLUDE DTSIMTAD                                               DTSBX655
00809      EJECT                                                        DTSBX655
00810  01  MTAA-REC.                                                    DTSBX655
00811  ++INCLUDE DTSIMTAA                                               DTSBX655
00812      EJECT                                                        DTSBX655
00813  01  MBAA-REC.                                                    DTSBX655
00814  ++INCLUDE DTSIMBAA                                               DTSBX655
00815      EJECT                                                        DTSBX655
00816  01  MFSC-REC.                                                    DTSBX655
00817  ++INCLUDE DTSIMFSC                                               DTSBX655
00818      EJECT                                                        DTSBX655
00819  01  MERD-REC.                                                    DTSBX655
00820  ++INCLUDE DTSIMERD                                               DTSBX655
00821      EJECT                                                        DTSBX655
00822  01  MDPC-REC.                                                    DTSBX655
00823  ++INCLUDE DTSIMDPC                                               DTSBX655
00824      EJECT                                                        DTSBX655
00825  01  L921-LINK-AREA.                                              DTSBX655
00826  ++INCLUDE DTSIL921                                               DTSBX655
00827      EJECT                                                        DTSBX655
00828  01  ISKL-REC.                                                    DTSBX655
00829  ++INCLUDE DTSIISKL                                               DTSBX655
00830      EJECT                                                        DTSBX655
00831  01  IPES-REC.                                                    DTSBX655
00832  ++INCLUDE DTSIIPES                                               DTSBX655
00833      EJECT                                                        DTSBX655
00834  01  L931-LINK-AREA.                                              DTSBX655
00835  ++INCLUDE DTSIL931                                               DTSBX655
00836      EJECT                                                        DTSBX655
00837  01  FSKL-REC.                                                    DTSBX655
00838  ++INCLUDE DTSIFSKL                                               DTSBX655
00839      EJECT                                                        DTSBX655
00840  01  FQTR-REC.                                                    DTSBX655
00841  ++INCLUDE DTSIFQTR                                               DTSBX655
00842      EJECT                                                        DTSBX655
00843  01  FFIS-REC.                                                    DTSBX655
00844  ++INCLUDE DTSIFFIS                                               DTSBX655
00845      EJECT                                                        DTSBX655
00846  01  FFAZ-REC.                                                    DTSBX655
00847  ++INCLUDE DTSIFFAZ                                               DTSBX655
00848      EJECT                                                        DTSBX655
00849  01  FOPR-REC.                                                    DTSBX655
00850  ++INCLUDE DTSIFOPR                                               DTSBX655
00851      EJECT                                                        DTSBX655
00852  01  L933-LINK-AREA.                                              DTSBX655
00853  ++INCLUDE DTSIL933                                               DTSBX655
00854      EJECT                                                        DTSBX655
00855  01  XSIC-REC.                                                    DTSBX655
00856  ++INCLUDE DTSIXSIC                                               DTSBX655
00857      EJECT                                                        DTSBX655
00858  01  L004-COMM-AREA.                                              DTSBX655
00859  ++INCLUDE DTSIL004                                               DTSBX655
00860                                                                   DTSBX655
00861  01  L061-LINK-AREA.                                              DTSBX655
00862  ++INCLUDE DTSIL061                                               DTSBX655
00863                                                                   DTSBX655
00864  01  L062-LINK-AREA.                                              DTSBX655
00865  ++INCLUDE DTSIL062                                               DTSBX655
00866                                                                   DTSBX655
00867  01  L516-LINK-AREA.                                              DTSBX655
00868  ++INCLUDE DTSIL516                                               DTSBX655
00869      EJECT                                                        DTSBX655
00870  01  LBCM-LINK-AREA.                                                 CL173
00871  ++INCLUDE DTSILBCM                                                  CL173
00872      EJECT                                                           CL154
00873  01  L923-LINK-AREA.                                                 CL183
00874  ++INCLUDE DTSIL923                                                  CL183
00875      EJECT                                                           CL183
00876  01  ASKL-REC.                                                       CL183
00877  ++INCLUDE DTSIASKL                                                  CL183
00878      EJECT                                                           CL183
00879  01  AHDR-REC.                                                       CL183
00880  ++INCLUDE DTSIAHDR                                                  CL183
00881      EJECT                                                           CL183
00882  01  AADJ-REC.                                                       CL183
00883  ++INCLUDE DTSIAADJ                                                  CL183
00884      EJECT                                                           CL183
00885  01  L927-LINK-AREA.                                                 CL183
00886  ++INCLUDE DTSIL927                                                  CL183
00887      EJECT                                                           CL183
00888  PROCEDURE DIVISION.                                                 CL228
00889                                                                      CL164
00890      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBX655
00891         PERFORM P0000-PROCESS THRU P0000-EXIT                     DTSBX655
00892         PERFORM T0000-TERMINATE THRU T0000-EXIT.                  DTSBX655
00893      SKIP2                                                        DTSBX655
00894      GOBACK.                                                      DTSBX655
00895      EJECT                                                        DTSBX655
00896  I0000-INITIATE.                                                  DTSBX655
00897      SKIP2                                                        DTSBX655
00898      MOVE 'N' TO WRK-TRACE-IND.                                   DTSBX655
00899      SET WRK-ERROR-NO-88 TO TRUE.                                 DTSBX655
00900       MOVE +0 TO WRK-MPRF-REC-CNT                                    CL193
00901                                                                   DTSBX655
00902      PERFORM I2000-OPEN-FILES-1        THRU I2000-EXIT.           DTSBX655
00903                                                                   DTSBX655
00904      MOVE +0 TO WRK-MPRF-CNT                                         CL120
00905                 WRK-MQTR-CNT                                         CL120
00906                 WRK-MLOG-CNT                                         CL120
00907                 WRK-MEVL-DELETED-CNT.                                CL120
00908                                                                      CL120
00909  I0000-EXIT.                                                      DTSBX655
00910      EXIT.                                                        DTSBX655
00911  I2000-OPEN-FILES-1.                                              DTSBX655
00912         DISPLAY 'UPDATE RETURN FLAG TO Y - BAD ADDRESS FROM NCOA'    CL220
00913         DISPLAY ' '.                                                 CL220
00914      OPEN INPUT  EMP-FILE1.                                          CL120
00915      IF NOT EXP-STATUS-OK-88                                      DTSBX655
00916         DISPLAY 'CANNOT OPEN EXP FILE ' EXP-STATUS                DTSBX655
00917         SET WRK-ERROR-YES-88 TO TRUE                              DTSBX655
00918         GO TO I2000-EXIT.                                         DTSBX655
00919      MOVE WRK-TRACE-IND TO L910-TRACE-IND.                        DTSBX655
00920                                                                   DTSBX655
00921      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBX655
00922                                                                   DTSBX655
00923 *    PERFORM S910-OPEN-READ THRU S910-EXIT.                          CL171
00924      PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT.                 CL176
00925      PERFORM S923-OPEN-UPDATE THRU S923-EXIT.                        CL189
00926      PERFORM S927-OPEN-UPDATE         THRU S927-EXIT.                CL189
00927                                                                   DTSBX655
00928 *    PERFORM S921-OPEN-READ THRU S921-EXIT.                          CL123
00929      PERFORM S005-FROM-SYS             THRU S005-EXIT.               CL187
00930                                                                   DTSBX655
00931 **   PERFORM S931-OPEN-READ THRU S931-EXIT.                          CL122
00932 *    PERFORM S931-OPEN-UPDATE THRU S931-EXIT.                        CL176
00933                                                                   DTSBX655
00934      MOVE WRK-MOD-NAME TO L933-MOD-NAME.                          DTSBX655
00935                                                                   DTSBX655
00936 ***  PERFORM S933-OPEN-READ THRU S933-EXIT.                       DTSBX655
00937                                                                   DTSBX655
00938  I2000-EXIT.                                                      DTSBX655
00939      EXIT.                                                        DTSBX655
00940                                                                   DTSBX655
00941  P0000-PROCESS.                                                   DTSBX655
00942 *     DISPLAY 'IN P0000-PROCESS'.                                    CL220
00943       READ EMP-FILE1 AT END GO TO P0000-EXIT.                        CL122
00944                                                                   DTSBX655
00945      MOVE INEMP-NO         TO WS-EMP-NO1.                            CL196
00946       ADD 1 TO IN-REC-CNT.                                           CL122
00947      MOVE LOW-VALUES TO MPRF-KEY-AREA.                               CL129
00948      SET MPRF-PRF-88 TO TRUE.                                        CL129
00949                                                                   DTSBX655
00950      MOVE WS-EMP-NO1     TO MPRF-EMP-NO.                             CL159
00951      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                            CL119
00952                                                                   DTSBX655
00953      PERFORM S910-READ         THRU S910-EXIT.                    DTSBX655
00954      IF L910-NO-REC-88                                               CL119
00955         DISPLAY ' EMP NOT FOUND '   INEMP-NO                         CL196
00956         GO TO P0000-PROCESS.                                         CL119
00957      ADD 1 TO MPRF-REC-CNT.                                          CL122
00958      MOVE MSKL-REC TO MPRF-REC                                       CL119
00959 *    DISPLAY'MPRF-RETURN-MAIL-FLAG: ' MPRF-EMP-NO                    CL217
00960 *           ' ' MPRF-RETURN-MAIL-IND.                                CL217
00961 *      PERFORM P6000-SCAN-EVL     THRU P6000-EXIT.                   CL207
00962 *    GO TO P0000-PROCESS.                                            CL207
00963                                                                      CL204
00964 *    IF MPRF-TOT-CREDIT-AMT < 1                                      CL231
00965 *     DISPLAY MPRF-EMP-NO ';'                                        CL231
00966 *     ';' MPRF-RETURN-MAIL-IND  ';'  MPRF-TOT-CREDIT-AMT             CL231
00967 *    ELSE                                                            CL231
00968 *     DISPLAY MPRF-EMP-NO ';'                                        CL231
00969 *     ';' MPRF-RETURN-MAIL-IND  ';'  MPRF-TOT-CREDIT-AMT.            CL231
00970                                                                      CL226
00971 *    IF MPRF-RETURN-MAIL-NO-88                                       CL232
00972 *     DISPLAY MPRF-EMP-NO ' DUTAS RTN MAIL FLAG = N NCOA = Y '.      CL232
00973 *             '---- RTN FLAG NOT UPDATED'                            CL231
00974 *     GO TO P0000-PROCESS.                                           CL231
00975                                                                      CL227
00976       PERFORM P6000-SCAN-EVL     THRU P6000-EXIT.                    CL231
00977                                                                      CL231
00978       IF  WRK-MEVL-REWRITE-CNT = 1                                   CL231
00979         DISPLAY MEVL-EMP-NO ' MEVL REWRITTEN AFTER NCOA '            CL231
00980         GO TO P0000-PROCESS.                                         CL231
00981                                                                      CL231
00982       PERFORM P1100-CHECK-FOR-MLOG THRU P1100-EXIT.                  CL217
00983       PERFORM P3000-ADD-MNTE     THRU P3000-EXIT                     CL225
00984       SET MPRF-RETURN-MAIL-YES-88 TO TRUE                            CL221
00985       MOVE L005-DATE   TO MPRF-CHNG-DATE                             CL228
00986       MOVE MPRF-REC    TO MSKL-REC                                   CL228
00987       PERFORM S910-REWRITE THRU S910-EXIT                            CL221
00988       DISPLAY MPRF-EMP-NO ' DUTAS RTN MAIL UPDATED; NCOA = Y '.      CL232
00989       ADD +1 TO WRK-MPRF-REC-CNT                                     CL221
00990       GO TO P0000-PROCESS.                                           CL155
00991  P0000-EXIT.                                                         CL119
00992      EXIT.                                                        DTSBX655
00993  P1100-CHECK-FOR-MLOG.                                               CL208
00994          ADD  +5000           TO WRK-ABSTIME                         CL222
00995          PERFORM S005-FROM-SYS THRU S005-EXIT                        CL208
00996          MOVE L005-ABSTIME TO WRK-SYS-ABSTIME                        CL208
00997          MOVE MPRF-EMP-NO TO L331-EMP-NO WRK-EMP-NO                  CL208
00998          MOVE L005-DATE          TO L331-CURR-RUN-DATE               CL212
00999          ADD  WRK-ABSTIME TO WRK-SYS-ABSTIME                         CL208
01000          MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME                 CL208
01001          MOVE 'NCOAX655' TO L331-OP-ID                               CL224
01002          MOVE 'RETURN MAIL IND' TO L331-FIELD-NAME                   CL208
01003          MOVE MPRF-RETURN-MAIL-IND  TO L331-FROM-VALUE               CL221
01004 *        MOVE 'N'                   TO L331-FROM-VALUE               CL221
01005          MOVE 'Y'         TO L331-TO-VALUE                           CL213
01006          MOVE 'Y'         TO MPRF-RETURN-MAIL-IND                    CL213
01007 *        MOVE +1 TO WRK-MPRF-MAIL-UPD-CNT                            CL211
01008 *        DISPLAY ' RETURN MAIL UPDATED: ' WRK-EMP-NO                 CL220
01009          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                     CL208
01010  P1100-EXIT. EXIT.                                                   CL208
01011                                                                   DTSBX655
01012  P6000-SCAN-EVL.                                                     CL122
01013      MOVE +0 TO WRK-MEVL-REWRITE-CNT                                 CL231
01014      SET WRK-MEVL-OK TO TRUE.                                        CL122
01015      MOVE +0              TO WRK-RECEIVED-DATE.                      CL122
01016      MOVE LOW-VALUES  TO MEVL-KEY-AREA.                              CL122
01017      MOVE MPRF-EMP-NO TO MEVL-EMP-NO.                                CL122
01018      MOVE +0          TO MEVL-DATE.                                  CL122
01019      SET MEVL-EVL-88  TO TRUE.                                       CL122
01020      MOVE MEVL-KEY-AREA TO MSKL-KEY-AREA.                            CL122
01021                                                                      CL122
01022      PERFORM S910-START-BROWSE THRU S910-EXIT.                       CL122
01023      IF L910-NO-REC-88                                               CL122
01024         DISPLAY ' EVENT LOG NOT FOUND ' MPRF-EMP-NO                  CL122
01025         SET WRK-MEVL-NO-REC TO TRUE                                  CL206
01026         GO TO P6000-EXIT                                             CL122
01027      ELSE                                                            CL122
01028         PERFORM P6100-SCAN-MEVL THRU P6100-EXIT                      CL122
01029            UNTIL WRK-MEVL-NO-REC.                                    CL122
01030                                                                      CL122
01031  P6000-EXIT.                                                         CL122
01032      EXIT.                                                           CL122
01033  P6100-SCAN-MEVL.                                                    CL122
01034      MOVE MSKL-REC TO MEVL-REC.                                   DTSBX655
01035                                                                      CL126
01036       IF MEVL-DATE > 20190527                                        CL231
01037         IF  MEVL-TEXT (1:20) = 'MPRF-RETURN-MAIL-IND' OR             CL200
01038             MEVL-TEXT (1:15) = 'RETURN MAIL IND'                     CL200
01039        MOVE +1 TO WRK-MEVL-REWRITE-CNT                               CL231
01040         DISPLAY ' MEVL REWRITTEN ' MEVL-EMP-NO ' ' MEVL-TEXT         CL203
01041         SET WRK-MEVL-NO-REC TO TRUE                                  CL204
01042         GO TO P6100-EXIT.                                            CL204
01043                                                                      CL204
01044  P6100-READ-NEXT.                                                    CL204
01045                                                                      CL132
01046      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBX655
01047      IF L910-NO-REC-88                                            DTSBX655
01048         SET WRK-MEVL-NO-REC TO TRUE.                              DTSBX655
01049                                                                   DTSBX655
01050  P6100-EXIT.                                                      DTSBX655
01051      EXIT.                                                        DTSBX655
01052                                                                   DTSBX655
01053  S6000-WRITE-MEVL.                                                   CL154
01054      MOVE LOW-VALUES TO MEVL-REC.                                    CL165
01055      MOVE LOW-VALUES TO LBCM-RUN-AREA.                               CL173
01056                                                                      CL173
01057      MOVE ZERO TO LBCM-EMP-ABSTIME.                                  CL173
01058      MOVE MPRF-EMP-NO TO MEVL-EMP-NO.                                CL165
01059      DISPLAY'EMPNO:', MPRF-EMP-NO.                                   CL166
01060      SET MEVL-EVL-88 TO TRUE.                                        CL165
01061      ADD +6000 TO LBCM-EMP-ABSTIME.                                  CL182
01062                                                                      CL154
01063      MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME.                          CL173
01064                                                                      CL154
01065      PERFORM S005-FROM-ABSTIME THRU S005-A-EXIT.                     CL173
01066                                                                      CL154
01067                                                                      CL154
01068      DISPLAY'EMPNO:', MPRF-EMP-NO.                                   CL166
01069                                                                      CL154
01070      MOVE L005-DATE TO MEVL-DATE.                                    CL181
01071                                                                      CL154
01072      MOVE L005-TIME TO MEVL-TIME.                                    CL181
01073                                                                      CL154
01074      DISPLAY'EMPNO:', MPRF-EMP-NO.                                   CL166
01075                                                                      CL154
01076      MOVE ZEROS TO MEVL-PURGE-DATE.                                  CL154
01077                                                                      CL154
01078                                                                      CL154
01079 *    MOVE EVL-TEXT TO MEVL-TEXT.                                     CL184
01080                                                                      CL154
01081 **** SET MEVL-SOURCE-SYSTEM-88 TO TRUE.                              CL154
01082 **   MOVE MPAY-RESPONSIBLE-OP-ID   TO MEVL-SOURCE.                   CL180
01083                                                                      CL154
01084      SET MEVL-NOT-CONVERTED-88 TO TRUE.                              CL154
01085 *    MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE                       CL180
01086      MOVE 20170127           TO MEVL-ESTB-DATE                       CL180
01087                                 MEVL-CHNG-DATE.                      CL154
01088                                                                      CL154
01089                                                                      CL154
01090      MOVE MEVL-REC TO MSKL-REC.                                      CL154
01091                                                                      CL154
01092      PERFORM S910-WRITE THRU S910-EXIT.                              CL154
01093  S6000-EXIT.                                                         CL154
01094      EXIT.                                                           CL154
01095      EJECT                                                           CL154
01096                                                                   DTSBX655
01097  P3000-ADD-MNTE.                                                     CL183
01098      MOVE LENGTH OF T003-REC     TO T003-LENGTH.                     CL183
01099      MOVE '003'                  TO T003-REC-TYPE.                   CL183
01100      MOVE 'SYSTEM    '           TO T003-ORIGIN.                     CL183
01101      MOVE L005-DATE              TO T003-SYS-DATE.                   CL183
01102      MOVE L005-TIME              TO T003-SYS-TIME.                   CL183
01103      SET T003-ADD-MNTE-88        TO TRUE.                            CL183
01104                                                                      CL183
01105      MOVE LOW-VALUES              TO                                 CL183
01106      MNTE-KEY-AREA.                                                  CL183
01107      MOVE MPRF-EMP-NO             TO MNTE-EMP-NO.                    CL183
01108      SET MNTE-NTE-88              TO TRUE.                           CL183
01109      MOVE +0                      TO MNTE-PURGE-DATE.                CL183
01110      SET MNTE-NOT-CONVERTED-88    TO TRUE.                           CL183
01111                                                                      CL183
01112      MOVE L005-DATE               TO MNTE-ESTB-DATE                  CL183
01113                                      MNTE-CHNG-DATE.                 CL183
01114      MOVE ZERO                    TO MNTE-KEY-ESTB-ABSTIME           CL183
01115                                      MNTE-DATA-ESTB-ABSTIME          CL183
01116                                      MNTE-CHNG-ABSTIME.              CL183
01117      MOVE 'DTSBX655'              TO MNTE-ESTB-OP-ID                 CL234
01118                                      MNTE-CHNG-OP-ID.                CL183
01119                                                                      CL183
01120      MOVE 'RETURN MAIL FLAG UPDATED TO YES    '                      CL229
01121                                   TO MNTE-SUBJECT.                   CL183
01122                                                                      CL183
01123      MOVE +3                      TO MNTE-TEXT-CNT.                  CL190
01124                                                                      CL183
01125      MOVE WRK-MNTE-MSG-LINE1      TO MNTE-TEXT (1).                  CL183
01126      MOVE WRK-MNTE-MSG-LINE2      TO MNTE-TEXT (2).                  CL183
01127 *    MOVE WRK-MNTE-MSG-LINE3      TO MNTE-TEXT (3).                  CL229
01128                                                                      CL183
01129      MOVE MPRF-EMP-NO               TO T003-EMP-NO.                  CL183
01130      MOVE MNTE-REC                  TO T003-MNTE-REC.                CL183
01131                                                                      CL183
01132      MOVE T003-REC                  TO TSKL-REC.                     CL183
01133      PERFORM S927-WRITE             THRU S927-EXIT.                  CL183
01134      ADD +1                         TO WRK-T003-CNT.                 CL183
01135                                                                      CL183
01136  P3000-EXIT.                                                         CL183
01137      EXIT.                                                           CL183
01138                                                                      CL183
01139      SKIP3                                                           CL183
01140  T0000-TERMINATE.                                                 DTSBX655
01141                                                                   DTSBX655
01142      DISPLAY ' '.                                                 DTSBX655
01143                                                                   DTSBX655
01144      DISPLAY '*** DTSBX655 TERMINATION STATISTICS ***'.              CL238
01145                                                                   DTSBX655
01146      DISPLAY ' '.                                                 DTSBX655
01147                                                                   DTSBX655
01148      DISPLAY 'INPUT RECORDS READ                        : '          CL123
01149              IN-REC-CNT                                              CL123
01150                                                                      CL123
01151      DISPLAY 'RETURN MAIL UPDATE                       : '           CL192
01152              WRK-MPRF-REC-CNT                                        CL192
01153                                                                      CL192
01154                                                                      CL123
01155      DISPLAY 'ACTIVE EMPLOYERS FOUND                    : '          CL123
01156              MPRF-WRK-CNT.                                           CL123
01157                                                                      CL123
01158      DISPLAY 'QTR RECS FOUND                            : '          CL123
01159          WRK-MQTR-FOUND-CNT.                                         CL123
01160                                                                      CL123
01161      DISPLAY 'QTR RECS UPDATED                          : '          CL123
01162          WRK-MQTR-UPDATED-CNT.                                       CL123
01163                                                                   DTSBX655
01164      DISPLAY 'MEVL REC FOUND                            : '          CL123
01165          WRK-MEVL-FOUND-CNT.                                         CL123
01166                                                                   DTSBX655
01167      DISPLAY 'MEVL REC UPDATED                          : '          CL123
01168 **       WRK-MEVL-DELETED-CNT.                                       CL149
01169          WRK-MEVL-REWRITE-CNT.                                       CL149
01170                                                                      CL123
01171      CLOSE EMP-FILE1.                                                CL123
01172                                                                   DTSBX655
01173      PERFORM S923-CLOSE THRU S923-EXIT.                              CL189
01174      PERFORM S927-CLOSE THRU S927-EXIT.                              CL189
01175                                                                      CL183
01176      PERFORM S910-CLOSE THRU S910-EXIT.                              CL176
01177 *    PERFORM S921-CLOSE THRU S921-EXIT.                              CL123
01178 *    PERFORM S931-CLOSE THRU S931-EXIT.                              CL176
01179 ***  PERFORM S933-CLOSE THRU S933-EXIT.                           DTSBX655
01180                                                                   DTSBX655
01181  T0000-EXIT.                                                      DTSBX655
01182      EXIT.                                                        DTSBX655
01183      EJECT                                                        DTSBX655
01184  S001-FROM-FED-8.                                                 DTSBX655
01185      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX655
01186      GO TO S001-DATE.                                             DTSBX655
01187                                                                   DTSBX655
01188  S001-FROM-ABS-DAY.                                               DTSBX655
01189      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX655
01190      GO TO S001-DATE.                                             DTSBX655
01191                                                                   DTSBX655
01192  S001-DATE.                                                       DTSBX655
01193      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX655
01194                                                                   DTSBX655
01195  S001-EXIT.                                                       DTSBX655
01196      EXIT.                                                        DTSBX655
01197      SKIP3                                                        DTSBX655
01198  S004-FROM-5.                                                     DTSBX655
01199      SET L004-FROM-5     TO TRUE.                                 DTSBX655
01200      GO TO S004-EDIT-QTR.                                         DTSBX655
01201                                                                   DTSBX655
01202  S004-FROM-ABS.                                                   DTSBX655
01203      SET L004-FROM-ABS   TO TRUE.                                 DTSBX655
01204      GO TO S004-EDIT-QTR.                                         DTSBX655
01205                                                                   DTSBX655
01206  S004-EDIT-QTR.                                                   DTSBX655
01207      CALL 'DTSBU004' USING L004-COMM-AREA.                        DTSBX655
01208                                                                   DTSBX655
01209  S004-EXIT.                                                       DTSBX655
01210      EXIT.                                                        DTSBX655
01211      SKIP3                                                        DTSBX655
01212                                                                   DTSBX655
01213  S005-FROM-SYS.                                                      CL187
01214      SET L005-FROM-SYS   TO TRUE.                                    CL187
01215      CALL 'DTSBU005' USING L005-LINK-AREA.                           CL187
01216                                                                      CL187
01217  S005-EXIT.                                                          CL187
01218      EXIT.                                                           CL187
01219                                                                      CL187
01220  S005-FROM-ABSTIME.                                                  CL156
01221      SET L005-FROM-ABSTIME TO TRUE.                                  CL156
01222      GO TO S005-ABSTIME.                                             CL156
01223                                                                      CL156
01224  S005-ABSTIME.                                                       CL156
01225      CALL 'DTSBU005' USING L005-LINK-AREA.                           CL156
01226  S005-A-EXIT.                                                        CL156
01227      EXIT.                                                           CL156
01228      SKIP3                                                           CL156
01229  S910-WRITE.                                                         CL156
01230      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                             CL173
01231      SET L910-WRITE-88 TO TRUE.                                      CL156
01232      GO TO S910-MSTR-IO.                                             CL156
01233  S039-SIC-EDIT.                                                   DTSBX655
01234      CALL 'DTSBU039' USING L039-LINK-AREA.                        DTSBX655
01235  S039-EXIT.                                                       DTSBX655
01236      EXIT.                                                        DTSBX655
01237                                                                   DTSBX655
01238  S054-RATE-DETERMINATION.                                         DTSBX655
01239      CALL 'DTSBU054' USING L054-LINK-AREA                         DTSBX655
01240                            MRCT-REC.                              DTSBX655
01241                                                                   DTSBX655
01242  S054-EXIT.                                                       DTSBX655
01243      EXIT.                                                        DTSBX655
01244      SKIP3                                                        DTSBX655
01245  S061-FLD-REP-INFO.                                               DTSBX655
01246      SKIP1                                                        DTSBX655
01247      CALL 'DTSBU061' USING L061-LINK-AREA.                        DTSBX655
01248      SKIP2                                                        DTSBX655
01249  S061-EXIT.                                                       DTSBX655
01250      EXIT.                                                        DTSBX655
01251                                                                   DTSBX655
01252  S062-FLD-REP-LOOKUP.                                             DTSBX655
01253                                                                   DTSBX655
01254      CALL 'DTSBU062' USING L062-LINK-AREA.                        DTSBX655
01255                                                                   DTSBX655
01256  S062-EXIT.                                                       DTSBX655
01257      EXIT.                                                        DTSBX655
01258                                                                   DTSBX655
01259  S101-PER-MONTH-NO.                                                  CL*23
01260      SET L101-PER-MONTH-NO-88 TO TRUE.                               CL*23
01261      GO TO S101-INT-CHARGE.                                          CL*23
01262                                                                      CL*23
01263  S101-INT-CHARGE.                                                    CL*23
01264      CALL 'DTSBU101' USING L101-LINK-AREA.                           CL*23
01265  S101-EXIT.                                                          CL*23
01266      EXIT.                                                           CL*23
01267                                                                      CL*23
01268  S109-FIRST-PEN-INT-YRQ.                                             CL*23
01269      SET L109-CMND-PEN-INT-QTR-88 TO TRUE.                           CL*23
01270      CALL 'DTSBU109' USING L109-LINK-AREA.                           CL*23
01271  S109-EXIT.                                                          CL*23
01272      EXIT.                                                           CL*23
01273  S331-WRITE-MLOG.                                                    CL210
01274      CALL 'DTSBU331' USING L331-LINK-AREA.                           CL210
01275  S331-EXIT.                                                          CL210
01276      EXIT.                                                           CL210
01277      SKIP3                                                           CL210
01278                                                                      CL*23
01279  S410-FILING-SCHED.                                               DTSBX655
01280      CALL 'DTSBU410' USING L410-LINK-AREA.                        DTSBX655
01281                                                                   DTSBX655
01282  S410-EXIT.                                                       DTSBX655
01283      EXIT.                                                        DTSBX655
01284      SKIP3                                                        DTSBX655
01285  S516-LIABILITY.                                                  DTSBX655
01286      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBX655
01287                            MPRF-REC.                              DTSBX655
01288                                                                   DTSBX655
01289  S516-EXIT.                                                       DTSBX655
01290      EXIT.                                                        DTSBX655
01291      SKIP3                                                        DTSBX655
01292  S910-OPEN-READ.                                                  DTSBX655
01293      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX655
01294      GO TO S910-MSTR-IO.                                          DTSBX655
01295                                                                   DTSBX655
01296  S910-OPEN-UPDATE-NO-AIX.                                         DTSBX655
01297      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBX655
01298      GO TO S910-MSTR-IO.                                          DTSBX655
01299                                                                   DTSBX655
01300  S910-READ.                                                       DTSBX655
01301      SET L910-READ-88 TO TRUE.                                    DTSBX655
01302      GO TO S910-MSTR-IO.                                          DTSBX655
01303                                                                   DTSBX655
01304  S910-START-BROWSE.                                               DTSBX655
01305      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX655
01306      GO TO S910-MSTR-IO.                                          DTSBX655
01307                                                                   DTSBX655
01308  S910-READ-NEXT.                                                  DTSBX655
01309      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX655
01310      GO TO S910-MSTR-IO.                                          DTSBX655
01311                                                                   DTSBX655
01312  S910-COUNT.                                                      DTSBX655
01313      SET L910-COUNT-88 TO TRUE.                                   DTSBX655
01314      GO TO S910-MSTR-IO.                                          DTSBX655
01315                                                                   DTSBX655
01316  S910-REWRITE.                                                    DTSBX655
01317      SET L910-REWRITE-88 TO TRUE.                                 DTSBX655
01318      GO TO S910-MSTR-IO.                                          DTSBX655
01319                                                                   DTSBX655
01320  S910-DELETE.                                                     DTSBX655
01321      SET L910-DELETE-88 TO TRUE.                                  DTSBX655
01322      GO TO S910-MSTR-IO.                                          DTSBX655
01323                                                                   DTSBX655
01324  S910-CLOSE.                                                      DTSBX655
01325      SET L910-CLOSE-88     TO TRUE.                               DTSBX655
01326      GO TO S910-MSTR-IO.                                          DTSBX655
01327                                                                   DTSBX655
01328  S910-MSTR-IO.                                                    DTSBX655
01329      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX655
01330                            MSKL-REC.                              DTSBX655
01331  S910-EXIT.                                                       DTSBX655
01332      EXIT.                                                        DTSBX655
01333      SKIP3                                                        DTSBX655
01334  S921-OPEN-READ.                                                  DTSBX655
01335      SET L921-OPEN-READ-88 TO TRUE.                               DTSBX655
01336      GO TO S921-AIX-IO.                                           DTSBX655
01337                                                                   DTSBX655
01338  S921-START-BROWSE.                                               DTSBX655
01339      SET L921-START-BROWSE-88 TO TRUE.                            DTSBX655
01340      GO TO S921-AIX-IO.                                           DTSBX655
01341                                                                   DTSBX655
01342  S921-CLOSE.                                                      DTSBX655
01343      SET L921-CLOSE-88     TO TRUE.                               DTSBX655
01344      GO TO S921-AIX-IO.                                           DTSBX655
01345                                                                   DTSBX655
01346  S923-CLOSE.                                                         CL183
01347      SET L923-CLOSE-88 TO TRUE.                                      CL183
01348      GO TO S923-ATC-IO.                                              CL183
01349                                                                      CL183
01350  S923-ATC-IO.                                                        CL183
01351      CALL 'DTSBU923' USING L923-LINK-AREA                            CL183
01352                            ASKL-REC.                                 CL183
01353  S923-EXIT.                                                          CL183
01354      EXIT.                                                           CL183
01355      SKIP3                                                           CL183
01356  S921-AIX-IO.                                                     DTSBX655
01357      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX655
01358                            ISKL-REC.                              DTSBX655
01359  S921-EXIT.                                                       DTSBX655
01360      EXIT.                                                        DTSBX655
01361      SKIP3                                                        DTSBX655
01362                                                                   DTSBX655
01363  S923-OPEN-UPDATE.                                                   CL183
01364      SET L923-OPEN-UPDATE-88 TO TRUE.                                CL183
01365      GO TO S923-ATC-IO.                                              CL183
01366                                                                      CL183
01367      SKIP3                                                           CL183
01368  S927-OPEN-UPDATE.                                                   CL183
01369      SET L927-OPEN-UPDATE-88 TO TRUE.                                CL183
01370      GO TO S927-BTC-O.                                               CL183
01371                                                                      CL183
01372  S927-WRITE.                                                         CL183
01373      SET L927-WRITE-88 TO TRUE.                                      CL183
01374      GO TO S927-BTC-O.                                               CL183
01375                                                                      CL183
01376  S927-CLOSE.                                                         CL183
01377      SET L927-CLOSE-88 TO TRUE.                                      CL183
01378      GO TO S927-BTC-O.                                               CL183
01379                                                                      CL183
01380  S927-BTC-O.                                                         CL183
01381      CALL 'DTSBU927' USING L927-LINK-AREA                            CL183
01382                            TSKL-REC.                                 CL183
01383  S927-EXIT.                                                          CL183
01384      EXIT.                                                           CL183
01385                                                                      CL183
01386      SKIP3                                                           CL183
01387  S931-OPEN-READ.                                                  DTSBX655
01388      SET L931-OPEN-READ-88 TO TRUE.                               DTSBX655
01389      GO TO S931-REF-IO.                                           DTSBX655
01390                                                                   DTSBX655
01391  S931-OPEN-UPDATE.                                                DTSBX655
01392      SET L931-OPEN-UPDATE-88 TO TRUE.                             DTSBX655
01393      GO TO S931-REF-IO.                                           DTSBX655
01394                                                                   DTSBX655
01395  S931-START-BROWSE.                                               DTSBX655
01396      SET L931-START-BROWSE-88 TO TRUE.                            DTSBX655
01397      GO TO S931-REF-IO.                                           DTSBX655
01398                                                                   DTSBX655
01399  S931-READ.                                                       DTSBX655
01400      SET L931-READ-88 TO TRUE.                                    DTSBX655
01401      GO TO S931-REF-IO.                                           DTSBX655
01402                                                                   DTSBX655
01403  S931-READ-NEXT.                                                  DTSBX655
01404      SET L931-READ-NEXT-88 TO TRUE.                               DTSBX655
01405      GO TO S931-REF-IO.                                           DTSBX655
01406                                                                   DTSBX655
01407  S931-DELETE.                                                     DTSBX655
01408      SET L931-DELETE-88    TO TRUE.                               DTSBX655
01409      GO TO S931-REF-IO.                                           DTSBX655
01410                                                                   DTSBX655
01411  S931-REWRITE.                                                    DTSBX655
01412      SET L931-REWRITE-88   TO TRUE.                               DTSBX655
01413      GO TO S931-REF-IO.                                           DTSBX655
01414                                                                   DTSBX655
01415  S931-WRITE.                                                      DTSBX655
01416      SET L931-WRITE-88   TO TRUE.                                 DTSBX655
01417      GO TO S931-REF-IO.                                           DTSBX655
01418                                                                   DTSBX655
01419  S931-CLOSE.                                                      DTSBX655
01420      SET L931-CLOSE-88 TO TRUE.                                   DTSBX655
01421      GO TO S931-REF-IO.                                           DTSBX655
01422                                                                   DTSBX655
01423  S931-REF-IO.                                                     DTSBX655
01424      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBX655
01425                            FSKL-REC.                              DTSBX655
01426  S931-EXIT.                                                       DTSBX655
01427      EXIT.                                                        DTSBX655
01428      SKIP3                                                        DTSBX655
01429  S933-OPEN-READ.                                                  DTSBX655
01430      SET L933-OPEN-READ-88 TO TRUE.                               DTSBX655
01431      GO TO S933-SIC-I.                                            DTSBX655
01432                                                                   DTSBX655
01433  S933-CLOSE.                                                      DTSBX655
01434      SET L933-CLOSE-88 TO TRUE.                                   DTSBX655
01435      GO TO S933-SIC-I.                                            DTSBX655
01436                                                                   DTSBX655
01437  S933-SIC-I.                                                      DTSBX655
01438      CALL 'DTSBU933' USING L933-LINK-AREA                         DTSBX655
01439                            XSIC-REC.                              DTSBX655
01440  S933-EXIT.                                                       DTSBX655
01441      EXIT.                                                        DTSBX655
01442                                                                   DTSBX655
01443  S999-ABEND.                                                      DTSBX655
01444      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX655
01445  S999-EXIT.                                                       DTSBX655
01446      EXIT.                                                        DTSBX655
