1085 lines
86 KiB
COBOL
1085 lines
86 KiB
COBOL
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
|