00001  IDENTIFICATION DIVISION.                                         10/24/18
00002  PROGRAM-ID.             DESBD426.                                DESBD427
00003  AUTHOR.                 NGC.                                        LV040
00004  DATE-WRITTEN.           NOVEMBER 2013.                              CL**2
00005  DATE-COMPILED.                                                   DESBD427
00006                                                                   DESBD427
00007 ****                                                                 CL*38
00008 *                                                                 DESBD427
00009 *    FUNCTION:  UPDATE THE WAGE NAME VSAM FILE WITH FULL NAME        CL**2
00010 *               FROM ESSP DAILY WAGE FILE SUBMISSIONS.               CL*32
00011 *                                                                 DESBD427
00012 *                                                                 DESBD427
00013 *    MODIFICATION HISTORY:                                        DESBD427
00014 *                                                                 DESBD427
00015 *    05/16/2018  INITIAL DEVELOPMENT                                 CL*32
00016 *                REFERENCE:                     PROGRAMMER: ZL1      CL*32
00017 *                                                                 DESBD427
00018 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD427
00019 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD427
00020 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DESBD427
00021 *                                                                 DESBD427
00022 *    DESCRIPTION:                                                 DESBD427
00023 *                                                                 DESBD427
00024 *                                                                 DESBD427
00025 *    RECORDS READ:                                                DESBD427
00026 *       TDEC ONTINE AND DELINQUENT WAGE RECORDS                      CL**2
00027 *                                                                 DESBD427
00028 *    PRINTED OUTPUTS:                                             DESBD427
00029 *        NONE                                                     DESBD427
00030 *                                                                 DESBD427
00031 *    RECORDS WRITTEN:                                             DESBD427
00032 *       UPDATE WAGE NAME VSAM FILE                                   CL**2
00033 *                                                                 DESBD427
00034 *    MODULES CALLED:                                              DESBD427
00035 *         NONE                                                    DESBD427
00036 *                                                                 DESBD427
00037 *****                                                             DESBD427
00038                                                                   DESBD427
00039  ENVIRONMENT DIVISION.                                            DESBD427
00040      SKIP2                                                        DESBD427
00041  INPUT-OUTPUT SECTION.                                            DESBD427
00042      SKIP3                                                        DESBD427
00043  FILE-CONTROL.                                                    DESBD427
00044      SELECT ESSP-WAGE-IN     ASSIGN TO DTSFX144                      CL*32
00045             FILE STATUS IS TDEC-IN-STATUS.                        DESBD427
00046                                                                   DESBD427
00047      SELECT X146-WAGE-OUT    ASSIGN TO DTSFX146                      CL*14
00048             FILE STATUS IS TDEC-IN-STATUS.                           CL**8
00049                                                                      CL**8
00050                                                                   DESBD427
00051  DATA DIVISION.                                                   DESBD427
00052                                                                   DESBD427
00053  FILE SECTION.                                                    DESBD427
00054                                                                      CL*24
00055  FD  ESSP-WAGE-IN                                                    CL*32
00056      RECORDING MODE F                                                CL*24
00057      BLOCK CONTAINS 0 RECORDS                                        CL*24
00058      LABEL RECORDS ARE STANDARD.                                     CL*32
00059                                                                      CL*24
00060  01  ESSP-WAGE-REC                 PIC X(120).                       CL*39
00061                                                                      CL*24
00062  FD  X146-WAGE-OUT                                                   CL**8
00063      RECORDING MODE IS F                                             CL**8
00064      LABEL RECORDS ARE STANDARD                                      CL**8
00065      BLOCK CONTAINS 0 CHARACTERS.                                    CL**8
00066      SKIP1                                                           CL**8
00067  01  X146-REC                        PIC X(76).                      CL*15
00068                                                                      CL**8
00069                                                                   DESBD427
00070  WORKING-STORAGE SECTION.                                         DESBD427
000705 77  PAN-VALET PICTURE X(24) VALUE '040DESBD427  10/24/18'.       DESBD427
00071      SKIP3                                                        DESBD427
00072  01  W-AREA.                                                      DESBD427
00073      05  W-MOD-NAME                  PIC  X(08) VALUE 'DESBD427'.    CL*32
00074      05  W-TRACE-IND                 PIC  X(01) VALUE 'N'.        DESBD427
00075      05  WRK-ABEND-CD               PIC S9(04)  COMP  VALUE +427.    CL*32
00076                                                                   DESBD427
00077      05  W-START-BATCH               PIC S9(05) COMP-3            DESBD427
00078                                           VALUE +71937.           DESBD427
00079                                                                   DESBD427
00080      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.        DESBD427
00081          88 W-ERROR-YES-88             VALUE 'Y'.                 DESBD427
00082          88 W-ERROR-NO-88              VALUE 'N'.                 DESBD427
00083                                                                   DESBD427
00084      05  TDEC-IN-STATUS              PIC  X(02) VALUE SPACES.     DESBD427
00085          88  TDEC-IN-OK-88             VALUE '00'.                DESBD427
00086          88  TDEC-IN-EOF-88            VALUE '10'.                DESBD427
00087                                                                   DESBD427
00088      05  PENDING-STATUS              PIC  X(02) VALUE SPACES.     DESBD427
00089          88  PENDING-OK-88             VALUE '00'.                DESBD427
00090                                                                   DESBD427
00091      05  MISSING-RPT-STATUS          PIC  X(02) VALUE SPACES.     DESBD427
00092          88  MISSING-RPT-OK-88         VALUE '00'.                DESBD427
00093                                                                   DESBD427
00094      05  WAGE-ERROR-STATUS           PIC  X(02) VALUE SPACES.     DESBD427
00095          88  WAGE-ERROR-OK-88          VALUE '00'.                DESBD427
00096                                                                   DESBD427
00097      05  RECORD-COUNT-STATUS         PIC  X(02) VALUE SPACES.     DESBD427
00098          88  RECORD-COUNT-OK-88        VALUE '00'.                DESBD427
00099                                                                   DESBD427
00100      05  WAGE-X148-STATUS            PIC  X(02) VALUE SPACES.     DESBD427
00101          88  WAGE-X148-OK-88           VALUE '00'.                DESBD427
00102                                                                   DESBD427
00103                                                                   DESBD427
00104      05  WAGE-X153-STATUS           PIC  X(02).                   DESBD427
00105          88  WAGE-X153-FILE-OK-88        VALUE '00'.              DESBD427
00106          88  WAGE-X153-FILE-VERIFY-88    VALUE '97'.              DESBD427
00107                                                                   DESBD427
00108      05  WAGE-W001-STATUS            PIC  X(02) VALUE SPACES.     DESBD427
00109          88  WAGE-W001-OK-88           VALUE '00'.                DESBD427
00110                                                                   DESBD427
00111      05  WWG2-STATUS                 PIC  X(02) VALUE SPACES.     DESBD427
00112          88  WWG2-OK-88                VALUE '00'.                DESBD427
00113          88  WWG2-EOF-88               VALUE '10'.                DESBD427
00114                                                                   DESBD427
00115      05  WITM-STATUS                 PIC  X(02) VALUE SPACES.     DESBD427
00116          88  WITM-OK-88                VALUE '00'.                DESBD427
00117          88  WITM-EOF-88               VALUE '10'.                DESBD427
00118                                                                   DESBD427
00119      05  W-WAGE-REC-IND               PIC  X(01) VALUE 'N'.       DESBD427
00120          88  W-WAGE-REC-ERR-YES-88      VALUE 'Y'.                DESBD427
00121          88  W-WAGE-REC-ERR-NO-88       VALUE 'N'.                DESBD427
00122                                                                   DESBD427
00123      05  W-BATCH-ERR-IND              PIC  X(01) VALUE 'N'.       DESBD427
00124          88  W-BATCH-ERR-YES-88         VALUE 'Y'.                DESBD427
00125          88  W-BATCH-ERR-NO-88          VALUE 'N'.                DESBD427
00126                                                                   DESBD427
00127      05  W-EMP-NBR-CHNG-IND           PIC  X(01) VALUE 'N'.       DESBD427
00128          88  W-EMP-NBR-CHNG-YES-88      VALUE 'Y'.                DESBD427
00129          88  W-EMP-NBR-CHNG-NO-88       VALUE 'N'.                DESBD427
00130                                                                   DESBD427
00131      05  W-WAGE-ERR-IND               PIC  X(01) VALUE 'N'.       DESBD427
00132          88  W-WAGE-ERR-YES-88          VALUE 'Y'.                DESBD427
00133          88  W-WAGE-ERR-NO-88           VALUE 'N'.                DESBD427
00134                                                                   DESBD427
00135      05  W-WAGE-ON-FILE-IND           PIC  X(01) VALUE 'N'.       DESBD427
00136          88  W-WAGE-ON-FILE-YES-88      VALUE 'Y'.                DESBD427
00137          88  W-WAGE-ON-FILE-NO-88       VALUE 'N'.                DESBD427
00138                                                                   DESBD427
00139      05  W-EMP-FOUND-IND             PIC  X(01) VALUE 'N'.        DESBD427
00140          88 W-EMP-FOUND-YES-88         VALUE 'Y'.                 DESBD427
00141          88 W-EMP-FOUND-NO-88          VALUE 'N'.                 DESBD427
00142                                                                   DESBD427
00143      05  W-EMP-LIABLE-IND            PIC  X(01) VALUE 'N'.        DESBD427
00144          88 W-EMP-LIABLE-YES-88        VALUE 'Y'.                 DESBD427
00145          88 W-EMP-LIABLE-NO-88         VALUE 'N'.                 DESBD427
00146                                                                   DESBD427
00147      05  W-VALID-QTR-IND             PIC  X(01) VALUE 'N'.        DESBD427
00148          88 W-VALID-QTR-YES-88         VALUE 'Y'.                 DESBD427
00149          88 W-VALID-QTR-NO-88          VALUE 'N'.                 DESBD427
00150                                                                   DESBD427
00151      05  W-RPT-FOUND-IND              PIC  X(01) VALUE '0'.       DESBD427
00152          88 W-RPT-FOUND-NO-88           VALUE '0'.                DESBD427
00153          88 W-RPT-FOUND-MRPT-88         VALUE '1'.                DESBD427
00154          88 W-RPT-FOUND-ATC-88          VALUE '2'.                DESBD427
00155          88 W-RPT-FOUND-YES-88          VALUE '1' '2'.            DESBD427
00156                                                                   DESBD427
00157      05  W-SSN-ERR-IND                PIC  X(01) VALUE 'N'.       DESBD427
00158           88  W-SSN-ERR-YES-88           VALUE 'Y'.               DESBD427
00159           88  W-SSN-ERR-NO-88            VALUE 'N'.               DESBD427
00160                                                                      CL**8
00161      05  WRK-SLASH-QTR.                                              CL**8
00162          10  WRK-YEAR            PIC  9(04).                         CL**8
00163          10  FILLER              PIC  X(01).                         CL**8
00164          10  WRK-QTR             PIC  9(01).                         CL**8
00165                                                                   DESBD427
00166      05  WRK-SLASH-DATE.                                          DESBD427
00167          10  WRK-SLASH-MM        PIC  9(02).                      DESBD427
00168          10  WRK-SLASH-DD        PIC  9(02).                      DESBD427
00169          10  WRK-SLASH-YR        PIC  9(02).                      DESBD427
00170                                                                      CL*24
00171      05  WRK-EFF-DATE.                                               CL**8
00172          10  WRK-EFF-MM        PIC  9(02).                           CL**8
00173          10  FILLER              PIC  X(01)  VALUE '/'.              CL**8
00174          10  WRK-EFF-DD        PIC  9(02)    VALUE 01.               CL**8
00175          10  FILLER              PIC  X(01)  VALUE '/'.              CL**8
00176          10  WRK-EFF-YR        PIC  9(04)    VALUE ZEROS.            CL*34
00177                                                                   DESBD427
00178      05  WRK-PEND-DATE.                                           DESBD427
00179          10  WRK-PEND-MM         PIC  9(02).                      DESBD427
00180          10  WRK-PEND-DD         PIC  9(02).                      DESBD427
00181          10  WRK-PEND-YR         PIC  9(02).                      DESBD427
00182                                                                   DESBD427
00183      05  W-EMP-NO                PIC  9(06)           VALUE  0.   DESBD427
00184      05  WRK-WADD-CNT            PIC  9(05)           VALUE  0.      CL*20
00185      05  WRK-WUPD-CNT            PIC  9(05)           VALUE  0.      CL*20
00186      05  W-YRQ                   PIC  9(05)           VALUE  0.   DESBD427
00187      05  W-ANNUAL-YRQ            PIC  9(05)           VALUE  0.   DESBD427
00188      05  W-DEFAULT-YRQ           PIC  9(05)           VALUE  0.   DESBD427
00189      05  W-DEFAULT-QTR-DISP      PIC  X(06) VALUE SPACES.         DESBD427
00190      05  W-CURR-EMP              PIC  9(06)           VALUE  0.   DESBD427
00191      05  W-CURR-QTR              PIC  X(06)    VALUE SPACES.      DESBD427
00192      05  W-CURR-SSN              PIC  9(09)           VALUE  0.   DESBD427
00193      05  W-CURR-WAGES            PIC  9(08)V99        VALUE  0.   DESBD427
00194      05  W-SEQ-NO                PIC S9(07)    COMP-3 VALUE +0.   DESBD427
00195      05  W-RPT-EMP-NO            PIC S9(07)    COMP-3 VALUE +0.   DESBD427
00196      05  W-RPT-BATCH             PIC S9(05)    COMP-3 VALUE +0.   DESBD427
00197      05  W-RPT-ITEM              PIC S9(03)    COMP-3 VALUE +0.   DESBD427
00198      05  W-W4-TOT-WAGE           PIC S9(09)V99 COMP-3 VALUE +0.   DESBD427
00199      05  W-MRPT-TOT-WAGE         PIC S9(09)V99 COMP-3 VALUE +0.   DESBD427
00200      05  W-WGH-TOT-WAGE          PIC S9(09)V99 COMP-3 VALUE +0.   DESBD427
00201      05  W-SSN                   PIC S9(09) COMP-3    VALUE +0.      CL**7
00202      05  WRK-SSN                 PIC S9(09) COMP-3    VALUE +0.      CL**7
00203      05  W-MRPT-RESP-OPID        PIC  X(08).                      DESBD427
00204      05  W-MRPT-ESTB-DATE        PIC S9(09).                      DESBD427
00205      05  W-DIFF                  PIC S9(09)V99 COMP-3 VALUE +0.   DESBD427
00206      05  W-ESTB-DATE             PIC  X(10) VALUE SPACES.         DESBD427
00207      05  W-SLASH-QTR.                                                CL**8
00208          15  W-SLASH-Y           PIC  X(04) VALUE SPACES.            CL**8
00209          15  W-SLASH-F           PIC  X(01) VALUE '/'.               CL**8
00210          15  W-SLASH-Q           PIC  X(01) VALUE SPACES.            CL*12
00211      05  WRK-NAME.                                                   CL**8
00212          15  WRK-LNAME           PIC  X(20) VALUE SPACES.            CL**8
00213          15  WRK-FNAME           PIC  X(15) VALUE SPACES.            CL**8
00214          15  WRK-INAME           PIC  X(01) VALUE SPACES.            CL*13
00215                                                                   DESBD427
00216  01  WAGE-TRANS-AREA.                                             DESBD427
00217      05  ESP-TRANSACTION-AREA      PIC  X(80).                    DESBD427
00218  ++INCLUDE EWGTRNW4                                               DESBD427
00219          EJECT                                                    DESBD427
00220                                                                   DESBD427
00221      05  W-W001-REC.                                              DESBD427
00222  ++INCLUDE DTSIW001                                               DESBD427
00223                                                                   DESBD427
00224  01  WRK-X153-REC.                                                DESBD427
00225  ++INCLUDE DTSIX153                                               DESBD427
00226                                                                   DESBD427
00227      05  W-RPT1-FIRST-TIME       PIC  X(01) VALUE 'Y'.            DESBD427
00228          88  W-RPT1-FIRST-TIME-YES-88                             DESBD427
00229                                    VALUE 'Y'.                     DESBD427
00230          88  W-RPT1-FIRST-TIME-NO-88                              DESBD427
00231                                    VALUE 'N'.                     DESBD427
00232      05  W-MISSING-RPT-HDR.                                       DESBD427
00233          10  FILLER              PIC X(07) VALUE                  DESBD427
00234              'EMP;   '.                                           DESBD427
00235          10  FILLER              PIC X(07) VALUE                  DESBD427
00236              'BATCH#;'.                                           DESBD427
00237          10  FILLER              PIC X(07) VALUE                  DESBD427
00238              'QTR    '.                                           DESBD427
00239          10  FILLER              PIC X(06) VALUE                  DESBD427
00240              'ANN?; '.                                            DESBD427
00241          10  FILLER              PIC X(12) VALUE                  DESBD427
00242              'TOT WAGES;'.                                        DESBD427
00243          10  FILLER              PIC X(10) VALUE                  DESBD427
00244              'WAGE DATE;'.                                        DESBD427
00245          10  FILLER              PIC X(07) VALUE                  DESBD427
00246              'MESSAGE'.                                           DESBD427
00247                                                                   DESBD427
00248      05  W-MISSING-RPT-REC.                                       DESBD427
00249          10  MSRP-EMP            PIC 9(06).                       DESBD427
00250          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00251          10  MSRP-BATCH          PIC 9(05).                       DESBD427
00252          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00253          10  MSRP-QTR            PIC X(06).                       DESBD427
00254          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00255          10  MSRP-FILING-SCHED   PIC X(05).                       DESBD427
00256          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00257          10  MSRP-TOT-WAGE       PIC --------9.99.                DESBD427
00258          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00259          10  MSRP-DATE           PIC X(10).                       DESBD427
00260          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00261          10  MSRP-REASON         PIC X(40).                       DESBD427
00262              88  MSRP-RSN-NOT-FOUND-88      VALUE                 DESBD427
00263              'ACCOUNT NUMBER DOES NOT EXIST           '.          DESBD427
00264              88  MSRP-RSN-NOT-LIABLE-88     VALUE                 DESBD427
00265              'EMPLOYER NOT LIABLE                     '.          DESBD427
00266              88  MSRP-RSN-INVALID-QTR-88    VALUE                 DESBD427
00267              'INVALID QUARTER                         '.          DESBD427
00268              88  MSRP-RSN-RPT-NOT-FOUND-88  VALUE                 DESBD427
00269              'REPORT NOT FOUND                        '.          DESBD427
00270                                                                   DESBD427
00271      05  W-RPT2-FIRST-TIME       PIC  X(01) VALUE 'Y'.            DESBD427
00272          88  W-RPT2-FIRST-TIME-YES-88                             DESBD427
00273                                    VALUE 'Y'.                     DESBD427
00274          88  W-RPT2-FIRST-TIME-NO-88                              DESBD427
00275                                    VALUE 'N'.                     DESBD427
00276      05  W-WAGE-ERROR-HDR.                                        DESBD427
00277          10  FILLER              PIC X(09) VALUE                  DESBD427
00278              'EMPLOYER;'.                                         DESBD427
00279          10  FILLER              PIC X(09) VALUE                  DESBD427
00280              'BATCH#:  '.                                         DESBD427
00281          10  FILLER              PIC X(08) VALUE                  DESBD427
00282              'QUARTER;'.                                          DESBD427
00283          10  FILLER              PIC X(09) VALUE                  DESBD427
00284              'W4 WAGES;'.                                         DESBD427
00285          10  FILLER              PIC X(12) VALUE                  DESBD427
00286              'UC-30 WAGES;'.                                      DESBD427
00287          10  FILLER              PIC X(11) VALUE                  DESBD427
00288              'DIFFERENCE;'.                                       DESBD427
00289          10  FILLER              PIC X(13) VALUE                  DESBD427
00290              'WORKER COUNT;'.                                     DESBD427
00291          10  FILLER              PIC X(14) VALUE                  DESBD427
00292              'WAGES ON FILE;'.                                    DESBD427
00293          10  FILLER              PIC X(18) VALUE                  DESBD427
00294              'REPORT ENTERED DT;'.                                DESBD427
00295          10  FILLER              PIC X(17) VALUE                  DESBD427
00296              'WAGES ENTERED DT;'.                                 DESBD427
00297          10  FILLER              PIC X(10) VALUE                  DESBD427
00298              'RESP OPID;'.                                        DESBD427
00299      05  W-WAGE-ERROR-REC.                                        DESBD427
00300          10  WERR-EMP            PIC 9(06).                       DESBD427
00301          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00302          10  WERR-BATCH          PIC 9(05).                       DESBD427
00303          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00304          10  WERR-QTR            PIC X(06).                       DESBD427
00305          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00306          10  WERR-W4-WAGE        PIC --------9.99.                DESBD427
00307          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00308          10  WERR-MRPT-WAGE      PIC --------9.99.                DESBD427
00309          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00310          10  WERR-DIFFERENCE     PIC --------9.99.                DESBD427
00311          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00312          10  WERR-WORKER-CNT     PIC 9(07).                       DESBD427
00313          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00314          10  WERR-WGH-WAGE       PIC --------9.99.                DESBD427
00315          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00316          10  WERR-RPT-DATE       PIC X(10).                       DESBD427
00317          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00318          10  WERR-WAGE-DATE      PIC X(10).                       DESBD427
00319          10  FILLER              PIC X(01) VALUE ';'.             DESBD427
00320          10  WERR-RESP-OPID      PIC X(08).                       DESBD427
00321                                                                   DESBD427
00322      05  W-RECORD-COUNT-REC.                                      DESBD427
00323          10  WC-REC-IN.                                           DESBD427
00324              15  FILLER              PIC X(30) VALUE              DESBD427
00325              'INPUT RECORDS:               '.                     DESBD427
00326              15  WC-REC-IN-CNT       PIC 9(07).                   DESBD427
00327          10  WC-TOT-RPTS.                                         DESBD427
00328              15  FILLER              PIC X(30) VALUE              DESBD427
00329              'TOTAL REPORTS:               '.                     DESBD427
00330              15  WC-TOT-RPTS-CNT     PIC 9(07).                   DESBD427
00331          10  WC-RPTS-FOUND.                                       DESBD427
00332              15  FILLER              PIC X(30) VALUE              DESBD427
00333              'REPORTS FOUND:               '.                     DESBD427
00334              15  WC-RPTS-FOUND-CNT   PIC 9(07).                   DESBD427
00335          10  WC-MRPT-FOUND.                                       DESBD427
00336              15  FILLER              PIC X(30) VALUE              DESBD427
00337              'REPORTS POSTED:              '.                     DESBD427
00338              15  WC-MRPT-FOUND-CNT   PIC 9(07).                   DESBD427
00339          10  WC-ATC-FOUND.                                        DESBD427
00340              15  FILLER              PIC X(30) VALUE              DESBD427
00341              'REPORTS FOUND IN ATC          '.                    DESBD427
00342              15  WC-ATC-FOUND-CNT    PIC 9(07).                   DESBD427
00343          10  WC-RPT-MISSING.                                      DESBD427
00344              15  FILLER              PIC X(30) VALUE              DESBD427
00345              'TOTAL REPORTS MISSING         '.                    DESBD427
00346              15  WC-RPT-MISSING-CNT  PIC 9(07).                   DESBD427
00347          10  WC-EMP-CHANGED.                                      DESBD427
00348              15  FILLER              PIC X(30) VALUE              DESBD427
00349              'EMPLOYER NBR CHANGED          '.                    DESBD427
00350              15  WC-EMP-CHANGED-CNT  PIC 9(07).                   DESBD427
00351          10  WC-NOT-LIABLE.                                       DESBD427
00352              15  FILLER              PIC X(30) VALUE              DESBD427
00353              'EMPLOYER NOT LIABLE           '.                    DESBD427
00354              15  WC-NOT-LIABLE-CNT   PIC 9(07).                   DESBD427
00355          10  WC-NO-EMP.                                           DESBD427
00356              15  FILLER              PIC X(30) VALUE              DESBD427
00357              'EMPLOYER NBR NOT FOUND        '.                    DESBD427
00358              15  WC-NO-EMP-CNT       PIC 9(07).                   DESBD427
00359          10  WC-INVALID-QTR.                                      DESBD427
00360              15  FILLER              PIC X(30) VALUE              DESBD427
00361              'INVALID QUARTER               '.                    DESBD427
00362              15  WC-INVALID-QTR-CNT  PIC 9(07).                   DESBD427
00363          10  WC-WAGE-DIFF.                                        DESBD427
00364              15  FILLER              PIC X(30) VALUE              DESBD427
00365              'WAGE DISCREPANCIES            '.                    DESBD427
00366              15  WC-WAGE-DIFF-CNT    PIC 9(07).                   DESBD427
00367          10  WC-DUP-SSN.                                          DESBD427
00368              15  FILLER              PIC X(30) VALUE              DESBD427
00369              'DUPLICATE SSNS                '.                    DESBD427
00370              15  WC-DUP-SSN-CNT      PIC 9(07).                   DESBD427
00371          10  WC-X148.                                             DESBD427
00372              15  FILLER              PIC X(30) VALUE              DESBD427
00373              'WAGE RECORDS WRITTEN          '.                    DESBD427
00374              15  WC-X148-CNT         PIC 9(07).                   DESBD427
00375                                                                   DESBD427
00376      05  WRK-ABSTIME             PIC S9(15)  COMP-3.              DESBD427
00377      05  W-TDEC-IN-CNT           PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00378      05  W-X148-CNT              PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00379      05  W-X153-CNT              PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00380      05  W-W001-CNT              PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00381      05  W-REPORT-CNT            PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00382      05  W-WORKER-CNT            PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00383      05  W-FOUND-IN-ATC-CNT      PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00384      05  W-EMP-IN-ATC-CNT        PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00385      05  W-MRPT-FOUND-CNT        PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00386      05  W-RPT-FOUND-CNT         PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00387      05  W-RPT-MISSING-CNT       PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00388      05  W-EMP-NBR-CHNG-CNT      PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00389      05  W-PAY-FOUND-CNT         PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00390      05  W-EMP-MISSING-CNT       PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00391      05  W-NOT-LIABLE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00392      05  W-MISS-RPT-ERR-CNT      PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00393      05  W-DUP-SSN-CNT           PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00394      05  W-WAGE-MISMATCH-CNT     PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00395      05  W-INVALID-QTR-CNT       PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00396      05  W-PENDING-CNT           PIC S9(07)  COMP-3 VALUE +0.     DESBD427
00397                                                                   DESBD427
00398      05  WRK-QTR.                                                    CL*32
00399          10  WRK-QTRYR               PIC  9(04) VALUE ZEROS.         CL*32
00400          10  WRK-QTRYQ               PIC  9(01) VALUE ZEROS.         CL*32
00401                                                                      CL*32
00402      05  AMT-DISP1               PIC ----------9.99.              DESBD427
00403      05  AMT-DISP2               PIC ----------9.99.              DESBD427
00404      05  AMT-DISP3               PIC ----------9.99.              DESBD427
00405      05  AMT-DISP4               PIC ----------9.99.              DESBD427
00406                                                                   DESBD427
00407                                                                   DESBD427
00408  01  L001-LINK-AREA.                                              DESBD427
00409  ++INCLUDE DTSIL001                                               DESBD427
00410                                                                   DESBD427
00411  01  L004-LINK-AREA.                                              DESBD427
00412  ++INCLUDE DTSIL004                                               DESBD427
00413                                                                   DESBD427
00414  01  L005-LINK-AREA.                                              DESBD427
00415  ++INCLUDE DTSIL005                                               DESBD427
00416                                                                   DESBD427
00417  01  L516-LINK-AREA.                                              DESBD427
00418  ++INCLUDE DTSIL516                                               DESBD427
00419                                                                   DESBD427
00420  01  L910-LINK-AREA.                                              DESBD427
00421  ++INCLUDE DTSIL910                                               DESBD427
00422                                                                   DESBD427
00423  01  L982-LINK-AREA.                                              DESBD427
00424  ++INCLUDE DTSIL982                                               DESBD427
00425                                                                   DESBD427
00426  01  X146-WEB-REC.                                                   CL*10
00427  ++INCLUDE DTSIX146                                                  CL*10
00428                                                                      CL*10
00429  01  X144-WEB-REC.                                                   CL*10
00430          15  X144-REC-TYPE              PIC  X(03) VALUE '144'.      CL*19
00431          15  FILLER                     PIC  X(01) VALUE ','.        CL*19
00432          15  X144-EMP-NO                PIC  9(06).                  CL*19
00433          15  FILLER                     PIC  X(01) VALUE ','.        CL*19
00434          15  X144-QUARTER.                                           CL*36
00435            20  X144-QTRYR               PIC  9(04).                  CL*32
00436            20  FILLER                   PIC  X(01).                  CL*35
00437            20  X144-QTRYQ               PIC  9(01).                  CL*32
00438          15  FILLER                     PIC  X(01) VALUE ','.        CL*32
00439          15  X144-AMEND                 PIC  9(08).                  CL*19
00440          15  FILLER                     PIC  X(01) VALUE ','.        CL*19
00441          15  X144-SSN                   PIC  9(09).                  CL*19
00442          15  FILLER                     PIC  X(01) VALUE ','.        CL*19
00443          15  X144-LAST-NAME             PIC  X(20).                  CL*19
00444          15  FILLER                     PIC  X(10).                  CL*19
00445          15  FILLER                     PIC  X(01) VALUE ','.        CL*19
00446          15  X144-FIRST-NAME            PIC  X(15).                  CL*19
00447          15  FILLER                     PIC  X(15).                  CL*19
00448          15  FILLER                     PIC  X(01) VALUE ','.        CL*19
00449          15  X144-MID-INIT              PIC  X(01).                  CL*19
00450          15  FILLER                     PIC  X(01) VALUE ','.        CL*19
00451          15  X144-EARNINGS              PIC  ---------9.99.          CL*19
00452          15  FILLER                     PIC  X(01) VALUE ','.        CL*19
00453          15  FILLER                     PIC  X(432).                 CL*19
00454                                                                      CL*10
00455  01  MSKL-REC.                                                    DESBD427
00456  ++INCLUDE DTSIMSKL                                               DESBD427
00457                                                                   DESBD427
00458  01  MHDR-REC.                                                    DESBD427
00459  ++INCLUDE DTSIMHDR                                               DESBD427
00460                                                                   DESBD427
00461  01  MPRF-REC.                                                    DESBD427
00462  ++INCLUDE DTSIMPRF                                               DESBD427
00463                                                                   DESBD427
00464  01  MRPT-REC.                                                    DESBD427
00465  ++INCLUDE DTSIMRPT                                               DESBD427
00466                                                                   DESBD427
00467  01  MPAY-REC.                                                    DESBD427
00468  ++INCLUDE DTSIMPAY                                               DESBD427
00469                                                                   DESBD427
00470  01  L923-LINK-AREA.                                              DESBD427
00471  ++INCLUDE DTSIL923                                               DESBD427
00472                                                                   DESBD427
00473  01  L009-LINK-AREA.                                                 CL*21
00474  ++INCLUDE DTSIL009                                                  CL*21
00475                                                                      CL*21
00476  01  ASKL-REC.                                                    DESBD427
00477  ++INCLUDE DTSIASKL                                               DESBD427
00478                                                                   DESBD427
00479  01  AHDR-REC.                                                    DESBD427
00480  ++INCLUDE DTSIAHDR                                               DESBD427
00481                                                                   DESBD427
00482  01  ARPT-REC.                                                    DESBD427
00483  ++INCLUDE DTSIARPT                                               DESBD427
00484      EJECT                                                        DESBD427
00485  01  AATX-REC.                                                    DESBD427
00486  ++INCLUDE DTSIAATX                                               DESBD427
00487                                                                   DESBD427
00488  01  APAY-REC.                                                    DESBD427
00489  ++INCLUDE DTSIAPAY                                               DESBD427
00490                                                                   DESBD427
00491  01  L931-LINK-AREA.                                              DESBD427
00492  ++INCLUDE DTSIL931                                               DESBD427
00493                                                                   DESBD427
00494  01  FSKL-REC.                                                    DESBD427
00495  ++INCLUDE DTSIFSKL                                               DESBD427
00496                                                                   DESBD427
00497  01  L981-LINK-AREA.                                              DESBD427
00498  ++INCLUDE DTSIL981                                               DESBD427
00499      SKIP3                                                        DESBD427
00500  01  WWGH-REC.                                                    DESBD427
00501  ++INCLUDE DTSIWWGH                                               DESBD427
00502                                                                   DESBD427
00503  01  WNAM-REC.                                                    DESBD427
00504  ++INCLUDE DTSIWNAM                                               DESBD427
00505                                                                   DESBD427
00506  PROCEDURE DIVISION.                                              DESBD427
00507                                                                   DESBD427
00508  DESBD422-MAIN.                                                   DESBD427
00509      PERFORM I0000-INIT         THRU I0000-EXIT.                  DESBD427
00510      IF W-ERROR-YES-88                                            DESBD427
00511         GO TO DESBD422-MAIN-EXIT.                                 DESBD427
00512                                                                   DESBD427
00513      PERFORM P0000-PROCESS    THRU P0000-EXIT.                    DESBD427
00514                                                                   DESBD427
00515      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DESBD427
00516                                                                   DESBD427
00517  DESBD422-MAIN-EXIT.                                              DESBD427
00518      GOBACK.                                                      DESBD427
00519                                                                   DESBD427
00520  I0000-INIT.                                                      DESBD427
00521      PERFORM I2000-OPEN-FILES               THRU I2000-EXIT.      DESBD427
00522                                                                   DESBD427
00523      PERFORM S005-FROM-SYS                  THRU S005-EXIT.       DESBD427
00524      MOVE L005-SLASH-8-DATE                 TO X146-PROCESS-DATE.    CL**8
00525      MOVE L005-DATE                         TO L004-DATE.         DESBD427
00526      PERFORM S004-FROM-DATE                 THRU S004-EXIT.       DESBD427
00527      SUBTRACT 1                             FROM L004-ABS-QTR.    DESBD427
00528      PERFORM S004-FROM-ABS                  THRU S004-EXIT.       DESBD427
00529      MOVE L004-QTR-5-9                      TO W-DEFAULT-YRQ.     DESBD427
00530      MOVE L004-SLASH-5-QTR                  TO W-DEFAULT-QTR-DISP.DESBD427
00531      DISPLAY 'DEFAULT QTR: ' W-DEFAULT-YRQ                        DESBD427
00532         '  ' W-DEFAULT-QTR-DISP.                                  DESBD427
00533                                                                   DESBD427
00534  I0000-EXIT.                                                      DESBD427
00535      EXIT.                                                        DESBD427
00536                                                                   DESBD427
00537  I2000-OPEN-FILES.                                                DESBD427
00538      PERFORM S1000-OPEN-TDEC-IN             THRU S1000-EXIT.      DESBD427
00539      IF W-ERROR-YES-88                                            DESBD427
00540         GO TO I2000-EXIT                                          DESBD427
00541      END-IF.                                                      DESBD427
00542                                                                   DESBD427
00543                                                                   DESBD427
00544      PERFORM S982O-OPEN-UPDATE              THRU S982O-EXIT.         CL**2
00545      IF NOT L982-OK-88                                               CL*16
00546         DISPLAY 'NAME FILE CANT OPEN'.                               CL*16
00547  I2000-EXIT.                                                      DESBD427
00548      EXIT.                                                        DESBD427
00549                                                                   DESBD427
00550  P0000-PROCESS.                                                   DESBD427
00551      PERFORM S1010-READ-TDEC-IN             THRU S1010-EXIT.      DESBD427
00552      IF TDEC-IN-EOF-88                                            DESBD427
00553         DISPLAY 'INPUT FILE IS EMPTY'                             DESBD427
00554         GO TO P0000-EXIT                                          DESBD427
00555      END-IF.                                                      DESBD427
00556                                                                   DESBD427
00557      PERFORM UNTIL TDEC-IN-EOF-88                                 DESBD427
00558         PERFORM P3100-UPDATE-NAME           THRU P3100-EXIT          CL**2
00559         PERFORM S1010-READ-TDEC-IN          THRU S1010-EXIT       DESBD427
00560      END-PERFORM.                                                 DESBD427
00561                                                                   DESBD427
00562                                                                   DESBD427
00563  P0000-EXIT.                                                      DESBD427
00564      EXIT.                                                        DESBD427
00565                                                                   DESBD427
00566                                                                   DESBD427
00567  P3100-UPDATE-NAME.                                               DESBD427
00568                                                                   DESBD427
00569 *    DISPLAY 'CHECK NAME ' X154-SSN '  ' X154-LAST-NAME.             CL**4
00570      MOVE SPACES                       TO WRK-NAME.                  CL**8
00571      MOVE LOW-VALUE                    TO WNAM-REC.               DESBD427
00572      MOVE X144-SSN                      TO WNAM-SSN WRK-SSN.         CL*32
00573      MOVE X144-LAST-NAME               TO WRK-LNAME.                 CL*32
00574      MOVE X144-FIRST-NAME              TO WRK-FNAME.                 CL*32
00575      MOVE X144-MID-INIT                TO WRK-INAME.                 CL*32
00576      MOVE X144-QTRYR                   TO WRK-EFF-YR.                CL*34
00577                                                                      CL*34
00578       IF X144-QTRYQ =  1   MOVE 01 TO WRK-EFF-MM ELSE                CL*34
00579       IF X144-QTRYQ =  2   MOVE 04 TO WRK-EFF-MM ELSE                CL*34
00580       IF X144-QTRYQ =  3   MOVE 07 TO WRK-EFF-MM ELSE                CL*34
00581       IF X144-QTRYQ =  4   MOVE 10 TO WRK-EFF-MM ELSE                CL*34
00582          MOVE 01 TO WRK-EFF-MM.                                      CL*34
00583                                                                      CL*34
00584      MOVE L005-SLASH-8-DATE            TO X146-PROCESS-DATE.         CL**9
00585      MOVE WRK-EFF-DATE                 TO X146-EFF-DATE.             CL*34
00586                                                                      CL**9
00587      IF  X144-LAST-NAME > SPACES                                     CL*32
00588         MOVE X144-LAST-NAME    TO L009-DATA                          CL*32
00589         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*20
00590         MOVE L009-DATA        TO WRK-LNAME X144-LAST-NAME            CL*32
00591      ELSE                                                            CL*20
00592        MOVE X144-LAST-NAME       TO WRK-LNAME.                       CL*32
00593                                                                      CL**9
00594      IF  X144-FIRST-NAME > SPACES                                    CL*32
00595         MOVE X144-FIRST-NAME       TO L009-DATA                      CL*32
00596         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*20
00597         MOVE L009-DATA        TO WRK-FNAME X144-FIRST-NAME           CL*32
00598      ELSE                                                            CL*20
00599        MOVE X144-FIRST-NAME      TO WRK-FNAME.                       CL*32
00600                                                                      CL*20
00601      IF  X144-MID-INIT  > SPACES                                     CL*32
00602         MOVE X144-MID-INIT        TO L009-DATA                       CL*32
00603         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*20
00604         MOVE L009-DATA        TO WRK-INAME X144-MID-INIT             CL*32
00605      ELSE                                                            CL*20
00606        MOVE X144-MID-INIT              TO WRK-INAME.                 CL*32
00607                                                                      CL*20
00608                                                                   DESBD427
00609      PERFORM S982A-START-BROWSE        THRU S982A-EXIT.           DESBD427
00610                                                                   DESBD427
00611      IF NOT L982-OK-88                                            DESBD427
00612        DISPLAY 'BROWSE NOT OK-ADD NAME'                              CL**4
00613        PERFORM P3110-ADD-NAME         THRU P3110-EXIT             DESBD427
00614        GO TO P3100-EXIT                                           DESBD427
00615      END-IF.                                                      DESBD427
00616                                                                   DESBD427
00617      MOVE WNAM-SSN  TO W-SSN.                                     DESBD427
00618                                                                   DESBD427
00619      IF WRK-SSN = W-SSN                                              CL**7
00620         NEXT SENTENCE                                             DESBD427
00621      ELSE                                                         DESBD427
00622        DISPLAY 'SSN NOT ON FILE ADD ' X144-SSN                       CL*23
00623        PERFORM P3110-ADD-NAME         THRU P3110-EXIT             DESBD427
00624        GO TO P3100-EXIT.                                          DESBD427
00625                                                                   DESBD427
00626      IF WNAM-FIRST-NAME = WRK-FNAME AND                              CL*39
00627         WNAM-LAST-NAME = WRK-LNAME                                   CL*39
00628         GO TO P3100-EXIT                                             CL*39
00629      END-IF.                                                         CL*39
00630                                                                   DESBD427
00631 *    IF WNAM-TYPE-3CHAR-88                                           CL*28
00632        PERFORM P3120-REWRITE-NAME  THRU P3120-EXIT.                  CL*28
00633 *    ELSE                                                            CL*28
00634 *      DISPLAY 'WNAM ' WNAM-SSN ' ' WNAM-NAME-TYPE ' ' WNAM-NAME     CL*28
00635 *      DISPLAY ' DCG ' DCG-SSN ' ' WNAM-NAME-TYPE ' ' DCG-NAME       CL*28
00636 *    END-IF.                                                         CL*28
00637                                                                   DESBD427
00638  P3100-EXIT.                                                      DESBD427
00639      EXIT.                                                        DESBD427
00640  P3110-ADD-NAME.                                                  DESBD427
00641 *                                                                 DESBD427
00642 *    DISPLAY 'ADD NAME P3110 ' W001-LAST-NAME.                       CL**8
00643 *                                                                 DESBD427
00644      PERFORM S005-FROM-SYS      THRU S005-EXIT.                   DESBD427
00645      ADD +1                     TO L005-ABSTIME.                  DESBD427
00646      PERFORM S005-ABSTIME       THRU S005-EXIT.                   DESBD427
00647      MOVE L005-NINES-COMPLEMENT-ABSTIME                           DESBD427
00648                                TO WNAM-NINES-COMPLEMENT-ABSTIME.  DESBD427
00649      MOVE X144-SSN                  TO WNAM-SSN.                     CL*32
00650      MOVE X144-LAST-NAME            TO WNAM-LAST-NAME.               CL*32
00651      MOVE X144-FIRST-NAME           TO WNAM-FIRST-NAME.              CL*32
00652      MOVE X144-MID-INIT             TO WNAM-MID-INIT.                CL*32
00653      SET  WNAM-TYPE-FULL-88     TO TRUE.                          DESBD427
00654      PERFORM S982C-WRITE        THRU S982C-EXIT.                  DESBD427
00655      DISPLAY 'REC ADDED: ' X144-SSN ' ' WNAM-LAST-NAME ' '           CL*40
00656                            WNAM-FIRST-NAME.                          CL*40
00657      ADD +1                     TO WRK-WADD-CNT.                     CL*20
00658 *&                                                                   CL**9
00659      MOVE X144-SSN              TO X146-SSN                          CL*32
00660      INSPECT X144-LAST-NAME                                          CL*32
00661             REPLACING ALL ',' BY ' '.                                CL*30
00662      INSPECT X144-FIRST-NAME                                         CL*32
00663             REPLACING ALL ',' BY ' '.                                CL*30
00664      MOVE X144-LAST-NAME       TO X146-LAST-NAME.                    CL*32
00665      MOVE X144-FIRST-NAME      TO X146-FIRST-NAME.                   CL*32
00666      MOVE X144-MID-INIT        TO X146-MID-INIT.                     CL*32
00667      SET  X146-INSERT-88        TO TRUE.                             CL*10
00668      WRITE X146-REC             FROM X146-WEB-REC.                   CL*13
00669                                                                   DESBD427
00670  P3110-EXIT.                                                      DESBD427
00671      EXIT.                                                        DESBD427
00672                                                                   DESBD427
00673  P3120-REWRITE-NAME.                                              DESBD427
00674 *&                                                                DESBD427
00675 *    DISPLAY 'UPD NAME P3120 ' W001-LAST-NAME.                       CL*20
00676 *&                                                                DESBD427
00677      MOVE X144-LAST-NAME        TO WNAM-LAST-NAME.                   CL*32
00678      MOVE X144-FIRST-NAME       TO WNAM-FIRST-NAME.                  CL*32
00679      MOVE X144-MID-INIT         TO WNAM-MID-INIT.                    CL*32
00680      SET  WNAM-TYPE-FULL-88     TO TRUE.                          DESBD427
00681                                                                   DESBD427
00682      PERFORM S982D-REWRITE      THRU S982D-EXIT.                  DESBD427
00683                                                                   DESBD427
00684      DISPLAY ' REC UPDT  ' X144-SSN ' ' X144-LAST-NAME ' '           CL*32
00685               X144-FIRST-NAME.                                       CL*32
00686      ADD +1                     TO WRK-WUPD-CNT.                     CL*20
00687 *&                                                                   CL**8
00688      MOVE X144-SSN              TO X146-SSN                          CL*32
00689      INSPECT X144-LAST-NAME                                          CL*32
00690             REPLACING ALL ',' BY ' '.                                CL*30
00691      INSPECT X144-FIRST-NAME                                         CL*32
00692             REPLACING ALL ',' BY ' '.                                CL*30
00693      MOVE X144-LAST-NAME       TO X146-LAST-NAME.                    CL*32
00694      MOVE X144-FIRST-NAME      TO X146-FIRST-NAME.                   CL*32
00695      MOVE X144-MID-INIT        TO X146-MID-INIT.                     CL*32
00696      SET  X146-UPDATE-88       TO TRUE.                              CL*26
00697      WRITE X146-REC             FROM X146-WEB-REC.                   CL*13
00698                                                                   DESBD427
00699  P3120-EXIT.                                                      DESBD427
00700      EXIT.                                                        DESBD427
00701                                                                   DESBD427
00702                                                                   DESBD427
00703  T0000-TERMINATE.                                                 DESBD427
00704                                                                   DESBD427
00705      DISPLAY ' '.                                                 DESBD427
00706      DISPLAY ' '.                                                 DESBD427
00707                                                                   DESBD427
00708      DISPLAY '*** DESBD427 TERMINATION STATISTICS ***'.              CL*32
00709                                                                   DESBD427
00710      DISPLAY '  '.                                                DESBD427
00711                                                                   DESBD427
00712      DISPLAY '  '.                                                DESBD427
00713      DISPLAY 'ESSP RECORDS READ                                : '   CL*32
00714              W-TDEC-IN-CNT.                                       DESBD427
00715                                                                   DESBD427
00716      DISPLAY '  '.                                                DESBD427
00717      DISPLAY 'TOTAL NAMES ADDED                                : '   CL**2
00718              WRK-WADD-CNT.                                           CL*20
00719                                                                   DESBD427
00720      DISPLAY '  '.                                                DESBD427
00721      DISPLAY 'TOTAL NAMES UPDATED                              : '   CL**2
00722              WRK-WUPD-CNT.                                           CL*20
00723                                                                   DESBD427
00724                                                                   DESBD427
00725      PERFORM S1020-CLOSE-TDEC-IN       THRU S1020-EXIT.           DESBD427
00726                                                                   DESBD427
00727      PERFORM S982F-CLOSE               THRU S982F-EXIT.              CL**2
00728                                                                   DESBD427
00729  T0000-EXIT.                                                      DESBD427
00730      EXIT.                                                        DESBD427
00731                                                                   DESBD427
00732  S001-FROM-FED-8.                                                 DESBD427
00733      SET L001-FROM-FED-8 TO TRUE.                                 DESBD427
00734      GO TO S001-DATE.                                             DESBD427
00735                                                                   DESBD427
00736  S001-FROM-CAL-8.                                                 DESBD427
00737      SET L001-FROM-CAL-8 TO TRUE.                                 DESBD427
00738      GO TO S001-DATE.                                             DESBD427
00739                                                                   DESBD427
00740  S001-FROM-ABS-DAY.                                               DESBD427
00741      SET L001-FROM-ABS-DAY TO TRUE.                               DESBD427
00742      GO TO S001-DATE.                                             DESBD427
00743                                                                   DESBD427
00744  S001-DATE.                                                       DESBD427
00745      CALL 'DTSBU001' USING L001-LINK-AREA.                        DESBD427
00746  S001-EXIT.                                                       DESBD427
00747      EXIT.                                                        DESBD427
00748                                                                   DESBD427
00749  S004-FROM-DATE.                                                  DESBD427
00750      SET L004-FROM-DATE TO TRUE.                                  DESBD427
00751      GO TO S004-QTR.                                              DESBD427
00752                                                                   DESBD427
00753  S004-FROM-5.                                                     DESBD427
00754      SET L004-FROM-5 TO TRUE.                                     DESBD427
00755      GO TO S004-QTR.                                              DESBD427
00756                                                                   DESBD427
00757  S004-FROM-ABS.                                                   DESBD427
00758      SET L004-FROM-ABS TO TRUE.                                   DESBD427
00759      GO TO S004-QTR.                                              DESBD427
00760                                                                   DESBD427
00761  S004-FROM-3.                                                     DESBD427
00762      SET L004-FROM-3 TO TRUE.                                     DESBD427
00763      GO TO S004-QTR.                                              DESBD427
00764                                                                   DESBD427
00765  S004-QTR.                                                        DESBD427
00766      CALL 'DTSBU004' USING L004-LINK-AREA.                        DESBD427
00767  S004-EXIT.                                                       DESBD427
00768                                                                   DESBD427
00769  S005-FROM-SYS.                                                   DESBD427
00770      SET L005-FROM-SYS       TO TRUE.                             DESBD427
00771      GO TO S005-ABSTIME.                                          DESBD427
00772                                                                   DESBD427
00773  S005-ABSTIME.                                                    DESBD427
00774      CALL 'DTSBU005' USING L005-LINK-AREA.                        DESBD427
00775  S005-EXIT.                                                       DESBD427
00776      EXIT.                                                        DESBD427
00777                                                                   DESBD427
00778  S516-LIABILITY-INFO.                                             DESBD427
00779      CALL 'DTSBU516' USING L516-LINK-AREA                         DESBD427
00780                            MPRF-REC.                              DESBD427
00781  S516-EXIT.                                                       DESBD427
00782      EXIT.                                                        DESBD427
00783                                                                   DESBD427
00784  S910A-OPEN-READ.                                                 DESBD427
00785      SET L910-OPEN-READ-88 TO TRUE.                               DESBD427
00786      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD427
00787                                                                   DESBD427
00788  S910A-EXIT.                                                      DESBD427
00789      EXIT.                                                        DESBD427
00790                                                                   DESBD427
00791  S910C-CLOSE.                                                     DESBD427
00792      SET L910-CLOSE-88 TO TRUE.                                   DESBD427
00793      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD427
00794                                                                   DESBD427
00795  S910C-EXIT.                                                      DESBD427
00796      EXIT.                                                        DESBD427
00797                                                                   DESBD427
00798  S910D-START-BROWSE.                                              DESBD427
00799      SET L910-START-BROWSE-88 TO TRUE.                            DESBD427
00800      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD427
00801                                                                   DESBD427
00802  S910D-EXIT.                                                      DESBD427
00803      EXIT.                                                        DESBD427
00804                                                                   DESBD427
00805  S910E-READ-NEXT.                                                 DESBD427
00806      SET L910-READ-NEXT-88 TO TRUE.                               DESBD427
00807      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD427
00808                                                                   DESBD427
00809  S910E-EXIT.                                                      DESBD427
00810      EXIT.                                                        DESBD427
00811                                                                   DESBD427
00812  S910F-READ.                                                      DESBD427
00813      SET L910-READ-88      TO TRUE.                               DESBD427
00814      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD427
00815                                                                   DESBD427
00816  S910F-EXIT.                                                      DESBD427
00817      EXIT.                                                        DESBD427
00818                                                                   DESBD427
00819  S910Z-MSTR-I.                                                    DESBD427
00820      CALL 'DTSBU910' USING L910-LINK-AREA                         DESBD427
00821                            MSKL-REC.                              DESBD427
00822  S910Z-EXIT.                                                      DESBD427
00823      EXIT.                                                        DESBD427
00824                                                                   DESBD427
00825  S923A-OPEN-READ.                                                 DESBD427
00826      SET L923-OPEN-READ-88     TO TRUE.                           DESBD427
00827      PERFORM  S923Z-ATC-IO     THRU S923Z-EXIT.                   DESBD427
00828                                                                   DESBD427
00829  S923A-EXIT.                                                      DESBD427
00830      EXIT.                                                        DESBD427
00831                                                                   DESBD427
00832  S923B-START-BROWSE.                                              DESBD427
00833      SET L923-START-BROWSE-88  TO TRUE.                           DESBD427
00834      PERFORM  S923Z-ATC-IO     THRU S923Z-EXIT.                   DESBD427
00835                                                                   DESBD427
00836  S923B-EXIT.                                                      DESBD427
00837      EXIT.                                                        DESBD427
00838                                                                   DESBD427
00839  S923C-READ-NEXT.                                                 DESBD427
00840      SET L923-READ-NEXT-88     TO TRUE.                           DESBD427
00841      PERFORM  S923Z-ATC-IO     THRU S923Z-EXIT.                   DESBD427
00842                                                                   DESBD427
00843  S923C-EXIT.                                                      DESBD427
00844      EXIT.                                                        DESBD427
00845                                                                   DESBD427
00846  S923D-READ.                                                      DESBD427
00847      SET L923-READ-88          TO TRUE.                           DESBD427
00848      PERFORM  S923Z-ATC-IO     THRU S923Z-EXIT.                   DESBD427
00849                                                                   DESBD427
00850  S923D-EXIT.                                                      DESBD427
00851      EXIT.                                                        DESBD427
00852                                                                   DESBD427
00853  S923E-CLOSE.                                                     DESBD427
00854      SET L923-CLOSE-88         TO TRUE.                           DESBD427
00855      PERFORM  S923Z-ATC-IO      THRU S923Z-EXIT.                  DESBD427
00856                                                                   DESBD427
00857  S923E-EXIT.                                                      DESBD427
00858      EXIT.                                                        DESBD427
00859                                                                   DESBD427
00860                                                                   DESBD427
00861  S923Z-ATC-IO.                                                    DESBD427
00862      CALL 'DTSBU923' USING L923-LINK-AREA                         DESBD427
00863                            ASKL-REC.                              DESBD427
00864  S923Z-EXIT.                                                      DESBD427
00865      EXIT.                                                        DESBD427
00866                                                                   DESBD427
00867  S931-OPEN-READ.                                                  DESBD427
00868      SET L931-OPEN-READ-88 TO TRUE.                               DESBD427
00869      GO TO S931-REF-IO.                                           DESBD427
00870                                                                   DESBD427
00871  S931-CLOSE.                                                      DESBD427
00872      SET L931-CLOSE-88 TO TRUE.                                   DESBD427
00873      GO TO S931-REF-IO.                                           DESBD427
00874                                                                   DESBD427
00875  S931-REF-IO.                                                     DESBD427
00876      CALL 'DTSBU931' USING L931-LINK-AREA                         DESBD427
00877                            FSKL-REC.                              DESBD427
00878  S931-EXIT.                                                       DESBD427
00879      EXIT.                                                        DESBD427
00880                                                                   DESBD427
00881  S981A-OPEN-READ.                                                 DESBD427
00882      SET L981-OPEN-READ-88 TO TRUE.                               DESBD427
00883      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD427
00884                                                                   DESBD427
00885  S981A-EXIT.                                                      DESBD427
00886      EXIT.                                                        DESBD427
00887                                                                   DESBD427
00888  S981C-CLOSE.                                                     DESBD427
00889      SET L981-CLOSE-88 TO TRUE.                                   DESBD427
00890      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD427
00891                                                                   DESBD427
00892  S981C-EXIT.                                                      DESBD427
00893      EXIT.                                                        DESBD427
00894                                                                   DESBD427
00895  S981D-START-BROWSE.                                              DESBD427
00896      SET L981-START-BROWSE-88 TO TRUE.                            DESBD427
00897      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD427
00898                                                                   DESBD427
00899  S981D-EXIT.                                                      DESBD427
00900      EXIT.                                                        DESBD427
00901                                                                   DESBD427
00902  S981E-READ-NEXT.                                                 DESBD427
00903      SET L981-READ-NEXT-88 TO TRUE.                               DESBD427
00904      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD427
00905                                                                   DESBD427
00906  S981E-EXIT.                                                      DESBD427
00907      EXIT.                                                        DESBD427
00908                                                                   DESBD427
00909  S981F-READ.                                                      DESBD427
00910      SET L981-READ-88      TO TRUE.                               DESBD427
00911      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD427
00912                                                                   DESBD427
00913  S981F-EXIT.                                                      DESBD427
00914      EXIT.                                                        DESBD427
00915                                                                   DESBD427
00916  S981Z-WAGE-I.                                                    DESBD427
00917      CALL 'DTSBU981' USING L981-LINK-AREA                         DESBD427
00918                            WWGH-REC.                              DESBD427
00919  S981Z-EXIT.                                                      DESBD427
00920      EXIT.                                                        DESBD427
00921  S982O-OPEN-UPDATE.                                               DESBD427
00922      SET L982-OPEN-UPDATE-88 TO TRUE.                             DESBD427
00923      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD427
00924                                                                   DESBD427
00925  S982O-EXIT.                                                      DESBD427
00926      EXIT.                                                        DESBD427
00927                                                                   DESBD427
00928  S982A-START-BROWSE.                                              DESBD427
00929      SET L982-START-BROWSE-88 TO TRUE.                            DESBD427
00930      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD427
00931                                                                   DESBD427
00932  S982A-EXIT.                                                      DESBD427
00933      EXIT.                                                        DESBD427
00934                                                                   DESBD427
00935  S982B-READ-NEXT.                                                 DESBD427
00936      SET L982-READ-NEXT-88    TO TRUE.                            DESBD427
00937      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD427
00938                                                                   DESBD427
00939  S982B-EXIT.                                                      DESBD427
00940      EXIT.                                                        DESBD427
00941  S982C-WRITE.                                                     DESBD427
00942      SET L982-WRITE-88        TO TRUE.                            DESBD427
00943      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD427
00944                                                                   DESBD427
00945  S982C-EXIT.                                                      DESBD427
00946      EXIT.                                                        DESBD427
00947                                                                   DESBD427
00948  S982D-REWRITE.                                                   DESBD427
00949      SET L982-REWRITE-88        TO TRUE.                          DESBD427
00950      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD427
00951                                                                   DESBD427
00952  S982D-EXIT.                                                      DESBD427
00953      EXIT.                                                        DESBD427
00954  S982F-CLOSE.                                                     DESBD427
00955      SET L982-CLOSE-88        TO TRUE.                            DESBD427
00956      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD427
00957                                                                   DESBD427
00958  S982F-EXIT.                                                      DESBD427
00959      EXIT.                                                        DESBD427
00960                                                                   DESBD427
00961  S982Z-WNAM-IO.                                                   DESBD427
00962      CALL 'DTSBU982' USING L982-LINK-AREA                         DESBD427
00963                           WNAM-REC.                               DESBD427
00964  S982Z-EXIT.                                                      DESBD427
00965      EXIT.                                                        DESBD427
00966                                                                   DESBD427
00967  S1000-OPEN-TDEC-IN.                                              DESBD427
00968      OPEN INPUT ESSP-WAGE-IN                                         CL*35
00969      IF NOT TDEC-IN-OK-88                                         DESBD427
00970         DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS        DESBD427
00971         SET W-ERROR-YES-88    TO TRUE                             DESBD427
00972      END-IF.                                                      DESBD427
00973                                                                   DESBD427
00974      OPEN OUTPUT X146-WAGE-OUT                                       CL**8
00975      IF NOT TDEC-IN-OK-88                                            CL**8
00976         DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS           CL**8
00977         SET W-ERROR-YES-88    TO TRUE                                CL**8
00978      END-IF.                                                         CL**8
00979                                                                      CL**8
00980  S1000-EXIT.                                                      DESBD427
00981      EXIT.                                                        DESBD427
00982                                                                   DESBD427
00983  S1010-READ-TDEC-IN.                                              DESBD427
00984 *    READ TDEC-TRAN-IN         INTO ESP-TRANSACTION-AREA.         DESBD427
00985      READ ESSP-WAGE-IN INTO X144-WEB-REC                             CL*32
00986      IF TDEC-IN-OK-88                                             DESBD427
00987         ADD +1                 TO W-TDEC-IN-CNT                   DESBD427
00988      ELSE                                                         DESBD427
00989         IF TDEC-IN-EOF-88                                         DESBD427
00990            DISPLAY 'EOF'                                          DESBD427
00991         ELSE                                                      DESBD427
00992            DISPLAY 'CANNOT READ TDEC INPUT ' TDEC-IN-STATUS       DESBD427
00993         END-IF                                                    DESBD427
00994      END-IF.                                                      DESBD427
00995                                                                   DESBD427
00996  S1010-EXIT.                                                      DESBD427
00997      EXIT.                                                        DESBD427
00998                                                                   DESBD427
00999  S1020-CLOSE-TDEC-IN.                                             DESBD427
01000      CLOSE ESSP-WAGE-IN                                              CL*32
01001            X146-WAGE-OUT.                                            CL*10
01002                                                                   DESBD427
01003  S1020-EXIT.                                                      DESBD427
01004      EXIT.                                                        DESBD427
01005  S009-CONVERT-TO-CAPS.                                               CL*20
01006                                                                      CL*20
01007      CALL 'DTSBU009' USING L009-LINK-AREA.                           CL*20
01008                                                                      CL*20
01009  S009-EXIT.                                                          CL*20
01010      EXIT.                                                           CL*20
01011                                                                   DESBD427
01012  S999-ABEND.                                                      DESBD427
01013      DISPLAY '*** I/O MODULE ABENDING'.                           DESBD427
01014                                                                   DESBD427
01015      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DESBD427
01016  S999-EXIT.                                                       DESBD427
01017      EXIT.                                                        DESBD427
