00001 IDENTIFICATION DIVISION. 03/18/04 00002 PROGRAM-ID. EFTBR120. EFTBR120 00003 AUTHOR. NORTHROP GRUMMAN. LV131 00004 DATE-WRITTEN. JULY 2003. CL*58 00005 DATE-COMPILED. EFTBR120 00006 EFTBR120 00007 ***** EFTBR120 00008 * EFTBR120 00009 * CALLING SEQUENCE: EFTBD120 WHICH UPDATES EFTIR120 CL101 00010 * EFTBR120 READS EFTIR120 RECORDS. CL*61 00011 * EFTBR120 00012 * FUNCTION: WEB EMPLOYER STATUS REPORT. CL*60 00013 * EFTBR120 00014 * EFTBR120 00015 * MODIFICATION HISTORY: EFTBR120 00016 * EFTBR120 00017 * 07/30/03 INITIAL DEVELOPMENT CL*58 00018 * WORK ORDER: AUTHOR OF CHANGE - RW1 CL*59 00019 * EFTBR120 00020 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX EFTBR120 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX EFTBR120 00022 * WORK ORDER: #**** AUTHOR OF CHANGE - XXX CL*59 00023 * EFTBR120 00024 * EFTBR120 00025 * DESCRIPTION: EFTBR120 00026 * EFTBR120 00027 * THIS MODULE REPORTS THE EMPLOYER STATUS CHANGES ON THE CL*50 00028 * SALE DATE, LAST WAGES PAID DATE, AND STATUS CHANGE DE- CL*63 00029 * SCRIPTION ONLY. CL*63 00030 * EFTBR120 00031 * EFTBR120 00032 * RECORDS READ: EFTBR120 00033 * EFTBR120 00034 * NONE. EFTBR120 00035 * EFTBR120 00036 * EFTBR120 00037 * PRINTED OUTPUTS: EFTBR120 00038 * EFTBR120 00039 * 120R1 EMPLOYER WEB STATUS CHANGES REPORT CL*63 00040 * EFTBR120 00041 * EFTBR120 00042 * RECORDS WRITTEN: EFTBR120 00043 * EFTBR120 00044 * NONE. EFTBR120 00045 * EFTBR120 00046 * EFTBR120 00047 * MODULES CALLED: EFTBR120 00048 * EFTBR120 00049 * DTSBU001 DATE EDIT/CONVERSION MODULE EFTBR120 00050 * EFTBR120 00051 * EFTBR120 00052 ***** EFTBR120 00053 SKIP3 CL*58 00054 ENVIRONMENT DIVISION. EFTBR120 00055 EFTBR120 00056 CONFIGURATION SECTION. EFTBR120 00057 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. EFTBR120 00058 EFTBR120 00059 INPUT-OUTPUT SECTION. EFTBR120 00060 EFTBR120 00061 FILE-CONTROL. EFTBR120 00062 SELECT PRT-FILE ASSIGN TO RPT120R1. CL*64 00063 EFTBR120 00064 DATA DIVISION. EFTBR120 00065 EFTBR120 00066 FILE SECTION. EFTBR120 00067 EFTBR120 00068 FD PRT-FILE CL*51 00069 RECORDING MODE IS F. EFTBR120 00070 01 PRT-RECORD PIC X(133). CL*51 00071 EJECT EFTBR120 00072 CL*20 00073 WORKING-STORAGE SECTION. EFTBR120 000735 77 PAN-VALET PICTURE X(24) VALUE '131EFTBR120 03/18/04'. EFTBR120 00074 EFTBR120 00075 01 WRK-AREA. EFTBR120 00076 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +120. CL*65 00077 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. CL*24 00078 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. CL*24 00079 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL*19 00080 05 WS-FEIN PIC 9(09) VALUE 0. CL*74 00081 EFTBR120 00082 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. EFTBR120 00083 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. EFTBR120 00084 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. EFTBR120 00085 05 WS-FOOT-CNT PIC S9(05) COMP-3 VALUE +0. CL*58 00086 CL**3 00087 05 WRK-START-YRQ PIC 9(05). CL**3 00088 05 FILLER REDEFINES WRK-START-YRQ. CL**3 00089 10 WRK-START-YRQ-Y PIC X(04). CL*31 00090 10 WRK-START-YRQ-Q PIC X(01). CL*31 00091 CL**3 00092 05 WRK-EDIT-PHONE. CL112 00093 10 WRK-LEFT-PARN PIC X(01). CL115 00094 10 WRK-AREA-CODE PIC X(03). CL112 00095 10 WRK-RIGHT-PARN PIC X(01). CL117 00096 10 FILLER PIC X(01). CL117 00097 10 WRK-EXCHANGE PIC X(03). CL112 00098 10 WRK-DASH PIC X(01). CL115 00099 10 WRK-NUMBER PIC X(04). CL112 00100 10 FILLER PIC X(01). CL126 00101 10 WRK-EXT PIC X(05). CL126 00102 CL112 00103 EJECT EFTBR120 00104 01 L001-LINK-AREA. EFTBR120 00105 ++INCLUDE DTSIL001 EFTBR120 00106 EJECT EFTBR120 00107 EFTBR120 00108 01 HEADER-1. EFTBR120 00109 05 FILLER PIC X(01) VALUE SPACES. EFTBR120 00110 05 FILLER PIC X(49) VALUE '120R1'. CL*67 00111 05 FILLER PIC X(60) VALUE EFTBR120 00112 'DISTRICT OF COLUMBIA'. EFTBR120 00113 05 FILLER PIC X(06) VALUE 'DATE:'. EFTBR120 00114 05 HDR1-LRCM-SYS-DATE PIC X(08). EFTBR120 00115 CL*23 00116 01 HEADER-2. EFTBR120 00117 05 FILLER PIC X(54) VALUE SPACES. EFTBR120 00118 05 FILLER PIC X(56) VALUE EFTBR120 00119 'TAX DIVISION'. EFTBR120 00120 05 FILLER PIC X(06) VALUE 'TIME:'. EFTBR120 00121 05 HDR2-LRCM-SYS-TIME PIC X(08). EFTBR120 00122 EFTBR120 00123 01 HEADER-3. EFTBR120 00124 05 FILLER PIC X(01) VALUE SPACES. EFTBR120 00125 05 FILLER PIC X(41) VALUE CL*56 00126 'ROUTE TO: TAX CHIEF'. EFTBR120 00127 05 HDR3-LITERAL PIC X(60) VALUE CL*56 00128 ' WEB STATUS CHANGED REPORT '. CL102 00129 05 FILLER PIC X(08) VALUE SPACES. CL*56 00130 05 FILLER PIC X(06) VALUE 'PAGE:'. EFTBR120 00131 05 HDR3-PAGE PIC ZZ,ZZ9. EFTBR120 00132 CL*20 00133 01 HEADER-4. EFTBR120 00134 05 FILLER PIC X(01) VALUE SPACES. EFTBR120 00135 05 FILLER PIC X(132) VALUE SPACES. EFTBR120 00136 EFTBR120 00137 01 HEADER-5. CL**5 00138 05 FILLER PIC X(01) VALUE SPACES. EFTBR120 00139 05 FILLER PIC X(10) VALUE SPACES. CL106 00140 05 FILLER PIC X(11) VALUE CL106 00141 ' NEW FEIN/ '. CL106 00142 05 FILLER PIC X(29) VALUE SPACES. CL107 00143 05 FILLER PIC X(10) VALUE CL*56 00144 'LAST WAGES'. CL*56 00145 05 FILLER PIC X(02) VALUE SPACES. CL100 00146 05 FILLER PIC X(08) VALUE CL100 00147 'BUSINESS'. CL100 00148 05 FILLER PIC X(01) VALUE SPACE. CL111 00149 05 FILLER PIC X(19) VALUE CL122 00150 '------CONTACT------'. CL122 00151 05 FILLER PIC X(02) VALUE SPACE. CL124 00152 05 FILLER PIC X(40) VALUE SPACES. CL130 00153 CL*56 00154 01 HEADER-6. CL**5 00155 05 FILLER PIC X(01) VALUE SPACES. EFTBR120 00156 05 FILLER PIC X(02) VALUE SPACES. CL*70 00157 05 FILLER PIC X(06) VALUE CL*56 00158 'EMP NO'. CL*56 00159 05 FILLER PIC X(02) VALUE SPACES. CL106 00160 05 FILLER PIC X(11) VALUE CL106 00161 'ENTITY NAME'. CL106 00162 05 FILLER PIC X(01) VALUE SPACES. CL106 00163 05 FILLER PIC X(13) VALUE CL*86 00164 ' TRACE NUMBER'. CL*93 00165 05 FILLER PIC X(03) VALUE SPACES. CL*90 00166 05 FILLER PIC X(09) VALUE CL*56 00167 'SALE DATE'. CL*56 00168 05 FILLER PIC X(03) VALUE SPACES. CL*70 00169 05 FILLER PIC X(09) VALUE CL*56 00170 'PAID DATE'. CL*58 00171 05 FILLER PIC X(03) VALUE SPACES. CL*97 00172 05 FILLER PIC X(07) VALUE CL*96 00173 'ADDRESS'. CL*96 00174 05 FILLER PIC X(06) VALUE SPACES. CL124 00175 05 FILLER PIC X(05) VALUE CL121 00176 'PHONE'. CL106 00177 05 FILLER PIC X(01) VALUE '/'. CL106 00178 05 FILLER PIC X(04) VALUE CL106 00179 'NAME'. CL106 00180 05 FILLER PIC X(07) VALUE SPACES. CL125 00181 05 FILLER PIC X(25) VALUE CL130 00182 'STATUS CHANGE DESCRIPTION'. CL130 00183 05 FILLER PIC X(18) VALUE SPACES. CL130 00184 CL*56 00185 01 SPACES-LINE. CL127 00186 05 FILLER PIC X(01) VALUE SPACES. CL*56 00187 05 FILLER PIC X(132) VALUE SPACES. CL*56 00188 CL*56 00189 01 DETAIL-LINE-1. CL**5 00190 05 FILLER PIC X(03) VALUE SPACES. CL*70 00191 05 WS-EMP-NO PIC 999B999. EFTBR120 00192 05 FILLER PIC X(02) VALUE SPACES. CL*71 00193 05 DTL1-FEIN. CL*86 00194 10 DTL1-FEIN2 PIC X(02). CL*86 00195 10 WS-DASH PIC X(01). CL*95 00196 10 DTL1-FEIN7 PIC X(07). CL*86 00197 05 FILLER PIC X(02) VALUE SPACES. CL*86 00198 05 WS-TRACE-NO PIC 9(13) BLANK WHEN ZERO. CL*94 00199 05 FILLER PIC X(02) VALUE SPACES. CL*90 00200 05 WS-SALE-DATE PIC X(10). CL*66 00201 05 FILLER PIC X(02) VALUE SPACES. CL*70 00202 05 WS-LAST-WAGES-PAID-DATE PIC X(10). CL*66 00203 05 FILLER PIC X(04) VALUE SPACES. CL*96 00204 05 WS-ADDRESS PIC X(03). CL*96 00205 05 FILLER PIC X(04) VALUE SPACES. CL123 00206 05 WS-PHONE PIC X(20). CL127 00207 05 FILLER PIC X(01) VALUE SPACES. CL129 00208 05 WS-STATUS-CHNG-DESC PIC X(40). CL126 00209 CL*52 00210 01 DETAIL-LINE-2. CL127 00211 05 FILLER PIC X(12) VALUE SPACES. CL128 00212 05 WS-ENTITY-NAME PIC X(40). CL127 00213 05 FILLER PIC X(20) VALUE SPACES. CL127 00214 05 WS-CONTACT-NAME PIC X(51). CL127 00215 05 FILLER PIC X(09) VALUE SPACES. CL127 00216 CL127 00217 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL*37 00218 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. EFTBR120 00219 EFTBR120 00220 01 FOOTING-LINE-3. EFTBR120 00221 05 FILLER PIC X(24) VALUE SPACES. CL*68 00222 05 WS-FOOTING-CNT PIC ZZ,ZZ9. EFTBR120 00223 05 FILLER PIC X(02) VALUE SPACES. EFTBR120 00224 05 FILLER PIC X(27) VALUE CL*68 00225 'STATUS CHANGE RECORDS COUNT'. CL*68 00226 CL*56 00227 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. CL*56 00228 CL*56 00229 01 FOOTING-LINE-5. CL*56 00230 05 FILLER PIC X(25) VALUE SPACES. CL*56 00231 05 FILLER PIC X(17) VALUE EFTBR120 00232 '*** END OF REPORT'. EFTBR120 00233 EJECT EFTBR120 00234 CL*56 00235 LINKAGE SECTION. EFTBR120 00236 EFTBR120 00237 01 LRCM-LINK-AREA. EFTBR120 00238 ++INCLUDE DTSILRCM EFTBR120 00239 EJECT EFTBR120 00240 01 R120-REC. CL*61 00241 ++INCLUDE EFTIR120 CL*61 00242 EJECT EFTBR120 00243 PROCEDURE DIVISION USING LRCM-LINK-AREA EFTBR120 00244 R120-REC. CL*62 00245 EFTBR120 00246 IF FIRST-TIME-IND = 'Y' EFTBR120 00247 PERFORM I1000-INITIATE THRU I1000-EXIT EFTBR120 00248 MOVE 'N' TO FIRST-TIME-IND. EFTBR120 00249 EFTBR120 00250 IF LRCM-EOR-88 EFTBR120 00251 PERFORM T1000-TERMINATE THRU T1000-EXIT EFTBR120 00252 ELSE EFTBR120 00253 PERFORM P1000-PROCESS-REPORT THRU P1000-EXIT. CL*58 00254 EFTBR120 00255 GOBACK. EFTBR120 00256 EJECT EFTBR120 00257 I1000-INITIATE. EFTBR120 00258 EFTBR120 00259 OPEN OUTPUT PRT-FILE. CL*51 00260 MOVE LRCM-SYS-DATE TO HDR1-LRCM-SYS-DATE. CL*43 00261 MOVE LRCM-SYS-TIME TO HDR2-LRCM-SYS-TIME. EFTBR120 00262 MOVE SPACES TO PRT-RECORD. CL*51 00263 EFTBR120 00264 I1000-EXIT. EFTBR120 00265 EXIT. EFTBR120 00266 SKIP3 CL*58 00267 CL*20 00268 P1000-PROCESS-REPORT. CL*40 00269 CL*20 00270 MOVE R120-EMP-NO TO WS-EMP-NO. CL*61 00271 MOVE R120-SALE-DATE TO L001-FED-8-DATE-9. CL*65 00272 SET L001-FROM-FED-8 TO TRUE. CL*65 00273 PERFORM S001-DATE THRU S001-EXIT. CL*65 00274 CL103 00275 IF L001-INVALID-DATE CL103 00276 * MOVE R120-SALE-DATE TO WS-SALE-DATE CL104 00277 MOVE SPACES TO WS-SALE-DATE CL104 00278 ELSE CL103 00279 IF L001-CAL-8-DATE-9 = ZEROS CL103 00280 MOVE SPACES TO WS-SALE-DATE CL103 00281 ELSE CL103 00282 MOVE L001-SLASH-8-DATE TO WS-SALE-DATE. CL103 00283 CL*65 00284 MOVE R120-LAST-WAGES-PAID-DATE TO L001-FED-8-DATE-9. CL*65 00285 SET L001-FROM-FED-8 TO TRUE. CL*65 00286 PERFORM S001-DATE THRU S001-EXIT. CL*65 00287 CL103 00288 IF L001-INVALID-DATE CL103 00289 * MOVE R120-LAST-WAGES-PAID-DATE TO WS-LAST-WAGES-PAID-DATE CL104 00290 MOVE SPACES TO WS-LAST-WAGES-PAID-DATE CL104 00291 ELSE CL103 00292 IF L001-CAL-8-DATE-9 = ZEROS CL103 00293 MOVE SPACES TO WS-LAST-WAGES-PAID-DATE CL103 00294 ELSE CL103 00295 MOVE L001-SLASH-8-DATE TO WS-LAST-WAGES-PAID-DATE. CL103 00296 CL*65 00297 IF R120-FEIN > ZEROS CL*95 00298 MOVE R120-FEIN TO WS-FEIN CL*95 00299 MOVE WS-FEIN (1:2) TO DTL1-FEIN2 CL*95 00300 MOVE '-' TO WS-DASH CL*95 00301 MOVE WS-FEIN (3:7) TO DTL1-FEIN7 CL*95 00302 ELSE CL*95 00303 MOVE SPACES TO DTL1-FEIN2 CL*95 00304 MOVE SPACE TO WS-DASH CL*95 00305 MOVE SPACES TO DTL1-FEIN7 CL*95 00306 END-IF. CL*95 00307 CL*95 00308 MOVE R120-TRACE-NO TO WS-TRACE-NO. CL*81 00309 CL*77 00310 *? IF R120-NAME-YES-88 CL114 00311 *? MOVE 'YES' TO WS-NAME CL114 00312 *? ELSE CL114 00313 *? MOVE 'NO ' TO WS-NAME. CL114 00314 CL*77 00315 IF R120-ADDR-NO-CHANGE-88 CL*77 00316 MOVE 'NO ' TO WS-ADDRESS CL*77 00317 ELSE CL*77 00318 MOVE 'YES' TO WS-ADDRESS. CL*77 00319 CL*77 00320 IF R120-CONTACT-PHONE = SPACES CL113 00321 MOVE SPACE TO WRK-LEFT-PARN CL118 00322 MOVE SPACE TO WRK-AREA-CODE CL118 00323 MOVE SPACE TO WRK-RIGHT-PARN CL118 00324 MOVE SPACE TO WRK-EXCHANGE CL118 00325 MOVE SPACE TO WRK-DASH CL118 00326 MOVE SPACE TO WRK-NUMBER CL118 00327 MOVE SPACE TO WRK-EXT CL126 00328 MOVE WRK-EDIT-PHONE TO WS-PHONE CL115 00329 ELSE CL113 00330 MOVE '(' TO WRK-LEFT-PARN CL115 00331 MOVE R120-VOICE-AREA-CD TO WRK-AREA-CODE CL115 00332 MOVE ')' TO WRK-RIGHT-PARN CL117 00333 MOVE R120-VOICE-PREFIX TO WRK-EXCHANGE CL113 00334 MOVE '-' TO WRK-DASH CL115 00335 MOVE R120-VOICE-SUFFIX TO WRK-NUMBER CL113 00336 MOVE R120-VOICE-EXT TO WRK-EXT CL126 00337 MOVE WRK-EDIT-PHONE TO WS-PHONE. CL113 00338 CL113 00339 MOVE R120-STATUS-CHNG-DESC TO WS-STATUS-CHNG-DESC. CL*74 00340 CL*39 00341 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. CL*20 00342 WRITE PRT-RECORD FROM DETAIL-LINE-1 AFTER 1. CL127 00343 ADD 1 TO WS-LINE-CNT2. CL127 00344 CL127 00345 IF R120-ENTITY-NAME = SPACE AND R120-CONTACT-NAME = SPACES CL127 00346 NEXT SENTENCE CL127 00347 ELSE CL127 00348 IF R120-ENTITY-NAME NOT = SPACE CL131 00349 MOVE R120-ENTITY-NAME TO WS-ENTITY-NAME CL131 00350 ELSE CL131 00351 MOVE SPACES TO WS-ENTITY-NAME CL131 00352 END-IF CL131 00353 IF R120-CONTACT-NAME NOT = SPACES CL131 00354 MOVE R120-CONTACT-NAME TO WS-CONTACT-NAME CL131 00355 ELSE CL131 00356 MOVE SPACES TO WS-CONTACT-NAME CL131 00357 END-IF CL131 00358 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT CL127 00359 WRITE PRT-RECORD FROM DETAIL-LINE-2 AFTER 1 CL127 00360 ADD 1 TO WS-LINE-CNT2. CL127 00361 CL127 00362 WRITE PRT-RECORD FROM SPACES-LINE AFTER 1. CL127 00363 ADD 1 TO WS-LINE-CNT2. CL127 00364 CL127 00365 ADD +1 TO WS-FOOT-CNT. CL*58 00366 CL*20 00367 P1000-EXIT. CL*20 00368 EXIT. CL*20 00369 CL*20 00370 P2000-PRINT-HEADER. EFTBR120 00371 IF WS-LINE-CNT GREATER 55 OR CL*58 00372 WS-LINE-CNT2 GREATER 55 CL*58 00373 MOVE +0 TO WS-LINE-CNT EFTBR120 00374 MOVE +0 TO WS-LINE-CNT2 EFTBR120 00375 ADD +1 TO WS-PAGE-CNT EFTBR120 00376 MOVE WS-PAGE-CNT TO HDR3-PAGE EFTBR120 00377 WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE CL*53 00378 WRITE PRT-RECORD FROM HEADER-2 AFTER 1 CL*53 00379 WRITE PRT-RECORD FROM HEADER-3 AFTER 1 CL*53 00380 WRITE PRT-RECORD FROM HEADER-4 AFTER 1 CL*53 00381 WRITE PRT-RECORD FROM HEADER-5 AFTER 1 CL*53 00382 WRITE PRT-RECORD FROM HEADER-6 AFTER 1 CL*53 00383 WRITE PRT-RECORD FROM SPACES-LINE AFTER 1 CL127 00384 ADD +7 TO WS-LINE-CNT2. CL*58 00385 P2000-EXIT. EFTBR120 00386 EXIT. EFTBR120 00387 CL*20 00388 T1000-TERMINATE. EFTBR120 00389 EFTBR120 00390 IF WS-LINE-CNT2 > 52 OR WS-FOOT-CNT = ZERO CL*58 00391 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT EFTBR120 00392 END-IF. EFTBR120 00393 MOVE WS-FOOT-CNT TO WS-FOOTING-CNT. CL*58 00394 WRITE PRT-RECORD FROM FOOTING-LINE-1 AFTER 1. CL*54 00395 WRITE PRT-RECORD FROM FOOTING-LINE-2 AFTER 1. CL*54 00396 WRITE PRT-RECORD FROM FOOTING-LINE-3 AFTER 1. CL*54 00397 WRITE PRT-RECORD FROM FOOTING-LINE-4 AFTER 1. CL*54 00398 WRITE PRT-RECORD FROM FOOTING-LINE-5 AFTER 1. CL*54 00399 CL*20 00400 CLOSE PRT-FILE. CL*51 00401 EFTBR120 00402 T1000-EXIT. EFTBR120 00403 EXIT. EFTBR120 00404 EJECT EFTBR120 00405 CL*23 00406 S001-DATE. CL*63 00407 CALL 'DTSBU001' USING L001-LINK-AREA. CL*63 00408 S001-EXIT. CL*63 00409 EXIT. CL*63 00410 EFTBR120 00411 S999-ABEND. EFTBR120 00412 EFTBR120 00413 DISPLAY '*** EFTBR120 ABENDING. ' CL*61 00414 WRK-ABEND-MSG. CL*24 00415 CL*24 00416 CALL 'DTSBU999' USING WRK-ABEND-CD. EFTBR120 00417 EFTBR120 00418 S999-EXIT. EFTBR120 00419 EXIT. EFTBR120