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