2128 lines
168 KiB
COBOL
2128 lines
168 KiB
COBOL
00001 IDENTIFICATION DIVISION. 02/21/20
|
|
00002 PROGRAM-ID. DTSBE417. DTSBE417
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN. AUGUST 1994. DTSBE417
|
|
00005 DATE-COMPILED. DTSBE417
|
|
00006 SKIP3 DTSBE417
|
|
00007 ***** DTSBE417
|
|
00008 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE417
|
|
00009 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE417
|
|
00010 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE417
|
|
00011 * DTSBE417
|
|
00012 * THE DELINQUENT REPORT EXTRACT PROCESS IS DESIGNED TO RUN DTSBE417
|
|
00013 * IMMEDIATELY FOLLOWING A DAILY UPDATE RUN. DTSBE417
|
|
00014 * DTSBE417
|
|
00015 * IF THE DELINQUENT REPORT EXTRACT PROCESS DOES NOT RUN DTSBE417
|
|
00016 * IMMEDIATELY FOLLOWING A DAILY UPDATE RUN (AND ON-LINE DTSBE417
|
|
00017 * UPDATES OCCURRED BETWEEN THE DAILY UPDATE RUN AND THE DTSBE417
|
|
00018 * DELINQUENT REPORT EXTRACT PROCESS), THEN "INCONSISTENT" DTSBE417
|
|
00019 * MQTR-CURR-RPT-TYPE VALUES MAY BE ENCOUNTERED AND DTSBE417
|
|
00020 * REPORTED. DTSBE417
|
|
00021 * DTSBE417
|
|
00022 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE417
|
|
00023 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE417
|
|
00024 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE417
|
|
00025 * DTSBE417
|
|
00026 * DTSBE417
|
|
00027 * FUNCTION: DELINQUENT REPORT EXTRACT. DTSBE417
|
|
00028 * DTSBE417
|
|
00029 * DTSBE417
|
|
00030 * MODIFICATION LOG: DTSBE417
|
|
00031 * DTSBE417
|
|
00032 * 03/09/1999 REVIEWED AND MODIFIED FOR DC. DTSBE417
|
|
00033 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBE417
|
|
00034 * DTSBE417
|
|
00035 * 05/24/1999 PICKUP MODIFICATION. FIRST PURSUED YRQ MUST BE DTSBE417
|
|
00036 * GREATER THAN LECM-PICKUP-YRQ. DTSBE417
|
|
00037 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBE417
|
|
00038 * DTSBE417
|
|
00039 * DTSBE417
|
|
00040 * 05/10/2002 MODIFIED PROGRAM TO BYPASS ANNUAL FILERS DTSBE417
|
|
00041 * REFERENCE: HOUSEHOLD PROGRAMMER: ZL1 DTSBE417
|
|
00042 * DTSBE417
|
|
00043 * 08/15/2002 MODIFIED FOR NEW VERSION OF DTSIL516. THE DTSBE417
|
|
00044 * PROGRAM WILL WRITE AN R907 RECORD IF IT ADDS DTSBE417
|
|
00045 * AN MQTR BUT THE RATE IS ESTIMATED. DTSBE417
|
|
00046 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBE417
|
|
00047 * DTSBE417
|
|
00048 * 05/12/2004 MODIFIED TO WRITE R716 RECORDS ONLY DURING THE DTSBE417
|
|
00049 * DELINQUENCY RUN FOR THE FIRST QUARTER. DTSBE417
|
|
00050 * REFERENCE: TPS REQUIREMENTS PROGRAMMER: GB DTSBE417
|
|
00051 * 10/25/04 ABOVE REQUEST CANCELLED TO ALLOW ALL QUARTERS DTSBE417
|
|
00052 * TO PROCESS. DTSBE417
|
|
00053 * DTSBE417
|
|
00054 * 04/15/2005 MODIFIED FOR NEW PENALTY PROCESS. PENALTY DTSBE417
|
|
00055 * ASSESSED FOR MISSING REPORTS. DTSBE417
|
|
00056 * REFERENCE: DIR 107 PROGRAMMER: GD DTSBE417
|
|
00057 * DTSBE417
|
|
00058 * 11/22/05 ADD MPRF-RETURN-MAIL-IND. IF MPRF-RETURN-MAIL-YES-8DTSBE417
|
|
00059 * ON MPRF-EMP-NO, BY PASS THAT ACCOUNT EXTRACT INFO- DTSBE417
|
|
00060 * MATION AND SEND NO MISSING QUARTERLY REPORT LETTER DTSBE417
|
|
00061 * TO THAT EMPLOYER. DTSBE417
|
|
00062 * WORK ORDER: PROGRAMMER: RW1 DTSBE417
|
|
00063 * DTSBE417
|
|
00064 * 03/07/06 ADDED PROCESSING TO CHECK FOR UNPROCESSED REPORTS IDTSBE417
|
|
00065 * THE TRANSACTION FILE (ATC). DO NOT COUNT AS DTSBE417
|
|
00066 * DELINQUENT IF A REPORT EXISTS IN THE TRANSACTION DTSBE417
|
|
00067 * FILE FOR THE EMPLOYER. DTSBE417
|
|
00068 * WORK ORDER: PROGRAMMER: GD DTSBE417
|
|
00069 * DTSBE417
|
|
00070 * 09/10/07 PENALTY AND INTEREST CALCULATIONS MODIFIED TO DTSBE417
|
|
00071 * EXCLUDE SUR-TAX. P4100 P4111. DTSBE417
|
|
00072 * WORK ORDER: PROGRAMMER: ZL1 DTSBE417
|
|
00073 * DTSBE417
|
|
00074 * 09/10/07 MODIFIED P4100 TO PASS LECM-CURR-RUN-DATE TO DTSBE417
|
|
00075 * NEW FIELD L102-CURR-RUN-DATE. DTSBE417
|
|
00076 * WORK ORDER: PROGRAMMER: ZL1 DTSBE417
|
|
00077 * DTSBE417
|
|
00078 * 05/11/09 MOVED TEST FOR BAD ADDRESS SO THAT IT WILL ONLY DTSBE417
|
|
00079 * PREVENT MAILING OF THE NOTICE, AND NOT REMOVE DTSBE417
|
|
00080 * THE EMPLOYER FROM THE DELINQUENCY PROCESS DTSBE417
|
|
00081 * ALTOGETHER. DTSBE417
|
|
00082 * WORK ORDER: PROGRAMMER: GD DTSBE417
|
|
00083 * DTSBE417
|
|
00084 * 05/27/10 ADDED CODE TO BYPASS EMPLOYERS WITH AN ORIGINAL DTSBE417
|
|
00085 * REPORT IN THE ATC FILE TO P2100 (MQTR EXISTS). DTSBE417
|
|
00086 * WORK ORDER: PROGRAMMER: GD DTSBE417
|
|
00087 * DTSBE417
|
|
00088 * 03/29/13 ADDED CODE TO TIMELY PAYMENTS CALCULATIONS. DTSBE417
|
|
00089 * WORK ORDER: PROGRAMMER: ZL1 DTSBE417
|
|
00090 * DTSBE417
|
|
00091 * 07/02/13 MODIFIED CODE NOT TO PRINT DELINQUENT NOTICE. DTSBE417
|
|
00092 * NEW PROGRAM DTSBE418 WILL CREATE IR417 WHEN NEEDED DTSBE417
|
|
00093 * WORK ORDER: PROGRAMMER: ZL1 DTSBE417
|
|
00094 * DTSBE417
|
|
00095 * DTSBE417
|
|
00096 * 12/11/13 MODIFIED CODE TO PRINT LATE FILING NOTICE AND DTSBE417
|
|
00097 * ASSIGN LATE PENALTY FOR ALL REPORTS NOT FILED. DTSBE417
|
|
00098 * WILL NOT MARK THE QUARTER DELINQUENT. DTSBE417
|
|
00099 * WORK ORDER: PROGRAMMER: ZL1 DTSBE417
|
|
00100 * DTSBE417
|
|
00101 * DTSBE417
|
|
00102 * 02/20/14 MODIFIED CODE TO ORIGINAL VERSION; MARK QUARTER DTSBE417
|
|
00103 * DELINQUENT AND GENERATE DELINQUENCY NOTICES. DTSBE417
|
|
00104 * WORK ORDER: PROGRAMMER: ZL1 DTSBE417
|
|
00105 * DTSBE417
|
|
00106 * 08/27/14 MODIFIED CODE TO READ ICESA FILE AND IF REPORT DTSBE417
|
|
00107 * IS IN THE TRANSACTION FILE DO NOT CREATE NOTICE DTSBE417
|
|
00108 * WORK ORDER: PROGRAMMER: ZL1 DTSBE417
|
|
00109 * CL**2
|
|
00110 * 12/12/19 MODIFIED CODE TO READ MHDR RECORD AND VERIFY CL**2
|
|
00111 * LATE PENALTY JOB RAN. CL**2
|
|
00112 * WORK ORDER: PROGRAMMER: ZL1 CL**2
|
|
00113 * CL**2
|
|
00114 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE417
|
|
00115 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE417
|
|
00116 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE417
|
|
00117 * DTSBE417
|
|
00118 * DTSBE417
|
|
00119 * DESCRIPTION: DTSBE417
|
|
00120 * DTSBE417
|
|
00121 * DTSBE417
|
|
00122 * INITIATION: DTSBE417
|
|
00123 * DTSBE417
|
|
00124 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE417
|
|
00125 * SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE417
|
|
00126 * DTSBE417
|
|
00127 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUTS DTSBE417
|
|
00128 * DESCRIPTIONS AND LAYOUTS (417R1, 418R1, 716R1). DTSBE417
|
|
00129 * DTSBE417
|
|
00130 * IF WRK-PARM-SUBJECT-YRQ IS GREATER THAN DTSBE417
|
|
00131 * LECM-LAST-UC30-DEL-MAIL-YRQ THEN MOVE DTSBE417
|
|
00132 * WRK-PARM-SUBJECT-YRQ TO LECM-LAST-UC30-DEL-MAIL-YRQ. DTSBE417
|
|
00133 * DTSBE417
|
|
00134 * REFIGURE LECM-FIRST-PURSUED-RPT-YRQ. DTSBE417
|
|
00135 * DTSBE417
|
|
00136 * DTSBE417
|
|
00137 * PROCESSING: DTSBE417
|
|
00138 * DTSBE417
|
|
00139 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (417R1, DTSBE417
|
|
00140 * 418R1, 716R1). DTSBE417
|
|
00141 * DTSBE417
|
|
00142 * INCLUDES EXTENSIVE MASTER FILE UPDATING. DTSBE417
|
|
00143 * DTSBE417
|
|
00144 * MAINTAIN MPRF-PURSUED-RPT-CNT. DTSBE417
|
|
00145 * DTSBE417
|
|
00146 * DTSBE417
|
|
00147 * TERMINATION: DTSBE417
|
|
00148 * DTSBE417
|
|
00149 * READ THE MHDR RECORD. IF WRK-PARM-SUBJECT-YRQ IS DTSBE417
|
|
00150 * GREATER THAN MHDR-LAST-UC30-DEL-MAIL-YRQ THEN MOVE DTSBE417
|
|
00151 * WRK-PARM-SUBJECT-YRQ TO MHDR-LAST-UC30-DEL-MAIL-YRQ. DTSBE417
|
|
00152 * REFIGURE MHDR-FIRST-PURSUED-RPT-YRQ. DTSBE417
|
|
00153 * REWRITE THE MHDR-RECORD. DTSBE417
|
|
00154 * DTSBE417
|
|
00155 * READ FQTR RECORD FOR WRK-PARM-SUBJECT-YRQ. IF FOUND, DTSBE417
|
|
00156 * REWRITE; IF NOT FOUND, CREATE A FQTR RECORD AND WRITE. DTSBE417
|
|
00157 * MOVE LECM-CURR-RUN-DATE TO FQTR-UC30-DEL-MAIL-DATE. DTSBE417
|
|
00158 * DTSBE417
|
|
00159 * DTSBE417
|
|
00160 * RECORDS READ: DTSBE417
|
|
00161 * DTSBE417
|
|
00162 * MASTER: DTSBE417
|
|
00163 * DTSBE417
|
|
00164 * MHDR DTSBE417
|
|
00165 * MQTR DTSBE417
|
|
00166 * MRPT DTSBE417
|
|
00167 * MTAD DTSBE417
|
|
00168 * MOPO DTSBE417
|
|
00169 * MTAA DTSBE417
|
|
00170 * DTSBE417
|
|
00171 * DTSBE417
|
|
00172 * ALTERNATE INDEX: DTSBE417
|
|
00173 * DTSBE417
|
|
00174 * NONE. DTSBE417
|
|
00175 * DTSBE417
|
|
00176 * DTSBE417
|
|
00177 * REFERENCE: DTSBE417
|
|
00178 * DTSBE417
|
|
00179 * FQTR DTSBE417
|
|
00180 * DTSBE417
|
|
00181 * DTSBE417
|
|
00182 * RECORDS UPDATED: DTSBE417
|
|
00183 * DTSBE417
|
|
00184 * MHDR (REWRITE) DTSBE417
|
|
00185 * MTCK (WRITE) DTSBE417
|
|
00186 * MEVL (WRITE) DTSBE417
|
|
00187 * FQTR (WRITE, REWRITE) DTSBE417
|
|
00188 * DTSBE417
|
|
00189 * DTSBE417
|
|
00190 * REPORT RECORDS WRITTEN: DTSBE417
|
|
00191 * DTSBE417
|
|
00192 * R716 RQC REPORT DELINQUENCY UNIVERSE. DTSBE417
|
|
00193 * R417 DELINQUENT REPORT NOTICE LETTER. DTSBE417
|
|
00194 * R418 DELINQUENT EMPLOYER ACCOUNT NUMBER LIST. DTSBE417
|
|
00195 * R907 UNUSUAL CONDITION ENCOUNTERED. DTSBE417
|
|
00196 * DTSBE417
|
|
00197 * DTSBE417
|
|
00198 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE417
|
|
00199 * DTSBE417
|
|
00200 * NONE. DTSBE417
|
|
00201 * DTSBE417
|
|
00202 * DTSBE417
|
|
00203 * MODULES CALLED: DTSBE417
|
|
00204 * DTSBE417
|
|
00205 * DTSBU001 DATE CONVERSION/EDIT. DTSBE417
|
|
00206 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE417
|
|
00207 * DTSBU061 FIELD ZIP / FIELD REP ID. DTSBE417
|
|
00208 * DTSBU111 ADDRESS LOOKUP. DTSBE417
|
|
00209 * DTSBU112 ADDRESS FORMAT. DTSBE417
|
|
00210 * DTSBU511 INITIALIZE MQTR. DTSBE417
|
|
00211 * DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE DTSBE417
|
|
00212 * FOR A GIVEN QUARTER. DTSBE417
|
|
00213 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE417
|
|
00214 * DTSBU931 REFERENCE FILE I/O DRIVER. DTSBE417
|
|
00215 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE417
|
|
00216 * DTSBE417
|
|
00217 ***** DTSBE417
|
|
00218 DTSBE417
|
|
00219 DTSBE417
|
|
00220 ENVIRONMENT DIVISION. DTSBE417
|
|
00221 INPUT-OUTPUT SECTION. DTSBE417
|
|
00222 SKIP3 DTSBE417
|
|
00223 FILE-CONTROL. DTSBE417
|
|
00224 SELECT DOWNLOAD-FILE ASSIGN TO DTSFE417 DTSBE417
|
|
00225 FILE STATUS IS DOWNLOAD-STATUS. DTSBE417
|
|
00226 DTSBE417
|
|
00227 SELECT EMP-RPT-FILE ASSIGN TO DTSBX212 DTSBE417
|
|
00228 FILE STATUS IS DOWNX212-STATUS. DTSBE417
|
|
00229 DTSBE417
|
|
00230 DTSBE417
|
|
00231 DATA DIVISION. DTSBE417
|
|
00232 FILE SECTION. DTSBE417
|
|
00233 FD DOWNLOAD-FILE DTSBE417
|
|
00234 RECORDING MODE IS F DTSBE417
|
|
00235 LABEL RECORDS ARE STANDARD DTSBE417
|
|
00236 BLOCK CONTAINS 0 CHARACTERS. DTSBE417
|
|
00237 SKIP1 DTSBE417
|
|
00238 01 DOWNLOAD-REC PIC X(51). DTSBE417
|
|
00239 DTSBE417
|
|
00240 DTSBE417
|
|
00241 FD EMP-RPT-FILE DTSBE417
|
|
00242 RECORDING MODE IS F DTSBE417
|
|
00243 BLOCK CONTAINS 0 RECORDS DTSBE417
|
|
00244 LABEL RECORDS ARE OMITTED. DTSBE417
|
|
00245 DTSBE417
|
|
00246 01 EMP-RPT-REC PIC X(106). DTSBE417
|
|
00247 DTSBE417
|
|
00248 DTSBE417
|
|
00249 DTSBE417
|
|
00250 WORKING-STORAGE SECTION. DTSBE417
|
|
002505 77 PAN-VALET PICTURE X(24) VALUE '003DTSBE417 02/21/20'. DTSBE417
|
|
00251 77 PAN-VALET PICTURE X(24) VALUE '089DTSBE417 09/02/14'. DTSBE417
|
|
00252 77 PAN-VALET PICTURE X(24) VALUE '018DTSBE417 09/02/14'. DTSBE417
|
|
00253 77 PAN-VALET PICTURE X(24) VALUE '087DTSBE417 02/26/14'. DTSBE417
|
|
00254 77 PAN-VALET PICTURE X(24) VALUE '010DTSBE417 02/25/14'. DTSBE417
|
|
00255 77 PAN-VALET PICTURE X(24) VALUE '085DTSBE417 11/12/13'. DTSBE417
|
|
00256 77 PAN-VALET PICTURE X(24) VALUE '003DTSBE417 11/08/13'. DTSBE417
|
|
00257 77 PAN-VALET PICTURE X(24) VALUE '083DTSBE417 11/07/13'. DTSBE417
|
|
00258 77 PAN-VALET PICTURE X(24) VALUE '002DTSBE417 07/02/13'. DTSBE417
|
|
00259 77 PAN-VALET PICTURE X(24) VALUE '080DTSBE417 04/01/13'. DTSBE417
|
|
00260 77 PAN-VALET PICTURE X(24) VALUE '008DTSBE417 03/29/13'. DTSBE417
|
|
00261 77 PAN-VALET PICTURE X(24) VALUE '078DTSBE417 05/27/10'. DTSBE417
|
|
00262 DTSBE417
|
|
00263 01 WRK-AREA. DTSBE417
|
|
00264 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +417.DTSBE417
|
|
00265 DTSBE417
|
|
00266 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE417'.DTSBE417
|
|
00267 DTSBE417
|
|
00268 05 DOWNLOAD-STATUS PIC X(02). DTSBE417
|
|
00269 88 DOWNLOAD-OK-88 VALUE '00'. DTSBE417
|
|
00270 DTSBE417
|
|
00271 DTSBE417
|
|
00272 05 DOWNX212-STATUS PIC X(02). DTSBE417
|
|
00273 88 DOWNX212-OK-88 VALUE '00'. DTSBE417
|
|
00274 DTSBE417
|
|
00275 05 WRK-DOWNLOAD-REC. DTSBE417
|
|
00276 10 D-EMP-NO PIC 9(06). DTSBE417
|
|
00277 10 FILLER PIC X(01) VALUE ';'. DTSBE417
|
|
00278 10 D-EMP-NAME PIC X(40). DTSBE417
|
|
00279 10 FILLER PIC X(01) VALUE ';'. DTSBE417
|
|
00280 10 D-LIAB-IND PIC X(01). DTSBE417
|
|
00281 10 FILLER PIC X(01) VALUE ';'. DTSBE417
|
|
00282 10 D-RET-MAIL-IND PIC X(01). DTSBE417
|
|
00283 DTSBE417
|
|
00284 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBE417
|
|
00285 VALUE +999999999. DTSBE417
|
|
00286 DTSBE417
|
|
00287 05 AMT-DISP1 PIC --------9.99. DTSBE417
|
|
00288 DTSBE417
|
|
00289 05 ABEND-MSG PIC X(60). DTSBE417
|
|
00290 DTSBE417
|
|
00291 05 WRK-PEN-CNT PIC S9(07) COMP-3 DTSBE417
|
|
00292 VALUE +0. DTSBE417
|
|
00293 05 WRK-SI-PEN-CNT PIC S9(07) COMP-3 DTSBE417
|
|
00294 VALUE +0. DTSBE417
|
|
00295 05 WRK-SI-DEL-CNT PIC S9(07) COMP-3 DTSBE417
|
|
00296 VALUE +0. DTSBE417
|
|
00297 05 WRK-DELINQUENT-CNT PIC S9(07) COMP-3 DTSBE417
|
|
00298 VALUE +0. DTSBE417
|
|
00299 05 WRK-OVER-2-MISS-CNT PIC S9(07) COMP-3 DTSBE417
|
|
00300 VALUE +0. DTSBE417
|
|
00301 05 WRK-TF-TABLE-CNT PIC S9(07) COMP-3 DTSBE417
|
|
00302 VALUE +0. DTSBE417
|
|
00303 05 WRK-BYPASS-CNT PIC S9(07) COMP-3 DTSBE417
|
|
00304 VALUE +0. DTSBE417
|
|
00305 DTSBE417
|
|
00306 05 WRK-TIMELY-PAYMENTS PIC S9(09)V99 COMP-3 DTSBE417
|
|
00307 VALUE +0. DTSBE417
|
|
00308 DTSBE417
|
|
00309 05 READ-EMP PIC S9(07) VALUE 0. DTSBE417
|
|
00310 DTSBE417
|
|
00311 05 WRK-PRINT-MISSING-LTR-IND PIC X(01) VALUE 'N'. DTSBE417
|
|
00312 DTSBE417
|
|
00313 05 INCONSISTENCY-ENCOUNTERED-IND PIC X(01). DTSBE417
|
|
00314 DTSBE417
|
|
00315 05 TPS-UNIV-QTR PIC 9(01) VALUE 1. DTSBE417
|
|
00316 DTSBE417
|
|
00317 05 WRK-TRIGGER-DATE PIC S9(09) COMP-3. DTSBE417
|
|
00318 DTSBE417
|
|
00319 05 WRK-ORIG-RECEIVED-DATE PIC S9(09) COMP-3. DTSBE417
|
|
00320 DTSBE417
|
|
00321 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBE417
|
|
00322 DTSBE417
|
|
00323 05 WRK-EMP-NO PIC S9(07) COMP-3 DTSBE417
|
|
00324 VALUE +0. DTSBE417
|
|
00325 DTSBE417
|
|
00326 05 WRK-ICESA-YRQ. DTSBE417
|
|
00327 10 WRK-ICESA-CCYY PIC 9999. DTSBE417
|
|
00328 10 FILLER PIC X. DTSBE417
|
|
00329 10 WRK-ICESA-QTR PIC 9. DTSBE417
|
|
00330 DTSBE417
|
|
00331 DTSBE417
|
|
00332 05 WRK-RPT. DTSBE417
|
|
00333 10 WRK-RPT-CCYY PIC 9999. DTSBE417
|
|
00334 10 WRK-RPT-QTR PIC 9. DTSBE417
|
|
00335 05 WRK-RPT-WS REDEFINES WRK-RPT PIC 9(5). DTSBE417
|
|
00336 DTSBE417
|
|
00337 05 WRK-RPT-YRQ PIC S9(5) COMP-3 DTSBE417
|
|
00338 VALUE +0. DTSBE417
|
|
00339 DTSBE417
|
|
00340 05 TF-SUB PIC S9(07) COMP-3. DTSBE417
|
|
00341 05 TF-MAX PIC S9(07) COMP-3 DTSBE417
|
|
00342 VALUE +999999. DTSBE417
|
|
00343 05 TRANS-FILE-RPTS OCCURS 999999 TIMES. DTSBE417
|
|
00344 10 TRANS-FILE-RPT-IND PIC X(01). DTSBE417
|
|
00345 88 TF-RPT-FOUND-YES-88 VALUE 'Y'. DTSBE417
|
|
00346 88 TF-RPT-FOUND-NO-88 VALUE 'N'. DTSBE417
|
|
00347 10 TRANS-BYPASSED-IND PIC X(01). DTSBE417
|
|
00348 88 TF-BYPASSED-YES-88 VALUE 'Y'. DTSBE417
|
|
00349 88 TF-BYPASSED-NO-88 VALUE 'N'. DTSBE417
|
|
00350 DTSBE417
|
|
00351 05 EVL-TEXT. DTSBE417
|
|
00352 10 FILLER PIC X(28) DTSBE417
|
|
00353 VALUE 'DELINQUENCY NOTICE FOR QTR '. DTSBE417
|
|
00354 10 EVL-SLASH-QTR PIC X(4). DTSBE417
|
|
00355 10 FILLER PIC X(9) DTSBE417
|
|
00356 VALUE ' MAILED '. DTSBE417
|
|
00357 10 EVL-ADDR-TYPE PIC X(04). DTSBE417
|
|
00358 10 EVL-ADDR-ID-NO PIC XXX. DTSBE417
|
|
00359 EJECT DTSBE417
|
|
00360 01 MSG-AREA. DTSBE417
|
|
00361 05 MSG1-AREA. DTSBE417
|
|
00362 10 MSG1-ID PIC X(03) VALUE '421'. DTSBE417
|
|
00363 10 MSG1-TEXT. DTSBE417
|
|
00364 15 FILLER PIC X(40) DTSBE417
|
|
00365 VALUE 'RATE MISSING. DELINQUENT REPORT LETTER '. DTSBE417
|
|
00366 15 FILLER PIC X(40) DTSBE417
|
|
00367 VALUE 'PRINTED WITHOUT A RATE. YRQ = '. DTSBE417
|
|
00368 15 MSG1-SLASHED-YRQ PIC X(04). DTSBE417
|
|
00369 DTSBE417
|
|
00370 05 MSG2-AREA. DTSBE417
|
|
00371 10 MSG2-ID PIC X(03) VALUE '422'. DTSBE417
|
|
00372 10 MSG2-TEXT. DTSBE417
|
|
00373 15 FILLER PIC X(40) DTSBE417
|
|
00374 VALUE 'DELINQUENT REPORT LETTER PRINTING SUPPRE'. DTSBE417
|
|
00375 15 FILLER PIC X(40) DTSBE417
|
|
00376 VALUE 'SSED ON ALL MTAD RECORDS. YRQ = '. DTSBE417
|
|
00377 15 MSG2-SLASHED-YRQ PIC X(04). DTSBE417
|
|
00378 DTSBE417
|
|
00379 05 MSG3-AREA. DTSBE417
|
|
00380 10 MSG3-ID PIC X(03) VALUE '423'. DTSBE417
|
|
00381 10 MSG3-TEXT. DTSBE417
|
|
00382 15 FILLER PIC X(40) DTSBE417
|
|
00383 VALUE 'MORE THAN 19 ADDITIONAL REPORTS ARE MISS'. DTSBE417
|
|
00384 15 FILLER PIC X(40) DTSBE417
|
|
00385 VALUE 'ING. INCOMPLETE LETTER PRINTED. YRQ = '. DTSBE417
|
|
00386 15 MSG3-SLASHED-YRQ PIC X(04). DTSBE417
|
|
00387 DTSBE417
|
|
00388 05 MSG4-AREA. DTSBE417
|
|
00389 10 MSG4-ID PIC X(03) VALUE '424'. DTSBE417
|
|
00390 10 MSG4-TEXT. DTSBE417
|
|
00391 15 FILLER PIC X(40) DTSBE417
|
|
00392 VALUE 'INCONSISTENT MQR-CURR-RPT-TYPE ENCOUNTER'. DTSBE417
|
|
00393 15 FILLER PIC X(40) DTSBE417
|
|
00394 VALUE 'ED. SCREAM AT PROGRAMMING. YRQ = '. DTSBE417
|
|
00395 15 MSG4-SLASHED-YRQ PIC X(04). DTSBE417
|
|
00396 DTSBE417
|
|
00397 05 MSG5-AREA. DTSBE417
|
|
00398 10 MSG5-ID PIC X(03) VALUE '425'. DTSBE417
|
|
00399 10 MSG5-TEXT. DTSBE417
|
|
00400 15 FILLER PIC X(40) DTSBE417
|
|
00401 VALUE 'DELINQUENT REPORT LETTER PRINTING SUPPRE'. DTSBE417
|
|
00402 15 FILLER PIC X(40) DTSBE417
|
|
00403 VALUE 'SSED FOR ALL ADDRESSES. YRQ = '. DTSBE417
|
|
00404 15 MSG5-SLASHED-YRQ PIC X(04). DTSBE417
|
|
00405 DTSBE417
|
|
00406 05 MSG6-AREA. DTSBE417
|
|
00407 10 MSG6-ID PIC X(03) VALUE '426'. DTSBE417
|
|
00408 10 MSG6-TEXT. DTSBE417
|
|
00409 15 FILLER PIC X(40) DTSBE417
|
|
00410 VALUE 'DELINQUENT QUARTER ADDED BUT RATE IS EST'. DTSBE417
|
|
00411 15 FILLER PIC X(40) DTSBE417
|
|
00412 VALUE 'IMATED. YRQ = '. DTSBE417
|
|
00413 15 MSG6-SLASHED-YRQ PIC X(04). DTSBE417
|
|
00414 DTSBE417
|
|
00415 01 FILLER PIC X(100) VALUE SPACES. DTSBE417
|
|
00416 DTSBE417
|
|
00417 01 W-EMP-RPT-REC. DTSBE417
|
|
00418 ++INCLUDE DTSIX212 DTSBE417
|
|
00419 DTSBE417
|
|
00420 01 L001-LINK-AREA. DTSBE417
|
|
00421 ++INCLUDE DTSIL001 DTSBE417
|
|
00422 EJECT DTSBE417
|
|
00423 01 L004-LINK-AREA. DTSBE417
|
|
00424 ++INCLUDE DTSIL004 DTSBE417
|
|
00425 EJECT DTSBE417
|
|
00426 01 L005-LINK-AREA. DTSBE417
|
|
00427 ++INCLUDE DTSIL005 DTSBE417
|
|
00428 EJECT DTSBE417
|
|
00429 01 L061-LINK-AREA. DTSBE417
|
|
00430 ++INCLUDE DTSIL061 DTSBE417
|
|
00431 EJECT DTSBE417
|
|
00432 01 L064-LINK-AREA. DTSBE417
|
|
00433 ++INCLUDE DTSIL064 DTSBE417
|
|
00434 EJECT DTSBE417
|
|
00435 01 L102-LINK-AREA. DTSBE417
|
|
00436 ++INCLUDE DTSIL102 DTSBE417
|
|
00437 EJECT DTSBE417
|
|
00438 01 L109-LINK-AREA. DTSBE417
|
|
00439 ++INCLUDE DTSIL109 DTSBE417
|
|
00440 EJECT DTSBE417
|
|
00441 01 L111-LINK-AREA. DTSBE417
|
|
00442 ++INCLUDE DTSIL111 DTSBE417
|
|
00443 EJECT DTSBE417
|
|
00444 01 L112-LINK-AREA. DTSBE417
|
|
00445 ++INCLUDE DTSIL112 DTSBE417
|
|
00446 EJECT DTSBE417
|
|
00447 01 L410-LINK-AREA. DTSBE417
|
|
00448 ++INCLUDE DTSIL410 DTSBE417
|
|
00449 EJECT DTSBE417
|
|
00450 01 L516-LINK-AREA. DTSBE417
|
|
00451 ++INCLUDE DTSIL516 DTSBE417
|
|
00452 EJECT DTSBE417
|
|
00453 01 L910-LINK-AREA. DTSBE417
|
|
00454 ++INCLUDE DTSIL910 DTSBE417
|
|
00455 SKIP3 DTSBE417
|
|
00456 01 MSKL-REC. DTSBE417
|
|
00457 ++INCLUDE DTSIMSKL DTSBE417
|
|
00458 SKIP3 DTSBE417
|
|
00459 01 MHDR-REC. DTSBE417
|
|
00460 ++INCLUDE DTSIMHDR DTSBE417
|
|
00461 SKIP3 DTSBE417
|
|
00462 01 MQTR-REC. DTSBE417
|
|
00463 ++INCLUDE DTSIMQTR DTSBE417
|
|
00464 SKIP3 DTSBE417
|
|
00465 01 MRPT-REC. DTSBE417
|
|
00466 ++INCLUDE DTSIMRPT DTSBE417
|
|
00467 SKIP3 DTSBE417
|
|
00468 01 MTAD-REC. DTSBE417
|
|
00469 ++INCLUDE DTSIMTAD DTSBE417
|
|
00470 SKIP3 DTSBE417
|
|
00471 01 MOPO-REC. DTSBE417
|
|
00472 ++INCLUDE DTSIMOPO DTSBE417
|
|
00473 SKIP3 DTSBE417
|
|
00474 01 MTAA-REC. DTSBE417
|
|
00475 ++INCLUDE DTSIMTAA DTSBE417
|
|
00476 SKIP3 DTSBE417
|
|
00477 01 MEVL-REC. DTSBE417
|
|
00478 ++INCLUDE DTSIMEVL DTSBE417
|
|
00479 SKIP3 DTSBE417
|
|
00480 01 MTCK-REC. DTSBE417
|
|
00481 ++INCLUDE DTSIMTCK DTSBE417
|
|
00482 EJECT DTSBE417
|
|
00483 01 MDST-REC. DTSBE417
|
|
00484 ++INCLUDE DTSIMDST DTSBE417
|
|
00485 EJECT DTSBE417
|
|
00486 01 L923-LINK-AREA. DTSBE417
|
|
00487 ++INCLUDE DTSIL923 DTSBE417
|
|
00488 EJECT DTSBE417
|
|
00489 01 ASKL-REC. DTSBE417
|
|
00490 ++INCLUDE DTSIASKL DTSBE417
|
|
00491 EJECT DTSBE417
|
|
00492 01 ARPT-REC. DTSBE417
|
|
00493 ++INCLUDE DTSIARPT DTSBE417
|
|
00494 DTSBE417
|
|
00495 01 L931-LINK-AREA. DTSBE417
|
|
00496 ++INCLUDE DTSIL931 DTSBE417
|
|
00497 SKIP3 DTSBE417
|
|
00498 01 FSKL-REC. DTSBE417
|
|
00499 ++INCLUDE DTSIFSKL DTSBE417
|
|
00500 SKIP3 DTSBE417
|
|
00501 01 FQTR-REC. DTSBE417
|
|
00502 ++INCLUDE DTSIFQTR DTSBE417
|
|
00503 EJECT DTSBE417
|
|
00504 01 R417-REC. DTSBE417
|
|
00505 ++INCLUDE DTSIR417 DTSBE417
|
|
00506 SKIP3 DTSBE417
|
|
00507 01 R418-REC. DTSBE417
|
|
00508 ++INCLUDE DTSIR418 DTSBE417
|
|
00509 SKIP3 DTSBE417
|
|
00510 01 R716-REC. DTSBE417
|
|
00511 ++INCLUDE DTSIR716 DTSBE417
|
|
00512 SKIP3 DTSBE417
|
|
00513 01 R907-REC. DTSBE417
|
|
00514 ++INCLUDE DTSIR907 DTSBE417
|
|
00515 EJECT DTSBE417
|
|
00516 01 L927-LINK-AREA. DTSBE417
|
|
00517 ++INCLUDE DTSIL927 DTSBE417
|
|
00518 DTSBE417
|
|
00519 01 T026-REC. DTSBE417
|
|
00520 ++INCLUDE DTSIT026 DTSBE417
|
|
00521 DTSBE417
|
|
00522 01 CACT-LITERALS. DTSBE417
|
|
00523 ++INCLUDE DTSICACT DTSBE417
|
|
00524 DTSBE417
|
|
00525 ++INCLUDE OJRWE417 DTSBE417
|
|
00526 EJECT DTSBE417
|
|
00527 LINKAGE SECTION. DTSBE417
|
|
00528 SKIP3 DTSBE417
|
|
00529 01 LECM-LINK-AREA. DTSBE417
|
|
00530 ++INCLUDE DTSILECM DTSBE417
|
|
00531 SKIP3 DTSBE417
|
|
00532 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE417
|
|
00533 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE417
|
|
00534 15 FILLER PIC X(01). DTSBE417
|
|
00535 15 LECM-PARM-RETURN-BY-DATE DTSBE417
|
|
00536 PIC X(06). DTSBE417
|
|
00537 15 FILLER PIC X(58). DTSBE417
|
|
00538 EJECT DTSBE417
|
|
00539 01 MPRF-LINK-REC. DTSBE417
|
|
00540 ++INCLUDE DTSIMPRF DTSBE417
|
|
00541 EJECT DTSBE417
|
|
00542 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE417
|
|
00543 MPRF-LINK-REC. DTSBE417
|
|
00544 DTSBE417
|
|
00545 EVALUATE TRUE DTSBE417
|
|
00546 WHEN LECM-PROCESS-88 DTSBE417
|
|
00547 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE417
|
|
00548 DTSBE417
|
|
00549 WHEN LECM-INITIALIZE-88 DTSBE417
|
|
00550 SET WRK-EDIT-PASSED-88 TO TRUE DTSBE417
|
|
00551 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE417
|
|
00552 IF WRK-EDIT-FAILED-88 DTSBE417
|
|
00553 PERFORM S999-ABEND THRU S999-EXIT DTSBE417
|
|
00554 END-IF DTSBE417
|
|
00555 DTSBE417
|
|
00556 WHEN LECM-TERMINATE-88 DTSBE417
|
|
00557 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE417
|
|
00558 DTSBE417
|
|
00559 WHEN OTHER DTSBE417
|
|
00560 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE417
|
|
00561 TO ABEND-MSG DTSBE417
|
|
00562 PERFORM S999-ABEND THRU S999-EXIT. DTSBE417
|
|
00563 DTSBE417
|
|
00564 DTSBE417
|
|
00565 GOBACK. DTSBE417
|
|
00566 EJECT DTSBE417
|
|
00567 I0000-INITIALIZE. DTSBE417
|
|
00568 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE417
|
|
00569 L931-TRACE-IND DTSBE417
|
|
00570 L516-TRACE-IND. DTSBE417
|
|
00571 DTSBE417
|
|
00572 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE417
|
|
00573 L931-MOD-NAME DTSBE417
|
|
00574 R907-MODULE-NAME. DTSBE417
|
|
00575 DTSBE417
|
|
00576 MOVE LECM-PARM-SUBJECT-YRQ TO DTSBE417
|
|
00577 OJR-PARM-SUBJECT-YRQ. DTSBE417
|
|
00578 DTSBE417
|
|
00579 MOVE LECM-PARM-RETURN-BY-DATE TO DTSBE417
|
|
00580 OJR-PARM-RETURN-BY-DATE. DTSBE417
|
|
00581 DTSBE417
|
|
00582 MOVE LECM-PARM-SUBJECT-YRQ TO DTSBE417
|
|
00583 OJR-PARM-SUBJECT-YRQ. DTSBE417
|
|
00584 DTSBE417
|
|
00585 MOVE LECM-PARM-RETURN-BY-DATE TO DTSBE417
|
|
00586 OJR-PARM-RETURN-BY-DATE. DTSBE417
|
|
00587 DTSBE417
|
|
00588 MOVE LENGTH OF T026-REC TO T026-LENGTH. DTSBE417
|
|
00589 MOVE '026' TO T026-REC-TYPE. DTSBE417
|
|
00590 MOVE WRK-MOD-NAME TO T026-ORIGIN. DTSBE417
|
|
00591 MOVE LECM-SYS-DATE TO T026-SYS-DATE. DTSBE417
|
|
00592 MOVE LECM-SYS-TIME TO T026-SYS-TIME. DTSBE417
|
|
00593 DTSBE417
|
|
00594 MOVE LENGTH OF R417-REC TO R417-LENGTH. DTSBE417
|
|
00595 DTSBE417
|
|
00596 MOVE '417' TO R417-REC-TYPE. DTSBE417
|
|
00597 DTSBE417
|
|
00598 MOVE LENGTH OF R418-REC TO R418-LENGTH. DTSBE417
|
|
00599 DTSBE417
|
|
00600 MOVE '418' TO R418-REC-TYPE. DTSBE417
|
|
00601 DTSBE417
|
|
00602 MOVE LENGTH OF R716-REC TO R716-LENGTH. DTSBE417
|
|
00603 DTSBE417
|
|
00604 MOVE '716' TO R716-REC-TYPE. DTSBE417
|
|
00605 DTSBE417
|
|
00606 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE417
|
|
00607 DTSBE417
|
|
00608 MOVE '907' TO R907-REC-TYPE. DTSBE417
|
|
00609 DTSBE417
|
|
00610 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE417
|
|
00611 DTSBE417
|
|
00612 DTSBE417
|
|
00613 IF WRK-PARM-SUBJECT-YRQ > LECM-LAST-UC30-DEL-MAIL-YRQ DTSBE417
|
|
00614 MOVE WRK-PARM-SUBJECT-YRQ DTSBE417
|
|
00615 TO LECM-LAST-UC30-DEL-MAIL-YRQ. DTSBE417
|
|
00616 DTSBE417
|
|
00617 DTSBE417
|
|
00618 PERFORM I2000-FIRST-PURSUED-RPT-YRQ THRU I2000-EXIT. DTSBE417
|
|
00619 DTSBE417
|
|
00620 DTSBE417
|
|
00621 IF WRK-FIRST-PURSUED-RPT-YRQ > LECM-FIRST-PURSUED-RPT-YRQ DTSBE417
|
|
00622 MOVE WRK-FIRST-PURSUED-RPT-YRQ DTSBE417
|
|
00623 TO LECM-FIRST-PURSUED-RPT-YRQ. DTSBE417
|
|
00624 DTSBE417
|
|
00625 PERFORM I3000-TRANS-FILE-RPTS THRU I3000-EXIT. DTSBE417
|
|
00626 DTSBE417
|
|
00627 OPEN INPUT EMP-RPT-FILE DTSBE417
|
|
00628 IF NOT DOWNX212-OK-88 DTSBE417
|
|
00629 DISPLAY 'CANNOT OPEN WEB REPORT FILE -BX212 ' DTSBE417
|
|
00630 DOWNX212-STATUS DTSBE417
|
|
00631 PERFORM S999-ABEND THRU S999-EXIT DTSBE417
|
|
00632 END-IF. DTSBE417
|
|
00633 DISPLAY ' EMP FILE OPEND ' DOWNX212-STATUS. DTSBE417
|
|
00634 DTSBE417
|
|
00635 PERFORM I4000-TRANS-UPLOAD THRU I4000-EXIT. DTSBE417
|
|
00636 DTSBE417
|
|
00637 DISPLAY ' EMP TABLE COMPLETED ' DTSBE417
|
|
00638 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE417
|
|
00639 DTSBE417
|
|
00640 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE417
|
|
00641 DTSBE417
|
|
00642 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBE417
|
|
00643 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBE417
|
|
00644 DTSBE417
|
|
00645 DTSBE417
|
|
00646 OPEN OUTPUT DOWNLOAD-FILE. DTSBE417
|
|
00647 IF NOT DOWNLOAD-OK-88 DTSBE417
|
|
00648 DISPLAY 'CANNOT OPEN DOWNLOAD FILE ' DOWNLOAD-STATUS DTSBE417
|
|
00649 PERFORM S999-ABEND THRU S999-EXIT DTSBE417
|
|
00650 END-IF. DTSBE417
|
|
00651 DTSBE417
|
|
00652 DTSBE417
|
|
00653 I0000-EXIT. DTSBE417
|
|
00654 EXIT. DTSBE417
|
|
00655 ++INCLUDE OJRPE417 DTSBE417
|
|
00656 DTSBE417
|
|
00657 I3000-TRANS-FILE-RPTS. DTSBE417
|
|
00658 PERFORM DTSBE417
|
|
00659 VARYING TF-SUB FROM +1 BY +1 DTSBE417
|
|
00660 UNTIL TF-SUB > TF-MAX DTSBE417
|
|
00661 SET TF-RPT-FOUND-NO-88 (TF-SUB) TO TRUE DTSBE417
|
|
00662 SET TF-BYPASSED-NO-88 (TF-SUB) TO TRUE DTSBE417
|
|
00663 END-PERFORM. DTSBE417
|
|
00664 DTSBE417
|
|
00665 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBE417
|
|
00666 DTSBE417
|
|
00667 MOVE ZERO TO ASKL-BATCH-NO DTSBE417
|
|
00668 ASKL-ITEM-NO. DTSBE417
|
|
00669 DTSBE417
|
|
00670 PERFORM S923-START-BROWSE THRU S923-EXIT. DTSBE417
|
|
00671 PERFORM UNTIL L923-NO-REC-88 DTSBE417
|
|
00672 IF ASKL-RPT-88 DTSBE417
|
|
00673 MOVE ASKL-REC TO ARPT-REC DTSBE417
|
|
00674 IF (ARPT-ORIG-88 DTSBE417
|
|
00675 AND ARPT-YRQ = WRK-PARM-SUBJECT-YRQ DTSBE417
|
|
00676 AND ARPT-NOT-PROCESSED-88) DTSBE417
|
|
00677 IF NOT ARPT-EMP-NO-NO-ENTRY-88 DTSBE417
|
|
00678 SET TF-RPT-FOUND-YES-88 (ARPT-EMP-NO) TO TRUE DTSBE417
|
|
00679 ADD +1 TO WRK-TF-TABLE-CNT DTSBE417
|
|
00680 DISPLAY 'I3 ' ARPT-EMP-NO ' ' ARPT-BATCH-NO DTSBE417
|
|
00681 ' ' ARPT-ITEM-NO DTSBE417
|
|
00682 END-IF DTSBE417
|
|
00683 END-IF DTSBE417
|
|
00684 END-IF DTSBE417
|
|
00685 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBE417
|
|
00686 END-PERFORM. DTSBE417
|
|
00687 DTSBE417
|
|
00688 PERFORM S923-CLOSE THRU S923-EXIT. DTSBE417
|
|
00689 DTSBE417
|
|
00690 I3000-EXIT. DTSBE417
|
|
00691 EXIT. DTSBE417
|
|
00692 I4000-TRANS-UPLOAD. DTSBE417
|
|
00693 READ EMP-RPT-FILE INTO W-EMP-RPT-REC AT END DTSBE417
|
|
00694 GO TO I4000-EXIT. DTSBE417
|
|
00695 MOVE X212-EMP-NBR TO WRK-EMP-NO DTSBE417
|
|
00696 MOVE X212-QTR TO WRK-ICESA-YRQ DTSBE417
|
|
00697 MOVE WRK-ICESA-CCYY TO WRK-RPT-CCYY DTSBE417
|
|
00698 MOVE WRK-ICESA-QTR TO WRK-RPT-QTR DTSBE417
|
|
00699 DTSBE417
|
|
00700 MOVE WRK-RPT-WS TO WRK-RPT-YRQ. DTSBE417
|
|
00701 DTSBE417
|
|
00702 IF WRK-RPT-YRQ = WRK-PARM-SUBJECT-YRQ DTSBE417
|
|
00703 SET TF-RPT-FOUND-YES-88 (WRK-EMP-NO) TO TRUE DTSBE417
|
|
00704 ADD +1 TO WRK-TF-TABLE-CNT. DTSBE417
|
|
00705 DISPLAY 'WEB-ICESA: ' WRK-EMP-NO ' ' WRK-RPT-YRQ. DTSBE417
|
|
00706 DTSBE417
|
|
00707 GO TO I4000-TRANS-UPLOAD. DTSBE417
|
|
00708 I4000-EXIT. DTSBE417
|
|
00709 EXIT. DTSBE417
|
|
00710 P0000-PROCESS. DTSBE417
|
|
00711 *****IF (MPRF-EMP-NO < 360094) DTSBE417
|
|
00712 *************OR DTSBE417
|
|
00713 ********(MPRF-EMP-NO > 360098) DTSBE417
|
|
00714 *********GO TO P0000-EXIT. DTSBE417
|
|
00715 DTSBE417
|
|
00716 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE417
|
|
00717 DTSBE417
|
|
00718 IF MPRF-CLASS-SUB-88 DTSBE417
|
|
00719 SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSBE417
|
|
00720 MOVE MPRF-EMP-NO TO L410-EMP-NO DTSBE417
|
|
00721 MOVE WRK-PARM-SUBJECT-YRQ TO L410-YRQ DTSBE417
|
|
00722 PERFORM S410-FILE-SCHED THRU S410-EXIT DTSBE417
|
|
00723 IF L410-ANN-SCHED-88 DTSBE417
|
|
00724 *** DISPLAY ' **** ANNUAL FILER CANNOT PROCESS' MPRF-EMP-NDTSBE417
|
|
00725 GO TO P0000-EXIT DTSBE417
|
|
00726 END-IF DTSBE417
|
|
00727 END-IF. DTSBE417
|
|
00728 DTSBE417
|
|
00729 ********************************************************** DTSBE417
|
|
00730 * SELECT EMPLOYERS LIABLE DURING THE SUBJECT QUARTER DTSBE417
|
|
00731 * BUT WHERE THE QUARTER IS NOT PURSUED. DTSBE417
|
|
00732 ********************************************************** DTSBE417
|
|
00733 IF MPRF-CLASS-SUB-88 DTSBE417
|
|
00734 NEXT SENTENCE DTSBE417
|
|
00735 ELSE DTSBE417
|
|
00736 GO TO P0000-EXIT. DTSBE417
|
|
00737 DTSBE417
|
|
00738 MOVE WRK-PARM-SUBJECT-YRQ TO L516-YRQ. DTSBE417
|
|
00739 PERFORM S516-LIABILITY THRU S516-EXIT. DTSBE417
|
|
00740 IF L516-LIABLE-88 DTSBE417
|
|
00741 MOVE LOW-VALUES TO MQTR-KEY-AREA DTSBE417
|
|
00742 MOVE MPRF-EMP-NO TO MQTR-EMP-NO DTSBE417
|
|
00743 SET MQTR-QTR-88 TO TRUE DTSBE417
|
|
00744 MOVE WRK-PARM-SUBJECT-YRQ TO MQTR-YRQ DTSBE417
|
|
00745 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBE417
|
|
00746 PERFORM S910-READ THRU S910-EXIT DTSBE417
|
|
00747 IF L910-OK-88 DTSBE417
|
|
00748 MOVE MSKL-REC TO MQTR-REC DTSBE417
|
|
00749 IF NOT MQTR-CURR-RCVD-88 DTSBE417
|
|
00750 AND MQTR-RPT-NOT-PURSUED-88 DTSBE417
|
|
00751 NEXT SENTENCE DTSBE417
|
|
00752 ELSE DTSBE417
|
|
00753 GO TO P0000-EXIT DTSBE417
|
|
00754 END-IF DTSBE417
|
|
00755 ELSE DTSBE417
|
|
00756 NEXT SENTENCE DTSBE417
|
|
00757 END-IF DTSBE417
|
|
00758 ELSE DTSBE417
|
|
00759 GO TO P0000-EXIT DTSBE417
|
|
00760 END-IF. DTSBE417
|
|
00761 DTSBE417
|
|
00762 MOVE MPRF-EMP-NO TO D-EMP-NO. DTSBE417
|
|
00763 MOVE MPRF-PRIMARY-NAME TO D-EMP-NAME. DTSBE417
|
|
00764 IF L516-LIABLE-88 DTSBE417
|
|
00765 MOVE 'Y' TO D-LIAB-IND DTSBE417
|
|
00766 ELSE DTSBE417
|
|
00767 MOVE 'N' TO D-LIAB-IND DTSBE417
|
|
00768 END-IF. DTSBE417
|
|
00769 MOVE MPRF-RETURN-MAIL-IND TO D-RET-MAIL-IND. DTSBE417
|
|
00770 DTSBE417
|
|
00771 WRITE DOWNLOAD-REC FROM WRK-DOWNLOAD-REC. DTSBE417
|
|
00772 IF NOT DOWNLOAD-OK-88 DTSBE417
|
|
00773 DISPLAY 'CANNOT WRITE DOWNLOAD REC ' DTSBE417
|
|
00774 DOWNLOAD-STATUS DTSBE417
|
|
00775 END-IF. DTSBE417
|
|
00776 DTSBE417
|
|
00777 DISPLAY 'P0000 ' MPRF-EMP-NO ' ' L516-LIABLE-IND DTSBE417
|
|
00778 ' ' L516-YRQ ' ' MPRF-RETURN-MAIL-IND. DTSBE417
|
|
00779 ********************************************************** DTSBE417
|
|
00780 ** IF MPRF-PURSUED-RPT-CNT > +0 DTSBE417
|
|
00781 ** PERFORM P1000-DROP-PURSUIT THRU P1000-EXIT. DTSBE417
|
|
00782 DTSBE417
|
|
00783 MOVE 'N' TO WRK-SUBJECT-YRQ-PURSUED-IND. DTSBE417
|
|
00784 DTSBE417
|
|
00785 MOVE +0 TO WRK-SUBJECT-YRQ-RPT-DUE-DATE. DTSBE417
|
|
00786 DTSBE417
|
|
00787 SET WRK-SUBJECT-YRQ-NO-UI-RATE-88 TO TRUE. DTSBE417
|
|
00788 DTSBE417
|
|
00789 PERFORM P2000-SUBJECT-YRQ THRU P2000-EXIT. DTSBE417
|
|
00790 DTSBE417
|
|
00791 IF WRK-SUBJECT-YRQ-PURSUED-IND = 'Y' DTSBE417
|
|
00792 IF MPRF-RETURN-MAIL-NO-88 DTSBE417
|
|
00793 PERFORM P3000-CONSTRUCT-RPT-RECS THRU P3000-EXIT DTSBE417
|
|
00794 MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR DTSBE417
|
|
00795 MOVE SPACES TO EVL-ADDR-TYPE DTSBE417
|
|
00796 MOVE SPACES TO EVL-ADDR-ID-NO DTSBE417
|
|
00797 PERFORM S4000-WRITE-MEVL THRU S4000-EXIT DTSBE417
|
|
00798 END-IF DTSBE417
|
|
00799 PERFORM P4000-PENALTY THRU P4000-EXIT DTSBE417
|
|
00800 END-IF. DTSBE417
|
|
00801 DTSBE417
|
|
00802 P0000-EXIT. DTSBE417
|
|
00803 EXIT. DTSBE417
|
|
00804 EJECT DTSBE417
|
|
00805 P1000-DROP-PURSUIT. DTSBE417
|
|
00806 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE417
|
|
00807 DTSBE417
|
|
00808 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE417
|
|
00809 DTSBE417
|
|
00810 SET MQTR-QTR-88 TO TRUE. DTSBE417
|
|
00811 DTSBE417
|
|
00812 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
00813 DTSBE417
|
|
00814 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
00815 DTSBE417
|
|
00816 PERFORM P1100-SCAN-MQTR THRU P1100-EXIT DTSBE417
|
|
00817 UNTIL L910-NO-REC-88. DTSBE417
|
|
00818 P1000-EXIT. DTSBE417
|
|
00819 EXIT. DTSBE417
|
|
00820 SKIP3 DTSBE417
|
|
00821 P1100-SCAN-MQTR. DTSBE417
|
|
00822 MOVE MSKL-REC TO MQTR-REC. DTSBE417
|
|
00823 DTSBE417
|
|
00824 IF MQTR-YRQ < WRK-FIRST-PURSUED-RPT-YRQ DTSBE417
|
|
00825 NEXT SENTENCE DTSBE417
|
|
00826 ELSE DTSBE417
|
|
00827 SET L910-NO-REC-88 TO TRUE DTSBE417
|
|
00828 GO TO P1100-EXIT. DTSBE417
|
|
00829 DTSBE417
|
|
00830 IF MQTR-RPT-IS-PURSUED-88 DTSBE417
|
|
00831 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE DTSBE417
|
|
00832 MOVE MQTR-REC TO MSKL-REC DTSBE417
|
|
00833 PERFORM S910-REWRITE THRU S910-EXIT DTSBE417
|
|
00834 IF MPRF-PURSUED-RPT-CNT > +0 DTSBE417
|
|
00835 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT. DTSBE417
|
|
00836 DTSBE417
|
|
00837 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE417
|
|
00838 P1100-EXIT. DTSBE417
|
|
00839 EXIT. DTSBE417
|
|
00840 EJECT DTSBE417
|
|
00841 P2000-SUBJECT-YRQ. DTSBE417
|
|
00842 MOVE WRK-PARM-SUBJECT-YRQ TO L516-YRQ. DTSBE417
|
|
00843 DTSBE417
|
|
00844 PERFORM S516-LIABILITY THRU S516-EXIT. DTSBE417
|
|
00845 DTSBE417
|
|
00846 DTSBE417
|
|
00847 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE417
|
|
00848 DTSBE417
|
|
00849 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE417
|
|
00850 DTSBE417
|
|
00851 SET MQTR-QTR-88 TO TRUE. DTSBE417
|
|
00852 DTSBE417
|
|
00853 MOVE WRK-PARM-SUBJECT-YRQ TO MQTR-YRQ. DTSBE417
|
|
00854 DTSBE417
|
|
00855 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
00856 DTSBE417
|
|
00857 PERFORM S910-READ THRU S910-EXIT. DTSBE417
|
|
00858 DTSBE417
|
|
00859 IF L910-OK-88 DTSBE417
|
|
00860 PERFORM P2100-MQTR-EXISTS THRU P2100-EXIT DTSBE417
|
|
00861 ELSE DTSBE417
|
|
00862 PERFORM P2200-NO-MQTR-EXISTS THRU P2200-EXIT. DTSBE417
|
|
00863 P2000-EXIT. DTSBE417
|
|
00864 EXIT. DTSBE417
|
|
00865 SKIP3 DTSBE417
|
|
00866 P2100-MQTR-EXISTS. DTSBE417
|
|
00867 MOVE MSKL-REC TO MQTR-REC. DTSBE417
|
|
00868 DTSBE417
|
|
00869 DTSBE417
|
|
00870 MOVE 'N' TO INCONSISTENCY-ENCOUNTERED-IND. DTSBE417
|
|
00871 DTSBE417
|
|
00872 IF TF-RPT-FOUND-YES-88 (MPRF-EMP-NO) DTSBE417
|
|
00873 SET TF-BYPASSED-YES-88 (MPRF-EMP-NO) TO TRUE DTSBE417
|
|
00874 ADD +1 TO WRK-BYPASS-CNT DTSBE417
|
|
00875 GO TO P2100-EXIT DTSBE417
|
|
00876 END-IF. DTSBE417
|
|
00877 DTSBE417
|
|
00878 DTSBE417
|
|
00879 IF L516-LIABLE-88 DTSBE417
|
|
00880 PERFORM P2110-LIABLE THRU P2110-EXIT DTSBE417
|
|
00881 ELSE DTSBE417
|
|
00882 PERFORM P2120-NOT-LIABLE THRU P2120-EXIT. DTSBE417
|
|
00883 DTSBE417
|
|
00884 DTSBE417
|
|
00885 IF INCONSISTENCY-ENCOUNTERED-IND = 'Y' DTSBE417
|
|
00886 NEXT SENTENCE DTSBE417
|
|
00887 ELSE DTSBE417
|
|
00888 IF MQTR-RPT-IS-PURSUED-88 DTSBE417
|
|
00889 MOVE 'Y' TO WRK-SUBJECT-YRQ-PURSUED-IND DTSBE417
|
|
00890 MOVE MQTR-RPT-DUE-DATE DTSBE417
|
|
00891 TO WRK-SUBJECT-YRQ-RPT-DUE-DATE DTSBE417
|
|
00892 MOVE MQTR-UI-RATE TO WRK-SUBJECT-YRQ-UI-RATE. DTSBE417
|
|
00893 DTSBE417
|
|
00894 DTSBE417
|
|
00895 MOVE LECM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBE417
|
|
00896 DTSBE417
|
|
00897 MOVE MQTR-REC TO MSKL-REC. DTSBE417
|
|
00898 DTSBE417
|
|
00899 PERFORM S910-REWRITE THRU S910-EXIT. DTSBE417
|
|
00900 P2100-EXIT. DTSBE417
|
|
00901 EXIT. DTSBE417
|
|
00902 SKIP3 DTSBE417
|
|
00903 P2110-LIABLE. DTSBE417
|
|
00904 IF MQTR-CURR-NOT-LIABLE-88 DTSBE417
|
|
00905 PERFORM S9100-INCONSISTENT-RPT-TYPE THRU S9100-EXIT DTSBE417
|
|
00906 ELSE DTSBE417
|
|
00907 IF MQTR-CURR-RCVD-88 OR MQTR-CURR-ESTIM-88 DTSBE417
|
|
00908 NEXT SENTENCE DTSBE417
|
|
00909 ELSE DTSBE417
|
|
00910 IF MQTR-RPT-DUE-DATE = WRK-SUBJECT-YRQ-DEF-DUE-DATE DTSBE417
|
|
00911 SET MQTR-CURR-DELINQ-88 TO TRUE DTSBE417
|
|
00912 ELSE DTSBE417
|
|
00913 IF MQTR-RPT-DUE-DATE <= LECM-PRIOR-RUN-DATE DTSBE417
|
|
00914 IF MQTR-CURR-NOT-DUE-88 DTSBE417
|
|
00915 PERFORM S9100-INCONSISTENT-RPT-TYPE DTSBE417
|
|
00916 THRU S9100-EXIT DTSBE417
|
|
00917 ELSE DTSBE417
|
|
00918 NEXT SENTENCE DTSBE417
|
|
00919 ELSE DTSBE417
|
|
00920 IF MQTR-CURR-NOT-DUE-88 DTSBE417
|
|
00921 MOVE MQTR-RPT-DUE-DATE TO WRK-TRIGGER-DATE DTSBE417
|
|
00922 PERFORM S3000-ESTB-MTCK THRU S3000-EXIT DTSBE417
|
|
00923 ELSE DTSBE417
|
|
00924 PERFORM S9100-INCONSISTENT-RPT-TYPE DTSBE417
|
|
00925 THRU S9100-EXIT. DTSBE417
|
|
00926 DTSBE417
|
|
00927 DTSBE417
|
|
00928 PERFORM S1000-PURSUED-RPT-IND THRU S1000-EXIT. DTSBE417
|
|
00929 DTSBE417
|
|
00930 DTSBE417
|
|
00931 PERFORM S2000-MISS-RPT-CUTOFF-CD THRU S2000-EXIT. DTSBE417
|
|
00932 DTSBE417
|
|
00933 DTSBE417
|
|
00934 P2110-EXIT. DTSBE417
|
|
00935 EXIT. DTSBE417
|
|
00936 SKIP3 DTSBE417
|
|
00937 P2120-NOT-LIABLE. DTSBE417
|
|
00938 IF MQTR-CURR-NOT-LIABLE-88 DTSBE417
|
|
00939 NEXT SENTENCE DTSBE417
|
|
00940 ELSE DTSBE417
|
|
00941 PERFORM S9100-INCONSISTENT-RPT-TYPE THRU S9100-EXIT. DTSBE417
|
|
00942 DTSBE417
|
|
00943 DTSBE417
|
|
00944 PERFORM S2000-MISS-RPT-CUTOFF-CD THRU S2000-EXIT. DTSBE417
|
|
00945 P2120-EXIT. DTSBE417
|
|
00946 EXIT. DTSBE417
|
|
00947 SKIP3 DTSBE417
|
|
00948 P2200-NO-MQTR-EXISTS. DTSBE417
|
|
00949 IF L516-NOT-LIABLE-88 DTSBE417
|
|
00950 GO TO P2200-EXIT. DTSBE417
|
|
00951 DTSBE417
|
|
00952 IF TF-RPT-FOUND-YES-88 (MPRF-EMP-NO) DTSBE417
|
|
00953 SET TF-BYPASSED-YES-88 (MPRF-EMP-NO) TO TRUE DTSBE417
|
|
00954 ADD +1 TO WRK-BYPASS-CNT DTSBE417
|
|
00955 GO TO P2200-EXIT DTSBE417
|
|
00956 END-IF. DTSBE417
|
|
00957 DTSBE417
|
|
00958 * DISPLAY 'NO QTR RECORD FOUND ' MPRF-EMP-NO DTSBE417
|
|
00959 * MOVE 'Y' WRK-PRINT-MISSING-LTR-IND. DTSBE417
|
|
00960 * GO TO P2200-EXIT DTSBE417
|
|
00961 * DTSBE417
|
|
00962 * PRINT LETTER WHEN NO QUARTER RECORD EXISTS DTSBE417
|
|
00963 * DO NOT CREATE QUARTER RECORD DTSBE417
|
|
00964 * DTSBE417
|
|
00965 * BACK TO NORMAL - CREATE QTR ZL1 DTSBE417
|
|
00966 * DTSBE417
|
|
00967 * DTSBE417
|
|
00968 PERFORM S511-INITIALIZE-MQTR THRU S511-EXIT. DTSBE417
|
|
00969 DTSBE417
|
|
00970 DTSBE417
|
|
00971 IF L516-DEFAULT-RPT-DUE-DATE = WRK-SUBJECT-YRQ-DEF-DUE-DATE DTSBE417
|
|
00972 SET MQTR-CURR-DELINQ-88 TO TRUE DTSBE417
|
|
00973 ELSE DTSBE417
|
|
00974 IF L516-DEFAULT-RPT-DUE-DATE < LECM-CURR-RUN-DATE DTSBE417
|
|
00975 SET MQTR-CURR-DELINQ-88 TO TRUE DTSBE417
|
|
00976 ELSE DTSBE417
|
|
00977 SET MQTR-CURR-NOT-DUE-88 TO TRUE DTSBE417
|
|
00978 MOVE L516-DEFAULT-RPT-DUE-DATE TO WRK-TRIGGER-DATE DTSBE417
|
|
00979 PERFORM S3000-ESTB-MTCK THRU S3000-EXIT. DTSBE417
|
|
00980 DTSBE417
|
|
00981 DTSBE417
|
|
00982 PERFORM S1000-PURSUED-RPT-IND THRU S1000-EXIT DTSBE417
|
|
00983 DTSBE417
|
|
00984 DTSBE417
|
|
00985 PERFORM S2000-MISS-RPT-CUTOFF-CD THRU S2000-EXIT. DTSBE417
|
|
00986 DTSBE417
|
|
00987 IF L516-ESTIMATED-RATE-88 DTSBE417
|
|
00988 MOVE MSG6-ID TO R907-MSG-ID DTSBE417
|
|
00989 MOVE WRK-SUBJECT-SLASH-QTR TO MSG6-SLASHED-YRQ DTSBE417
|
|
00990 MOVE MSG6-TEXT TO R907-MSG-TEXT DTSBE417
|
|
00991 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE417
|
|
00992 DTSBE417
|
|
00993 MOVE L516-UI-RATE TO MQTR-UI-RATE. DTSBE417
|
|
00994 DTSBE417
|
|
00995 MOVE L516-DEFAULT-TAX-DUE-DATE TO MQTR-TAX-DUE-DATE DTSBE417
|
|
00996 DTSBE417
|
|
00997 MOVE L516-DEFAULT-RPT-DUE-DATE TO MQTR-RPT-DUE-DATE. DTSBE417
|
|
00998 DTSBE417
|
|
00999 MOVE LECM-CURR-RUN-DATE TO MQTR-ESTB-DATE DTSBE417
|
|
01000 MQTR-CHNG-DATE. DTSBE417
|
|
01001 DTSBE417
|
|
01002 IF MQTR-RPT-IS-PURSUED-88 DTSBE417
|
|
01003 MOVE 'Y' TO WRK-SUBJECT-YRQ-PURSUED-IND DTSBE417
|
|
01004 MOVE MQTR-RPT-DUE-DATE DTSBE417
|
|
01005 TO WRK-SUBJECT-YRQ-RPT-DUE-DATE DTSBE417
|
|
01006 MOVE MQTR-UI-RATE TO WRK-SUBJECT-YRQ-UI-RATE. DTSBE417
|
|
01007 DTSBE417
|
|
01008 DTSBE417
|
|
01009 MOVE MQTR-REC TO MSKL-REC. DTSBE417
|
|
01010 DTSBE417
|
|
01011 PERFORM S910-WRITE THRU S910-EXIT. DTSBE417
|
|
01012 P2200-EXIT. DTSBE417
|
|
01013 EXIT. DTSBE417
|
|
01014 EJECT DTSBE417
|
|
01015 P3000-CONSTRUCT-RPT-RECS. DTSBE417
|
|
01016 MOVE MPRF-EMP-NO TO R417-EMP-NO DTSBE417
|
|
01017 R418-EMP-NO. DTSBE417
|
|
01018 DTSBE417
|
|
01019 MOVE WRK-UC30-FIRST-DEL-MAIL-DATE DTSBE417
|
|
01020 TO R417-MAIL-DATE. DTSBE417
|
|
01021 DTSBE417
|
|
01022 MOVE WRK-PARM-RETURN-BY-DATE TO R417-RETURN-BY-DATE. DTSBE417
|
|
01023 DTSBE417
|
|
01024 MOVE WRK-PARM-SUBJECT-YRQ TO R417-YRQ DTSBE417
|
|
01025 R418-YRQ. DTSBE417
|
|
01026 DTSBE417
|
|
01027 MOVE WRK-SUBJECT-YRQ-RPT-DUE-DATE DTSBE417
|
|
01028 TO R417-DUE-DATE. DTSBE417
|
|
01029 DTSBE417
|
|
01030 MOVE MPRF-PRIMARY-NAME TO R418-PRIMARY-NAME. DTSBE417
|
|
01031 DTSBE417
|
|
01032 MOVE ZEROS TO R417-ADDITIONAL-RPT-CNT DTSBE417
|
|
01033 R418-ADDITIONAL-RPT-CNT. DTSBE417
|
|
01034 DTSBE417
|
|
01035 DTSBE417
|
|
01036 PERFORM DTSBE417
|
|
01037 VARYING WRK-SUB FROM 1 BY 1 DTSBE417
|
|
01038 UNTIL WRK-SUB > +19 DTSBE417
|
|
01039 MOVE +0 TO R417-ADDITIONAL-RPT-YRQ (WRK-SUB) DTSBE417
|
|
01040 R418-ADDITIONAL-RPT-YRQ (WRK-SUB) DTSBE417
|
|
01041 END-PERFORM. DTSBE417
|
|
01042 DTSBE417
|
|
01043 DTSBE417
|
|
01044 IF MPRF-PURSUED-RPT-CNT LESS THAN 2 DTSBE417
|
|
01045 NEXT SENTENCE DTSBE417
|
|
01046 ELSE DTSBE417
|
|
01047 MOVE LOW-VALUES TO MQTR-KEY-AREA DTSBE417
|
|
01048 MOVE MPRF-EMP-NO TO MQTR-EMP-NO DTSBE417
|
|
01049 SET MQTR-QTR-88 TO TRUE DTSBE417
|
|
01050 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBE417
|
|
01051 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE417
|
|
01052 PERFORM P3010-SCAN-MQTR THRU P3010-EXIT DTSBE417
|
|
01053 UNTIL L910-NO-REC-88. DTSBE417
|
|
01054 DTSBE417
|
|
01055 DTSBE417
|
|
01056 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE417
|
|
01057 DTSBE417
|
|
01058 DTSBE417
|
|
01059 MOVE L061-FLD-REP-ID TO R418-FIELD-REP-ID. DTSBE417
|
|
01060 DTSBE417
|
|
01061 DTSBE417
|
|
01062 PERFORM P3020-CALC-RATE THRU P3020-EXIT. DTSBE417
|
|
01063 DTSBE417
|
|
01064 DTSBE417
|
|
01065 SET WRK-MTAD-NO-LETTER-SENT-88 TO TRUE. DTSBE417
|
|
01066 DTSBE417
|
|
01067 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBE417
|
|
01068 DTSBE417
|
|
01069 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBE417
|
|
01070 DTSBE417
|
|
01071 SET MTAD-TAD-88 TO TRUE. DTSBE417
|
|
01072 DTSBE417
|
|
01073 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
01074 DTSBE417
|
|
01075 MOVE SPACES TO R418-ADDRESS1-SENT-IND DTSBE417
|
|
01076 R418-ADDRESS2-SENT-IND DTSBE417
|
|
01077 R418-ADDRESS3-SENT-IND. DTSBE417
|
|
01078 DTSBE417
|
|
01079 DTSBE417
|
|
01080 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
01081 DTSBE417
|
|
01082 DTSBE417
|
|
01083 PERFORM P3030-SCAN-MTAD THRU P3030-EXIT DTSBE417
|
|
01084 UNTIL L910-NO-REC-88. DTSBE417
|
|
01085 DTSBE417
|
|
01086 DTSBE417
|
|
01087 IF WRK-MTAD-NO-LETTER-SENT-88 DTSBE417
|
|
01088 MOVE MSG2-ID TO R907-MSG-ID DTSBE417
|
|
01089 MOVE WRK-SUBJECT-SLASH-QTR TO MSG2-SLASHED-YRQ DTSBE417
|
|
01090 MOVE MSG2-TEXT TO R907-MSG-TEXT DTSBE417
|
|
01091 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE417
|
|
01092 DTSBE417
|
|
01093 DTSBE417
|
|
01094 SET WRK-MOPO-NO-LETTER-SENT-88 TO TRUE. DTSBE417
|
|
01095 DTSBE417
|
|
01096 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE417
|
|
01097 DTSBE417
|
|
01098 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE417
|
|
01099 DTSBE417
|
|
01100 SET MSKL-OPO-88 TO TRUE. DTSBE417
|
|
01101 DTSBE417
|
|
01102 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
01103 DTSBE417
|
|
01104 PERFORM P3040-SCAN-MOPO THRU P3040-EXIT DTSBE417
|
|
01105 UNTIL L910-NO-REC-88. DTSBE417
|
|
01106 DTSBE417
|
|
01107 DTSBE417
|
|
01108 SET WRK-MTAA-NO-LETTER-SENT-88 TO TRUE. DTSBE417
|
|
01109 DTSBE417
|
|
01110 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE417
|
|
01111 DTSBE417
|
|
01112 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE417
|
|
01113 DTSBE417
|
|
01114 SET MSKL-TAA-88 TO TRUE. DTSBE417
|
|
01115 DTSBE417
|
|
01116 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
01117 DTSBE417
|
|
01118 PERFORM P3050-SCAN-MTAA THRU P3050-EXIT DTSBE417
|
|
01119 UNTIL L910-NO-REC-88. DTSBE417
|
|
01120 DTSBE417
|
|
01121 DTSBE417
|
|
01122 IF (WRK-MTAD-NO-LETTER-SENT-88) DTSBE417
|
|
01123 AND DTSBE417
|
|
01124 (WRK-MOPO-NO-LETTER-SENT-88) DTSBE417
|
|
01125 AND DTSBE417
|
|
01126 (WRK-MTAA-NO-LETTER-SENT-88) DTSBE417
|
|
01127 MOVE MSG5-ID TO R907-MSG-ID DTSBE417
|
|
01128 MOVE WRK-SUBJECT-SLASH-QTR TO MSG5-SLASHED-YRQ DTSBE417
|
|
01129 MOVE MSG5-TEXT TO R907-MSG-TEXT DTSBE417
|
|
01130 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE417
|
|
01131 ELSE DTSBE417
|
|
01132 PERFORM S064-LOOKUP-FLD-ZIP-ADDR THRU S064-EXIT DTSBE417
|
|
01133 MOVE L064-CITY TO R418-CITY DTSBE417
|
|
01134 MOVE L064-ST TO R418-STATE DTSBE417
|
|
01135 MOVE L064-ZIP TO R418-ZIP DTSBE417
|
|
01136 PERFORM S946-WRITE-R418 THRU S946-EXIT. DTSBE417
|
|
01137 DTSBE417
|
|
01138 PERFORM P3060-TPS-UNIVERSE THRU P3060-EXIT. DTSBE417
|
|
01139 DTSBE417
|
|
01140 ADD +1 TO WRK-DELINQUENT-CNT. DTSBE417
|
|
01141 IF MPRF-CLASS-SELF-INS-88 DTSBE417
|
|
01142 ADD +1 TO WRK-SI-DEL-CNT DTSBE417
|
|
01143 END-IF. DTSBE417
|
|
01144 DTSBE417
|
|
01145 P3000-EXIT. DTSBE417
|
|
01146 EXIT. DTSBE417
|
|
01147 EJECT DTSBE417
|
|
01148 P3010-SCAN-MQTR. DTSBE417
|
|
01149 MOVE MSKL-REC TO MQTR-REC. DTSBE417
|
|
01150 DTSBE417
|
|
01151 IF MQTR-YRQ = WRK-PARM-SUBJECT-YRQ DTSBE417
|
|
01152 NEXT SENTENCE DTSBE417
|
|
01153 ELSE DTSBE417
|
|
01154 IF MQTR-RPT-IS-PURSUED-88 DTSBE417
|
|
01155 ADD +1 TO R417-ADDITIONAL-RPT-CNT DTSBE417
|
|
01156 R418-ADDITIONAL-RPT-CNT DTSBE417
|
|
01157 IF R417-ADDITIONAL-RPT-CNT > 19 DTSBE417
|
|
01158 SET L910-NO-REC-88 TO TRUE DTSBE417
|
|
01159 PERFORM P3011-WRITE-R907 THRU P3011-EXIT DTSBE417
|
|
01160 SUBTRACT +1 FROM R417-ADDITIONAL-RPT-CNT DTSBE417
|
|
01161 R418-ADDITIONAL-RPT-CNT DTSBE417
|
|
01162 GO TO P3010-EXIT DTSBE417
|
|
01163 ELSE DTSBE417
|
|
01164 MOVE MQTR-YRQ TO DTSBE417
|
|
01165 R417-ADDITIONAL-RPT-YRQ (R417-ADDITIONAL-RPT-CNT) DTSBE417
|
|
01166 R418-ADDITIONAL-RPT-YRQ (R418-ADDITIONAL-RPT-CNT). DTSBE417
|
|
01167 DTSBE417
|
|
01168 DTSBE417
|
|
01169 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE417
|
|
01170 P3010-EXIT. DTSBE417
|
|
01171 EXIT. DTSBE417
|
|
01172 EJECT DTSBE417
|
|
01173 P3011-WRITE-R907. DTSBE417
|
|
01174 MOVE MSG3-ID TO R907-MSG-ID. DTSBE417
|
|
01175 DTSBE417
|
|
01176 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBE417
|
|
01177 DTSBE417
|
|
01178 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE417
|
|
01179 DTSBE417
|
|
01180 MOVE L004-SLASH-QTR TO MSG3-SLASHED-YRQ. DTSBE417
|
|
01181 DTSBE417
|
|
01182 MOVE MSG3-TEXT TO R907-MSG-TEXT. DTSBE417
|
|
01183 DTSBE417
|
|
01184 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE417
|
|
01185 P3011-EXIT. DTSBE417
|
|
01186 EXIT. DTSBE417
|
|
01187 EJECT DTSBE417
|
|
01188 P3020-CALC-RATE. DTSBE417
|
|
01189 IF WRK-SUBJECT-YRQ-NO-UI-RATE-88 DTSBE417
|
|
01190 IF MPRF-CLASS-SELF-INS-88 DTSBE417
|
|
01191 PERFORM P3021-GET-L109 THRU P3021-EXIT DTSBE417
|
|
01192 COMPUTE DTSBE417
|
|
01193 R417-TOTAL-RATE = L109-SUR-RATE DTSBE417
|
|
01194 ELSE DTSBE417
|
|
01195 SET R417-NO-UI-RATE-88 TO TRUE DTSBE417
|
|
01196 PERFORM P3022-NO-RATE-R907 THRU P3022-EXIT DTSBE417
|
|
01197 ELSE DTSBE417
|
|
01198 PERFORM P3021-GET-L109 THRU P3021-EXIT DTSBE417
|
|
01199 COMPUTE DTSBE417
|
|
01200 R417-TOTAL-RATE = DTSBE417
|
|
01201 WRK-SUBJECT-YRQ-UI-RATE + DTSBE417
|
|
01202 L109-SUR-RATE. DTSBE417
|
|
01203 DTSBE417
|
|
01204 MOVE R417-TOTAL-RATE TO R418-TOTAL-RATE. DTSBE417
|
|
01205 P3020-EXIT. DTSBE417
|
|
01206 EXIT. DTSBE417
|
|
01207 EJECT DTSBE417
|
|
01208 P3021-GET-L109. DTSBE417
|
|
01209 MOVE MPRF-EMP-CLASS TO L109-EMP-CLASS. DTSBE417
|
|
01210 DTSBE417
|
|
01211 MOVE MQTR-YRQ TO L109-YRQ. DTSBE417
|
|
01212 DTSBE417
|
|
01213 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSBE417
|
|
01214 DTSBE417
|
|
01215 PERFORM S109-LOOKUP-SUR-RATE THRU S109-EXIT. DTSBE417
|
|
01216 P3021-EXIT. DTSBE417
|
|
01217 EXIT. DTSBE417
|
|
01218 EJECT DTSBE417
|
|
01219 P3022-NO-RATE-R907. DTSBE417
|
|
01220 MOVE MSG1-ID TO R907-MSG-ID. DTSBE417
|
|
01221 DTSBE417
|
|
01222 MOVE WRK-SUBJECT-SLASH-QTR TO MSG1-SLASHED-YRQ. DTSBE417
|
|
01223 DTSBE417
|
|
01224 MOVE MSG1-TEXT TO R907-MSG-TEXT. DTSBE417
|
|
01225 DTSBE417
|
|
01226 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE417
|
|
01227 P3022-EXIT. DTSBE417
|
|
01228 EXIT. DTSBE417
|
|
01229 EJECT DTSBE417
|
|
01230 P3030-SCAN-MTAD. DTSBE417
|
|
01231 MOVE MSKL-REC TO MTAD-REC. DTSBE417
|
|
01232 DTSBE417
|
|
01233 IF MTAD-MISSING-RPT-LTRS-YES-88 DTSBE417
|
|
01234 SET WRK-MTAD-LETTER-SENT-88 TO TRUE DTSBE417
|
|
01235 PERFORM P3031-LOOKUP-ADDR THRU P3031-EXIT DTSBE417
|
|
01236 PERFORM P3032-SET-ADDRESS-SENT-IND THRU P3032-EXIT DTSBE417
|
|
01237 PERFORM S946-WRITE-R417 THRU S946-EXIT DTSBE417
|
|
01238 * MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR DTSBE417
|
|
01239 * MOVE 'MTAD' TO EVL-ADDR-TYPE DTSBE417
|
|
01240 * MOVE MTAD-ID-NO TO EVL-ADDR-ID-NO DTSBE417
|
|
01241 * PERFORM S4000-WRITE-MEVL THRU S4000-EXIT DTSBE417
|
|
01242 MOVE MTAD-REC TO MSKL-REC DTSBE417
|
|
01243 PERFORM S910-READ THRU S910-EXIT DTSBE417
|
|
01244 IF L910-NO-REC-88 DTSBE417
|
|
01245 MOVE 'LOGIC ERROR IN P3030' TO ABEND-MSG DTSBE417
|
|
01246 PERFORM S999-ABEND THRU S999-EXIT. DTSBE417
|
|
01247 DTSBE417
|
|
01248 DTSBE417
|
|
01249 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE417
|
|
01250 P3030-EXIT. DTSBE417
|
|
01251 EXIT. DTSBE417
|
|
01252 SKIP3 DTSBE417
|
|
01253 P3031-LOOKUP-ADDR. DTSBE417
|
|
01254 MOVE MTAD-ID-NO TO L111-ID-NO. DTSBE417
|
|
01255 DTSBE417
|
|
01256 DTSBE417
|
|
01257 PERFORM S111-LOOKUP-TAD THRU S111-EXIT. DTSBE417
|
|
01258 DTSBE417
|
|
01259 DTSBE417
|
|
01260 IF L111-ADDR-FOUND-88 DTSBE417
|
|
01261 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE417
|
|
01262 PERFORM S112-TAD-ADDR THRU S112-EXIT DTSBE417
|
|
01263 MOVE L112-MAILING-ADDRESS TO R417-FMT-ADDR DTSBE417
|
|
01264 MOVE L112-ZIP TO R417-ZIP DTSBE417
|
|
01265 R417-SORT-ZIP DTSBE417
|
|
01266 MOVE L112-ADVANCED-BARCODE TO R417-ADVANCED-BARCODE DTSBE417
|
|
01267 ELSE DTSBE417
|
|
01268 MOVE ALL '?' TO R417-FMT-ADDR DTSBE417
|
|
01269 R417-ZIP DTSBE417
|
|
01270 R417-SORT-ZIP DTSBE417
|
|
01271 R417-ADVANCED-BARCODE. DTSBE417
|
|
01272 P3031-EXIT. DTSBE417
|
|
01273 EXIT. DTSBE417
|
|
01274 SKIP3 DTSBE417
|
|
01275 P3032-SET-ADDRESS-SENT-IND. DTSBE417
|
|
01276 IF MTAD-ID-NO = 001 DTSBE417
|
|
01277 SET R418-ADDRESS1-SENT-YES TO TRUE DTSBE417
|
|
01278 ELSE DTSBE417
|
|
01279 IF MTAD-ID-NO = 002 DTSBE417
|
|
01280 SET R418-ADDRESS2-SENT-YES TO TRUE. DTSBE417
|
|
01281 P3032-EXIT. DTSBE417
|
|
01282 EXIT. DTSBE417
|
|
01283 EJECT DTSBE417
|
|
01284 P3040-SCAN-MOPO. DTSBE417
|
|
01285 MOVE MSKL-REC TO MOPO-REC. DTSBE417
|
|
01286 DTSBE417
|
|
01287 IF MOPO-MISSING-RPT-LTRS-YES-88 DTSBE417
|
|
01288 SET WRK-MOPO-LETTER-SENT-88 TO TRUE DTSBE417
|
|
01289 PERFORM P3041-LOOKUP-ADDR THRU P3041-EXIT DTSBE417
|
|
01290 PERFORM S946-WRITE-R417 THRU S946-EXIT DTSBE417
|
|
01291 * MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR DTSBE417
|
|
01292 * MOVE 'MOPO' TO EVL-ADDR-TYPE DTSBE417
|
|
01293 * MOVE MOPO-ID-NO TO EVL-ADDR-ID-NO DTSBE417
|
|
01294 * PERFORM S4000-WRITE-MEVL THRU S4000-EXIT DTSBE417
|
|
01295 MOVE MOPO-REC TO MSKL-REC DTSBE417
|
|
01296 PERFORM S910-READ THRU S910-EXIT DTSBE417
|
|
01297 IF L910-NO-REC-88 DTSBE417
|
|
01298 MOVE 'LOGIC ERROR IN P3040' TO ABEND-MSG DTSBE417
|
|
01299 PERFORM S999-ABEND THRU S999-EXIT. DTSBE417
|
|
01300 DTSBE417
|
|
01301 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE417
|
|
01302 P3040-EXIT. DTSBE417
|
|
01303 EXIT. DTSBE417
|
|
01304 SKIP3 DTSBE417
|
|
01305 P3041-LOOKUP-ADDR. DTSBE417
|
|
01306 MOVE MOPO-ID-NO TO L111-ID-NO. DTSBE417
|
|
01307 DTSBE417
|
|
01308 PERFORM S111-LOOKUP-OPO THRU S111-EXIT. DTSBE417
|
|
01309 DTSBE417
|
|
01310 IF L111-ADDR-FOUND-88 DTSBE417
|
|
01311 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE417
|
|
01312 PERFORM S112-OPO-ADDR THRU S112-EXIT DTSBE417
|
|
01313 MOVE L112-MAILING-ADDRESS TO R417-FMT-ADDR DTSBE417
|
|
01314 MOVE L112-ZIP TO R417-ZIP DTSBE417
|
|
01315 R417-SORT-ZIP DTSBE417
|
|
01316 MOVE L112-ADVANCED-BARCODE TO R417-ADVANCED-BARCODE DTSBE417
|
|
01317 ELSE DTSBE417
|
|
01318 MOVE ALL '?' TO R417-FMT-ADDR DTSBE417
|
|
01319 R417-ZIP DTSBE417
|
|
01320 R417-SORT-ZIP DTSBE417
|
|
01321 R417-ADVANCED-BARCODE. DTSBE417
|
|
01322 P3041-EXIT. DTSBE417
|
|
01323 EXIT. DTSBE417
|
|
01324 EJECT DTSBE417
|
|
01325 P3050-SCAN-MTAA. DTSBE417
|
|
01326 MOVE MSKL-REC TO MTAA-REC. DTSBE417
|
|
01327 DTSBE417
|
|
01328 IF MTAA-MISSING-RPT-LTRS-YES-88 DTSBE417
|
|
01329 SET WRK-MTAA-LETTER-SENT-88 TO TRUE DTSBE417
|
|
01330 PERFORM P3051-LOOKUP-ADDR THRU P3051-EXIT DTSBE417
|
|
01331 PERFORM S946-WRITE-R417 THRU S946-EXIT DTSBE417
|
|
01332 * MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR DTSBE417
|
|
01333 * MOVE 'MTAA' TO EVL-ADDR-TYPE DTSBE417
|
|
01334 * MOVE MTAA-ID-NO TO EVL-ADDR-ID-NO DTSBE417
|
|
01335 * PERFORM S4000-WRITE-MEVL THRU S4000-EXIT DTSBE417
|
|
01336 MOVE MTAA-REC TO MSKL-REC DTSBE417
|
|
01337 PERFORM S910-READ THRU S910-EXIT DTSBE417
|
|
01338 IF L910-NO-REC-88 DTSBE417
|
|
01339 MOVE 'LOGIC ERROR IN P3050' TO ABEND-MSG DTSBE417
|
|
01340 PERFORM S999-ABEND THRU S999-EXIT. DTSBE417
|
|
01341 DTSBE417
|
|
01342 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE417
|
|
01343 P3050-EXIT. DTSBE417
|
|
01344 EXIT. DTSBE417
|
|
01345 SKIP3 DTSBE417
|
|
01346 P3051-LOOKUP-ADDR. DTSBE417
|
|
01347 MOVE MTAA-ID-NO TO L111-ID-NO. DTSBE417
|
|
01348 DTSBE417
|
|
01349 PERFORM S111-LOOKUP-TAA THRU S111-EXIT. DTSBE417
|
|
01350 DTSBE417
|
|
01351 IF L111-ADDR-FOUND-88 DTSBE417
|
|
01352 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE417
|
|
01353 PERFORM S112-TAA-ADDR THRU S112-EXIT DTSBE417
|
|
01354 MOVE L112-MAILING-ADDRESS TO R417-FMT-ADDR DTSBE417
|
|
01355 MOVE L112-ZIP TO R417-ZIP DTSBE417
|
|
01356 R417-SORT-ZIP DTSBE417
|
|
01357 MOVE L112-ADVANCED-BARCODE TO R417-ADVANCED-BARCODE DTSBE417
|
|
01358 ELSE DTSBE417
|
|
01359 MOVE ALL '?' TO R417-FMT-ADDR DTSBE417
|
|
01360 R417-ZIP DTSBE417
|
|
01361 R417-SORT-ZIP DTSBE417
|
|
01362 R417-ADVANCED-BARCODE. DTSBE417
|
|
01363 DTSBE417
|
|
01364 P3051-EXIT. DTSBE417
|
|
01365 EXIT. DTSBE417
|
|
01366 DTSBE417
|
|
01367 P3060-TPS-UNIVERSE. DTSBE417
|
|
01368 DTSBE417
|
|
01369 * MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9. DTSBE417
|
|
01370 * DTSBE417
|
|
01371 * IF L004-QTR-5-Q = TPS-UNIV-QTR DTSBE417
|
|
01372 * NEXT SENTENCE DTSBE417
|
|
01373 * ELSE DTSBE417
|
|
01374 * GO TO P3060-EXIT DTSBE417
|
|
01375 * END-IF. DTSBE417
|
|
01376 DTSBE417
|
|
01377 MOVE MPRF-EMP-NO TO R716-EMP-NO. DTSBE417
|
|
01378 DTSBE417
|
|
01379 MOVE LECM-CURR-RUN-DATE TO R716-RUN-DATE. DTSBE417
|
|
01380 DTSBE417
|
|
01381 MOVE MPRF-PRIMARY-NAME TO R716-PRIMARY-NAME. DTSBE417
|
|
01382 DTSBE417
|
|
01383 PERFORM S946-WRITE-R716 THRU S946-EXIT. DTSBE417
|
|
01384 DTSBE417
|
|
01385 P3060-EXIT. DTSBE417
|
|
01386 EXIT. DTSBE417
|
|
01387 DTSBE417
|
|
01388 DTSBE417
|
|
01389 P4000-PENALTY. DTSBE417
|
|
01390 * IF MPRF-PURSUED-RPT-CNT > +2 CL**3
|
|
01391 * ADD +1 TO WRK-OVER-2-MISS-CNT CL**3
|
|
01392 * DISPLAY 'OVER 2 ' MPRF-EMP-NO ' ' MPRF-PURSUED-RPT-CNT CL**3
|
|
01393 * GO TO P4000-EXIT CL**3
|
|
01394 * END-IF CL**3
|
|
01395 PERFORM P4100-INIT-L102 THRU P4100-EXIT. DTSBE417
|
|
01396 DTSBE417
|
|
01397 PERFORM S102-DELINQUENCY-RUN THRU S102-EXIT. DTSBE417
|
|
01398 IF L102-LATE-PEN-CHARGE-CHNG > +0 DTSBE417
|
|
01399 ADD +1 TO WRK-PEN-CNT DTSBE417
|
|
01400 IF MPRF-CLASS-SELF-INS-88 DTSBE417
|
|
01401 ADD +1 TO WRK-SI-PEN-CNT DTSBE417
|
|
01402 END-IF DTSBE417
|
|
01403 PERFORM P4200-GENERATE-T026 THRU P4200-EXIT DTSBE417
|
|
01404 END-IF. DTSBE417
|
|
01405 DTSBE417
|
|
01406 P4000-EXIT. DTSBE417
|
|
01407 EXIT. DTSBE417
|
|
01408 DTSBE417
|
|
01409 P4100-INIT-L102. DTSBE417
|
|
01410 MOVE MPRF-EMP-CLASS TO L102-EMP-CLASS. DTSBE417
|
|
01411 MOVE +0 TO L102-TRAN-RECEIVED-DATE. DTSBE417
|
|
01412 SET L102-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBE417
|
|
01413 MOVE WRK-PARM-SUBJECT-YRQ TO L102-LAST-PEN-ASSESSED-YRQ. DTSBE417
|
|
01414 MOVE +0 TO L102-OR-RECEIVED-DATE. DTSBE417
|
|
01415 DTSBE417
|
|
01416 MOVE WRK-PARM-SUBJECT-YRQ TO L102-MQTR-YRQ. DTSBE417
|
|
01417 MOVE MQTR-TAX-DUE-DATE TO L102-TAX-DUE-DATE. DTSBE417
|
|
01418 MOVE MQTR-RPT-DUE-DATE TO L102-RPT-DUE-DATE. DTSBE417
|
|
01419 DTSBE417
|
|
01420 MOVE LECM-CURR-RUN-DATE TO L102-CURR-RUN-DATE. DTSBE417
|
|
01421 DTSBE417
|
|
01422 MOVE +0 TO L102-LATE-PEN-CHARGED-AMT DTSBE417
|
|
01423 L102-TAX-CHARGED-AMT DTSBE417
|
|
01424 L102-TAX-BALANCE-AMT DTSBE417
|
|
01425 WRK-TIMELY-PAYMENTS. DTSBE417
|
|
01426 PERFORM DTSBE417
|
|
01427 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE417
|
|
01428 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE417
|
|
01429 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE417
|
|
01430 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE417
|
|
01431 TO L102-LATE-PEN-CHARGED-AMT DTSBE417
|
|
01432 END-IF DTSBE417
|
|
01433 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE417
|
|
01434 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE417
|
|
01435 TO L102-TAX-CHARGED-AMT DTSBE417
|
|
01436 * ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE417
|
|
01437 * TO L102-TAX-BALANCE-AMT DTSBE417
|
|
01438 END-IF DTSBE417
|
|
01439 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE417
|
|
01440 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBE417
|
|
01441 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE417
|
|
01442 TO L102-TAX-CHARGED-AMT DTSBE417
|
|
01443 END-IF DTSBE417
|
|
01444 END-IF DTSBE417
|
|
01445 END-PERFORM. DTSBE417
|
|
01446 DTSBE417
|
|
01447 MOVE MQTR-PEN-AREA TO L102-PEN-AREA. DTSBE417
|
|
01448 DTSBE417
|
|
01449 * MOVE ZERO TO WRK-TIMELY-SI-PAY-AMT. DTSBE417
|
|
01450 * IF MPRF-CLASS-SELF-INS-88 DTSBE417
|
|
01451 * MOVE WRK-TIMELY-SI-PAY-AMT TO L102-TIMELY-SI-PAY-AMT DTSBE417
|
|
01452 * END-IF. DTSBE417
|
|
01453 DTSBE417
|
|
01454 PERFORM P4110-PAYMENTS THRU P4110-EXIT DTSBE417
|
|
01455 DTSBE417
|
|
01456 COMPUTE L102-TAX-BALANCE-AMT = DTSBE417
|
|
01457 (L102-TAX-CHARGED-AMT - WRK-TIMELY-PAYMENTS). DTSBE417
|
|
01458 DTSBE417
|
|
01459 P4100-EXIT. DTSBE417
|
|
01460 EXIT. DTSBE417
|
|
01461 DTSBE417
|
|
01462 P4110-PAYMENTS. DTSBE417
|
|
01463 MOVE LOW-VALUE TO MDST-KEY-AREA. DTSBE417
|
|
01464 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE417
|
|
01465 SET MDST-DST-88 TO TRUE. DTSBE417
|
|
01466 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
01467 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
01468 IF L910-OK-88 DTSBE417
|
|
01469 PERFORM P4111-SCAN-MDST THRU P4111-EXIT DTSBE417
|
|
01470 UNTIL L910-NO-REC-88. DTSBE417
|
|
01471 DTSBE417
|
|
01472 P4110-EXIT. DTSBE417
|
|
01473 EXIT. DTSBE417
|
|
01474 DTSBE417
|
|
01475 P4111-SCAN-MDST. DTSBE417
|
|
01476 MOVE MSKL-REC TO MDST-REC. DTSBE417
|
|
01477 IF (MDST-YRQ = MQTR-YRQ DTSBE417
|
|
01478 AND MDST-RECEIVED-DATE <= MQTR-TAX-DUE-DATE) DTSBE417
|
|
01479 PERFORM DTSBE417
|
|
01480 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBE417
|
|
01481 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBE417
|
|
01482 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBE417
|
|
01483 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE417
|
|
01484 TO WRK-TIMELY-PAYMENTS DTSBE417
|
|
01485 END-IF DTSBE417
|
|
01486 IF MDST-ACCT-SUR-88 (MDST-ACCT-IDX) DTSBE417
|
|
01487 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE417
|
|
01488 TO WRK-TIMELY-PAYMENTS DTSBE417
|
|
01489 END-IF DTSBE417
|
|
01490 END-PERFORM DTSBE417
|
|
01491 END-IF. DTSBE417
|
|
01492 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE417
|
|
01493 P4111-EXIT. DTSBE417
|
|
01494 EXIT. DTSBE417
|
|
01495 DTSBE417
|
|
01496 P4200-GENERATE-T026. DTSBE417
|
|
01497 MOVE MPRF-EMP-NO TO T026-EMP-NO. DTSBE417
|
|
01498 SET T026-LATE-PEN-CHG TO TRUE. DTSBE417
|
|
01499 MOVE MPRF-PRIMARY-NAME TO T026-NAME-CHECK. DTSBE417
|
|
01500 MOVE L102-LATE-PEN-CHARGE-CHNG TO T026-AMT. DTSBE417
|
|
01501 MOVE +0 TO T026-RECEIVED-DATE. DTSBE417
|
|
01502 MOVE WRK-PARM-SUBJECT-YRQ TO T026-APPLIC-YRQ. DTSBE417
|
|
01503 MOVE CACT-APPLIC-LATE-PEN TO T026-APPLIC-IND. DTSBE417
|
|
01504 MOVE +0 TO T026-APPLIC-BATCH-NO DTSBE417
|
|
01505 T026-APPLIC-ITEM-NO. DTSBE417
|
|
01506 DTSBE417
|
|
01507 MOVE +0 TO T026-DATE-1 DTSBE417
|
|
01508 T026-DATE-2. DTSBE417
|
|
01509 MOVE SPACE TO T026-INT-SPAN-IND. DTSBE417
|
|
01510 SET T026-NO-INT-RATE-88 TO TRUE. DTSBE417
|
|
01511 MOVE 'SYS' TO T026-RESPONSIBLE-ACTIVITY. DTSBE417
|
|
01512 MOVE SPACES TO T026-RESPONSIBLE-OP-ID. DTSBE417
|
|
01513 PERFORM S927-WRITE-T026 THRU S927-EXIT. DTSBE417
|
|
01514 IF L102-LATE-PEN-WAIVE-CHNG > +0 DTSBE417
|
|
01515 SET T026-LATE-PEN-WAIVE TO TRUE DTSBE417
|
|
01516 MOVE L102-LATE-PEN-WAIVE-CHNG TO T026-AMT DTSBE417
|
|
01517 PERFORM S927-WRITE-T026 THRU S927-EXIT. DTSBE417
|
|
01518 DTSBE417
|
|
01519 P4200-EXIT. DTSBE417
|
|
01520 EXIT. DTSBE417
|
|
01521 DTSBE417
|
|
01522 T0000-TERMINATE. DTSBE417
|
|
01523 CLOSE DOWNLOAD-FILE EMP-RPT-FILE. DTSBE417
|
|
01524 DTSBE417
|
|
01525 MOVE LOW-VALUES TO FQTR-KEY-AREA. DTSBE417
|
|
01526 DTSBE417
|
|
01527 SET FQTR-QTR-88 TO TRUE. DTSBE417
|
|
01528 DTSBE417
|
|
01529 MOVE WRK-PARM-SUBJECT-YRQ TO FQTR-YRQ. DTSBE417
|
|
01530 DTSBE417
|
|
01531 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA. DTSBE417
|
|
01532 DTSBE417
|
|
01533 PERFORM S931-READ THRU S931-EXIT. DTSBE417
|
|
01534 DTSBE417
|
|
01535 IF L931-NO-REC-88 DTSBE417
|
|
01536 MOVE LOW-VALUES TO FQTR-DATA-AREA DTSBE417
|
|
01537 MOVE +0 TO FQTR-UC30-MASS-MAIL-DATE DTSBE417
|
|
01538 FQTR-SELF-INS-TAX-DUE-DATE DTSBE417
|
|
01539 * FQTR-SELF-INS-LATE-PEN-DATE DTSBE417
|
|
01540 FQTR-LATE-PEN-ASSESSED-DATE DTSBE417
|
|
01541 FQTR-UC30-FINAL-DEL-DATE DTSBE417
|
|
01542 MOVE WRK-UC30-FIRST-DEL-CUTOFF-DATE DTSBE417
|
|
01543 TO FQTR-UC30-FIRST-DEL-DATE DTSBE417
|
|
01544 MOVE WRK-PARM-RETURN-BY-DATE TO DTSBE417
|
|
01545 FQTR-UC30-FINAL-ACTION-DATE DTSBE417
|
|
01546 MOVE LECM-CURR-RUN-DATE DTSBE417
|
|
01547 TO FQTR-ESTB-DATE DTSBE417
|
|
01548 FQTR-CHNG-DATE DTSBE417
|
|
01549 MOVE FQTR-REC TO FSKL-REC DTSBE417
|
|
01550 PERFORM S931-WRITE THRU S931-EXIT DTSBE417
|
|
01551 ELSE DTSBE417
|
|
01552 MOVE FSKL-REC TO FQTR-REC DTSBE417
|
|
01553 MOVE WRK-UC30-FIRST-DEL-CUTOFF-DATE DTSBE417
|
|
01554 TO FQTR-UC30-FIRST-DEL-DATE DTSBE417
|
|
01555 MOVE WRK-PARM-RETURN-BY-DATE TO DTSBE417
|
|
01556 FQTR-UC30-FINAL-ACTION-DATE DTSBE417
|
|
01557 MOVE LECM-CURR-RUN-DATE DTSBE417
|
|
01558 TO FQTR-CHNG-DATE DTSBE417
|
|
01559 MOVE FQTR-REC TO FSKL-REC DTSBE417
|
|
01560 PERFORM S931-REWRITE THRU S931-EXIT. DTSBE417
|
|
01561 DTSBE417
|
|
01562 DTSBE417
|
|
01563 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE417
|
|
01564 DTSBE417
|
|
01565 MOVE +0 TO MHDR-EMP-NO. DTSBE417
|
|
01566 DTSBE417
|
|
01567 SET MHDR-HDR-88 TO TRUE. DTSBE417
|
|
01568 DTSBE417
|
|
01569 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
01570 DTSBE417
|
|
01571 PERFORM S910-READ THRU S910-EXIT. DTSBE417
|
|
01572 DTSBE417
|
|
01573 IF L910-NO-REC-88 DTSBE417
|
|
01574 MOVE 'MHDR RECORD NOT FOUND' DTSBE417
|
|
01575 TO ABEND-MSG DTSBE417
|
|
01576 PERFORM S999-ABEND THRU S999-EXIT. DTSBE417
|
|
01577 DTSBE417
|
|
01578 DTSBE417
|
|
01579 MOVE MSKL-REC TO MHDR-REC. DTSBE417
|
|
01580 DTSBE417
|
|
01581 IF WRK-PARM-SUBJECT-YRQ > MHDR-LAST-UC30-DEL-MAIL-YRQ DTSBE417
|
|
01582 MOVE WRK-PARM-SUBJECT-YRQ DTSBE417
|
|
01583 TO MHDR-LAST-UC30-DEL-MAIL-YRQ DTSBE417
|
|
01584 MOVE LECM-CURR-RUN-DATE TO MHDR-CHNG-DATE. DTSBE417
|
|
01585 DTSBE417
|
|
01586 IF WRK-FIRST-PURSUED-RPT-YRQ > MHDR-FIRST-PURSUED-RPT-YRQ DTSBE417
|
|
01587 MOVE WRK-FIRST-PURSUED-RPT-YRQ DTSBE417
|
|
01588 TO MHDR-FIRST-PURSUED-RPT-YRQ DTSBE417
|
|
01589 MOVE LECM-CURR-RUN-DATE TO MHDR-CHNG-DATE. DTSBE417
|
|
01590 DTSBE417
|
|
01591 MOVE MHDR-REC TO MSKL-REC. DTSBE417
|
|
01592 DTSBE417
|
|
01593 PERFORM S910-REWRITE THRU S910-EXIT. DTSBE417
|
|
01594 DTSBE417
|
|
01595 DISPLAY SPACE. DTSBE417
|
|
01596 DISPLAY '** DTSBE417 TERMINATION **'. DTSBE417
|
|
01597 DISPLAY SPACE. DTSBE417
|
|
01598 DISPLAY 'DELINQUENT EMPLOYERS: ' WRK-DELINQUENT-CNT. DTSBE417
|
|
01599 DISPLAY 'SELF-INS DELINQUENT: ' WRK-SI-DEL-CNT. DTSBE417
|
|
01600 DISPLAY 'PENALTIES ASSESSED: ' WRK-PEN-CNT. DTSBE417
|
|
01601 DISPLAY 'SELF-INS PENALTIES: ' WRK-SI-PEN-CNT. DTSBE417
|
|
01602 DISPLAY 'OVER 2 MISSING RPTS: ' WRK-OVER-2-MISS-CNT. DTSBE417
|
|
01603 DISPLAY SPACE. DTSBE417
|
|
01604 DISPLAY 'TF TABLE ENTRIES : ' WRK-TF-TABLE-CNT. DTSBE417
|
|
01605 DISPLAY 'TF BYPASSED : ' WRK-BYPASS-CNT. DTSBE417
|
|
01606 DTSBE417
|
|
01607 * DISPLAY 'NOT BYPASSED : '. DTSBE417
|
|
01608 * PERFORM DTSBE417
|
|
01609 * VARYING TF-SUB FROM +1 BY +1 DTSBE417
|
|
01610 * UNTIL TF-SUB > TF-MAX DTSBE417
|
|
01611 * IF TF-RPT-FOUND-YES-88 (TF-SUB) DTSBE417
|
|
01612 * IF TF-BYPASSED-NO-88 (TF-SUB) DTSBE417
|
|
01613 * DISPLAY TF-SUB DTSBE417
|
|
01614 * END-IF DTSBE417
|
|
01615 * END-IF DTSBE417
|
|
01616 * END-PERFORM. DTSBE417
|
|
01617 DTSBE417
|
|
01618 T0000-EXIT. DTSBE417
|
|
01619 EXIT. DTSBE417
|
|
01620 EJECT DTSBE417
|
|
01621 S1000-PURSUED-RPT-IND. DTSBE417
|
|
01622 IF MQTR-RPT-IS-PURSUED-88 DTSBE417
|
|
01623 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT. DTSBE417
|
|
01624 DTSBE417
|
|
01625 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE. DTSBE417
|
|
01626 DTSBE417
|
|
01627 IF (MPRF-NOT-WRITTEN-OFF-88) DTSBE417
|
|
01628 AND DTSBE417
|
|
01629 (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88) DTSBE417
|
|
01630 AND DTSBE417
|
|
01631 (MQTR-YRQ >= WRK-FIRST-PURSUED-RPT-YRQ) DTSBE417
|
|
01632 SET MQTR-RPT-IS-PURSUED-88 TO TRUE. DTSBE417
|
|
01633 DTSBE417
|
|
01634 IF MQTR-RPT-IS-PURSUED-88 DTSBE417
|
|
01635 ADD +1 TO MPRF-PURSUED-RPT-CNT. DTSBE417
|
|
01636 S1000-EXIT. DTSBE417
|
|
01637 EXIT. DTSBE417
|
|
01638 EJECT DTSBE417
|
|
01639 S2000-MISS-RPT-CUTOFF-CD. DTSBE417
|
|
01640 IF MQTR-RPT-IS-PURSUED-88 DTSBE417
|
|
01641 PERFORM S2100-RPT-IS-PURSUED THRU S2100-EXIT DTSBE417
|
|
01642 ELSE DTSBE417
|
|
01643 IF MQTR-CURR-RCVD-88 DTSBE417
|
|
01644 PERFORM S2200-CURR-RCVD THRU S2200-EXIT DTSBE417
|
|
01645 ELSE DTSBE417
|
|
01646 IF MQTR-CURR-NOT-LIABLE-88 DTSBE417
|
|
01647 SET MQTR-MISS-NOT-LIABLE-88 TO TRUE DTSBE417
|
|
01648 ELSE DTSBE417
|
|
01649 IF MQTR-CURR-NOT-DUE-88 DTSBE417
|
|
01650 SET MQTR-MISS-NO-LTR-EXT-88 TO TRUE DTSBE417
|
|
01651 ELSE DTSBE417
|
|
01652 SET MQTR-MISS-NO-LTR-OTHER-88 TO TRUE. DTSBE417
|
|
01653 S2000-EXIT. DTSBE417
|
|
01654 EXIT. DTSBE417
|
|
01655 SKIP3 DTSBE417
|
|
01656 S2100-RPT-IS-PURSUED. DTSBE417
|
|
01657 SET MQTR-MISS-NO-LTR-ADDR-88 TO TRUE. DTSBE417
|
|
01658 DTSBE417
|
|
01659 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBE417
|
|
01660 DTSBE417
|
|
01661 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBE417
|
|
01662 DTSBE417
|
|
01663 SET MTAD-TAD-88 TO TRUE. DTSBE417
|
|
01664 DTSBE417
|
|
01665 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
01666 DTSBE417
|
|
01667 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
01668 DTSBE417
|
|
01669 PERFORM S2110-MTAD-SCAN THRU S2110-EXIT DTSBE417
|
|
01670 UNTIL L910-NO-REC-88. DTSBE417
|
|
01671 DTSBE417
|
|
01672 DTSBE417
|
|
01673 IF MQTR-MISS-LETTER-SENT-88 DTSBE417
|
|
01674 GO TO S2100-EXIT. DTSBE417
|
|
01675 DTSBE417
|
|
01676 DTSBE417
|
|
01677 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBE417
|
|
01678 DTSBE417
|
|
01679 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBE417
|
|
01680 DTSBE417
|
|
01681 SET MOPO-OPO-88 TO TRUE. DTSBE417
|
|
01682 DTSBE417
|
|
01683 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
01684 DTSBE417
|
|
01685 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
01686 DTSBE417
|
|
01687 PERFORM DTSBE417
|
|
01688 UNTIL L910-NO-REC-88 DTSBE417
|
|
01689 MOVE MSKL-REC TO MOPO-REC DTSBE417
|
|
01690 IF MOPO-MISSING-RPT-LTRS-YES-88 DTSBE417
|
|
01691 SET MQTR-MISS-LETTER-SENT-88 TO TRUE DTSBE417
|
|
01692 END-IF DTSBE417
|
|
01693 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE417
|
|
01694 END-PERFORM. DTSBE417
|
|
01695 DTSBE417
|
|
01696 DTSBE417
|
|
01697 IF MQTR-MISS-LETTER-SENT-88 DTSBE417
|
|
01698 GO TO S2100-EXIT. DTSBE417
|
|
01699 DTSBE417
|
|
01700 DTSBE417
|
|
01701 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSBE417
|
|
01702 DTSBE417
|
|
01703 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBE417
|
|
01704 DTSBE417
|
|
01705 SET MTAA-TAA-88 TO TRUE. DTSBE417
|
|
01706 DTSBE417
|
|
01707 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
01708 DTSBE417
|
|
01709 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
01710 DTSBE417
|
|
01711 PERFORM DTSBE417
|
|
01712 UNTIL L910-NO-REC-88 DTSBE417
|
|
01713 MOVE MSKL-REC TO MTAA-REC DTSBE417
|
|
01714 IF MTAA-MISSING-RPT-LTRS-YES-88 DTSBE417
|
|
01715 SET MQTR-MISS-LETTER-SENT-88 TO TRUE DTSBE417
|
|
01716 END-IF DTSBE417
|
|
01717 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE417
|
|
01718 END-PERFORM. DTSBE417
|
|
01719 S2100-EXIT. DTSBE417
|
|
01720 EXIT. DTSBE417
|
|
01721 SKIP3 DTSBE417
|
|
01722 S2110-MTAD-SCAN. DTSBE417
|
|
01723 MOVE MSKL-REC TO MTAD-REC. DTSBE417
|
|
01724 DTSBE417
|
|
01725 IF MTAD-MISSING-RPT-LTRS-YES-88 DTSBE417
|
|
01726 SET MQTR-MISS-LETTER-SENT-88 TO TRUE DTSBE417
|
|
01727 SET L910-NO-REC-88 TO TRUE DTSBE417
|
|
01728 ELSE DTSBE417
|
|
01729 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE417
|
|
01730 S2110-EXIT. DTSBE417
|
|
01731 EXIT. DTSBE417
|
|
01732 SKIP3 DTSBE417
|
|
01733 S2200-CURR-RCVD. DTSBE417
|
|
01734 MOVE ALL-NINES-DATE TO WRK-ORIG-RECEIVED-DATE. DTSBE417
|
|
01735 DTSBE417
|
|
01736 DTSBE417
|
|
01737 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBE417
|
|
01738 DTSBE417
|
|
01739 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBE417
|
|
01740 DTSBE417
|
|
01741 SET MRPT-RPT-88 TO TRUE. DTSBE417
|
|
01742 DTSBE417
|
|
01743 MOVE MQTR-YRQ TO MRPT-YRQ. DTSBE417
|
|
01744 DTSBE417
|
|
01745 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBE417
|
|
01746 DTSBE417
|
|
01747 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE417
|
|
01748 DTSBE417
|
|
01749 PERFORM S2210-MRPT-SCAN THRU S2210-EXIT DTSBE417
|
|
01750 UNTIL L910-NO-REC-88. DTSBE417
|
|
01751 DTSBE417
|
|
01752 IF WRK-ORIG-RECEIVED-DATE > MQTR-RPT-DUE-DATE DTSBE417
|
|
01753 SET MQTR-MISS-UNTIMELY-88 TO TRUE DTSBE417
|
|
01754 ELSE DTSBE417
|
|
01755 SET MQTR-MISS-TIMELY-88 TO TRUE. DTSBE417
|
|
01756 S2200-EXIT. DTSBE417
|
|
01757 EXIT. DTSBE417
|
|
01758 SKIP3 DTSBE417
|
|
01759 S2210-MRPT-SCAN. DTSBE417
|
|
01760 MOVE MSKL-REC TO MRPT-REC. DTSBE417
|
|
01761 DTSBE417
|
|
01762 IF MQTR-YRQ = MRPT-YRQ DTSBE417
|
|
01763 NEXT SENTENCE DTSBE417
|
|
01764 ELSE DTSBE417
|
|
01765 SET L910-NO-REC-88 TO TRUE DTSBE417
|
|
01766 GO TO S2210-EXIT. DTSBE417
|
|
01767 DTSBE417
|
|
01768 IF MRPT-ORIG-88 DTSBE417
|
|
01769 MOVE MRPT-RECEIVED-DATE DTSBE417
|
|
01770 TO WRK-ORIG-RECEIVED-DATE. DTSBE417
|
|
01771 DTSBE417
|
|
01772 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE417
|
|
01773 S2210-EXIT. DTSBE417
|
|
01774 EXIT. DTSBE417
|
|
01775 EJECT DTSBE417
|
|
01776 S3000-ESTB-MTCK. DTSBE417
|
|
01777 MOVE LOW-VALUES TO MTCK-REC. DTSBE417
|
|
01778 DTSBE417
|
|
01779 MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSBE417
|
|
01780 DTSBE417
|
|
01781 SET MTCK-TCK-88 TO TRUE. DTSBE417
|
|
01782 DTSBE417
|
|
01783 ADD +1 TO LECM-EMP-ABSTIME. DTSBE417
|
|
01784 DTSBE417
|
|
01785 MOVE LECM-EMP-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBE417
|
|
01786 DTSBE417
|
|
01787 MOVE +0 TO MTCK-PURGE-DATE. DTSBE417
|
|
01788 DTSBE417
|
|
01789 MOVE +0 TO MTCK-TEXT-CNT. DTSBE417
|
|
01790 DTSBE417
|
|
01791 SET MTCK-TYPE-CHK-LATE-88 TO TRUE. DTSBE417
|
|
01792 DTSBE417
|
|
01793 MOVE WRK-TRIGGER-DATE TO MTCK-TRIGGER-DATE. DTSBE417
|
|
01794 DTSBE417
|
|
01795 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE. DTSBE417
|
|
01796 DTSBE417
|
|
01797 SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSBE417
|
|
01798 DTSBE417
|
|
01799 SET MTCK-DEST-SYSTEM-88 TO TRUE. DTSBE417
|
|
01800 DTSBE417
|
|
01801 MOVE MQTR-YRQ TO MTCK-LTE-YRQ. DTSBE417
|
|
01802 DTSBE417
|
|
01803 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSBE417
|
|
01804 DTSBE417
|
|
01805 MOVE LECM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSBE417
|
|
01806 MTCK-CHNG-DATE. DTSBE417
|
|
01807 DTSBE417
|
|
01808 MOVE MTCK-REC TO MSKL-REC. DTSBE417
|
|
01809 DTSBE417
|
|
01810 PERFORM S910-WRITE THRU S910-EXIT. DTSBE417
|
|
01811 S3000-EXIT. DTSBE417
|
|
01812 EXIT. DTSBE417
|
|
01813 EJECT DTSBE417
|
|
01814 S4000-WRITE-MEVL. DTSBE417
|
|
01815 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE417
|
|
01816 DTSBE417
|
|
01817 DTSBE417
|
|
01818 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE417
|
|
01819 DTSBE417
|
|
01820 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE417
|
|
01821 DTSBE417
|
|
01822 DTSBE417
|
|
01823 MOVE LOW-VALUES TO MEVL-REC. DTSBE417
|
|
01824 DTSBE417
|
|
01825 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE417
|
|
01826 DTSBE417
|
|
01827 SET MEVL-EVL-88 TO TRUE. DTSBE417
|
|
01828 DTSBE417
|
|
01829 MOVE L005-DATE TO MEVL-DATE. DTSBE417
|
|
01830 DTSBE417
|
|
01831 MOVE L005-TIME TO MEVL-TIME. DTSBE417
|
|
01832 DTSBE417
|
|
01833 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBE417
|
|
01834 DTSBE417
|
|
01835 MOVE EVL-TEXT TO MEVL-TEXT. DTSBE417
|
|
01836 DTSBE417
|
|
01837 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE417
|
|
01838 DTSBE417
|
|
01839 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE417
|
|
01840 DTSBE417
|
|
01841 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE417
|
|
01842 MEVL-CHNG-DATE. DTSBE417
|
|
01843 DTSBE417
|
|
01844 DTSBE417
|
|
01845 MOVE MEVL-REC TO MSKL-REC. DTSBE417
|
|
01846 DTSBE417
|
|
01847 PERFORM S910-WRITE THRU S910-EXIT. DTSBE417
|
|
01848 S4000-EXIT. DTSBE417
|
|
01849 EXIT. DTSBE417
|
|
01850 EJECT DTSBE417
|
|
01851 S9100-INCONSISTENT-RPT-TYPE. DTSBE417
|
|
01852 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBE417
|
|
01853 DTSBE417
|
|
01854 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE417
|
|
01855 DTSBE417
|
|
01856 MOVE L004-SLASH-QTR TO MSG4-SLASHED-YRQ. DTSBE417
|
|
01857 DTSBE417
|
|
01858 MOVE MSG4-ID TO R907-MSG-ID. DTSBE417
|
|
01859 DTSBE417
|
|
01860 MOVE MSG4-TEXT TO R907-MSG-TEXT. DTSBE417
|
|
01861 DTSBE417
|
|
01862 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE417
|
|
01863 DTSBE417
|
|
01864 MOVE 'Y' TO INCONSISTENCY-ENCOUNTERED-IND. DTSBE417
|
|
01865 S9100-EXIT. DTSBE417
|
|
01866 EXIT. DTSBE417
|
|
01867 EJECT DTSBE417
|
|
01868 S001-FROM-FED-8. DTSBE417
|
|
01869 SET L001-FROM-FED-8 TO TRUE. DTSBE417
|
|
01870 GO TO S001-DATE. DTSBE417
|
|
01871 DTSBE417
|
|
01872 S001-FROM-CAL-6. DTSBE417
|
|
01873 SET L001-FROM-CAL-6 TO TRUE. DTSBE417
|
|
01874 GO TO S001-DATE. DTSBE417
|
|
01875 DTSBE417
|
|
01876 S001-FROM-ABS-DAY. DTSBE417
|
|
01877 SET L001-FROM-ABS-DAY TO TRUE. DTSBE417
|
|
01878 GO TO S001-DATE. DTSBE417
|
|
01879 DTSBE417
|
|
01880 S001-DATE. DTSBE417
|
|
01881 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE417
|
|
01882 S001-EXIT. DTSBE417
|
|
01883 EXIT. DTSBE417
|
|
01884 SKIP3 DTSBE417
|
|
01885 S004-FROM-5. DTSBE417
|
|
01886 SET L004-FROM-5 TO TRUE. DTSBE417
|
|
01887 GO TO S004-QTR. DTSBE417
|
|
01888 DTSBE417
|
|
01889 S004-FROM-ABS. DTSBE417
|
|
01890 SET L004-FROM-ABS TO TRUE. DTSBE417
|
|
01891 GO TO S004-QTR. DTSBE417
|
|
01892 DTSBE417
|
|
01893 S004-FROM-3. DTSBE417
|
|
01894 SET L004-FROM-3 TO TRUE. DTSBE417
|
|
01895 GO TO S004-QTR. DTSBE417
|
|
01896 DTSBE417
|
|
01897 S004-QTR. DTSBE417
|
|
01898 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE417
|
|
01899 S004-EXIT. DTSBE417
|
|
01900 EXIT. DTSBE417
|
|
01901 SKIP3 DTSBE417
|
|
01902 S005-FROM-ABSTIME. DTSBE417
|
|
01903 SET L005-FROM-ABSTIME TO TRUE. DTSBE417
|
|
01904 GO TO S005-ABSTIME. DTSBE417
|
|
01905 DTSBE417
|
|
01906 S005-ABSTIME. DTSBE417
|
|
01907 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE417
|
|
01908 S005-EXIT. DTSBE417
|
|
01909 EXIT. DTSBE417
|
|
01910 SKIP3 DTSBE417
|
|
01911 S061-DETERMINE-FLD-REP. DTSBE417
|
|
01912 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBE417
|
|
01913 DTSBE417
|
|
01914 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE417
|
|
01915 DTSBE417
|
|
01916 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE417
|
|
01917 S061-EXIT. DTSBE417
|
|
01918 EXIT. DTSBE417
|
|
01919 SKIP3 DTSBE417
|
|
01920 S064-LOOKUP-FLD-ZIP-ADDR. DTSBE417
|
|
01921 MOVE MPRF-EMP-NO TO L064-EMP-NO. DTSBE417
|
|
01922 DTSBE417
|
|
01923 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND DTSBE417
|
|
01924 TO L064-TAX-REC-ADDR-EXISTS-IND. DTSBE417
|
|
01925 DTSBE417
|
|
01926 CALL 'DTSBU064' USING L064-LINK-AREA. DTSBE417
|
|
01927 S064-EXIT. DTSBE417
|
|
01928 EXIT. DTSBE417
|
|
01929 SKIP3 DTSBE417
|
|
01930 S102-DELINQUENCY-RUN. DTSBE417
|
|
01931 SET L102-DELINQUENCY-RUN-88 TO TRUE. DTSBE417
|
|
01932 GO TO S102-PENALTY-COMPUTATION. DTSBE417
|
|
01933 DTSBE417
|
|
01934 S102-PENALTY-COMPUTATION. DTSBE417
|
|
01935 CALL 'DTSBU102' USING L102-LINK-AREA. DTSBE417
|
|
01936 S102-EXIT. DTSBE417
|
|
01937 EXIT. DTSBE417
|
|
01938 DTSBE417
|
|
01939 S109-FIRST-PEN-INT-YRQ. DTSBE417
|
|
01940 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBE417
|
|
01941 DTSBE417
|
|
01942 S109-LOOKUP-SUR-RATE. DTSBE417
|
|
01943 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE417
|
|
01944 S109-EXIT. DTSBE417
|
|
01945 EXIT. DTSBE417
|
|
01946 SKIP3 DTSBE417
|
|
01947 S111-LOOKUP-TAD. DTSBE417
|
|
01948 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE417
|
|
01949 GO TO S111-LOOKUP-ADDR. DTSBE417
|
|
01950 DTSBE417
|
|
01951 S111-LOOKUP-TAA. DTSBE417
|
|
01952 SET L111-LOOKUP-TAA-88 TO TRUE. DTSBE417
|
|
01953 GO TO S111-LOOKUP-ADDR. DTSBE417
|
|
01954 DTSBE417
|
|
01955 S111-LOOKUP-OPO. DTSBE417
|
|
01956 SET L111-LOOKUP-OPO-88 TO TRUE. DTSBE417
|
|
01957 GO TO S111-LOOKUP-ADDR. DTSBE417
|
|
01958 DTSBE417
|
|
01959 S111-LOOKUP-ADDR. DTSBE417
|
|
01960 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE417
|
|
01961 DTSBE417
|
|
01962 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE417
|
|
01963 S111-EXIT. DTSBE417
|
|
01964 EXIT. DTSBE417
|
|
01965 SKIP3 DTSBE417
|
|
01966 S112-TAD-ADDR. DTSBE417
|
|
01967 SET L112-TAD-ADDR-88 TO TRUE. DTSBE417
|
|
01968 GO TO S112-FORMAT-ADDR. DTSBE417
|
|
01969 DTSBE417
|
|
01970 S112-TAA-ADDR. DTSBE417
|
|
01971 SET L112-TAA-ADDR-88 TO TRUE. DTSBE417
|
|
01972 GO TO S112-FORMAT-ADDR. DTSBE417
|
|
01973 DTSBE417
|
|
01974 S112-OPO-ADDR. DTSBE417
|
|
01975 SET L112-OPO-ADDR-88 TO TRUE. DTSBE417
|
|
01976 GO TO S112-FORMAT-ADDR. DTSBE417
|
|
01977 DTSBE417
|
|
01978 S112-FORMAT-ADDR. DTSBE417
|
|
01979 SET L112-ANCHOR-LAST-88 TO TRUE. DTSBE417
|
|
01980 DTSBE417
|
|
01981 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE417
|
|
01982 DTSBE417
|
|
01983 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE417
|
|
01984 S112-EXIT. DTSBE417
|
|
01985 EXIT. DTSBE417
|
|
01986 SKIP3 DTSBE417
|
|
01987 S410-FILE-SCHED. DTSBE417
|
|
01988 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBE417
|
|
01989 S410-EXIT. DTSBE417
|
|
01990 EXIT. DTSBE417
|
|
01991 SKIP3 DTSBE417
|
|
01992 S511-INITIALIZE-MQTR. DTSBE417
|
|
01993 CALL 'DTSBU511' USING MQTR-REC. DTSBE417
|
|
01994 S511-EXIT. DTSBE417
|
|
01995 EXIT. DTSBE417
|
|
01996 SKIP3 DTSBE417
|
|
01997 S516-LIABILITY. DTSBE417
|
|
01998 CALL 'DTSBU516' USING L516-LINK-AREA DTSBE417
|
|
01999 MPRF-LINK-REC. DTSBE417
|
|
02000 S516-EXIT. DTSBE417
|
|
02001 EXIT. DTSBE417
|
|
02002 SKIP3 DTSBE417
|
|
02003 S910-READ. DTSBE417
|
|
02004 SET L910-READ-88 TO TRUE. DTSBE417
|
|
02005 GO TO S910-MSTR-IO. DTSBE417
|
|
02006 DTSBE417
|
|
02007 S910-START-BROWSE. DTSBE417
|
|
02008 SET L910-START-BROWSE-88 TO TRUE. DTSBE417
|
|
02009 GO TO S910-MSTR-IO. DTSBE417
|
|
02010 DTSBE417
|
|
02011 S910-READ-NEXT. DTSBE417
|
|
02012 SET L910-READ-NEXT-88 TO TRUE. DTSBE417
|
|
02013 GO TO S910-MSTR-IO. DTSBE417
|
|
02014 DTSBE417
|
|
02015 S910-COUNT. DTSBE417
|
|
02016 SET L910-COUNT-88 TO TRUE. DTSBE417
|
|
02017 GO TO S910-MSTR-IO. DTSBE417
|
|
02018 DTSBE417
|
|
02019 S910-WRITE. DTSBE417
|
|
02020 SET L910-WRITE-88 TO TRUE. DTSBE417
|
|
02021 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE417
|
|
02022 GO TO S910-MSTR-IO. DTSBE417
|
|
02023 DTSBE417
|
|
02024 S910-REWRITE. DTSBE417
|
|
02025 SET L910-REWRITE-88 TO TRUE. DTSBE417
|
|
02026 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE417
|
|
02027 GO TO S910-MSTR-IO. DTSBE417
|
|
02028 DTSBE417
|
|
02029 S910-DELETE. DTSBE417
|
|
02030 SET L910-DELETE-88 TO TRUE. DTSBE417
|
|
02031 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE417
|
|
02032 GO TO S910-MSTR-IO. DTSBE417
|
|
02033 DTSBE417
|
|
02034 S910-MSTR-IO. DTSBE417
|
|
02035 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE417
|
|
02036 MSKL-REC. DTSBE417
|
|
02037 S910-EXIT. DTSBE417
|
|
02038 EXIT. DTSBE417
|
|
02039 SKIP3 DTSBE417
|
|
02040 S923-OPEN-READ. DTSBE417
|
|
02041 SET L923-OPEN-READ-88 TO TRUE. DTSBE417
|
|
02042 GO TO S923-ATC-IO. DTSBE417
|
|
02043 DTSBE417
|
|
02044 S923-START-BROWSE. DTSBE417
|
|
02045 SET L923-START-BROWSE-88 TO TRUE. DTSBE417
|
|
02046 GO TO S923-ATC-IO. DTSBE417
|
|
02047 DTSBE417
|
|
02048 S923-READ-NEXT. DTSBE417
|
|
02049 SET L923-READ-NEXT-88 TO TRUE. DTSBE417
|
|
02050 GO TO S923-ATC-IO. DTSBE417
|
|
02051 DTSBE417
|
|
02052 S923-CLOSE. DTSBE417
|
|
02053 SET L923-CLOSE-88 TO TRUE. DTSBE417
|
|
02054 GO TO S923-ATC-IO. DTSBE417
|
|
02055 DTSBE417
|
|
02056 S923-ATC-IO. DTSBE417
|
|
02057 CALL 'DTSBU923' USING L923-LINK-AREA DTSBE417
|
|
02058 ASKL-REC. DTSBE417
|
|
02059 S923-EXIT. DTSBE417
|
|
02060 EXIT. DTSBE417
|
|
02061 DTSBE417
|
|
02062 S927-WRITE-T026. DTSBE417
|
|
02063 SET L927-WRITE-88 TO TRUE. DTSBE417
|
|
02064 CALL 'DTSBU927' USING L927-LINK-AREA DTSBE417
|
|
02065 T026-REC. DTSBE417
|
|
02066 GO TO S927-EXIT. DTSBE417
|
|
02067 DTSBE417
|
|
02068 S927-EXIT. DTSBE417
|
|
02069 EXIT. DTSBE417
|
|
02070 DTSBE417
|
|
02071 S931-READ. DTSBE417
|
|
02072 SET L931-READ-88 TO TRUE. DTSBE417
|
|
02073 GO TO S931-REF-I. DTSBE417
|
|
02074 DTSBE417
|
|
02075 S931-START-BROWSE. DTSBE417
|
|
02076 SET L931-START-BROWSE-88 TO TRUE. DTSBE417
|
|
02077 GO TO S931-REF-I. DTSBE417
|
|
02078 DTSBE417
|
|
02079 S931-READ-NEXT. DTSBE417
|
|
02080 SET L931-READ-NEXT-88 TO TRUE. DTSBE417
|
|
02081 GO TO S931-REF-I. DTSBE417
|
|
02082 DTSBE417
|
|
02083 S931-WRITE. DTSBE417
|
|
02084 SET L931-WRITE-88 TO TRUE. DTSBE417
|
|
02085 GO TO S931-REF-I. DTSBE417
|
|
02086 DTSBE417
|
|
02087 S931-REWRITE. DTSBE417
|
|
02088 SET L931-REWRITE-88 TO TRUE. DTSBE417
|
|
02089 GO TO S931-REF-I. DTSBE417
|
|
02090 DTSBE417
|
|
02091 S931-DELETE. DTSBE417
|
|
02092 SET L931-DELETE-88 TO TRUE. DTSBE417
|
|
02093 GO TO S931-REF-I. DTSBE417
|
|
02094 DTSBE417
|
|
02095 S931-REF-I. DTSBE417
|
|
02096 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE417
|
|
02097 FSKL-REC. DTSBE417
|
|
02098 S931-EXIT. DTSBE417
|
|
02099 EXIT. DTSBE417
|
|
02100 SKIP3 DTSBE417
|
|
02101 S946-WRITE-R417. DTSBE417
|
|
02102 CALL 'DTSBU946' USING R417-REC. DTSBE417
|
|
02103 GO TO S946-EXIT. DTSBE417
|
|
02104 DTSBE417
|
|
02105 S946-WRITE-R418. DTSBE417
|
|
02106 CALL 'DTSBU946' USING R418-REC. DTSBE417
|
|
02107 GO TO S946-EXIT. DTSBE417
|
|
02108 DTSBE417
|
|
02109 S946-WRITE-R716. DTSBE417
|
|
02110 CALL 'DTSBU946' USING R716-REC. DTSBE417
|
|
02111 GO TO S946-EXIT. DTSBE417
|
|
02112 DTSBE417
|
|
02113 S946-WRITE-R907. DTSBE417
|
|
02114 CALL 'DTSBU946' USING R907-REC. DTSBE417
|
|
02115 GO TO S946-EXIT. DTSBE417
|
|
02116 DTSBE417
|
|
02117 S946-EXIT. DTSBE417
|
|
02118 EXIT. DTSBE417
|
|
02119 SKIP3 DTSBE417
|
|
02120 S999-ABEND. DTSBE417
|
|
02121 DISPLAY '*** DTSBE417 ABENDING. ' DTSBE417
|
|
02122 ABEND-MSG. DTSBE417
|
|
02123 DTSBE417
|
|
02124 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE417
|
|
02125 S999-EXIT. DTSBE417
|
|
02126 EXIT. DTSBE417
|