00001 IDENTIFICATION DIVISION. 03/19/08 00002 PROGRAM-ID. DTSCU422. DTSCU422 00003 AUTHOR. TRW. LV009 00004 DATE-WRITTEN. FEBRUARY 2002. DTSCU422 00005 DATE-COMPILED. DTSCU422 00006 SKIP3 DTSCU422 00007 ***** DTSCU422 00008 * *** ANNUAL REPORT VERSION *** DTSCU422 00009 * DTSCU422 00010 * FUNCTION: CREATE A TEMPORARY STORAGE FILE CONTAINING THE DTSCU422 00011 * SSN OF EACH WORKER REPORTED DURING THE LAST YEAR DTSCU422 00012 * OR THE CURRENT YEAR FOR A GIVEN EMPLOYER, AND DTSCU422 00013 * THE WAGES REPORTED DURING THE CURRENT YEAR. DTSCU422 00014 * DTSCU422 00015 * THIS PROGRAM IS USED TO PREFILL THE ANNUAL REPORT DTSCU422 00016 * ENTRY SCREEN (27) WITH SSNS FOR ALL WORKERS DTSCU422 00017 * REPORTED, AND TO RETURN THE TOTAL WAGES PREVIOUSLYDTSCU422 00018 * REPORTED FOR USE IN CALCULATING TAXABLE WAGES DTSCU422 00019 * FOR SUPPLEMENTAL REPORTS. DTSCU422 00020 * DTSCU422 00021 * MODIFICATION LOG: DTSCU422 00022 * DTSCU422 00023 * 02/18/2002 INITIAL DEVELOPMENT. DTSCU422 00024 * WORK ORDER: PROGRAMMER: GD DTSCU422 00025 * DTSCU422 00026 * 03/24/2004 ADDED P2000 TO FIND NAMES IN WAGE NAME FILE. DTSCU422 00027 * WORK ORDER: EFT PROGRAMMER: GD DTSCU422 00028 * DTSCU422 00029 * 04/08/2004 CORRECTED PROBLEM IN LOADING DATA TO TEMP DTSCU422 00030 * STORAGE IN P3200. CODE THAT TESTED WHEN DTSCU422 00031 * SUBSCRIPT EXCEEDED WRK-WAGE-TBL-MAX WAS DTSCU422 00032 * INCORRECT, AND THE FIRST WAGE ITEM ON THE DTSCU422 00033 * NEW PAGE WAS BEING DROPPED. DTSCU422 00034 * WORK ORDER: PROGRAMMER: GD DTSCU422 00035 * DTSCU422 00036 * 03/19/2008 CORRECTED PROBLEM IN P1920 (INSERT ROW INTO DTSCU422 00037 * SSN TABLE. OLD ROW WAS NOT INITIALIZED AFTER DTSCU422 00038 * OLD DATA MOVED TO NEW ROW. DTSCU422 00039 * WORK ORDER: PROGRAMMER: GD DTSCU422 00040 * DTSCU422 00041 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU422 00042 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU422 00043 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU422 00044 * DTSCU422 00045 * DTSCU422 00046 * DESCRIPTION: DTSCU422 00047 * DTSCU422 00048 * DTSCU422 READ THE EMPLOYER-ORIENTED WAGE HISTORY FILE DTSCU422 00049 * (WGH) FOR A GIVEN EMPLOYER, AND RETURNS THE SSNS OF DTSCU422 00050 * ALL WORKERS REPORTED, AND ANY WAGES PREVIOUSLY DTSCU422 00051 * REPORTED FOR THE CURRENT YEAR. DTSCU422 00052 * DTSCU422 00053 * DTSCU422 00054 * GENERAL SPECIFICATIONS: DTSCU422 00055 * DTSCU422 00056 * DTSCU422 00057 * DTSCU422 00058 * DTSCU422 00059 * COMMAND SPECIFIC SPECIFICATIONS: DTSCU422 00060 * DTSCU422 00061 * DTSCU422 00062 * DTSCU422 00063 ***** DTSCU422 00064 SKIP3 DTSCU422 00065 DATA DIVISION. DTSCU422 00066 WORKING-STORAGE SECTION. DTSCU422 000665 77 PAN-VALET PICTURE X(24) VALUE '009DTSCU422 03/19/08'. DTSCU422 00067 SKIP3 DTSCU422 00068 01 WRK-AREA. DTSCU422 00069 05 WRK-ABEND-CD PIC X(04) VALUE 'U422'. DTSCU422 00070 DTSCU422 00071 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSCU422'. DTSCU422 00072 DTSCU422 00073 05 TBL-SUB PIC S9(04) COMP. DTSCU422 00074 05 TBL-CNT PIC S9(04) COMP VALUE +0. DTSCU422 00075 05 TBL-MAX PIC S9(04) COMP DTSCU422 00076 VALUE +250. DTSCU422 00077 05 SSN-SUB PIC S9(04) COMP. DTSCU422 00078 05 NXT-SUB PIC S9(04) COMP. DTSCU422 00079 DTSCU422 00080 05 WRK-INDEX-IND PIC X(01). DTSCU422 00081 88 WRK-INDEX-NULL-88 VALUE '0'. DTSCU422 00082 88 WRK-INDEX-POSITION-FOUND-88 VALUE '1'. DTSCU422 00083 88 WRK-INDEX-SSN-FOUND-88 VALUE '2'. DTSCU422 00084 88 WRK-INDEX-FOUND-88 VALUE '1' '2'. DTSCU422 00085 DTSCU422 00086 05 WRK-TOT-CURR-WAGE PIC S9(11)V99 COMP-3. DTSCU422 00087 05 WRK-MAX-SSN PIC S9(09) COMP-3 DTSCU422 00088 VALUE +0. DTSCU422 00089 05 WRK-LAST-DUMMY-SSN PIC S9(09) COMP-3 DTSCU422 00090 VALUE +0. DTSCU422 00091 DTSCU422 00092 05 PRIOR-QTR1 PIC S9(05) COMP-3. DTSCU422 00093 05 PRIOR-QTR2 PIC S9(05) COMP-3. DTSCU422 00094 05 PRIOR-QTR3 PIC S9(05) COMP-3. DTSCU422 00095 05 PRIOR-QTR4 PIC S9(05) COMP-3. DTSCU422 00096 DTSCU422 00097 05 WRK-SSN-TBL OCCURS 250 TIMES. DTSCU422 00098 10 WRK-SSN PIC S9(09) COMP-3. DTSCU422 00099 88 WRK-SSN-DUMMY-88 VALUE +1 THRU +999999. DTSCU422 00100 10 WRK-SSN-NAME PIC X(03). DTSCU422 00101 10 WRK-QTR1-CURR-WAGE PIC S9(07)V99 COMP-3. DTSCU422 00102 10 WRK-QTR1-PRIOR-WAGE PIC S9(07)V99 COMP-3. DTSCU422 00103 10 WRK-QTR2-CURR-WAGE PIC S9(07)V99 COMP-3. DTSCU422 00104 10 WRK-QTR2-PRIOR-WAGE PIC S9(07)V99 COMP-3. DTSCU422 00105 10 WRK-QTR3-CURR-WAGE PIC S9(07)V99 COMP-3. DTSCU422 00106 10 WRK-QTR3-PRIOR-WAGE PIC S9(07)V99 COMP-3. DTSCU422 00107 10 WRK-QTR4-CURR-WAGE PIC S9(07)V99 COMP-3. DTSCU422 00108 10 WRK-QTR4-PRIOR-WAGE PIC S9(07)V99 COMP-3. DTSCU422 00109 DTSCU422 00110 05 WRK-WAGE-TBL-MAX PIC S9(04) COMP DTSCU422 00111 VALUE +10. DTSCU422 00112 05 TS-SUB PIC S9(04) COMP. DTSCU422 00113 05 ITEM-LENGTH PIC S9(04) COMP DTSCU422 00114 VALUE +1007. DTSCU422 00115 EJECT DTSCU422 00116 01 L004-COMM-AREA. DTSCU422 00117 ++INCLUDE DTSIL004 DTSCU422 00118 DTSCU422 00119 01 L829-COMM-AREA. DTSCU422 00120 05 L829-CONTROL-BLOCK. DTSCU422 00121 ++INCLUDE DTSIL829 DTSCU422 00122 05 L829-REC PIC X(1007). DTSCU422 00123 DTSCU422 00124 01 L427-COMM-AREA. DTSCU422 00125 ++INCLUDE DTSIL427 DTSCU422 00126 DTSCU422 00127 01 L881-COMM-AREA. DTSCU422 00128 05 L881-CONTROL-BLOCK. DTSCU422 00129 ++INCLUDE DTSIL881 DTSCU422 00130 DTSCU422 00131 05 WWGH-COMM-REC. DTSCU422 00132 ++INCLUDE DTSIWWGH DTSCU422 00133 DTSCU422 00134 01 L882-COMM-AREA. DTSCU422 00135 05 L882-CONTROL-BLOCK. DTSCU422 00136 ++INCLUDE DTSIL882 DTSCU422 00137 DTSCU422 00138 05 WNAM-COMM-REC. DTSCU422 00139 ++INCLUDE DTSIWNAM DTSCU422 00140 DTSCU422 00141 LINKAGE SECTION. DTSCU422 00142 SKIP3 DTSCU422 00143 01 DFHCOMMAREA. DTSCU422 00144 ++INCLUDE DTSIL422 DTSCU422 00145 EJECT DTSCU422 00146 PROCEDURE DIVISION. DTSCU422 00147 DTSCU422 00148 PERFORM I0000-INIT-TABLE THRU I0000-EXIT. DTSCU422 00149 DTSCU422 00150 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSCU422 00151 DTSCU422 00152 GOBACK. DTSCU422 00153 EJECT DTSCU422 00154 I0000-INIT-TABLE. DTSCU422 00155 PERFORM DTSCU422 00156 VARYING SSN-SUB FROM +1 BY +1 DTSCU422 00157 UNTIL SSN-SUB > TBL-MAX DTSCU422 00158 MOVE ZERO TO WRK-SSN (SSN-SUB) DTSCU422 00159 WRK-QTR1-CURR-WAGE (SSN-SUB) DTSCU422 00160 WRK-QTR1-PRIOR-WAGE (SSN-SUB) DTSCU422 00161 WRK-QTR2-CURR-WAGE (SSN-SUB) DTSCU422 00162 WRK-QTR2-PRIOR-WAGE (SSN-SUB) DTSCU422 00163 WRK-QTR3-CURR-WAGE (SSN-SUB) DTSCU422 00164 WRK-QTR3-PRIOR-WAGE (SSN-SUB) DTSCU422 00165 WRK-QTR4-CURR-WAGE (SSN-SUB) DTSCU422 00166 WRK-QTR4-PRIOR-WAGE (SSN-SUB) DTSCU422 00167 MOVE SPACES TO WRK-SSN-NAME (SSN-SUB) DTSCU422 00168 END-PERFORM. DTSCU422 00169 DTSCU422 00170 MOVE L422-QTR1 TO L004-QTR-5-9. DTSCU422 00171 SUBTRACT 1 FROM L004-QTR-5-YR. DTSCU422 00172 MOVE L004-QTR-5-9 TO PRIOR-QTR1. DTSCU422 00173 DTSCU422 00174 MOVE L422-QTR2 TO L004-QTR-5-9. DTSCU422 00175 SUBTRACT 1 FROM L004-QTR-5-YR. DTSCU422 00176 MOVE L004-QTR-5-9 TO PRIOR-QTR2. DTSCU422 00177 DTSCU422 00178 MOVE L422-QTR3 TO L004-QTR-5-9. DTSCU422 00179 SUBTRACT 1 FROM L004-QTR-5-YR. DTSCU422 00180 MOVE L004-QTR-5-9 TO PRIOR-QTR3. DTSCU422 00181 DTSCU422 00182 MOVE L422-QTR4 TO L004-QTR-5-9. DTSCU422 00183 SUBTRACT 1 FROM L004-QTR-5-YR. DTSCU422 00184 MOVE L004-QTR-5-9 TO PRIOR-QTR4. DTSCU422 00185 DTSCU422 00186 I0000-EXIT. DTSCU422 00187 EXIT. DTSCU422 00188 DTSCU422 00189 P0000-PROCESS. DTSCU422 00190 DTSCU422 00191 PERFORM P1000-CURR-WWGH-WAGES THRU P1000-EXIT. DTSCU422 00192 DTSCU422 00193 PERFORM P2000-FIND-NAMES THRU P2000-EXIT. DTSCU422 00194 DTSCU422 00195 PERFORM P3000-SAVE-TO-TS THRU P3000-EXIT. DTSCU422 00196 DTSCU422 00197 P0000-EXIT. DTSCU422 00198 EXIT. DTSCU422 00199 DTSCU422 00200 ************************************************************** DTSCU422 00201 * THIS PROCEDURE CHECKS THE WAGE HISTORY FILE TO FIND THE DTSCU422 00202 * WORKERS THAT THE EMPLOYER REPORTED PREVIOUSLY. THE SSNS DTSCU422 00203 * OF THESE WORKERS ARE RETURNED TO THE REPORT ENTRY SCREEN DTSCU422 00204 * TO SIMPLIFY DATA ENTRY - THE SCREEN USER DOES NOT NEED TO DTSCU422 00205 * RE-ENTER THE SSNS. ONLY THE NAME CHECK AND WAGES ARE DTSCU422 00206 * REQUIRED. DTSCU422 00207 * DTSCU422 00208 * THE SEARCH STARTS WITH THE PRIOR YEAR AND CONTINUES THROUGH DTSCU422 00209 * THE CURRENT YEAR. ANY CURRENT YEAR WAGES ON FILE ARE DTSCU422 00210 * RETURNED IN THE L422 LINKAGE AREA. DTSCU422 00211 * DTSCU422 00212 * IF L422-KEY = LOW-VALUES (MEANING THAT THIS IS THE DTSCU422 00213 * FIRST CALL TO THE PROGRAM), START THE BROWSE AT THE FIRST DTSCU422 00214 * QUARTER OF THE PRIOR YEAR. AFTER THE FIRST CALL, DTSCU422 00215 * L422-KEY WILL CONTAIN THE KEY OF THE LAST RECORD READ. DTSCU422 00216 * IN THIS CASE, START THE BROWSE WITH THE RECORD FOLLOWING DTSCU422 00217 * THE LAST ONE READ. DTSCU422 00218 ************************************************************** DTSCU422 00219 P1000-CURR-WWGH-WAGES. DTSCU422 00220 MOVE ZERO TO TBL-SUB. DTSCU422 00221 SET L422-ERR-NO-88 TO TRUE. DTSCU422 00222 DTSCU422 00223 PERFORM P1100-SCAN-WWGH THRU P1100-EXIT. DTSCU422 00224 DTSCU422 00225 P1000-EXIT. DTSCU422 00226 EXIT. DTSCU422 00227 DTSCU422 00228 P1100-SCAN-WWGH. DTSCU422 00229 MOVE LOW-VALUE TO WWGH-COMM-REC. DTSCU422 00230 MOVE L422-EMP-NO TO WWGH-EMP-NO. DTSCU422 00231 MOVE L422-QTR1 TO L004-QTR-5-9. DTSCU422 00232 SUBTRACT 1 FROM L004-QTR-5-YR. DTSCU422 00233 DTSCU422 00234 PERFORM S881A-START-BROWSE THRU S881A-EXIT. DTSCU422 00235 DTSCU422 00236 IF L881-OK-88 DTSCU422 00237 PERFORM P1110-SCAN-WAGE-FILE THRU P1110-EXIT DTSCU422 00238 UNTIL L881-NO-REC-88 DTSCU422 00239 OR L422-ERR-IND NOT = '00'. DTSCU422 00240 DTSCU422 00241 P1100-EXIT. DTSCU422 00242 EXIT. DTSCU422 00243 DTSCU422 00244 P1110-SCAN-WAGE-FILE. DTSCU422 00245 IF WWGH-EMP-NO NOT = L422-EMP-NO DTSCU422 00246 OR WWGH-YRQ > L422-QTR4 DTSCU422 00247 PERFORM S881C-END-BROWSE THRU S881C-EXIT DTSCU422 00248 SET L881-NO-REC-88 TO TRUE DTSCU422 00249 GO TO P1110-EXIT DTSCU422 00250 ELSE DTSCU422 00251 IF L422-RPT-TYPE-ORIG-88 DTSCU422 00252 AND WWGH-SSN < +1000000 DTSCU422 00253 NEXT SENTENCE DTSCU422 00254 END-IF DTSCU422 00255 PERFORM P1900-FIND-INDEX THRU P1900-EXIT DTSCU422 00256 IF L422-ERR-NO-88 DTSCU422 00257 PERFORM P1111-MOVE-WAGES THRU P1111-EXIT DTSCU422 00258 ELSE DTSCU422 00259 GO TO P1110-EXIT. DTSCU422 00260 DTSCU422 00261 PERFORM S881B-READ-NEXT THRU S881B-EXIT. DTSCU422 00262 DTSCU422 00263 P1110-EXIT. DTSCU422 00264 EXIT. DTSCU422 00265 DTSCU422 00266 P1111-MOVE-WAGES. DTSCU422 00267 MOVE WWGH-SSN TO WRK-SSN (TBL-SUB) DTSCU422 00268 DTSCU422 00269 EVALUATE TRUE DTSCU422 00270 WHEN WWGH-YRQ = L422-QTR1 DTSCU422 00271 ADD WWGH-EARNINGS TO WRK-QTR1-CURR-WAGE (TBL-SUB) DTSCU422 00272 WHEN WWGH-YRQ = L422-QTR2 DTSCU422 00273 ADD WWGH-EARNINGS TO WRK-QTR2-CURR-WAGE (TBL-SUB) DTSCU422 00274 WHEN WWGH-YRQ = L422-QTR3 DTSCU422 00275 ADD WWGH-EARNINGS TO WRK-QTR3-CURR-WAGE (TBL-SUB) DTSCU422 00276 WHEN WWGH-YRQ = L422-QTR4 DTSCU422 00277 ADD WWGH-EARNINGS TO WRK-QTR4-CURR-WAGE (TBL-SUB) DTSCU422 00278 WHEN WWGH-YRQ = PRIOR-QTR1 DTSCU422 00279 ADD WWGH-EARNINGS TO WRK-QTR1-PRIOR-WAGE (TBL-SUB) DTSCU422 00280 WHEN WWGH-YRQ = PRIOR-QTR2 DTSCU422 00281 ADD WWGH-EARNINGS TO WRK-QTR2-PRIOR-WAGE (TBL-SUB) DTSCU422 00282 WHEN WWGH-YRQ = PRIOR-QTR3 DTSCU422 00283 ADD WWGH-EARNINGS TO WRK-QTR3-PRIOR-WAGE (TBL-SUB) DTSCU422 00284 WHEN WWGH-YRQ = PRIOR-QTR4 DTSCU422 00285 ADD WWGH-EARNINGS TO WRK-QTR4-PRIOR-WAGE (TBL-SUB) DTSCU422 00286 END-EVALUATE. DTSCU422 00287 DTSCU422 00288 P1111-EXIT. DTSCU422 00289 EXIT. DTSCU422 00290 DTSCU422 00291 DTSCU422 00292 P1900-FIND-INDEX. DTSCU422 00293 SET WRK-INDEX-NULL-88 TO TRUE. DTSCU422 00294 DTSCU422 00295 IF WWGH-SSN > WRK-MAX-SSN DTSCU422 00296 IF TBL-CNT < TBL-MAX DTSCU422 00297 ADD +1 TO TBL-CNT DTSCU422 00298 MOVE TBL-CNT TO TBL-SUB DTSCU422 00299 SET WRK-INDEX-POSITION-FOUND-88 TO TRUE DTSCU422 00300 MOVE WWGH-SSN TO WRK-MAX-SSN DTSCU422 00301 ELSE DTSCU422 00302 SET L422-ERR-OVER-250-88 TO TRUE DTSCU422 00303 END-IF DTSCU422 00304 ELSE DTSCU422 00305 PERFORM P1910-SEARCH-TABLE THRU P1910-EXIT DTSCU422 00306 IF WRK-INDEX-POSITION-FOUND-88 DTSCU422 00307 IF TBL-CNT < TBL-MAX DTSCU422 00308 PERFORM P1920-INSERT-SSN THRU P1920-EXIT DTSCU422 00309 ELSE DTSCU422 00310 SET L422-ERR-OVER-250-88 TO TRUE DTSCU422 00311 END-IF DTSCU422 00312 END-IF DTSCU422 00313 END-IF. DTSCU422 00314 DTSCU422 00315 P1900-EXIT. DTSCU422 00316 EXIT. DTSCU422 00317 DTSCU422 00318 P1910-SEARCH-TABLE. DTSCU422 00319 PERFORM DTSCU422 00320 VARYING SSN-SUB FROM +1 BY +1 DTSCU422 00321 UNTIL WRK-INDEX-FOUND-88 DTSCU422 00322 OR SSN-SUB > TBL-CNT DTSCU422 00323 IF WRK-SSN (SSN-SUB) = WWGH-SSN DTSCU422 00324 SET WRK-INDEX-SSN-FOUND-88 TO TRUE DTSCU422 00325 MOVE SSN-SUB TO TBL-SUB DTSCU422 00326 ELSE DTSCU422 00327 IF WWGH-SSN < WRK-SSN (SSN-SUB) DTSCU422 00328 MOVE SSN-SUB TO TBL-SUB DTSCU422 00329 SET WRK-INDEX-POSITION-FOUND-88 TO TRUE DTSCU422 00330 END-IF DTSCU422 00331 END-IF DTSCU422 00332 END-PERFORM. DTSCU422 00333 DTSCU422 00334 P1910-EXIT. DTSCU422 00335 EXIT. DTSCU422 00336 DTSCU422 00337 P1920-INSERT-SSN. DTSCU422 00338 PERFORM DTSCU422 00339 VARYING SSN-SUB FROM TBL-CNT BY -1 DTSCU422 00340 UNTIL SSN-SUB < TBL-SUB DTSCU422 00341 COMPUTE NXT-SUB = SSN-SUB + 1 DTSCU422 00342 MOVE WRK-SSN-TBL (SSN-SUB) TO WRK-SSN-TBL (NXT-SUB) DTSCU422 00343 PERFORM P1921-INIT-ROW THRU P1921-EXIT DTSCU422 00344 END-PERFORM. DTSCU422 00345 DTSCU422 00346 ADD +1 TO TBL-CNT. DTSCU422 00347 DTSCU422 00348 P1920-EXIT. DTSCU422 00349 EXIT. DTSCU422 00350 DTSCU422 00351 P1921-INIT-ROW. DTSCU422 00352 MOVE ZERO TO WRK-SSN (SSN-SUB) DTSCU422 00353 WRK-QTR1-CURR-WAGE (SSN-SUB) DTSCU422 00354 WRK-QTR1-PRIOR-WAGE (SSN-SUB) DTSCU422 00355 WRK-QTR2-CURR-WAGE (SSN-SUB) DTSCU422 00356 WRK-QTR2-PRIOR-WAGE (SSN-SUB) DTSCU422 00357 WRK-QTR3-CURR-WAGE (SSN-SUB) DTSCU422 00358 WRK-QTR3-PRIOR-WAGE (SSN-SUB) DTSCU422 00359 WRK-QTR4-CURR-WAGE (SSN-SUB) DTSCU422 00360 WRK-QTR4-PRIOR-WAGE (SSN-SUB). DTSCU422 00361 MOVE SPACES TO WRK-SSN-NAME (SSN-SUB). DTSCU422 00362 P1921-EXIT. DTSCU422 00363 EXIT. DTSCU422 00364 DTSCU422 00365 P2000-FIND-NAMES. DTSCU422 00366 PERFORM DTSCU422 00367 VARYING TBL-SUB FROM +1 BY +1 DTSCU422 00368 UNTIL TBL-SUB > TBL-CNT DTSCU422 00369 MOVE LOW-VALUE TO WNAM-COMM-REC DTSCU422 00370 MOVE WRK-SSN (TBL-SUB) TO WNAM-SSN DTSCU422 00371 PERFORM S882A-START-BROWSE THRU S882A-EXIT DTSCU422 00372 IF L882-OK-88 DTSCU422 00373 MOVE WNAM-LAST-NAME (1:3) DTSCU422 00374 TO WRK-SSN-NAME (TBL-SUB) DTSCU422 00375 END-IF DTSCU422 00376 PERFORM S882C-END-BROWSE THRU S882C-EXIT DTSCU422 00377 END-PERFORM. DTSCU422 00378 DTSCU422 00379 P2000-EXIT. DTSCU422 00380 EXIT. DTSCU422 00381 DTSCU422 00382 P3000-SAVE-TO-TS. DTSCU422 00383 PERFORM P3100-INIT-TS THRU P3100-EXIT. DTSCU422 00384 DTSCU422 00385 PERFORM P3200-BUILD-TS THRU P3200-EXIT DTSCU422 00386 VARYING TBL-SUB FROM +1 BY +1 DTSCU422 00387 UNTIL TBL-SUB > TBL-CNT. DTSCU422 00388 DTSCU422 00389 IF TS-SUB > +0 DTSCU422 00390 MOVE L427-WAGE-AREA TO L829-REC DTSCU422 00391 ADD +1 TO L422-TS-CNT DTSCU422 00392 PERFORM S829B-WRITE THRU S829B-EXIT. DTSCU422 00393 DTSCU422 00394 MOVE WRK-LAST-DUMMY-SSN TO L422-LAST-DUMMY-SSN. DTSCU422 00395 DTSCU422 00396 P3000-EXIT. DTSCU422 00397 EXIT. DTSCU422 00398 DTSCU422 00399 P3100-INIT-TS. DTSCU422 00400 MOVE ZERO TO L427-WAGE-TBL-CNT DTSCU422 00401 TS-SUB DTSCU422 00402 DTSCU422 00403 MOVE L422-EMP-NO TO L427-EMP-NO. DTSCU422 00404 SET L427-EDITED-NO-88 TO TRUE. DTSCU422 00405 DTSCU422 00406 PERFORM DTSCU422 00407 VARYING SSN-SUB FROM +1 BY +1 DTSCU422 00408 UNTIL SSN-SUB > WRK-WAGE-TBL-MAX DTSCU422 00409 MOVE ZERO TO L427-SSN (SSN-SUB) DTSCU422 00410 L427-QTR1-WAGE-CHNG (SSN-SUB) DTSCU422 00411 L427-QTR1-CURR-WAGE (SSN-SUB) DTSCU422 00412 L427-QTR1-TAX-WAGE (SSN-SUB) DTSCU422 00413 L427-QTR1-PRIOR-WAGE (SSN-SUB) DTSCU422 00414 L427-QTR2-WAGE-CHNG (SSN-SUB) DTSCU422 00415 L427-QTR2-CURR-WAGE (SSN-SUB) DTSCU422 00416 L427-QTR2-TAX-WAGE (SSN-SUB) DTSCU422 00417 L427-QTR2-PRIOR-WAGE (SSN-SUB) DTSCU422 00418 L427-QTR3-WAGE-CHNG (SSN-SUB) DTSCU422 00419 L427-QTR3-CURR-WAGE (SSN-SUB) DTSCU422 00420 L427-QTR3-TAX-WAGE (SSN-SUB) DTSCU422 00421 L427-QTR3-PRIOR-WAGE (SSN-SUB) DTSCU422 00422 L427-QTR4-WAGE-CHNG (SSN-SUB) DTSCU422 00423 L427-QTR4-CURR-WAGE (SSN-SUB) DTSCU422 00424 L427-QTR4-TAX-WAGE (SSN-SUB) DTSCU422 00425 L427-QTR4-PRIOR-WAGE (SSN-SUB) DTSCU422 00426 MOVE SPACES TO L427-SSN-NAME (SSN-SUB) DTSCU422 00427 SET L427-SSN-NO-ENTRY-88 (SSN-SUB) TO TRUE DTSCU422 00428 SET L427-SSN-NAME-NO-ENTRY-88 (SSN-SUB) TO TRUE DTSCU422 00429 SET L427-QTR1-NO-ENTRY-88 (SSN-SUB) TO TRUE DTSCU422 00430 SET L427-QTR2-NO-ENTRY-88 (SSN-SUB) TO TRUE DTSCU422 00431 SET L427-QTR3-NO-ENTRY-88 (SSN-SUB) TO TRUE DTSCU422 00432 SET L427-QTR4-NO-ENTRY-88 (SSN-SUB) TO TRUE DTSCU422 00433 END-PERFORM. DTSCU422 00434 DTSCU422 00435 P3100-EXIT. DTSCU422 00436 EXIT. DTSCU422 00437 DTSCU422 00438 P3200-BUILD-TS. DTSCU422 00439 ADD +1 TO TS-SUB. DTSCU422 00440 IF TS-SUB > WRK-WAGE-TBL-MAX DTSCU422 00441 MOVE L427-WAGE-AREA TO L829-REC DTSCU422 00442 ADD +1 TO L422-TS-CNT DTSCU422 00443 PERFORM S829B-WRITE THRU S829B-EXIT DTSCU422 00444 PERFORM P3100-INIT-TS THRU P3100-EXIT DTSCU422 00445 MOVE +1 TO TS-SUB DTSCU422 00446 MOVE TS-SUB TO L427-WAGE-TBL-CNT DTSCU422 00447 PERFORM P3210-MOVE-DATA THRU P3210-EXIT DTSCU422 00448 ELSE DTSCU422 00449 MOVE TS-SUB TO L427-WAGE-TBL-CNT DTSCU422 00450 PERFORM P3210-MOVE-DATA THRU P3210-EXIT DTSCU422 00451 END-IF. DTSCU422 00452 DTSCU422 00453 P3200-EXIT. DTSCU422 00454 EXIT. DTSCU422 00455 DTSCU422 00456 P3210-MOVE-DATA. DTSCU422 00457 MOVE WRK-SSN (TBL-SUB) TO L427-SSN (TS-SUB). DTSCU422 00458 MOVE WRK-SSN-NAME (TBL-SUB) TO L427-SSN-NAME (TS-SUB). DTSCU422 00459 DTSCU422 00460 IF L422-RPT-TYPE-SUPPL-88 DTSCU422 00461 OR L422-RPT-TYPE-WD-88 DTSCU422 00462 SET L427-SSN-CURR-WAGE-88 (TS-SUB) TO TRUE DTSCU422 00463 ELSE DTSCU422 00464 SET L427-SSN-PRE-FILL-88 (TS-SUB) TO TRUE. DTSCU422 00465 DTSCU422 00466 MOVE WRK-QTR1-CURR-WAGE (TBL-SUB) DTSCU422 00467 TO L427-QTR1-CURR-WAGE (TS-SUB). DTSCU422 00468 MOVE WRK-QTR1-PRIOR-WAGE (TBL-SUB) DTSCU422 00469 TO L427-QTR1-PRIOR-WAGE (TS-SUB). DTSCU422 00470 MOVE WRK-QTR2-CURR-WAGE (TBL-SUB) DTSCU422 00471 TO L427-QTR2-CURR-WAGE (TS-SUB). DTSCU422 00472 MOVE WRK-QTR2-PRIOR-WAGE (TBL-SUB) DTSCU422 00473 TO L427-QTR2-PRIOR-WAGE (TS-SUB). DTSCU422 00474 MOVE WRK-QTR3-CURR-WAGE (TBL-SUB) DTSCU422 00475 TO L427-QTR3-CURR-WAGE (TS-SUB). DTSCU422 00476 MOVE WRK-QTR3-PRIOR-WAGE (TBL-SUB) DTSCU422 00477 TO L427-QTR3-PRIOR-WAGE (TS-SUB). DTSCU422 00478 MOVE WRK-QTR4-CURR-WAGE (TBL-SUB) DTSCU422 00479 TO L427-QTR4-CURR-WAGE (TS-SUB). DTSCU422 00480 MOVE WRK-QTR4-PRIOR-WAGE (TBL-SUB) DTSCU422 00481 TO L427-QTR4-PRIOR-WAGE (TS-SUB). DTSCU422 00482 DTSCU422 00483 IF L422-RPT-TYPE-SUPPL-88 DTSCU422 00484 OR L422-RPT-TYPE-WD-88 DTSCU422 00485 ADD +1 TO TS-SUB DTSCU422 00486 MOVE WRK-SSN (TBL-SUB) TO L427-SSN (TS-SUB) DTSCU422 00487 MOVE WRK-SSN-NAME (TBL-SUB) TO L427-SSN-NAME (TS-SUB) DTSCU422 00488 IF WRK-SSN-DUMMY-88 (TBL-SUB) DTSCU422 00489 SET L427-SSN-DUMMY-88 (TS-SUB) TO TRUE DTSCU422 00490 IF WRK-SSN (TBL-SUB) > WRK-LAST-DUMMY-SSN DTSCU422 00491 MOVE WRK-SSN (TBL-SUB) TO WRK-LAST-DUMMY-SSN DTSCU422 00492 END-IF DTSCU422 00493 ELSE DTSCU422 00494 SET L427-SSN-PRE-FILL-88 (TS-SUB) TO TRUE DTSCU422 00495 END-IF DTSCU422 00496 MOVE WRK-QTR1-CURR-WAGE (TBL-SUB) DTSCU422 00497 TO L427-QTR1-CURR-WAGE (TS-SUB) DTSCU422 00498 MOVE WRK-QTR1-PRIOR-WAGE (TBL-SUB) DTSCU422 00499 TO L427-QTR1-PRIOR-WAGE (TS-SUB) DTSCU422 00500 MOVE WRK-QTR2-CURR-WAGE (TBL-SUB) DTSCU422 00501 TO L427-QTR2-CURR-WAGE (TS-SUB) DTSCU422 00502 MOVE WRK-QTR2-PRIOR-WAGE (TBL-SUB) DTSCU422 00503 TO L427-QTR2-PRIOR-WAGE (TS-SUB) DTSCU422 00504 MOVE WRK-QTR3-CURR-WAGE (TBL-SUB) DTSCU422 00505 TO L427-QTR3-CURR-WAGE (TS-SUB) DTSCU422 00506 MOVE WRK-QTR3-PRIOR-WAGE (TBL-SUB) DTSCU422 00507 TO L427-QTR3-PRIOR-WAGE (TS-SUB) DTSCU422 00508 MOVE WRK-QTR4-CURR-WAGE (TBL-SUB) DTSCU422 00509 TO L427-QTR4-CURR-WAGE (TS-SUB) DTSCU422 00510 MOVE WRK-QTR4-PRIOR-WAGE (TBL-SUB) DTSCU422 00511 TO L427-QTR4-PRIOR-WAGE (TS-SUB). DTSCU422 00512 DTSCU422 00513 P3210-EXIT. DTSCU422 00514 EXIT. DTSCU422 00515 DTSCU422 00516 S004-FROM-5. DTSCU422 00517 SET L004-FROM-5 TO TRUE. DTSCU422 00518 EXEC CICS DTSCU422 00519 LINK DTSCU422 00520 PROGRAM('DTSCU004') DTSCU422 00521 COMMAREA(L004-COMM-AREA) DTSCU422 00522 END-EXEC. DTSCU422 00523 DTSCU422 00524 S004-EXIT. DTSCU422 00525 EXIT. DTSCU422 00526 DTSCU422 00527 S829B-WRITE. DTSCU422 00528 SET L829-WRITE-88 TO TRUE. DTSCU422 00529 PERFORM S829Z-QUEUE-IO THRU S829Z-EXIT. DTSCU422 00530 DTSCU422 00531 S829B-EXIT. DTSCU422 00532 EXIT. DTSCU422 00533 DTSCU422 00534 S829Z-QUEUE-IO. DTSCU422 00535 MOVE L422-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCU422 00536 MOVE 'W' TO L829-QUEUE-NAME-SUFFIX. DTSCU422 00537 MOVE ITEM-LENGTH TO L829-REC-LENGTH. DTSCU422 00538 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCU422 00539 DTSCU422 00540 EXEC CICS LINK DTSCU422 00541 PROGRAM ('DTSCU829') DTSCU422 00542 COMMAREA (L829-COMM-AREA) DTSCU422 00543 END-EXEC. DTSCU422 00544 DTSCU422 00545 S829Z-EXIT. DTSCU422 00546 EXIT. DTSCU422 00547 DTSCU422 00548 S881A-START-BROWSE. DTSCU422 00549 SET L881-START-BROWSE-88 TO TRUE. DTSCU422 00550 PERFORM S881Z-WWGH-IO THRU S881Z-EXIT. DTSCU422 00551 DTSCU422 00552 S881A-EXIT. DTSCU422 00553 EXIT. DTSCU422 00554 DTSCU422 00555 S881B-READ-NEXT. DTSCU422 00556 SET L881-READ-NEXT-88 TO TRUE. DTSCU422 00557 PERFORM S881Z-WWGH-IO THRU S881Z-EXIT. DTSCU422 00558 DTSCU422 00559 S881B-EXIT. DTSCU422 00560 EXIT. DTSCU422 00561 DTSCU422 00562 S881C-END-BROWSE. DTSCU422 00563 SET L881-END-BROWSE-88 TO TRUE. DTSCU422 00564 PERFORM S881Z-WWGH-IO THRU S881Z-EXIT. DTSCU422 00565 DTSCU422 00566 S881C-EXIT. DTSCU422 00567 EXIT. DTSCU422 00568 DTSCU422 00569 S881Z-WWGH-IO. DTSCU422 00570 EXEC CICS DTSCU422 00571 LINK DTSCU422 00572 PROGRAM('DTSCU881') DTSCU422 00573 COMMAREA(L881-COMM-AREA) DTSCU422 00574 END-EXEC. DTSCU422 00575 DTSCU422 00576 S881Z-EXIT. DTSCU422 00577 EXIT. DTSCU422 00578 DTSCU422 00579 S882A-START-BROWSE. DTSCU422 00580 SET L882-START-BROWSE-88 TO TRUE. DTSCU422 00581 PERFORM S882Z-WNAM-IO THRU S882Z-EXIT. DTSCU422 00582 DTSCU422 00583 S882A-EXIT. DTSCU422 00584 EXIT. DTSCU422 00585 DTSCU422 00586 S882C-END-BROWSE. DTSCU422 00587 SET L882-END-BROWSE-88 TO TRUE. DTSCU422 00588 PERFORM S882Z-WNAM-IO THRU S882Z-EXIT. DTSCU422 00589 DTSCU422 00590 S882C-EXIT. DTSCU422 00591 EXIT. DTSCU422 00592 DTSCU422 00593 S882Z-WNAM-IO. DTSCU422 00594 EXEC CICS DTSCU422 00595 LINK DTSCU422 00596 PROGRAM('DTSCU882') DTSCU422 00597 COMMAREA(L882-COMM-AREA) DTSCU422 00598 END-EXEC. DTSCU422 00599 DTSCU422 00600 S882Z-EXIT. DTSCU422 00601 EXIT. DTSCU422 00602 DTSCU422 00603 DTSCU422 00604 S899-ABEND. DTSCU422 00605 EXEC CICS DTSCU422 00606 ABEND DTSCU422 00607 ABCODE(WRK-ABEND-CD) DTSCU422 00608 END-EXEC. DTSCU422 00609 S899-EXIT. DTSCU422 00610 EXIT. DTSCU422