Files
DUTAS/Batch/TDECVAL.cob

614 lines
48 KiB
COBOL

00001 IDENTIFICATION DIVISION. 05/22/01
00002 PROGRAM-ID. TDECVAL. TDECVAL
00003 LV001
00004 ******************************************************************TDECVAL
00005 * *TDECVAL
00006 * FUNCTION: *TDECVAL
00007 * THE FUNCTION OF TDECVAL IS TO VALIDATE THE *TDECVAL
00008 * WAGE RECORD DATA THAT IS TRANSMITTED FROM THE TDEC COMPANY*TDECVAL
00009 * *TDECVAL
00010 * *TDECVAL
00011 ******************************************************************TDECVAL
00012 ******************************************************************TDECVAL
00013 * MODIFICATION HISTORY: *TDECVAL
00014 * *TDECVAL
00015 * 04-13-2001 MODIFIED TO INTERFACE WITH TAPE TRACKING SYSTEM *TDECVAL
00016 * THROUGH DESBD200. *TDECVAL
00017 * MODIFIED OUTPUT RECORD: FIRST DATA ELEMENT IS THE *TDECVAL
00018 * LOG NUMBER FOR THE TRAKING SYSTEM. *TDECVAL
00019 * *TDECVAL
00020 * REFERENCE RFP # AUTHOR OF CHANGE - GD *TDECVAL
00021 * *TDECVAL
00022 * 05-15-2001 MODIFIED TO OUTPUT A CLEAN TDEC DISK FILE. I.E., *TDECVAL
00023 * WITHOUT THE EXCEPTION RECORDS. *TDECVAL
00024 * REFERENCE RFP # AUTHOR OF CHANGE - RW *TDECVAL
00025 * *TDECVAL
00026 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *TDECVAL
00027 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *TDECVAL
00028 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *TDECVAL
00029 ******************************************************************TDECVAL
00030 TDECVAL
00031 ENVIRONMENT DIVISION. TDECVAL
00032 TDECVAL
00033 CONFIGURATION SECTION. TDECVAL
00034 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. TDECVAL
00035 TDECVAL
00036 INPUT-OUTPUT SECTION. TDECVAL
00037 FILE-CONTROL. TDECVAL
00038 SELECT TDECFILE ASSIGN TO TDECFILE. TDECVAL
00039 SELECT TDECOUT ASSIGN TO TDECOUT. TDECVAL
00040 SELECT LISTOUT ASSIGN TO UR-S-LISTOUT. TDECVAL
00041 SELECT EAFILE ASSIGN TO TXMASTER, TDECVAL
00042 ORGANIZATION IS INDEXED, TDECVAL
00043 ACCESS MODE IS DYNAMIC, TDECVAL
00044 RECORD KEY IS EMPL-ACCT-NO TDECVAL
00045 FILE STATUS IS FILE-STATUS-FILE. TDECVAL
00046 TDECVAL
00047 DATA DIVISION. TDECVAL
00048 TDECVAL
00049 FILE SECTION. TDECVAL
00050 FD EAFILE TDECVAL
00051 RECORD CONTAINS 3285 CHARACTERS TDECVAL
00052 DATA RECORD IS TX-MASTER. TDECVAL
00053 01 TXMASTER. TDECVAL
00054 ++INCLUDE TXMSR TDECVAL
00055 TDECVAL
00056 FD TDECFILE TDECVAL
00057 RECORDING MODE IS F TDECVAL
00058 ** RECORDING MODE IS S TDECVAL
00059 BLOCK CONTAINS 0 CHARACTERS TDECVAL
00060 LABEL RECORDS ARE STANDARD TDECVAL
00061 DATA RECORD IS TDECREC. TDECVAL
00062 01 TRANSACTION-RECORD PIC X(80). TDECVAL
00063 *01 TRANSACTION-RECORD1 PIC X(20). TDECVAL
00064 *01 TRANSACTION-RECORD2 PIC X(360). TDECVAL
00065 TDECVAL
00066 FD TDECOUT TDECVAL
00067 RECORDING MODE IS F TDECVAL
00068 BLOCK CONTAINS 0 CHARACTERS TDECVAL
00069 LABEL RECORDS ARE STANDARD TDECVAL
00070 DATA RECORD IS TDECOUT-REC. TDECVAL
00071 01 TDECOUT-REC PIC X(90). TDECVAL
00072 TDECVAL
00073 FD LISTOUT TDECVAL
00074 RECORD CONTAINS 133 CHARACTERS TDECVAL
00075 LABEL RECORDS ARE OMITTED TDECVAL
00076 DATA RECORD IS PRINT-REC. TDECVAL
00077 01 PRINT-REC PIC X(133). TDECVAL
00078 TDECVAL
00079 WORKING-STORAGE SECTION. TDECVAL
000795 77 PAN-VALET PICTURE X(24) VALUE '001TDECVAL 05/22/01'. TDECVAL
00080 TDECVAL
00081 01 WRK-AREA. TDECVAL
00082 05 ABEND-CD PIC X(05) VALUE 'TDVAL'. TDECVAL
00083 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. TDECVAL
00084 05 ABEND-MSG PIC X(60). TDECVAL
00085 05 WRK-MOD-NAME PIC X(08) VALUE 'TDECVAL '. TDECVAL
00086 05 WRK-LOG-NO PIC 9(10) VALUE 0. TDECVAL
00087 05 ERROR-SW PIC 9 VALUE 0. TDECVAL
00088 TDECVAL
00089 01 WS-QUARTER-YR-QTR PIC 9(05). TDECVAL
00090 01 FILLER REDEFINES WS-QUARTER-YR-QTR. TDECVAL
00091 05 WS-QUARTER-YEAR PIC 9(4). TDECVAL
00092 05 WS-QUARTER-QTR PIC 9(1). TDECVAL
00093 TDECVAL
00094 01 L004-LINK-AREA. TDECVAL
00095 ++INCLUDE DTSIL004 TDECVAL
00096 EJECT TDECVAL
00097 TDECVAL
00098 01 WS-WAGE-ACCOUNT PIC 9(06). TDECVAL
00099 TDECVAL
00100 01 WS-CURR-EMP PIC 9(06) VALUE ZERO. TDECVAL
00101 01 WS-EMP-TOT-CNT PIC S9(07) COMP-3 VALUE +0.TDECVAL
00102 01 WS-EMP-SUCCESS-CNT PIC S9(07) COMP-3 VALUE +0.TDECVAL
00103 TDECVAL
00104 01 L200-LINK-AREA. TDECVAL
00105 ++INCLUDE DESIL200 TDECVAL
00106 TDECVAL
00107 01 C202-MSG-TABLE. TDECVAL
00108 ++INCLUDE DTSIC202 TDECVAL
00109 TDECVAL
00110 01 ALPHA-SORT-NAME-FOUR PIC X(4). TDECVAL
00111 01 MAILING-NAME-FOUR PIC X(4). TDECVAL
00112 TDECVAL
00113 01 TDECOUT-WORK-AREA. TDECVAL
00114 ******************************************************************TDECVAL
00115 * TDEC-OUTPUT TRANSACTION RECORD AREA *TDECVAL
00116 ******************************************************************TDECVAL
00117 05 WRK-TRANSACTION-AREA. TDECVAL
00118 10 WRK-TRAN-LOG-NO PIC 9(10) VALUE 0. TDECVAL
00119 10 WRK-TRAN-AREA PIC X(80) VALUE SPACES. TDECVAL
00120 TDECVAL
00121 01 TRANSACTION-WORK-AREA. TDECVAL
00122 ******************************************************************TDECVAL
00123 * ESP TRANSACTION RECORD DESCRIPTIONS *TDECVAL
00124 ******************************************************************TDECVAL
00125 05 ESP-TRANSACTION-AREA. TDECVAL
00126 10 TRAN-SSN PIC 9(10). TDECVAL
00127 10 FILLER REDEFINES TRAN-SSN. TDECVAL
00128 15 TR-SSN PIC 9(9). TDECVAL
00129 15 TR-SSN-SEQ PIC 9(1). TDECVAL
00130 10 TRAN-ID PIC X(02). TDECVAL
00131 10 FILLER REDEFINES TRAN-ID. TDECVAL
00132 15 TRAN-ID-PFX PIC X(1). TDECVAL
00133 88 TRAN-ID-PFX-WAGE VALUE 'W'. TDECVAL
00134 15 FILLER PIC X(1). TDECVAL
00135 10 TRAN-OPER-ID PIC 9(8). TDECVAL
00136 10 FILLER REDEFINES TRAN-OPER-ID. TDECVAL
00137 15 BATCH-NUMBER PIC 9(03). TDECVAL
00138 15 FILLER REDEFINES BATCH-NUMBER. TDECVAL
00139 20 BATCH-NUMBER-NN PIC 9(02). TDECVAL
00140 20 FILLER PIC X(01). TDECVAL
00141 15 TRAN-LOCAL-OFFICE PIC 9(02). TDECVAL
00142 15 TRAN-OPERATOR-ID PIC 9(03). TDECVAL
00143 10 TRAN-DATE-ENTERED PIC 9(08). TDECVAL
00144 10 TRAN-TIME-ENTERED PIC 9(06). TDECVAL
00145 10 FILLER PIC 9(06). TDECVAL
00146 10 TRAN-NAME-CHECK PIC X(3). TDECVAL
00147 10 TRAN-QUARTER-YR-QTR PIC 9(5). TDECVAL
00148 10 TRAN-AFFI-CODE PIC 9(1). TDECVAL
00149 10 TRAN-QUARTER-EARNINGS PIC 9(7). TDECVAL
00150 10 TRAN-ACCOUNT PIC 9(6). TDECVAL
00151 10 TRAN-EMP-NAME PIC X(4). TDECVAL
00152 10 TRAN-FILLER PIC X(299). TDECVAL
00153 01 COUNTERS. TDECVAL
00154 03 FILE-STATUS-FILE PIC 99. TDECVAL
00155 03 EMP-QTR-TOT-EARNINGS PIC 9(7). TDECVAL
00156 03 RECS-IN PIC 9(5). TDECVAL
00157 03 RECS-OUT PIC 9(5). TDECVAL
00158 03 QTR-RECS-OUT PIC 9(5). TDECVAL
00159 03 PAGE-CTR PIC 9(5). TDECVAL
00160 03 ERROR-RECS PIC 9(5). TDECVAL
00161 TDECVAL
00162 03 ZERO-WAGE-CNT PIC 9(5). TDECVAL
00163 03 EXCEPTION-CNT PIC 9(5). TDECVAL
00164 03 WS-ZERO-WAGE-NO PIC 9(5). TDECVAL
00165 TDECVAL
00166 TDECVAL
00167 01 LINE-CTR PIC 9(5) VALUE 56. TDECVAL
00168 01 EOF PIC X. TDECVAL
00169 TDECVAL
00170 01 WS-TODAY PIC 9(06). TDECVAL
00171 01 WS-TODAY-REDEF REDEFINES WS-TODAY. TDECVAL
00172 05 WS-TODAY-YY PIC 9(02). TDECVAL
00173 05 WS-TODAY-MM PIC 9(02). TDECVAL
00174 05 WS-TODAY-DD PIC 9(02). TDECVAL
00175 TDECVAL
00176 01 SELECT-CARD. TDECVAL
00177 03 PGM-NAME PIC X(09) VALUE '**TDECVAL'. TDECVAL
00178 03 FIL PIC XX. TDECVAL
00179 03 SELECT-QUARTER PIC 9(5). TDECVAL
00180 03 FIL PIC X(73). TDECVAL
00181 01 HD1. TDECVAL
00182 03 FIL PIC X(5) VALUE SPACES. TDECVAL
00183 03 FIL PIC X(8) VALUE 'TDECVAL '. TDECVAL
00184 03 FIL PIC X(31) VALUE SPACES. TDECVAL
00185 03 FIL PIC X(42) VALUE TDECVAL
00186 'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'. TDECVAL
00187 03 FIL PIC X(35) VALUE SPACES. TDECVAL
00188 03 FIL PIC X(5) VALUE 'PAGE:'. TDECVAL
00189 03 PAGE-CTR-PRT PIC ZZ,ZZ9. TDECVAL
00190 01 HD2. TDECVAL
00191 03 FIL PIC X(49) VALUE SPACES. TDECVAL
00192 03 FIL PIC X(39) VALUE TDECVAL
00193 'DOES UI WAGE RECORD EDIT REPORT'. TDECVAL
00194 01 HD3. TDECVAL
00195 03 FIL PIC X(57) VALUE SPACES. TDECVAL
00196 03 FIL PIC X(9) VALUE 'RUN DATE:'. TDECVAL
00197 03 REPORTING-DATE-MM PIC X(2). TDECVAL
00198 03 FILLER PIC X VALUE '/'. TDECVAL
00199 03 REPORTING-DATE-DD PIC X(2). TDECVAL
00200 03 FILLER PIC X VALUE '/'. TDECVAL
00201 03 REPORTING-DATE-YY PIC X(2). TDECVAL
00202 TDECVAL
00203 01 HD4. TDECVAL
00204 03 FIL PIC X(5) VALUE SPACES. TDECVAL
00205 03 FIL PIC X(3) VALUE 'SSN'. TDECVAL
00206 03 FIL PIC X(7) VALUE SPACES. TDECVAL
00207 03 FIL PIC X(12) VALUE 'DATE ENTERED'. TDECVAL
00208 03 FIL PIC X(02) VALUE SPACES. TDECVAL
00209 03 FIL PIC X(13) VALUE 'EMPLOYEE NAME'. TDECVAL
00210 03 FIL PIC X(2) VALUE SPACES. TDECVAL
00211 03 FIL PIC X(7) VALUE 'QUARTER'. TDECVAL
00212 03 FIL PIC X(6) VALUE SPACES. TDECVAL
00213 03 FIL PIC X(8) VALUE 'EARNINGS'. TDECVAL
00214 03 FIL PIC X(6) VALUE SPACES. TDECVAL
00215 03 FIL PIC X(14) VALUE 'ACCOUNT NUMBER'. TDECVAL
00216 03 FIL PIC X(2) VALUE SPACES. TDECVAL
00217 03 FIL PIC X(13) VALUE 'EMPLOYER NAME'. TDECVAL
00218 03 FIL PIC X(04) VALUE SPACES. TDECVAL
00219 03 FIL PIC X(18) VALUE 'ERRORS ENCOUNTERED'.TDECVAL
00220 01 DTL1. TDECVAL
00221 03 FIL PIC X(5) VALUE SPACES. TDECVAL
00222 03 SSN-PRT PIC X(9). TDECVAL
00223 03 FIL PIC X(04) VALUE SPACES. TDECVAL
00224 03 DATE-ENTERED-PRT PIC X(06). TDECVAL
00225 03 FIL PIC X(10) VALUE SPACES. TDECVAL
00226 03 EMPEE-NAME PIC X(3). TDECVAL
00227 03 FIL PIC X(08) VALUE SPACES. TDECVAL
00228 03 QTR-PRT PIC X(5). TDECVAL
00229 03 FIL PIC X(08) VALUE SPACES. TDECVAL
00230 03 EARNINGS-PRT PIC X(7). TDECVAL
00231 03 FIL PIC X(10) VALUE SPACES. TDECVAL
00232 03 ACCT-NUM-PRT PIC X(6). TDECVAL
00233 03 FIL PIC X(10) VALUE SPACES. TDECVAL
00234 03 EMPOR-PRT PIC X(6). TDECVAL
00235 03 FIL PIC X(07) VALUE SPACES. TDECVAL
00236 03 MESSAGE-AREA PIC X(30) VALUE SPACES. TDECVAL
00237 01 TOT1. TDECVAL
00238 03 FIL PIC X(2) VALUE SPACES. TDECVAL
00239 03 FIL PIC X(21) VALUE 'TOTAL WAGE RECS READ:'. TDECVAL
00240 03 WAGE-CNT-PRT PIC ZZZ,ZZ9. TDECVAL
00241 03 FIL PIC X(6) VALUE SPACES. TDECVAL
00242 03 FIL PIC X(24) VALUE 'TOTAL WAGE RECS WRITTEN:'.TDECVAL
00243 03 WAGE-OUT-PRT PIC ZZZ,ZZ9. TDECVAL
00244 03 FIL PIC X(6) VALUE SPACES. TDECVAL
00245 03 FIL PIC X(20) VALUE 'TOTAL ERROR RECORDS:'. TDECVAL
00246 03 ERRORS-PRT PIC ZZ,ZZ9. TDECVAL
00247 03 FIL PIC X(6) VALUE SPACES. TDECVAL
00248 03 FIL PIC X(20) VALUE 'TOTAL ZERO WAGE REC:'. TDECVAL
00249 03 ZERO-WAGE-PRT PIC ZZ,ZZ9. TDECVAL
00250 03 BLANK-LINE PIC X(133) VALUE SPACES. TDECVAL
00251 TDECVAL
00252 LINKAGE SECTION. TDECVAL
00253 01 PARM-AREA. TDECVAL
00254 05 PARM-LENGTH PIC S9(04) COMP. TDECVAL
00255 05 PARM-LOG-NO PIC 9(06). TDECVAL
00256 05 FILLER PIC X(01). TDECVAL
00257 05 PARM-ZERO-WAGE-NO PIC 9(05). TDECVAL
00258 TDECVAL
00259 PROCEDURE DIVISION USING PARM-AREA. TDECVAL
00260 TDECVAL
00261 ** READY TRACE. TDECVAL
00262 ACCEPT SELECT-CARD. TDECVAL
00263 OPEN INPUT TDECFILE TDECVAL
00264 I-O EAFILE TDECVAL
00265 OUTPUT LISTOUT TDECOUT. TDECVAL
00266 TDECVAL
00267 ACCEPT WS-TODAY FROM DATE. TDECVAL
00268 MOVE WS-TODAY-YY TO REPORTING-DATE-YY. TDECVAL
00269 MOVE WS-TODAY-MM TO REPORTING-DATE-MM. TDECVAL
00270 MOVE WS-TODAY-DD TO REPORTING-DATE-DD. TDECVAL
00271 TDECVAL
00272 MOVE ZEROS TO COUNTERS. TDECVAL
00273 TDECVAL
00274 PERFORM INIT0100-EDIT-PARMS THRU INIT0100-EXIT. TDECVAL
00275 TDECVAL
00276 PERFORM 100-READ-WAGE THRU 100-RW-EXIT TDECVAL
00277 UNTIL TDECVAL
00278 EOF = 1. TDECVAL
00279 TDECVAL
00280 INIT0100-EDIT-PARMS. TDECVAL
00281 TDECVAL
00282 IF PARM-LOG-NO NOT NUMERIC TDECVAL
00283 MOVE 'PARM-LOG-NO IS NOT NUMERIC ' TO ABEND-MSG TDECVAL
00284 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. TDECVAL
00285 TDECVAL
00286 DISPLAY 'PARM-LOG-NO = ' PARM-LOG-NO. TDECVAL
00287 TDECVAL
00288 IF PARM-ZERO-WAGE-NO NOT NUMERIC TDECVAL
00289 MOVE 'PARM-ZERO-WAGE-NO IS NOT NUMERIC ' TO ABEND-MSG TDECVAL
00290 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. TDECVAL
00291 TDECVAL
00292 MOVE PARM-ZERO-WAGE-NO TO WS-ZERO-WAGE-NO. TDECVAL
00293 DISPLAY 'PARM-ZERO-WAGE-NO = ' WS-ZERO-WAGE-NO. TDECVAL
00294 TDECVAL
00295 TDECVAL
00296 SET L200-CMD-INIT-88 TO TRUE. TDECVAL
00297 MOVE PARM-LOG-NO TO L200-LOG-NO-SFX. TDECVAL
00298 MOVE WRK-MOD-NAME TO L200-PROG-NAME. TDECVAL
00299 CALL 'DESBD200' USING L200-LINK-AREA C202-MSG-TABLE. TDECVAL
00300 MOVE L200-LOG-NO TO WRK-LOG-NO. TDECVAL
00301 TDECVAL
00302 DISPLAY 'WRK-LOG-NO = ' WRK-LOG-NO. TDECVAL
00303 TDECVAL
00304 INIT0100-EXIT. TDECVAL
00305 EXIT. TDECVAL
00306 TDECVAL
00307 100-READ-WAGE. TDECVAL
00308 READ TDECFILE INTO ESP-TRANSACTION-AREA TDECVAL
00309 AT END TDECVAL
00310 MOVE 1 TO EOF TDECVAL
00311 TDECVAL
00312 IF WS-EMP-TOT-CNT > ZERO TDECVAL
00313 MOVE WS-CURR-EMP TO L200-EMP-NO TDECVAL
00314 MOVE WS-QUARTER-YR-QTR TO L200-REPORTING-DATE TDECVAL
00315 MOVE WS-EMP-TOT-CNT TO L200-TOT-CNT TDECVAL
00316 MOVE WS-EMP-SUCCESS-CNT TO L200-SUCCESS-CNT TDECVAL
00317 ELSE TDECVAL
00318 MOVE ZERO TO L200-EMP-NO TDECVAL
00319 L200-TOT-CNT TDECVAL
00320 L200-SUCCESS-CNT TDECVAL
00321 END-IF TDECVAL
00322 TDECVAL
00323 SET L200-CMD-TERMINATE-88 TO TRUE TDECVAL
00324 PERFORM SERV0200-UPD-LOG THRU SERV0200-EXIT. TDECVAL
00325 TDECVAL
00326 IF EOF = 1 TDECVAL
00327 GO TO 999-CLOSE-FILES. TDECVAL
00328 ** TDECVAL
00329 **TO BYPASS WAGE REPORTS PRINTED FROM THE NEW TAX M/F TDECVAL
00330 ** TDECVAL
00331 IF TRAN-QUARTER-YR-QTR > 19993 TDECVAL
00332 ** ADD 1 TO RECS-IN TDECVAL
00333 GO TO 100-READ-WAGE. TDECVAL
00334 TDECVAL
00335 ADD 1 TO RECS-IN. TDECVAL
00336 TDECVAL
00337 INSPECT TRAN-QUARTER-EARNINGS REPLACING TDECVAL
00338 LEADING ' ' BY ZERO. TDECVAL
00339 TDECVAL
00340 IF TRAN-QUARTER-EARNINGS = ZEROS TDECVAL
00341 IF WS-ZERO-WAGE-NO = EXCEPTION-CNT TDECVAL
00342 ADD 1 TO ZERO-WAGE-CNT TDECVAL
00343 GO TO 100-READ-WAGE TDECVAL
00344 ELSE TDECVAL
00345 MOVE 'GROSS-WAGE EQUAL ZEROS' TO MESSAGE-AREA TDECVAL
00346 * MOVE 1 TO ERROR-SW TDECVAL
00347 ADD 1 TO ZERO-WAGE-CNT TDECVAL
00348 ADD 1 TO EXCEPTION-CNT TDECVAL
00349 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00350 SET EMSG106-SELECTED-YES TO TRUE TDECVAL
00351 MOVE ZERO TO ERROR-SW TDECVAL
00352 GO TO 100-RW-EXIT. TDECVAL
00353 TDECVAL
00354 MOVE TRAN-ACCOUNT TO WS-WAGE-ACCOUNT. TDECVAL
00355 TDECVAL
00356 IF WS-WAGE-ACCOUNT NOT NUMERIC TDECVAL
00357 * NEXT SENTENCE TDECVAL
00358 MOVE ZEROS TO WS-WAGE-ACCOUNT TDECVAL
00359 ELSE TDECVAL
00360 IF WS-CURR-EMP = ZERO TDECVAL
00361 MOVE WS-WAGE-ACCOUNT TO WS-CURR-EMP TDECVAL
00362 MOVE +1 TO WS-EMP-TOT-CNT TDECVAL
00363 MOVE ZERO TO WS-EMP-SUCCESS-CNT TDECVAL
00364 ELSE TDECVAL
00365 IF WS-WAGE-ACCOUNT NOT = WS-CURR-EMP TDECVAL
00366 SET L200-CMD-EMP-COMPLETE-88 TO TRUE TDECVAL
00367 MOVE WS-CURR-EMP TO L200-EMP-NO TDECVAL
00368 MOVE WS-QUARTER-YR-QTR TO L200-REPORTING-DATE TDECVAL
00369 MOVE WS-EMP-TOT-CNT TO L200-TOT-CNT TDECVAL
00370 MOVE WS-EMP-SUCCESS-CNT TO L200-SUCCESS-CNT TDECVAL
00371 PERFORM SERV0200-UPD-LOG THRU SERV0200-EXIT TDECVAL
00372 MOVE +1 TO WS-EMP-TOT-CNT TDECVAL
00373 MOVE ZERO TO WS-EMP-SUCCESS-CNT TDECVAL
00374 MOVE WS-WAGE-ACCOUNT TO WS-CURR-EMP TDECVAL
00375 ELSE TDECVAL
00376 ADD +1 TO WS-EMP-TOT-CNT TDECVAL
00377 END-IF TDECVAL
00378 END-IF TDECVAL
00379 END-IF. TDECVAL
00380 TDECVAL
00381 PERFORM 110-VALIDATE-WAGE THRU 121-VW-EXIT. TDECVAL
00382 TDECVAL
00383 IF ERROR-SW = 1 TDECVAL
00384 MOVE ZERO TO ERROR-SW TDECVAL
00385 GO TO 100-RW-EXIT TDECVAL
00386 ELSE TDECVAL
00387 MOVE ZERO TO ERROR-SW. TDECVAL
00388 TDECVAL
00389 PERFORM 220-CREATE-W4-TRAN THRU 220-CW-EXIT. TDECVAL
00390 TDECVAL
00391 100-RW-EXIT. TDECVAL
00392 EXIT. TDECVAL
00393 TDECVAL
00394 110-VALIDATE-WAGE. TDECVAL
00395 TDECVAL
00396 MOVE SPACES TO MESSAGE-AREA. TDECVAL
00397 TDECVAL
00398 111-VALIDATE-SSN. TDECVAL
00399 IF TR-SSN NOT NUMERIC TDECVAL
00400 MOVE 1 TO ERROR-SW TDECVAL
00401 MOVE 'SSN NOT NUMERIC ' TO MESSAGE-AREA TDECVAL
00402 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00403 SET EMSG104-SELECTED-YES TO TRUE TDECVAL
00404 GO TO 121-VW-EXIT. TDECVAL
00405 TDECVAL
00406 112-VALIDATE-ID. TDECVAL
00407 IF TRAN-ID NOT = 'W4' TDECVAL
00408 MOVE 1 TO ERROR-SW TDECVAL
00409 MOVE 'TRAN-ID ERROR' TO MESSAGE-AREA TDECVAL
00410 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00411 SET EMSG112-SELECTED-YES TO TRUE. TDECVAL
00412 TDECVAL
00413 113-VALIDATE-DATE. TDECVAL
00414 IF TRAN-DATE-ENTERED NOT NUMERIC TDECVAL
00415 MOVE 1 TO ERROR-SW TDECVAL
00416 MOVE 'DATE ENTERED ERROR' TO MESSAGE-AREA TDECVAL
00417 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00418 SET EMSG113-SELECTED-YES TO TRUE. TDECVAL
00419 TDECVAL
00420 114-VALIDATE-TIME. TDECVAL
00421 IF TRAN-TIME-ENTERED NOT NUMERIC TDECVAL
00422 MOVE 1 TO ERROR-SW TDECVAL
00423 MOVE 'TIME-ENTERED ERROR' TO MESSAGE-AREA TDECVAL
00424 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00425 SET EMSG114-SELECTED-YES TO TRUE. TDECVAL
00426 TDECVAL
00427 115-VALIDATE-NAME. TDECVAL
00428 IF TRAN-NAME-CHECK EQUAL SPACES TDECVAL
00429 MOVE 1 TO ERROR-SW TDECVAL
00430 MOVE 'EMPLOYEE NAME IS SPACES' TO MESSAGE-AREA TDECVAL
00431 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00432 SET EMSG107-SELECTED-YES TO TRUE. TDECVAL
00433 TDECVAL
00434 116-VALIDATE-QUARTER1. TDECVAL
00435 IF TRAN-QUARTER-YR-QTR NOT NUMERIC TDECVAL
00436 MOVE 1 TO ERROR-SW TDECVAL
00437 MOVE 'QUARTER FIELD NOT VALID' TO MESSAGE-AREA TDECVAL
00438 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00439 SET EMSG101-SELECTED-YES TO TRUE TDECVAL
00440 GO TO 118-QUARTER-EARNINGS-CHECK. TDECVAL
00441 TDECVAL
00442 IF SELECT-QUARTER EQUAL 'ALL' TDECVAL
00443 GO TO 118-QUARTER-EARNINGS-CHECK. TDECVAL
00444 TDECVAL
00445 117-VALIDATE-QUARTER2. TDECVAL
00446 IF TRAN-QUARTER-YR-QTR NOT EQUAL SELECT-QUARTER TDECVAL
00447 MOVE 1 TO ERROR-SW TDECVAL
00448 MOVE 'QUARTER FIELD NOT VALID' TO MESSAGE-AREA TDECVAL
00449 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00450 SET EMSG101-SELECTED-YES TO TRUE. TDECVAL
00451 TDECVAL
00452 118-QUARTER-EARNINGS-CHECK. TDECVAL
00453 IF TRAN-QUARTER-EARNINGS NOT NUMERIC TDECVAL
00454 MOVE 1 TO ERROR-SW TDECVAL
00455 MOVE 'QUARTER EARNINGS NOT NUMERIC' TO MESSAGE-AREA TDECVAL
00456 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00457 SET EMSG105-SELECTED-YES TO TRUE TDECVAL
00458 GO TO 121-VW-EXIT. TDECVAL
00459 TDECVAL
00460 119-TRAN-ACCOUNT1. TDECVAL
00461 IF TRAN-ACCOUNT NOT NUMERIC TDECVAL
00462 MOVE 1 TO ERROR-SW TDECVAL
00463 MOVE 'ACCOUNT NUMBER NOT NUMERIC' TO MESSAGE-AREA TDECVAL
00464 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00465 SET EMSG108-SELECTED-YES TO TRUE TDECVAL
00466 * GO TO 120-TRAN-EMP-NAME. TDECVAL
00467 GO TO 121-VW-EXIT. TDECVAL
00468 IF TRAN-ACCOUNT EQUAL ZEROS TDECVAL
00469 MOVE 1 TO ERROR-SW TDECVAL
00470 MOVE 'ACCOUNT NUMBER EQUAL ZEROS' TO MESSAGE-AREA TDECVAL
00471 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00472 SET EMSG109-SELECTED-YES TO TRUE TDECVAL
00473 * GO TO 120-TRAN-EMP-NAME. TDECVAL
00474 GO TO 121-VW-EXIT. TDECVAL
00475 TDECVAL
00476 119-TRAN-ACCOUNT2. TDECVAL
00477 TDECVAL
00478 MOVE TRAN-ACCOUNT TO EMPL-ACCT-NO. TDECVAL
00479 TDECVAL
00480 READ EAFILE TDECVAL
00481 INVALID KEY TDECVAL
00482 DISPLAY 'ACCOUNT # INVALID KEY ' EMPL-ACCT-NO TDECVAL
00483 MOVE 'ACCOUNT NUMBER NOT ON M/F ' TO MESSAGE-AREA TDECVAL
00484 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00485 SET EMSG109-SELECTED-YES TO TRUE TDECVAL
00486 GO TO 121-VW-EXIT. TDECVAL
00487 *** GO TO 120-TRAN-EMP-NAME. TDECVAL
00488 *** DISPLAY 'FILE-STATUS *99*' FILE-STATUS-FILE. TDECVAL
00489 TDECVAL
00490 MOVE ALPHA-SORT-NAME TO ALPHA-SORT-NAME-FOUR. TDECVAL
00491 MOVE MAILING-NAME TO MAILING-NAME-FOUR. TDECVAL
00492 TDECVAL
00493 ** IF FILE-STATUS-FILE EQUAL 00 TDECVAL
00494 ** DISPLAY 'FILE-STATUS *OO*' FILE-STATUS-FILE TDECVAL
00495 ** DISPLAY 'TRAN-ACCOUNT *OO*' TRAN-ACCOUNT TDECVAL
00496 ** DISPLAY 'EMPL-ACCOUNT *OO*' EMPL-ACCT-NO. TDECVAL
00497 TDECVAL
00498 IF FILE-STATUS-FILE EQUAL 23 TDECVAL
00499 DISPLAY 'FILE-STATUS ****' FILE-STATUS-FILE TDECVAL
00500 DISPLAY 'TRAN-ACCOUNT ****' TRAN-ACCOUNT. TDECVAL
00501 TDECVAL
00502 120-TRAN-EMP-NAME. TDECVAL
00503 IF TRAN-EMP-NAME EQUAL SPACES TDECVAL
00504 ** MOVE 1 TO ERROR-SW TDECVAL
00505 MOVE 'EMPLOYER NAME EQUAL SPACES' TO MESSAGE-AREA TDECVAL
00506 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00507 SET EMSG110-SELECTED-YES TO TRUE. TDECVAL
00508 TDECVAL
00509 *** DISPLAY '2511 ALPHA-NAME' ALPHA-SORT-NAME-FOUR TRAN-EMP-NAME.TDECVAL
00510 IF (ALPHA-SORT-NAME-FOUR = TRAN-EMP-NAME) OR TDECVAL
00511 (MAILING-NAME-FOUR = TRAN-EMP-NAME) TDECVAL
00512 NEXT SENTENCE TDECVAL
00513 ELSE TDECVAL
00514 ** MOVE 1 TO ERROR-SW TDECVAL
00515 MOVE 'EMPLOYER NAME NOT ON M/F' TDECVAL
00516 TO MESSAGE-AREA TDECVAL
00517 MOVE TRAN-EMP-NAME TO EMPOR-PRT TDECVAL
00518 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL
00519 SET EMSG111-SELECTED-YES TO TRUE. TDECVAL
00520 TDECVAL
00521 121-VW-EXIT. TDECVAL
00522 EXIT. TDECVAL
00523 TDECVAL
00524 125-WAGE-REPORT. TDECVAL
00525 TDECVAL
00526 MOVE TR-SSN TO SSN-PRT. TDECVAL
00527 MOVE TRAN-DATE-ENTERED TO DATE-ENTERED-PRT. TDECVAL
00528 MOVE TRAN-NAME-CHECK TO EMPEE-NAME. TDECVAL
00529 MOVE TRAN-QUARTER-EARNINGS TO EARNINGS-PRT. TDECVAL
00530 MOVE TRAN-QUARTER-YR-QTR TO QTR-PRT. TDECVAL
00531 MOVE TRAN-ACCOUNT TO ACCT-NUM-PRT. TDECVAL
00532 MOVE TRAN-EMP-NAME TO EMPOR-PRT. TDECVAL
00533 IF LINE-CTR > 55 TDECVAL
00534 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. TDECVAL
00535 WRITE PRINT-REC FROM DTL1. TDECVAL
00536 IF TRAN-QUARTER-EARNINGS NOT = ZEROS TDECVAL
00537 ADD 1 TO ERROR-RECS. TDECVAL
00538 ADD 1 TO LINE-CTR. TDECVAL
00539 125-WR-EXIT. TDECVAL
00540 EXIT. TDECVAL
00541 TDECVAL
00542 130-WAGE-HEADER. TDECVAL
00543 ADD 1 TO PAGE-CTR. TDECVAL
00544 MOVE PAGE-CTR TO PAGE-CTR-PRT. TDECVAL
00545 WRITE PRINT-REC FROM HD1 AFTER TOP-OF-PAGE. TDECVAL
00546 WRITE PRINT-REC FROM HD2. TDECVAL
00547 WRITE PRINT-REC FROM HD3. TDECVAL
00548 WRITE PRINT-REC FROM HD4. TDECVAL
00549 MOVE 4 TO LINE-CTR. TDECVAL
00550 130-WH-EXIT. TDECVAL
00551 EXIT. TDECVAL
00552 TDECVAL
00553 220-CREATE-W4-TRAN. TDECVAL
00554 TDECVAL
00555 ADD +1 TO WS-EMP-SUCCESS-CNT. TDECVAL
00556 TDECVAL
00557 MOVE WRK-LOG-NO TO WRK-TRAN-LOG-NO. TDECVAL
00558 MOVE ESP-TRANSACTION-AREA TO WRK-TRAN-AREA. TDECVAL
00559 TDECVAL
00560 WRITE TDECOUT-REC FROM WRK-TRANSACTION-AREA. TDECVAL
00561 ADD 1 TO QTR-RECS-OUT. TDECVAL
00562 ADD TRAN-QUARTER-EARNINGS TO EMP-QTR-TOT-EARNINGS. TDECVAL
00563 TDECVAL
00564 220-CW-EXIT. TDECVAL
00565 EXIT. TDECVAL
00566 TDECVAL
00567 TDECVAL
00568 ******************************************************************TDECVAL
00569 * OBTAIN YYYYQ YEAR-QUARTER INFORMATION. *TDECVAL
00570 ******************************************************************TDECVAL
00571 S004-FROM-3. TDECVAL
00572 SET L004-FROM-3 TO TRUE. TDECVAL
00573 GO TO S004-YRQ. TDECVAL
00574 TDECVAL
00575 S004-YRQ. TDECVAL
00576 CALL 'DTSBU004' USING L004-LINK-AREA. TDECVAL
00577 TDECVAL
00578 S004-EXIT. TDECVAL
00579 EXIT. TDECVAL
00580 EJECT TDECVAL
00581 TDECVAL
00582 ******************************************************************TDECVAL
00583 * CALL DESBD200 TO UPDATE MSTF LOG FILE. *TDECVAL
00584 ******************************************************************TDECVAL
00585 SERV0200-UPD-LOG. TDECVAL
00586 TDECVAL
00587 MOVE WRK-LOG-NO TO L200-LOG-NO. TDECVAL
00588 MOVE WRK-MOD-NAME TO L200-PROG-NAME. TDECVAL
00589 TDECVAL
00590 CALL 'DESBD200' USING L200-LINK-AREA C202-MSG-TABLE. TDECVAL
00591 TDECVAL
00592 SERV0200-EXIT. TDECVAL
00593 EXIT. TDECVAL
00594 TDECVAL
00595 SERV9999-ABEND. TDECVAL
00596 DISPLAY '**** DTECVAL ABENDING ' ABEND-MSG. TDECVAL
00597 CALL ABEND-MOD USING ABEND-CD. TDECVAL
00598 SERV9999-EXIT. TDECVAL
00599 EXIT. TDECVAL
00600 TDECVAL
00601 999-CLOSE-FILES. TDECVAL
00602 MOVE RECS-IN TO WAGE-CNT-PRT. TDECVAL
00603 MOVE QTR-RECS-OUT TO WAGE-OUT-PRT. TDECVAL
00604 MOVE ERROR-RECS TO ERRORS-PRT. TDECVAL
00605 MOVE ZERO-WAGE-CNT TO ZERO-WAGE-PRT. TDECVAL
00606 IF LINE-CTR > 52 TDECVAL
00607 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. TDECVAL
00608 WRITE PRINT-REC FROM TOT1 AFTER 2. TDECVAL
00609 CLOSE TDECFILE LISTOUT EAFILE. TDECVAL
00610 CLOSE TDECOUT. TDECVAL
00611 STOP RUN. TDECVAL
00612 TDECVAL