1242 lines
98 KiB
COBOL
1242 lines
98 KiB
COBOL
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
|