00001  IDENTIFICATION DIVISION.                                         11/21/18
00002  PROGRAM-ID.    DTSBX465.                                         DTSBX465
00003                                                                      LV016
00004 ******************************************************************DTSBX465
00005 *                                                                *DTSBX465
00006 *                                                                *DTSBX465
00007 *    FUNCTION:                                                   *DTSBX465
00008 *                                                                *DTSBX465
00009 *      THE FUNCTION OF DTSBX465 IS TO GENERATE A UI QTR WAGE     *DTSBX465
00010 *      FILE FOR THE OFFICE OF TAX AND REVENUE.  UI WAGE DATA     *DTSBX465
00011 *      WILL BE EXTRACTED FOR A GIVEN QUARTER PERIOD BASED ON     *DTSBX465
00012 *      THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE.          *DTSBX465
00013 *                                                                *DTSBX465
00014 *      CONTACT: WALTER GOETZ  202-442-6312 TAX AND REVENUE(OTR)  *DTSBX465
00015 *                                                                *DTSBX465
00016 *                      G.A.BROWN                                 *DTSBX465
00017 ******************************************************************DTSBX465
00018 *                                                                 DTSBX465
00019 *    MODIFICATION HISTORY:                                        DTSBX465
00020 *                                                                 DTSBX465
00021 * 03-07-2005 MODIFIED SYSIN PARM ACCEPT CARD TO ACCEPT BLANK      DTSBX465
00022 *            ON QUARTERLY FROM-DATE AND TO-DATE AS THE DEFAULT    DTSBX465
00023 *            FROM THE HEADER RECORD COMPLETE QUARTER BEGIN DATE   DTSBX465
00024 *            AND THE COMPLETE QUARTER END DATE FIELDS. IF THE     DTSBX465
00025 *            INVALID QTR FROM-DATE AND QTR TO-DATE ENTERED,       DTSBX465
00026 *            THE PROGRAM EDITING RESULTS WILL ABEND.              DTSBX465
00027 *            REFERENCE RFP: STEVE                  PROGRAMMER: RLWDTSBX465
00028 *                                                                 DTSBX465
00029 * 06-17-2018 MODIFIED PROGRAM TO READ WAGE NAME FILE AN OUTPUT       CL**8
00030 *            FULL NAME ON OUTPUT WAGE FILE TO OTR                    CL**8
00031 *            REFERENCE RFP: STEVE                  PROGRAMMER: ZL1   CL**8
00032 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX465
00033 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX465
00034 *            REFERENCE RFP #****                   PROGRAMMER: XXXDTSBX465
00035 *****                                                             DTSBX465
00036                                                                   DTSBX465
00037  ENVIRONMENT     DIVISION.                                        DTSBX465
00038  CONFIGURATION SECTION.                                           DTSBX465
00039  SPECIAL-NAMES.  C01 IS TOP-OF-PAGE.                              DTSBX465
00040  INPUT-OUTPUT SECTION.                                            DTSBX465
00041  FILE-CONTROL.                                                    DTSBX465
00042      SELECT WAGE-FILE ASSIGN TO UT-S-BUSINES.                     DTSBX465
00043      SELECT WAGE-FILE-G ASSIGN TO UT-S-GOVT.                      DTSBX465
00044      SELECT WAGE-FILE-F ASSIGN TO UT-S-FED.                       DTSBX465
00045  DATA DIVISION.                                                   DTSBX465
00046  FILE SECTION.                                                    DTSBX465
00047                                                                   DTSBX465
00048  FD  WAGE-FILE                                                    DTSBX465
00049      RECORDING MODE IS F                                          DTSBX465
00050      LABEL RECORD ARE STANDARD                                    DTSBX465
00051      RECORD CONTAINS 80 CHARACTERS                                   CL**3
00052      BLOCK CONTAINS 0 RECORDS                                     DTSBX465
00053      DATA RECORD IS WAGE-REC.                                     DTSBX465
00054                                                                   DTSBX465
00055  01  WAGE-REC.                                                    DTSBX465
00056      03  EMPLOYEE-SSN     PIC 9(9).                               DTSBX465
00057      03  EMPLOYEE-LAST-NAME    PIC X(20).                            CL**3
00058      03  EMPLOYEE-FIRST-NAME   PIC X(15).                            CL**3
00059      03  EMPLOYEE-MID-INIT     PIC X(01).                            CL**3
00060      03  EMPLOYER-ACCT-NUM     PIC 9(6).                          DTSBX465
00061      03  EMPLOYEE-WAGES        PIC 9(7).                          DTSBX465
00062      03  CEN-YEAR-QUARTER      PIC 9(5).                          DTSBX465
00063      03  WAGE-UPDATE-DATE      PIC 9(8).                          DTSBX465
00064      03  FEDERAL-ID-NUMBER     PIC 9(9).                          DTSBX465
00065                                                                   DTSBX465
00066  FD  WAGE-FILE-G                                                  DTSBX465
00067      RECORDING MODE IS F                                          DTSBX465
00068      LABEL RECORD ARE STANDARD                                    DTSBX465
00069      RECORD CONTAINS 80 CHARACTERS                                   CL**3
00070      BLOCK CONTAINS 0 RECORDS                                     DTSBX465
00071      DATA RECORD IS WAGE-REC-G.                                   DTSBX465
00072                                                                   DTSBX465
00073  01  WAGE-REC-G.                                                  DTSBX465
00074      03  EMPLOYEE-SSN-G   PIC 9(9).                               DTSBX465
00075      03  EMPLOYEE-LAST-NAME-G  PIC X(20).                            CL**3
00076      03  EMPLOYEE-FIRST-NAME-G PIC X(15).                            CL**3
00077      03  EMPLOYEE-MID-INIT-G   PIC X(01).                            CL**3
00078      03  EMPLOYER-ACCT-NUM-G   PIC 9(6).                          DTSBX465
00079      03  EMPLOYEE-WAGES-G      PIC 9(7).                          DTSBX465
00080      03  CEN-YEAR-QUARTER-G    PIC 9(5).                          DTSBX465
00081      03  WAGE-UPDATE-DATE-G    PIC 9(8).                          DTSBX465
00082      03  FEDERAL-ID-NUMBER-G   PIC 9(9).                          DTSBX465
00083                                                                   DTSBX465
00084                                                                   DTSBX465
00085  FD  WAGE-FILE-F                                                  DTSBX465
00086      RECORDING MODE IS F                                          DTSBX465
00087      LABEL RECORD ARE STANDARD                                    DTSBX465
00088      RECORD CONTAINS 80 CHARACTERS                                   CL**3
00089      BLOCK CONTAINS 0 RECORDS                                     DTSBX465
00090      DATA RECORD IS WAGE-REC-F.                                   DTSBX465
00091                                                                   DTSBX465
00092  01  WAGE-REC-F.                                                  DTSBX465
00093      03  EMPLOYEE-SSN-F   PIC 9(9).                               DTSBX465
00094      03  EMPLOYEE-LAST-NAME-F  PIC X(20).                            CL**3
00095      03  EMPLOYEE-FIRST-NAME-F PIC X(15).                            CL**3
00096      03  EMPLOYEE-MID-INIT-F   PIC X(01).                            CL**3
00097      03  EMPLOYER-ACCT-NUM-F   PIC 9(6).                          DTSBX465
00098      03  EMPLOYEE-WAGES-F      PIC 9(7).                          DTSBX465
00099      03  CEN-YEAR-QUARTER-F    PIC 9(5).                          DTSBX465
00100      03  WAGE-UPDATE-DATE-F    PIC 9(8).                          DTSBX465
00101      03  FEDERAL-ID-NUMBER-F   PIC 9(9).                          DTSBX465
00102                                                                   DTSBX465
00103 ******************************************************************DTSBX465
00104 *                  WORKING STORAGE SECTION                       *DTSBX465
00105 ******************************************************************DTSBX465
00106  WORKING-STORAGE SECTION.                                         DTSBX465
001065 77  PAN-VALET PICTURE X(24) VALUE '016DTSBX465  11/21/18'.       DTSBX465
00107                                                                   DTSBX465
00108  01  SELECT-CARD.                                                 DTSBX465
00109      03  PRG-NAME  PIC X(10) VALUE '**DTSBX465'.                  DTSBX465
00110      03  FIL       PIC XX.                                        DTSBX465
00111      03  FROM-ACTIVITY-DATE    PIC 9(8).                          DTSBX465
00112      03  FIL         PIC X.                                       DTSBX465
00113      03  TO-ACTIVITY-DATE      PIC 9(8).                          DTSBX465
00114      03  FIL         PIC X VALUE SPACE.                           DTSBX465
00115      03  DCGOVT      PIC X(3).                                    DTSBX465
00116      03  FIL         PIC X.                                       DTSBX465
00117      03  FEDGOVT     PIC X(3).                                    DTSBX465
00118      03  FIL         PIC X.                                       DTSBX465
00119      03  BUSINESS    PIC X(3).                                    DTSBX465
00120      03  FIL         PIC X(39).                                   DTSBX465
00121                                                                   DTSBX465
00122  01  COUNTERS.                                                    DTSBX465
00123      03  FEDERAL-ID-NUMBER-WS   PIC 9(9).                         DTSBX465
00124      03  STOP-RECS     PIC 9(5).                                  DTSBX465
00125      03  UNMATCH-SW    PIC X.                                     DTSBX465
00126      03  ALL-NINES     PIC 9.                                     DTSBX465
00127      03  RECS-IN         PIC 9(9).                                DTSBX465
00128      03  RECS-OUT        PIC 9(9).                                DTSBX465
00129      03  QTR-WAGES       PIC 9(9).                                DTSBX465
00130      03  DC-WAGES        PIC 9(9).                                DTSBX465
00131      03  FED-WAGES       PIC 9(9).                                DTSBX465
00132      03  BUSINESS-WAGES  PIC 9(9).                                DTSBX465
00133      03  DC-ACCT         PIC 9(6).                                DTSBX465
00134      03  EMP-ACCT-HOLD     PIC 9(6).                              DTSBX465
00135      03  EMP-ACCT-HOLD-RED   PIC 9(6).                            DTSBX465
00136      03  EMP-ACCT-HOLD-WS REDEFINES EMP-ACCT-HOLD-RED.            DTSBX465
00137          05  ACCT-FOUR   PIC 9(4).                                DTSBX465
00138          05  ACCT-THREE-WS  REDEFINES ACCT-FOUR.                  DTSBX465
00139             07  ACCT-THREE-RED   PIC 9(3).                        DTSBX465
00140             07  ACCT-FIL         PIC 9.                           DTSBX465
00141          05  ACCT-TWO    PIC 99.                                  DTSBX465
00142                                                                   DTSBX465
00143      03  W-SSN                       PIC S9(09)  COMP-3  VALUE 0.    CL**2
00144      03  WRK-SSN                     PIC S9(09)  COMP-3  VALUE 0.    CL**2
00145      03  ABEND-CODE                  PIC S9(04)  COMP                CL**2
00146                                  VALUE +465.                      DTSBX465
00147      03  ABEND-MOD                   PIC  X(08)                   DTSBX465
00148                                  VALUE 'DTSBU999'.                DTSBX465
00149      03  ABEND-MSG                   PIC  X(60).                  DTSBX465
00150                                                                   DTSBX465
00151      03  WRK-BEGIN-DATE              PIC S9(09) COMP-3.           DTSBX465
00152      03  WRK-END-DATE                PIC S9(09) COMP-3.           DTSBX465
00153                                                                   DTSBX465
00154      03  WRK-BEGIN-DATE-DISP         PIC  9(08).                  DTSBX465
00155      03  FILLER REDEFINES WRK-BEGIN-DATE-DISP.                    DTSBX465
00156          05  WRK-BEGIN-YR            PIC  9(04).                  DTSBX465
00157          05  WRK-BEGIN-MO            PIC  9(02).                  DTSBX465
00158          05  WRK-BEGIN-DA            PIC  9(02).                  DTSBX465
00159                                                                   DTSBX465
00160      03  WRK-END-DATE-DISP           PIC  9(08).                  DTSBX465
00161      03  FILLER REDEFINES WRK-END-DATE-DISP.                      DTSBX465
00162          05  WRK-END-YR              PIC  9(04).                  DTSBX465
00163          05  WRK-END-MO              PIC  9(02).                  DTSBX465
00164          05  WRK-END-DA              PIC  9(02).                  DTSBX465
00165                                                                      CL**3
00166      03  WRK-NAME.                                                   CL**3
00167          05 WRK-LNAME                PIC X(20) VALUE SPACES.         CL**3
00168          05 WRK-FNAME                PIC X(15) VALUE SPACES.         CL**3
00169          05 WRK-INAME                PIC X(01) VALUE SPACES.         CL**3
00170  01  L001-LINK-AREA.                                              DTSBX465
00171  ++INCLUDE DTSIL001                                               DTSBX465
00172                                                                   DTSBX465
00173  01  L004-LINK-AREA.                                              DTSBX465
00174  ++INCLUDE DTSIL004                                               DTSBX465
00175                                                                   DTSBX465
00176  01  L910-LINK-AREA.                                              DTSBX465
00177  ++INCLUDE DTSIL910                                               DTSBX465
00178                                                                      CL**3
00179  01  L982-LINK-AREA.                                                 CL**3
00180  ++INCLUDE DTSIL982                                                  CL**3
00181                                                                   DTSBX465
00182  01  MSKL-REC.                                                    DTSBX465
00183  ++INCLUDE DTSIMSKL                                               DTSBX465
00184                                                                   DTSBX465
00185  01  MHDR-REC.                                                    DTSBX465
00186  ++INCLUDE DTSIMHDR                                               DTSBX465
00187                                                                   DTSBX465
00188  01  MPRF-REC.                                                    DTSBX465
00189  ++INCLUDE DTSIMPRF                                               DTSBX465
00190                                                                      CL**3
00191  01  WNAM-REC.                                                       CL**3
00192  ++INCLUDE DTSIWNAM                                                  CL**3
00193                                                                      CL**3
00194  01  COMMON-LINKAGE-SECTION.                                      DTSBX465
00195  ++INCLUDE EWGLINKB                                               DTSBX465
00196      EJECT                                                        DTSBX465
00197   EJECT                                                           DTSBX465
00198 ******************************************************************DTSBX465
00199 *               PROCEDURE DIVISION - CONTROL PROCEDURE           *DTSBX465
00200 ******************************************************************DTSBX465
00201  PROCEDURE DIVISION.                                              DTSBX465
00202  BEGIN00000.                                                      DTSBX465
00203      OPEN OUTPUT WAGE-FILE, WAGE-FILE-G, WAGE-FILE-F.             DTSBX465
00204 **                                                                DTSBX465
00205 **** OPEN UI WAGE MASTER FILE FOR READ ONLY                       DTSBX465
00206 **                                                                DTSBX465
00207      SET DBW-RANDOM-PROCESSING TO TRUE.                           DTSBX465
00208      SET DBW-HEADER-RECORD     TO TRUE.                           DTSBX465
00209      SET DBW-OPEN-INPUT    TO TRUE.                               DTSBX465
00210      CALL 'EWG960D'                                               DTSBX465
00211        USING VSAM-WAGEDATA-CONTROL-BLOCK.                         DTSBX465
00212                                                                   DTSBX465
00213      PERFORM 114-S910-OPEN-READ THRU 114-S910-OPEN-READ-EXIT.     DTSBX465
00214      PERFORM S982O-OPEN-READ    THRU S982O-EXIT.                     CL**6
00215                                                                   DTSBX465
00216      MOVE ZEROS TO COUNTERS.                                      DTSBX465
00217      MOVE ZERO TO WRK-BEGIN-DATE                                  DTSBX465
00218                   WRK-END-DATE.                                   DTSBX465
00219                                                                   DTSBX465
00220  MAIN0100-INITIATE.                                               DTSBX465
00221      ACCEPT SELECT-CARD.                                          DTSBX465
00222      DISPLAY  '  '.                                               DTSBX465
00223      DISPLAY  '  '  SELECT-CARD.                                  DTSBX465
00224      DISPLAY  '  '.                                               DTSBX465
00225      DISPLAY  ' PROGRAM   ' PRG-NAME.                             DTSBX465
00226      DISPLAY  ' FROM-DATE ' FROM-ACTIVITY-DATE.                   DTSBX465
00227      DISPLAY  ' TO-DATE   ' TO-ACTIVITY-DATE.                     DTSBX465
00228      DISPLAY  ' DC GOVT   ' DCGOVT                                DTSBX465
00229      DISPLAY  ' FED GOVT  ' FEDGOVT                               DTSBX465
00230      DISPLAY  ' BUSINESS  ' BUSINESS                              DTSBX465
00231      DISPLAY  '  '.                                               DTSBX465
00232      DISPLAY  '  '.                                               DTSBX465
00233                                                                   DTSBX465
00234      IF (FROM-ACTIVITY-DATE = SPACES OR LOW-VALUES)               DTSBX465
00235      AND (TO-ACTIVITY-DATE = SPACES OR LOW-VALUES)                DTSBX465
00236         PERFORM INIT0300-DEFAULT-DATES THRU INIT0300-EXIT         DTSBX465
00237      ELSE                                                         DTSBX465
00238         PERFORM INIT0100-BEGIN-DATE THRU INIT0100-EXIT            DTSBX465
00239         PERFORM INIT0200-END-DATE THRU INIT0200-EXIT.             DTSBX465
00240                                                                   DTSBX465
00241      IF WRK-END-DATE < WRK-BEGIN-DATE                             DTSBX465
00242          MOVE 'PERIOD END LESS THAN PERIOD BEGIN'                 DTSBX465
00243             TO ABEND-MSG                                          DTSBX465
00244          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX465
00245                                                                   DTSBX465
00246      MOVE WRK-BEGIN-DATE TO WRK-BEGIN-DATE-DISP.                  DTSBX465
00247      MOVE WRK-END-DATE TO WRK-END-DATE-DISP.                      DTSBX465
00248      DISPLAY  '  '.                                               DTSBX465
00249      DISPLAY  ' FROM-DATE/DEFAULT FROM DATE ' WRK-BEGIN-DATE-DISP.DTSBX465
00250      DISPLAY  ' TO-DATE/DEFAULT TO-DATE     ' WRK-END-DATE-DISP.  DTSBX465
00251      DISPLAY  '  '.                                               DTSBX465
00252                                                                   DTSBX465
00253      MOVE LOW-VALUE TO VSAM-WAGEDATA-CONTROL-BLOCK.               DTSBX465
00254      PERFORM MAIN0200-PROCESS-WAGE THRU MAIN0200-EX               DTSBX465
00255          UNTIL DBW-END-OF-FILE.                                   DTSBX465
00256          GO TO TERM0100-CLOSE-FILES.                              DTSBX465
00257                                                                   DTSBX465
00258  INIT0100-BEGIN-DATE.                                             DTSBX465
00259      MOVE FROM-ACTIVITY-DATE TO L001-FED-8-DATE-X.                DTSBX465
00260      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBX465
00261      IF L001-VALID-DATE                                           DTSBX465
00262         MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE                  DTSBX465
00263      ELSE                                                         DTSBX465
00264         MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG             DTSBX465
00265         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBX465
00266                                                                   DTSBX465
00267      MOVE WRK-BEGIN-DATE TO L004-DATE.                            DTSBX465
00268      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSBX465
00269      IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE                  DTSBX465
00270         MOVE 'PERIOD BEGIN NOT START OF QTR'                      DTSBX465
00271                                  TO ABEND-MSG                     DTSBX465
00272         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX465
00273      END-IF.                                                      DTSBX465
00274                                                                   DTSBX465
00275  INIT0100-EXIT.                                                   DTSBX465
00276      EXIT.                                                        DTSBX465
00277                                                                   DTSBX465
00278  INIT0200-END-DATE.                                               DTSBX465
00279      MOVE TO-ACTIVITY-DATE TO L001-FED-8-DATE-X.                  DTSBX465
00280      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBX465
00281      IF L001-VALID-DATE                                           DTSBX465
00282         MOVE L001-FED-8-DATE-9 TO WRK-END-DATE                    DTSBX465
00283      ELSE                                                         DTSBX465
00284         MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG               DTSBX465
00285         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBX465
00286                                                                   DTSBX465
00287      MOVE WRK-END-DATE TO L004-DATE.                              DTSBX465
00288      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSBX465
00289      IF WRK-END-DATE NOT = L004-QTR-END-DATE                      DTSBX465
00290         DISPLAY ' END DT ' L004-QTR-END-DATE                         CL*16
00291         MOVE 'PERIOD END NOT END OF QTR'                          DTSBX465
00292                                  TO ABEND-MSG                     DTSBX465
00293         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX465
00294      END-IF.                                                      DTSBX465
00295                                                                   DTSBX465
00296  INIT0200-EXIT.                                                   DTSBX465
00297      EXIT.                                                        DTSBX465
00298                                                                   DTSBX465
00299  INIT0300-DEFAULT-DATES.                                          DTSBX465
00300                                                                   DTSBX465
00301      MOVE LOW-VALUES           TO MSKL-KEY-AREA.                  DTSBX465
00302      MOVE +0                   TO MSKL-EMP-NO.                    DTSBX465
00303      SET MSKL-HDR-88           TO TRUE.                           DTSBX465
00304      PERFORM 115-S910-READ THRU 115-S910-READ-EXIT.               DTSBX465
00305                                                                   DTSBX465
00306      IF L910-NO-REC-88                                            DTSBX465
00307         MOVE 'MHDR RECORD IS MISSING'                             DTSBX465
00308                                TO ABEND-MSG                       DTSBX465
00309         PERFORM S999-ABEND     THRU S999-EXIT.                    DTSBX465
00310                                                                   DTSBX465
00311      MOVE MSKL-REC             TO MHDR-REC.                       DTSBX465
00312                                                                   DTSBX465
00313      MOVE MHDR-CMPL-QTR-BEGIN-DATE                                DTSBX465
00314                                TO WRK-BEGIN-DATE.                 DTSBX465
00315      MOVE MHDR-CMPL-QTR-END-DATE                                  DTSBX465
00316                                TO WRK-END-DATE.                   DTSBX465
00317                                                                   DTSBX465
00318      MOVE WRK-BEGIN-DATE TO FROM-ACTIVITY-DATE.                   DTSBX465
00319      MOVE WRK-END-DATE TO TO-ACTIVITY-DATE.                       DTSBX465
00320                                                                   DTSBX465
00321  INIT0300-EXIT.                                                   DTSBX465
00322      EXIT.                                                        DTSBX465
00323                                                                   DTSBX465
00324  MAIN0200-PROCESS-WAGE.                                           DTSBX465
00325      MOVE 'S' TO DBW-PROCESSING-MODE.                             DTSBX465
00326      MOVE 'SG01' TO DBW-SEGNAME.                                  DTSBX465
00327      PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT.             DTSBX465
00328      PERFORM LOCATE-WAGE THRU L-W-EX                              DTSBX465
00329            UNTIL DBW-NO-RECORD-FOUND.                             DTSBX465
00330      ADD 1 TO RECS-IN.                                            DTSBX465
00331      IF WGP-SSN = 999999999                                       DTSBX465
00332          GO TO TERM0100-CLOSE-FILES.                              DTSBX465
00333      IF ALL-NINES = 1                                             DTSBX465
00334          GO TO TERM0100-CLOSE-FILES.                              DTSBX465
00335  MAIN0200-EX.                                                     DTSBX465
00336      EXIT.                                                        DTSBX465
00337                                                                   DTSBX465
00338  LOCATE-WAGE.                                                     DTSBX465
00339       MOVE 'R' TO DBW-PROCESSING-MODE.                            DTSBX465
00340       MOVE 'SG02' TO DBW-SEGNAME.                                 DTSBX465
00341      PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT.             DTSBX465
00342      IF DBW-NO-RECORD-FOUND                                       DTSBX465
00343         GO TO L-W-EX.                                             DTSBX465
00344      PERFORM SEGMENT-2-DATA THRU S-2-D-EX.                        DTSBX465
00345  L-W-EX.                                                          DTSBX465
00346      EXIT.                                                        DTSBX465
00347                                                                   DTSBX465
00348  SEGMENT-2-DATA.                                                  DTSBX465
00349 **********************************************************        DTSBX465
00350 *  ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS         DTSBX465
00351 ******* **************************************************        DTSBX465
00352      IF WGP-SSN = 999999999                                       DTSBX465
00353         MOVE 1 TO ALL-NINES                                       DTSBX465
00354         GO TO S-2-D-EX.                                           DTSBX465
00355                                                                   DTSBX465
00356 *    DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE.             DTSBX465
00357      IF WGD-ACTIVITY-DATE NOT LESS THAN FROM-ACTIVITY-DATE        DTSBX465
00358                          AND                                      DTSBX465
00359         WGD-ACTIVITY-DATE NOT GREATER THAN TO-ACTIVITY-DATE       DTSBX465
00360         NEXT SENTENCE     ELSE                                    DTSBX465
00361            GO TO S-2-D-EX.                                        DTSBX465
00362                                                                   DTSBX465
00363 *    DISPLAY ' ENO : ' WGD-ACCOUNT-NUMBER ' '                        CL*12
00364 *            ' DOCS: ' WGD-ACTIVITY-DATE ' '                         CL*12
00365 *            ' FROM: ' FROM-ACTIVITY-DATE ' '                        CL*12
00366 *            ' TO  : ' TO-ACTIVITY-DATE.                             CL*12
00367                                                                   DTSBX465
00368      MOVE WGD-ACCOUNT-NUMBER TO EMP-ACCT-HOLD.                    DTSBX465
00369      MOVE EMP-ACCT-HOLD TO EMP-ACCT-HOLD-RED.                     DTSBX465
00370                                                                   DTSBX465
00371      IF ACCT-FOUR =                                               DTSBX465
00372         1101 OR 1102 OR 1104 OR 1105 OR 1106 OR 1108 OR           DTSBX465
00373         1109 OR 1110 OR 1111 OR 1112 OR 1113 OR 1115 OR           DTSBX465
00374         1116 OR 1117 OR 1118 OR 1119 OR 1120 OR 1121 OR 1122 OR   DTSBX465
00375         1123 OR 1124 OR 1125 OR 1126 OR 1127 OR 1128 OR 1129 OR   DTSBX465
00376         1130 OR 1131 OR 1132 OR 1133 OR 1134 OR 1135 OR 1136 OR   DTSBX465
00377         1137 OR 1138 OR 1139 OR 1140 OR 1141 OR 1142 OR 1144 OR   DTSBX465
00378         1145 OR 1146 OR 1147 OR 1148 OR 1149 OR 1150 OR 1151 OR   DTSBX465
00379         1153 OR 1154 OR 1155 OR 1156                              DTSBX465
00380         GO TO S-2-D-EX.                                           DTSBX465
00381                                                                   DTSBX465
00382      ADD 1 TO QTR-WAGES.                                          DTSBX465
00383                                                                   DTSBX465
00384  40-WRITE-DCGOV-FEDL-BUS-ACCTS.                                   DTSBX465
00385                                                                   DTSBX465
00386      PERFORM 110-FEIN-LOOK-UP THRU 110-FLU-EXIT.                  DTSBX465
00387                                                                   DTSBX465
00388      IF WGP-SSN = 000000000                                       DTSBX465
00389         GO TO S-2-D-EX.                                           DTSBX465
00390                                                                   DTSBX465
00391      IF L910-NO-REC-88                                            DTSBX465
00392         GO TO S-2-D-EX.                                           DTSBX465
00393                                                                   DTSBX465
00394      IF DCGOVT = 'DCG'                                            DTSBX465
00395      IF EMP-ACCT-HOLD = 998888                                       CL*13
00396         PERFORM 050-WRITE-GOVERNMENT-ACCOUNTS THRU 050-W-G-A-EXT  DTSBX465
00397         GO TO S-2-D-EX.                                           DTSBX465
00398                                                                   DTSBX465
00399      IF FEDGOVT = 'FED'                                           DTSBX465
00400      IF ACCT-THREE-RED = 000                                      DTSBX465
00401         PERFORM 025-WRITE-FEDERAL-ACCOUNTS THRU 025-W-F-A-EXT     DTSBX465
00402         GO TO S-2-D-EX.                                           DTSBX465
00403                                                                   DTSBX465
00404      IF BUSINESS = 'BUS'                                             CL*15
00405         PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT.      CL*15
00406                                                                   DTSBX465
00407      GO TO S-2-D-EX.                                              DTSBX465
00408                                                                   DTSBX465
00409  025-WRITE-FEDERAL-ACCOUNTS.                                      DTSBX465
00410                                                                   DTSBX465
00411 *    DISPLAY ' FED    ACCT ' WGD-ACCOUNT-NUMBER                      CL*15
00412      IF ACCT-THREE-RED = 000                                      DTSBX465
00413         ADD 1 TO FED-WAGES.                                       DTSBX465
00414                                                                   DTSBX465
00415      MOVE WGP-SSN TO EMPLOYEE-SSN-F.                              DTSBX465
00416      MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER-F.                       DTSBX465
00417      MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM-F.              DTSBX465
00418      MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES-F.               DTSBX465
00419 *    MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME-F.                      CL**3
00420      MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE-F.                DTSBX465
00421      MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER-F.            DTSBX465
00422 *                                                                    CL**2
00423      MOVE SPACES                       TO WRK-NAME.                  CL**2
00424      MOVE LOW-VALUE                    TO WNAM-REC.                  CL**2
00425      MOVE WGP-SSN                      TO WNAM-SSN WRK-SSN.          CL**2
00426      PERFORM 130-READ-NAME             THRU 130-READ-NAME-EXIT.      CL**2
00427      MOVE WRK-LNAME                    TO  EMPLOYEE-LAST-NAME-F      CL**3
00428      MOVE WRK-FNAME                    TO  EMPLOYEE-FIRST-NAME-F     CL**3
00429      MOVE WRK-INAME                    TO  EMPLOYEE-MID-INIT-F       CL**3
00430      WRITE WAGE-REC-F.                                            DTSBX465
00431      MOVE SPACES TO WAGE-REC-F.                                   DTSBX465
00432  025-W-F-A-EXT.                                                   DTSBX465
00433      EXIT.                                                        DTSBX465
00434                                                                   DTSBX465
00435  050-WRITE-GOVERNMENT-ACCOUNTS.                                   DTSBX465
00436 *    DISPLAY ' DC GOV ACCT ' WGD-ACCOUNT-NUMBER                      CL*15
00437 *    IF WGD-ACCOUNT-NUMBER = 998888                                  CL*13
00438         ADD 1 TO DC-WAGES.                                        DTSBX465
00439                                                                   DTSBX465
00440      MOVE WGP-SSN TO EMPLOYEE-SSN-G.                              DTSBX465
00441      MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER-G.                       DTSBX465
00442      MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM-G.              DTSBX465
00443      MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES-G.               DTSBX465
00444 *    MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME-G.                      CL**3
00445      MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE-G.                DTSBX465
00446      MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER-G.            DTSBX465
00447 *                                                                    CL**3
00448      MOVE SPACES                       TO WRK-NAME.                  CL**3
00449      MOVE LOW-VALUE                    TO WNAM-REC.                  CL**3
00450      MOVE WGP-SSN                      TO WNAM-SSN WRK-SSN.          CL**3
00451      PERFORM 130-READ-NAME             THRU 130-READ-NAME-EXIT.      CL**3
00452      MOVE WRK-LNAME                    TO  EMPLOYEE-LAST-NAME-G      CL**3
00453      MOVE WRK-FNAME                    TO  EMPLOYEE-FIRST-NAME-G     CL**3
00454      MOVE WRK-INAME                    TO  EMPLOYEE-MID-INIT-G       CL**3
00455      WRITE WAGE-REC-G.                                            DTSBX465
00456      MOVE SPACES TO WAGE-REC-G.                                   DTSBX465
00457  050-W-G-A-EXT.                                                   DTSBX465
00458      EXIT.                                                        DTSBX465
00459  100-WRITE-BUSINESS-ACCOUNTS.                                     DTSBX465
00460                                                                   DTSBX465
00461      ADD 1 TO BUSINESS-WAGES.                                     DTSBX465
00462      MOVE WGP-SSN TO EMPLOYEE-SSN.                                DTSBX465
00463      MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER.                         DTSBX465
00464      MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM.                DTSBX465
00465      MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES.                 DTSBX465
00466 *    MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME.                        CL**3
00467      MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE.                  DTSBX465
00468      MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER.              DTSBX465
00469      MOVE SPACES                       TO WRK-NAME.                  CL**3
00470      MOVE LOW-VALUE                    TO WNAM-REC.                  CL**3
00471      MOVE WGP-SSN                      TO WNAM-SSN WRK-SSN.          CL**3
00472      PERFORM 130-READ-NAME             THRU 130-READ-NAME-EXIT.      CL**3
00473      MOVE WRK-LNAME                    TO  EMPLOYEE-LAST-NAME        CL**3
00474      MOVE WRK-FNAME                    TO  EMPLOYEE-FIRST-NAME       CL**3
00475      MOVE WRK-INAME                    TO  EMPLOYEE-MID-INIT         CL**3
00476      WRITE WAGE-REC.                                              DTSBX465
00477      MOVE SPACES TO WAGE-REC.                                     DTSBX465
00478                                                                   DTSBX465
00479  100-W-B-A-EXT.                                                   DTSBX465
00480      EXIT.                                                        DTSBX465
00481  S-2-D-EX.                                                        DTSBX465
00482      EXIT.                                                        DTSBX465
00483  110-FEIN-LOOK-UP.                                                DTSBX465
00484                                                                   DTSBX465
00485      MOVE ZEROS TO FEDERAL-ID-NUMBER-WS.                          DTSBX465
00486      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBX465
00487                                                                   DTSBX465
00488      MOVE WGD-ACCOUNT-NUMBER TO MSKL-EMP-NO.                      DTSBX465
00489      SET MSKL-PRF-88 TO TRUE.                                        CL*14
00490 *    SET L910-READ-88 TO TRUE.                                       CL*14
00491                                                                   DTSBX465
00492 *    PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT.                  CL*14
00493      PERFORM 115-S910-READ THRU 115-S910-READ-EXIT                   CL*14
00494                                                                   DTSBX465
00495      IF L910-NO-REC-88                                            DTSBX465
00496         DISPLAY 'ACCT NOT IN DTS: ' WGD-ACCOUNT-NUMBER               CL*15
00497         GO TO 110-FLU-EXIT.                                       DTSBX465
00498                                                                   DTSBX465
00499      MOVE MSKL-REC TO MPRF-REC.                                   DTSBX465
00500                                                                   DTSBX465
00501 *    IF MPRF-STATUS-ACT-88                                           CL*15
00502 *       NEXT SENTENCE                                                CL*15
00503 *    ELSE                                                            CL*15
00504 *      DISPLAY ' ACCT NOT ACTIVE ' MPRF-FEIN                         CL*15
00505 *      SET L910-NO-REC-88 TO TRUE                                    CL*15
00506 *       GO TO 110-FLU-EXIT.                                          CL*15
00507                                                                   DTSBX465
00508      MOVE MPRF-FEIN TO FEDERAL-ID-NUMBER-WS.                      DTSBX465
00509                                                                   DTSBX465
00510  110-FLU-EXIT.                                                    DTSBX465
00511      EXIT.                                                        DTSBX465
00512                                                                   DTSBX465
00513  114-S910-OPEN-READ.                                              DTSBX465
00514      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX465
00515      PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT.               DTSBX465
00516  114-S910-OPEN-READ-EXIT.                                         DTSBX465
00517      EXIT.                                                        DTSBX465
00518                                                                   DTSBX465
00519  115-S910-READ.                                                   DTSBX465
00520      SET L910-READ-88 TO TRUE.                                    DTSBX465
00521      PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT.               DTSBX465
00522  115-S910-READ-EXIT.                                              DTSBX465
00523      EXIT.                                                        DTSBX465
00524                                                                   DTSBX465
00525  116-S910-CLOSE.                                                  DTSBX465
00526      SET L910-CLOSE-88 TO TRUE.                                   DTSBX465
00527      PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT.               DTSBX465
00528  116-S910-CLOSE-EXIT.                                             DTSBX465
00529      EXIT.                                                        DTSBX465
00530                                                                   DTSBX465
00531  120-READ-MPRF.                                                   DTSBX465
00532      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX465
00533                            MSKL-REC.                              DTSBX465
00534  120-READ-MPRF-EXIT.                                              DTSBX465
00535      EXIT.                                                        DTSBX465
00536                                                                      CL**2
00537  130-READ-NAME.                                                      CL**2
00538 ******************************************************************DTSBX465
00539 *           SEARCH FOR NAME ON WAGE NAME FILE          *             CL**2
00540 ******************************************************************DTSBX465
00541                                                                      CL**2
00542      PERFORM S982A-START-BROWSE        THRU S982A-EXIT.              CL**2
00543                                                                      CL**2
00544      IF NOT L982-OK-88                                               CL**2
00545        DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN                      CL**2
00546        GO TO 130-READ-NAME-EXIT                                      CL**4
00547      END-IF.                                                         CL**2
00548                                                                      CL**2
00549      MOVE WNAM-SSN  TO W-SSN.                                        CL**2
00550                                                                      CL**2
00551      IF WRK-SSN = W-SSN                                              CL**2
00552         MOVE WNAM-LAST-NAME    TO WRK-LNAME                          CL**3
00553         MOVE WNAM-FIRST-NAME   TO WRK-FNAME                          CL**3
00554         MOVE WNAM-MID-INIT     TO WRK-INAME                          CL**3
00555      ELSE                                                            CL**2
00556        DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN.                     CL**2
00557  130-READ-NAME-EXIT.                                                 CL**2
00558      EXIT.                                                           CL**2
00559 ******************************************************************   CL**2
00560 *                     TERMINATION ROUTINE                        *   CL**2
00561 ******************************************************************   CL**2
00562  TERM0100-CLOSE-FILES.                                            DTSBX465
00563      CLOSE WAGE-FILE, WAGE-FILE-G, WAGE-FILE-F.                   DTSBX465
00564                                                                   DTSBX465
00565      MOVE 'C' TO DBW-COMMAND-CODE.                                DTSBX465
00566      PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT.         DTSBX465
00567                                                                   DTSBX465
00568      PERFORM 116-S910-CLOSE THRU 116-S910-CLOSE-EXIT.             DTSBX465
00569                                                                   DTSBX465
00570      DISPLAY 'NUMBER RECORDS READ  ***  ' RECS-IN.                DTSBX465
00571      DISPLAY '  ' .                                               DTSBX465
00572      DISPLAY 'DC WAGES       ' DC-WAGES.                          DTSBX465
00573      DISPLAY 'BUSINESS WAGES ' BUSINESS-WAGES.                    DTSBX465
00574      DISPLAY 'FEDRAL WAGES   ' FED-WAGES.                         DTSBX465
00575      DISPLAY '  ' .                                               DTSBX465
00576      DISPLAY 'NUMBER RECORDS PRINTED  ***   ' RECS-OUT.           DTSBX465
00577      STOP RUN.                                                    DTSBX465
00578  TERM0100-EXIT.                                                   DTSBX465
00579      EXIT.                                                        DTSBX465
00580      EJECT                                                        DTSBX465
00581 ******************************************************************DTSBX465
00582 *                         SERVICE ROUTINES                       *DTSBX465
00583 ******************************************************************DTSBX465
00584  SERV1001-READ-MASTER.                                            DTSBX465
00585      MOVE 'R' TO DBW-COMMAND-CODE.                                DTSBX465
00586      PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT.         DTSBX465
00587  SERV1001-EXIT.                                                   DTSBX465
00588      EXIT.                                                        DTSBX465
00589  SERV2001-RESET-MASTER.                                           DTSBX465
00590      MOVE 'S' TO DBW-COMMAND-CODE.                                DTSBX465
00591      PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT.         DTSBX465
00592  SERV2001-EXIT.                                                   DTSBX465
00593      EXIT.                                                        DTSBX465
00594  SERV9001-ACCESS-DATABASE.                                        DTSBX465
00595      IF DBW-SEGNAME = 'SG01'                                      DTSBX465
00596      CALL 'EWG960D'                                               DTSBX465
00597        USING VSAM-WAGEDATA-CONTROL-BLOCK.                         DTSBX465
00598      IF DBW-SEGNAME = 'SG02'                                      DTSBX465
00599      CALL 'EWG960D'                                               DTSBX465
00600        USING VSAM-WAGEDATA-CONTROL-BLOCK.                         DTSBX465
00601  SERV9001-EXIT.                                                   DTSBX465
00602      EXIT.                                                        DTSBX465
00603                                                                   DTSBX465
00604  S001-FROM-CAL-6.                                                 DTSBX465
00605      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBX465
00606      GO TO S001-DATE.                                             DTSBX465
00607                                                                   DTSBX465
00608  S001-FROM-FED-8.                                                 DTSBX465
00609      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX465
00610      GO TO S001-DATE.                                             DTSBX465
00611                                                                   DTSBX465
00612  S001-FROM-ABS.                                                   DTSBX465
00613      SET L001-FROM-ABS-DAY  TO TRUE.                              DTSBX465
00614      GO TO S001-DATE.                                             DTSBX465
00615                                                                   DTSBX465
00616  S001-DATE.                                                       DTSBX465
00617      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX465
00618  S001-EXIT.                                                       DTSBX465
00619      EXIT.                                                        DTSBX465
00620                                                                   DTSBX465
00621  S004-FROM-DATE.                                                  DTSBX465
00622      SET L004-FROM-DATE TO TRUE.                                  DTSBX465
00623      GO TO S004-YRQ.                                              DTSBX465
00624                                                                   DTSBX465
00625  S004-YRQ.                                                        DTSBX465
00626      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX465
00627  S004-EXIT.                                                       DTSBX465
00628      EXIT.                                                        DTSBX465
00629  S982O-OPEN-READ.                                                    CL**5
00630      SET L982-OPEN-READ-88 TO TRUE.                                  CL**5
00631      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00632                                                                      CL**3
00633  S982O-EXIT.                                                         CL**3
00634      EXIT.                                                           CL**3
00635                                                                      CL**3
00636  S982A-START-BROWSE.                                                 CL**3
00637      SET L982-START-BROWSE-88 TO TRUE.                               CL**3
00638      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00639                                                                      CL**3
00640  S982A-EXIT.                                                         CL**3
00641      EXIT.                                                           CL**3
00642  S982B-READ-NEXT.                                                    CL**3
00643      SET L982-READ-NEXT-88    TO TRUE.                               CL**3
00644      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00645                                                                      CL**3
00646  S982B-EXIT.                                                         CL**3
00647      EXIT.                                                           CL**3
00648  S982C-WRITE.                                                        CL**3
00649      SET L982-WRITE-88        TO TRUE.                               CL**3
00650      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00651                                                                      CL**3
00652  S982C-EXIT.                                                         CL**3
00653      EXIT.                                                           CL**3
00654                                                                      CL**3
00655  S982D-REWRITE.                                                      CL**3
00656      SET L982-REWRITE-88        TO TRUE.                             CL**3
00657      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00658  S982D-EXIT.                                                         CL**3
00659      EXIT.                                                           CL**3
00660  S982F-CLOSE.                                                        CL**3
00661      SET L982-CLOSE-88        TO TRUE.                               CL**3
00662      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00663                                                                      CL**3
00664  S982F-EXIT.                                                         CL**3
00665      EXIT.                                                           CL**3
00666                                                                      CL**3
00667  S982Z-WNAM-IO.                                                      CL**3
00668      CALL 'DTSBU982' USING L982-LINK-AREA                            CL**3
00669                           WNAM-REC.                                  CL**3
00670  S982Z-EXIT.                                                         CL**3
00671      EXIT.                                                           CL**3
00672                                                                      CL**3
00673                                                                   DTSBX465
00674  S999-ABEND.                                                      DTSBX465
00675      DISPLAY '****  DTSBX465 ABENDING '                           DTSBX465
00676         ABEND-MSG.                                                DTSBX465
00677      CALL ABEND-MOD USING ABEND-CODE.                             DTSBX465
00678                                                                   DTSBX465
00679  S999-EXIT.                                                       DTSBX465
00680      EXIT.                                                        DTSBX465
00681                                                                   DTSBX465
