945 lines
75 KiB
COBOL
945 lines
75 KiB
COBOL
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
|