00001  IDENTIFICATION DIVISION.                                         06/02/25
00002  PROGRAM-ID.    DTSBX468.                                         DTSBX468
00003                                                                      LV054
00004 ******************************************************************DTSBX468
00005 *                                                                *DTSBX468
00006 *    FUNCTION: CREATE QUARTERLY WAGE FILE FOR NDNH.              *   CL*17
00007 *                                                                *DTSBX468
00008 *    FUNCTION:                                                   *DTSBX468
00009 *                                                                *DTSBX468
00010 *      THE FUNCTION OF DTSBX465 IS TO GENERATE A UI QTR WAGE     *DTSBX468
00011 *      FILE FOR THE OFFICE OF TAX AND REVENUE.  UI WAGE DATA     *DTSBX468
00012 *      WILL BE EXTRACTED FOR A GIVEN QUARTER PERIOD BASED ON     *DTSBX468
00013 *      THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE.          *DTSBX468
00014 *                                                                *DTSBX468
00015 *      CONTACT: WALTER GOETZ  202-442-6312 TAX AND REVENUE(OTR)  *DTSBX468
00016 *                                                                *DTSBX468
00017 *                      G.A.BROWN                                 *DTSBX468
00018 ******************************************************************DTSBX468
00019 *                                                                 DTSBX468
00020 *    MODIFICATION HISTORY:                                        DTSBX468
00021 *                                                                 DTSBX468
00022 * 03-07-2005 MODIFIED SYSIN PARM ACCEPT CARD TO ACCEPT BLANK      DTSBX468
00023 *            ON QUARTERLY FROM-DATE AND TO-DATE AS THE DEFAULT    DTSBX468
00024 *            FROM THE HEADER RECORD COMPLETE QUARTER BEGIN DATE   DTSBX468
00025 *            AND THE COMPLETE QUARTER END DATE FIELDS. IF THE     DTSBX468
00026 *            INVALID QTR FROM-DATE AND QTR TO-DATE ENTERED,       DTSBX468
00027 *            THE PROGRAM EDITING RESULTS WILL ABEND.              DTSBX468
00028 *            REFERENCE RFP: STEVE                  PROGRAMMER: RLWDTSBX468
00029 *                                                                 DTSBX468
00030 * 06-17-2018 MODIFIED PROGRAM TO READ WAGE NAME FILE AN OUTPUT       CL**8
00031 *            FULL NAME ON OUTPUT WAGE FILE TO OTR                    CL**8
00032 *            REFERENCE RFP: STEVE                  PROGRAMMER: ZL1   CL**8
00033 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX468
00034 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX468
00035 *            REFERENCE RFP #****                   PROGRAMMER: XXXDTSBX468
00036 *****                                                             DTSBX468
00037                                                                   DTSBX468
00038  ENVIRONMENT     DIVISION.                                        DTSBX468
00039  CONFIGURATION SECTION.                                           DTSBX468
00040  SPECIAL-NAMES.  C01 IS TOP-OF-PAGE.                              DTSBX468
00041  INPUT-OUTPUT SECTION.                                            DTSBX468
00042  FILE-CONTROL.                                                    DTSBX468
00043      SELECT WAGE-FILE ASSIGN TO UT-S-BUSINES.                     DTSBX468
00044 *    SELECT WAGE-FILE-G ASSIGN TO UT-S-GOVT.                         CL*19
00045 *    SELECT WAGE-FILE-F ASSIGN TO UT-S-FED.                          CL*19
00046  DATA DIVISION.                                                   DTSBX468
00047  FILE SECTION.                                                    DTSBX468
00048                                                                   DTSBX468
00049  FD  WAGE-FILE                                                    DTSBX468
00050      RECORDING MODE IS F.                                            CL*21
00051  01  WAGE-REC             PIC X(601).                                CL*19
00052                                                                   DTSBX468
00053                                                                   DTSBX468
00054 ******************************************************************DTSBX468
00055 *                  WORKING STORAGE SECTION                       *DTSBX468
00056 ******************************************************************DTSBX468
00057  WORKING-STORAGE SECTION.                                         DTSBX468
000575 77  PAN-VALET PICTURE X(24) VALUE '054DTSBX468  06/02/25'.       DTSBX468
00058                                                                   DTSBX468
00059  01  SELECT-CARD.                                                 DTSBX468
00060      03  PRG-NAME  PIC X(10) VALUE '**DTSBX465'.                  DTSBX468
00061      03  FIL       PIC XX.                                        DTSBX468
00062      03  FROM-ACTIVITY-DATE    PIC 9(8).                          DTSBX468
00063      03  FIL         PIC X.                                       DTSBX468
00064      03  TO-ACTIVITY-DATE      PIC 9(8).                          DTSBX468
00065      03  FIL         PIC X VALUE SPACE.                           DTSBX468
00066      03  DCGOVT      PIC X(3).                                    DTSBX468
00067      03  FIL         PIC X.                                       DTSBX468
00068      03  FEDGOVT     PIC X(3).                                    DTSBX468
00069      03  FIL         PIC X.                                       DTSBX468
00070      03  BUSINESS    PIC X(3).                                    DTSBX468
00071      03  FIL         PIC X(39).                                   DTSBX468
00072                                                                   DTSBX468
00073  01  COUNTERS.                                                    DTSBX468
00074      03  FEDERAL-ID-NUMBER-WS   PIC 9(9).                         DTSBX468
00075      03  STOP-RECS              PIC 9(5).                            CL*46
00076      03  UNMATCH-SW             PIC X.                               CL*46
00077      03  ALL-NINES              PIC 9.                               CL*46
00078      03  RECS-IN         PIC 9(9).                                DTSBX468
00079      03  RECS-OUT        PIC 9(9).                                DTSBX468
00080      03  QTR-WAGES       PIC 9(9).                                DTSBX468
00081      03  WRK-ZIP.                                                    CL*18
00082          05  WRK-ZIPA    PIC X(05).                                  CL*18
00083          05  FILLER      PIC X(01).                                  CL*18
00084          05  WRK-ZIPB    PIC X(04).                                  CL*18
00085      03  DC-WAGES        PIC 9(9).                                DTSBX468
00086                                                                      CL*46
00087      03  WRK-YEAR-QUARTER PIC 9(5).                                  CL*47
00088      03  WRK-YEARZ REDEFINES WRK-YEAR-QUARTER.                       CL*46
00089          05  WRK-YEAR-YR  PIC 9(4).                                  CL*18
00090          05  WRK-YEAR-Q   PIC 9(1).                                  CL*18
00091                                                                      CL*46
00092      03  FED-WAGES       PIC 9(9).                                DTSBX468
00093      03  BUSINESS-WAGES  PIC 9(9).                                DTSBX468
00094      03  DC-ACCT         PIC 9(6).                                DTSBX468
00095      03  EMP-ACCT-HOLD     PIC 9(6).                              DTSBX468
00096      03  EMP-ACCT-HOLD-RED   PIC 9(6).                            DTSBX468
00097      03  EMP-ACCT-HOLD-WS REDEFINES EMP-ACCT-HOLD-RED.            DTSBX468
00098          05  ACCT-FOUR   PIC 9(4).                                DTSBX468
00099          05  ACCT-THREE-WS  REDEFINES ACCT-FOUR.                  DTSBX468
00100             07  ACCT-THREE-RED   PIC 9(3).                        DTSBX468
00101             07  ACCT-FIL         PIC 9.                           DTSBX468
00102          05  ACCT-TWO    PIC 99.                                  DTSBX468
00103                                                                   DTSBX468
00104      03  W-SSN                       PIC S9(09)  COMP-3  VALUE 0.    CL**2
00105      03  WRK-SSN                     PIC S9(09)  COMP-3  VALUE 0.    CL**2
00106      03  ABEND-CODE                  PIC S9(04)  COMP                CL**2
00107                                  VALUE +465.                      DTSBX468
00108      03  ABEND-MOD                   PIC  X(08)                   DTSBX468
00109                                  VALUE 'DTSBU999'.                DTSBX468
00110      03  ABEND-MSG                   PIC  X(60).                  DTSBX468
00111                                                                   DTSBX468
00112      03  WRK-BEGIN-DATE              PIC S9(09) COMP-3.           DTSBX468
00113      03  WRK-END-DATE                PIC S9(09) COMP-3.           DTSBX468
00114                                                                   DTSBX468
00115      03  WRK-BEGIN-DATE-DISP         PIC  9(08).                  DTSBX468
00116      03  FILLER REDEFINES WRK-BEGIN-DATE-DISP.                    DTSBX468
00117          05  WRK-BEGIN-YR            PIC  9(04).                  DTSBX468
00118          05  WRK-BEGIN-MO            PIC  9(02).                  DTSBX468
00119          05  WRK-BEGIN-DA            PIC  9(02).                  DTSBX468
00120                                                                   DTSBX468
00121      03  WRK-END-DATE-DISP           PIC  9(08).                  DTSBX468
00122      03  FILLER REDEFINES WRK-END-DATE-DISP.                      DTSBX468
00123          05  WRK-END-YR              PIC  9(04).                  DTSBX468
00124          05  WRK-END-MO              PIC  9(02).                  DTSBX468
00125          05  WRK-END-DA              PIC  9(02).                  DTSBX468
00126                                                                      CL**3
00127      03  WRK-NAME.                                                   CL**3
00128          05 WRK-LNAME                PIC X(20) VALUE SPACES.         CL**3
00129          05 WRK-FNAME                PIC X(15) VALUE SPACES.         CL**3
00130          05 WRK-INAME                PIC X(01) VALUE SPACES.         CL**3
00131  01  HEADER-RECORD.                                                  CL*27
00132      05  HEADER-IDENTIFIER            PIC X(02)  VALUE 'HQ'.         CL*27
00133      05  HEADER-STATE-CODE            PIC 9(02)  VALUE 11.           CL*27
00134      05  HEADER-AGENCY-CODE           PIC X(09)  VALUE SPACES.       CL*27
00135      05  HEADER-TRANSMISSION-TYPE     PIC X(02)  VALUE 'QW'.         CL*27
00136      05  FILLER                       PIC X(01)  VALUE SPACE.        CL*27
00137      05  HEADER-VERSION-CONTROL       PIC X(02)  VALUE '01'.         CL*27
00138      05  HEADER-DATE-STAMP            PIC 9(08)  VALUE 20250531.     CL*54
00139      05  FILLER REDEFINES HEADER-DATE-STAMP.                         CL*27
00140          10  HEADER-DATE-STAMP-CC     PIC 9(02).                     CL*27
00141          10  HEADER-DATE-STAMP-YY     PIC 9(02).                     CL*27
00142          10  HEADER-DATE-STAMP-MM     PIC 9(02).                     CL*27
00143          10  HEADER-DATE-STAMP-DD     PIC 9(02).                     CL*27
00144      05  HEADER-BATCH-NUMBER          PIC 9(06) VALUE 000210.        CL*27
00145      05  FILLER                       PIC X(263) VALUE SPACES.       CL*27
00146                                                                      CL*28
00147  01  TRAILER-RECORD.                                                 CL*28
00148      05  TRAILER-IDENTIFIER           PIC X(02)  VALUE 'TQ'.         CL*28
00149      05  TRAILER-RECORD-COUNT         PIC 9(11)  VALUE 2.            CL*28
00150      05  FILLER                       PIC X(282) VALUE SPACES.       CL*28
00151                                                                      CL*28
00152                                                                      CL*33
00153  01  L981-LINK-AREA.                                                 CL*33
00154  ++INCLUDE DTSIL981                                                  CL*33
00155                                                                      CL*33
00156  01  WWGH-REC.                                                       CL*33
00157  ++INCLUDE DTSIWWGH                                                  CL*33
00158                                                                      CL*33
00159                                                                      CL*27
00160  01  NDNH-LINK-AREA.                                                 CL*17
00161  ++INCLUDE DTSQWREC                                                  CL*18
00162                                                                      CL*17
00163  01  L001-LINK-AREA.                                              DTSBX468
00164  ++INCLUDE DTSIL001                                               DTSBX468
00165                                                                   DTSBX468
00166  01  L004-LINK-AREA.                                              DTSBX468
00167  ++INCLUDE DTSIL004                                               DTSBX468
00168                                                                   DTSBX468
00169  01  L910-LINK-AREA.                                              DTSBX468
00170  ++INCLUDE DTSIL910                                               DTSBX468
00171                                                                      CL**3
00172  01  L982-LINK-AREA.                                                 CL**3
00173  ++INCLUDE DTSIL982                                                  CL**3
00174                                                                   DTSBX468
00175  01  MSKL-REC.                                                    DTSBX468
00176  ++INCLUDE DTSIMSKL                                               DTSBX468
00177                                                                   DTSBX468
00178  01  MHDR-REC.                                                    DTSBX468
00179  ++INCLUDE DTSIMHDR                                               DTSBX468
00180                                                                   DTSBX468
00181                                                                      CL*19
00182  01  MTAD-REC.                                                       CL*19
00183  ++INCLUDE DTSIMTAD                                                  CL*19
00184                                                                      CL*19
00185  01  MPRF-REC.                                                    DTSBX468
00186  ++INCLUDE DTSIMPRF                                               DTSBX468
00187                                                                      CL**3
00188  01  WNAM-REC.                                                       CL**3
00189  ++INCLUDE DTSIWNAM                                                  CL**3
00190                                                                      CL**3
00191 *01  COMMON-LINKAGE-SECTION.                                         CL*33
00192 *++INCLUDE EWGLINKB                                                  CL*33
00193      EJECT                                                        DTSBX468
00194   EJECT                                                           DTSBX468
00195 ******************************************************************DTSBX468
00196 *               PROCEDURE DIVISION - CONTROL PROCEDURE           *DTSBX468
00197 ******************************************************************DTSBX468
00198  PROCEDURE DIVISION.                                              DTSBX468
00199  BEGIN00000.                                                      DTSBX468
00200      OPEN OUTPUT WAGE-FILE.                                          CL*18
00201      WRITE WAGE-REC FROM HEADER-RECORD.                              CL*27
00202                                                                   DTSBX468
00203      PERFORM 114-S910-OPEN-READ THRU 114-S910-OPEN-READ-EXIT.     DTSBX468
00204      PERFORM S981A1-OPEN-READ   THRU S981A1-EXIT.                    CL*36
00205        IF NOT L981-OK-88                                             CL*40
00206           DISPLAY ' OPEN WWGH VSAM FAILED ' WWGH-KEY-AREA            CL*44
00207           PERFORM S999-ABEND THRU S999-EXIT.                         CL*40
00208                                                                      CL*40
00209      PERFORM S982O-OPEN-READ    THRU S982O-EXIT.                     CL*33
00210        IF NOT L982-OK-88                                             CL*44
00211           DISPLAY ' OPEN NAME VSAM FAILED '                          CL*44
00212           PERFORM S999-ABEND THRU S999-EXIT.                         CL*44
00213                                                                      CL*44
00214                                                                   DTSBX468
00215      MOVE ZEROS TO COUNTERS.                                      DTSBX468
00216      MOVE ZERO TO WRK-BEGIN-DATE                                  DTSBX468
00217                   WRK-END-DATE.                                   DTSBX468
00218                                                                   DTSBX468
00219  MAIN0100-INITIATE.                                               DTSBX468
00220      ACCEPT SELECT-CARD.                                          DTSBX468
00221      DISPLAY  '  '.                                               DTSBX468
00222      DISPLAY  '  '  SELECT-CARD.                                  DTSBX468
00223      DISPLAY  '  '.                                               DTSBX468
00224      DISPLAY  ' PROGRAM   ' PRG-NAME.                             DTSBX468
00225      DISPLAY  ' FROM-DATE ' FROM-ACTIVITY-DATE.                   DTSBX468
00226      DISPLAY  ' TO-DATE   ' TO-ACTIVITY-DATE.                     DTSBX468
00227      DISPLAY  ' DC GOVT   ' DCGOVT                                DTSBX468
00228      DISPLAY  ' FED GOVT  ' FEDGOVT                               DTSBX468
00229      DISPLAY  ' BUSINESS  ' BUSINESS                              DTSBX468
00230      DISPLAY  '  '.                                               DTSBX468
00231      DISPLAY  '  '.                                               DTSBX468
00232                                                                   DTSBX468
00233      IF (FROM-ACTIVITY-DATE = SPACES OR LOW-VALUES)               DTSBX468
00234      AND (TO-ACTIVITY-DATE = SPACES OR LOW-VALUES)                DTSBX468
00235         PERFORM INIT0300-DEFAULT-DATES THRU INIT0300-EXIT         DTSBX468
00236      ELSE                                                         DTSBX468
00237         PERFORM INIT0100-BEGIN-DATE THRU INIT0100-EXIT            DTSBX468
00238         PERFORM INIT0200-END-DATE THRU INIT0200-EXIT.             DTSBX468
00239                                                                   DTSBX468
00240      IF WRK-END-DATE < WRK-BEGIN-DATE                             DTSBX468
00241          MOVE 'PERIOD END LESS THAN PERIOD BEGIN'                 DTSBX468
00242             TO ABEND-MSG                                          DTSBX468
00243          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX468
00244                                                                   DTSBX468
00245      MOVE WRK-BEGIN-DATE TO WRK-BEGIN-DATE-DISP.                  DTSBX468
00246      MOVE WRK-END-DATE TO WRK-END-DATE-DISP.                      DTSBX468
00247      DISPLAY  '  '.                                               DTSBX468
00248      DISPLAY  ' DEFAULT FROM DATE - ' WRK-BEGIN-DATE-DISP.           CL*34
00249      DISPLAY  ' DEFAULT TO-DATE   - ' WRK-END-DATE-DISP.             CL*34
00250      DISPLAY  '  '.                                               DTSBX468
00251                                                                   DTSBX468
00252      PERFORM P0000-PROCESS THRU P0000-EXIT.                          CL*34
00253      PERFORM P9999-TERMINATE THRU P9999-EXIT.                        CL*34
00254      STOP RUN.                                                       CL*35
00255                                                                   DTSBX468
00256  INIT0100-BEGIN-DATE.                                             DTSBX468
00257      MOVE FROM-ACTIVITY-DATE TO L001-FED-8-DATE-X.                DTSBX468
00258      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBX468
00259      IF L001-VALID-DATE                                           DTSBX468
00260         MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE                  DTSBX468
00261      ELSE                                                         DTSBX468
00262         MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG             DTSBX468
00263         PERFORM S999-ABEND THRU S999-EXIT                            CL*35
00264      END-IF.                                                         CL*31
00265                                                                   DTSBX468
00266 *    MOVE WRK-BEGIN-DATE TO L004-DATE.                               CL*31
00267 *    PERFORM S004-FROM-DATE THRU S004-EXIT.                          CL*31
00268 *    IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE                     CL*31
00269 *       MOVE 'PERIOD BEGIN NOT START OF QTR'                         CL*31
00270 *                                TO ABEND-MSG                        CL*31
00271 *       PERFORM S999-ABEND THRU S999-EXIT                            CL*31
00272                                                                   DTSBX468
00273  INIT0100-EXIT.                                                   DTSBX468
00274      EXIT.                                                        DTSBX468
00275                                                                   DTSBX468
00276  INIT0200-END-DATE.                                               DTSBX468
00277      MOVE TO-ACTIVITY-DATE TO L001-FED-8-DATE-X.                  DTSBX468
00278      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBX468
00279      IF L001-VALID-DATE                                           DTSBX468
00280         MOVE L001-FED-8-DATE-9 TO WRK-END-DATE                    DTSBX468
00281      ELSE                                                         DTSBX468
00282         MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG               DTSBX468
00283         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBX468
00284                                                                   DTSBX468
00285 *    MOVE WRK-END-DATE TO L004-DATE.                                 CL*31
00286 *    PERFORM S004-FROM-DATE THRU S004-EXIT.                          CL*31
00287 *    IF WRK-END-DATE NOT = L004-QTR-END-DATE                         CL*31
00288 *       DISPLAY ' END DT ' L004-QTR-END-DATE                         CL*31
00289 *       MOVE 'PERIOD END NOT END OF QTR'                             CL*31
00290 *                                TO ABEND-MSG                        CL*31
00291 *       PERFORM S999-ABEND THRU S999-EXIT                            CL*31
00292 *    END-IF.                                                         CL*31
00293                                                                   DTSBX468
00294  INIT0200-EXIT.                                                   DTSBX468
00295      EXIT.                                                        DTSBX468
00296                                                                   DTSBX468
00297  INIT0300-DEFAULT-DATES.                                          DTSBX468
00298                                                                   DTSBX468
00299      MOVE LOW-VALUES           TO MSKL-KEY-AREA.                  DTSBX468
00300      MOVE +0                   TO MSKL-EMP-NO.                    DTSBX468
00301      SET MSKL-HDR-88           TO TRUE.                           DTSBX468
00302      PERFORM 115-S910-READ THRU 115-S910-READ-EXIT.               DTSBX468
00303                                                                   DTSBX468
00304      IF L910-NO-REC-88                                            DTSBX468
00305         MOVE 'MHDR RECORD IS MISSING'                             DTSBX468
00306                                TO ABEND-MSG                       DTSBX468
00307         PERFORM S999-ABEND     THRU S999-EXIT.                    DTSBX468
00308                                                                   DTSBX468
00309      MOVE MSKL-REC             TO MHDR-REC.                       DTSBX468
00310                                                                   DTSBX468
00311      MOVE MHDR-CMPL-QTR-BEGIN-DATE                                DTSBX468
00312                                TO WRK-BEGIN-DATE.                 DTSBX468
00313      MOVE MHDR-CMPL-QTR-END-DATE                                  DTSBX468
00314                                TO WRK-END-DATE.                   DTSBX468
00315                                                                   DTSBX468
00316      MOVE WRK-BEGIN-DATE TO FROM-ACTIVITY-DATE.                   DTSBX468
00317      MOVE WRK-END-DATE TO TO-ACTIVITY-DATE.                       DTSBX468
00318                                                                   DTSBX468
00319  INIT0300-EXIT.                                                   DTSBX468
00320      EXIT.                                                        DTSBX468
00321                                                                   DTSBX468
00322  P0000-PROCESS.                                                      CL*33
00323 *    DISPLAY  'P0000 PROCESSED   '.                                  CL*49
00324 *    DISPLAY ' WWGH KEY AREA'  WWGH-KEY-AREA.                        CL*49
00325      MOVE LOW-VALUES TO WWGH-KEY-AREA.                               CL*41
00326                                                                      CL*33
00327      MOVE 010021      TO WWGH-EMP-NO.                                CL*33
00328      MOVE 20191       TO WWGH-YRQ.                                   CL*33
00329      MOVE 000000000   TO WWGH-SSN.                                   CL*42
00330                                                                      CL*33
00331 *         DISPLAY ' BEFORE BROWSE ********* ' WWGH-KEY-AREA          CL*49
00332      PERFORM S981X-START-BROWSE THRU S981X-EXIT.                     CL*43
00333 *         DISPLAY ' AFTER  BROWSE ********* ' WWGH-KEY-AREA          CL*49
00334        IF NOT L981-OK-88                                             CL*43
00335           DISPLAY ' BROWSE FAILED ********* ' WWGH-KEY-AREA          CL*43
00336           PERFORM S999-ABEND THRU S999-EXIT.                         CL*43
00337                                                                      CL*33
00338 *    PERFORM S981C-READ      THRU S981C-EXIT.                        CL*43
00339 *      IF NOT L981-OK-88                                             CL*43
00340 *         DISPLAY ' READ FAILED ********* ' WWGH-KEY-AREA            CL*43
00341 *         PERFORM S999-ABEND THRU S999-EXIT.                         CL*43
00342                                                                      CL*33
00343      PERFORM P1000-FIND-QTR-WAGE THRU P1000-EXIT                     CL*33
00344            UNTIL L981-NO-REC-88.                                     CL*34
00345  P0000-EXIT.                                                         CL*33
00346      EXIT.                                                        DTSBX468
00347                                                                   DTSBX468
00348  P1000-FIND-QTR-WAGE.                                                CL*33
00349 **********************************************************        DTSBX468
00350 *  ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS         DTSBX468
00351 ******* **************************************************        DTSBX468
00352 *    DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE.             DTSBX468
00353      ADD 1 TO RECS-IN.                                               CL*33
00354      IF WWGH-CHNG-DATE NOT LESS THAN FROM-ACTIVITY-DATE              CL*33
00355                          AND                                      DTSBX468
00356         WWGH-CHNG-DATE NOT GREATER THAN TO-ACTIVITY-DATE             CL*33
00357         NEXT SENTENCE                                                CL*33
00358      ELSE                                                            CL*33
00359       GO TO P1000-CONTINUE.                                          CL*33
00360                                                                   DTSBX468
00361 *    IF WWGH-CHNG-DATE > 20240227                                    CL*49
00362 *       DISPLAY 'FEB WAGES WWGH : ' WWGH-EMP-NO.                     CL*49
00363                                                                      CL*45
00364      MOVE WWGH-EMP-NO   TO EMP-ACCT-HOLD.                            CL*33
00365      MOVE EMP-ACCT-HOLD TO EMP-ACCT-HOLD-RED.                     DTSBX468
00366                                                                   DTSBX468
00367                                                                   DTSBX468
00368      PERFORM P4000-FEIN-LOOK-UP THRU P4000-EXIT.                     CL*33
00369                                                                   DTSBX468
00370      IF L910-NO-REC-88                                            DTSBX468
00371         DISPLAY 'ACCT NOT IN DTS: ' WWGH-EMP-NO                      CL*33
00372       GO TO P1000-CONTINUE.                                          CL*33
00373                                                                   DTSBX468
00374      PERFORM P2000-WRITE-QTR-WAGES THRU P2000-EXIT.                  CL*33
00375 *    IF DCGOVT = 'DCG'                                               CL*22
00376 *    IF EMP-ACCT-HOLD = 998888                                       CL*22
00377 *       PERFORM 050-WRITE-GOVERNMENT-ACCOUNTS THRU 050-W-G-A-EXT     CL*18
00378 *       PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT.      CL*22
00379 *       GO TO S-2-D-EX.                                              CL*22
00380                                                                   DTSBX468
00381 *    IF FEDGOVT = 'FED'                                              CL*22
00382 *    IF ACCT-THREE-RED = 000                                         CL*22
00383 *       PERFORM 025-WRITE-FEDERAL-ACCOUNTS THRU 025-W-F-A-EXT        CL*18
00384 *       PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT.      CL*22
00385 *       GO TO S-2-D-EX.                                              CL*22
00386                                                                   DTSBX468
00387                                                                   DTSBX468
00388  P1000-CONTINUE.                                                     CL*33
00389                                                                   DTSBX468
00390        PERFORM S981C2-READ-NEXT  THRU S981C2-EXIT.                   CL*33
00391  P1000-EXIT.                                                         CL*33
00392      EXIT.                                                           CL*33
00393                                                                      CL*33
00394  P2000-WRITE-QTR-WAGES.                                              CL*33
00395                                                                   DTSBX468
00396      ADD 1 TO BUSINESS-WAGES.                                     DTSBX468
00397      MOVE WWGH-SSN             TO EMPLOYEE-SSN.                      CL*33
00398      MOVE WWGH-YRQ             TO WRK-YEAR-QUARTER.                  CL*33
00399 *    DISPLAY 'YRQ '  WRK-YEAR-QUARTER.                               CL*48
00400      MOVE WRK-YEAR-YR          TO REPORTING-PERIOD-CCYY.             CL*18
00401      MOVE WRK-YEAR-Q           TO REPORTING-PERIOD-Q.                CL*18
00402      MOVE WWGH-EMP-NO          TO EMPLOYER-STATE-TAX-ID.             CL*50
00403      MOVE WWGH-EARNINGS        TO EMPLOYEE-DOLLARS.                  CL*33
00404      MOVE ZEROS                TO EMPLOYEE-CENTS.                    CL*18
00405 *    MOVE WGD-ACTIVITY-DATE    TO WAGE-UPDATE-DATE.                  CL*18
00406      MOVE FEDERAL-ID-NUMBER-WS TO EMPLOYER-FEIN.                     CL*18
00407                                                                      CL*41
00408      MOVE SPACES               TO WRK-NAME.                          CL*18
00409      MOVE LOW-VALUE            TO WNAM-REC.                          CL*18
00410      MOVE WWGH-SSN             TO WNAM-SSN WRK-SSN.                  CL*33
00411                                                                      CL*18
00412      PERFORM P3000-READ-NAME  THRU P3000-EXIT.                       CL*33
00413                                                                      CL*33
00414      MOVE WRK-LNAME            TO  EMPLOYEE-LAST-NAME                CL*18
00415      MOVE WRK-FNAME            TO  EMPLOYEE-FIRST-NAME               CL*18
00416      MOVE WRK-INAME            TO  EMPLOYEE-MIDDLE-NAME              CL*21
00417                                                                      CL*33
00418      PERFORM P2500-READ-MTAD     THRU P2500-EXIT.                    CL*33
00419                                                                      CL*33
00420      WRITE WAGE-REC   FROM NDNH-LINK-AREA.                           CL*23
00421      MOVE SPACES               TO WAGE-REC.                          CL*18
00422 *    DISPLAY 'FEIN ' EMPLOYER-FEIN ' SSN ' EMPLOYEE-SSN.             CL*33
00423                                                                   DTSBX468
00424 *    IF BUSINESS-WAGES > 10                                          CL*48
00425 *        GO TO P9999-TERMINATE.                                      CL*48
00426  P2000-EXIT.                                                         CL*33
00427      EXIT.                                                        DTSBX468
00428                                                                      CL*33
00429                                                                      CL*33
00430  P4000-FEIN-LOOK-UP.                                                 CL*33
00431                                                                   DTSBX468
00432      MOVE ZEROS TO FEDERAL-ID-NUMBER-WS.                          DTSBX468
00433      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBX468
00434                                                                   DTSBX468
00435      MOVE WWGH-EMP-NO  TO MSKL-EMP-NO.                               CL*33
00436      SET MSKL-PRF-88 TO TRUE.                                        CL*14
00437 *    SET L910-READ-88 TO TRUE.                                       CL*14
00438                                                                   DTSBX468
00439 *    PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT.                  CL*14
00440      PERFORM 115-S910-READ THRU 115-S910-READ-EXIT                   CL*14
00441                                                                   DTSBX468
00442      IF L910-NO-REC-88                                            DTSBX468
00443         DISPLAY 'ACCT NOT IN DTS: ' WWGH-EMP-NO                      CL*33
00444         GO TO P4000-EXIT.                                            CL*33
00445                                                                   DTSBX468
00446      MOVE MSKL-REC TO MPRF-REC.                                   DTSBX468
00447                                                                   DTSBX468
00448 *    IF MPRF-STATUS-ACT-88                                           CL*15
00449 *       NEXT SENTENCE                                                CL*15
00450 *    ELSE                                                            CL*15
00451 *      DISPLAY ' ACCT NOT ACTIVE ' MPRF-FEIN                         CL*15
00452 *      SET L910-NO-REC-88 TO TRUE                                    CL*15
00453 *       GO TO 110-FLU-EXIT.                                          CL*15
00454                                                                   DTSBX468
00455      MOVE MPRF-FEIN TO FEDERAL-ID-NUMBER-WS.                      DTSBX468
00456      MOVE MPRF-PRIMARY-NAME TO EMPLOYER-NAME.                        CL*18
00457 *    IF MPRF-EMP-NO = 998888                                         CL*45
00458 *       DISPLAY ' DCGOV ID ' FEDERAL-ID-NUMBER-WS                    CL*45
00459 *                ' '  EMPLOYER-NAME.                                 CL*45
00460  P4000-EXIT.                                                         CL*33
00461      EXIT.                                                        DTSBX468
00462                                                                      CL*18
00463  P2500-READ-MTAD.                                                    CL*33
00464      MOVE LOW-VALUE              TO MTAD-REC.                        CL*18
00465      MOVE MPRF-EMP-NO            TO MTAD-EMP-NO.                     CL*18
00466      SET MTAD-TAD-88 TO TRUE.                                        CL*18
00467      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                        CL*18
00468                                                                      CL*18
00469      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                            CL*18
00470      PERFORM 115-S910-READ          THRU 115-S910-READ-EXIT.         CL*20
00471      IF L910-NO-REC-88                                               CL*18
00472         GO TO P2500-EXIT.                                            CL*33
00473                                                                      CL*18
00474      MOVE MSKL-REC               TO MTAD-REC.                        CL*18
00475      MOVE  MTAD-ATTN-LINE        TO EMPLOYER-STREET-ADDRESS1         CL*18
00476      MOVE  MTAD-DELIV-LINE-1     TO EMPLOYER-STREET-ADDRESS2         CL*18
00477      MOVE  MTAD-DELIV-LINE-2     TO EMPLOYER-STREET-ADDRESS3         CL*18
00478      MOVE  MTAD-CITY             TO EMPLOYER-CITY                    CL*18
00479      MOVE  MTAD-ST               TO EMPLOYER-STATE                   CL*18
00480      MOVE  MTAD-ZIP              TO WRK-ZIP                          CL*18
00481      MOVE  WRK-ZIPA              TO EMPLOYER-ZIP-CODE                CL*18
00482      MOVE  WRK-ZIPB              TO EMPLOYER-ZIP4.                   CL*18
00483 *                                                                    CL*18
00484      MOVE LOW-VALUE              TO MTAD-REC.                        CL*18
00485      MOVE MPRF-EMP-NO            TO MTAD-EMP-NO.                     CL*18
00486      SET MTAD-TAD-88 TO TRUE.                                        CL*18
00487      SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE.                        CL*18
00488                                                                      CL*18
00489      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                            CL*18
00490      PERFORM 115-S910-READ          THRU 115-S910-READ-EXIT.         CL*20
00491      IF L910-NO-REC-88                                               CL*18
00492      MOVE  SPACES                TO OPTIONAL-STREET-ADDRESS1         CL*44
00493                                     OPTIONAL-STREET-ADDRESS2         CL*44
00494                                     OPTIONAL-STREET-ADDRESS3         CL*44
00495                                     OPTIONAL-CITY                    CL*44
00496                                     OPTIONAL-STATE                   CL*44
00497                                     WRK-ZIP                          CL*44
00498                                     OPTIONAL-ZIP-CODE                CL*44
00499                                     OPTIONAL-ZIP4                    CL*44
00500         GO TO P2500-EXIT.                                            CL*33
00501                                                                   DTSBX468
00502                                                                      CL*18
00503      MOVE MSKL-REC               TO MTAD-REC.                        CL*18
00504      MOVE  MTAD-ATTN-LINE        TO OPTIONAL-STREET-ADDRESS1         CL*18
00505      MOVE  MTAD-DELIV-LINE-1     TO OPTIONAL-STREET-ADDRESS2         CL*18
00506      MOVE  MTAD-DELIV-LINE-2     TO OPTIONAL-STREET-ADDRESS3         CL*18
00507      MOVE  MTAD-CITY             TO OPTIONAL-CITY                    CL*18
00508      MOVE  MTAD-ST               TO OPTIONAL-STATE                   CL*18
00509      MOVE  MTAD-ZIP              TO WRK-ZIP                          CL*18
00510      MOVE  WRK-ZIPA              TO OPTIONAL-ZIP-CODE                CL*18
00511      MOVE  WRK-ZIPB              TO OPTIONAL-ZIP4.                   CL*18
00512 *                                                                    CL*18
00513  P2500-EXIT.                                                         CL*33
00514      EXIT.                                                           CL*18
00515                                                                      CL*18
00516  114-S910-OPEN-READ.                                              DTSBX468
00517      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX468
00518      PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT.               DTSBX468
00519  114-S910-OPEN-READ-EXIT.                                         DTSBX468
00520      EXIT.                                                        DTSBX468
00521                                                                   DTSBX468
00522  115-S910-READ.                                                   DTSBX468
00523      SET L910-READ-88 TO TRUE.                                    DTSBX468
00524      PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT.               DTSBX468
00525  115-S910-READ-EXIT.                                              DTSBX468
00526      EXIT.                                                        DTSBX468
00527                                                                   DTSBX468
00528  116-S910-CLOSE.                                                  DTSBX468
00529      SET L910-CLOSE-88 TO TRUE.                                   DTSBX468
00530      PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT.               DTSBX468
00531  116-S910-CLOSE-EXIT.                                             DTSBX468
00532      EXIT.                                                        DTSBX468
00533                                                                   DTSBX468
00534  120-READ-MPRF.                                                   DTSBX468
00535      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX468
00536                            MSKL-REC.                              DTSBX468
00537  120-READ-MPRF-EXIT.                                              DTSBX468
00538      EXIT.                                                        DTSBX468
00539                                                                      CL**2
00540  P3000-READ-NAME.                                                    CL*33
00541 ******************************************************************DTSBX468
00542 *           SEARCH FOR NAME ON WAGE NAME FILE          *             CL**2
00543 ******************************************************************DTSBX468
00544                                                                      CL**2
00545      PERFORM S982A-START-BROWSE        THRU S982A-EXIT.              CL**2
00546                                                                      CL**2
00547      IF NOT L982-OK-88                                               CL**2
00548        DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN                      CL**2
00549        GO TO P3000-EXIT                                              CL*33
00550      END-IF.                                                         CL**2
00551                                                                      CL**2
00552      MOVE WNAM-SSN  TO W-SSN.                                        CL**2
00553                                                                      CL**2
00554      IF WRK-SSN = W-SSN                                              CL**2
00555         MOVE WNAM-LAST-NAME    TO WRK-LNAME                          CL**3
00556         MOVE WNAM-FIRST-NAME   TO WRK-FNAME                          CL**3
00557         MOVE WNAM-MID-INIT     TO WRK-INAME                          CL**3
00558      ELSE                                                            CL**2
00559        DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN.                     CL**2
00560  P3000-EXIT.                                                         CL*33
00561      EXIT.                                                           CL**2
00562 ******************************************************************   CL**2
00563 *                     TERMINATION ROUTINE                        *   CL**2
00564 ******************************************************************   CL**2
00565  P9999-TERMINATE.                                                    CL*33
00566                                                                      CL*28
00567      MOVE BUSINESS-WAGES TO TRAILER-RECORD-COUNT.                    CL*28
00568      WRITE WAGE-REC FROM TRAILER-RECORD.                             CL*28
00569      CLOSE WAGE-FILE.                                                CL*18
00570                                                                   DTSBX468
00571                                                                   DTSBX468
00572      PERFORM 116-S910-CLOSE THRU 116-S910-CLOSE-EXIT.             DTSBX468
00573                                                                   DTSBX468
00574      PERFORM S981D-CLOSE    THRU S981D-EXIT.                         CL*33
00575      PERFORM S982F-CLOSE    THRU S982F-EXIT.                         CL*33
00576                                                                      CL*33
00577      DISPLAY 'TOTAL WWGH RECORDS READ  ***   = ' RECS-IN.            CL*33
00578      DISPLAY '  ' .                                               DTSBX468
00579      DISPLAY 'TOTAL QTR WAGE RECORDS WRITTEN = ' BUSINESS-WAGES.     CL*33
00580      DISPLAY '  ' .                                               DTSBX468
00581  P9999-EXIT.                                                         CL*33
00582      EXIT.                                                        DTSBX468
00583      EJECT                                                        DTSBX468
00584 ******************************************************************DTSBX468
00585 *                         SERVICE ROUTINES                       *DTSBX468
00586 ******************************************************************DTSBX468
00587                                                                   DTSBX468
00588  S001-FROM-CAL-6.                                                 DTSBX468
00589      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBX468
00590      GO TO S001-DATE.                                             DTSBX468
00591                                                                   DTSBX468
00592  S001-FROM-FED-8.                                                 DTSBX468
00593      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX468
00594      GO TO S001-DATE.                                             DTSBX468
00595                                                                   DTSBX468
00596  S001-FROM-ABS.                                                   DTSBX468
00597      SET L001-FROM-ABS-DAY  TO TRUE.                              DTSBX468
00598      GO TO S001-DATE.                                             DTSBX468
00599                                                                   DTSBX468
00600  S001-DATE.                                                       DTSBX468
00601      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX468
00602  S001-EXIT.                                                       DTSBX468
00603      EXIT.                                                        DTSBX468
00604                                                                   DTSBX468
00605  S004-FROM-DATE.                                                  DTSBX468
00606      SET L004-FROM-DATE TO TRUE.                                  DTSBX468
00607      GO TO S004-YRQ.                                              DTSBX468
00608                                                                   DTSBX468
00609  S004-YRQ.                                                        DTSBX468
00610      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX468
00611  S004-EXIT.                                                       DTSBX468
00612      EXIT.                                                        DTSBX468
00613  S981A-OPEN-UPDATE.                                                  CL*32
00614      SET L981-OPEN-UPDATE-88  TO TRUE.                               CL*32
00615      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*32
00616                                                                      CL*32
00617  S981A-EXIT.                                                         CL*32
00618      EXIT.                                                           CL*32
00619                                                                      CL*32
00620  S981A1-OPEN-READ.                                                   CL*36
00621      SET L981-OPEN-READ-88  TO TRUE.                                 CL*33
00622      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*33
00623                                                                      CL*33
00624  S981A1-EXIT.                                                        CL*33
00625      EXIT.                                                           CL*33
00626                                                                      CL*33
00627  S981B-WRITE.                                                        CL*32
00628      SET L981-WRITE-88        TO TRUE.                               CL*32
00629      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*32
00630                                                                      CL*32
00631  S981B-EXIT.                                                         CL*32
00632      EXIT.                                                           CL*32
00633  S981C-READ.                                                         CL*32
00634      SET L981-READ-88        TO TRUE.                                CL*32
00635      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*32
00636                                                                      CL*32
00637  S981C-EXIT.                                                         CL*32
00638      EXIT.                                                           CL*32
00639  S981X-START-BROWSE.                                                 CL*43
00640       DISPLAY ' STARTING BROWSE'                                     CL*43
00641      SET L981-START-BROWSE-88    TO TRUE.                            CL*33
00642      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*33
00643       DISPLAY ' BROWSE COMPLETE'.                                    CL*43
00644                                                                      CL*33
00645  S981X-EXIT.                                                         CL*43
00646      EXIT.                                                           CL*33
00647  S981C2-READ-NEXT.                                                   CL*33
00648      SET L981-READ-NEXT-88   TO TRUE.                                CL*33
00649      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*33
00650                                                                      CL*33
00651  S981C2-EXIT.                                                        CL*33
00652      EXIT.                                                           CL*33
00653  S981E-DELETE.                                                       CL*32
00654      SET L981-DELETE-88        TO TRUE.                              CL*32
00655      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*32
00656                                                                      CL*32
00657  S981E-EXIT.                                                         CL*32
00658      EXIT.                                                           CL*32
00659                                                                      CL*32
00660  S981D-CLOSE.                                                        CL*32
00661      SET L981-CLOSE-88        TO TRUE.                               CL*32
00662      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*32
00663                                                                      CL*32
00664  S981D-EXIT.                                                         CL*32
00665      EXIT.                                                           CL*32
00666  S981Z-WWGH-IO.                                                      CL*32
00667      CALL 'DTSBU981' USING L981-LINK-AREA                            CL*32
00668                            WWGH-REC.                                 CL*32
00669  S981Z-EXIT.                                                         CL*32
00670      EXIT.                                                           CL*32
00671                                                                      CL*32
00672                                                                      CL*32
00673  S982O-OPEN-READ.                                                    CL**5
00674      SET L982-OPEN-READ-88 TO TRUE.                                  CL**5
00675      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00676                                                                      CL**3
00677  S982O-EXIT.                                                         CL**3
00678      EXIT.                                                           CL**3
00679                                                                      CL**3
00680  S982A-START-BROWSE.                                                 CL**3
00681      SET L982-START-BROWSE-88 TO TRUE.                               CL**3
00682      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00683                                                                      CL**3
00684  S982A-EXIT.                                                         CL**3
00685      EXIT.                                                           CL**3
00686  S982B-READ-NEXT.                                                    CL**3
00687      SET L982-READ-NEXT-88    TO TRUE.                               CL**3
00688      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00689                                                                      CL**3
00690  S982B-EXIT.                                                         CL**3
00691      EXIT.                                                           CL**3
00692  S982C-WRITE.                                                        CL**3
00693      SET L982-WRITE-88        TO TRUE.                               CL**3
00694      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00695                                                                      CL**3
00696  S982C-EXIT.                                                         CL**3
00697      EXIT.                                                           CL**3
00698                                                                      CL**3
00699  S982D-REWRITE.                                                      CL**3
00700      SET L982-REWRITE-88        TO TRUE.                             CL**3
00701      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00702  S982D-EXIT.                                                         CL**3
00703      EXIT.                                                           CL**3
00704  S982F-CLOSE.                                                        CL**3
00705      SET L982-CLOSE-88        TO TRUE.                               CL**3
00706      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00707                                                                      CL**3
00708  S982F-EXIT.                                                         CL**3
00709      EXIT.                                                           CL**3
00710                                                                      CL**3
00711  S982Z-WNAM-IO.                                                      CL**3
00712      CALL 'DTSBU982' USING L982-LINK-AREA                            CL**3
00713                           WNAM-REC.                                  CL**3
00714  S982Z-EXIT.                                                         CL**3
00715      EXIT.                                                           CL**3
00716                                                                      CL**3
00717                                                                   DTSBX468
00718  S999-ABEND.                                                      DTSBX468
00719      DISPLAY '****  DTSBX465 ABENDING '                           DTSBX468
00720         ABEND-MSG.                                                DTSBX468
00721      CALL ABEND-MOD USING ABEND-CODE.                             DTSBX468
00722                                                                   DTSBX468
00723  S999-EXIT.                                                       DTSBX468
00724      EXIT.                                                        DTSBX468
00725                                                                   DTSBX468
