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