267 lines
21 KiB
COBOL
267 lines
21 KiB
COBOL
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
|