00001 IDENTIFICATION DIVISION. 02/12/19 00002 PROGRAM-ID. DTSBX629. DTSBX629 00003 LV015 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 '015DTSBX629 02/12/19'. 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. CL228 00339 ++INCLUDE ESPLINKB CL228 00340 ++INCLUDE EWGLINKB CL228 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 * IF WS-X144-SSN-FOUND = 1 CL217 00488 * ADD 1 TO WS-TOTAL-YES-X144-SSN CL217 00489 * DISPLAY '>+ X144 FOUND FOR X147- DELETE ' X147-SSN CL217 00490 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL187 00491 * ELSE CL217 00492 * IF WS-X144-SSN-FOUND = 0 CL217 00493 * ADD 1 TO WS-TOTAL-NO-X144-SSN CL217 00494 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL187 00495 * DISPLAY ' X140/144 NOT FOUND FOR X147 -VERIFY ' X147-SSN CL217 00496 * ELSE CL217 00497 * IF WS-X144-SSN-FOUND = 1 CL217 00498 * ADD 1 TO WS-TOTAL-YES-X144-SSN CL217 00499 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL187 00500 * DISPLAY 'X144 FOUND FOR X147 -VER: ' X147-SSN CL217 00501 * ELSE CL217 00502 * ADD 1 TO WS-TOTAL-NO-X144-SSN CL217 00503 * DISPLAY 'X140 OR X144 NOTFOUND FOR X147 -VER: ' X147-SSN. CL217 00504 * CL217 00505 * CL195 00506 **** SEARCH DOCS FOR ANY CLAIM ON ESSP SSN MARKED FOR DELETION. CL195 00507 **** IF CLAIM IS FOUND DO NOT DELETE SSN-- SEND REPORT. CL195 00508 * CL195 00509 MOVE 0 TO WS-CLAIM-SSN-FOUND. CL182 00510 CL194 00511 PERFORM PROC2700-FIND-CLAIM THRU PROC2700-EXIT. CL181 00512 CL133 00513 IF WS-CLAIM-SSN-FOUND = 1 CL214 00514 IF WS-X144-SSN-FOUND = 1 CL214 00515 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL205 00516 DISPLAY ' >> CLAIM FOUND WITH X144: REPLACE WAGES ' CL205 00517 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL201 00518 ELSE CL214 00519 DISPLAY ' >> CLAIM FOUND NO X144: CANNOT DELETE' CL205 00520 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL216 00521 PERFORM PROC2600-SAV-SSN THRU PROC2600-EXIT CL207 00522 ADD 1 TO WS-TOTAL-NDEL CL205 00523 ELSE CL205 00524 IF WS-CLAIM-SSN-FOUND = 0 CL214 00525 IF WS-X144-SSN-FOUND = 1 CL214 00526 DISPLAY '++ CLAIM NOT FOUND REPLACE WAGES ' X147-EMP-NO CL205 00527 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL205 00528 ELSE CL214 00529 DISPLAY '++ CLAIM NOT FOUND DELETE WAGES ' X147-EMP-NO CL205 00530 PERFORM PROC2550-DEL-SSN THRU PROC2550-EXIT CL215 00531 ELSE CL214 00532 DISPLAY '++ CHECK IF STATEMENT ========= ' X147-EMP-NO. CL215 00533 CL201 00534 GO TO PROC2000-UI-EXIT. CL201 00535 CL182 00536 IF X147-SSN = WS-HOLD-X147-SSN AND CL199 00537 X147-EMP-NO = WS-HOLD-X147-EMP-NO AND CL199 00538 EMPLOYER-FOUND-IND = 'Y' CL199 00539 DISPLAY ' >> CLAIM FOUND ----: CANNOT DELETE ' CL199 00540 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL199 00541 PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT CL199 00542 ADD 1 TO WS-TOTAL-NDEL CL199 00543 GO TO PROC2000-UI-EXIT. CL199 00544 CL*91 00545 MOVE 0 TO ENDOFSEG. CL199 00546 MOVE 'N' TO EMPLOYER-FOUND-IND. CL199 00547 CL119 00548 * PERFORM SERV2000-MASTER THRU CL201 00549 * SERV2000-EXIT. CL201 00550 CL119 00551 CL119 00552 PERFORM PROC4000-SEARCH-SEG04 THRU CL199 00553 PROC4000-SEG04-EXIT CL199 00554 UNTIL CL199 00555 ENDOFSEG EQUAL 1. CL199 00556 DTSBX629 00557 IF EMPLOYER-FOUND-IND = 'Y' CL199 00558 PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT CL199 00559 DISPLAY '>>> CLAIM FOUND --- CANNOT DELETE ' CL199 00560 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL199 00561 ADD 1 TO WS-TOTAL-NDEL CL199 00562 ELSE CL*87 00563 DISPLAY ' << EMP NOT FOUND ON DOCS -DELETE ' X147-EMP-NO CL195 00564 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT. CL*87 00565 CL*87 00566 PROC2000-UI-EXIT. DTSBX629 00567 EXIT. DTSBX629 00568 CL146 00569 PROC2100-FIND-SSN. CL146 00570 * SET DBW-SEQUENTIAL-PROCESSING TO TRUE. CL146 00571 SET DBW-RANDOM-PROCESSING TO TRUE. CL146 00572 SET DBW-READ-SEGMENT TO TRUE. CL146 00573 SET DBW-PROFILE-SEGMENT TO TRUE. CL146 00574 CL146 00575 MOVE +0 TO WRK-SEG01-SSN-FOUND CL146 00576 MOVE X147-SSN TO DBW-SSN CL146 00577 MOVE SPACES TO DBW-NAME CL146 00578 CL146 00579 PERFORM S960-SEG01 THRU S960-EXIT. CL146 00580 CL146 00581 IF DBW-NO-RECORD-FOUND CL146 00582 DISPLAY '## SSN- NOT FOUND IN DOCS SEG01: ' X147-SSN CL194 00583 GO TO PROC2100-EXIT CL146 00584 ELSE CL146 00585 * ADD +1 TO WRK-SEG01-READ-CNT CL149 00586 DISPLAY '++SSN FOUND ON DOCS SEG01: ' X147-SSN ' ' WGP-SSN. CL194 00587 *& CL146 00588 CL146 00589 SET DBW-RANDOM-PROCESSING TO TRUE. CL146 00590 SET DBW-WAGE-SEGMENT TO TRUE. CL146 00591 SET DBW-RESET-POINTERS TO TRUE. CL146 00592 PERFORM S961-SEG02 THRU S961-EXIT. CL146 00593 CL146 00594 PERFORM P2150-SELECT-SSN THRU P2150-EXIT CL146 00595 UNTIL DBW-NO-RECORD-FOUND. CL146 00596 CL146 00597 CL146 00598 DTSBX629 00599 PROC2100-EXIT. CL146 00600 EXIT. CL146 00601 P2150-SELECT-SSN. CL148 00602 SET DBW-READ-SEGMENT TO TRUE. CL146 00603 PERFORM S961-SEG02 THRU S961-EXIT. CL146 00604 CL146 00605 IF DBW-NO-RECORD-FOUND CL146 00606 GO TO P2150-EXIT. CL148 00607 CL146 00608 * ADD +1 TO WRK-SEG02-READ-CNT. CL148 00609 MOVE X147-YR TO WS-X147-YR CL151 00610 MOVE X147-QTR TO WS-X147-QTR CL151 00611 CL151 00612 * DISPLAY 'DOCS SSN ' WGP-SSN ' ' WGD-YR-QTR CL194 00613 * ' ' WGD-ACCOUNT-NUMBER ' ' WGD-QUARTER-EARNINGS. CL194 00614 * DISPLAY 'ESSP SSN ' X147-SSN ' ' WS-X147-QUARTER CL194 00615 * ' ' X147-EMP-NO. CL194 00616 CL146 00617 IF WGD-YR-QTR = WS-X147-QUARTER AND CL150 00618 WGD-ACCOUNT-NUMBER = X147-EMP-NO CL148 00619 SET DBW-NO-RECORD-FOUND TO TRUE CL153 00620 * PERFORM P1220-BUILD-W4 THRU P1220-EXIT CL146 00621 MOVE +1 TO WRK-SEG01-SSN-FOUND CL146 00622 DISPLAY '++SSN FOUND IN DOCS SEG02: ' X147-SSN CL217 00623 * PERFORM P1210-EDIT-SSN THRU P1210-EXIT CL146 00624 * IF WRK-SSN-ERROR-NO-88 CL146 00625 * GO TO P1200-EXIT CL146 00626 * PERFORM P1220-BUILD-WGH THRU P1220-EXIT CL146 00627 * END-IF CL146 00628 END-IF. CL146 00629 CL146 00630 CL146 00631 P2150-EXIT. CL148 00632 EXIT. CL146 00633 CL194 00634 PROC2200-X144-SSN. CL101 00635 CL138 00636 READ X144SSN-IN INTO Z144-REC CL239 00637 AT END CL138 00638 * MOVE 0 TO WS-X144-SSN-FOUND CL218 00639 DISPLAY '### X144 AT END ' Z144-EMP-NO CL228 00640 GO TO PROC2200-EXIT. CL138 00641 CL138 00642 MOVE 0 TO WS-SAV-X147. CL138 00643 CL159 00644 * IF X144-SSN = 999999999 CL228 00645 * MOVE 2 TO WS-X144-SSN-FOUND CL228 00646 * GO TO PROC2200-EXIT. CL228 00647 CL159 00648 * DISPLAY '### X144 ' CL174 00649 * X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN. CL174 00650 * DISPLAY '### X147 ' CL174 00651 * X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN. CL174 00652 CL163 00653 * IF X144-SSN = X147-SSN CL174 00654 * DISPLAY '### MATCHING X144 SSN ' CL174 00655 CL163 00656 * DISPLAY '### X144 EMP: ' CL238 00657 * ' ' Z144-EMP-NO ' ' Z144-QUARTER. CL238 00658 * DISPLAY '### X147 EMP: ' CL238 00659 * ' ' Z147-EMP-NO ' '. CL238 00660 CL138 00661 IF Z144-EMP-NO = Z147-EMP-NO AND Z144-QUARTER = 20181 CL237 00662 MOVE 1 TO WS-X144-SSN-FOUND CL138 00663 DISPLAY '### MISSING TDEC RPT FOUND: ' CL228 00664 ' ' Z144-EMP-NO ' ' Z144-QUARTER CL235 00665 GO TO PROC2200-EXIT. CL138 00666 CL138 00667 IF Z144-EMP-NO > Z147-EMP-NO CL228 00668 MOVE 0 TO WS-X144-SSN-FOUND CL138 00669 GO TO PROC2200-EXIT. CL138 00670 CL138 00671 IF Z144-EMP-NO < Z147-EMP-NO CL228 00672 GO TO PROC2200-X144-SSN. CL138 00673 CL138 00674 * IF X144-QUARTER > X147-QUARTER CL226 00675 * MOVE 0 TO WS-X144-SSN-FOUND CL226 00676 * GO TO PROC2200-EXIT. CL226 00677 CL157 00678 * IF X144-QUARTER < X147-QUARTER CL226 00679 * GO TO PROC2200-X144-SSN. CL226 00680 CL138 00681 CL138 00682 * IF X144-SSN > X147-SSN CL226 00683 * MOVE 0 TO WS-X144-SSN-FOUND CL226 00684 * GO TO PROC2200-EXIT. CL226 00685 CL138 00686 * IF X144-SSN < X147-SSN CL226 00687 * GO TO PROC2200-X144-SSN. CL226 00688 CL138 00689 * DISPLAY '### MATCHING X147 SSN FOUND ' CL119 00690 * ' ' X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN. CL119 00691 PROC2200-EXIT. CL101 00692 EXIT. CL101 00693 CL101 00694 PROC2250-X140-RPT. CL138 00695 CL138 00696 MOVE 0 TO WS-X140-RPT-FOUND CL239 00697 READ X140RPT-IN INTO X140-REC CL239 00698 AT END CL239 00699 MOVE 0 TO WS-X140-RPT-FOUND CL239 00700 GO TO PROC2250-EXIT. CL194 00701 CL138 00702 MOVE 0 TO WS-SAV-X147. CL138 00703 CL194 00704 MOVE X140-QUARTER-YY TO WS-X140-YR CL240 00705 MOVE X140-QUARTER-Q TO WS-X140-QTR CL240 00706 CL240 00707 * DISPLAY '### TDEC ' Z144-EMP-NO ' ' Z144-QUARTER. CL*14 00708 * DISPLAY '### ESSP ' X140-EMP-NO ' ' WS-X140-QUARTER. CL*14 00709 * 'X144 ' X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN. CL138 00710 CL138 00711 MOVE WS-X140-QUARTER TO W-X140-REPORT-QTR. CL**4 00712 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL**4 00713 IF X140-EMP-NO = Z144-EMP-NO CL239 00714 AND WS-X140-QUARTER = Z144-QUARTER CL240 00715 MOVE 1 TO WS-X140-RPT-FOUND CL138 00716 * DISPLAY 'P2250; RPT FOUND= ' WS-X140-RPT-FOUND CL*14 00717 GO TO PROC2250-EXIT. CL138 00718 CL138 00719 IF X140-EMP-NO > Z144-EMP-NO CL253 00720 MOVE 0 TO WS-X140-RPT-FOUND CL138 00721 GO TO PROC2250-EXIT. CL138 00722 CL138 00723 IF X140-EMP-NO < Z144-EMP-NO CL253 00724 GO TO PROC2250-X140-RPT. CL143 00725 CL138 00726 IF WS-X140-QUARTER > Z144-QUARTER CL253 00727 MOVE 0 TO WS-X140-RPT-FOUND CL138 00728 GO TO PROC2250-EXIT. CL142 00729 CL138 00730 IF WS-X140-QUARTER < Z144-QUARTER CL253 00731 GO TO PROC2250-X140-RPT. CL143 00732 CL138 00733 PROC2250-EXIT. CL138 00734 EXIT. CL138 00735 PROC2275-MPRF-RPT. CL**4 00736 CL**4 00737 MOVE 0 TO WS-X140-RPT-FOUND CL**4 00738 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL**4 00739 * MOVE X140-EMP-NO TO MRPT-EMP-NO. CL*15 00740 * MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL*15 00741 MOVE Z144-EMP-NO TO MRPT-EMP-NO. CL*15 00742 MOVE Z144-QUARTER TO MRPT-YRQ. CL*15 00743 MOVE ZEROS TO MRPT-BATCH-NO. CL**4 00744 MOVE ZEROS TO MRPT-ITEM-NO CL**4 00745 CL**4 00746 SET MRPT-RPT-88 TO TRUE. CL**4 00747 MOVE MRPT-REC TO MSKL-REC. CL**4 00748 CL**4 00749 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**4 00750 IF L910-OK-88 CL**4 00751 PERFORM P2016-SCAN-MRPT THRU P2016-EXIT CL**4 00752 UNTIL L910-NO-REC-88 CL**4 00753 ELSE CL**4 00754 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 00755 MOVE 0 TO WS-X140-RPT-FOUND CL*15 00756 DISPLAY 'X629 RPT NOT ON DUTAS- ' CL*15 00757 X140-EMP-NO ' ' W-X140-REPORT-QTR CL**7 00758 DISPLAY ' ' CL**4 00759 DISPLAY ' '. CL**4 00760 CL**4 00761 CL**4 00762 PROC2275-EXIT. CL**4 00763 EXIT. CL**4 00764 CL**4 00765 P2016-SCAN-MRPT. CL**4 00766 MOVE MSKL-REC TO MRPT-REC. CL**4 00767 IF MRPT-YRQ = Z144-QUARTER CL*15 00768 MOVE 1 TO WS-X140-RPT-FOUND CL**4 00769 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 00770 SET L910-NO-REC-88 TO TRUE CL**4 00771 GO TO P2016-EXIT CL**4 00772 ELSE CL**4 00773 IF MRPT-YRQ > Z144-QUARTER CL*15 00774 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 00775 SET L910-NO-REC-88 TO TRUE CL**4 00776 GO TO P2016-EXIT CL**4 00777 ELSE CL**4 00778 GO TO P2016-READ-NEXT CL**4 00779 END-IF CL**4 00780 END-IF. CL**4 00781 CL**4 00782 * IF MRPT-ORIG-88 CL**4 00783 * SET W-RPT-ERROR-YES-88 TO TRUE CL**4 00784 * SET L910-NO-REC-88 TO TRUE CL**4 00785 * MOVE SPACES TO R140-MESSAGE CL**4 00786 * MOVE W-EMP-NO TO R140-EMP-NO CL**4 00787 * STRING CL**4 00788 * ':-----FAILED - RPT EXIST IN DUTAS ' CL**4 00789 * X140-QUARTER CL**4 00790 * DELIMITED BY SIZE CL**4 00791 * INTO R140-MESSAGE CL**4 00792 * END-STRING CL**4 00793 * MOVE R140-MESSAGE TO X434-MESSAGE CL**4 00794 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 00795 * GO TO P2016-EXIT CL**4 00796 * END-IF. CL**4 00797 CL**4 00798 CL**4 00799 P2016-READ-NEXT. CL**4 00800 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**4 00801 IF L910-NO-REC-88 CL**4 00802 SET W-RPT-ERROR-NO-88 TO TRUE. CL**4 00803 P2016-EXIT. CL**4 00804 CL**4 00805 CL**4 00806 CL138 00807 CL**4 00808 PROC2500-DEL-SSN. CL*87 00809 CL*87 00810 * WRITE X147-RECORD-OUTA FROM X144-REC. CL125 00811 * WRITE X147-RECORD-OUTA FROM X147-REC. CL229 00812 ADD 1 TO WS-TOTAL-DELQ. CL113 00813 CL129 00814 IF WS-SAV-X147 = 1 CL129 00815 GO TO PROC2500-EXIT. CL129 00816 CL129 00817 MOVE X147-SSN TO WS-INPUT-SSN. CL126 00818 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL244 00819 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL244 00820 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL244 00821 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL244 00822 CL126 00823 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL244 00824 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL244 00825 * MOVE X147-FNAME TO WS-OUT-FNAME. CL244 00826 * MOVE X147-LNAME TO WS-OUT-LNAME. CL244 00827 * MOVE X147-WAGES TO WS-OUT-WAGES. CL244 00828 * IF WS-X144-SSN-FOUND = 1 CL244 00829 * MOVE 'Y ' TO WS-OUT-X144 CL244 00830 * ELSE CL244 00831 * MOVE 'N ' TO WS-OUT-X144. CL244 00832 * IF WS-X140-RPT-FOUND = 1 CL244 00833 * MOVE 'Y ' TO WS-OUT-X140 CL244 00834 * ELSE CL244 00835 * MOVE 'N ' TO WS-OUT-X140. CL244 00836 IF WS-CLAIM-SSN-FOUND = 1 CL205 00837 MOVE '++CLAIM FOUND WAGES REPLACED' TO WS-OUT-MESSAGE CL205 00838 ELSE CL205 00839 MOVE '++NO CLAIM -- WAGES REPLACED' TO WS-OUT-MESSAGE. CL205 00840 CL126 00841 ADD 1 TO LINE-COUNT. CL206 00842 WRITE PRINT-RECORD FROM WS-OUTPUT. CL206 00843 PROC2500-EXIT. CL*87 00844 EXIT. CL*87 00845 CL*87 00846 CL201 00847 PROC2550-DEL-SSN. CL201 00848 CL201 00849 * WRITE X147-RECORD-OUTA FROM X144-REC. CL201 00850 * WRITE X147-RECORD-OUTA FROM X147-REC. CL229 00851 ADD 1 TO WS-TOTAL-DELQ. CL201 00852 CL201 00853 IF WS-SAV-X147 = 1 CL201 00854 GO TO PROC2500-EXIT. CL201 00855 CL201 00856 MOVE X147-SSN TO WS-INPUT-SSN. CL201 00857 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 00858 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 00859 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 00860 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 00861 CL201 00862 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 00863 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 00864 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 00865 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 00866 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 00867 * IF WS-X144-SSN-FOUND = 1 CL245 00868 * MOVE 'Y ' TO WS-OUT-X144 CL245 00869 * ELSE CL245 00870 * MOVE 'N ' TO WS-OUT-X144. CL245 00871 * IF WS-X140-RPT-FOUND = 1 CL245 00872 * MOVE 'Y ' TO WS-OUT-X140 CL245 00873 * ELSE CL245 00874 * MOVE 'N ' TO WS-OUT-X140. CL245 00875 * MOVE 'WAGES ---DELETED ' TO WS-OUT-MESSAGE. CL245 00876 CL201 00877 ADD 1 TO LINE-COUNT. CL210 00878 WRITE PRINT-RECORD FROM WS-OUTPUT. CL210 00879 PROC2550-EXIT. CL201 00880 EXIT. CL201 00881 CL201 00882 CL123 00883 PROC2600-SAV-SSN. CL123 00884 CL123 00885 MOVE 0 TO WS-SAV-X147. CL129 00886 * WRITE X147-RECORD-OUTB FROM X147-REC. CL229 00887 MOVE X147-SSN TO WS-INPUT-SSN. CL126 00888 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 00889 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 00890 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 00891 * MOVE CPD-SSN-SEQ TO WS-OUT-SEQ. CL245 00892 CL126 00893 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 00894 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 00895 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 00896 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 00897 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 00898 * IF WS-X144-SSN-FOUND = 1 CL245 00899 * MOVE 'Y ' TO WS-OUT-X144 CL245 00900 * ELSE CL245 00901 * MOVE 'N ' TO WS-OUT-X144. CL245 00902 * IF WS-X140-RPT-FOUND = 1 CL245 00903 * MOVE 'Y ' TO WS-OUT-X140 CL245 00904 * ELSE CL245 00905 * MOVE 'N ' TO WS-OUT-X140. CL245 00906 * IF WRK-SEG01-SSN-FOUND = 0 CL245 00907 * MOVE '++ X147 NOT FOUND IN DOCS -ESSP VERIFY' CL245 00908 * TO WS-OUT-MESSAGE CL245 00909 * ELSE CL245 00910 * MOVE '++ CLAIM FOUND NO WAGES CANNOT DELETE ' CL245 00911 * TO WS-OUT-MESSAGE. CL245 00912 * MOVE 1 TO WS-SAV-X147. CL245 00913 * ADD 1 TO LINE-COUNT. CL245 00914 WRITE PRINT-RECORD FROM WS-OUTPUT. CL126 00915 PROC2600-EXIT. CL123 00916 EXIT. CL123 00917 CL123 00918 PROC2700-FIND-CLAIM. CL179 00919 MOVE X147-SSN TO WS-XSSN CL179 00920 MOVE WS-X147-SSN-NO TO DB-SSN. CL179 00921 MOVE ZERO TO DB-SEQ-9. CL179 00922 CL179 00923 MOVE ZEROS TO WS-HOLD-X147-SSN CL181 00924 SET DB-RANDOM-PROCESSING TO TRUE. CL180 00925 SET DB-READ-SEGMENT TO TRUE. CL180 00926 SET DB-CLAIMANT-PROFILE TO TRUE. CL181 00927 SET DB-RESET-POINTERS TO TRUE. CL184 00928 MOVE 'R' TO DB-PROCESSING-MODE. CL179 00929 MOVE 'SG01' TO DB-SEGNAME. CL179 00930 CL179 00931 PERFORM SERV1000-MASTER THRU CL179 00932 SERV1000-EXIT. CL179 00933 CL179 00934 IF DB-END-OF-FILE CL194 00935 DISPLAY '++ESSN NOT FOUND ON DOCS - DELETE ' X147-SSN CL195 00936 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL194 00937 GO TO PROC2700-EXIT. CL194 00938 CL179 00939 IF DB-NO-RECORD-FOUND CL186 00940 DISPLAY '++DSSN NOT FOUND ON DOCS - DELETE ' X147-SSN CL195 00941 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL187 00942 GO TO PROC2700-EXIT. CL179 00943 CL181 00944 PERFORM UNTIL DB-NO-RECORD-FOUND OR CPD-SSN > X147-SSN CL186 00945 * PERFORM UNTIL NOT DB-SUCCESSFUL-COMPLETION CL185 00946 * ADD +1 TO WRK-SEG01-READ-CNT CL183 00947 PERFORM P2750-PROCESS-CLAIM THRU P2750-EXIT CL181 00948 SET DB-SEQUENTIAL-PROCESSING TO TRUE CL181 00949 SET DB-CLAIMANT-PROFILE TO TRUE CL181 00950 SET DB-READ-SEGMENT TO TRUE CL181 00951 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION CL181 00952 END-PERFORM. CL181 00953 CL181 00954 CL181 00955 PROC2700-EXIT. CL181 00956 EXIT. CL181 00957 CL179 00958 P2750-PROCESS-CLAIM. CL181 00959 IF CPD-ALTERNATE-BASE-YES CL179 00960 MOVE CPD-ALT-BASE-PERIOD-QTR TO WS-DOCS-BASE-QTR CL179 00961 ELSE CL179 00962 MOVE CPD-BASE-PERIOD-QTR-CODE TO WS-DOCS-BASE-QTR. CL179 00963 CL179 00964 IF WS-DOCS-BASE-QTR-Q = 1 CL188 00965 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR1 CL188 00966 ADD +1 TO WS-DOCS-BASE-QTR1-Q CL189 00967 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR2 CL188 00968 ADD +2 TO WS-DOCS-BASE-QTR2-Q CL189 00969 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR3 CL188 00970 ADD +3 TO WS-DOCS-BASE-QTR3-Q CL189 00971 ELSE CL188 00972 IF WS-DOCS-BASE-QTR-Q = 2 CL188 00973 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR1 CL188 00974 ADD +1 TO WS-DOCS-BASE-QTR1-Q CL189 00975 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR2 CL188 00976 ADD +2 TO WS-DOCS-BASE-QTR2-Q CL189 00977 ADD +1 TO WS-DOCS-BASE-QTR-Y CL188 00978 MOVE +1 TO WS-DOCS-BASE-QTR-Q CL188 00979 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR3 CL188 00980 ELSE CL188 00981 IF WS-DOCS-BASE-QTR-Q = 3 CL188 00982 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR1 CL188 00983 ADD +1 TO WS-DOCS-BASE-QTR1-Q CL189 00984 ADD +1 TO WS-DOCS-BASE-QTR-Y CL188 00985 MOVE +1 TO WS-DOCS-BASE-QTR-Q CL188 00986 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR2 CL188 00987 ADD +1 TO WS-DOCS-BASE-QTR-Q CL188 00988 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR3 CL188 00989 ELSE CL188 00990 IF WS-DOCS-BASE-QTR-Q = 4 CL188 00991 ADD +1 TO WS-DOCS-BASE-QTR-Y CL188 00992 MOVE +1 TO WS-DOCS-BASE-QTR-Q CL188 00993 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR1 CL188 00994 ADD +1 TO WS-DOCS-BASE-QTR-Q CL188 00995 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR2 CL188 00996 ADD +1 TO WS-DOCS-BASE-QTR-Q CL188 00997 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR3. CL188 00998 CL188 00999 MOVE X147-QUARTER TO WS-X147-QTR-ESSP. CL179 01000 MOVE WS-X147-EYY TO WS-X147-YY CL179 01001 MOVE WS-X147-EQ TO WS-X147-Q CL179 01002 CL179 01003 IF CPD-ALTERNATE-BASE-YES CL193 01004 MOVE CPD-ALT-BASE-PERIOD-QTR TO WS-DOCS-BASE-QTR CL193 01005 ELSE CL193 01006 MOVE CPD-BASE-PERIOD-QTR-CODE TO WS-DOCS-BASE-QTR. CL193 01007 CL194 01008 DISPLAY ' DOCS BASE QTR: ' WS-DOCS-BASE-QTR. CL193 01009 DISPLAY ' CPD BASE QTR: ' CPD-BASE-PERIOD-QTR-CODE CL193 01010 DISPLAY ' CPD ALTB QTR: ' CPD-ALT-BASE-PERIOD-QTR. CL193 01011 CL193 01012 DISPLAY '*ESSP: ' X147-SSN ' ' WS-X147-QTR-DELETE CL194 01013 DISPLAY 'DOCSB: ' CPD-SSN ' ' WS-DOCS-BASE-QTR CL184 01014 DISPLAY 'DOCS1: ' CPD-SSN ' ' WS-DOCS-BASE-QTR1 CL186 01015 DISPLAY 'DOCS2: ' CPD-SSN ' ' WS-DOCS-BASE-QTR2 CL186 01016 DISPLAY 'DOCS3: ' CPD-SSN ' ' WS-DOCS-BASE-QTR3. CL186 01017 CL179 01018 IF WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR OR CL179 01019 WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR1 OR CL179 01020 WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR2 OR CL179 01021 WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR3 CL179 01022 MOVE X147-SSN TO WS-HOLD-X147-SSN CL179 01023 SET DB-NO-RECORD-FOUND TO TRUE CL185 01024 MOVE 1 TO WS-CLAIM-SSN-FOUND CL186 01025 DISPLAY '## SSN FOUND ON DOCS - BASE CLAIM ' X147-SSN. CL195 01026 CL179 01027 CL179 01028 P2750-EXIT. CL181 01029 EXIT. CL179 01030 ******************************************************************DTSBX629 01031 * PROC3000-READ-MASTER-FILE *DTSBX629 01032 ******************************************************************DTSBX629 01033 DTSBX629 01034 PROC3000-READ-MASTER-FILE. DTSBX629 01035 DTSBX629 01036 MOVE 0 TO WS-X144-SSN-FOUND. CL116 01037 MOVE 0 TO WS-X140-RPT-FOUND. CL138 01038 CL116 01039 READ X144SSN-IN INTO Z144-REC CL239 01040 AT END DTSBX629 01041 MOVE 'Y' TO MASTER-END-IND CL*63 01042 GO TO PROC3000-READ-EXIT. DTSBX629 01043 DTSBX629 01044 * IF X147-EMP-NO = WS-X147-EMP-NO CL227 01045 * AND X147-QUARTER = WS-X147-QUARTER CL227 01046 * MOVE 3 TO WS-X144-SSN-FOUND CL227 01047 * ELSE CL227 01048 * MOVE X147-SSN TO WS-X147-SSN CL227 01049 * MOVE X147-EMP-NO TO WS-X147-EMP-NO CL227 01050 * MOVE X147-QUARTER TO WS-X147-QUARTER. CL227 01051 ADD 1 TO MASTER-READ-COUNT. DTSBX629 01052 DTSBX629 01053 PROC3000-READ-EXIT. DTSBX629 01054 EXIT. DTSBX629 01055 DTSBX629 01056 DTSBX629 01057 ******************************************************************DTSBX629 01058 * PROC4000-SEARCH-SEG04 * CL*87 01059 ******************************************************************DTSBX629 01060 DTSBX629 01061 PROC4000-SEARCH-SEG04. CL*87 01062 DTSBX629 01063 SET DB-RANDOM-PROCESSING TO TRUE. CL195 01064 * SET DB-READ-SEGMENT TO TRUE. CL199 01065 SET DB-BASE-PERIOD-EMP TO TRUE. CL195 01066 SET DB-RESET-POINTERS TO TRUE. CL195 01067 * MOVE X147-EMP-NO TO BPE-EMPLOYER-ACCT CL199 01068 MOVE 'SG04' TO DB-SEGNAME. CL*87 01069 DTSBX629 01070 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL195 01071 CL195 01072 * PERFORM SERV1000-MASTER THRU CL195 01073 * SERV1000-EXIT. CL195 01074 DTSBX629 01075 DISPLAY 'BPE EMP NO: ' BPE-EMPLOYER-ACCT CL197 01076 * IF DB-NO-RECORD-FOUND OR DB-END-OF-FILE CL200 01077 * DISPLAY '#1 EMP NOT FOUND ON DOCS CLAIM: ' X147-EMP-NO CL200 01078 * MOVE 1 TO ENDOFSEG CL200 01079 * GO TO PROC4000-SEG04-EXIT. CL200 01080 CL195 01081 PERFORM UNTIL DB-NO-RECORD-FOUND OR CL199 01082 DB-END-OF-FILE CL199 01083 SET DB-RANDOM-PROCESSING TO TRUE CL201 01084 * SET DB-SEQUENTIAL-PROCESSING TO TRUE CL201 01085 SET DB-BASE-PERIOD-EMP TO TRUE CL195 01086 SET DB-READ-SEGMENT TO TRUE CL195 01087 CL195 01088 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION CL195 01089 CL197 01090 * DISPLAY 'BPE EMP NO: ' BPE-EMPLOYER-ACCT CL199 01091 IF DB-SUCCESSFUL-COMPLETION AND CL197 01092 BPE-EMPLOYER-ACCT = X147-EMP-NO CL197 01093 DISPLAY '## BPEEMP FOUND ON DOCS CLAIM: ' X147-EMP-NO CL199 01094 MOVE 1 TO ENDOFSEG CL197 01095 MOVE X147-EMP-NO TO WS-HOLD-X147-EMP-NO CL197 01096 MOVE 'Y' TO EMPLOYER-FOUND-IND CL198 01097 SET DB-END-OF-FILE TO TRUE CL197 01098 SET DB-NO-RECORD-FOUND TO TRUE CL197 01099 ELSE CL195 01100 IF NOT DB-NO-RECORD-FOUND OR CL197 01101 DB-END-OF-FILE CL199 01102 * BPE-EMPLOYER-ACCT > X147-EMP-NO CL199 01103 DISPLAY '#2 EMP NOT FOUND ON DOCS CLAIM: ' X147-EMP-NO CL200 01104 SET DB-END-OF-FILE TO TRUE CL197 01105 SET DB-NO-RECORD-FOUND TO TRUE CL197 01106 END-IF CL195 01107 END-IF CL195 01108 CL195 01109 END-PERFORM. CL195 01110 DTSBX629 01111 * IF BPE-EMPLOYER-ACCT = X147-EMP-NO CL197 01112 * MOVE 1 TO ENDOFSEG CL197 01113 * MOVE X147-EMP-NO TO WS-HOLD-X147-EMP-NO CL197 01114 * MOVE 'Y' TO EMPLOYER-FOUND-IND. CL197 01115 CL*25 01116 PROC4000-SEG04-EXIT. CL*87 01117 EXIT. DTSBX629 01118 DTSBX629 01119 ******************************************************************DTSBX629 01120 * PROC5000-WRITE-RECORD-PAID *DTSBX629 01121 ******************************************************************DTSBX629 01122 DTSBX629 01123 DTSBX629 01124 PROC5000-X147-NOT-DELETED. CL*94 01125 MOVE X147-SSN TO WS-INPUT-SSN. CL*92 01126 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 01127 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 01128 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 01129 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 01130 * CL245 01131 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 01132 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 01133 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 01134 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 01135 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 01136 * MOVE 'Y ' TO WS-OUT-X144. CL245 01137 * MOVE '++ CLAIM FOUND ON DOCS - VERIFY' TO WS-OUT-MESSAGE. CL245 01138 DTSBX629 01139 * IF LINE-COUNT GREATER 55 CL*74 01140 * MOVE ZEROES TO LINE-COUNT CL*74 01141 ADD 1 TO LINE-COUNT. CL126 01142 WRITE PRINT-RECORD FROM WS-OUTPUT. CL*92 01143 PROC5000-EXIT. CL*94 01144 EXIT. DTSBX629 01145 DTSBX629 01146 CL*69 01147 S910-OPEN-READ. CL**4 01148 SET L910-OPEN-READ-88 TO TRUE. CL**4 01149 GO TO S910-MSTR-IO. CL**4 01150 CL**4 01151 S910-READ. CL**4 01152 SET L910-READ-88 TO TRUE. CL**4 01153 GO TO S910-MSTR-IO. CL**4 01154 CL**4 01155 S910-START-BROWSE. CL**4 01156 SET L910-START-BROWSE-88 TO TRUE. CL**4 01157 GO TO S910-MSTR-IO. CL**4 01158 CL**4 01159 S910-READ-NEXT. CL**4 01160 SET L910-READ-NEXT-88 TO TRUE. CL**4 01161 GO TO S910-MSTR-IO. CL**4 01162 CL**4 01163 S910-CLOSE. CL**4 01164 SET L910-CLOSE-88 TO TRUE. CL**4 01165 GO TO S910-MSTR-IO. CL**4 01166 CL**4 01167 S910-MSTR-IO. CL**4 01168 CALL 'DTSBU910' USING L910-LINK-AREA CL**4 01169 MSKL-REC. CL**4 01170 S910-EXIT. CL**4 01171 EXIT. CL**4 01172 CL**4 01173 S001-FROM-CAL-6. CL**4 01174 SET L001-FROM-CAL-6 TO TRUE. CL*55 01175 GO TO S001-DATE-CONVERT. CL*55 01176 CL*55 01177 S001-FROM-ABS-DAY. CL*55 01178 SET L001-FROM-ABS-DAY TO TRUE. CL*55 01179 GO TO S001-DATE-CONVERT. CL*55 01180 CL*55 01181 S001-DATE-CONVERT. CL*55 01182 CALL 'DTSBU001' USING L001-LINK-AREA. CL*55 01183 S001-EXIT. CL*55 01184 EXIT. CL*55 01185 SKIP3 CL*55 01186 S999-ABEND. CL*55 01187 DISPLAY '*** ' CL*55 01188 WRK-MODULE-NAME CL*55 01189 ' IS ABENDING: ' CL*55 01190 WRK-ABEND-MSG. CL*55 01191 CL*55 01192 CALL 'DTSBU999' USING WRK-ABEND-CD. CL*55 01193 S999-EXIT. CL*55 01194 EXIT. CL*55 01195 ******************************************************************DTSBX629 01196 * READ FILES *DTSBX629 01197 ******************************************************************DTSBX629 01198 CL145 01199 S960-SEG01. CL145 01200 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK CL145 01201 WGP-SEGMENT-ONE. CL145 01202 S960-EXIT. CL145 01203 EXIT. CL145 01204 S961-SEG02. CL145 01205 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK CL145 01206 WGD-SEGMENT-TWO. CL145 01207 S961-EXIT. CL145 01208 EXIT. CL145 01209 DTSBX629 01210 ******************************************************************DTSBX629 01211 * SERVICE ROUTINES *DTSBX629 01212 ******************************************************************DTSBX629 01213 DTSBX629 01214 SERV1000-MASTER. DTSBX629 01215 DTSBX629 01216 MOVE 'R' TO DB-COMMAND-CODE. DTSBX629 01217 DTSBX629 01218 MOVE 'DTSBX551' TO DB-PROGRAM-NAME. CL195 01219 DTSBX629 01220 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. DTSBX629 01221 DTSBX629 01222 SERV1000-EXIT. DTSBX629 01223 EXIT. DTSBX629 01224 CL119 01225 SERV2000-MASTER. CL119 01226 CL119 01227 MOVE 'S' TO DB-COMMAND-CODE. CL119 01228 CL119 01229 MOVE 'DTSBX551' TO DB-PROGRAM-NAME. CL195 01230 CL119 01231 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL119 01232 CL119 01233 SERV2000-EXIT. CL119 01234 EXIT. CL119 01235 S9999-ABEND. CL*78 01236 SKIP1 CL*78 01237 CALL 'DTSBU999' USING WRK-ABEND-CODE. CL*78 01238 SKIP1 CL*78 01239 S9999-EXIT. CL*78 01240 EXIT. CL*78