00001 IDENTIFICATION DIVISION. 03/21/12 00002 PROGRAM-ID. DTSBE351. DTSBE351 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV026 00004 DATE-WRITTEN. AUGUST 1994. DTSBE351 00005 DATE-COMPILED. DTSBE351 00006 SKIP3 DTSBE351 00007 ***** DTSBE351 00008 * DTSBE351 00009 * FUNCTION: EMPLOYER REPORT MASS MAILING EXTRACT. DTSBE351 00010 * DTSBE351 00011 * DTSBE351 00012 * MODIFICATION LOG: DTSBE351 00013 * DTSBE351 00014 * 05/23/96 NEW LOGIC ADDED FOR PROCESSING ELECTRONIC FILING DTSBE351 00015 * UC-30. DTSBE351 00016 * WORK ORDER: NONE PROGRAMMER: SFW DTSBE351 00017 * DTSBE351 00018 * 08/06/96 RECOMPILED BECAUSE R902-ELF-ADD-88 ADDED TO DAILY DTSBE351 00019 * SORT IN DTSIR902. DTSBE351 00020 * REFERENCE RFP: #WARPII PROGRAMMER: MJA DTSBE351 00021 * DTSBE351 00022 * 12/02/96 ADDED R908-ELECTRONIC-FILER-IND TO R908 SORT AREA DTSBE351 00023 * ADDED CODE TO P2000-SETUP-BASIC-R902 PARAGRAPH DTSBE351 00024 * SINCE THAT IS WHERE THE ELF RECORDS ARE READ. DTSBE351 00025 * REFERENCE RFP: #WARP II PROGRAMMER: MJA DTSBE351 00026 * DTSBE351 00027 * 03/03/1999 REVIEWED AND MODIFIED FOR DC. DTSBE351 00028 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBE351 00029 * DTSBE351 00030 * 05/24/1999 PICKUP MODIFICATION. PARM YRQ >= LECM-PICKUP- DTSBE351 00031 * YRQ. DTSBE351 00032 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBE351 00033 * DTSBE351 00034 * 06/03/1999 MODIFIED R902 GENERATION FOR DC REQUIREMENTS. DTSBE351 00035 * REFERENCE: DIR 68 PROGRAMMER: GD DTSBE351 00036 * DTSBE351 00037 * 12/08/1999 ADD LECM-PARM-DISP-CREDIT-IND. SUPPRESSES DTSBE351 00038 * PRINTING OF CREDIT AMOUNTS FOR ALL EMPLOYERS. DTSBE351 00039 * REFERENCE: PROGRAMMER: GD DTSBE351 00040 * DTSBE351 00041 * 09/06/2000 ADDED CODE TO READ MFAE TYPE 1 (UC30) RECORD. DTSBE351 00042 * IF RECORD IS FOUND, UC30 WILL NOT BE PRINTED. DTSBE351 00043 * REFERENCE: PROGRAMMER: ZL1 DTSBE351 00044 * DTSBE351 00045 * 12/11/2001 ADDED CODE TO BYPASS HOUSEHOLD EMPLOYERS DTSBE351 00046 * FILING ANNUALLY. DTSBE351 00047 * REFERENCE: PROGRAMMER: ZL1 DTSBE351 00048 * DTSBE351 00049 * 08/14/2002 RECOMPILED FOR NEW VERSION OF DTSIL516. THE DTSBE351 00050 * PROGRAM WILL TREAT EMPLOYERS WITH ESTIMATED DTSBE351 00051 * RATES AS IF THERE WERE NO RATE ON FILE: IT DTSBE351 00052 * IT NOT SEND A UC30, AND WILL WRITE AN R907 DTSBE351 00053 * ERROR MESSAGE. DTSBE351 00054 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBE351 00055 * DTSBE351 00056 * DTSBE351 00057 * 10/10/2007 ADDED CODE TO BYPASS ICESA EMPLOYERS. DO NOT DTSBE351 00058 * PRINT UC30 FOR EMPLOYERS FILING ICESA REPORT. DTSBE351 00059 * REFERENCE: PROGRAMMER: ZL1 DTSBE351 00060 * DTSBE351 00061 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE351 00062 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE351 00063 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE351 00064 * DTSBE351 00065 * DTSBE351 00066 * DESCRIPTION: DTSBE351 00067 * DTSBE351 00068 * DTSBE351 00069 * INITIATION: DTSBE351 00070 * DTSBE351 00071 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE351 00072 * SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE351 00073 * DTSBE351 00074 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUTS DTSBE351 00075 * DESCRIPTIONS AND LAYOUTS (902R1 AND 902R2). DTSBE351 00076 * DTSBE351 00077 * IF WRK-PARM-SUBJECT-YRQ IS GREATER THAN DTSBE351 00078 * LECM-LAST-UC30-MASS-MAIL-YRQ THEN MOVE DTSBE351 00079 * WRK-PARM-SUBJECT-YRQ TO LECM-LAST-UC30-MASS-MAIL-YRQ. DTSBE351 00080 * DTSBE351 00081 * READ FCYR RECORD (TO LOOKUP WRK-TAX-WAGE-BASE). DTSBE351 00082 * DTSBE351 00083 * DTSBE351 00084 * PROCESSING: DTSBE351 00085 * DTSBE351 00086 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (719R1, DTSBE351 00087 * 902R1, 902R2, AND 908R1). DTSBE351 00088 * DTSBE351 00089 * DTSBE351 00090 * TERMINATION: DTSBE351 00091 * DTSBE351 00092 * READ THE MHDR RECORD. IF WRK-PARM-SUBJECT-YRQ IS DTSBE351 00093 * GREATER THAN MHDR-LAST-UC30-MASS-MAIL-YRQ THEN MOVE DTSBE351 00094 * WRK-PARM-SUBJECT-YRQ TO MHDR-LAST-UC30-MASS-MAIL-YRQ DTSBE351 00095 * AND REWRITE THE MHDR-RECORD. DTSBE351 00096 * DTSBE351 00097 * READ FQTR RECORD FOR WRK-PARM-SUBJECT-YRQ. IF FOUND, DTSBE351 00098 * REWRITE; IF NOT FOUND, CREATE A FQTR RECORD AND WRITE. DTSBE351 00099 * MOVE LECM-CURR-RUN-DATE TO FQTR-UC30-MASS-MAIL-DATE. DTSBE351 00100 * DTSBE351 00101 * DTSBE351 00102 * RECORDS READ: DTSBE351 00103 * DTSBE351 00104 * MASTER: DTSBE351 00105 * DTSBE351 00106 * MHDR DTSBE351 00107 * MQTR DTSBE351 00108 * MFAE DTSBE351 00109 * DTSBE351 00110 * ALTERNATE INDEX: DTSBE351 00111 * DTSBE351 00112 * NONE. DTSBE351 00113 * DTSBE351 00114 * DTSBE351 00115 * REFERENCE: DTSBE351 00116 * DTSBE351 00117 * FCYR DTSBE351 00118 * FQTR DTSBE351 00119 * DTSBE351 00120 * DTSBE351 00121 * RECORDS UPDATED: DTSBE351 00122 * DTSBE351 00123 * MHDR (REWRITE) DTSBE351 00124 * FQTR (WRITE, REWRITE) DTSBE351 00125 * DTSBE351 00126 * DTSBE351 00127 * REPORT RECORDS WRITTEN: DTSBE351 00128 * DTSBE351 00129 * R719 RQC CONTRIBUTION REPORT UNIVERSE. DTSBE351 00130 * R902 EMPLOYER'S QUARTERLY WAGE REPORT. DTSBE351 00131 * R907 UNUSUAL CONDITIONS ENCOUNTERED REPORT. DTSBE351 00132 * R908 UC-30 COUNTS LIST. DTSBE351 00133 * DTSBE351 00134 * DTSBE351 00135 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE351 00136 * DTSBE351 00137 * NONE. DTSBE351 00138 * DTSBE351 00139 * DTSBE351 00140 * MODULES CALLED: DTSBE351 00141 * DTSBE351 00142 * DTSBU001 DATE CONVERSION/EDIT. DTSBE351 00143 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE351 00144 * DTSBU111 ADDRESS LOOKUP. DTSBE351 00145 * DTSBU112 ADDRESS FORMAT. DTSBE351 00146 * DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE DTSBE351 00147 * FOR A GIVEN QUARTER. DTSBE351 00148 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE351 00149 * DTSBU931 REFERENCE FILE I/O DRIVER. DTSBE351 00150 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE351 00151 * DTSBE351 00152 * DTSBE351 00153 ***** DTSBE351 00154 SKIP3 DTSBE351 00155 ENVIRONMENT DIVISION. DTSBE351 00156 EJECT DTSBE351 00157 DATA DIVISION. DTSBE351 00158 SKIP3 DTSBE351 00159 WORKING-STORAGE SECTION. DTSBE351 001595 77 PAN-VALET PICTURE X(24) VALUE '026DTSBE351 03/21/12'. DTSBE351 00160 SKIP3 DTSBE351 00161 01 WRK-AREA. DTSBE351 00162 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +351. DTSBE351 00163 DTSBE351 00164 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE351'. DTSBE351 00165 DTSBE351 00166 DTSBE351 00167 05 ABEND-MSG PIC X(60). DTSBE351 00168 DTSBE351 00169 DTSBE351 00170 05 WRK-PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE351 00171 05 WRK-LAST-UC30-MAIL-YRQ PIC S9(05) COMP-3. DTSBE351 00172 DTSBE351 00173 DTSBE351 00174 05 WRK-UC30-SKIP-IND PIC X(08). DTSBE351 00175 88 WRK-UC30-SKIP-MAG-88 VALUE 'MAG UC30'. DTSBE351 00176 88 WRK-UC30-SKIP-WEB-88 VALUE 'WEB UC30'. DTSBE351 00177 88 WRK-UC30-SKIP-VALID-88 VALUE 'WEB UC30', DTSBE351 00178 'MAG UC30'. DTSBE351 00179 05 WRK-UC30-SKIP-88 PIC X(01). DTSBE351 00180 88 WRK-UC30-SKIP-YES-88 VALUE 'Y'. DTSBE351 00181 88 WRK-UC30-SKIP-NO-88 VALUE 'N'. DTSBE351 00182 DTSBE351 00183 05 WRK-PARM-DISP-CREDIT-IND PIC X(01). DTSBE351 00184 88 WRK-PARM-DISP-CREDIT-YES-88 VALUE 'Y'. DTSBE351 00185 88 WRK-PARM-DISP-CREDIT-NO-88 VALUE 'N'. DTSBE351 00186 88 WRK-PARM-DISP-CREDIT-VALID-88 VALUE 'Y', 'N'. DTSBE351 00187 DTSBE351 00188 DTSBE351 00189 05 WRK-TAX-WAGE-BASE PIC S9(07)V9(02) COMP-3. DTSBE351 00190 DTSBE351 00191 05 TOT-MPRF-READ PIC 9(05) VALUE ZEROS. DTSBE351 00192 05 TOT-MPRF-READ-NOT-ACTIVE PIC 9(05) VALUE ZEROS. DTSBE351 00193 05 TOT-MPRF-READ-NOT-LIABLE PIC 9(05) VALUE ZEROS. DTSBE351 00194 05 TOT-MPRF-READ-ANN-FILER PIC 9(05) VALUE ZEROS. DTSBE351 00195 05 TOT-MPRF-READ-PEND-SCHED PIC 9(05) VALUE ZEROS. DTSBE351 00196 05 TOT-MPRF-READ-RPT-TYPE PIC 9(05) VALUE ZEROS. DTSBE351 00197 05 TOT-MPRF-READ-NO-RATE PIC 9(05) VALUE ZEROS. DTSBE351 00198 05 TOT-MPRF-RETN-NO-MAIL PIC 9(05) VALUE ZEROS. DTSBE351 00199 05 TOT-MPRF-READ-NO-MAIL PIC 9(05) VALUE ZEROS. DTSBE351 00200 05 TOT-MPRF-READ-MAG-UC30 PIC 9(05) VALUE ZEROS. DTSBE351 00201 05 TOT-MPRF-READ-NOT-UC30 PIC 9(05) VALUE ZEROS. DTSBE351 00202 05 TOT-MPRF-READ-R902 PIC 9(05) VALUE ZEROS. DTSBE351 00203 DTSBE351 00204 05 WRK-SLASH-QTR PIC X(04). DTSBE351 00205 DTSBE351 00206 05 WRK-EDIT-STATUS-IND PIC X(01). DTSBE351 00207 88 WRK-EDIT-PASSED-88 VALUE 'Y'. DTSBE351 00208 88 WRK-EDIT-FAILED-88 VALUE 'N'. DTSBE351 00209 DTSBE351 00210 DTSBE351 00211 DTSBE351 00212 05 WRK-MFAE-IND PIC X(01). DTSBE351 00213 88 WRK-MFAE-FOUND-88 VALUE 'Y'. DTSBE351 00214 88 WRK-MFAE-NOT-FOUND-88 VALUE 'N'. DTSBE351 00215 DTSBE351 00216 05 WRK-MQTR-IND PIC X(01). DTSBE351 00217 88 WRK-MQTR-FOUND-88 VALUE 'Y'. DTSBE351 00218 88 WRK-MQTR-NOT-FOUND-88 VALUE 'N'. DTSBE351 00219 EJECT DTSBE351 00220 01 MSG-AREA. DTSBE351 00221 05 MSG1-AREA. DTSBE351 00222 10 MSG1-ID PIC X(03) VALUE '393'. DTSBE351 00223 10 MSG1-TEXT. DTSBE351 00224 15 FILLER PIC X(40) DTSBE351 00225 VALUE 'RATE MISSING. NO QUARTERLY REPORT PRINT'. DTSBE351 00226 15 FILLER PIC X(40) DTSBE351 00227 VALUE 'ED FROM UC-30 MASS MAILING RUN. YRQ = '. DTSBE351 00228 15 MSG1-SLASHED-YRQ PIC X(04). DTSBE351 00229 EJECT DTSBE351 00230 01 L001-LINK-AREA. DTSBE351 00231 ++INCLUDE DTSIL001 DTSBE351 00232 EJECT DTSBE351 00233 01 L004-LINK-AREA. DTSBE351 00234 ++INCLUDE DTSIL004 DTSBE351 00235 EJECT DTSBE351 00236 01 L111-LINK-AREA. DTSBE351 00237 ++INCLUDE DTSIL111 DTSBE351 00238 EJECT DTSBE351 00239 01 L112-LINK-AREA. DTSBE351 00240 ++INCLUDE DTSIL112 DTSBE351 00241 EJECT DTSBE351 00242 01 L516-LINK-AREA. DTSBE351 00243 ++INCLUDE DTSIL516 DTSBE351 00244 EJECT DTSBE351 00245 01 L910-LINK-AREA. DTSBE351 00246 ++INCLUDE DTSIL910 DTSBE351 00247 SKIP3 DTSBE351 00248 01 MSKL-REC. DTSBE351 00249 ++INCLUDE DTSIMSKL DTSBE351 00250 EJECT DTSBE351 00251 01 MRPT-REC. DTSBE351 00252 ++INCLUDE DTSIMRPT DTSBE351 00253 EJECT DTSBE351 00254 01 MHDR-REC. DTSBE351 00255 ++INCLUDE DTSIMHDR DTSBE351 00256 EJECT DTSBE351 00257 01 MELF-REC. DTSBE351 00258 ++INCLUDE DTSIMELF DTSBE351 00259 EJECT DTSBE351 00260 01 MQTR-REC. DTSBE351 00261 ++INCLUDE DTSIMQTR DTSBE351 00262 EJECT DTSBE351 00263 *01 MTNM-REC. DTSBE351 00264 ***INCLUDE DTSIMTNM DTSBE351 00265 EJECT DTSBE351 00266 *01 MTCK-REC. DTSBE351 00267 ***INCLUDE DTSIMTCK DTSBE351 00268 EJECT DTSBE351 00269 01 L931-LINK-AREA. DTSBE351 00270 ++INCLUDE DTSIL931 DTSBE351 00271 EJECT DTSBE351 00272 01 FSKL-REC. DTSBE351 00273 ++INCLUDE DTSIFSKL DTSBE351 00274 EJECT DTSBE351 00275 01 FCYR-REC. DTSBE351 00276 ++INCLUDE DTSIFCYR DTSBE351 00277 EJECT DTSBE351 00278 01 FQTR-REC. DTSBE351 00279 ++INCLUDE DTSIFQTR DTSBE351 00280 EJECT DTSBE351 00281 01 MFAE-REC. DTSBE351 00282 ++INCLUDE DTSIMFAE DTSBE351 00283 EJECT DTSBE351 00284 01 R719-REC. DTSBE351 00285 ++INCLUDE DTSIR719 DTSBE351 00286 SKIP3 DTSBE351 00287 01 R902-REC. DTSBE351 00288 ++INCLUDE DTSIR902 DTSBE351 00289 SKIP3 DTSBE351 00290 01 R907-REC. DTSBE351 00291 ++INCLUDE DTSIR907 DTSBE351 00292 SKIP3 DTSBE351 00293 01 R908-REC. DTSBE351 00294 ++INCLUDE DTSIR908 DTSBE351 00295 EJECT DTSBE351 00296 LINKAGE SECTION. DTSBE351 00297 DTSBE351 00298 01 LECM-LINK-AREA. DTSBE351 00299 ++INCLUDE DTSILECM DTSBE351 00300 DTSBE351 00301 DTSBE351 00302 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE351 00303 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE351 00304 15 FILLER PIC X(01). DTSBE351 00305 15 LECM-PARM-DISP-CREDIT-IND PIC X(01). DTSBE351 00306 88 LECM-PARM-DISP-CREDIT-YES-88 VALUE 'Y'. DTSBE351 00307 88 LECM-PARM-DISP-CREDIT-NO-88 VALUE 'N'. DTSBE351 00308 15 FILLER PIC X(63). DTSBE351 00309 EJECT DTSBE351 00310 01 MPRF-LINK-REC. DTSBE351 00311 ++INCLUDE DTSIMPRF DTSBE351 00312 EJECT DTSBE351 00313 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE351 00314 MPRF-LINK-REC. DTSBE351 00315 DTSBE351 00316 EVALUATE TRUE DTSBE351 00317 WHEN LECM-PROCESS-88 DTSBE351 00318 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE351 00319 DTSBE351 00320 WHEN LECM-INITIALIZE-88 DTSBE351 00321 SET WRK-EDIT-PASSED-88 TO TRUE DTSBE351 00322 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE351 00323 IF WRK-EDIT-FAILED-88 DTSBE351 00324 PERFORM S999-ABEND THRU S999-EXIT DTSBE351 00325 END-IF DTSBE351 00326 DTSBE351 00327 WHEN LECM-TERMINATE-88 DTSBE351 00328 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE351 00329 DTSBE351 00330 WHEN OTHER DTSBE351 00331 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE351 00332 TO ABEND-MSG DTSBE351 00333 PERFORM S999-ABEND THRU S999-EXIT. DTSBE351 00334 DTSBE351 00335 DTSBE351 00336 GOBACK. DTSBE351 00337 EJECT DTSBE351 00338 I0000-INITIALIZE. DTSBE351 00339 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE351 00340 L931-TRACE-IND DTSBE351 00341 L516-TRACE-IND. DTSBE351 00342 DTSBE351 00343 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE351 00344 L931-MOD-NAME DTSBE351 00345 R907-MODULE-NAME. DTSBE351 00346 DTSBE351 00347 DTSBE351 00348 MOVE LENGTH OF R719-REC TO R719-LENGTH. DTSBE351 00349 DTSBE351 00350 MOVE LENGTH OF R902-REC TO R902-LENGTH. DTSBE351 00351 DTSBE351 00352 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE351 00353 DTSBE351 00354 MOVE LENGTH OF R908-REC TO R908-LENGTH. DTSBE351 00355 DTSBE351 00356 DTSBE351 00357 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE351 00358 DTSBE351 00359 DTSBE351 00360 IF WRK-PARM-SUBJECT-YRQ > LECM-LAST-UC30-MASS-MAIL-YRQ DTSBE351 00361 MOVE WRK-PARM-SUBJECT-YRQ DTSBE351 00362 TO LECM-LAST-UC30-MASS-MAIL-YRQ. DTSBE351 00363 DTSBE351 00364 DTSBE351 00365 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSBE351 00366 DTSBE351 00367 SET FCYR-CYR-88 TO TRUE. DTSBE351 00368 DTSBE351 00369 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9. DTSBE351 00370 DTSBE351 00371 MOVE L004-QTR-5-YR TO FCYR-YR. DTSBE351 00372 DTSBE351 00373 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSBE351 00374 DTSBE351 00375 PERFORM S931-READ THRU S931-EXIT. DTSBE351 00376 DTSBE351 00377 IF L931-NO-REC-88 DTSBE351 00378 MOVE 'TAXABLE WAGE BASE NOT FOUND' DTSBE351 00379 TO ABEND-MSG DTSBE351 00380 PERFORM S999-ABEND THRU S999-EXIT. DTSBE351 00381 DTSBE351 00382 MOVE FSKL-REC TO FCYR-REC. DTSBE351 00383 DTSBE351 00384 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE. DTSBE351 00385 DTSBE351 00386 DTSBE351 00387 SET LECM-MST-OPEN-UPDATE-HDR-88 TO TRUE. DTSBE351 00388 DTSBE351 00389 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE351 00390 I0000-EXIT. DTSBE351 00391 EXIT. DTSBE351 00392 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE351 00393 PERFORM I1100-SUBJECT-YRQ THRU I1100-EXIT. DTSBE351 00394 PERFORM I1200-DISPLAY-CREDIT THRU I1200-EXIT. DTSBE351 00395 I1000-EXIT. DTSBE351 00396 EXIT. DTSBE351 00397 SKIP3 DTSBE351 00398 I1100-SUBJECT-YRQ. DTSBE351 00399 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE351 00400 MOVE LECM-LAST-UC30-MASS-MAIL-YRQ TO L004-QTR-5-9 DTSBE351 00401 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE351 00402 ADD +1 TO L004-ABS-QTR DTSBE351 00403 PERFORM S004-FROM-ABS THRU S004-EXIT DTSBE351 00404 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE351 00405 ELSE DTSBE351 00406 MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X DTSBE351 00407 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE351 00408 IF (L004-VALID-QTR) DTSBE351 00409 AND DTSBE351 00410 (L004-QTR-5-9 > LECM-PICKUP-YRQ) DTSBE351 00411 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE351 00412 ELSE DTSBE351 00413 MOVE 'PARM-SUBJECT-YRQ NOT VALID' DTSBE351 00414 TO ABEND-MSG DTSBE351 00415 PERFORM S999-ABEND THRU S999-EXIT. DTSBE351 00416 DTSBE351 00417 DISPLAY 'LAST UC30 MAIL YRQ ' LECM-LAST-UC30-MASS-MAIL-YRQ. DTSBE351 00418 MOVE LECM-LAST-UC30-MASS-MAIL-YRQ TO WRK-LAST-UC30-MAIL-YRQ. DTSBE351 00419 DTSBE351 00420 MOVE L004-SLASH-QTR TO WRK-SLASH-QTR. DTSBE351 00421 I1100-EXIT. DTSBE351 00422 EXIT. DTSBE351 00423 DTSBE351 00424 I1200-DISPLAY-CREDIT. DTSBE351 00425 MOVE LECM-PARM-DISP-CREDIT-IND TO DTSBE351 00426 WRK-PARM-DISP-CREDIT-IND. DTSBE351 00427 DTSBE351 00428 IF WRK-PARM-DISP-CREDIT-IND = SPACES DTSBE351 00429 SET WRK-PARM-DISP-CREDIT-NO-88 TO TRUE. DTSBE351 00430 DTSBE351 00431 IF WRK-PARM-DISP-CREDIT-VALID-88 DTSBE351 00432 NEXT SENTENCE DTSBE351 00433 ELSE DTSBE351 00434 MOVE 'PARM-DISP-CREDIT-IND NOT VALID' DTSBE351 00435 TO ABEND-MSG DTSBE351 00436 PERFORM S999-ABEND THRU S999-EXIT. DTSBE351 00437 DTSBE351 00438 I1200-EXIT. DTSBE351 00439 EXIT. DTSBE351 00440 EJECT DTSBE351 00441 *************************************************************** DTSBE351 00442 DTSBE351 00443 * THE REPORT EXTRACT RECORDS FOR THE QUARTERLY REPORTS. DTSBE351 00444 * R719 - WRITTEN FOR RATED EMPLOYERS DTSBE351 00445 * R902 - WRITTEN FOR BOTH RATED AND SELF INSURED EMPLOYERS DTSBE351 00446 * R908 - WRITTEN FOR ALL EMPLOYERS DTSBE351 00447 * R907 - WRITTEN FOR EMPLOYERS WITH NO RATE (NO UC30 SENT DTSBE351 00448 * TO THESE EMPLOYERS) DTSBE351 00449 *************************************************************** DTSBE351 00450 DTSBE351 00451 P0000-PROCESS. DTSBE351 00452 ADD 1 TO TOT-MPRF-READ DTSBE351 00453 DTSBE351 00454 IF MPRF-CLASS-SUB-88 DTSBE351 00455 NEXT SENTENCE DTSBE351 00456 ELSE DTSBE351 00457 ADD 1 TO TOT-MPRF-READ-NOT-ACTIVE DTSBE351 00458 GO TO P0000-EXIT. DTSBE351 00459 DTSBE351 00460 DTSBE351 00461 MOVE WRK-PARM-SUBJECT-YRQ TO L516-YRQ. DTSBE351 00462 DTSBE351 00463 PERFORM S516-LIABILITY THRU S516-EXIT. DTSBE351 00464 DTSBE351 00465 IF L516-NOT-LIABLE-88 DTSBE351 00466 ADD 1 TO TOT-MPRF-READ-NOT-LIABLE DTSBE351 00467 GO TO P0000-EXIT. DTSBE351 00468 DTSBE351 00469 IF L516-ANN-SCHED-88 DTSBE351 00470 ADD 1 TO TOT-MPRF-READ-ANN-FILER DTSBE351 00471 GO TO P0000-EXIT. DTSBE351 00472 DTSBE351 00473 IF L516-PENDING-SCHED-88 DTSBE351 00474 ADD 1 TO TOT-MPRF-READ-PEND-SCHED DTSBE351 00475 PERFORM P1000-WRITE-907 THRU P1000-EXIT DTSBE351 00476 GO TO P0000-EXIT. DTSBE351 00477 DTSBE351 00478 IF MPRF-CLASS-SELF-INS-88 DTSBE351 00479 NEXT SENTENCE DTSBE351 00480 ELSE DTSBE351 00481 MOVE MPRF-EMP-NO TO R719-EMP-NO DTSBE351 00482 MOVE LECM-CURR-RUN-DATE TO R719-RUN-DATE DTSBE351 00483 PERFORM S946-WRITE-R719 THRU S946-EXIT. DTSBE351 00484 DTSBE351 00485 DTSBE351 00486 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE351 00487 DTSBE351 00488 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE351 00489 DTSBE351 00490 SET MQTR-QTR-88 TO TRUE. DTSBE351 00491 DTSBE351 00492 MOVE WRK-PARM-SUBJECT-YRQ TO MQTR-YRQ. DTSBE351 00493 DTSBE351 00494 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE351 00495 DTSBE351 00496 PERFORM S910-READ THRU S910-EXIT. DTSBE351 00497 DTSBE351 00498 IF L910-NO-REC-88 DTSBE351 00499 SET WRK-MQTR-NOT-FOUND-88 TO TRUE DTSBE351 00500 ELSE DTSBE351 00501 SET WRK-MQTR-FOUND-88 TO TRUE DTSBE351 00502 MOVE MSKL-REC TO MQTR-REC DTSBE351 00503 IF MQTR-CURR-RCVD-88 DTSBE351 00504 ADD 1 TO TOT-MPRF-READ-RPT-TYPE DTSBE351 00505 GO TO P0000-EXIT. DTSBE351 00506 DTSBE351 00507 DTSBE351 00508 SET WRK-UC30-SKIP-NO-88 TO TRUE. DTSBE351 00509 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBE351 00510 DTSBE351 00511 MOVE WRK-LAST-UC30-MAIL-YRQ TO MRPT-YRQ DTSBE351 00512 DTSBE351 00513 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBE351 00514 DTSBE351 00515 SET MRPT-RPT-88 TO TRUE. DTSBE351 00516 DTSBE351 00517 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBE351 00518 DTSBE351 00519 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE351 00520 DTSBE351 00521 IF L910-OK-88 DTSBE351 00522 MOVE MSKL-REC TO MRPT-REC DTSBE351 00523 MOVE MRPT-RESPONSIBLE-OP-ID TO WRK-UC30-SKIP-IND DTSBE351 00524 IF WRK-UC30-SKIP-VALID-88 DTSBE351 00525 ADD 1 TO TOT-MPRF-READ-MAG-UC30 DTSBE351 00526 SET WRK-UC30-SKIP-YES-88 TO TRUE DTSBE351 00527 ELSE DTSBE351 00528 ADD 1 TO TOT-MPRF-READ-NOT-UC30 DTSBE351 00529 SET WRK-UC30-SKIP-NO-88 TO TRUE DTSBE351 00530 END-IF DTSBE351 00531 END-IF. DTSBE351 00532 DTSBE351 00533 IF WRK-UC30-SKIP-YES-88 DTSBE351 00534 DISPLAY ' MAG FILER NO UC30 ' MPRF-EMP-NO DTSBE351 00535 GO TO P0000-EXIT. DTSBE351 00536 DTSBE351 00537 IF L910-NO-REC-88 DTSBE351 00538 ADD 1 TO TOT-MPRF-READ-NOT-UC30. DTSBE351 00539 DTSBE351 00540 IF MPRF-CLASS-SELF-INS-88 DTSBE351 00541 NEXT SENTENCE DTSBE351 00542 ELSE DTSBE351 00543 IF L516-NO-RATE-88 DTSBE351 00544 ADD 1 TO TOT-MPRF-READ-NO-RATE DTSBE351 00545 PERFORM P1000-WRITE-907 THRU P1000-EXIT DTSBE351 00546 GO TO P0000-EXIT. DTSBE351 00547 DTSBE351 00548 DTSBE351 00549 IF MPRF-UC30-MASS-MAIL-NO-88 DTSBE351 00550 ADD 1 TO TOT-MPRF-READ-NO-MAIL DTSBE351 00551 GO TO P0000-EXIT DTSBE351 00552 END-IF. DTSBE351 00553 DTSBE351 00554 IF MPRF-RETURN-MAIL-YES-88 DTSBE351 00555 ADD 1 TO TOT-MPRF-RETN-NO-MAIL DTSBE351 00556 GO TO P0000-EXIT DTSBE351 00557 END-IF. DTSBE351 00558 DTSBE351 00559 * PERFORM P1700-READ-MFAE THRU P1700-EXIT. DTSBE351 00560 DTSBE351 00561 * IF WRK-MFAE-FOUND-88 DTSBE351 00562 * DISPLAY ' NOT MAG BUT ON RATE TAPE ' MRPT-EMP-NO DTSBE351 00563 * GO TO P0000-EXIT DTSBE351 00564 * END-IF. DTSBE351 00565 DTSBE351 00566 PERFORM P2000-SETUP-BASIC-R902 THRU P2000-EXIT. DTSBE351 00567 DTSBE351 00568 DTSBE351 00569 PERFORM P3000-SETUP-R908 THRU P3000-EXIT. DTSBE351 00570 DTSBE351 00571 PERFORM P4000-TO-MTAD-ADDR THRU P4000-EXIT. DTSBE351 00572 DTSBE351 00573 *****MOVE LOW-VALUES TO MTNM-KEY-AREA. DTSBE351 00574 DTSBE351 00575 *****MOVE MPRF-EMP-NO TO MTNM-EMP-NO. DTSBE351 00576 DTSBE351 00577 *****SET MTNM-TNM-88 TO TRUE. DTSBE351 00578 DTSBE351 00579 *****MOVE MTNM-KEY-AREA TO MSKL-KEY-AREA. DTSBE351 00580 DTSBE351 00581 *****PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE351 00582 DTSBE351 00583 *****PERFORM P5000-MTNM-SCAN THRU P5000-EXIT DTSBE351 00584 *********UNTIL L910-NO-REC-88. DTSBE351 00585 P0000-EXIT. DTSBE351 00586 EXIT. DTSBE351 00587 EJECT DTSBE351 00588 P1000-WRITE-907. DTSBE351 00589 MOVE MSG1-ID TO R907-MSG-ID. DTSBE351 00590 DTSBE351 00591 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE351 00592 DTSBE351 00593 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9. DTSBE351 00594 DTSBE351 00595 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE351 00596 DTSBE351 00597 MOVE L004-SLASH-QTR TO MSG1-SLASHED-YRQ. DTSBE351 00598 DTSBE351 00599 MOVE MSG1-TEXT TO R907-MSG-TEXT. DTSBE351 00600 DTSBE351 00601 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE351 00602 P1000-EXIT. DTSBE351 00603 EXIT. DTSBE351 00604 EJECT DTSBE351 00605 P1700-READ-MFAE. DTSBE351 00606 DTSBE351 00607 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSBE351 00608 MOVE MPRF-EMP-NO TO MFAE-EMP-NO. DTSBE351 00609 SET MFAE-FAE-88 TO TRUE. DTSBE351 00610 SET MFAE-SERVICE-UC30-88 TO TRUE. DTSBE351 00611 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSBE351 00612 DTSBE351 00613 PERFORM S910-READ THRU S910-EXIT. DTSBE351 00614 DTSBE351 00615 IF L910-NO-REC-88 DTSBE351 00616 SET WRK-MFAE-NOT-FOUND-88 TO TRUE DTSBE351 00617 ELSE DTSBE351 00618 SET WRK-MFAE-FOUND-88 TO TRUE. DTSBE351 00619 DTSBE351 00620 P1700-EXIT. DTSBE351 00621 EXIT. DTSBE351 00622 EJECT. DTSBE351 00623 DTSBE351 00624 P2000-SETUP-BASIC-R902. DTSBE351 00625 SET R902-SORT-TYPE-QTR-88 TO TRUE. DTSBE351 00626 DTSBE351 00627 MOVE LOW-VALUES TO R902-VAR-SORT-AREA. DTSBE351 00628 DTSBE351 00629 MOVE MPRF-EMP-CLASS TO R902-QUARTERLY-EMP-CLASS. DTSBE351 00630 DTSBE351 00631 MOVE MPRF-EMP-NO TO R902-QUARTERLY-EMP-NO. DTSBE351 00632 DTSBE351 00633 MOVE WRK-PARM-SUBJECT-YRQ TO R902-QUARTERLY-YRQ. DTSBE351 00634 DTSBE351 00635 DTSBE351 00636 SET R902-QUARTERLY-88 TO TRUE. DTSBE351 00637 DTSBE351 00638 MOVE MPRF-PRIMARY-NAME TO R902-PRI-NAME-FIRST4. DTSBE351 00639 DTSBE351 00640 MOVE WRK-TAX-WAGE-BASE TO R902-TAX-WAGE-BASE. DTSBE351 00641 DTSBE351 00642 MOVE L516-UI-RATE TO R902-UI-RATE. DTSBE351 00643 DTSBE351 00644 IF (WRK-MQTR-FOUND-88) DTSBE351 00645 AND DTSBE351 00646 (MQTR-RPT-DUE-DATE GREATER THAN ZERO) DTSBE351 00647 MOVE MQTR-RPT-DUE-DATE TO R902-RPT-DUE-DATE DTSBE351 00648 ELSE DTSBE351 00649 MOVE L516-DEFAULT-RPT-DUE-DATE DTSBE351 00650 TO R902-RPT-DUE-DATE. DTSBE351 00651 DTSBE351 00652 MOVE MPRF-FEIN TO R902-FEIN. DTSBE351 00653 DTSBE351 00654 MOVE +0 TO R902-QTRLY-CR-AMT. DTSBE351 00655 DTSBE351 00656 MOVE +0 TO R902-DAILY-WAIVER-START-YRQ DTSBE351 00657 R902-DAILY-WAIVER-END-YRQ DTSBE351 00658 R902-DAILY-WAIVER-DATE. DTSBE351 00659 DTSBE351 00660 MOVE 'N' TO R902-DAILY-SUPPLEMENTAL-IND. DTSBE351 00661 DTSBE351 00662 IF NOT MPRF-NAICS-CD-NONCLASSIF-88 DTSBE351 00663 MOVE MPRF-NAICS-CD TO R902-INDUSTRY-CD DTSBE351 00664 ELSE DTSBE351 00665 IF NOT MPRF-SIC-CD-NONCLASSIF-88 DTSBE351 00666 MOVE MPRF-SIC-CD TO R902-INDUSTRY-CD. DTSBE351 00667 DTSBE351 00668 MOVE LOW-VALUES TO MELF-KEY-AREA. DTSBE351 00669 MOVE MPRF-EMP-NO TO MELF-EMP-NO. DTSBE351 00670 SET MELF-ELF-88 TO TRUE. DTSBE351 00671 MOVE MELF-KEY-AREA TO MSKL-KEY-AREA. DTSBE351 00672 PERFORM S910-READ THRU S910-EXIT. DTSBE351 00673 IF L910-NO-REC-88 DTSBE351 00674 SET R902-ELECTRNIC-WAGES-NO-88 TO TRUE DTSBE351 00675 ELSE DTSBE351 00676 MOVE MSKL-REC TO MELF-REC DTSBE351 00677 IF MELF-WAGES-YES-88 DTSBE351 00678 SET R902-ELECTRNIC-WAGES-YES-88 TO TRUE DTSBE351 00679 ELSE DTSBE351 00680 SET R902-ELECTRNIC-WAGES-NO-88 TO TRUE. DTSBE351 00681 P2000-EXIT. DTSBE351 00682 EXIT. DTSBE351 00683 EJECT. DTSBE351 00684 P3000-SETUP-R908. DTSBE351 00685 MOVE MPRF-EMP-NO TO R908-EMP-NO. DTSBE351 00686 DTSBE351 00687 MOVE WRK-PARM-SUBJECT-YRQ TO R908-YRQ. DTSBE351 00688 DTSBE351 00689 MOVE MPRF-EMP-CLASS TO R908-EMP-CLASS. DTSBE351 00690 P3000-EXIT. DTSBE351 00691 EXIT. DTSBE351 00692 EJECT DTSBE351 00693 ************************************************************** DTSBE351 00694 * THIS PARAGRAPH PROCESSES THE TAX MAILING ADDRESS AND WRITES DTSBE351 00695 * THE R902 AND R908 EXTRACT RECORDS. DTSBE351 00696 ************************************************************** DTSBE351 00697 DTSBE351 00698 P4000-TO-MTAD-ADDR. DTSBE351 00699 IF MPRF-CLASS-SELF-INS-88 DTSBE351 00700 MOVE +0 TO R902-QTRLY-CR-AMT DTSBE351 00701 ELSE DTSBE351 00702 IF WRK-PARM-DISP-CREDIT-YES-88 DTSBE351 00703 IF (MPRF-UC30-CREDIT-YES-88) DTSBE351 00704 AND DTSBE351 00705 (MPRF-PURSUED-RPT-CNT EQUAL ZERO) DTSBE351 00706 AND DTSBE351 00707 (MPRF-TOT-CREDIT-AMT GREATER THAN ZERO) DTSBE351 00708 MOVE MPRF-TOT-CREDIT-AMT TO R902-QTRLY-CR-AMT DTSBE351 00709 ELSE DTSBE351 00710 MOVE ZERO TO R902-QTRLY-CR-AMT DTSBE351 00711 END-IF DTSBE351 00712 ELSE DTSBE351 00713 MOVE ZERO TO R902-QTRLY-CR-AMT DTSBE351 00714 END-IF. DTSBE351 00715 DTSBE351 00716 PERFORM P4100-LOOKUP-ADDR THRU P4100-EXIT. DTSBE351 00717 DTSBE351 00718 DTSBE351 00719 *****IF MPRF-UC30-PRIMARY-88 DTSBE351 00720 *********SET R902-QTRLY-PRIMARY-88 TO TRUE DTSBE351 00721 *****ELSE DTSBE351 00722 *********SET R902-QTRLY-SECND-NONE-88 TO TRUE. DTSBE351 00723 DTSBE351 00724 DTSBE351 00725 ADD 1 TO TOT-MPRF-READ-R902. DTSBE351 00726 PERFORM S946-WRITE-R902 THRU S946-EXIT. DTSBE351 00727 DTSBE351 00728 DTSBE351 00729 PERFORM S946-WRITE-R908 THRU S946-EXIT. DTSBE351 00730 DTSBE351 00731 DTSBE351 00732 *****IF R902-QTRLY-PRIMARY-88 DTSBE351 00733 *********PERFORM P4200-SETUP-MTCK THRU P4200-EXIT DTSBE351 00734 *********PERFORM S910-WRITE THRU S910-EXIT. DTSBE351 00735 P4000-EXIT. DTSBE351 00736 EXIT. DTSBE351 00737 EJECT DTSBE351 00738 P4100-LOOKUP-ADDR. DTSBE351 00739 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE351 00740 DTSBE351 00741 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE351 00742 DTSBE351 00743 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBE351 00744 DTSBE351 00745 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE351 00746 DTSBE351 00747 IF L111-ADDR-FOUND-88 DTSBE351 00748 SET L112-TAD-ADDR-88 TO TRUE DTSBE351 00749 PERFORM P4110-FORMAT-ADDR THRU P4110-EXIT DTSBE351 00750 ELSE DTSBE351 00751 MOVE ALL '?' TO R902-QUARTERLY-ZIP-CODE DTSBE351 00752 R902-FMT-ADDR DTSBE351 00753 R902-ZIP DTSBE351 00754 R902-ADVANCED-BARCODE. DTSBE351 00755 P4100-EXIT. DTSBE351 00756 EXIT. DTSBE351 00757 SKIP3 DTSBE351 00758 P4110-FORMAT-ADDR. DTSBE351 00759 SET L112-ANCHOR-LAST-88 TO TRUE. DTSBE351 00760 DTSBE351 00761 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE351 00762 DTSBE351 00763 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBE351 00764 DTSBE351 00765 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBE351 00766 DTSBE351 00767 MOVE L112-MAILING-ADDRESS TO R902-FMT-ADDR. DTSBE351 00768 DTSBE351 00769 MOVE L112-ZIP TO R902-ZIP DTSBE351 00770 R902-QUARTERLY-ZIP-CODE. DTSBE351 00771 DTSBE351 00772 MOVE L112-ADVANCED-BARCODE TO R902-ADVANCED-BARCODE. DTSBE351 00773 P4110-EXIT. DTSBE351 00774 EXIT. DTSBE351 00775 EJECT. DTSBE351 00776 *P4200-SETUP-MTCK. DTSBE351 00777 *****MOVE LOW-VALUES TO MTCK-REC. DTSBE351 00778 DTSBE351 00779 *****MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSBE351 00780 DTSBE351 00781 *****SET MTCK-TCK-88 TO TRUE. DTSBE351 00782 DTSBE351 00783 *****ADD +1 TO LECM-EMP-ABSTIME. DTSBE351 00784 DTSBE351 00785 *****MOVE LECM-EMP-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBE351 00786 DTSBE351 00787 *****MOVE ZERO TO MTCK-PURGE-DATE DTSBE351 00788 ******************MTCK-ACKNOWLEDGED-DATE. DTSBE351 00789 DTSBE351 00790 *****SET MTCK-TYPE-MANUAL-88 TO TRUE. DTSBE351 00791 DTSBE351 00792 *****PERFORM P4210-CALC-TRIGGER-DATE THRU P4210-EXIT. DTSBE351 00793 DTSBE351 00794 *****MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE DTSBE351 00795 DTSBE351 00796 *****MOVE 'COLLCT' TO MTCK-DEST-OP-ID DTSBE351 00797 DTSBE351 00798 *****SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSBE351 00799 DTSBE351 00800 *****SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSBE351 00801 DTSBE351 00802 *****MOVE LECM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSBE351 00803 ********************************MTCK-CHNG-DATE. DTSBE351 00804 DTSBE351 00805 *****MOVE +1 TO MTCK-TEXT-CNT. DTSBE351 00806 DTSBE351 00807 *****MOVE WRK-SLASH-QTR TO MSG2-SLASHED-YRQ. DTSBE351 00808 DTSBE351 00809 *****MOVE MSG2-TCK TO MTCK-TEXT (MTCK-TEXT-CNT). DTSBE351 00810 DTSBE351 00811 *****MOVE MTCK-REC TO MSKL-REC. DTSBE351 00812 *P4200-EXIT. DTSBE351 00813 *****EXIT. DTSBE351 00814 EJECT DTSBE351 00815 *P4210-CALC-TRIGGER-DATE. DTSBE351 00816 *****MOVE R902-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBE351 00817 DTSBE351 00818 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE351 00819 DTSBE351 00820 *****ADD +10 TO L001-JUL-ABS-DAY. DTSBE351 00821 DTSBE351 00822 *****PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBE351 00823 *P4210-EXIT. DTSBE351 00824 *****EXIT. DTSBE351 00825 EJECT DTSBE351 00826 *P5000-MTNM-SCAN. DTSBE351 00827 *****MOVE MSKL-REC TO MTNM-REC. DTSBE351 00828 DTSBE351 00829 *****IF MTNM-UC30-MASS-YES-88 DTSBE351 00830 *********PERFORM P5100-TO-MTAA-ADDR THRU P5100-EXIT DTSBE351 00831 *********MOVE MTNM-KEY-AREA TO MSKL-KEY-AREA DTSBE351 00832 *********PERFORM S910-READ THRU S910-EXIT DTSBE351 00833 *********IF L910-NO-REC-88 DTSBE351 00834 *************MOVE 'LOGIC ERROR IN P5000' DTSBE351 00835 ***************TO ABEND-MSG DTSBE351 00836 *************PERFORM S999-ABEND THRU S999-EXIT. DTSBE351 00837 DTSBE351 00838 *****PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE351 00839 *P5000-EXIT. DTSBE351 00840 *****EXIT. DTSBE351 00841 SKIP3 DTSBE351 00842 P5100-TO-MTAA-ADDR. DTSBE351 00843 *****SET L111-LOOKUP-TAA-88 TO TRUE. DTSBE351 00844 DTSBE351 00845 *****MOVE MTNM-ID-NO TO L111-ID-NO. DTSBE351 00846 DTSBE351 00847 *****PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE351 00848 DTSBE351 00849 *****IF L111-ADDR-FOUND-88 DTSBE351 00850 *********SET L112-TAA-ADDR-88 TO TRUE DTSBE351 00851 *********PERFORM P4110-FORMAT-ADDR THRU P4110-EXIT DTSBE351 00852 *****ELSE DTSBE351 00853 *********MOVE ALL '?' TO R902-QUARTERLY-ZIP-CODE DTSBE351 00854 *************************R902-FMT-ADDR DTSBE351 00855 *************************R902-ZIP DTSBE351 00856 *************************R902-DELIV-POINT DTSBE351 00857 *************************R902-CHECK-DIGIT. DTSBE351 00858 DTSBE351 00859 *****MOVE ZERO TO R902-QTRLY-CR-AMT. DTSBE351 00860 DTSBE351 00861 *****SET R902-QTRLY-SECONDARY-88 TO TRUE. DTSBE351 00862 DTSBE351 00863 *****PERFORM S946-WRITE-R902 THRU S946-EXIT. DTSBE351 00864 DTSBE351 00865 *****PERFORM S946-WRITE-R908 THRU S946-EXIT. DTSBE351 00866 *P5100-EXIT. DTSBE351 00867 *****EXIT. DTSBE351 00868 EJECT DTSBE351 00869 T0000-TERMINATE. DTSBE351 00870 MOVE LOW-VALUES TO FQTR-KEY-AREA. DTSBE351 00871 DTSBE351 00872 SET FQTR-QTR-88 TO TRUE. DTSBE351 00873 DTSBE351 00874 MOVE WRK-PARM-SUBJECT-YRQ DTSBE351 00875 TO FQTR-YRQ. DTSBE351 00876 DTSBE351 00877 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA. DTSBE351 00878 DTSBE351 00879 PERFORM S931-READ THRU S931-EXIT. DTSBE351 00880 DTSBE351 00881 IF L931-NO-REC-88 DTSBE351 00882 MOVE LOW-VALUES TO FQTR-DATA-AREA DTSBE351 00883 MOVE LECM-CURR-RUN-DATE DTSBE351 00884 TO FQTR-UC30-MASS-MAIL-DATE DTSBE351 00885 MOVE +0 TO FQTR-SELF-INS-TAX-DUE-DATE DTSBE351 00886 FQTR-LATE-PEN-ASSESSED-DATE DTSBE351 00887 FQTR-UC30-FIRST-DEL-DATE DTSBE351 00888 FQTR-UC30-FINAL-DEL-DATE DTSBE351 00889 FQTR-UC30-FINAL-ACTION-DATE DTSBE351 00890 FQTR-SELF-INS-CHG-RUN-DATE DTSBE351 00891 FQTR-INTENT-2-ESTIMATE-DATE DTSBE351 00892 FQTR-ESTIMATED-DATE DTSBE351 00893 FQTR-SELF-INS-2ND-LETTER-DATE DTSBE351 00894 MOVE LECM-CURR-RUN-DATE DTSBE351 00895 TO FQTR-ESTB-DATE DTSBE351 00896 FQTR-CHNG-DATE DTSBE351 00897 MOVE FQTR-REC TO FSKL-REC DTSBE351 00898 PERFORM S931-WRITE THRU S931-EXIT DTSBE351 00899 ELSE DTSBE351 00900 MOVE FSKL-REC TO FQTR-REC DTSBE351 00901 MOVE LECM-CURR-RUN-DATE TO FQTR-UC30-MASS-MAIL-DATE DTSBE351 00902 MOVE LECM-CURR-RUN-DATE TO FQTR-CHNG-DATE DTSBE351 00903 MOVE FQTR-REC TO FSKL-REC DTSBE351 00904 PERFORM S931-REWRITE THRU S931-EXIT. DTSBE351 00905 DTSBE351 00906 DTSBE351 00907 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE351 00908 DTSBE351 00909 MOVE +0 TO MHDR-EMP-NO. DTSBE351 00910 DTSBE351 00911 SET MHDR-HDR-88 TO TRUE. DTSBE351 00912 DTSBE351 00913 MOVE MHDR-REC TO MSKL-REC. DTSBE351 00914 DTSBE351 00915 PERFORM S910-READ THRU S910-EXIT. DTSBE351 00916 DTSBE351 00917 IF L910-NO-REC-88 DTSBE351 00918 MOVE 'MHDR RECORD NOT FOUND' DTSBE351 00919 TO ABEND-MSG DTSBE351 00920 PERFORM S999-ABEND THRU S999-EXIT. DTSBE351 00921 DTSBE351 00922 MOVE MSKL-REC TO MHDR-REC. DTSBE351 00923 DTSBE351 00924 IF WRK-PARM-SUBJECT-YRQ > MHDR-LAST-UC30-MASS-MAIL-YRQ DTSBE351 00925 MOVE WRK-PARM-SUBJECT-YRQ DTSBE351 00926 TO MHDR-LAST-UC30-MASS-MAIL-YRQ DTSBE351 00927 MOVE LECM-CURR-RUN-DATE TO MHDR-CHNG-DATE DTSBE351 00928 MOVE MHDR-REC TO MSKL-REC DTSBE351 00929 PERFORM S910-REWRITE THRU S910-EXIT. DTSBE351 00930 DISPLAY ' TOT MPRF RECS READ = ' TOT-MPRF-READ. DTSBE351 00931 DISPLAY ' TOT MPRF NOT ACTIVE = ' TOT-MPRF-READ-NOT-ACTIVE.DTSBE351 00932 DISPLAY ' TOT MPRF NOT LIABLE = ' TOT-MPRF-READ-NOT-LIABLE.DTSBE351 00933 DISPLAY ' TOT MPRF ANN FILER = ' TOT-MPRF-READ-ANN-FILER. DTSBE351 00934 DISPLAY ' TOT MPRF PEND SCHED = ' TOT-MPRF-READ-PEND-SCHED.DTSBE351 00935 DISPLAY ' TOT MQTR INV RPT TYP = ' TOT-MPRF-READ-RPT-TYPE. DTSBE351 00936 DISPLAY ' TOT MPRF NO RATE = ' TOT-MPRF-READ-NO-RATE. DTSBE351 00937 DISPLAY ' TOT MPRF NO MASS MAIL = ' TOT-MPRF-READ-NO-MAIL. DTSBE351 00938 DISPLAY ' TOT MPRF RETURN MAIL = ' TOT-MPRF-RETN-NO-MAIL DTSBE351 00939 DISPLAY ' TOT MAG UC30 FILERS = ' TOT-MPRF-READ-MAG-UC30. DTSBE351 00940 DISPLAY ' TOT NOT MAG FILERS = ' TOT-MPRF-READ-NOT-UC30. DTSBE351 00941 DISPLAY ' TOT UC30 RECS WRITTEN = ' TOT-MPRF-READ-R902. DTSBE351 00942 T0000-EXIT. DTSBE351 00943 EXIT. DTSBE351 00944 EJECT DTSBE351 00945 *S001-FROM-FED-8. DTSBE351 00946 *****SET L001-FROM-FED-8 TO TRUE. DTSBE351 00947 *****GO TO S001-DATE. DTSBE351 00948 DTSBE351 00949 *S001-FROM-ABS-DAY. DTSBE351 00950 *****SET L001-FROM-ABS-DAY TO TRUE. DTSBE351 00951 *****GO TO S001-DATE. DTSBE351 00952 DTSBE351 00953 *S001-DATE. DTSBE351 00954 *****CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE351 00955 *S001-EXIT. DTSBE351 00956 *****EXIT. DTSBE351 00957 SKIP3 DTSBE351 00958 S004-FROM-5. DTSBE351 00959 SET L004-FROM-5 TO TRUE. DTSBE351 00960 GO TO S004-QTR. DTSBE351 00961 DTSBE351 00962 S004-FROM-ABS. DTSBE351 00963 SET L004-FROM-ABS TO TRUE. DTSBE351 00964 GO TO S004-QTR. DTSBE351 00965 DTSBE351 00966 S004-FROM-3. DTSBE351 00967 SET L004-FROM-3 TO TRUE. DTSBE351 00968 GO TO S004-QTR. DTSBE351 00969 DTSBE351 00970 S004-QTR. DTSBE351 00971 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE351 00972 S004-EXIT. DTSBE351 00973 EXIT. DTSBE351 00974 SKIP3 DTSBE351 00975 S111-LOOKUP-ADDR. DTSBE351 00976 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE351 00977 S111-EXIT. DTSBE351 00978 EXIT. DTSBE351 00979 SKIP3 DTSBE351 00980 S112-FORMAT-ADDR. DTSBE351 00981 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE351 00982 S112-EXIT. DTSBE351 00983 EXIT. DTSBE351 00984 SKIP3 DTSBE351 00985 S516-LIABILITY. DTSBE351 00986 CALL 'DTSBU516' USING L516-LINK-AREA DTSBE351 00987 MPRF-LINK-REC. DTSBE351 00988 S516-EXIT. DTSBE351 00989 EXIT. DTSBE351 00990 SKIP3 DTSBE351 00991 S910-READ. DTSBE351 00992 SET L910-READ-88 TO TRUE. DTSBE351 00993 GO TO S910-MSTR-IO. DTSBE351 00994 DTSBE351 00995 S910-START-BROWSE. DTSBE351 00996 SET L910-START-BROWSE-88 TO TRUE. DTSBE351 00997 GO TO S910-MSTR-IO. DTSBE351 00998 DTSBE351 00999 S910-READ-NEXT. DTSBE351 01000 SET L910-READ-NEXT-88 TO TRUE. DTSBE351 01001 GO TO S910-MSTR-IO. DTSBE351 01002 DTSBE351 01003 *S910-COUNT. DTSBE351 01004 *****SET L910-COUNT-88 TO TRUE. DTSBE351 01005 *****GO TO S910-MSTR-IO. DTSBE351 01006 DTSBE351 01007 *S910-WRITE. DTSBE351 01008 *****SET L910-WRITE-88 TO TRUE. DTSBE351 01009 *****SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE351 01010 *****GO TO S910-MSTR-IO. DTSBE351 01011 DTSBE351 01012 S910-REWRITE. DTSBE351 01013 SET L910-REWRITE-88 TO TRUE. DTSBE351 01014 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE351 01015 GO TO S910-MSTR-IO. DTSBE351 01016 DTSBE351 01017 *S910-DELETE. DTSBE351 01018 *****SET L910-DELETE-88 TO TRUE. DTSBE351 01019 *****SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE351 01020 *****GO TO S910-MSTR-IO. DTSBE351 01021 DTSBE351 01022 S910-MSTR-IO. DTSBE351 01023 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE351 01024 MSKL-REC. DTSBE351 01025 S910-EXIT. DTSBE351 01026 EXIT. DTSBE351 01027 SKIP3 DTSBE351 01028 S931-READ. DTSBE351 01029 SET L931-READ-88 TO TRUE. DTSBE351 01030 GO TO S931-REF-I. DTSBE351 01031 DTSBE351 01032 *S931-START-BROWSE. DTSBE351 01033 *****SET L931-START-BROWSE-88 TO TRUE. DTSBE351 01034 *****GO TO S931-REF-I. DTSBE351 01035 DTSBE351 01036 *S931-READ-NEXT. DTSBE351 01037 *****SET L931-READ-NEXT-88 TO TRUE. DTSBE351 01038 *****GO TO S931-REF-I. DTSBE351 01039 DTSBE351 01040 S931-WRITE. DTSBE351 01041 SET L931-WRITE-88 TO TRUE. DTSBE351 01042 GO TO S931-REF-I. DTSBE351 01043 DTSBE351 01044 S931-REWRITE. DTSBE351 01045 SET L931-REWRITE-88 TO TRUE. DTSBE351 01046 GO TO S931-REF-I. DTSBE351 01047 DTSBE351 01048 *S931-DELETE. DTSBE351 01049 *****SET L931-DELETE-88 TO TRUE. DTSBE351 01050 *****GO TO S931-REF-I. DTSBE351 01051 DTSBE351 01052 S931-REF-I. DTSBE351 01053 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE351 01054 FSKL-REC. DTSBE351 01055 S931-EXIT. DTSBE351 01056 EXIT. DTSBE351 01057 SKIP3 DTSBE351 01058 S946-WRITE-R719. DTSBE351 01059 CALL 'DTSBU946' USING R719-REC. DTSBE351 01060 GO TO S946-EXIT. DTSBE351 01061 DTSBE351 01062 S946-WRITE-R902. DTSBE351 01063 CALL 'DTSBU946' USING R902-REC. DTSBE351 01064 GO TO S946-EXIT. DTSBE351 01065 DTSBE351 01066 S946-WRITE-R907. DTSBE351 01067 CALL 'DTSBU946' USING R907-REC. DTSBE351 01068 GO TO S946-EXIT. DTSBE351 01069 DTSBE351 01070 S946-WRITE-R908. DTSBE351 01071 CALL 'DTSBU946' USING R908-REC. DTSBE351 01072 GO TO S946-EXIT. DTSBE351 01073 DTSBE351 01074 S946-EXIT. DTSBE351 01075 EXIT. DTSBE351 01076 SKIP3 DTSBE351 01077 S999-ABEND. DTSBE351 01078 DISPLAY '*** DTSBE351 ABENDING. ' DTSBE351 01079 ABEND-MSG. DTSBE351 01080 DTSBE351 01081 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE351 01082 S999-EXIT. DTSBE351 01083 EXIT. DTSBE351