00001  IDENTIFICATION DIVISION.                                         09/23/24
00002  PROGRAM-ID.             DTSBU431.                                DTSBU431
00003  AUTHOR.                 NGC                                         LV014
00004  DATE-WRITTEN.           OCTOBER 2010.                            DTSBU431
00005  DATE-COMPILED.                                                   DTSBU431
00006                                                                   DTSBU431
00007 *****                                                             DTSBU431
00008 *                                                                 DTSBU431
00009 *    FUNCTION:  GET COUNTS OF WAGE ITEMS NEEDED FOR               DTSBU431
00010 *               ITEM 5 ON THE ETA 581 REPORT.                     DTSBU431
00011 *                                                                 DTSBU431
00012 *    NOTE: THIS PROGRAM USES SEVERAL BENEFIT MODULES THEREFORE    DTSBU431
00013 *          THIS PROGRAM NEEDS THE BENEFIT COMPILE JCL(COB2BBEN)   DTSBU431
00014 *          TO RESOLVE ALL THE NEEDED LOAD MODULES.                DTSBU431
00015 *                                                                 DTSBU431
00016 *    MODIFICATION HISTORY:                                        DTSBU431
00017 *                                                                 DTSBU431
00018 *    10/01/2010  INITIAL DEVELOPMENT                              DTSBU431
00019 *                REFERENCE:                     PROGRAMMER: GD    DTSBU431
00020 *                                                                 DTSBU431
00021 *                                                                 DTSBU431
00022 *                                                                 DTSBU431
00023 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU431
00024 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU431
00025 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU431
00026 *                                                                 DTSBU431
00027 *    DESCRIPTION:                                                 DTSBU431
00028 *                                                                 DTSBU431
00029 *                                                                 DTSBU431
00030 *    RECORDS READ:                                                DTSBU431
00031 *        WAGE MASTER FILE                                         DTSBU431
00032 *                                                                 DTSBU431
00033 *    PRINTED OUTPUTS:                                             DTSBU431
00034 *        NONE.                                                    DTSBU431
00035 *                                                                 DTSBU431
00036 *    RECORDS WRITTEN:                                             DTSBU431
00037 *        DTSIWWGH   EMPLOYER ORIENTED WAGE RECORD                 DTSBU431
00038 *                                                                 DTSBU431
00039 *    MODULES CALLED:                                              DTSBU431
00040 *         EWG960R   WAGE FILE ACCESS MODULE                       DTSBU431
00041 *         DTSBU004  YEAR/QUARTER CONVERSION MODULE                DTSBU431
00042 *                                                                 DTSBU431
00043 *****                                                             DTSBU431
00044                                                                   DTSBU431
00045  ENVIRONMENT DIVISION.                                            DTSBU431
00046      SKIP2                                                        DTSBU431
00047  DATA DIVISION.                                                   DTSBU431
00048                                                                   DTSBU431
00049  WORKING-STORAGE SECTION.                                         DTSBU431
000495 77  PAN-VALET PICTURE X(24) VALUE '014DTSBU431  09/23/24'.       DTSBU431
00050      SKIP3                                                        DTSBU431
00051  01  WRK-AREA.                                                    DTSBU431
00052      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +430.DTSBU431
00053      05  WRK-ERROR-IND               PIC  X(01).                  DTSBU431
00054          88  WRK-ERROR-YES-88         VALUE 'Y'.                  DTSBU431
00055          88  WRK-ERROR-NO-88          VALUE 'N'.                  DTSBU431
00056      05  ABEND-CODE                  PIC S9(04)  COMP                CL**7
00057                                  VALUE +431.                         CL**7
00058      05  ABEND-MOD                   PIC  X(08)                      CL**7
00059                                  VALUE 'DTSBU999'.                   CL**7
00060      05  ABEND-MSG                   PIC  X(60).                     CL**7
00061                                                                      CL**7
00062                                                                   DTSBU431
00063      05  WRK-START-DATE              PIC S9(09)  COMP-3 VALUE +0. DTSBU431
00064      05  WRK-END-DATE                PIC S9(09)  COMP-3 VALUE +0. DTSBU431
00065                                                                   DTSBU431
00066      05  WRK-WAGE-ITEM-CNT           PIC S9(07)  COMP-3 VALUE +0. DTSBU431
00067                                                                   DTSBU431
00068  01  L004-LINK-AREA.                                              DTSBU431
00069  ++INCLUDE DTSIL004                                               DTSBU431
00070                                                                   DTSBU431
00071                                                                      CL*12
00072  01  L981-LINK-AREA.                                                 CL*12
00073  ++INCLUDE DTSIL981                                                  CL*12
00074                                                                      CL*12
00075  01  WWGH-REC.                                                       CL*12
00076  ++INCLUDE DTSIWWGH                                                  CL*12
00077  LINKAGE SECTION.                                                 DTSBU431
00078                                                                   DTSBU431
00079  01  L430-LINK-AREA.                                              DTSBU431
00080  ++INCLUDE DTSIL430                                               DTSBU431
00081                                                                      CL*11
00082                                                                   DTSBU431
00083  PROCEDURE DIVISION USING L430-LINK-AREA.                         DTSBU431
00084                                                                   DTSBU431
00085      SET WRK-ERROR-NO-88          TO TRUE.                           CL**8
00086      EVALUATE TRUE                                                   CL**8
00087        WHEN L430-CMND-INITIALIZE-88                                  CL**8
00088         PERFORM I0000-INIT             THRU I0000-EXIT            DTSBU431
00089                                                                   DTSBU431
00090        WHEN L430-CMND-PROCESS-88                                     CL**8
00091            PERFORM P0000-PROCESS       THRU P0000-EXIT            DTSBU431
00092                                                                   DTSBU431
00093        WHEN L430-CMND-TERMINATE-88                                   CL**8
00094            PERFORM T0000-TERMINATE     THRU T0000-EXIT            DTSBU431
00095                                                                   DTSBU431
00096      END-EVALUATE.                                                   CL**8
00097                                                                   DTSBU431
00098      GOBACK.                                                      DTSBU431
00099                                                                   DTSBU431
00100  I0000-INIT.                                                      DTSBU431
00101      PERFORM I1000-SET-DATES    THRU I1000-EXIT.                  DTSBU431
00102                                                                   DTSBU431
00103      PERFORM I2000-OPEN-FILES   THRU I2000-EXIT.                  DTSBU431
00104                                                                   DTSBU431
00105                                                                   DTSBU431
00106  I0000-EXIT.                                                      DTSBU431
00107      EXIT.                                                        DTSBU431
00108                                                                   DTSBU431
00109  I1000-SET-DATES.                                                 DTSBU431
00110      MOVE L430-SUBJECT-YRQ        TO L004-QTR-5-9.                   CL**4
00111      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBU431
00112      IF L004-VALID-QTR                                            DTSBU431
00113         MOVE L004-QTR-START-DATE  TO WRK-START-DATE               DTSBU431
00114         MOVE L004-QTR-END-DATE    TO WRK-END-DATE                 DTSBU431
00115      ELSE                                                         DTSBU431
00116         DISPLAY 'INVALID SUBJECT QUARTER '                        DTSBU431
00117            L430-SUBJECT-YRQ                                       DTSBU431
00118         PERFORM S999-ABEND        THRU S999-EXIT                  DTSBU431
00119      END-IF.                                                      DTSBU431
00120                                                                   DTSBU431
00121                                                                   DTSBU431
00122      DISPLAY '**************************'.                        DTSBU431
00123      DISPLAY '*      DTSBU430'                                    DTSBU431
00124      DISPLAY '*               '                                   DTSBU431
00125      DISPLAY '*  START:     ' WRK-START-DATE.                     DTSBU431
00126      DISPLAY '*  END  :     ' WRK-END-DATE.                       DTSBU431
00127      DISPLAY '**************************'.                        DTSBU431
00128                                                                   DTSBU431
00129  I1000-EXIT.                                                      DTSBU431
00130      EXIT.                                                        DTSBU431
00131                                                                   DTSBU431
00132  I2000-OPEN-FILES.                                                DTSBU431
00133      PERFORM S981A1-OPEN-READ   THRU S981A1-EXIT.                    CL**2
00134        IF NOT L981-OK-88                                             CL**2
00135           DISPLAY ' OPEN WWGH VSAM FAILED ' WWGH-KEY-AREA            CL**2
00136           PERFORM S999-ABEND THRU S999-EXIT.                         CL**2
00137                                                                      CL**2
00138                                                                   DTSBU431
00139  I2000-EXIT.                                                      DTSBU431
00140      EXIT.                                                        DTSBU431
00141                                                                   DTSBU431
00142  P0000-PROCESS.                                                   DTSBU431
00143      MOVE LOW-VALUES TO WWGH-KEY-AREA.                               CL**2
00144                                                                      CL**2
00145      MOVE 010021      TO WWGH-EMP-NO.                                CL**2
00146      MOVE 20221       TO WWGH-YRQ.                                   CL**2
00147      MOVE 000000000   TO WWGH-SSN.                                   CL**2
00148                                                                      CL**2
00149           DISPLAY ' BEFORE BROWSE ********* ' WWGH-KEY-AREA          CL*10
00150      PERFORM S981X-START-BROWSE THRU S981X-EXIT.                     CL**2
00151           DISPLAY ' AFTER  BROWSE ********* ' WWGH-KEY-AREA          CL*10
00152        IF NOT L981-OK-88                                             CL**2
00153           DISPLAY ' BROWSE FAILED ********* ' WWGH-KEY-AREA          CL**2
00154           PERFORM S999-ABEND THRU S999-EXIT.                         CL**2
00155                                                                      CL**2
00156           DISPLAY ' BEFORE READ      ****** ' WWGH-KEY-AREA          CL*10
00157 *    PERFORM S981C-READ      THRU S981C-EXIT.                        CL*13
00158 *      IF NOT L981-OK-88                                             CL*13
00159 *         DISPLAY ' READ FAILED ********* ' WWGH-KEY-AREA            CL*13
00160 *         PERFORM S999-ABEND THRU S999-EXIT.                         CL*13
00161                                                                      CL**2
00162 *         DISPLAY ' AFTER  READ      ****** ' WWGH-KEY-AREA          CL*13
00163                                                                      CL**2
00164      PERFORM P1000-FIND-QTR-WAGE THRU P1000-EXIT                     CL**2
00165            UNTIL L981-NO-REC-88.                                     CL**2
00166                                                                   DTSBU431
00167                                                                   DTSBU431
00168      MOVE WRK-WAGE-ITEM-CNT              TO L430-WAGE-ITEM-CNT.   DTSBU431
00169      DISPLAY ' WAGE COUNT  WRK****** ' WRK-WAGE-ITEM-CNT.            CL*14
00170      DISPLAY ' WAGE COUNT  430****** ' L430-WAGE-ITEM-CNT.           CL*14
00171                                                                   DTSBU431
00172  P0000-EXIT.                                                      DTSBU431
00173      EXIT.                                                        DTSBU431
00174                                                                   DTSBU431
00175                                                                   DTSBU431
00176 **************************************************************    DTSBU431
00177 *  P1200 FINDS ALL THE WAGE SEGMENT ASSOCIATED WITH THE SSN       DTSBU431
00178 *  AND SELECTS THOSE FROM 2001.                                   DTSBU431
00179 **************************************************************    DTSBU431
00180                                                                   DTSBU431
00181  P1000-FIND-QTR-WAGE.                                                CL**2
00182 *    DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE.                CL**2
00183 *    ADD 1 TO RECS-IN.                                               CL**2
00184                                                                   DTSBU431
00185      IF WWGH-CHNG-DATE >= WRK-START-DATE                             CL**2
00186         AND WWGH-CHNG-DATE <= WRK-END-DATE                           CL**2
00187            ADD +1  TO WRK-WAGE-ITEM-CNT                           DTSBU431
00188      END-IF.                                                      DTSBU431
00189                                                                   DTSBU431
00190      PERFORM S981C2-READ-NEXT  THRU S981C2-EXIT.                     CL**2
00191  P1000-EXIT.                                                         CL**2
00192      EXIT.                                                        DTSBU431
00193                                                                   DTSBU431
00194  S004-FROM-5.                                                     DTSBU431
00195      SET L004-FROM-5 TO TRUE.                                     DTSBU431
00196      GO TO S004-QTR.                                              DTSBU431
00197                                                                   DTSBU431
00198  S004-QTR.                                                        DTSBU431
00199      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBU431
00200  S004-EXIT.                                                       DTSBU431
00201      EXIT.                                                        DTSBU431
00202                                                                      CL**2
00203  S981A1-OPEN-READ.                                                   CL**2
00204      SET L981-OPEN-READ-88  TO TRUE.                                 CL**2
00205      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL**2
00206                                                                      CL**2
00207  S981A1-EXIT.                                                        CL**2
00208      EXIT.                                                           CL**2
00209                                                                      CL**2
00210  S981C-READ.                                                         CL**2
00211      SET L981-READ-88        TO TRUE.                                CL**2
00212      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL**2
00213                                                                      CL**2
00214  S981C-EXIT.                                                         CL**2
00215      EXIT.                                                           CL**2
00216  S981X-START-BROWSE.                                                 CL**2
00217       DISPLAY ' STARTING BROWSE'                                     CL**2
00218      SET L981-START-BROWSE-88    TO TRUE.                            CL**2
00219      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL**2
00220       DISPLAY ' BROWSE COMPLETE'.                                    CL**2
00221                                                                      CL**2
00222  S981X-EXIT.                                                         CL**2
00223      EXIT.                                                           CL**2
00224  S981C2-READ-NEXT.                                                   CL**2
00225      SET L981-READ-NEXT-88   TO TRUE.                                CL**2
00226      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL**2
00227                                                                      CL**2
00228  S981C2-EXIT.                                                        CL**2
00229  S981D-CLOSE.                                                        CL**2
00230      SET L981-CLOSE-88        TO TRUE.                               CL**2
00231      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL**2
00232                                                                      CL**2
00233  S981D-EXIT.                                                         CL**2
00234      EXIT.                                                           CL**2
00235  S981Z-WWGH-IO.                                                      CL**2
00236      CALL 'DTSBU981' USING L981-LINK-AREA                            CL**2
00237                            WWGH-REC.                                 CL**2
00238  S981Z-EXIT.                                                         CL**2
00239      EXIT.                                                           CL**2
00240                                                                      CL**2
00241                                                                      CL**6
00242  S999-ABEND.                                                         CL**6
00243      DISPLAY '****  DTSBU431 ABENDING '                              CL**6
00244         ABEND-MSG.                                                   CL**6
00245      CALL ABEND-MOD USING ABEND-CODE.                                CL**6
00246                                                                      CL**6
00247  S999-EXIT.                                                          CL**6
00248      EXIT.                                                           CL**6
00249                                                                      CL**6
00250  T0000-TERMINATE.                                                 DTSBU431
00251                                                                   DTSBU431
00252      DISPLAY ' '.                                                 DTSBU431
00253      DISPLAY ' '.                                                 DTSBU431
00254                                                                   DTSBU431
00255      DISPLAY '*** DTSBU431 TERMINATION STATISTICS ***'.              CL**2
00256                                                                   DTSBU431
00257      DISPLAY '  '.                                                DTSBU431
00258      DISPLAY 'TOTAL WAGES ITEMS FOR QTR                 :'           CL**2
00259              WRK-WAGE-ITEM-CNT.                                   DTSBU431
00260      PERFORM S981D-CLOSE    THRU S981D-EXIT.                         CL**2
00261                                                                   DTSBU431
00262                                                                   DTSBU431
00263  T0000-EXIT.                                                      DTSBU431
00264      EXIT.                                                        DTSBU431
00265                                                                   DTSBU431
