00001 IDENTIFICATION DIVISION. 08/14/25 00002 PROGRAM-ID. DTSBX629. DTSBX629 00003 LV018 00004 ******************************************************************DTSBX629 00005 * *DTSBX629 00006 * FUNCTION: *DTSBX629 00007 * *DTSBX629 00008 * PROGRAM WILL READ TDEC X144 FILE (DETAIL WAGE RECORDS SENT * CL254 00009 * TO ESSP) AND REPORT ANY WAGES NOT RETURNED THE SAME DAY. CL254 00010 * RECORDS NOT RETURNED MAY BE JOB RAN LATE OR TDEC WAGES WAS * CL254 00011 * REJECTED BY ESSP. * CL254 00012 * 07/07/18 ZL1 * CL254 00013 * * CL*53 00014 ******************************************************************DTSBX629 00015 DTSBX629 00016 ENVIRONMENT DIVISION. DTSBX629 00017 DTSBX629 00018 CONFIGURATION SECTION. DTSBX629 00019 DTSBX629 00020 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX629 00021 DTSBX629 00022 INPUT-OUTPUT SECTION. DTSBX629 00023 DTSBX629 00024 FILE-CONTROL. DTSBX629 00025 DTSBX629 00026 SELECT X140RPT-IN ASSIGN TO DTSFX140. CL239 00027 SELECT X144SSN-IN ASSIGN TO DTSFI144. CL**1 00028 SELECT X144SSN-OUT ASSIGN TO DTSFO144. CL**1 00029 * SELECT X147SSN-OUTA ASSIGN TO DTSFA147. CL223 00030 * SELECT X147SSN-OUTB ASSIGN TO DTSFB147. CL223 00031 SELECT REPORT-FILE ASSIGN TO RPT627R1. CL223 00032 DTSBX629 00033 DTSBX629 00034 DATA DIVISION. DTSBX629 00035 FILE SECTION. DTSBX629 00036 CL101 00037 FD X144SSN-IN CL101 00038 RECORDING MODE IS F. CL101 00039 01 X144-RECORD-IN PIC X(512). CL101 00040 CL101 00041 FD X144SSN-OUT CL**1 00042 RECORDING MODE IS F. CL**1 00043 01 X144-RECORD-OUT PIC X(512). CL**1 00044 CL**1 00045 CL138 00046 FD X140RPT-IN CL239 00047 RECORDING MODE IS F. CL239 00048 01 X140-RECORD-IN PIC X(512). CL239 00049 CL138 00050 DTSBX629 00051 *FD X147SSN-IN CL239 00052 * RECORDING MODE IS F. CL239 00053 *01 X147-RECORD-IN PIC X(80). CL239 00054 CL*87 00055 *FD X147SSN-OUTA CL223 00056 * RECORDING MODE IS F. CL223 00057 *01 X147-RECORD-OUTA PIC X(512). CL223 00058 CL*87 00059 *FD X147SSN-OUTB CL223 00060 * RECORDING MODE IS F. CL223 00061 *01 X147-RECORD-OUTB PIC X(512). CL223 00062 CL123 00063 FD REPORT-FILE DTSBX629 00064 RECORDING MODE IS F DTSBX629 00065 RECORD CONTAINS 133 CHARACTERS DTSBX629 00066 BLOCK CONTAINS 0 RECORDS DTSBX629 00067 LABEL RECORDS ARE OMITTED DTSBX629 00068 DATA RECORD IS PRINT-RECORD. DTSBX629 00069 DTSBX629 00070 01 PRINT-RECORD PIC X(133). DTSBX629 00071 DTSBX629 00072 ******************************************************************DTSBX629 00073 * WORKING STORAGE SECTION *DTSBX629 00074 ******************************************************************DTSBX629 00075 WORKING-STORAGE SECTION. DTSBX629 000755 77 PAN-VALET PICTURE X(24) VALUE '018DTSBX629 08/14/25'. DTSBX629 00076 DTSBX629 00077 01 ENDOFSEG PIC 9 VALUE ZEROES. DTSBX629 00078 DTSBX629 00079 01 EMPLOYER-FOUND-IND PIC X VALUE SPACE. CL*87 00080 DTSBX629 00081 01 MASTER-END-IND PIC X VALUE SPACE. DTSBX629 00082 88 MASTER-END VALUE 'Y'. DTSBX629 00083 DTSBX629 00084 CL*70 00085 01 MASUIX-END-IND PIC X VALUE SPACE. CL*73 00086 88 MASHIS-END VALUE 'Y'. CL*70 00087 01 WRK-AREA. CL*79 00088 05 WRK-ABEND-CODE PIC X(04) VALUE 'X552'. CL*91 00089 CL*70 00090 01 WRK-SEG01-SSN-FOUND PIC 9(01) VALUE ZEROES. CL147 00091 01 WS-X144-NOT-RETURNED PIC 9(05) VALUE ZEROES. CL243 00092 01 WS-X144-SSN-FOUND PIC 9(01) VALUE ZEROES. CL243 00093 01 WS-CLAIM-SSN-FOUND PIC 9(01) VALUE ZEROES. CL182 00094 01 WS-X140-RPT-FOUND PIC 9(01) VALUE ZEROES. CL138 00095 01 WS-X147-SSN-NOT-DOCS PIC 9(05) VALUE ZEROES. CL168 00096 01 WS-X147-SSN-N99-DOCS PIC 9(05) VALUE ZEROES. CL211 00097 01 WS-X147-SSN-IN-DOCS PIC 9(05) VALUE ZEROES. CL168 00098 01 SSN-HIT-COUNT PIC 9(03) VALUE ZEROES. CL106 00099 01 WS-HOLD-X147-SSN PIC 9(09) VALUE ZEROES. CL*91 00100 01 WS-TOTAL-NO-X144-SSN PIC 9(05) VALUE ZEROES. CL108 00101 01 WS-TOTAL-YES-X144-SSN PIC 9(05) VALUE ZEROES. CL113 00102 01 WS-TOTAL-OTH-X144-SSN PIC 9(05) VALUE ZEROES. CL113 00103 01 WS-HOLD-X147-EMP-NO PIC 9(06) VALUE ZEROES. CL*91 00104 01 WS-SAV-X147 PIC 9(01) VALUE ZEROES. CL129 00105 01 WRK-MODULE-NAME PIC X(08) VALUE 'DTSBX551'. CL138 00106 01 WRK-ABEND-CD PIC X(04) VALUE 'X551'. CL138 00107 01 WRK-ABEND-MSG PIC X(60). CL*62 00108 DTSBX629 00109 01 WS-HOLD-PAY-DATE. DTSBX629 00110 05 WS-HOLD-PAY-DATE-CEN PIC 9(02) VALUE ZEROS. DTSBX629 00111 05 WS-HOLD-PAY-DATE-YY PIC 9(02) VALUE ZEROES. DTSBX629 00112 05 WS-HOLD-PAY-DATE-MM PIC 9(02) VALUE ZEROES. DTSBX629 00113 05 WS-HOLD-PAY-DATE-DD PIC 9(02) VALUE ZEROES. DTSBX629 00114 DTSBX629 00115 01 WS-X147-SSN PIC 9(09) VALUE ZEROS. CL106 00116 01 WS-X147-EMP-NO PIC 9(06) VALUE ZEROS. CL104 00117 01 WS-X147-QUARTER. CL150 00118 05 WS-X147-YR PIC 9(04) VALUE ZEROS. CL152 00119 05 WS-X147-QTR PIC 9(01) VALUE ZEROS. CL150 00120 CL*34 00121 01 WS-X140-QUARTER. CL240 00122 05 WS-X140-YR PIC 9(04) VALUE ZEROS. CL240 00123 05 WS-X140-QTR PIC 9(01) VALUE ZEROS. CL240 00124 CL240 00125 01 W-X140-REPORT-QTR PIC 9(5) VALUE ZEROS. CL**4 00126 01 WS-INPUT-SSN. DTSBX629 00127 05 WS-INPUT-SSN1 PIC 9(03) VALUE ZEROES. DTSBX629 00128 05 WS-INPUT-SSN2 PIC 9(02) VALUE ZEROES. DTSBX629 00129 05 WS-INPUT-SSN3 PIC 9(04) VALUE ZEROES. DTSBX629 00130 DTSBX629 00131 01 WS-HOLD-BWE PIC 9(08) VALUE ZEROES. DTSBX629 00132 CL**8 00133 01 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL**8 00134 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL**7 00135 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL**7 00136 CL**7 00137 DTSBX629 00138 01 WS-HOLD-PAYMENT PIC 9(05)V99 VALUE ZEROES.DTSBX629 00139 DTSBX629 00140 01 WS-HOLD-DATE. CL*25 00141 05 WS-HOLD-DATE-CEN PIC 9(02) VALUE ZEROS. CL*26 00142 05 WS-HOLD-DATE-YY PIC 9(02) VALUE ZEROES. CL*26 00143 05 WS-HOLD-DATE-MM PIC 9(02) VALUE ZEROES. CL*26 00144 05 WS-HOLD-DATE-DD PIC 9(02) VALUE ZEROES. CL*26 00145 DTSBX629 00146 01 WS-WRK-BWE-DATE. CL*51 00147 05 WS-WRK-BWE-CEN PIC 9(02) VALUE ZERO. CL*51 00148 05 WS-WRK-BWE-YY PIC 9(02) VALUE ZERO. CL*51 00149 05 WS-WRK-BWE-MM PIC 9(02) VALUE ZERO. CL*51 00150 05 WS-WRK-BWE-DD PIC 9(02) VALUE ZERO. CL*51 00151 CL*50 00152 01 WS-X147-SSN-NO. CL106 00153 05 WS-XSSN PIC 9(9) VALUE ZERO. CL*85 00154 05 FILLER PIC 9(1) VALUE ZERO. CL*85 00155 CL*85 00156 01 WS-X147-QTR-ESSP. CL*86 00157 05 WS-X147-EYY PIC X(4) VALUE SPACES. CL*86 00158 05 FILLER PIC X(1) VALUE SPACES. CL*86 00159 05 WS-X147-EQ PIC X(1) VALUE SPACES. CL*86 00160 CL*86 00161 CL*86 00162 01 WS-X147-QTR-DUTAS. CL*86 00163 05 WS-X147-YY PIC 9(4) VALUE ZERO. CL*86 00164 05 WS-X147-Q PIC 9(1) VALUE ZERO. CL*86 00165 01 WS-X147-QTR-DELETE REDEFINES WS-X147-QTR-DUTAS PIC 9(5). CL*86 00166 CL*86 00167 01 WS-DOCS-BASE-QTR PIC 9(5) VALUE ZEROS. CL192 00168 01 WS-DOCS-BASE-QTRA REDEFINES WS-DOCS-BASE-QTR. CL192 00169 05 WS-DOCS-BASE-QTR-Y PIC 9(4). CL192 00170 05 WS-DOCS-BASE-QTR-Q PIC 9(1). CL192 00171 01 WS-DOCS-BASE-QTR1. CL188 00172 05 WS-DOCS-BASE-QTR1-Y PIC 9(4). CL192 00173 05 WS-DOCS-BASE-QTR1-Q PIC 9(1). CL192 00174 01 WS-DOCS-BASE-QTR2. CL188 00175 05 WS-DOCS-BASE-QTR2-Y PIC 9(4). CL192 00176 05 WS-DOCS-BASE-QTR2-Q PIC 9(1). CL192 00177 01 WS-DOCS-BASE-QTR3. CL188 00178 05 WS-DOCS-BASE-QTR3-Y PIC 9(4). CL192 00179 05 WS-DOCS-BASE-QTR3-Q PIC 9(1). CL192 00180 CL*86 00181 01 WS-COUNTERS. DTSBX629 00182 05 LINE-COUNT PIC 9(03) VALUE 99. DTSBX629 00183 05 PAGE-COUNT PIC 9(03) VALUE ZEROES. DTSBX629 00184 05 TRANS-READ-COUNT PIC 9(06) VALUE ZEROES. DTSBX629 00185 05 MASTER-READ-COUNT PIC 9(06) VALUE ZEROES. DTSBX629 00186 05 WS-TOTAL-READ PIC 9(05) VALUE ZEROES. CL*93 00187 05 WS-TOTAL-NDEL PIC 9(05) VALUE ZEROES. CL*93 00188 05 WS-TOTAL-DELQ PIC 9(05) VALUE ZEROES. CL*93 00189 DTSBX629 00190 01 WS-OUTPUT. DTSBX629 00191 03 FILLER PIC X(03) VALUE SPACES. CL*20 00192 03 WS-OUT-EMP-NO PIC 9(06). CL*92 00193 03 FILLER PIC X(04) VALUE SPACES. CL243 00194 03 WS-OUT-NAME PIC X(04). CL243 00195 03 FILLER PIC X(04) VALUE SPACES. CL243 00196 03 WS-OUT-QUARTER PIC X(06). CL*92 00197 03 FILLER PIC X(04) VALUE SPACES. CL129 00198 03 WS-OUT-DATE PIC X(10). CL**2 00199 03 FILLER PIC X(04) VALUE SPACES. CL**2 00200 03 WS-OUT-MESSAGE PIC X(40). CL137 00201 CL*25 00202 CL*11 00203 01 WS-TOTAL-LINE1. CL*92 00204 03 FIL PIC X(2) VALUE SPACES. CL249 00205 03 FIL PIC X(43) VALUE CL126 00206 'TOTAL TDEC REPORTS RECEIVED BY ... DUTAS = '. CL249 00207 03 WS-OUT-READ PIC ZZZZ9. CL*93 00208 03 FIL PIC X(50) VALUE SPACES. CL126 00209 01 WS-TOTAL-LINE10. CL211 00210 03 FIL PIC X(2) VALUE SPACES. CL249 00211 03 FIL PIC X(43) VALUE CL211 00212 'TOTAL TDEC REPORTS SENT TO ... ESSP = '. CL251 00213 03 WS-OUT-READ1 PIC ZZZZ9. CL248 00214 03 FIL PIC X(50) VALUE SPACES. CL211 00215 01 WS-TOTAL-LINE11. CL126 00216 03 FIL PIC X(2) VALUE SPACES. CL249 00217 03 FIL PIC X(43) VALUE CL126 00218 'TOTAL TDEC REPORTS RETURED TO ... DUTAS = '. CL251 00219 03 WS-OUT-NDEL PIC ZZZZ9. CL248 00220 03 FIL PIC X(50) VALUE SPACES. CL126 00221 01 WS-TOTAL-LINE12. CL165 00222 03 FIL PIC X(2) VALUE SPACES. CL249 00223 03 FIL PIC X(43) VALUE CL165 00224 'TOTAL TDEC REPORTS MISSING FROM .. ESSP = '. CL251 00225 03 WS-OUT-DELQ PIC ZZZZ9. CL248 00226 03 FIL PIC X(05) VALUE SPACES. CL254 00227 03 FIL PIC X(45) VALUE 'SEE NOTE1'. CL254 00228 01 WS-TOTAL-LINE2. CL*92 00229 03 FIL PIC X(5) VALUE SPACES. CL*92 00230 03 FIL PIC X(43) VALUE CL127 00231 'NOTE1: PLEASE CHECK ESSP (TDEC REJECT FILE)'. CL254 00232 * 03 WS-OUT-NDEL PIC ZZZZ9. CL248 00233 03 FIL PIC X(50) VALUE SPACES. CL127 00234 DTSBX629 00235 01 WS-TOTAL-LINE3. CL*92 00236 03 FIL PIC X(5) VALUE SPACES. CL*92 00237 03 FIL PIC X(43) VALUE CL126 00238 'TOTAL X147 - SENT TO DOCS 4 DELETION = '. CL175 00239 * 03 WS-OUT-DELQ PIC ZZZZ9. CL248 00240 03 FIL PIC X(101) VALUE SPACES. CL*92 00241 CL*92 00242 CL172 00243 01 WS-TOTAL-LINE4. CL172 00244 03 FIL PIC X(5) VALUE SPACES. CL172 00245 03 FIL PIC X(43) VALUE CL172 00246 'TOTAL X140/144 NOT FOUND FOR X147 = '. CL172 00247 03 RP-TOTAL-NO-X144-SSN PIC ZZZZ9. CL172 00248 03 FIL PIC X(101) VALUE SPACES. CL172 00249 CL220 00250 *01 WS-TOTAL-LINE45. CL243 00251 * 03 FIL PIC X(5) VALUE SPACES. CL243 00252 * 03 FIL PIC X(43) VALUE CL243 00253 * '****** PLEASE EMAIL CHANGES BY NOON TO STOP'. CL243 00254 * 03 FIL PIC X(43) VALUE CL243 00255 * ' UPDATES/DELETION OF WAGES FROM DOCS... '. CL243 00256 * 03 FIL PIC X(040) VALUE SPACES. CL243 00257 CL220 00258 CL172 00259 01 WS-RUN-DATE. DTSBX629 00260 03 RUN-YR PIC 99. CL*54 00261 03 RUN-MO PIC 99. CL*54 00262 03 RUN-DA PIC 99. CL*54 00263 DTSBX629 00264 DTSBX629 00265 01 Z147-EMP-NO. CL233 00266 05 WS-EMP-NOA PIC 9(3) VALUE ZEROS. CL233 00267 05 WS-EMP-NOB PIC 9(3) VALUE ZEROS. CL233 00268 CL233 00269 01 HEADER1. DTSBX629 00270 03 FILLER PIC X(05) VALUE SPACES. DTSBX629 00271 03 FILLER PIC X(31) VALUE DTSBX629 00272 'DISTRICT OF COLUMBIA GOVERNMENT'. DTSBX629 00273 03 FILLER PIC X(05) VALUE SPACES. CL247 00274 03 REPORTING-DATE. CL247 00275 05 RUN-MO1 PIC 99. CL247 00276 05 FIL PIC X VALUE '/'. CL247 00277 05 RUN-DA1 PIC 99. CL247 00278 05 FIL PIC X VALUE '/'. CL247 00279 05 RUN-CEN PIC 99. CL247 00280 05 RUN-YR1 PIC 99. CL247 00281 * DTSBX629 00282 01 HEADER2. DTSBX629 00283 03 FILLER PIC X(04) VALUE SPACES. CL247 00284 03 FILLER PIC X(33) VALUE DTSBX629 00285 'DEPARTMENT OF EMPLOYMENT SERVICES'. DTSBX629 00286 03 FILLER PIC X(30) VALUE SPACES. CL*99 00287 * 03 FILLER PIC X(10) VALUE CL249 00288 * 'PAGE NO. '. CL249 00289 * 03 HD-PAGE PIC 9(03). CL249 00290 03 FILLER PIC X(07) VALUE SPACES. DTSBX629 00291 DTSBX629 00292 01 HEADER3. DTSBX629 00293 03 FILLER PIC X(02) VALUE SPACES. CL249 00294 03 FILLER PIC X(50) VALUE CL220 00295 'MISSING TDEC REPORTS (X140) FROM ESSP'. CL250 00296 03 FILLER PIC X(30) VALUE SPACES. CL201 00297 DTSBX629 00298 01 COLUMN-HD1. CL*44 00299 03 FILLER PIC X(03) VALUE SPACES. CL*54 00300 03 FILLER PIC X(06) VALUE 'EMP-NO'. CL*97 00301 03 FILLER PIC X(04) VALUE SPACES. CL243 00302 03 FILLER PIC X(04) VALUE 'NAME'. CL243 00303 03 FILLER PIC X(04) VALUE SPACES. CL243 00304 03 FILLER PIC X(06) VALUE 'YR/QTR'. CL*96 00305 03 FILLER PIC X(04) VALUE SPACES. CL247 00306 03 FILLER PIC X(35) VALUE 'DATE SENT TO ESSP'. CL**3 00307 CL*15 00308 ++INCLUDE WSDATES DTSBX629 00309 01 L001-LINK-AREA. CL*61 00310 ++INCLUDE DTSIL001 CL*60 00311 01 Z147-REC. CL228 00312 05 Z147-EMP-NOA PIC 9(3). CL233 00313 05 FILLER PIC X(01). CL233 00314 05 Z147-EMP-NOB PIC 9(3). CL233 00315 05 FILLER PIC X(73). CL233 00316 01 Z144-REC. CL228 00317 05 FILLER PIC X(61). CL226 00318 05 Z144-EMP-NO PIC 9(6). CL228 00319 05 Z144-EMP-NAME PIC X(04). CL241 00320 05 FILLER PIC X(14). CL241 00321 05 Z144-QUARTER PIC 9(5). CL235 00322 05 FILLER PIC X(400). CL**2 00323 05 Z144-DATE-SENT-ESSP PIC X(10). CL**2 00324 05 FILLER PIC X(12). CL**2 00325 CL**4 00326 01 MRPT-REC. CL**4 00327 ++INCLUDE DTSIMRPT CL**4 00328 01 L910-LINK-AREA. CL**6 00329 ++INCLUDE DTSIL910 CL**5 00330 01 MSKL-REC. CL**5 00331 ++INCLUDE DTSIMSKL CL**5 00332 CL**4 00333 ++INCLUDE DTSEX147 CL228 00334 01 X140-REC. CL228 00335 ++INCLUDE DTSEX140 CL228 00336 01 X144-REC. CL228 00337 ++INCLUDE DTSEX144 CL228 00338 *01 COMMON-LINKAGE-SECTION. CL*18 00339 *++INCLUDE ESPLINKB CL*16 00340 *++INCLUDE EWGLINKB CL*16 00341 ******************************************************************DTSBX629 00342 * PROCEDURE DIVISION *DTSBX629 00343 ******************************************************************DTSBX629 00344 DTSBX629 00345 PROCEDURE DIVISION. DTSBX629 00346 DTSBX629 00347 MAIN0100-CONTROL. DTSBX629 00348 DTSBX629 00349 CL145 00350 OPEN INPUT X144SSN-IN. CL239 00351 OPEN OUTPUT X144SSN-OUT. CL**1 00352 * OPEN OUTPUT X147SSN-OUTB CL226 00353 OPEN OUTPUT REPORT-FILE. CL*87 00354 ++INCLUDE CODEDATE DTSBX629 00355 MOVE ZEROS TO WS-RUN-DATE. DTSBX629 00356 MOVE WS-SYSTEM-DATE TO WS-RUN-DATE. DTSBX629 00357 MOVE RUN-DA TO RUN-DA1. DTSBX629 00358 MOVE RUN-MO TO RUN-MO1. DTSBX629 00359 MOVE 20 TO RUN-CEN. DTSBX629 00360 MOVE RUN-YR TO RUN-YR1. DTSBX629 00361 DTSBX629 00362 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**4 00363 ADD 1 TO PAGE-COUNT CL*98 00364 * MOVE PAGE-COUNT TO HD-PAGE CL249 00365 WRITE PRINT-RECORD FROM HEADER1 AFTER ADVANCING CL*98 00366 TOP-OF-PAGE CL*98 00367 WRITE PRINT-RECORD FROM HEADER2 AFTER ADVANCING 1 CL*98 00368 WRITE PRINT-RECORD FROM HEADER3 AFTER ADVANCING 1 CL*98 00369 MOVE SPACES TO PRINT-RECORD CL*98 00370 WRITE PRINT-RECORD AFTER ADVANCING 1 CL*98 00371 WRITE PRINT-RECORD FROM COLUMN-HD1 AFTER 1. CL132 00372 MOVE ZEROES TO MASTER-READ-COUNT. DTSBX629 00373 ****************************************************************** CL*85 00374 * BENEFIT FILE PROCESS * CL*85 00375 ****************************************************************** CL*85 00376 PROC1000-GET-UI-DATA. CL*85 00377 DISPLAY ' '. CL*85 00378 * DISPLAY '****** START SEARCH FOR MISSING TDEC REPORTS'. CL241 00379 DISPLAY '### TDEC REPORT(S) NOT RETURNED FROM ESSP: ' CL241 00380 DISPLAY 'EMP NO NAME QTR '. CL241 00381 DISPLAY ' '. CL241 00382 DTSBX629 00383 PERFORM PROC2000-UI-PROCESS THRU DTSBX629 00384 PROC2000-UI-EXIT DTSBX629 00385 UNTIL MASTER-END. CL195 00386 DTSBX629 00387 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++'. DTSBX629 00388 DISPLAY ' '. DTSBX629 00389 DISPLAY ' PROGRAM DTSBX627 RECORD COUNTS:'. CL230 00390 DISPLAY ' '. DTSBX629 00391 DISPLAY ' '. CL**2 00392 DISPLAY 'TOTAL X147 RECORDS READ = ' MASTER-READ-COUNT. CL113 00393 DISPLAY ' MATCHING X144 RES FOUND = ' WS-TOTAL-YES-X144-SSN. CL115 00394 DISPLAY 'TOTAL X147 CLAIMS FOUND = ' WS-TOTAL-NDEL. CL115 00395 DISPLAY 'TOTAL X147 REC DELETED = ' WS-TOTAL-DELQ. CL115 00396 DISPLAY 'TOTAL X147 DUP OR ALL 9 = ' WS-TOTAL-OTH-X144-SSN. CL114 00397 DISPLAY 'TOTAL X144 REC NOT FOUND = ' WS-TOTAL-NO-X144-SSN. CL113 00398 DISPLAY ' '. DTSBX629 00399 DISPLAY ' '. DTSBX629 00400 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++'. DTSBX629 00401 MOVE MASTER-READ-COUNT TO WS-OUT-READ WS-OUT-READ1. CL248 00402 MOVE WS-TOTAL-NDEL TO WS-OUT-NDEL. CL126 00403 MOVE WS-TOTAL-DELQ TO WS-OUT-DELQ. CL126 00404 * MOVE WS-TOTAL-YES-X144-SSN TO WS-OUT-M144. CL167 00405 * MOVE WS-X147-SSN-IN-DOCS TO RP-X147-SSN-IN-DOCS. CL248 00406 * MOVE WS-X147-SSN-NOT-DOCS TO RP-X147-SSN-NOT-DOCS. CL248 00407 * MOVE WS-TOTAL-NO-X144-SSN TO RP-TOTAL-NO-X144-SSN CL248 00408 * MOVE WS-X147-SSN-N99-DOCS TO RP-X147-SSN-N99-DOCS. CL248 00409 CL*11 00410 WRITE PRINT-RECORD FROM WS-TOTAL-LINE1 AFTER 2. CL*93 00411 WRITE PRINT-RECORD FROM WS-TOTAL-LINE10 AFTER 1. CL211 00412 WRITE PRINT-RECORD FROM WS-TOTAL-LINE11 AFTER 1. CL211 00413 WRITE PRINT-RECORD FROM WS-TOTAL-LINE12 AFTER 1. CL169 00414 WRITE PRINT-RECORD FROM WS-TOTAL-LINE2 AFTER 3. CL255 00415 * WRITE PRINT-RECORD FROM WS-TOTAL-LINE3 AFTER 1. CL247 00416 * WRITE PRINT-RECORD FROM WS-TOTAL-LINE4 AFTER 1. CL247 00417 * WRITE PRINT-RECORD FROM WS-TOTAL-LINE45 AFTER 3. CL246 00418 CL*11 00419 MOVE ZEROES TO RETURN-CODE. DTSBX629 00420 DTSBX629 00421 CLOSE X144SSN-IN, REPORT-FILE. CL239 00422 * CLOSE X147SSN-OUTB. CL225 00423 DTSBX629 00424 GOBACK. DTSBX629 00425 DTSBX629 00426 MAIN0100-CONTROL-EXIT. DTSBX629 00427 EXIT. DTSBX629 00428 DTSBX629 00429 ******************************************************************DTSBX629 00430 * PROC2000-UI-PROCESS *DTSBX629 00431 ******************************************************************DTSBX629 00432 DTSBX629 00433 PROC2000-UI-PROCESS. DTSBX629 00434 DTSBX629 00435 PERFORM PROC3000-READ-MASTER-FILE THRU DTSBX629 00436 PROC3000-READ-EXIT. DTSBX629 00437 DTSBX629 00438 IF MASTER-END DTSBX629 00439 GO TO PROC2000-UI-EXIT. DTSBX629 00440 DTSBX629 00441 * MOVE Z147-EMP-NOA TO WS-EMP-NOA CL239 00442 * MOVE Z147-EMP-NOB TO WS-EMP-NOB CL239 00443 * IF WS-X144-SSN-FOUND = 3 CL133 00444 * ADD 1 TO WS-TOTAL-OTH-X144-SSN CL133 00445 * GO TO PROC2000-UI-EXIT. CL133 00446 CL116 00447 * IF X147-SSN = 999999999 CL228 00448 * ADD 1 TO WS-X147-SSN-N99-DOCS CL228 00449 * GO TO PROC2000-UI-EXIT. CL228 00450 CL116 00451 * DISPLAY '------' CL230 00452 * DISPLAY '+++< TDEC X144 REPORTS MISSING : ' CL230 00453 CL195 00454 MOVE 0 TO WS-X144-SSN-FOUND. CL101 00455 MOVE 0 TO WS-X140-RPT-FOUND. CL138 00456 * OPEN INPUT X144SSN-IN. CL239 00457 OPEN INPUT X140RPT-IN. CL239 00458 CL161 00459 PERFORM PROC2250-X140-RPT THRU PROC2250-EXIT. CL239 00460 CL161 00461 IF WS-X140-RPT-FOUND = 0 CL*11 00462 * DISPLAY ' RPT NOT FOUND= ' WS-X140-RPT-FOUND CL*15 00463 PERFORM PROC2275-MPRF-RPT THRU PROC2275-EXIT. CL**4 00464 * CLOSE X144SSN-IN. CL239 00465 CLOSE X140RPT-IN. CL239 00466 CL102 00467 IF WS-X140-RPT-FOUND > 0 CL**2 00468 ADD 1 TO WS-TOTAL-NDEL CL**2 00469 GO TO PROC2000-UI-EXIT. CL**2 00470 CL**2 00471 ADD 1 TO WS-TOTAL-DELQ CL249 00472 MOVE Z144-EMP-NO TO WS-OUT-EMP-NO CL243 00473 MOVE Z144-EMP-NAME TO WS-OUT-NAME CL243 00474 MOVE Z144-QUARTER TO WS-OUT-QUARTER CL243 00475 CL**2 00476 IF Z144-DATE-SENT-ESSP > SPACES CL**2 00477 MOVE Z144-DATE-SENT-ESSP TO WS-OUT-DATE CL**2 00478 ELSE CL**2 00479 MOVE REPORTING-DATE TO Z144-DATE-SENT-ESSP CL**2 00480 MOVE Z144-DATE-SENT-ESSP TO WS-OUT-DATE. CL**2 00481 CL**2 00482 WRITE PRINT-RECORD FROM WS-OUTPUT CL247 00483 WRITE X144-RECORD-OUT FROM Z144-REC CL**1 00484 CL239 00485 GO TO PROC2000-UI-EXIT. CL223 00486 CL223 00487 * CL195 00488 **** SEARCH DOCS FOR ANY CLAIM ON ESSP SSN MARKED FOR DELETION. CL195 00489 **** IF CLAIM IS FOUND DO NOT DELETE SSN-- SEND REPORT. CL195 00490 * CL195 00491 MOVE 0 TO WS-CLAIM-SSN-FOUND. CL182 00492 CL194 00493 * PERFORM PROC2700-FIND-CLAIM THRU PROC2700-EXIT. CL*18 00494 CL133 00495 IF WS-CLAIM-SSN-FOUND = 1 CL214 00496 IF WS-X144-SSN-FOUND = 1 CL214 00497 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL205 00498 DISPLAY ' >> CLAIM FOUND WITH X144: REPLACE WAGES ' CL205 00499 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL201 00500 ELSE CL214 00501 DISPLAY ' >> CLAIM FOUND NO X144: CANNOT DELETE' CL205 00502 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL216 00503 PERFORM PROC2600-SAV-SSN THRU PROC2600-EXIT CL207 00504 ADD 1 TO WS-TOTAL-NDEL CL205 00505 ELSE CL205 00506 IF WS-CLAIM-SSN-FOUND = 0 CL214 00507 IF WS-X144-SSN-FOUND = 1 CL214 00508 DISPLAY '++ CLAIM NOT FOUND REPLACE WAGES ' X147-EMP-NO CL205 00509 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL205 00510 ELSE CL214 00511 DISPLAY '++ CLAIM NOT FOUND DELETE WAGES ' X147-EMP-NO CL205 00512 PERFORM PROC2550-DEL-SSN THRU PROC2550-EXIT CL215 00513 ELSE CL214 00514 DISPLAY '++ CHECK IF STATEMENT ========= ' X147-EMP-NO. CL215 00515 CL201 00516 GO TO PROC2000-UI-EXIT. CL201 00517 CL182 00518 IF X147-SSN = WS-HOLD-X147-SSN AND CL199 00519 X147-EMP-NO = WS-HOLD-X147-EMP-NO AND CL199 00520 EMPLOYER-FOUND-IND = 'Y' CL199 00521 DISPLAY ' >> CLAIM FOUND ----: CANNOT DELETE ' CL199 00522 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL199 00523 PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT CL199 00524 ADD 1 TO WS-TOTAL-NDEL CL199 00525 GO TO PROC2000-UI-EXIT. CL199 00526 CL*91 00527 MOVE 0 TO ENDOFSEG. CL199 00528 MOVE 'N' TO EMPLOYER-FOUND-IND. CL199 00529 CL119 00530 * PERFORM SERV2000-MASTER THRU CL201 00531 * SERV2000-EXIT. CL201 00532 CL119 00533 CL119 00534 * PERFORM PROC4000-SEARCH-SEG04 THRU CL*18 00535 * PROC4000-SEG04-EXIT CL*18 00536 * UNTIL CL*18 00537 * ENDOFSEG EQUAL 1. CL*18 00538 DTSBX629 00539 IF EMPLOYER-FOUND-IND = 'Y' CL199 00540 PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT CL199 00541 DISPLAY '>>> CLAIM FOUND --- CANNOT DELETE ' CL199 00542 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL199 00543 ADD 1 TO WS-TOTAL-NDEL CL199 00544 ELSE CL*87 00545 DISPLAY ' << EMP NOT FOUND ON DOCS -DELETE ' X147-EMP-NO CL195 00546 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT. CL*87 00547 CL*87 00548 PROC2000-UI-EXIT. DTSBX629 00549 EXIT. DTSBX629 00550 CL146 00551 PROC2200-X144-SSN. CL101 00552 CL138 00553 READ X144SSN-IN INTO Z144-REC CL239 00554 AT END CL138 00555 * MOVE 0 TO WS-X144-SSN-FOUND CL218 00556 DISPLAY '### X144 AT END ' Z144-EMP-NO CL228 00557 GO TO PROC2200-EXIT. CL138 00558 CL138 00559 MOVE 0 TO WS-SAV-X147. CL138 00560 CL159 00561 * IF X144-SSN = 999999999 CL228 00562 * MOVE 2 TO WS-X144-SSN-FOUND CL228 00563 * GO TO PROC2200-EXIT. CL228 00564 CL159 00565 * DISPLAY '### X144 ' CL174 00566 * X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN. CL174 00567 * DISPLAY '### X147 ' CL174 00568 * X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN. CL174 00569 CL163 00570 * IF X144-SSN = X147-SSN CL174 00571 * DISPLAY '### MATCHING X144 SSN ' CL174 00572 CL163 00573 * DISPLAY '### X144 EMP: ' CL238 00574 * ' ' Z144-EMP-NO ' ' Z144-QUARTER. CL238 00575 * DISPLAY '### X147 EMP: ' CL238 00576 * ' ' Z147-EMP-NO ' '. CL238 00577 CL138 00578 IF Z144-EMP-NO = Z147-EMP-NO AND Z144-QUARTER = 20181 CL237 00579 MOVE 1 TO WS-X144-SSN-FOUND CL138 00580 DISPLAY '### MISSING TDEC RPT FOUND: ' CL228 00581 ' ' Z144-EMP-NO ' ' Z144-QUARTER CL235 00582 GO TO PROC2200-EXIT. CL138 00583 CL138 00584 IF Z144-EMP-NO > Z147-EMP-NO CL228 00585 MOVE 0 TO WS-X144-SSN-FOUND CL138 00586 GO TO PROC2200-EXIT. CL138 00587 CL138 00588 IF Z144-EMP-NO < Z147-EMP-NO CL228 00589 GO TO PROC2200-X144-SSN. CL138 00590 CL138 00591 * IF X144-QUARTER > X147-QUARTER CL226 00592 * MOVE 0 TO WS-X144-SSN-FOUND CL226 00593 * GO TO PROC2200-EXIT. CL226 00594 CL157 00595 * IF X144-QUARTER < X147-QUARTER CL226 00596 * GO TO PROC2200-X144-SSN. CL226 00597 CL138 00598 CL138 00599 * IF X144-SSN > X147-SSN CL226 00600 * MOVE 0 TO WS-X144-SSN-FOUND CL226 00601 * GO TO PROC2200-EXIT. CL226 00602 CL138 00603 * IF X144-SSN < X147-SSN CL226 00604 * GO TO PROC2200-X144-SSN. CL226 00605 CL138 00606 * DISPLAY '### MATCHING X147 SSN FOUND ' CL119 00607 * ' ' X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN. CL119 00608 PROC2200-EXIT. CL101 00609 EXIT. CL101 00610 CL101 00611 PROC2250-X140-RPT. CL138 00612 CL138 00613 MOVE 0 TO WS-X140-RPT-FOUND CL239 00614 READ X140RPT-IN INTO X140-REC CL239 00615 AT END CL239 00616 MOVE 0 TO WS-X140-RPT-FOUND CL239 00617 GO TO PROC2250-EXIT. CL194 00618 CL138 00619 MOVE 0 TO WS-SAV-X147. CL138 00620 CL194 00621 MOVE X140-QUARTER-YY TO WS-X140-YR CL240 00622 MOVE X140-QUARTER-Q TO WS-X140-QTR CL240 00623 CL240 00624 * DISPLAY '### TDEC ' Z144-EMP-NO ' ' Z144-QUARTER. CL*14 00625 * DISPLAY '### ESSP ' X140-EMP-NO ' ' WS-X140-QUARTER. CL*14 00626 * 'X144 ' X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN. CL138 00627 CL138 00628 MOVE WS-X140-QUARTER TO W-X140-REPORT-QTR. CL**4 00629 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL**4 00630 IF X140-EMP-NO = Z144-EMP-NO CL239 00631 AND WS-X140-QUARTER = Z144-QUARTER CL240 00632 MOVE 1 TO WS-X140-RPT-FOUND CL138 00633 * DISPLAY 'P2250; RPT FOUND= ' WS-X140-RPT-FOUND CL*14 00634 GO TO PROC2250-EXIT. CL138 00635 CL138 00636 IF X140-EMP-NO > Z144-EMP-NO CL253 00637 MOVE 0 TO WS-X140-RPT-FOUND CL138 00638 GO TO PROC2250-EXIT. CL138 00639 CL138 00640 IF X140-EMP-NO < Z144-EMP-NO CL253 00641 GO TO PROC2250-X140-RPT. CL143 00642 CL138 00643 IF WS-X140-QUARTER > Z144-QUARTER CL253 00644 MOVE 0 TO WS-X140-RPT-FOUND CL138 00645 GO TO PROC2250-EXIT. CL142 00646 CL138 00647 IF WS-X140-QUARTER < Z144-QUARTER CL253 00648 GO TO PROC2250-X140-RPT. CL143 00649 CL138 00650 PROC2250-EXIT. CL138 00651 EXIT. CL138 00652 PROC2275-MPRF-RPT. CL**4 00653 CL**4 00654 MOVE 0 TO WS-X140-RPT-FOUND CL**4 00655 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL**4 00656 * MOVE X140-EMP-NO TO MRPT-EMP-NO. CL*15 00657 * MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL*15 00658 MOVE Z144-EMP-NO TO MRPT-EMP-NO. CL*15 00659 MOVE Z144-QUARTER TO MRPT-YRQ. CL*15 00660 MOVE ZEROS TO MRPT-BATCH-NO. CL**4 00661 MOVE ZEROS TO MRPT-ITEM-NO CL**4 00662 CL**4 00663 SET MRPT-RPT-88 TO TRUE. CL**4 00664 MOVE MRPT-REC TO MSKL-REC. CL**4 00665 CL**4 00666 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**4 00667 IF L910-OK-88 CL**4 00668 PERFORM P2016-SCAN-MRPT THRU P2016-EXIT CL**4 00669 UNTIL L910-NO-REC-88 CL**4 00670 ELSE CL**4 00671 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 00672 MOVE 0 TO WS-X140-RPT-FOUND CL*15 00673 DISPLAY 'X629 RPT NOT ON DUTAS- ' CL*15 00674 X140-EMP-NO ' ' W-X140-REPORT-QTR CL**7 00675 DISPLAY ' ' CL**4 00676 DISPLAY ' '. CL**4 00677 CL**4 00678 CL**4 00679 PROC2275-EXIT. CL**4 00680 EXIT. CL**4 00681 CL**4 00682 P2016-SCAN-MRPT. CL**4 00683 MOVE MSKL-REC TO MRPT-REC. CL**4 00684 IF MRPT-YRQ = Z144-QUARTER CL*15 00685 MOVE 1 TO WS-X140-RPT-FOUND CL**4 00686 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 00687 SET L910-NO-REC-88 TO TRUE CL**4 00688 GO TO P2016-EXIT CL**4 00689 ELSE CL**4 00690 IF MRPT-YRQ > Z144-QUARTER CL*15 00691 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 00692 SET L910-NO-REC-88 TO TRUE CL**4 00693 GO TO P2016-EXIT CL**4 00694 ELSE CL**4 00695 GO TO P2016-READ-NEXT CL**4 00696 END-IF CL**4 00697 END-IF. CL**4 00698 CL**4 00699 * IF MRPT-ORIG-88 CL**4 00700 * SET W-RPT-ERROR-YES-88 TO TRUE CL**4 00701 * SET L910-NO-REC-88 TO TRUE CL**4 00702 * MOVE SPACES TO R140-MESSAGE CL**4 00703 * MOVE W-EMP-NO TO R140-EMP-NO CL**4 00704 * STRING CL**4 00705 * ':-----FAILED - RPT EXIST IN DUTAS ' CL**4 00706 * X140-QUARTER CL**4 00707 * DELIMITED BY SIZE CL**4 00708 * INTO R140-MESSAGE CL**4 00709 * END-STRING CL**4 00710 * MOVE R140-MESSAGE TO X434-MESSAGE CL**4 00711 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 00712 * GO TO P2016-EXIT CL**4 00713 * END-IF. CL**4 00714 CL**4 00715 CL**4 00716 P2016-READ-NEXT. CL**4 00717 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**4 00718 IF L910-NO-REC-88 CL**4 00719 SET W-RPT-ERROR-NO-88 TO TRUE. CL**4 00720 P2016-EXIT. CL**4 00721 CL**4 00722 CL**4 00723 CL138 00724 CL**4 00725 PROC2500-DEL-SSN. CL*87 00726 CL*87 00727 * WRITE X147-RECORD-OUTA FROM X144-REC. CL125 00728 * WRITE X147-RECORD-OUTA FROM X147-REC. CL229 00729 ADD 1 TO WS-TOTAL-DELQ. CL113 00730 CL129 00731 IF WS-SAV-X147 = 1 CL129 00732 GO TO PROC2500-EXIT. CL129 00733 CL129 00734 MOVE X147-SSN TO WS-INPUT-SSN. CL126 00735 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL244 00736 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL244 00737 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL244 00738 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL244 00739 CL126 00740 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL244 00741 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL244 00742 * MOVE X147-FNAME TO WS-OUT-FNAME. CL244 00743 * MOVE X147-LNAME TO WS-OUT-LNAME. CL244 00744 * MOVE X147-WAGES TO WS-OUT-WAGES. CL244 00745 * IF WS-X144-SSN-FOUND = 1 CL244 00746 * MOVE 'Y ' TO WS-OUT-X144 CL244 00747 * ELSE CL244 00748 * MOVE 'N ' TO WS-OUT-X144. CL244 00749 * IF WS-X140-RPT-FOUND = 1 CL244 00750 * MOVE 'Y ' TO WS-OUT-X140 CL244 00751 * ELSE CL244 00752 * MOVE 'N ' TO WS-OUT-X140. CL244 00753 IF WS-CLAIM-SSN-FOUND = 1 CL205 00754 MOVE '++CLAIM FOUND WAGES REPLACED' TO WS-OUT-MESSAGE CL205 00755 ELSE CL205 00756 MOVE '++NO CLAIM -- WAGES REPLACED' TO WS-OUT-MESSAGE. CL205 00757 CL126 00758 ADD 1 TO LINE-COUNT. CL206 00759 WRITE PRINT-RECORD FROM WS-OUTPUT. CL206 00760 PROC2500-EXIT. CL*87 00761 EXIT. CL*87 00762 CL*87 00763 CL201 00764 PROC2550-DEL-SSN. CL201 00765 CL201 00766 * WRITE X147-RECORD-OUTA FROM X144-REC. CL201 00767 * WRITE X147-RECORD-OUTA FROM X147-REC. CL229 00768 ADD 1 TO WS-TOTAL-DELQ. CL201 00769 CL201 00770 IF WS-SAV-X147 = 1 CL201 00771 GO TO PROC2500-EXIT. CL201 00772 CL201 00773 MOVE X147-SSN TO WS-INPUT-SSN. CL201 00774 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 00775 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 00776 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 00777 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 00778 CL201 00779 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 00780 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 00781 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 00782 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 00783 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 00784 * IF WS-X144-SSN-FOUND = 1 CL245 00785 * MOVE 'Y ' TO WS-OUT-X144 CL245 00786 * ELSE CL245 00787 * MOVE 'N ' TO WS-OUT-X144. CL245 00788 * IF WS-X140-RPT-FOUND = 1 CL245 00789 * MOVE 'Y ' TO WS-OUT-X140 CL245 00790 * ELSE CL245 00791 * MOVE 'N ' TO WS-OUT-X140. CL245 00792 * MOVE 'WAGES ---DELETED ' TO WS-OUT-MESSAGE. CL245 00793 CL201 00794 ADD 1 TO LINE-COUNT. CL210 00795 WRITE PRINT-RECORD FROM WS-OUTPUT. CL210 00796 PROC2550-EXIT. CL201 00797 EXIT. CL201 00798 CL201 00799 CL123 00800 PROC2600-SAV-SSN. CL123 00801 CL123 00802 MOVE 0 TO WS-SAV-X147. CL129 00803 * WRITE X147-RECORD-OUTB FROM X147-REC. CL229 00804 MOVE X147-SSN TO WS-INPUT-SSN. CL126 00805 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 00806 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 00807 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 00808 * MOVE CPD-SSN-SEQ TO WS-OUT-SEQ. CL245 00809 CL126 00810 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 00811 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 00812 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 00813 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 00814 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 00815 * IF WS-X144-SSN-FOUND = 1 CL245 00816 * MOVE 'Y ' TO WS-OUT-X144 CL245 00817 * ELSE CL245 00818 * MOVE 'N ' TO WS-OUT-X144. CL245 00819 * IF WS-X140-RPT-FOUND = 1 CL245 00820 * MOVE 'Y ' TO WS-OUT-X140 CL245 00821 * ELSE CL245 00822 * MOVE 'N ' TO WS-OUT-X140. CL245 00823 * IF WRK-SEG01-SSN-FOUND = 0 CL245 00824 * MOVE '++ X147 NOT FOUND IN DOCS -ESSP VERIFY' CL245 00825 * TO WS-OUT-MESSAGE CL245 00826 * ELSE CL245 00827 * MOVE '++ CLAIM FOUND NO WAGES CANNOT DELETE ' CL245 00828 * TO WS-OUT-MESSAGE. CL245 00829 * MOVE 1 TO WS-SAV-X147. CL245 00830 * ADD 1 TO LINE-COUNT. CL245 00831 WRITE PRINT-RECORD FROM WS-OUTPUT. CL126 00832 PROC2600-EXIT. CL123 00833 EXIT. CL123 00834 CL123 00835 ******************************************************************DTSBX629 00836 * PROC3000-READ-MASTER-FILE *DTSBX629 00837 ******************************************************************DTSBX629 00838 DTSBX629 00839 PROC3000-READ-MASTER-FILE. DTSBX629 00840 DTSBX629 00841 MOVE 0 TO WS-X144-SSN-FOUND. CL116 00842 MOVE 0 TO WS-X140-RPT-FOUND. CL138 00843 CL116 00844 READ X144SSN-IN INTO Z144-REC CL239 00845 AT END DTSBX629 00846 MOVE 'Y' TO MASTER-END-IND CL*63 00847 GO TO PROC3000-READ-EXIT. DTSBX629 00848 DTSBX629 00849 * IF X147-EMP-NO = WS-X147-EMP-NO CL227 00850 * AND X147-QUARTER = WS-X147-QUARTER CL227 00851 * MOVE 3 TO WS-X144-SSN-FOUND CL227 00852 * ELSE CL227 00853 * MOVE X147-SSN TO WS-X147-SSN CL227 00854 * MOVE X147-EMP-NO TO WS-X147-EMP-NO CL227 00855 * MOVE X147-QUARTER TO WS-X147-QUARTER. CL227 00856 ADD 1 TO MASTER-READ-COUNT. DTSBX629 00857 DTSBX629 00858 PROC3000-READ-EXIT. DTSBX629 00859 EXIT. DTSBX629 00860 DTSBX629 00861 DTSBX629 00862 ******************************************************************DTSBX629 00863 * PROC5000-WRITE-RECORD-PAID *DTSBX629 00864 ******************************************************************DTSBX629 00865 DTSBX629 00866 DTSBX629 00867 PROC5000-X147-NOT-DELETED. CL*94 00868 MOVE X147-SSN TO WS-INPUT-SSN. CL*92 00869 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 00870 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 00871 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 00872 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 00873 * CL245 00874 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 00875 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 00876 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 00877 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 00878 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 00879 * MOVE 'Y ' TO WS-OUT-X144. CL245 00880 * MOVE '++ CLAIM FOUND ON DOCS - VERIFY' TO WS-OUT-MESSAGE. CL245 00881 DTSBX629 00882 * IF LINE-COUNT GREATER 55 CL*74 00883 * MOVE ZEROES TO LINE-COUNT CL*74 00884 ADD 1 TO LINE-COUNT. CL126 00885 WRITE PRINT-RECORD FROM WS-OUTPUT. CL*92 00886 PROC5000-EXIT. CL*94 00887 EXIT. DTSBX629 00888 DTSBX629 00889 CL*69 00890 S910-OPEN-READ. CL**4 00891 SET L910-OPEN-READ-88 TO TRUE. CL**4 00892 GO TO S910-MSTR-IO. CL**4 00893 CL**4 00894 S910-READ. CL**4 00895 SET L910-READ-88 TO TRUE. CL**4 00896 GO TO S910-MSTR-IO. CL**4 00897 CL**4 00898 S910-START-BROWSE. CL**4 00899 SET L910-START-BROWSE-88 TO TRUE. CL**4 00900 GO TO S910-MSTR-IO. CL**4 00901 CL**4 00902 S910-READ-NEXT. CL**4 00903 SET L910-READ-NEXT-88 TO TRUE. CL**4 00904 GO TO S910-MSTR-IO. CL**4 00905 CL**4 00906 S910-CLOSE. CL**4 00907 SET L910-CLOSE-88 TO TRUE. CL**4 00908 GO TO S910-MSTR-IO. CL**4 00909 CL**4 00910 S910-MSTR-IO. CL**4 00911 CALL 'DTSBU910' USING L910-LINK-AREA CL**4 00912 MSKL-REC. CL**4 00913 S910-EXIT. CL**4 00914 EXIT. CL**4 00915 CL**4 00916 S001-FROM-CAL-6. CL**4 00917 SET L001-FROM-CAL-6 TO TRUE. CL*55 00918 GO TO S001-DATE-CONVERT. CL*55 00919 CL*55 00920 S001-FROM-ABS-DAY. CL*55 00921 SET L001-FROM-ABS-DAY TO TRUE. CL*55 00922 GO TO S001-DATE-CONVERT. CL*55 00923 CL*55 00924 S001-DATE-CONVERT. CL*55 00925 CALL 'DTSBU001' USING L001-LINK-AREA. CL*55 00926 S001-EXIT. CL*55 00927 EXIT. CL*55 00928 SKIP3 CL*55 00929 S999-ABEND. CL*55 00930 DISPLAY '*** ' CL*55 00931 WRK-MODULE-NAME CL*55 00932 ' IS ABENDING: ' CL*55 00933 WRK-ABEND-MSG. CL*55 00934 CL*55 00935 CALL 'DTSBU999' USING WRK-ABEND-CD. CL*55 00936 S999-EXIT. CL*55 00937 EXIT. CL*55 00938 S9999-ABEND. CL*78 00939 SKIP1 CL*78 00940 CALL 'DTSBU999' USING WRK-ABEND-CODE. CL*78 00941 SKIP1 CL*78 00942 S9999-EXIT. CL*78 00943 EXIT. CL*78