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