00001  IDENTIFICATION DIVISION.                                         08/23/25
00002  PROGRAM-ID.    DTSVAL04.                                         DTSVAL04
00003                                                                      LV027
00004 ******************************************************************DTSVAL04
00005 *                                                                *DTSVAL04
00006 *                                                                *   CL**7
00007 *    FUNCTION:                                                   *DTSVAL04
00008 *    THIS PROGRAM IS WRITTEN TO PRODUCE W4 WAGE TRANSACTIONS,    *DTSVAL04
00009 *    USING THE ICESA WAGE FORMAT. (FOR dcgov)                    *   CL**7
00010 *                                             08/11/11      zl1  *   CL*12
00011 ******************************************************************DTSVAL04
00012 *    FOR INPUT FILES THAT ARE 275 BYTES, USE THIS PROGRAM.       *   CL*12
00013 ******************************************************************DTSVAL04
00014 ******************************************************************DTSVAL04
00015 * MODIFICATION HISTORY:                                          *DTSVAL04
00016 *                                                                *DTSVAL04
00017 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DTSVAL04
00018 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DTSVAL04
00019 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *DTSVAL04
00020 ******************************************************************DTSVAL04
00021                                                                   DTSVAL04
00022  ENVIRONMENT DIVISION.                                            DTSVAL04
00023                                                                   DTSVAL04
00024  CONFIGURATION  SECTION.                                          DTSVAL04
00025  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSVAL04
00026  INPUT-OUTPUT   SECTION.                                          DTSVAL04
00027                                                                   DTSVAL04
00028  FILE-CONTROL.                                                    DTSVAL04
00029                                                                   DTSVAL04
00030      SELECT ICESA-FILE ASSIGN TO ICESA.                           DTSVAL04
00031      SELECT ICERR-FILE ASSIGN TO ICERR.                              CL*14
00032                                                                   DTSVAL04
00033      SELECT W4-FILE    ASSIGN TO W4FILE.                          DTSVAL04
00034                                                                   DTSVAL04
00035      SELECT PRINT-FILE ASSIGN TO PRINT.                           DTSVAL04
00036                                                                   DTSVAL04
00037      SELECT LISTOUT ASSIGN TO UR-S-LISTOUT.                       DTSVAL04
00038                                                                   DTSVAL04
00039  DATA DIVISION.                                                   DTSVAL04
00040  FILE SECTION.                                                    DTSVAL04
00041                                                                   DTSVAL04
00042  FD  ICESA-FILE                                                   DTSVAL04
00043      RECORDING MODE F                                             DTSVAL04
00044      BLOCK CONTAINS 0 RECORDS                                     DTSVAL04
00045      LABEL RECORDS ARE STANDARD                                   DTSVAL04
00046      DATA RECORD IS ICESA-REC.                                    DTSVAL04
00047                                                                   DTSVAL04
00048  01  ICESA-REC.                                                   DTSVAL04
00049      05 ICESA-REC-TYPE             PIC X(01).                     DTSVAL04
00050      05 FILLER                     PIC X(274).                    DTSVAL04
00051                                                                   DTSVAL04
00052  FD  ICERR-FILE                                                      CL*14
00053      RECORDING MODE F                                                CL*13
00054      BLOCK CONTAINS 0 RECORDS                                        CL*13
00055      LABEL RECORDS ARE STANDARD                                      CL*13
00056      DATA RECORD IS ICERR-REC.                                       CL*13
00057                                                                      CL*13
00058  01  ICERR-REC.                                                      CL*13
00059      05 ICERR-REC-TYPE             PIC X(01).                        CL*13
00060      05 FILLER                     PIC X(274).                       CL*13
00061                                                                      CL*13
00062  FD  W4-FILE                                                      DTSVAL04
00063      RECORDING MODE F                                             DTSVAL04
00064      BLOCK CONTAINS 0 CHARACTERS                                  DTSVAL04
00065      LABEL RECORDS ARE STANDARD                                   DTSVAL04
00066      DATA RECORD IS W4-OUT-RECORD.                                DTSVAL04
00067                                                                   DTSVAL04
00068  01  W4-OUT-RECORD    PIC X(80).                                     CL**7
00069                                                                   DTSVAL04
00070  FD  PRINT-FILE                                                   DTSVAL04
00071      RECORDING MODE F                                             DTSVAL04
00072      LABEL RECORDS ARE OMITTED                                    DTSVAL04
00073      DATA RECORD IS PRINT-REC.                                    DTSVAL04
00074                                                                   DTSVAL04
00075  01  PRINT-REC             PIC X(133).                            DTSVAL04
00076                                                                   DTSVAL04
00077  FD  LISTOUT                                                      DTSVAL04
00078      RECORD CONTAINS 133 CHARACTERS                               DTSVAL04
00079      LABEL RECORDS ARE OMITTED                                    DTSVAL04
00080      DATA RECORD IS LIST-REC.                                     DTSVAL04
00081  01  LIST-REC       PIC X(133).                                   DTSVAL04
00082                                                                   DTSVAL04
00083 ******************************************************************DTSVAL04
00084 *                    WORKING STORAGE SECTION                     *DTSVAL04
00085 ******************************************************************DTSVAL04
00086                                                                   DTSVAL04
00087  WORKING-STORAGE SECTION.                                         DTSVAL04
000875 77  PAN-VALET PICTURE X(24) VALUE '027DTSVAL04  08/23/25'.       DTSVAL04
00088  01  WS-LOWER PIC X(26) VALUE 'abcdefghijklmnopqrstuvwxyz'.          CL**3
00089  01  WS-UPPER PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.          CL**3
00090                                                                   DTSVAL04
00091  01  WRK-AREA.                                                    DTSVAL04
00092      05  ABEND-CD                    PIC  X(05) VALUE 'val04'.       CL**7
00093      05  ABEND-MOD                   PIC  X(08) VALUE 'DTSBU999'. DTSVAL04
00094      05  ABEND-MSG                   PIC  X(60).                  DTSVAL04
00095      05  WRK-MOD-NAME                PIC  X(08) VALUE 'dtsval04'.    CL**7
00096      05  ERROR-SW                    PIC  9.                      DTSVAL04
00097                                                                   DTSVAL04
00098  01  COUNTERS.                                                    DTSVAL04
00099      03  FILE-STATUS-FILE              PIC 99.                    DTSVAL04
00100      03  EMP-QTR-TOT-EARNINGS          PIC 9(7).                  DTSVAL04
00101      03  RECS-IN                       PIC 9(5).                  DTSVAL04
00102      03  RECS-OUT                      PIC 9(5).                  DTSVAL04
00103      03  QTR-RECS-OUT                  PIC 9(5).                  DTSVAL04
00104      03  PAGE-CTR                      PIC 9(5).                  DTSVAL04
00105      03  ERROR-RECS                    PIC 9(5).                  DTSVAL04
00106      03  ZERO-WAGE-CNT                 PIC 9(5).                  DTSVAL04
00107      03  EXCEPTION-CNT                 PIC 9(5).                  DTSVAL04
00108      03  WS-ZERO-WAGE-NO               PIC 9(5).                  DTSVAL04
00109                                                                   DTSVAL04
00110  01  LINE-CTR                          PIC 9(5) VALUE 56.         DTSVAL04
00111                                                                   DTSVAL04
00112  01  WS-QUARTER-YR-QTR                 PIC 9(05).                 DTSVAL04
00113  01  FILLER REDEFINES WS-QUARTER-YR-QTR.                          DTSVAL04
00114      05  WS-QUARTER-YEAR               PIC 9(4).                  DTSVAL04
00115      05  WS-QUARTER-QTR                PIC 9(1).                  DTSVAL04
00116                                                                   DTSVAL04
00117  01 L004-LINK-AREA.                                               DTSVAL04
00118  ++INCLUDE DTSIL004                                               DTSVAL04
00119      EJECT                                                        DTSVAL04
00120                                                                   DTSVAL04
00121  ++INCLUDE EWGRECS                                                DTSVAL04
00122                                                                   DTSVAL04
00123  01  REC-END-IND                      PIC  X(01)  VALUE 'N'.      DTSVAL04
00124      88 REC-END                                   VALUE 'Y'.      DTSVAL04
00125  01  WS-REPT-YEAR                     PIC  X(04).                 DTSVAL04
00126  01  WS-FILL-YR REDEFINES WS-REPT-YEAR.                           DTSVAL04
00127      05  WS-REPT-MM                   PIC  X(02).                 DTSVAL04
00128      05  WS-REPT-YR                   PIC  X(02).                 DTSVAL04
00129                                                                   DTSVAL04
00130  01  WS-TODAY                         PIC 9(06).                  DTSVAL04
00131  01  WS-TODAY-REDEF REDEFINES WS-TODAY.                           DTSVAL04
00132      05  WS-TODAY-YY                  PIC 9(02).                  DTSVAL04
00133      05  WS-TODAY-MM                  PIC 9(02).                  DTSVAL04
00134      05  WS-TODAY-DD                  PIC 9(02).                  DTSVAL04
00135                                                                   DTSVAL04
00136  01  WS-AFFI-CODE                     PIC 9(01) VALUE 2.          DTSVAL04
00137                                                                   DTSVAL04
00138  01  WS-QTR-NEW.                                                  DTSVAL04
00139      05 WS-QTR-QTR                    PIC 9(01).                  DTSVAL04
00140      05 WS-QTR-YY                     PIC 9(02).                  DTSVAL04
00141                                                                   DTSVAL04
00142  01  WS-YQTR.                                                     DTSVAL04
00143      05 WS-YQTR-Y                     PIC 9(02).                  DTSVAL04
00144      05 WS-YQTR-Q                     PIC 9(01).                  DTSVAL04
00145                                                                   DTSVAL04
00146                                                                   DTSVAL04
00147  01  WS-LAST-NAME                     PIC X(20).                  DTSVAL04
00148  01  WS-LAST-NAMES REDEFINES WS-LAST-NAME.                        DTSVAL04
00149      05 WS-LAST                       PIC X(03).                  DTSVAL04
00150      05 WS-LAST-FILLER                PIC X(17).                  DTSVAL04
00151                                                                   DTSVAL04
00152  01  WS-HOLD-SSN.                                                 DTSVAL04
00153      05 WS-HOLD-SSN-1                 PIC 9(03).                  DTSVAL04
00154      05 WS-HOLD-SSN-2                 PIC 9(02).                  DTSVAL04
00155      05 WS-HOLD-SSN-3                 PIC 9(04).                  DTSVAL04
00156                                                                   DTSVAL04
00157  01  TIME-FIXED                       PIC X(06)  VALUE '170000'.  DTSVAL04
00158  01  WRITE-CNT                        PIC 9(08)  VALUE ZEROES.    DTSVAL04
00159                                                                   DTSVAL04
00160  01  WS-ACCOUNT                       PIC X(15)  VALUE SPACES.    DTSVAL04
00161  01  WS-ACCOUNT-NO REDEFINES WS-ACCOUNT.                          DTSVAL04
00162      05 WS-WAGE-ACCOUNT               PIC 9(06).                  DTSVAL04
00163      05 FILLER                        PIC X(09).                  DTSVAL04
00164                                                                   DTSVAL04
00165  01  WS-TRN-OPER-ID.                                              DTSVAL04
00166      05 WS-TRN-CLM                    PIC X(06) VALUE '000444'.   DTSVAL04
00167      05 WS-TRN-OPR-ID                 PIC X(02) VALUE '05'.       DTSVAL04
00168                                                                   DTSVAL04
00169  01  ICESA-CNT                        PIC  9(08)  VALUE ZEROES.   DTSVAL04
00170  01  EMPLOYEE-CNT-TAPE                PIC  9(07)  VALUE ZEROES.   DTSVAL04
00171  01  GRAND-EMPLOYEE-CNT               PIC  9(08)  VALUE ZEROES.   DTSVAL04
00172  01  TOTAL-EMPLOYER-CNT               PIC  9(06)  VALUE ZEROES.   DTSVAL04
00173                                                                   DTSVAL04
00174  01  WS-HOLDING-AREA                  PIC  9(12)  VALUE ZEROES.   DTSVAL04
00175                                                                   DTSVAL04
00176  01  QTR-TOTL-GROS-WAGE               PIC  9(12)V99.              DTSVAL04
00177  01  QTR-WGES-REDEF REDEFINES QTR-TOTL-GROS-WAGE.                 DTSVAL04
00178      05  WS-FILL-WGE                  PIC  9(07).                 DTSVAL04
00179      05  WS-EMPL-WAGE-CENTS           PIC  9(05)V99.              DTSVAL04
00180                                                                   DTSVAL04
00181  01  GRAND-GROS-WAGE                  PIC  9(13)V99.              DTSVAL04
00182                                                                   DTSVAL04
00183  01  GRAND-S-RECORD-TOTAL             PIC  9(12)V99.              DTSVAL04
00184                                                                   DTSVAL04
00185                                                                   DTSVAL04
00186  01  LINE-COUNT-DETAIL            PIC  9(02) VALUE 99.            DTSVAL04
00187  01  PAGE-COUNT-1                 PIC  9(04) VALUE ZEROES.        DTSVAL04
00188  01  PAGE-COUNT-2                 PIC  9(04) VALUE ZEROES.        DTSVAL04
00189                                                                   DTSVAL04
00190 ******************************************************************DTSVAL04
00191 * TRANSACTION W4 - ADD WAGE INFORMATION                          *DTSVAL04
00192 ******************************************************************DTSVAL04
00193                                                                   DTSVAL04
00194  01  W4-TRAN-AREA.                                                DTSVAL04
00195          10  W4-KEY-DATA.                                         DTSVAL04
00196              15  W4-SSN                      PIC 9(09).           DTSVAL04
00197              15  FILLER                                           DTSVAL04
00198                      REDEFINES                                    DTSVAL04
00199                          W4-SSN.                                  DTSVAL04
00200                  20  W4-SSN1                 PIC X(03).           DTSVAL04
00201                  20  W4-SSN2                 PIC X(02).           DTSVAL04
00202                  20  W4-SSN3                 PIC X(04).           DTSVAL04
00203              15  FILLER                      PIC 9(01).           DTSVAL04
00204              15  W4-TRAN-ID                  PIC X(02).           DTSVAL04
00205              15  W4-TRAN-OPER-ID.                                 DTSVAL04
00206                  20  W4-TRAN-CLM-CNTR        PIC 9(06).           DTSVAL04
00207                  20  W4-TRAN-OPR-ID          PIC 9(02).           DTSVAL04
00208              15  W4-DATE-ENTERED             PIC 9(08).           DTSVAL04
00209              15  FILLER REDEFINES W4-DATE-ENTERED.                DTSVAL04
00210                  20  W4-CENTURY-ENTERED      PIC 9(2).            DTSVAL04
00211                  20  W4-DTE-ENTERED          PIC 9(6).            DTSVAL04
00212              15  W4-TIME-ENTERED             PIC 9(06).           DTSVAL04
00213              15  FILLER                      PIC X(6).            DTSVAL04
00214          10  W4-TRAN-DATA.                                        DTSVAL04
00215              15  W4-NAME-CHECK               PIC X(03).           DTSVAL04
00216              15  W4-QUARTER                  PIC 9(5).            DTSVAL04
00217              15  FILLER REDEFINES W4-QUARTER.                     DTSVAL04
00218                  20  W4-QTR-CENTURY          PIC 9(2).            DTSVAL04
00219                  20  W4-QTR                  PIC 9(3).            DTSVAL04
00220              15  W4-AFFI-CODE                PIC X(1).            DTSVAL04
00221              15  W4-QUARTER-EARNINGS         PIC 9(7).            DTSVAL04
00222              15  W4-ACCOUNT                  PIC 9(6).            DTSVAL04
00223              15  W4-EMP-NAME                 PIC X(4).            DTSVAL04
00224              15  W4-ZFILLER                  pic   x(14).            CL*24
00225 ******************************************************************DTSVAL04
00226 *                 DETAIL REPORT FOR WAGES                        *DTSVAL04
00227 ******************************************************************DTSVAL04
00228  01  DETAIL-LINE.                                                 DTSVAL04
00229      05  FILLER                           PIC X(10) VALUE SPACES. DTSVAL04
00230      05  DETAIL-SSN.                                              DTSVAL04
00231          10  DETAIL-SSN1                  PIC 9(03).              DTSVAL04
00232          10  FILLER                       PIC X(01) VALUE '-'.    DTSVAL04
00233          10  DETAIL-SSN2                  PIC 9(02).              DTSVAL04
00234          10  FILLER                       PIC X(01) VALUE '-'.    DTSVAL04
00235          10  DETAIL-SSN3                  PIC 9(04).              DTSVAL04
00236      05  FILLER                           PIC X(25) VALUE SPACES. DTSVAL04
00237      05  DETAIL-NAME                      PIC X(03).              DTSVAL04
00238      05  FILLER                           PIC X(33) VALUE SPACES. DTSVAL04
00239      05  DETAIL-EARNINGS             PIC  ZZZ,Z(03).99.           DTSVAL04
00240                                                                   DTSVAL04
00241  01  SUMMARY-LINE.                                                DTSVAL04
00242      05  FILLER                           PIC X(07) VALUE SPACES. DTSVAL04
00243      05  SUM-EMPL-COUNT                   PIC Z,ZZZ,ZZ9.          DTSVAL04
00244      05  FILLER                           PIC X(11) VALUE SPACES. DTSVAL04
00245      05  SUM-EMPL-FROM-TAPE               PIC Z,ZZZ,ZZ9.          DTSVAL04
00246      05  FILLER                           PIC X(12) VALUE SPACES. DTSVAL04
00247      05  SUM-EMPL-MATCH                   PIC X(03).              DTSVAL04
00248      05  FILLER                           PIC X(03) VALUE SPACES. DTSVAL04
00249      05  SUM-EMPL-GROSS-COUNT                                     DTSVAL04
00250                                           PIC ZZZ,ZZZ,ZZZ,ZZZ.99. DTSVAL04
00251      05  FILLER                           PIC X(06) VALUE SPACES. DTSVAL04
00252      05  SUM-EMPL-GROSS-FROM-TAPE                                 DTSVAL04
00253                                           PIC ZZZ,ZZZ,ZZZ,ZZZ.99. DTSVAL04
00254      05  FILLER                           PIC X(11) VALUE SPACES. DTSVAL04
00255      05  SUM-EMPL-TOTALS-MATCH            PIC X(03).              DTSVAL04
00256                                                                   DTSVAL04
00257  01  HEADER1.                                                     DTSVAL04
00258      03  FILLER                        PIC  X(05) VALUE SPACES.   DTSVAL04
00259      03  REPORTING-DATE.                                          DTSVAL04
00260          05  REPORTING-DATE-MM         PIC  X(02).                DTSVAL04
00261          05  FILLER                    PIC  X(01) VALUE '/'.      DTSVAL04
00262          05  REPORTING-DATE-DD         PIC  X(02).                DTSVAL04
00263          05  FILLER                    PIC  X(01) VALUE '/'.      DTSVAL04
00264          05  REPORTING-DATE-YY         PIC  X(02).                DTSVAL04
00265      03  FILLER                        PIC  X(38) VALUE SPACES.   DTSVAL04
00266      03  FILLER                        PIC  X(31) VALUE           DTSVAL04
00267          'DISTRICT OF COLUMBIA GOVERNMENT'.                       DTSVAL04
00268      03  FILLER                        PIC  X(30) VALUE SPACES.   DTSVAL04
00269      03  FILLER                        PIC  X(16) VALUE           DTSVAL04
00270          'REPORT: dtsval04'.                                         CL**9
00271      03  FILLER                        PIC  X(05) VALUE SPACES.   DTSVAL04
00272                                                                   DTSVAL04
00273  01  HEADER2.                                                     DTSVAL04
00274      03  FILLER                        PIC  X(50) VALUE SPACES.   DTSVAL04
00275      03  FILLER                        PIC  X(33) VALUE           DTSVAL04
00276          'DEPARTMENT OF EMPLOYMENT SERVICES'.                     DTSVAL04
00277      03  FILLER                        PIC  X(30) VALUE SPACES.   DTSVAL04
00278      03  FILLER                        PIC  X(10) VALUE           DTSVAL04
00279          'PAGE NO.  '.                                            DTSVAL04
00280      03  HD-PAGE                       PIC  9(03).                DTSVAL04
00281      03  FILLER                        PIC  X(07) VALUE SPACES.   DTSVAL04
00282                                                                   DTSVAL04
00283  01  HEADER3.                                                     DTSVAL04
00284      03  FILLER                        PIC  X(40) VALUE SPACES.   DTSVAL04
00285      03  FILLER                        PIC  X(47) VALUE           DTSVAL04
00286          'ICESA FORMAT QUARTERLY WAGE REPORT FOR ACCOUNT '.       DTSVAL04
00287      03  HD-ACCOUNT                    PIC  9(06).                DTSVAL04
00288      03  FILLER                        PIC  X(40) VALUE SPACES.   DTSVAL04
00289                                                                   DTSVAL04
00290  01  HEADER3-A.                                                   DTSVAL04
00291      03  FILLER                        PIC  X(50) VALUE SPACES.   DTSVAL04
00292      03  FILLER                        PIC  X(33) VALUE           DTSVAL04
00293          'ICESA FORMAT QUARTERLY TAX REPORT'.                     DTSVAL04
00294      03  FILLER                        PIC  X(50) VALUE SPACES.   DTSVAL04
00295                                                                   DTSVAL04
00296  01  HEADER4.                                                     DTSVAL04
00297      03  FILLER                        PIC  X(57) VALUE SPACES.   DTSVAL04
00298      03  HD-QUARTER                    PIC  X(06).                DTSVAL04
00299      03  FILLER                        PIC  X(12) VALUE           DTSVAL04
00300          ' QUARTER OF '.                                          DTSVAL04
00301      03  HD-YEAR                       PIC  9(02).                DTSVAL04
00302      03  FILLER                        PIC  X(56) VALUE SPACES.   DTSVAL04
00303                                                                   DTSVAL04
00304  01  COLUMN-DETAIL-HD1.                                           DTSVAL04
00305      03  FILLER                        PIC  X(14) VALUE SPACES.   DTSVAL04
00306      03  FILLER                        PIC  X(03) VALUE 'SSN'.    DTSVAL04
00307      03  FILLER                        PIC  X(29) VALUE SPACES.   DTSVAL04
00308      03  FILLER                        PIC  X(04) VALUE 'NAME'.   DTSVAL04
00309      03  FILLER                        PIC  X(32) VALUE SPACES.   DTSVAL04
00310      03  FILLER                        PIC  X(08) VALUE           DTSVAL04
00311          'EARNINGS'.                                              DTSVAL04
00312                                                                   DTSVAL04
00313  01  COLUMN-SUMMARY-HD1.                                          DTSVAL04
00314      03  FILLER                        PIC  X(10) VALUE SPACES.   DTSVAL04
00315      03  FILLER                        PIC  X(08) VALUE           DTSVAL04
00316          'EMPLOYEE'.                                              DTSVAL04
00317      03  FILLER                        PIC  X(08) VALUE SPACES.   DTSVAL04
00318      03  FILLER                        PIC  X(14) VALUE           DTSVAL04
00319          'EMPLOYEE COUNT'.                                        DTSVAL04
00320      03  FILLER                        PIC  X(07) VALUE SPACES.   DTSVAL04
00321      03  FILLER                        PIC  X(06) VALUE           DTSVAL04
00322          'TOTALS'.                                                DTSVAL04
00323      03  FILLER                        PIC  X(12) VALUE SPACES.   DTSVAL04
00324      03  FILLER                        PIC  X(05) VALUE           DTSVAL04
00325          'GROSS'.                                                 DTSVAL04
00326      03  FILLER                        PIC  X(17) VALUE SPACES.   DTSVAL04
00327      03  FILLER                        PIC  X(15) VALUE           DTSVAL04
00328          'GROSS AMOUNT'.                                          DTSVAL04
00329      03  FILLER                        PIC  X(10) VALUE SPACES.   DTSVAL04
00330      03  FILLER                        PIC  X(06) VALUE           DTSVAL04
00331          'TOTALS'.                                                DTSVAL04
00332                                                                   DTSVAL04
00333  01  COLUMN-SUMMARY-HD2.                                          DTSVAL04
00334      03  FILLER                        PIC  X(11) VALUE SPACES.   DTSVAL04
00335      03  FILLER                        PIC  X(05) VALUE           DTSVAL04
00336          'COUNT'.                                                 DTSVAL04
00337      03  FILLER                        PIC  X(13) VALUE SPACES.   DTSVAL04
00338      03  FILLER                        PIC  X(09) VALUE           DTSVAL04
00339          'FROM TAPE'.                                             DTSVAL04
00340      03  FILLER                        PIC  X(09) VALUE SPACES.   DTSVAL04
00341      03  FILLER                        PIC  X(06) VALUE           DTSVAL04
00342          'MATCH?'.                                                DTSVAL04
00343      03  FILLER                        PIC  X(12) VALUE SPACES.   DTSVAL04
00344      03  FILLER                        PIC  X(06) VALUE           DTSVAL04
00345          'AMOUNT'.                                                DTSVAL04
00346      03  FILLER                        PIC  X(17) VALUE SPACES.   DTSVAL04
00347      03  FILLER                        PIC  X(09) VALUE           DTSVAL04
00348          'FROM TAPE'.                                             DTSVAL04
00349      03  FILLER                        PIC  X(15) VALUE SPACES.   DTSVAL04
00350      03  FILLER                        PIC  X(06) VALUE           DTSVAL04
00351          'MATCH?'.                                                DTSVAL04
00352                                                                   DTSVAL04
00353  01  COLUMN-TAX-HD1.                                              DTSVAL04
00354      03  FILLER                        PIC  X(01) VALUE SPACES.   DTSVAL04
00355      03  FILLER                        PIC  X(07) VALUE           DTSVAL04
00356          'ACCOUNT'.                                               DTSVAL04
00357      03  FILLER                        PIC  X(22) VALUE SPACES.   DTSVAL04
00358      03  FILLER                        PIC  X(09) VALUE           DTSVAL04
00359          'NUMBER OF'.                                             DTSVAL04
00360      03  FILLER                        PIC  X(16) VALUE SPACES.   DTSVAL04
00361      03  FILLER                        PIC  X(03) VALUE           DTSVAL04
00362          'TAX'.                                                   DTSVAL04
00363      03  FILLER                        PIC  X(34) VALUE SPACES.   DTSVAL04
00364      03  FILLER                        PIC  X(05) VALUE           DTSVAL04
00365          'GROSS'.                                                 DTSVAL04
00366                                                                   DTSVAL04
00367  01  COLUMN-TAX-HD2.                                              DTSVAL04
00368      03  FILLER                        PIC  X(02) VALUE SPACES.   DTSVAL04
00369      03  FILLER                        PIC  X(06) VALUE           DTSVAL04
00370          'NUMBER'.                                                DTSVAL04
00371      03  FILLER                        PIC  X(22) VALUE SPACES.   DTSVAL04
00372      03  FILLER                        PIC  X(09) VALUE           DTSVAL04
00373          'EMPLOYEES'.                                             DTSVAL04
00374      03  FILLER                        PIC  X(15) VALUE SPACES.   DTSVAL04
00375      03  FILLER                        PIC  X(04) VALUE           DTSVAL04
00376          'RATE'.                                                  DTSVAL04
00377      03  FILLER                        PIC  X(34) VALUE SPACES.   DTSVAL04
00378      03  FILLER                        PIC  X(05) VALUE           DTSVAL04
00379          'WAGES'.                                                 DTSVAL04
00380                                                                   DTSVAL04
00381  01  COLUMN-TAX-HD3.                                              DTSVAL04
00382      03  FILLER                        PIC  X(13) VALUE SPACES.   DTSVAL04
00383      03  FILLER                        PIC  X(02) VALUE           DTSVAL04
00384          'UI'.                                                    DTSVAL04
00385      03  FILLER                        PIC  X(27) VALUE SPACES.   DTSVAL04
00386      03  FILLER                        PIC  X(06) VALUE           DTSVAL04
00387          'EXCESS'.                                                DTSVAL04
00388      03  FILLER                        PIC  X(23) VALUE SPACES.   DTSVAL04
00389      03  FILLER                        PIC  X(07) VALUE           DTSVAL04
00390          'TAXABLE'.                                               DTSVAL04
00391      03  FILLER                        PIC  X(38) VALUE SPACES.   DTSVAL04
00392      03  FILLER                        PIC  X(06) VALUE           DTSVAL04
00393          'AMOUNT'.                                                DTSVAL04
00394                                                                   DTSVAL04
00395  01  COLUMN-TAX-HD4.                                              DTSVAL04
00396      03  FILLER                        PIC  X(12) VALUE SPACES.   DTSVAL04
00397      03  FILLER                        PIC  X(05) VALUE           DTSVAL04
00398          'WAGES'.                                                 DTSVAL04
00399      03  FILLER                        PIC  X(26) VALUE SPACES.   DTSVAL04
00400      03  FILLER                        PIC  X(05) VALUE           DTSVAL04
00401          'WAGES'.                                                 DTSVAL04
00402      03  FILLER                        PIC  X(24) VALUE SPACES.   DTSVAL04
00403      03  FILLER                        PIC  X(05) VALUE           DTSVAL04
00404          'WAGES'.                                                 DTSVAL04
00405      03  FILLER                        PIC  X(41) VALUE SPACES.   DTSVAL04
00406      03  FILLER                        PIC  X(03) VALUE           DTSVAL04
00407          'DUE'.                                                   DTSVAL04
00408                                                                   DTSVAL04
00409  01  EMPLOYER-STATUS-RECORD-DATA.                                 DTSVAL04
00410 *++INCLUDE ESPTAXAD                                                  CL*27
00411      EJECT                                                        DTSVAL04
00412                                                                   DTSVAL04
00413  01  HD1.                                                         DTSVAL04
00414      03  FIL                 PIC X(5) VALUE SPACES.               DTSVAL04
00415      03  FIL                 PIC X(8) VALUE 'dtsval04'.              CL**9
00416      03  FIL                 PIC X(31) VALUE SPACES.              DTSVAL04
00417      03  FIL                 PIC X(42) VALUE                      DTSVAL04
00418      'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'.                DTSVAL04
00419      03  FIL                 PIC X(35) VALUE SPACES.              DTSVAL04
00420      03  FIL                 PIC X(5) VALUE 'PAGE:'.              DTSVAL04
00421      03  PAGE-CTR-PRT        PIC ZZ,ZZ9.                          DTSVAL04
00422                                                                   DTSVAL04
00423  01  HD2.                                                         DTSVAL04
00424      03  FIL                 PIC X(49) VALUE SPACES.              DTSVAL04
00425      03  FIL                 PIC X(39) VALUE                      DTSVAL04
00426      'DOES UI WAGE RECORD EDIT REPORT'.                           DTSVAL04
00427                                                                   DTSVAL04
00428  01  HD3.                                                         DTSVAL04
00429      03  FIL                 PIC X(57) VALUE SPACES.              DTSVAL04
00430      03  FIL                 PIC X(9) VALUE 'RUN DATE:'.          DTSVAL04
00431      03  REPORT-DATE-MM      PIC X(2).                            DTSVAL04
00432      03  FILLER              PIC X VALUE '/'.                     DTSVAL04
00433      03  REPORT-DATE-DD      PIC X(2).                            DTSVAL04
00434      03  FILLER              PIC X VALUE '/'.                     DTSVAL04
00435      03  REPORT-DATE-YY      PIC X(2).                            DTSVAL04
00436                                                                   DTSVAL04
00437  01  HD4                     PIC X(133) VALUE SPACES.             DTSVAL04
00438                                                                   DTSVAL04
00439  01  HD5.                                                         DTSVAL04
00440      03  FIL                 PIC X(5)  VALUE SPACES.              DTSVAL04
00441      03  FIL                 PIC X(3)  VALUE 'SSN'.               DTSVAL04
00442      03  FIL                 PIC X(7)  VALUE SPACES.              DTSVAL04
00443      03  FIL                 PIC X(12) VALUE 'DATE ENTERED'.      DTSVAL04
00444      03  FIL                 PIC X(02) VALUE SPACES.              DTSVAL04
00445      03  FIL                 PIC X(13) VALUE 'EMPLOYEE NAME'.     DTSVAL04
00446      03  FIL                 PIC X(2)  VALUE SPACES.              DTSVAL04
00447      03  FIL                 PIC X(7)  VALUE 'QUARTER'.           DTSVAL04
00448      03  FIL                 PIC X(5)  VALUE SPACES.              DTSVAL04
00449      03  FIL                 PIC X(8)  VALUE 'EARNINGS'.          DTSVAL04
00450      03  FIL                 PIC X(7)  VALUE SPACES.              DTSVAL04
00451      03  FIL                 PIC X(14) VALUE 'ACCOUNT NUMBER'.    DTSVAL04
00452      03  FIL                 PIC X(2)  VALUE SPACES.              DTSVAL04
00453      03  FIL                 PIC X(13) VALUE 'EMPLOYER NAME'.     DTSVAL04
00454      03  FIL                 PIC X(04) VALUE SPACES.              DTSVAL04
00455      03  FIL                 PIC X(18) VALUE 'ERRORS ENCOUNTERED'.DTSVAL04
00456                                                                   DTSVAL04
00457  01  HD6                     PIC X(133) VALUE SPACES.             DTSVAL04
00458                                                                   DTSVAL04
00459  01  DTL1.                                                        DTSVAL04
00460      03  FIL                 PIC X(5) VALUE SPACES.               DTSVAL04
00461      03  SSN-PRT             PIC X(9).                            DTSVAL04
00462      03  FIL                 PIC XX VALUE SPACES.                 DTSVAL04
00463      03  DATE-ENTERED-PRT    PIC X(08).                           DTSVAL04
00464      03  FIL                 PIC X(10) VALUE SPACES.              DTSVAL04
00465      03  EMPEE-NAME          PIC X(3).                            DTSVAL04
00466      03  FIL                 PIC X(07) VALUE SPACES.              DTSVAL04
00467      03  QTR-PRT             PIC X(6).                            DTSVAL04
00468      03  FIL                 PIC X(06) VALUE SPACES.              DTSVAL04
00469      03  EARNINGS-PRT        PIC 9(7)V99.                         DTSVAL04
00470      03  EARNINGS-PRT-X REDEFINES EARNINGS-PRT                    DTSVAL04
00471                              PIC X(9).                            DTSVAL04
00472      03  FIL                 PIC X(10) VALUE SPACES.              DTSVAL04
00473      03  ACCT-NUM-PRT        PIC X(6).                            DTSVAL04
00474      03  FIL                 PIC X(9)  VALUE SPACES.              DTSVAL04
00475      03  EMPOR-PRT           PIC X(6).                            DTSVAL04
00476      03  FIL                 PIC X(08) VALUE SPACES.              DTSVAL04
00477      03  MESSAGE-AREA        PIC X(30) VALUE SPACES.              DTSVAL04
00478                                                                   DTSVAL04
00479  01  TOT1.                                                        DTSVAL04
00480      03  FIL           PIC X(2) VALUE SPACES.                     DTSVAL04
00481      03  FIL           PIC X(21) VALUE 'TOTAL WAGE RECS READ:'.   DTSVAL04
00482      03  WAGE-CNT-PRT  PIC ZZZ,ZZ9.                               DTSVAL04
00483      03  FIL           PIC X(6) VALUE SPACES.                     DTSVAL04
00484      03  FIL           PIC X(24) VALUE 'TOTAL WAGE RECS WRITTEN:'.DTSVAL04
00485      03  WAGE-OUT-PRT  PIC ZZZ,ZZ9.                               DTSVAL04
00486      03  FIL           PIC X(6) VALUE SPACES.                     DTSVAL04
00487      03  FIL           PIC X(20) VALUE 'TOTAL ERROR RECORDS:'.    DTSVAL04
00488      03  ERRORS-PRT    PIC ZZ,ZZ9.                                DTSVAL04
00489      03  FIL           PIC X(6) VALUE SPACES.                     DTSVAL04
00490      03  FIL           PIC X(20) VALUE 'TOTAL ZERO WAGE REC:'.    DTSVAL04
00491      03  ZERO-WAGE-PRT PIC ZZ,ZZ9.                                DTSVAL04
00492                                                                   DTSVAL04
00493  03  BLANK-LINE        PIC X(133) VALUE SPACES.                   DTSVAL04
00494                                                                   DTSVAL04
00495  LINKAGE SECTION.                                                 DTSVAL04
00496 ******************************************************************DTSVAL04
00497 *                                                                *DTSVAL04
00498 * THIS PROCEDURE WILL WRITE THE SELECTED RECORDS                 *DTSVAL04
00499 *                                                                *DTSVAL04
00500 * FOR THE EWGTRNW4 WAGE FORMAT                                   *DTSVAL04
00501 *                                                                *DTSVAL04
00502 ******************************************************************DTSVAL04
00503                                                                   DTSVAL04
00504  PROCEDURE DIVISION.                                                 CL**7
00505                                                                   DTSVAL04
00506  MAIN0100-CONTROL.                                                DTSVAL04
00507                                                                   DTSVAL04
00508      OPEN INPUT  ICESA-FILE                                       DTSVAL04
00509           OUTPUT W4-FILE LISTOUT ICERR-FILE                          CL*14
00510                  PRINT-FILE.                                      DTSVAL04
00511                                                                   DTSVAL04
00512      ACCEPT WS-TODAY FROM DATE.                                   DTSVAL04
00513      MOVE WS-TODAY-YY TO REPORT-DATE-YY REPORTING-DATE-YY.        DTSVAL04
00514      MOVE WS-TODAY-MM TO REPORT-DATE-MM REPORTING-DATE-MM.        DTSVAL04
00515      MOVE WS-TODAY-DD TO REPORT-DATE-DD REPORTING-DATE-DD.        DTSVAL04
00516                                                                   DTSVAL04
00517      MOVE ZEROS TO COUNTERS.                                      DTSVAL04
00518                                                                   DTSVAL04
00519      MOVE LOW-VALUE TO W4-TRAN-AREA.                              DTSVAL04
00520                                                                   DTSVAL04
00521      MOVE ZEROES TO GRAND-GROS-WAGE                               DTSVAL04
00522                     GRAND-S-RECORD-TOTAL                          DTSVAL04
00523                     QTR-TOTL-GROS-WAGE.                           DTSVAL04
00524                                                                   DTSVAL04
00525      PERFORM PROC1000-WAGE-SEARCH THRU                            DTSVAL04
00526              PROC1000-WAGE-EXIT   until rec-end.                     CL**7
00527                                                                      CL**7
00528                                                                      CL**7
00529                                                                   DTSVAL04
00530  MAIN0100-CONTINUE.                                               DTSVAL04
00531                                                                   DTSVAL04
00532        IF ERROR-SW = 1                                               CL*12
00533         MOVE +3   TO RETURN-CODE                                     CL*12
00534      ELSE                                                         DTSVAL04
00535          MOVE ZEROES TO RETURN-CODE.                              DTSVAL04
00536                                                                   DTSVAL04
00537      PERFORM 999-CLOSE-FILES THRU 999-EXIT.                       DTSVAL04
00538                                                                   DTSVAL04
00539      GOBACK.                                                      DTSVAL04
00540                                                                   DTSVAL04
00541  MAIN0100-CONTROL-EXIT.                                           DTSVAL04
00542      EXIT.                                                        DTSVAL04
00543                                                                   DTSVAL04
00544  PROC1000-WAGE-SEARCH.                                            DTSVAL04
00545                                                                   DTSVAL04
00546      READ ICESA-FILE                                              DTSVAL04
00547        AT END                                                     DTSVAL04
00548         MOVE 'Y' TO REC-END-IND                                      CL*19
00549         go to PROC1000-WAGE-EXIT.                                    CL*19
00550                                                                   DTSVAL04
00551      MOVE SPACES TO W4-TRAN-AREA.                                    CL*24
00552      MOVE ICESA-REC TO WAGE-RECORD-S                                 CL*14
00553      PERFORM PROC2000-S-RECORD THRU                                  CL*14
00554                 PROC2000-S-EXIT.                                     CL*14
00555  PROC1000-WAGE-EXIT.                                              DTSVAL04
00556      EXIT.                                                        DTSVAL04
00557                                                                   DTSVAL04
00558                                                                   DTSVAL04
00559  PROC2000-S-RECORD.                                               DTSVAL04
00560                                                                   DTSVAL04
00561      MOVE LOW-VALUES TO W4-TRAN-AREA.                                CL*26
00562      MOVE 998888          TO W4-ACCOUNT                              CL*13
00563                              HD-ACCOUNT.                             CL*11
00564      MOVE 'DIST'       TO W4-EMP-NAME.                               CL*13
00565                                                                      CL*11
00566      INSPECT S-GROSS-WAGE REPLACING                               DTSVAL04
00567          LEADING ' ' BY ZERO.                                     DTSVAL04
00568                                                                      CL**6
00569      IF S-GROSS-WAGE = ZEROS                                         CL**6
00570         MOVE S-UNEMP-WAGE TO S-GROSS-WAGE.                           CL**6
00571                                                                   DTSVAL04
00572      IF S-GROSS-WAGE NOT NUMERIC                                  DTSVAL04
00573         MOVE 'GROSS-WAGE NOT NUMERIC' TO MESSAGE-AREA             DTSVAL04
00574         MOVE 1 TO ERROR-SW                                        DTSVAL04
00575         PERFORM 125-WAGE-REPORT               THRU 125-WR-EXIT.      CL*15
00576                                                                   DTSVAL04
00577      IF S-GROSS-WAGE = ZEROS                                      DTSVAL04
00578         IF WS-ZERO-WAGE-NO = EXCEPTION-CNT                        DTSVAL04
00579            ADD 1 TO ZERO-WAGE-CNT                                 DTSVAL04
00580            GO TO PROC1000-WAGE-SEARCH                             DTSVAL04
00581         ELSE                                                      DTSVAL04
00582            MOVE 'GROSS-WAGE EQUAL ZEROS' TO MESSAGE-AREA          DTSVAL04
00583            MOVE 1 TO ERROR-SW                                        CL*12
00584            ADD 1 TO ZERO-WAGE-CNT                                 DTSVAL04
00585            ADD 1 TO EXCEPTION-CNT                                 DTSVAL04
00586            PERFORM 125-WAGE-REPORT            THRU 125-WR-EXIT    DTSVAL04
00587            MOVE ZERO TO ERROR-SW                                  DTSVAL04
00588            GO TO PROC2000-S-EXIT.                                 DTSVAL04
00589                                                                   DTSVAL04
00590      ADD S-GROSS-WAGE TO  grand-gros-wage.                           CL*21
00591                                                                      CL*20
00592      MOVE WS-TODAY TO W4-DTE-ENTERED.                             DTSVAL04
00593      MOVE 20       TO W4-CENTURY-ENTERED.                         DTSVAL04
00594                                                                   DTSVAL04
00595      IF S-SSN NOT NUMERIC                                         DTSVAL04
00596           OR (S-SSN NOT GREATER THAN ZEROES)                      DTSVAL04
00597         MOVE 'SSN NOT NUMERIC' TO MESSAGE-AREA                    DTSVAL04
00598         MOVE 1 TO ERROR-SW                                        DTSVAL04
00599         PERFORM 125-WAGE-REPORT               THRU 125-WR-EXIT    DTSVAL04
00600      ELSE                                                         DTSVAL04
00601         MOVE S-SSN TO W4-SSN                                      DTSVAL04
00602                       WS-HOLD-SSN                                 DTSVAL04
00603         MOVE WS-HOLD-SSN-1 TO DETAIL-SSN1                         DTSVAL04
00604         MOVE WS-HOLD-SSN-2 TO DETAIL-SSN2                         DTSVAL04
00605         MOVE WS-HOLD-SSN-3 TO DETAIL-SSN3.                        DTSVAL04
00606                                                                   DTSVAL04
00607      MOVE SPACES TO W4-NAME-CHECK.                                DTSVAL04
00608                                                                      CL**2
00609      INSPECT S-LAST-NAME CONVERTING WS-LOWER TO WS-UPPER.            CL**2
00610                                                                      CL**2
00611      MOVE S-LAST-NAME TO WS-LAST-NAME.                            DTSVAL04
00612                                                                   DTSVAL04
00613      IF WS-LAST EQUAL SPACES                                      DTSVAL04
00614        MOVE 'EMPLOYEE-NAME EQUAL SPACES'      TO MESSAGE-AREA     DTSVAL04
00615        MOVE 1 TO ERROR-SW                                         DTSVAL04
00616        PERFORM 125-WAGE-REPORT                THRU 125-WR-EXIT    DTSVAL04
00617      ELSE                                                         DTSVAL04
00618          MOVE WS-LAST TO W4-NAME-CHECK                            DTSVAL04
00619                          DETAIL-NAME.                             DTSVAL04
00620                                                                   DTSVAL04
00621      IF S-REPT-MTH NUMERIC AND S-REPT-YR NUMERIC                     CL**4
00622            MOVE S-REPT-MTH TO WS-REPT-MM                          DTSVAL04
00623            MOVE S-REPT-YR  TO WS-REPT-YR                          DTSVAL04
00624            MOVE WS-REPT-YR TO WS-QTR-YY                           DTSVAL04
00625         ELSE                                                      DTSVAL04
00626            MOVE 'QTR OR YEAR NOT NUMERIC'      TO MESSAGE-AREA    DTSVAL04
00627            MOVE 1 TO ERROR-SW                                     DTSVAL04
00628            PERFORM 125-WAGE-REPORT             THRU 125-WR-EXIT.     CL*15
00629                                                                   DTSVAL04
00630      IF WS-REPT-MM = '03'                                         DTSVAL04
00631         MOVE 1  TO WS-QTR-QTR                                     DTSVAL04
00632      ELSE                                                         DTSVAL04
00633          IF WS-REPT-MM = '06'                                     DTSVAL04
00634             MOVE 2  TO WS-QTR-QTR                                 DTSVAL04
00635      ELSE                                                         DTSVAL04
00636          IF WS-REPT-MM = '09'                                     DTSVAL04
00637             MOVE 3  TO WS-QTR-QTR                                 DTSVAL04
00638      ELSE                                                         DTSVAL04
00639          IF WS-REPT-MM = '12'                                     DTSVAL04
00640             MOVE 4  TO WS-QTR-QTR                                 DTSVAL04
00641      ELSE                                                         DTSVAL04
00642         MOVE 'QUARTER ERROR WITH MONTH'                           DTSVAL04
00643              TO MESSAGE-AREA                                      DTSVAL04
00644         MOVE 1 TO ERROR-SW                                        DTSVAL04
00645         PERFORM 125-WAGE-REPORT      THRU 125-WR-EXIT.               CL*15
00646                                                                   DTSVAL04
00647      MOVE WS-QTR-QTR TO WS-YQTR-Q.                                DTSVAL04
00648      MOVE WS-QTR-YY  TO WS-YQTR-Y.                                DTSVAL04
00649      MOVE WS-YQTR       TO L004-QTR-3-X.                          DTSVAL04
00650      PERFORM S004-FROM-3 THRU S004-EXIT.                          DTSVAL04
00651      IF L004-VALID-QTR                                            DTSVAL04
00652         MOVE L004-QTR-5-9 TO WS-QUARTER-YR-QTR                    DTSVAL04
00653                              W4-QUARTER.                          DTSVAL04
00654                                                                   DTSVAL04
00655      MOVE S-GROSS-WAGE TO QTR-TOTL-GROS-WAGE.                     DTSVAL04
00656                                                                   DTSVAL04
00657       COMPUTE WS-HOLDING-AREA = (QTR-TOTL-GROS-WAGE / 100) * 100  DTSVAL04
00658         MOVE WS-HOLDING-AREA TO W4-QUARTER-EARNINGS               DTSVAL04
00659                                 DETAIL-EARNINGS.                  DTSVAL04
00660                                                                   DTSVAL04
00661      MOVE WS-AFFI-CODE TO W4-AFFI-CODE.                           DTSVAL04
00662      MOVE 'W4'         TO W4-TRAN-ID.                             DTSVAL04
00663                                                                   DTSVAL04
00664      MOVE WS-TRN-OPER-ID TO W4-TRAN-OPER-ID.                      DTSVAL04
00665      MOVE TIME-FIXED     TO W4-TIME-ENTERED.                      DTSVAL04
00666                                                                   DTSVAL04
00667      IF ERROR-SW = 1                                                 CL*14
00668         WRITE  ICERR-REC FROM WAGE-RECORD-S                          CL*14
00669         MOVE ZERO TO ERROR-SW                                        CL*14
00670      ELSE                                                            CL*14
00671 *    move W4-TRAN-AREA to w4-out-record                              CL*26
00672      WRITE W4-OUT-RECORD FROM W4-TRAN-AREA                           CL*26
00673      ADD 1 TO WRITE-CNT                                              CL*16
00674         MOVE ZERO TO ERROR-SW.                                       CL*14
00675                                                                   DTSVAL04
00676      ADD 1 TO LINE-COUNT-DETAIL                                      CL*16
00677               EMPLOYEE-CNT-TAPE                                   DTSVAL04
00678               GRAND-EMPLOYEE-CNT.                                 DTSVAL04
00679                                                                   DTSVAL04
00680  PROC2000-S-EXIT.                                                 DTSVAL04
00681      EXIT.                                                        DTSVAL04
00682 ******************************************************************DTSVAL04
00683 *                                                                *DTSVAL04
00684 ******************************************************************DTSVAL04
00685                                                                   DTSVAL04
00686  PROC4000-F-RECORD.                                               DTSVAL04
00687                                                                   DTSVAL04
00688      DISPLAY 'ICESA COUNTS         '.                             DTSVAL04
00689                                                                   DTSVAL04
00690      DISPLAY ' '.                                                 DTSVAL04
00691      DISPLAY 'TOTAL NUMBER OF S-TYPE REC READ = ' ICESA-CNT.      DTSVAL04
00692                                                                   DTSVAL04
00693      DISPLAY ' '.                                                 DTSVAL04
00694      DISPLAY 'TOTAL NUMBER OF S-TYPE REC GOOD = '  WRITE-CNT.     DTSVAL04
00695      DISPLAY ' '.                                                    CL*22
00696      DISPLAY 'TOTAL gross wates for dc gov    = ' grand-gros-wage.   CL*22
00697                                                                   DTSVAL04
00698  PROC4000-F-EXIT.                                                 DTSVAL04
00699      EXIT.                                                        DTSVAL04
00700                                                                   DTSVAL04
00701 ******************************************************************DTSVAL04
00702 *                                                                *DTSVAL04
00703 ******************************************************************DTSVAL04
00704                                                                   DTSVAL04
00705  PROC5000-HEADER-ROUTINE.                                         DTSVAL04
00706                                                                   DTSVAL04
00707      MOVE SPACES TO PRINT-REC.                                    DTSVAL04
00708                                                                   DTSVAL04
00709      ADD 1 TO PAGE-COUNT-1.                                       DTSVAL04
00710                                                                   DTSVAL04
00711      MOVE WS-REPT-YR TO  HD-YEAR.                                 DTSVAL04
00712      MOVE PAGE-COUNT-1 TO HD-PAGE.                                DTSVAL04
00713                                                                   DTSVAL04
00714      WRITE PRINT-REC FROM HEADER1 AFTER ADVANCING TOP-OF-PAGE.    DTSVAL04
00715      WRITE PRINT-REC FROM HEADER2 AFTER ADVANCING 1.              DTSVAL04
00716      WRITE PRINT-REC FROM HEADER3 AFTER ADVANCING 1.              DTSVAL04
00717      WRITE PRINT-REC FROM HEADER4 AFTER ADVANCING 2.              DTSVAL04
00718      WRITE PRINT-REC FROM COLUMN-DETAIL-HD1 AFTER ADVANCING 2.    DTSVAL04
00719                                                                   DTSVAL04
00720      MOVE SPACES TO PRINT-REC.                                    DTSVAL04
00721      WRITE PRINT-REC AFTER ADVANCING 2.                           DTSVAL04
00722                                                                   DTSVAL04
00723      MOVE 9 TO LINE-COUNT-DETAIL.                                 DTSVAL04
00724                                                                   DTSVAL04
00725  PROC5000-HEADER-EXIT.                                            DTSVAL04
00726      EXIT.                                                        DTSVAL04
00727                                                                   DTSVAL04
00728  125-WAGE-REPORT.                                                 DTSVAL04
00729      MOVE S-SSN                 TO SSN-PRT.                       DTSVAL04
00730      MOVE W4-DATE-ENTERED       TO DATE-ENTERED-PRT.              DTSVAL04
00731      MOVE S-LAST-NAME           TO EMPEE-NAME.                    DTSVAL04
00732      MOVE S-GROSS-WAGE          TO EARNINGS-PRT.                  DTSVAL04
00733      MOVE S-REPORTING-QTR-YR    TO QTR-PRT.                       DTSVAL04
00734      MOVE WS-WAGE-ACCOUNT       TO ACCT-NUM-PRT.                  DTSVAL04
00735      MOVE 'DC GOV'              TO EMPOR-PRT.                        CL*15
00736      IF LINE-CTR > 55                                             DTSVAL04
00737          PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT.                DTSVAL04
00738      WRITE LIST-REC FROM DTL1.                                    DTSVAL04
00739      IF S-GROSS-WAGE NOT = ZEROS                                  DTSVAL04
00740         ADD 1 TO ERROR-RECS.                                      DTSVAL04
00741      ADD 1 TO LINE-CTR.                                           DTSVAL04
00742  125-WR-EXIT.                                                     DTSVAL04
00743      EXIT.                                                        DTSVAL04
00744                                                                   DTSVAL04
00745  130-WAGE-HEADER.                                                 DTSVAL04
00746      ADD 1 TO PAGE-CTR.                                           DTSVAL04
00747      MOVE PAGE-CTR TO PAGE-CTR-PRT.                               DTSVAL04
00748      WRITE LIST-REC FROM HD1 AFTER TOP-OF-PAGE.                   DTSVAL04
00749      WRITE LIST-REC FROM HD2.                                     DTSVAL04
00750      WRITE LIST-REC FROM HD3.                                     DTSVAL04
00751      WRITE LIST-REC FROM HD4.                                     DTSVAL04
00752      WRITE LIST-REC FROM HD5.                                     DTSVAL04
00753      WRITE LIST-REC FROM HD6.                                     DTSVAL04
00754      MOVE 6 TO LINE-CTR.                                          DTSVAL04
00755  130-WH-EXIT.                                                     DTSVAL04
00756      EXIT.                                                        DTSVAL04
00757                                                                   DTSVAL04
00758 ******************************************************************DTSVAL04
00759 *              OBTAIN YYYYQ YEAR-QUARTER INFORMATION.            *DTSVAL04
00760 ******************************************************************DTSVAL04
00761  S004-FROM-3.                                                     DTSVAL04
00762      SET L004-FROM-3   TO TRUE.                                   DTSVAL04
00763      GO TO S004-YRQ.                                              DTSVAL04
00764                                                                   DTSVAL04
00765  S004-YRQ.                                                        DTSVAL04
00766      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSVAL04
00767                                                                   DTSVAL04
00768  S004-EXIT.                                                       DTSVAL04
00769      EXIT.                                                        DTSVAL04
00770      EJECT                                                        DTSVAL04
00771                                                                   DTSVAL04
00772  SERV9999-ABEND.                                                  DTSVAL04
00773      DISPLAY '****ICESA ***  DTSVAL04 ABENDING '  ABEND-MSG.         CL**7
00774      CALL ABEND-MOD USING ABEND-CD.                               DTSVAL04
00775  SERV9999-EXIT.                                                   DTSVAL04
00776      EXIT.                                                        DTSVAL04
00777                                                                   DTSVAL04
00778  999-CLOSE-FILES.                                                 DTSVAL04
00779      MOVE ICESA-CNT  TO WAGE-CNT-PRT.                             DTSVAL04
00780      MOVE WRITE-CNT  TO WAGE-OUT-PRT.                             DTSVAL04
00781      MOVE ERROR-RECS TO ERRORS-PRT.                               DTSVAL04
00782      MOVE ZERO-WAGE-CNT  TO ZERO-WAGE-PRT.                        DTSVAL04
00783      IF LINE-CTR > 55                                             DTSVAL04
00784          PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT.                DTSVAL04
00785      WRITE LIST-REC FROM TOT1 AFTER 2.                            DTSVAL04
00786      CLOSE ICESA-FILE LISTOUT PRINT-FILE                             CL*14
00787            ICERR-FILE.                                               CL*14
00788      DISPLAY 'TOTAL QTR WAGES ' grand-gros-wage.                     CL*21
00789                                                                   DTSVAL04
00790  999-EXIT.                                                        DTSVAL04
00791      EXIT.                                                        DTSVAL04
