00001 IDENTIFICATION DIVISION. 08/15/18 00002 DTSBD540 00003 PROGRAM-ID. DTSBD540. LV021 00004 DTSBD540 00005 AUTHOR. TRICOASTAL CONSULTING LTD. DTSBD540 00006 DTSBD540 00007 DATE-WRITTEN. DECEMBER 1999. DTSBD540 00008 DTSBD540 00009 DATE-COMPILED. DTSBD540 00010 DTSBD540 00011 DTSBD540 00012 ***** DTSBD540 00013 * DTSBD540 00014 * FUNCTION: DTSBD540 00015 * DTSBD540 00016 * EXTRACT DATA FROM THE UI TAX EMPLOYER MASTER FILE FOR DTSBD540 00017 * INPUT INTO THE ES202 SYSTEM. DTSBD540 00018 * DTSBD540 00019 * DTSBD540 00020 * MODIFICATION LOG: DTSBD540 00021 * DTSBD540 00022 * 12/02/1999 INITIAL DEVELOPMENT. DTSBD540 00023 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD540 00024 * DTSBD540 00025 * 07/24/2000 MODIFIED P8100 TO MOVE MAILING ADDRESS TO DTSBD540 00026 * MAILING/OTHER ADDRESS FIELDS, AND TO INITIALIZE DTSBD540 00027 * ADDRESS DATA TO LOW-VALUES. LOW-VALUES IN A DTSBD540 00028 * FIELD MEANS IT SHOULD BE IGNORED. SPACES IN A DTSBD540 00029 * FIELD MEANS REPLACE EXISTING DATA WITH SPACES. DTSBD540 00030 * ADDED CODE IN P9000 TO SET COUNTY TO 001. DTSBD540 00031 * REFERENCE: REQUEST FROM LMI PROGRAMMER: GD DTSBD540 00032 * DTSBD540 00033 * 10/13/2000 MODIFIED P1000 TO INITIALIZE IMT RECORD TO DTSBD540 00034 * LOW-VALUES. DTSBD540 00035 * MODIFIED P9000 TO INITIALIZE EACH QUARTER DTSBD540 00036 * OCCURRENCE TO LOW-VALUES. DTSBD540 00037 * MODIFIED NAICS AND SIC PROCESSING IN P9000 DTSBD540 00038 * TO SET A VALUE ONLY IF THERE IS A VALID DTSBD540 00039 * INDUSTRY CODE. FIELDS WILL CONTAIN LOW-VALUES DTSBD540 00040 * IF CODE HAS NOT BEEN ASSIGNED. DTSBD540 00041 * REFERENCE: REQUEST FROM LMI PROGRAMMER: GD DTSBD540 00042 * DTSBD540 00043 * 08/14/2002 RECOMPILED TO USE THE NEW VERSION OF THE MRTE DTSBD540 00044 * RECORD, INCLUDING THE 'ESTIMATED' RATE TYPE. DTSBD540 00045 * THE ES202 EXTRACT WILL REPORT A RATE EVEN IF DTSBD540 00046 * IT IS ESTIMATED. DTSBD540 00047 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD540 00048 * DTSBD540 00049 * 04/23/2004 MODIFIED P5000 TO SELECT EMPLOYERS FOR WHOM DTSBD540 00050 * THE NAICS CODE HAS CHANGED. DTSBD540 00051 * REFERENCE: LMI REQUIREMENT PROGRAMMER: GD DTSBD540 00052 * DTSBD540 00053 * 10/25/2004 MODIFIED TO CREATE A PARAMETER FILE CONTAINING DTSBD540 00054 * BOTH PARM SPECIFIED QTR AND PREVIOUS QTR WHICH DTSBD540 00055 * WILL PASS TO PGMS DTSBD541 AND DTSBD542. DTSBD540 00056 * REFERENCE: LMI REQUIRMENT PROGRAMMER: RW DTSBD540 00057 * DTSBD540 00058 * 07/13/2006 TEMPORARY MODIFICATION OF I1100 TO ALLOW JOB DTSBD540 00059 * TO RUN BEFORE THE QUARTER HAS BEEN DECLARED DTSBD540 00060 * DELINQUENT. DTSBD540 00061 * REFERENCE: PROGRAMMER: GD DTSBD540 00062 * DTSBD540 00063 * 07/13/2006 TEMPORARY MODIFICATION OF I1100 REMOVED. DTSBD540 00064 * REFERENCE: PROGRAMMER: GD DTSBD540 00065 * DTSBD540 00066 * 02/27/2014 REMOVE THE '63' FROM PROGRAM FOR THE IMT FIELD DTSBD540 00067 * LOCK FIELD DTSBD540 00068 * REFERENCE: 2292 PROGRAMMER: NH DTSBD540 00069 * DTSBD540 00070 * 02/26/2015 LMI NEED DATA BEFORE QTR DECLARED DELINQ, DTSBD540 00071 * MODIFY PROGRAM TO READ CURR UC30 QTR INSTEAD DTSBD540 00072 * OF LAST DELINQ QTR. DTSBD540 00073 * REFERENCE: PROGRAMMER: ZL1 DTSBD540 00074 * DTSBD540 00075 * 02/27/2015 PER LMI DUTAS NAICS WERE UPDATED WITH BLS NAICS. DTSBD540 00076 * REFERENCE: PROGRAMMER: ZL1 DTSBD540 00077 * DTSBD540 00078 * 05/26/2015 PER LMI ANY OWNERSHIP CODES THAT ARE '00" MUST DTSBD540 00079 * BE CHANGED TO '50' DTSBD540 00080 * REFERENCE: PROGRAMMER: NH1 DTSBD540 00081 * CL**3 00082 * 08/14/2018 PER LMI IF WAGES ARE ESTIMATED DO NOT SEND IND CL*15 00083 * AS 'E' NEEDS TO BE LOW-VALUES TICKET 8500 CL*15 00084 * REFERENCE: PROGRAMMER: NH1 CL**3 00085 * CL**3 00086 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD540 00087 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD540 00088 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD540 00089 * DTSBD540 00090 * DTSBD540 00091 * DESCRIPTION: DTSBD540 00092 * DTSBD540 00093 * DTSBD540 SCANS THE UI TAX EMPLOYER MASTER FILE AND WRITES DTSBD540 00094 * ES202 INPUT MICRO TRANSACTION (IMT) RECORDS. DTSBD540 00095 * DTSBD540 00096 * INPUT FILES: DTSBD540 00097 * DTSBD540 00098 * SYSIN INPUT PARAMETERS. SPECIFIES THE YEAR/QUARTER DTSBD540 00099 * FROM WHICH EMPLOYEE COUNTS ARE TO BE EXTRACTED DTSBD540 00100 * AND THE TYPE OF EXTRACT (PRELIMINARY OR REVISED).DTSBD540 00101 * DTSBD540 00102 * CNTRFILE THE HISTORY OF PRIOR EXTRACTS. ONE RECORD DTSBD540 00103 * OCCURRENCE FOR EACH YEAR/QUARTER FOR WHICH THE DTSBD540 00104 * ES202 EXTRACT PROCESS HAS RUN. DTSBD540 00105 * DTSBD540 00106 * DTSFMST* THE UI TAX EMPLOYER MASTER FILE. THE UI TAX DTSBD540 00107 * EMPLOYER MASTER FILE IS ACCESSED VIA MODULE DTSBD540 00108 * DTSBU910 - FD STATEMENTS FOR THE UI TAX EMPLOYER DTSBD540 00109 * MASTER FILE ARE IN DTSBU910 - NOT IN DTSBD540. DTSBD540 00110 * DTSBD540 00111 * DTSFAIX THE UI TAX EMPLOYER MASTER FILE ALTERNATE DTSBD540 00112 * INDEXES. THE UI TAX EMPLOYER MASTER FILE DTSBD540 00113 * ALTERNATE IDEXES ARE ACCESSED VIA MODULE DTSBD540 00114 * DTSBU921 - FD STATEMENT FOR THE UI TAX EMPLOYER DTSBD540 00115 * MASTER FILE IS IN DTSBU921 - NOT IN DTSBD540. DTSBD540 00116 * DTSBD540 00117 * DTSFVRO1 UI TAX REPORT RECORD OUTPUT FILE. ACCESSED DTSBD540 00118 * VIA MODULE DTSBU946. FD STATEMENT FOR THE DTSBD540 00119 * UI TAX REPORT RECORD OUTPUT FILE IS IN DTSBD540 00120 * DTSBU946 - NOT IN DTSBD540. DTSBD540 00121 * DTSBD540 00122 * DTSBD540 00123 * OUTPUT FILES: DTSBD540 00124 * DTSBD540 00125 * CNTRFILE THE HISTORY OF PRIOR EXTRACTS. ONE RECORD DTSBD540 00126 * OCCURRENCE FOR EACH YEAR/QUARTER FOR WHICH THE DTSBD540 00127 * ES202 EXTRACT PROCESS HAS RUN. DTSBD540 00128 * DTSBD540 00129 * DTSBD540 00130 * ES202IMT THE EXPO-202 INPUT MICRO TRANSACTION (IMT) FILE. DTSBD540 00131 * DTSBD540 00132 * DTSBD540 00133 * THE EXPO-202 INPUT MICRO TRANSACTION (IMT) FILE DEVELOPMENT DTSBD540 00134 * GUIDE VERSION 5.0 (REVISED 02/10/1997) WAS USED IN THE DTSBD540 00135 * DEVELOPMENT OF DTSBD540. DTSBD540 00136 * DTSBD540 00137 * DTSBD540 PROCESSES ONLY ONE YEAR/QUARTER PER RUN - THE DTSBD540 00138 * YEAR/QUARTER SPECIFIED VIA SYSIN. HOWEVER, MULTIPLE DTSBD540 00139 * DTSBD540 RUNS MY OCCUR FOR A GIVEN QUARTER - AN "INITIAL" DTSBD540 00140 * RUN AND THEN ANY NUMBER OF "REVISED" RUNS. DTSBD540 00141 * DTSBD540 00142 * WHEN AN "INITIAL" RUN OCCURS, DTSBD540 EXAMINES BOTH DTSBD540 00143 * EMPLOYER LEVEL DATA AND QUARTER LEVEL DATA. IF, FOR A DTSBD540 00144 * GIVEN EMPLOYER, ANY "EMPLOYER LEVEL" DATA IN WHICH THE DTSBD540 00145 * ES202 IS INTERESTED HAS BEEN MODIFIED SINCE THE MOST DTSBD540 00146 * RECENT "INITIAL" RUN, DTSBD540 EXTRACTS THE EMPLOYER DTSBD540 00147 * LEVEL DATA - AS WELL AS ANY QUARTER LEVEL DATA FROM THE DTSBD540 00148 * SPECIFIED YEAR/QUARTER WHICH MIGHT EXIST. DTSBD540 00149 * DTSBD540 00150 * WHEN A "REVISED" RUN IS SPECIFIED, DTSBD540 EXAMINES ONLY DTSBD540 00151 * THE SPECIFIED YEAR/QUARTER WHEN DETERMINING WHETHER OR NOT DTSBD540 00152 * TO GENERATE AN IMT RECORD FOR THE EMPLOYER. ONLY WHEN DTSBD540 00153 * YEAR/QUARTER DATA FOR THE SPECIFIED YEAR/QUARTER HAS BEEN DTSBD540 00154 * MODIFIED SINCE THE MOST RECENT EXTRACT FOR THE SPECIFIED DTSBD540 00155 * YEAR/QUARTER DOES DTSBD540 GENERATE AN EXTRACT RECORD DTSBD540 00156 * FOR THE EMPLOYER. HOWEVER, WHEN AN EXTRACT RECORD IS DTSBD540 00157 * GENERATED, IT IS A FULLY POPULATED EXTRACT RECORD - IT DTSBD540 00158 * INCLUDES BOTH EMPLOYER LEVEL AND YEAR/QUARTER LEVEL DATA. DTSBD540 00159 * DTSBD540 00160 * DTSBD540 00161 ***** DTSBD540 00162 DTSBD540 00163 DTSBD540 00164 DTSBD540 00165 ENVIRONMENT DIVISION. DTSBD540 00166 DTSBD540 00167 INPUT-OUTPUT SECTION. DTSBD540 00168 DTSBD540 00169 FILE-CONTROL. DTSBD540 00170 SELECT SYSIN-FILE ASSIGN TO SYSIN. DTSBD540 00171 SELECT CNTR-FILE ASSIGN TO CNTRFILE. DTSBD540 00172 SELECT ES202IMT-FILE ASSIGN TO ES202IMT. DTSBD540 00173 SELECT ES202PRM-FILE ASSIGN TO ES202PRM. DTSBD540 00174 DTSBD540 00175 DTSBD540 00176 DTSBD540 00177 DATA DIVISION. DTSBD540 00178 DTSBD540 00179 DTSBD540 00180 FILE SECTION. DTSBD540 00181 DTSBD540 00182 DTSBD540 00183 FD SYSIN-FILE DTSBD540 00184 RECORDING MODE IS F DTSBD540 00185 BLOCK CONTAINS 0 RECORDS. DTSBD540 00186 DTSBD540 00187 01 SYSIN-REC. DTSBD540 00188 05 SYSIN-RECORD-TYPE PIC X(03). DTSBD540 00189 88 SYSIN-RECORD-COMMENT-88 VALUE '***'. DTSBD540 00190 88 SYSIN-RECORD-YRQ-88 VALUE 'YRQ'. DTSBD540 00191 05 FILLER PIC X(01). DTSBD540 00192 05 SYSIN-EXT-YRQ PIC X(03). DTSBD540 00193 05 FILLER PIC X(01). DTSBD540 00194 05 SYSIN-EXT-TYPE PIC X(01). DTSBD540 00195 88 SYSIN-EXT-INITIAL-88 VALUE 'I'. DTSBD540 00196 88 SYSIN-EXT-REVISED-88 VALUE 'R'. DTSBD540 00197 05 FILLER PIC X(71). DTSBD540 00198 DTSBD540 00199 DTSBD540 00200 DTSBD540 00201 FD CNTR-FILE DTSBD540 00202 RECORDING MODE IS F DTSBD540 00203 BLOCK CONTAINS 0 RECORDS. DTSBD540 00204 DTSBD540 00205 01 CNTR-REC. DTSBD540 00206 05 CNTR-RECORD-TYPE PIC X(03). DTSBD540 00207 88 CNTR-RECORD-COMMENT-88 VALUE '***'. DTSBD540 00208 88 CNTR-RECORD-YRQ-88 VALUE 'YRQ'. DTSBD540 00209 05 FILLER PIC X(01). DTSBD540 00210 05 CNTR-YRQ PIC X(05). DTSBD540 00211 05 CNTR-YRQ-9 DTSBD540 00212 REDEFINES CNTR-YRQ PIC 9(05). DTSBD540 00213 05 FILLER PIC X(01). DTSBD540 00214 05 CNTR-EXT-INITIAL-DATE PIC X(08). DTSBD540 00215 05 CNTR-EXT-INITIAL-DATE-9 DTSBD540 00216 REDEFINES CNTR-EXT-INITIAL-DATE PIC 9(08). DTSBD540 00217 05 FILLER PIC X(01). DTSBD540 00218 05 CNTR-EXT-MOST-RECENT-DATE PIC X(08). DTSBD540 00219 05 CNTR-EXT-MOST-RECENT-DATE-9 DTSBD540 00220 REDEFINES CNTR-EXT-MOST-RECENT-DATE DTSBD540 00221 PIC 9(08). DTSBD540 00222 05 FILLER PIC X(53). DTSBD540 00223 DTSBD540 00224 FD ES202IMT-FILE DTSBD540 00225 RECORDING MODE IS F DTSBD540 00226 BLOCK CONTAINS 0 RECORDS. DTSBD540 00227 DTSBD540 00228 01 ES202-IMT-REC. DTSBD540 00229 ++INCLUDE ES2IMTV5 DTSBD540 00230 DTSBD540 00231 DTSBD540 00232 FD ES202PRM-FILE DTSBD540 00233 RECORDING MODE IS F DTSBD540 00234 BLOCK CONTAINS 0 RECORDS. DTSBD540 00235 DTSBD540 00236 01 ES202-PARM-REC. DTSBD540 00237 05 ES202-PARM-YRQ1 PIC S9(05) COMP-3. DTSBD540 00238 05 ES202-PARM-YRQ2 PIC S9(05) COMP-3. DTSBD540 00239 DTSBD540 00240 DTSBD540 00241 EJECT DTSBD540 00242 WORKING-STORAGE SECTION. DTSBD540 002425 77 PAN-VALET PICTURE X(24) VALUE '021DTSBD540 08/15/18'. DTSBD540 00243 77 PAN-VALET PICTURE X(24) VALUE '021DTSBD540 05/29/15'. DTSBD540 00244 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD540 05/26/15'. DTSBD540 00245 77 PAN-VALET PICTURE X(24) VALUE '019DTSBD540 02/27/15'. DTSBD540 00246 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD540 02/27/15'. DTSBD540 00247 77 PAN-VALET PICTURE X(24) VALUE '017DTSBD540 02/27/14'. DTSBD540 00248 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD540 02/27/14'. DTSBD540 00249 77 PAN-VALET PICTURE X(24) VALUE '015DTSBD540 07/13/06'. DTSBD540 00250 DTSBD540 00251 01 WRK-AREA. DTSBD540 00252 05 WRK-MODULE-NAME PIC X(08) VALUE 'DTSBD540'.DTSBD540 00253 DTSBD540 00254 05 WRK-ABEND-CODE PIC S9(04) COMP VALUE +540.DTSBD540 00255 DTSBD540 00256 05 WRK-ABEND-MSG PIC X(60). DTSBD540 00257 DTSBD540 00258 DTSBD540 00259 05 SYSIN-REC-CNT PIC S9(07) COMP-3. DTSBD540 00260 DTSBD540 00261 05 SYSIN-EOF-IND PIC X(01). DTSBD540 00262 88 SYSIN-EOF-NO-88 VALUE 'N'. DTSBD540 00263 88 SYSIN-EOF-YES-88 VALUE 'Y'. DTSBD540 00264 DTSBD540 00265 05 WRK-EXT-YRQ-AREA OCCURS 2 TIMES. DTSBD540 00266 10 WRK-EXT-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBD540 00267 10 WRK-EXT-ABS-QTR PIC S9(04) COMP VALUE +0. DTSBD540 00268 10 WRK-EXT-TYPE PIC X(01). DTSBD540 00269 88 WRK-EXT-INITIAL-88 VALUE 'I'. DTSBD540 00270 88 WRK-EXT-REVISED-88 VALUE 'R'. DTSBD540 00271 10 WRK-EXT-INITIAL-DATE PIC S9(09) COMP-3 VALUE +0. DTSBD540 00272 10 WRK-EXT-MOST-RECENT-DATE DTSBD540 00273 PIC S9(09) COMP-3 VALUE +0. DTSBD540 00274 DTSBD540 00275 05 WRK-CNTR-ABS-QTR PIC S9(04) COMP VALUE +0. DTSBD540 00276 DTSBD540 00277 05 WRK-CNTR-REC DTSBD540 00278 OCCURS 2 TIMES PIC X(80) VALUE SPACE. DTSBD540 00279 DTSBD540 00280 05 WRK-EXT-CURRENT-DATE PIC S9(09) COMP-3. DTSBD540 00281 DTSBD540 00282 05 WRK-GLOBAL-LAST-INITIAL-DATE DTSBD540 00283 PIC S9(09) COMP-3. DTSBD540 00284 DTSBD540 00285 05 YRQ-SUB PIC S9(04) COMP VALUE +0. DTSBD540 00286 DTSBD540 00287 05 WRK-YRQ-OCC-MAX PIC S9(04) COMP VALUE +2. DTSBD540 00288 DTSBD540 00289 05 ES202IMT-REC-CNT PIC S9(07) COMP-3. DTSBD540 00290 DTSBD540 00291 05 PRF-REC-CNT PIC S9(07) COMP-3. DTSBD540 00292 DTSBD540 00293 DTSBD540 00294 05 WRK-EMP-LEVEL-MOD-IND PIC X(01). DTSBD540 00295 88 WRK-EMP-LEVEL-MOD-NO-88 VALUE 'N'. DTSBD540 00296 88 WRK-EMP-LEVEL-MOD-YES-88 VALUE 'Y'. DTSBD540 00297 DTSBD540 00298 05 WRK-QTR-LEVEL-MOD-IND PIC X(01). DTSBD540 00299 88 WRK-QTR-LEVEL-MOD-NO-88 VALUE 'N'. DTSBD540 00300 88 WRK-QTR-LEVEL-MOD-YES-88 VALUE 'Y'. DTSBD540 00301 DTSBD540 00302 DTSBD540 00303 05 WRK-INIT-ESTB-DATE PIC S9(09) COMP-3. DTSBD540 00304 DTSBD540 00305 05 WRK-INIT-LIAB-DATE PIC S9(09) COMP-3. DTSBD540 00306 DTSBD540 00307 05 WRK-INIT-INACT-DATE PIC S9(09) COMP-3. DTSBD540 00308 88 WRK-INIT-ACTIVE-88 VALUE +999999999. DTSBD540 00309 DTSBD540 00310 05 WRK-MOST-RECENT-LIAB-DATE PIC S9(09) COMP-3. DTSBD540 00311 DTSBD540 00312 05 WRK-ACTIVE-IN-EXT-YRQ-IND PIC X(01). DTSBD540 00313 88 WRK-ACTIVE-IN-EXT-YRQ-NO-88 VALUE 'N'. DTSBD540 00314 88 WRK-ACTIVE-IN-EXT-YRQ-YES-88 VALUE 'Y'. DTSBD540 00315 DTSBD540 00316 05 WRK-PRED-ACCT PIC 9(10). DTSBD540 00317 DTSBD540 00318 05 WRK-SUCC-ACCT PIC 9(10). DTSBD540 00319 DTSBD540 00320 05 WRK-SUCC-EFF-DATE PIC S9(09) COMP-3. DTSBD540 00321 DTSBD540 00322 DTSBD540 00323 05 WRK-ROUND-AMT PIC S9(11)V9(02) COMP-3. DTSBD540 00324 DTSBD540 00325 05 WRK-IMTQ-IND PIC X(01). DTSBD540 00326 EJECT DTSBD540 00327 01 ADDRESS-REFORMAT-AREA. DTSBD540 00328 05 ADR-VALID-ADDRESS-IND PIC X(01). DTSBD540 00329 88 ADR-VALID-ADDRESS-NO-88 VALUE 'N'. DTSBD540 00330 88 ADR-VALID-ADDRESS-YES-88 VALUE 'Y'. DTSBD540 00331 DTSBD540 00332 05 ADR-PHYSICAL-ADDRESS-IND PIC X(01). DTSBD540 00333 88 ADR-PHYSICAL-ADDRESS-NO-88 VALUE 'N'. DTSBD540 00334 88 ADR-PHYSICAL-ADDRESS-YES-88 VALUE 'Y'. DTSBD540 00335 DTSBD540 00336 05 ADR-ES202-ADDRESS. DTSBD540 00337 10 ADR-ATTENTION-NAME PIC X(35). DTSBD540 00338 10 ADR-ADDRESS PIC X(35). DTSBD540 00339 10 ADR-ADDRESS2 PIC X(35). DTSBD540 00340 10 ADR-CITY PIC X(30). DTSBD540 00341 10 ADR-STATE PIC X(02). DTSBD540 00342 10 ADR-ZIP. DTSBD540 00343 15 ADR-ZIP-5 PIC X(05). DTSBD540 00344 15 ADR-ZIP-4 PIC X(04). DTSBD540 00345 EJECT DTSBD540 00346 01 PHONE-NUMBER-REFORMAT-AREA. DTSBD540 00347 05 PHONE-NUMBER-TYPE-IND PIC X(01). DTSBD540 00348 88 PHONE-NUMBER-VOICE-88 VALUE 'V'. DTSBD540 00349 88 PHONE-NUMBER-FAX-88 VALUE 'F'. DTSBD540 00350 DTSBD540 00351 05 PHONE-IN-AREA. DTSBD540 00352 10 PHONE-IN-AREA-CD PIC X(03). DTSBD540 00353 10 PHONE-IN-PREFIX PIC X(03). DTSBD540 00354 10 PHONE-IN-SUFFIX PIC X(04). DTSBD540 00355 10 PHONE-IN-EXT PIC X(05). DTSBD540 00356 DTSBD540 00357 05 PHONE-NUMBER-VALID-IND PIC X(01). DTSBD540 00358 88 PHONE-NUMBER-VALID-NO-88 VALUE 'N'. DTSBD540 00359 88 PHONE-NUMBER-VALID-YES-88 VALUE 'Y'. DTSBD540 00360 DTSBD540 00361 05 PHONE-OUT-PHONE-NUM. DTSBD540 00362 10 PHONE-OUT-AREA PIC 9(03). DTSBD540 00363 10 PHONE-OUT-PHONE PIC 9(07). DTSBD540 00364 DTSBD540 00365 05 PHONE-OUT-EXT PIC X(05). DTSBD540 00366 DTSBD540 00367 EJECT DTSBD540 00368 01 L001-LINK-AREA. DTSBD540 00369 ++INCLUDE DTSIL001 DTSBD540 00370 EJECT DTSBD540 00371 01 L004-LINK-AREA. DTSBD540 00372 ++INCLUDE DTSIL004 DTSBD540 00373 EJECT DTSBD540 00374 01 L005-LINK-AREA. DTSBD540 00375 ++INCLUDE DTSIL005 DTSBD540 00376 EJECT DTSBD540 00377 01 L006-LINK-AREA. DTSBD540 00378 ++INCLUDE DTSIL006 DTSBD540 00379 EJECT DTSBD540 00380 01 L064-LINK-AREA. DTSBD540 00381 ++INCLUDE DTSIL064 DTSBD540 00382 EJECT DTSBD540 00383 01 L910-LINK-AREA. DTSBD540 00384 ++INCLUDE DTSIL910 DTSBD540 00385 EJECT DTSBD540 00386 01 MSKL-REC. DTSBD540 00387 ++INCLUDE DTSIMSKL DTSBD540 00388 EJECT DTSBD540 00389 01 MHDR-REC. DTSBD540 00390 ++INCLUDE DTSIMHDR DTSBD540 00391 EJECT DTSBD540 00392 01 MPRF-REC. DTSBD540 00393 ++INCLUDE DTSIMPRF DTSBD540 00394 EJECT DTSBD540 00395 01 MREL-REC. DTSBD540 00396 ++INCLUDE DTSIMREL DTSBD540 00397 EJECT DTSBD540 00398 01 MQTR-REC. DTSBD540 00399 ++INCLUDE DTSIMQTR DTSBD540 00400 EJECT DTSBD540 00401 01 MJRN-REC. DTSBD540 00402 ++INCLUDE DTSIMJRN DTSBD540 00403 EJECT DTSBD540 00404 01 MRTE-REC. DTSBD540 00405 ++INCLUDE DTSIMRTE DTSBD540 00406 EJECT DTSBD540 00407 01 MSOL-REC. DTSBD540 00408 ++INCLUDE DTSIMSOL DTSBD540 00409 EJECT DTSBD540 00410 01 MTAD-REC. DTSBD540 00411 ++INCLUDE DTSIMTAD DTSBD540 00412 EJECT DTSBD540 00413 01 MLOG-REC. DTSBD540 00414 ++INCLUDE DTSIMLOG DTSBD540 00415 EJECT DTSBD540 00416 01 L921-LINK-AREA. DTSBD540 00417 ++INCLUDE DTSIL921 DTSBD540 00418 EJECT DTSBD540 00419 01 ISKL-REC. DTSBD540 00420 ++INCLUDE DTSIISKL DTSBD540 00421 EJECT DTSBD540 00422 01 IPES-REC. DTSBD540 00423 ++INCLUDE DTSIIPES DTSBD540 00424 EJECT DTSBD540 00425 01 R907-REC. DTSBD540 00426 ++INCLUDE DTSIR907 DTSBD540 00427 DTSBD540 00428 DTSBD540 00429 DTSBD540 00430 01 MSG-AREA. DTSBD540 00431 05 MSG01. DTSBD540 00432 10 MSG01-ID PIC X(03) VALUE '791'. DTSBD540 00433 10 MSG01-TEXT. DTSBD540 00434 15 FILLER PIC X(40) DTSBD540 00435 VALUE 'PHYSICAL LOCATION ADDRESS INFORMATION TR'. DTSBD540 00436 15 FILLER PIC X(40) DTSBD540 00437 VALUE 'UNCATED. '. DTSBD540 00438 15 FILLER PIC X(25) DTSBD540 00439 VALUE ' '. DTSBD540 00440 DTSBD540 00441 05 MSG02. DTSBD540 00442 10 MSG02-ID PIC X(03) VALUE '792'. DTSBD540 00443 10 MSG02-TEXT. DTSBD540 00444 15 FILLER PIC X(40) DTSBD540 00445 VALUE 'UI MAILING ADDRESS INFORMATION TRUNCATED'. DTSBD540 00446 15 FILLER PIC X(40) DTSBD540 00447 VALUE '. '. DTSBD540 00448 15 FILLER PIC X(25) DTSBD540 00449 VALUE ' '. DTSBD540 00450 DTSBD540 00451 05 MSG03. DTSBD540 00452 10 MSG03-ID PIC X(03) VALUE '793'. DTSBD540 00453 10 MSG03-TEXT. DTSBD540 00454 15 FILLER PIC X(40) DTSBD540 00455 VALUE 'UNEXPECTED MPRF-EMP-CLASS VALUE ENCOUNTE'. DTSBD540 00456 15 FILLER PIC X(40) DTSBD540 00457 VALUE 'RED. IMTQ-TYPE-COV DEFAULTED TO EXPERIE'. DTSBD540 00458 15 FILLER PIC X(25) DTSBD540 00459 VALUE 'NCE RATED. '. DTSBD540 00460 EJECT DTSBD540 00461 01 C072-LITERALS. DTSBD540 00462 ++INCLUDE DTSIC072 DTSBD540 00463 EJECT DTSBD540 00464 01 CNTR-INFORMATION-AREA. DTSBD540 00465 05 CNTR-EOF-IND PIC X(01). DTSBD540 00466 88 CNTR-EOF-NO-88 VALUE 'N'. DTSBD540 00467 88 CNTR-EOF-YES-88 VALUE 'Y'. DTSBD540 00468 DTSBD540 00469 DTSBD540 00470 05 CNTR-YRQ-IND-AREA. DTSBD540 00471 10 CNTR-YRQ-IND DTSBD540 00472 OCCURS 400 TIMES PIC X(01). DTSBD540 00473 88 CNTR-YRQ-NO-88 VALUE 'N'. DTSBD540 00474 88 CNTR-YRQ-YES-88 VALUE 'Y'. DTSBD540 00475 DTSBD540 00476 DTSBD540 00477 05 CNTR-TABLE-MAX PIC S9(04) COMP VALUE +500.DTSBD540 00478 DTSBD540 00479 05 CNTR-TABLE-CNT PIC S9(04) COMP. DTSBD540 00480 DTSBD540 00481 05 CNTR-TABLE-REC DTSBD540 00482 OCCURS 500 TIMES DTSBD540 00483 INDEXED BY CNTR-TABLE-REC-IDX DTSBD540 00484 PIC X(80). DTSBD540 00485 EJECT DTSBD540 00486 PROCEDURE DIVISION. DTSBD540 00487 DTSBD540 00488 DTSBD540 00489 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBD540 00490 DTSBD540 00491 DTSBD540 00492 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD540 00493 DTSBD540 00494 MOVE +0 TO MSKL-EMP-NO. DTSBD540 00495 DTSBD540 00496 SET MSKL-PRF-88 TO TRUE. DTSBD540 00497 DTSBD540 00498 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD540 00499 DTSBD540 00500 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD540 00501 UNTIL L910-NO-REC-88. DTSBD540 00502 DTSBD540 00503 DTSBD540 00504 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD540 00505 DTSBD540 00506 DTSBD540 00507 GOBACK. DTSBD540 00508 EJECT DTSBD540 00509 I0000-INITIALIZE. DTSBD540 00510 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD540 00511 DTSBD540 00512 DTSBD540 00513 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD540 00514 DTSBD540 00515 DTSBD540 00516 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD540 00517 DTSBD540 00518 MOVE '907' TO R907-REC-TYPE. DTSBD540 00519 DTSBD540 00520 MOVE WRK-MODULE-NAME TO R907-MODULE-NAME. DTSBD540 00521 DTSBD540 00522 DTSBD540 00523 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD540 00524 DTSBD540 00525 MOVE +0 TO MSKL-EMP-NO. DTSBD540 00526 DTSBD540 00527 SET MSKL-HDR-88 TO TRUE. DTSBD540 00528 DTSBD540 00529 PERFORM S910-READ THRU S910-EXIT. DTSBD540 00530 DTSBD540 00531 IF L910-NO-REC-88 DTSBD540 00532 MOVE 'MHDR RECORD NOT FOUND' DTSBD540 00533 TO WRK-ABEND-MSG DTSBD540 00534 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00535 DTSBD540 00536 MOVE MSKL-REC TO MHDR-REC. DTSBD540 00537 DTSBD540 00538 MOVE MHDR-PRIOR-RUN-DATE TO WRK-EXT-CURRENT-DATE. DTSBD540 00539 DTSBD540 00540 OPEN OUTPUT ES202PRM-FILE. DTSBD540 00541 DTSBD540 00542 MOVE +0 TO WRK-EXT-YRQ (1) DTSBD540 00543 WRK-EXT-YRQ (2). DTSBD540 00544 DTSBD540 00545 MOVE SPACE TO WRK-EXT-TYPE (1) DTSBD540 00546 WRK-EXT-TYPE (2). DTSBD540 00547 DTSBD540 00548 MOVE +0 TO WRK-EXT-INITIAL-DATE (1) DTSBD540 00549 WRK-EXT-INITIAL-DATE (2) DTSBD540 00550 WRK-EXT-MOST-RECENT-DATE (1) DTSBD540 00551 WRK-EXT-MOST-RECENT-DATE (2) DTSBD540 00552 WRK-GLOBAL-LAST-INITIAL-DATE. DTSBD540 00553 DTSBD540 00554 OPEN INPUT SYSIN-FILE. DTSBD540 00555 DTSBD540 00556 MOVE +0 TO SYSIN-REC-CNT. DTSBD540 00557 DTSBD540 00558 SET SYSIN-EOF-NO-88 TO TRUE. DTSBD540 00559 DTSBD540 00560 PERFORM I1000-READ-PROCESS-SYSIN THRU I1000-EXIT DTSBD540 00561 UNTIL SYSIN-EOF-YES-88. DTSBD540 00562 DTSBD540 00563 MOVE +0 TO YRQ-SUB. DTSBD540 00564 DTSBD540 00565 CLOSE SYSIN-FILE. DTSBD540 00566 DTSBD540 00567 IF SYSIN-REC-CNT = +0 DTSBD540 00568 MOVE 'NO SYSIN PARAMETER YRQ RECORD FOUND' DTSBD540 00569 TO WRK-ABEND-MSG DTSBD540 00570 PERFORM S999-ABEND THRU S999-EXIT DTSBD540 00571 ELSE DTSBD540 00572 IF SYSIN-REC-CNT = +1 DTSBD540 00573 NEXT SENTENCE DTSBD540 00574 ELSE DTSBD540 00575 MOVE 'MORE THAN ONE SYSIN PARAMETER RECORD FOUND' DTSBD540 00576 TO WRK-ABEND-MSG DTSBD540 00577 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00578 DTSBD540 00579 DTSBD540 00580 OPEN INPUT CNTR-FILE. DTSBD540 00581 DTSBD540 00582 SET CNTR-EOF-NO-88 TO TRUE. DTSBD540 00583 DTSBD540 00584 MOVE ALL 'N' TO CNTR-YRQ-IND-AREA. DTSBD540 00585 DTSBD540 00586 DISPLAY ' '. DTSBD540 00587 DTSBD540 00588 DISPLAY ' '. DTSBD540 00589 DTSBD540 00590 MOVE +0 TO CNTR-TABLE-CNT. DTSBD540 00591 DTSBD540 00592 PERFORM I2000-READ-TABLE-CNTR THRU I2000-EXIT DTSBD540 00593 UNTIL CNTR-EOF-YES-88. DTSBD540 00594 DTSBD540 00595 CLOSE CNTR-FILE. DTSBD540 00596 * DTSBD540 00597 MOVE +0 TO YRQ-SUB. DTSBD540 00598 * DTSBD540 00599 PERFORM I3000-SYSIN-CNTR-CROSS-EDITS THRU I3000-EXIT VARYING DTSBD540 00600 YRQ-SUB FROM 1 BY 1 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 00601 DTSBD540 00602 OPEN OUTPUT ES202IMT-FILE. DTSBD540 00603 DTSBD540 00604 MOVE +0 TO ES202IMT-REC-CNT DTSBD540 00605 PRF-REC-CNT. DTSBD540 00606 DTSBD540 00607 PERFORM I4000-WRITE-WRITE-ES202-PARM THRU I4000-EXIT. DTSBD540 00608 DTSBD540 00609 I0000-EXIT. DTSBD540 00610 EXIT. DTSBD540 00611 EJECT DTSBD540 00612 I1000-READ-PROCESS-SYSIN. DTSBD540 00613 READ SYSIN-FILE DTSBD540 00614 AT END DTSBD540 00615 SET SYSIN-EOF-YES-88 TO TRUE DTSBD540 00616 GO TO I1000-EXIT. DTSBD540 00617 DTSBD540 00618 DISPLAY ' '. DTSBD540 00619 DTSBD540 00620 DISPLAY '*** ' DTSBD540 00621 WRK-MODULE-NAME DTSBD540 00622 ' SYSIN PARAMETER RECORD: ' DTSBD540 00623 SYSIN-REC. DTSBD540 00624 DTSBD540 00625 IF SYSIN-RECORD-COMMENT-88 DTSBD540 00626 GO TO I1000-EXIT. DTSBD540 00627 DTSBD540 00628 IF SYSIN-RECORD-YRQ-88 DTSBD540 00629 NEXT SENTENCE DTSBD540 00630 ELSE DTSBD540 00631 MOVE 'INVALID SYSIN-RECORD-TYPE VALUE ENCOUNTERED' DTSBD540 00632 TO WRK-ABEND-MSG DTSBD540 00633 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00634 DTSBD540 00635 ADD +1 TO SYSIN-REC-CNT. DTSBD540 00636 DTSBD540 00637 MOVE SYSIN-EXT-YRQ TO L004-QTR-3-X. DTSBD540 00638 DTSBD540 00639 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD540 00640 DTSBD540 00641 PERFORM I1100-EDIT-EXT-YRQ THRU I1100-EXIT. DTSBD540 00642 DTSBD540 00643 IF (SYSIN-EXT-INITIAL-88) DTSBD540 00644 OR DTSBD540 00645 (SYSIN-EXT-REVISED-88) DTSBD540 00646 MOVE SYSIN-EXT-TYPE TO WRK-EXT-TYPE (1) DTSBD540 00647 ELSE DTSBD540 00648 MOVE 'INVALID SYSIN-EXT-TYPE VALUE ENCOUNTERED' DTSBD540 00649 TO WRK-ABEND-MSG DTSBD540 00650 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00651 DTSBD540 00652 MOVE L004-QTR-5-9 TO WRK-EXT-YRQ (1). DTSBD540 00653 MOVE L004-ABS-QTR TO WRK-EXT-ABS-QTR (1). DTSBD540 00654 DTSBD540 00655 SUBTRACT 1 FROM L004-ABS-QTR GIVING L004-ABS-QTR. DTSBD540 00656 DTSBD540 00657 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD540 00658 DTSBD540 00659 PERFORM I1100-EDIT-EXT-YRQ THRU I1100-EXIT. DTSBD540 00660 DTSBD540 00661 MOVE L004-QTR-5-9 TO WRK-EXT-YRQ (2). DTSBD540 00662 MOVE L004-ABS-QTR TO WRK-EXT-ABS-QTR (2). DTSBD540 00663 SET WRK-EXT-REVISED-88 (2) TO TRUE. DTSBD540 00664 DTSBD540 00665 I1000-EXIT. DTSBD540 00666 EXIT. DTSBD540 00667 EJECT DTSBD540 00668 I1100-EDIT-EXT-YRQ. DTSBD540 00669 IF L004-INVALID-QTR DTSBD540 00670 MOVE 'INVALID SYSIN-EXT-YRQ VALUE ENCOUNTERED' DTSBD540 00671 TO WRK-ABEND-MSG DTSBD540 00672 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00673 DTSBD540 00674 * IF L004-QTR-5-9 > MHDR-LAST-UC30-MASS-MAIL-YRQ CL**2 00675 * MOVE CL**2 00676 * 'SYSIN-EXT-YRQ > MHDR-LAST-UC30-DEL-MAIL-YRQ: TOO EARLY' CL**2 00677 * TO WRK-ABEND-MSG CL**2 00678 * PERFORM S999-ABEND THRU S999-EXIT. CL**2 00679 DTSBD540 00680 IF (L004-QTR-5-9 < MHDR-FIRST-PURSUED-RPT-YRQ) DTSBD540 00681 MOVE DTSBD540 00682 'SYSIN-EXT-YRQ < MHDR-FIRST-PURSUED-RPT-YRQ: TOO LATE' DTSBD540 00683 TO WRK-ABEND-MSG DTSBD540 00684 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00685 DTSBD540 00686 DTSBD540 00687 I1100-EXIT. DTSBD540 00688 EXIT. DTSBD540 00689 DTSBD540 00690 I2000-READ-TABLE-CNTR. DTSBD540 00691 READ CNTR-FILE DTSBD540 00692 AT END DTSBD540 00693 SET CNTR-EOF-YES-88 TO TRUE DTSBD540 00694 GO TO I2000-EXIT. DTSBD540 00695 DTSBD540 00696 DISPLAY ' '. DTSBD540 00697 DTSBD540 00698 DISPLAY '*** ' DTSBD540 00699 WRK-MODULE-NAME DTSBD540 00700 ' CONTROL RECORD: ' DTSBD540 00701 CNTR-REC. DTSBD540 00702 DTSBD540 00703 IF CNTR-TABLE-CNT < CNTR-TABLE-MAX DTSBD540 00704 NEXT SENTENCE DTSBD540 00705 ELSE DTSBD540 00706 MOVE 'TOO MANY CNTRFILE RECORDS INPUT' DTSBD540 00707 TO WRK-ABEND-MSG DTSBD540 00708 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00709 DTSBD540 00710 ADD +1 TO CNTR-TABLE-CNT. DTSBD540 00711 DTSBD540 00712 MOVE CNTR-REC TO CNTR-TABLE-REC (CNTR-TABLE-CNT). DTSBD540 00713 DTSBD540 00714 IF CNTR-RECORD-COMMENT-88 DTSBD540 00715 GO TO I2000-EXIT. DTSBD540 00716 DTSBD540 00717 IF CNTR-RECORD-YRQ-88 DTSBD540 00718 NEXT SENTENCE DTSBD540 00719 ELSE DTSBD540 00720 MOVE 'INVALID CNTR-RECORD-TYPE VALUE ENCOUNTERED' DTSBD540 00721 TO WRK-ABEND-MSG DTSBD540 00722 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00723 DTSBD540 00724 MOVE CNTR-YRQ TO L004-QTR-5-X. DTSBD540 00725 DTSBD540 00726 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD540 00727 DTSBD540 00728 IF L004-INVALID-QTR DTSBD540 00729 MOVE 'INVALID CNTR-YRQ VALUE ENCOUNTERED' DTSBD540 00730 TO WRK-ABEND-MSG DTSBD540 00731 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00732 DTSBD540 00733 IF (L004-ABS-QTR < +1) DTSBD540 00734 OR DTSBD540 00735 (L004-ABS-QTR > +400) DTSBD540 00736 MOVE 'UNEXPECTED L004-ABS-QTR VALUE ENCOUNTERED' DTSBD540 00737 TO WRK-ABEND-MSG DTSBD540 00738 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00739 DTSBD540 00740 MOVE L004-ABS-QTR TO WRK-CNTR-ABS-QTR. DTSBD540 00741 DTSBD540 00742 IF CNTR-YRQ-YES-88 (L004-ABS-QTR) DTSBD540 00743 MOVE 'DUPLICATE (FOR CNTR-YRQ) CNTR RECORD FOUND' DTSBD540 00744 TO WRK-ABEND-MSG DTSBD540 00745 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00746 DTSBD540 00747 SET CNTR-YRQ-YES-88 (L004-ABS-QTR) TO TRUE. DTSBD540 00748 DTSBD540 00749 IF CNTR-EXT-INITIAL-DATE = SPACES DTSBD540 00750 MOVE 'CNTR-EXT-INITIAL-DATE = SPACES ENCOUNTERED' DTSBD540 00751 TO WRK-ABEND-MSG DTSBD540 00752 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00753 DTSBD540 00754 MOVE CNTR-EXT-INITIAL-DATE TO L001-FED-8-DATE-X. DTSBD540 00755 DTSBD540 00756 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD540 00757 DTSBD540 00758 IF L001-INVALID-DATE DTSBD540 00759 MOVE 'INVALID CNTR-EXT-INITIAL-DATE ENCOUNTERED' DTSBD540 00760 TO WRK-ABEND-MSG DTSBD540 00761 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00762 DTSBD540 00763 IF L001-FED-8-DATE-9 > WRK-GLOBAL-LAST-INITIAL-DATE DTSBD540 00764 MOVE L001-FED-8-DATE-9 TO WRK-GLOBAL-LAST-INITIAL-DATE. DTSBD540 00765 ** PERFORM I2051-LOAD-INITIAL-DATE THRU I2051-EXIT VARYING DTSBD540 00766 ** YRQ-SUB FROM 1 BY 1 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 00767 DTSBD540 00768 IF CNTR-EXT-MOST-RECENT-DATE = SPACE DTSBD540 00769 MOVE 'CNTR-EXT-MOST-RECENT-DATE = SPACES' DTSBD540 00770 TO WRK-ABEND-MSG DTSBD540 00771 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00772 DTSBD540 00773 MOVE CNTR-EXT-MOST-RECENT-DATE TO L001-FED-8-DATE-X. DTSBD540 00774 DTSBD540 00775 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD540 00776 DTSBD540 00777 IF L001-INVALID-DATE DTSBD540 00778 MOVE 'INVALID CNTR-EXT-MOST-RECENT-DATE ENCOUNTERED' DTSBD540 00779 TO WRK-ABEND-MSG DTSBD540 00780 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00781 DTSBD540 00782 IF CNTR-EXT-MOST-RECENT-DATE < CNTR-EXT-INITIAL-DATE DTSBD540 00783 MOVE 'CNTR-EXT-MOST-RECENT-DATE < CNTR-EXT-INITIAL-DATE' DTSBD540 00784 TO WRK-ABEND-MSG DTSBD540 00785 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00786 DTSBD540 00787 PERFORM I2100-LOAD-DATES THRU I2100-EXIT VARYING DTSBD540 00788 YRQ-SUB FROM 1 BY 1 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 00789 DTSBD540 00790 * PERFORM I2052-LOAD-MOST-RECENT-DATE THRU I2052-EXIT VARYING DTSBD540 00791 * YRQ-SUB FROM 1 BY 1 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 00792 * PERFORM I2050-LOAD-WRK-CNTR-REC THRU I2050-EXIT VARYING DTSBD540 00793 * YRQ-SUB FROM 1 BY 1 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 00794 DTSBD540 00795 MOVE +0 TO YRQ-SUB. DTSBD540 00796 DTSBD540 00797 I2000-EXIT. DTSBD540 00798 EXIT. DTSBD540 00799 DTSBD540 00800 I2100-LOAD-DATES. DTSBD540 00801 IF WRK-CNTR-ABS-QTR = WRK-EXT-ABS-QTR (YRQ-SUB) DTSBD540 00802 IF WRK-EXT-INITIAL-DATE (YRQ-SUB) = +0 DTSBD540 00803 MOVE CNTR-EXT-INITIAL-DATE-9 TO DTSBD540 00804 WRK-EXT-INITIAL-DATE (YRQ-SUB) DTSBD540 00805 END-IF DTSBD540 00806 IF WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) = +0 DTSBD540 00807 MOVE CNTR-EXT-MOST-RECENT-DATE-9 TO DTSBD540 00808 WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) DTSBD540 00809 END-IF DTSBD540 00810 END-IF. DTSBD540 00811 *& DTSBD540 00812 DISPLAY 'I2100 MOST RECENT DATE ' DTSBD540 00813 WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) ' ' YRQ-SUB. DTSBD540 00814 I2100-EXIT. DTSBD540 00815 EXIT. DTSBD540 00816 DTSBD540 00817 *I2050-LOAD-WRK-CNTR-REC. DTSBD540 00818 * IF WRK-EXT-YRQ (YRQ-SUB) = CNTR-YRQ-9 DTSBD540 00819 * PERFORM I2300-LOAD-WRK-CNTR-REC THRU I2300-EXIT. DTSBD540 00820 * DTSBD540 00821 *I2050-EXIT. DTSBD540 00822 * EXIT. DTSBD540 00823 DTSBD540 00824 *I2051-LOAD-INITIAL-DATE. DTSBD540 00825 * DTSBD540 00826 * IF WRK-EXT-YRQ (YRQ-SUB) = L004-QTR-5-9 DTSBD540 00827 * PERFORM I2100-EXT-INITIAL-DATE THRU I2100-EXIT. DTSBD540 00828 * DTSBD540 00829 *I2051-EXIT. DTSBD540 00830 * EXIT. DTSBD540 00831 DTSBD540 00832 *I2052-LOAD-MOST-RECENT-DATE. DTSBD540 00833 * DTSBD540 00834 * IF WRK-EXT-YRQ (YRQ-SUB) = L004-QTR-5-9 DTSBD540 00835 * PERFORM I2200-EXT-MOST-RECENT-DATE THRU I2200-EXIT. DTSBD540 00836 * DTSBD540 00837 *I2052-EXIT. DTSBD540 00838 * EXIT. DTSBD540 00839 DTSBD540 00840 *I2100-EXT-INITIAL-DATE. DTSBD540 00841 * IF WRK-EXT-INITIAL-DATE (YRQ-SUB) = +0 DTSBD540 00842 * MOVE CNTR-EXT-INITIAL-DATE-9 TO DTSBD540 00843 * WRK-EXT-INITIAL-DATE (YRQ-SUB). DTSBD540 00844 *I2100-EXIT. DTSBD540 00845 * EXIT. DTSBD540 00846 DTSBD540 00847 *I2200-EXT-MOST-RECENT-DATE. DTSBD540 00848 * IF WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) = +0 DTSBD540 00849 * MOVE CNTR-EXT-MOST-RECENT-DATE-9 TO DTSBD540 00850 * WRK-EXT-MOST-RECENT-DATE (YRQ-SUB). DTSBD540 00851 *I2200-EXIT. DTSBD540 00852 * EXIT. DTSBD540 00853 * DTSBD540 00854 *I2300-LOAD-WRK-CNTR-REC. DTSBD540 00855 * IF WRK-CNTR-REC (YRQ-SUB) = +0 DTSBD540 00856 * MOVE CNTR-REC TO WRK-CNTR-REC (YRQ-SUB). DTSBD540 00857 * SET CNTR-REC-YES-LOAD-88 TO TRUE. DTSBD540 00858 *I2300-EXIT. DTSBD540 00859 * EXIT. DTSBD540 00860 DTSBD540 00861 EJECT DTSBD540 00862 I3000-SYSIN-CNTR-CROSS-EDITS. DTSBD540 00863 MOVE WRK-EXT-YRQ (YRQ-SUB) TO L004-QTR-5-9. DTSBD540 00864 DTSBD540 00865 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD540 00866 DTSBD540 00867 IF L004-INVALID-QTR DTSBD540 00868 MOVE 'I3000: UNEXPECTED L004-INVALID-QTR ENCOUNTERED' DTSBD540 00869 TO WRK-ABEND-MSG DTSBD540 00870 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00871 DTSBD540 00872 IF (L004-ABS-QTR < +1) DTSBD540 00873 OR DTSBD540 00874 (L004-ABS-QTR > +400) DTSBD540 00875 MOVE 'I3000: UNEXPECTED L004-ABS-QTR VALUE ENCOUNTERED' DTSBD540 00876 TO WRK-ABEND-MSG DTSBD540 00877 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00878 DTSBD540 00879 IF CNTR-YRQ-YES-88 (L004-ABS-QTR) DTSBD540 00880 PERFORM I3100-CNTR-EXISTS-EDITS THRU I3100-EXIT DTSBD540 00881 ELSE DTSBD540 00882 PERFORM I3200-NO-CNTR-EXISTS-EDITS THRU I3200-EXIT. DTSBD540 00883 I3000-EXIT. DTSBD540 00884 EXIT. DTSBD540 00885 DTSBD540 00886 DTSBD540 00887 DTSBD540 00888 I3100-CNTR-EXISTS-EDITS. DTSBD540 00889 IF WRK-EXT-INITIAL-88 (YRQ-SUB) DTSBD540 00890 MOVE DTSBD540 00891 'SECOND INITIAL EXTRACT FOR SYSIN-EXT-YRQ REQUESTED' DTSBD540 00892 TO WRK-ABEND-MSG DTSBD540 00893 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00894 DTSBD540 00895 IF WRK-EXT-CURRENT-DATE <= WRK-EXT-MOST-RECENT-DATE (YRQ-SUB)DTSBD540 00896 *& DTSBD540 00897 DISPLAY 'I3100 ABEND ' DTSBD540 00898 ' MOST RECENT ' WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) DTSBD540 00899 ' ' YRQ-SUB DTSBD540 00900 ' CURRENT ' WRK-EXT-CURRENT-DATE DTSBD540 00901 MOVE 'WRK-EXT-CURRENT-DATE <= WRK-EXT-MOST-RECENT-DATE' DTSBD540 00902 TO WRK-ABEND-MSG DTSBD540 00903 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00904 I3100-EXIT. DTSBD540 00905 EXIT. DTSBD540 00906 DTSBD540 00907 DTSBD540 00908 DTSBD540 00909 I3200-NO-CNTR-EXISTS-EDITS. DTSBD540 00910 IF WRK-EXT-REVISED-88 (YRQ-SUB) DTSBD540 00911 MOVE DTSBD540 00912 'SYSIN-EXT-YRQ REVISED REQUESTED, BUT NO INITIAL DETECTED' DTSBD540 00913 TO WRK-ABEND-MSG DTSBD540 00914 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 00915 I3200-EXIT. DTSBD540 00916 EXIT. DTSBD540 00917 DTSBD540 00918 I4000-WRITE-WRITE-ES202-PARM. DTSBD540 00919 DTSBD540 00920 MOVE WRK-EXT-YRQ (1) TO ES202-PARM-YRQ1. DTSBD540 00921 MOVE WRK-EXT-YRQ (2) TO ES202-PARM-YRQ2. DTSBD540 00922 DISPLAY SPACE. DTSBD540 00923 DISPLAY '****************************'. DTSBD540 00924 DISPLAY 'I4000 YRQ1 ' ES202-PARM-YRQ1 DTSBD540 00925 ' YRQ2 ' ES202-PARM-YRQ2. DTSBD540 00926 DISPLAY SPACE. DTSBD540 00927 DTSBD540 00928 WRITE ES202-PARM-REC. DTSBD540 00929 DTSBD540 00930 I4000-EXIT. DTSBD540 00931 EXIT. DTSBD540 00932 DTSBD540 00933 EJECT DTSBD540 00934 P0000-PROCESS. DTSBD540 00935 MOVE MSKL-REC TO MPRF-REC. DTSBD540 00936 DTSBD540 00937 ADD +1 TO PRF-REC-CNT. DTSBD540 00938 DTSBD540 00939 DTSBD540 00940 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBD540 00941 DTSBD540 00942 DTSBD540 00943 PERFORM P1000-PROCESS-EMPLOYER THRU P1000-EXIT. DTSBD540 00944 DTSBD540 00945 DTSBD540 00946 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD540 00947 DTSBD540 00948 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD540 00949 P0000-EXIT. DTSBD540 00950 EXIT. DTSBD540 00951 EJECT DTSBD540 00952 P1000-PROCESS-EMPLOYER. DTSBD540 00953 *****IF PRF-REC-CNT > +1000 DTSBD540 00954 *********GO TO P1000-EXIT. DTSBD540 00955 DTSBD540 00956 DTSBD540 00957 IF MPRF-CLASS-SUB-88 DTSBD540 00958 NEXT SENTENCE DTSBD540 00959 ELSE DTSBD540 00960 GO TO P1000-EXIT. DTSBD540 00961 DTSBD540 00962 DTSBD540 00963 MOVE +0 TO WRK-INIT-ESTB-DATE DTSBD540 00964 WRK-INIT-LIAB-DATE DTSBD540 00965 WRK-INIT-INACT-DATE DTSBD540 00966 WRK-MOST-RECENT-LIAB-DATE. DTSBD540 00967 DTSBD540 00968 SET WRK-ACTIVE-IN-EXT-YRQ-NO-88 TO TRUE. DTSBD540 00969 DTSBD540 00970 PERFORM P2000-EVALUATE-LIABILITY THRU P2000-EXIT. DTSBD540 00971 DTSBD540 00972 DTSBD540 00973 MOVE ZERO TO WRK-PRED-ACCT DTSBD540 00974 WRK-SUCC-ACCT DTSBD540 00975 WRK-SUCC-EFF-DATE. DTSBD540 00976 DTSBD540 00977 PERFORM P3000-FIND-PRED-SUCC THRU P3000-EXIT. DTSBD540 00978 DTSBD540 00979 DTSBD540 00980 SET WRK-EMP-LEVEL-MOD-NO-88 TO TRUE. DTSBD540 00981 DTSBD540 00982 IF WRK-EXT-INITIAL-88 (YRQ-SUB) DTSBD540 00983 PERFORM P4000-EVALUATE-EMP-LEVEL-MOD THRU P4000-EXIT. DTSBD540 00984 DTSBD540 00985 DTSBD540 00986 IF WRK-GLOBAL-LAST-INITIAL-DATE = +0 DTSBD540 00987 SET WRK-EMP-LEVEL-MOD-YES-88 TO TRUE. DTSBD540 00988 DTSBD540 00989 DTSBD540 00990 SET WRK-QTR-LEVEL-MOD-NO-88 TO TRUE. DTSBD540 00991 DTSBD540 00992 * IF WRK-EXT-REVISED-88 (YRQ-SUB) DTSBD540 00993 PERFORM P5000-EVALUATE-QTR-LEVEL-MOD THRU P5000-EXIT VARYING DTSBD540 00994 YRQ-SUB FROM 1 BY 1 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 00995 DTSBD540 00996 DTSBD540 00997 IF (WRK-EMP-LEVEL-MOD-YES-88) DTSBD540 00998 OR DTSBD540 00999 (WRK-QTR-LEVEL-MOD-YES-88) DTSBD540 01000 OR DTSBD540 01001 ((WRK-EXT-INITIAL-88 (1)) DTSBD540 01002 AND DTSBD540 01003 (WRK-ACTIVE-IN-EXT-YRQ-YES-88)) DTSBD540 01004 NEXT SENTENCE DTSBD540 01005 ELSE DTSBD540 01006 GO TO P1000-EXIT. DTSBD540 01007 DTSBD540 01008 DTSBD540 01009 MOVE LOW-VALUES TO ES202-IMT-REC. DTSBD540 01010 *& INITIALIZE ES202-IMT-REC. DTSBD540 01011 DTSBD540 01012 MOVE MPRF-EMP-NO TO IMT-ACCT. DTSBD540 01013 DTSBD540 01014 MOVE ZERO TO IMT-RPT-UNIT DTSBD540 01015 IMT-CK-DIGIT. DTSBD540 01016 DTSBD540 01017 PERFORM P8000-CONSTRUCT-EMP-LEVEL THRU P8000-EXIT. DTSBD540 01018 DTSBD540 01019 PERFORM P9000-CONSTRUCT-QTR-LEVEL THRU P9000-EXIT VARYING DTSBD540 01020 YRQ-SUB FROM 1 BY 1 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 01021 DTSBD540 01022 WRITE ES202-IMT-REC. DTSBD540 01023 DTSBD540 01024 ADD +1 TO ES202IMT-REC-CNT. DTSBD540 01025 P1000-EXIT. DTSBD540 01026 EXIT. DTSBD540 01027 EJECT DTSBD540 01028 P2000-EVALUATE-LIABILITY. DTSBD540 01029 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD540 01030 DTSBD540 01031 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD540 01032 DTSBD540 01033 SET MSKL-SOL-88 TO TRUE. DTSBD540 01034 DTSBD540 01035 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD540 01036 DTSBD540 01037 PERFORM DTSBD540 01038 UNTIL L910-NO-REC-88 DTSBD540 01039 MOVE MSKL-REC TO MSOL-REC DTSBD540 01040 PERFORM P2100-EVALUATE-MSOL THRU P2100-EXIT VARYING DTSBD540 01041 YRQ-SUB FROM 1 BY 1 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX DTSBD540 01042 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD540 01043 END-PERFORM. DTSBD540 01044 P2000-EXIT. DTSBD540 01045 EXIT. DTSBD540 01046 DTSBD540 01047 DTSBD540 01048 DTSBD540 01049 P2100-EVALUATE-MSOL. DTSBD540 01050 IF MSOL-INACT-WITHDRAWN-88 DTSBD540 01051 GO TO P2100-EXIT. DTSBD540 01052 DTSBD540 01053 DTSBD540 01054 IF WRK-INIT-LIAB-DATE = ZERO DTSBD540 01055 IF MSOL-NOT-CONVERTED-88 DTSBD540 01056 MOVE MSOL-ESTB-DATE TO WRK-INIT-ESTB-DATE DTSBD540 01057 END-IF DTSBD540 01058 MOVE MSOL-LIAB-DATE TO WRK-INIT-LIAB-DATE DTSBD540 01059 MOVE MSOL-INACT-DATE TO WRK-INIT-INACT-DATE. DTSBD540 01060 DTSBD540 01061 MOVE MSOL-LIAB-DATE TO WRK-MOST-RECENT-LIAB-DATE. DTSBD540 01062 DTSBD540 01063 IF (WRK-EXT-YRQ (YRQ-SUB) < MSOL-FIRST-LIAB-YRQ) DTSBD540 01064 OR DTSBD540 01065 (WRK-EXT-YRQ (YRQ-SUB) > MSOL-LAST-LIAB-YRQ) DTSBD540 01066 NEXT SENTENCE DTSBD540 01067 ELSE DTSBD540 01068 SET WRK-ACTIVE-IN-EXT-YRQ-YES-88 TO TRUE. DTSBD540 01069 P2100-EXIT. DTSBD540 01070 EXIT. DTSBD540 01071 EJECT DTSBD540 01072 P3000-FIND-PRED-SUCC. DTSBD540 01073 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD540 01074 DTSBD540 01075 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD540 01076 DTSBD540 01077 SET MSKL-REL-88 TO TRUE. DTSBD540 01078 DTSBD540 01079 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD540 01080 DTSBD540 01081 PERFORM DTSBD540 01082 UNTIL L910-NO-REC-88 DTSBD540 01083 MOVE MSKL-REC TO MREL-REC DTSBD540 01084 MOVE MREL-PRED-EMP-NO TO WRK-PRED-ACCT DTSBD540 01085 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD540 01086 END-PERFORM. DTSBD540 01087 DTSBD540 01088 DTSBD540 01089 MOVE LOW-VALUES TO IPES-KEY-AREA. DTSBD540 01090 DTSBD540 01091 SET IPES-PES-88 TO TRUE. DTSBD540 01092 DTSBD540 01093 MOVE MPRF-EMP-NO TO IPES-PRED-EMP-NO. DTSBD540 01094 DTSBD540 01095 MOVE IPES-KEY-AREA TO ISKL-KEY-AREA. DTSBD540 01096 DTSBD540 01097 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBD540 01098 DTSBD540 01099 PERFORM P3100-IPES-SCAN THRU P3100-EXIT DTSBD540 01100 UNTIL L921-NO-REC-88. DTSBD540 01101 P3000-EXIT. DTSBD540 01102 EXIT. DTSBD540 01103 DTSBD540 01104 DTSBD540 01105 DTSBD540 01106 P3100-IPES-SCAN. DTSBD540 01107 MOVE ISKL-REC TO IPES-REC. DTSBD540 01108 DTSBD540 01109 IF MPRF-EMP-NO NOT = IPES-PRED-EMP-NO DTSBD540 01110 SET L921-NO-REC-88 TO TRUE DTSBD540 01111 GO TO P3100-EXIT. DTSBD540 01112 DTSBD540 01113 MOVE IPES-SUC-EMP-NO TO WRK-SUCC-ACCT. DTSBD540 01114 DTSBD540 01115 MOVE IPES-EFF-DATE TO WRK-SUCC-EFF-DATE. DTSBD540 01116 DTSBD540 01117 PERFORM S921-READ-NEXT THRU S921-EXIT. DTSBD540 01118 P3100-EXIT. DTSBD540 01119 EXIT. DTSBD540 01120 EJECT DTSBD540 01121 P4000-EVALUATE-EMP-LEVEL-MOD. DTSBD540 01122 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD540 01123 DTSBD540 01124 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD540 01125 DTSBD540 01126 SET MSKL-LOG-88 TO TRUE. DTSBD540 01127 DTSBD540 01128 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD540 01129 DTSBD540 01130 PERFORM DTSBD540 01131 UNTIL L910-NO-REC-88 DTSBD540 01132 MOVE MSKL-REC TO MLOG-REC DTSBD540 01133 IF MLOG-ESTB-DATE > WRK-GLOBAL-LAST-INITIAL-DATE DTSBD540 01134 PERFORM P4100-CHECK-MLOG THRU P4100-EXIT DTSBD540 01135 END-IF DTSBD540 01136 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD540 01137 END-PERFORM. DTSBD540 01138 DTSBD540 01139 IF WRK-SUCC-ACCT > ZERO DTSBD540 01140 PERFORM P4200-EVALUATE-SUCC-MOD THRU P4200-EXIT. DTSBD540 01141 P4000-EXIT. DTSBD540 01142 EXIT. DTSBD540 01143 DTSBD540 01144 DTSBD540 01145 DTSBD540 01146 P4100-CHECK-MLOG. DTSBD540 01147 IF MLOG-DE-REC-TYPE = 'MPRF' DTSBD540 01148 PERFORM P4110-CHECK-MPRF THRU P4110-EXIT DTSBD540 01149 ELSE DTSBD540 01150 IF MLOG-DE-REC-TYPE = 'MTAD' DTSBD540 01151 PERFORM P4120-CHECK-MTAD THRU P4120-EXIT DTSBD540 01152 ELSE DTSBD540 01153 IF MLOG-DE-REC-TYPE = 'MSOL' DTSBD540 01154 PERFORM P4130-CHECK-MSOL THRU P4130-EXIT DTSBD540 01155 ELSE DTSBD540 01156 IF MLOG-DE-REC-TYPE = 'MREL' DTSBD540 01157 PERFORM P4140-CHECK-MREL THRU P4140-EXIT. DTSBD540 01158 P4100-EXIT. DTSBD540 01159 EXIT. DTSBD540 01160 DTSBD540 01161 DTSBD540 01162 DTSBD540 01163 P4110-CHECK-MPRF. DTSBD540 01164 IF MLOG-DATA-ELEMENT-NAME DTSBD540 01165 = 'MPRF-PRIMARY-NAME' DTSBD540 01166 OR DTSBD540 01167 'MPRF-ENTITY-NAME-IND' DTSBD540 01168 OR DTSBD540 01169 'MPRF-ENTITY-NAME' DTSBD540 01170 OR DTSBD540 01171 'MPRF-FEIN' DTSBD540 01172 OR DTSBD540 01173 'MPRF-FISCAL-AGENT-CD' DTSBD540 01174 SET WRK-EMP-LEVEL-MOD-YES-88 TO TRUE. DTSBD540 01175 P4110-EXIT. DTSBD540 01176 EXIT. DTSBD540 01177 DTSBD540 01178 DTSBD540 01179 DTSBD540 01180 P4120-CHECK-MTAD. DTSBD540 01181 IF MLOG-DATA-ELEMENT-NAME DTSBD540 01182 = 'MTAD-ATTN-LINE' DTSBD540 01183 OR DTSBD540 01184 'MTAD-DELIV-LINE-1' DTSBD540 01185 OR DTSBD540 01186 'MTAD-DELIV-LINE-2' DTSBD540 01187 OR DTSBD540 01188 'MTAD-CITY' DTSBD540 01189 OR DTSBD540 01190 'MTAD-ST' DTSBD540 01191 OR DTSBD540 01192 'MTAD-ZIP' DTSBD540 01193 OR DTSBD540 01194 'MTAD-PHYSCIAL-ADDRESS-IND' DTSBD540 01195 OR DTSBD540 01196 'MTAD-PHYSICAL-ADDRESS-IND' DTSBD540 01197 SET WRK-EMP-LEVEL-MOD-YES-88 TO TRUE. DTSBD540 01198 DTSBD540 01199 IF MLOG-REC-OCC-ID = 'MAILING ADDRESS' DTSBD540 01200 IF MLOG-DATA-ELEMENT-NAME DTSBD540 01201 = 'MTAD-VOICE1' DTSBD540 01202 OR DTSBD540 01203 'MTAD-VOICE-1' DTSBD540 01204 OR DTSBD540 01205 'MTAD-FAX' DTSBD540 01206 SET WRK-EMP-LEVEL-MOD-YES-88 TO TRUE. DTSBD540 01207 P4120-EXIT. DTSBD540 01208 EXIT. DTSBD540 01209 DTSBD540 01210 DTSBD540 01211 DTSBD540 01212 P4130-CHECK-MSOL. DTSBD540 01213 IF MLOG-DATA-ELEMENT-NAME DTSBD540 01214 = 'MSOL-LIAB-DATE' DTSBD540 01215 OR DTSBD540 01216 'MSOL-LIAB-CD' DTSBD540 01217 OR DTSBD540 01218 'MSOL-LIAB-ESTB-DATE' DTSBD540 01219 OR DTSBD540 01220 'MSOL-INACT-DATE' DTSBD540 01221 OR DTSBD540 01222 'MSOL-INACT-CD' DTSBD540 01223 SET WRK-EMP-LEVEL-MOD-YES-88 TO TRUE. DTSBD540 01224 P4130-EXIT. DTSBD540 01225 EXIT. DTSBD540 01226 DTSBD540 01227 DTSBD540 01228 DTSBD540 01229 P4140-CHECK-MREL. DTSBD540 01230 IF MLOG-DATA-ELEMENT-NAME DTSBD540 01231 = 'MREL-PRED-EMP-NO' DTSBD540 01232 OR DTSBD540 01233 'MREL-EFF-DATE' DTSBD540 01234 OR DTSBD540 01235 'RELATIONSHIP DELETED' DTSBD540 01236 SET WRK-EMP-LEVEL-MOD-YES-88 TO TRUE. DTSBD540 01237 P4140-EXIT. DTSBD540 01238 EXIT. DTSBD540 01239 DTSBD540 01240 DTSBD540 01241 DTSBD540 01242 P4200-EVALUATE-SUCC-MOD. DTSBD540 01243 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSBD540 01244 DTSBD540 01245 MOVE WRK-SUCC-ACCT TO MREL-EMP-NO. DTSBD540 01246 DTSBD540 01247 SET MREL-REL-88 TO TRUE. DTSBD540 01248 DTSBD540 01249 MOVE WRK-SUCC-EFF-DATE TO MREL-EFF-DATE. DTSBD540 01250 DTSBD540 01251 MOVE MPRF-EMP-NO TO MREL-PRED-EMP-NO. DTSBD540 01252 DTSBD540 01253 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBD540 01254 DTSBD540 01255 PERFORM S910-READ THRU S910-EXIT. DTSBD540 01256 DTSBD540 01257 IF L910-NO-REC-88 DTSBD540 01258 GO TO P4200-EXIT. DTSBD540 01259 DTSBD540 01260 MOVE MSKL-REC TO MREL-REC. DTSBD540 01261 DTSBD540 01262 IF MREL-CHNG-DATE > WRK-GLOBAL-LAST-INITIAL-DATE DTSBD540 01263 SET WRK-EMP-LEVEL-MOD-YES-88 TO TRUE. DTSBD540 01264 P4200-EXIT. DTSBD540 01265 EXIT. DTSBD540 01266 EJECT DTSBD540 01267 DTSBD540 01268 P5000-EVALUATE-QTR-LEVEL-MOD. DTSBD540 01269 DTSBD540 01270 IF WRK-EXT-REVISED-88 (YRQ-SUB) DTSBD540 01271 NEXT SENTENCE DTSBD540 01272 ELSE DTSBD540 01273 GO TO P5000-EXIT. DTSBD540 01274 DTSBD540 01275 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD540 01276 DTSBD540 01277 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD540 01278 DTSBD540 01279 SET MQTR-QTR-88 TO TRUE. DTSBD540 01280 DTSBD540 01281 MOVE WRK-EXT-YRQ (YRQ-SUB) TO MQTR-YRQ. DTSBD540 01282 DTSBD540 01283 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD540 01284 DTSBD540 01285 PERFORM S910-READ THRU S910-EXIT. DTSBD540 01286 DTSBD540 01287 IF L910-NO-REC-88 DTSBD540 01288 GO TO P5000-EXIT. DTSBD540 01289 DTSBD540 01290 MOVE MSKL-REC TO MQTR-REC. DTSBD540 01291 DTSBD540 01292 IF MQTR-WAGE-CHNG-DATE > WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) DTSBD540 01293 SET WRK-QTR-LEVEL-MOD-YES-88 TO TRUE DTSBD540 01294 GO TO P5000-EXIT. DTSBD540 01295 DTSBD540 01296 IF MQTR-EMPL-CNT-CHNG-DATE > DTSBD540 01297 WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) DTSBD540 01298 SET WRK-QTR-LEVEL-MOD-YES-88 TO TRUE DTSBD540 01299 GO TO P5000-EXIT. DTSBD540 01300 DTSBD540 01301 IF WRK-ACTIVE-IN-EXT-YRQ-YES-88 DTSBD540 01302 IF MQTR-ESTB-DATE > WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) DTSBD540 01303 SET WRK-QTR-LEVEL-MOD-YES-88 TO TRUE DTSBD540 01304 GO TO P5000-EXIT. DTSBD540 01305 DTSBD540 01306 DTSBD540 01307 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD540 01308 DTSBD540 01309 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD540 01310 DTSBD540 01311 SET MSKL-JRN-88 TO TRUE. DTSBD540 01312 DTSBD540 01313 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD540 01314 DTSBD540 01315 PERFORM DTSBD540 01316 UNTIL L910-NO-REC-88 DTSBD540 01317 MOVE MSKL-REC TO MJRN-REC DTSBD540 01318 IF MJRN-ESTB-DATE > WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) DTSBD540 01319 PERFORM DTSBD540 01320 VARYING MJRN-OCC-IDX FROM 1 BY 1 DTSBD540 01321 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBD540 01322 IF (MJRN-ROW-UI-88 (MJRN-OCC-IDX)) DTSBD540 01323 AND DTSBD540 01324 (MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)) DTSBD540 01325 AND DTSBD540 01326 (MJRN-YRQ (MJRN-OCC-IDX) = WRK-EXT-YRQ (YRQ-SUB)) DTSBD540 01327 SET WRK-QTR-LEVEL-MOD-YES-88 TO TRUE DTSBD540 01328 END-IF DTSBD540 01329 END-PERFORM DTSBD540 01330 END-IF DTSBD540 01331 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD540 01332 END-PERFORM. DTSBD540 01333 DTSBD540 01334 DTSBD540 01335 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD540 01336 DTSBD540 01337 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD540 01338 DTSBD540 01339 SET MSKL-LOG-88 TO TRUE. DTSBD540 01340 DTSBD540 01341 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD540 01342 DTSBD540 01343 PERFORM DTSBD540 01344 UNTIL L910-NO-REC-88 DTSBD540 01345 MOVE MSKL-REC TO MLOG-REC DTSBD540 01346 IF MLOG-ESTB-DATE > WRK-GLOBAL-LAST-INITIAL-DATE DTSBD540 01347 *& IF MLOG-ESTB-DATE > WRK-EXT-MOST-RECENT-DATE (YRQ-SUB) DTSBD540 01348 PERFORM P5100-CHECK-MLOG THRU P5100-EXIT DTSBD540 01349 END-IF DTSBD540 01350 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD540 01351 END-PERFORM. DTSBD540 01352 P5000-EXIT. DTSBD540 01353 EXIT. DTSBD540 01354 EJECT DTSBD540 01355 P5100-CHECK-MLOG. DTSBD540 01356 IF MLOG-DE-REC-TYPE = 'MPRF' DTSBD540 01357 IF MLOG-DATA-ELEMENT-NAME = 'MPRF-NAICS-CD' DTSBD540 01358 SET WRK-QTR-LEVEL-MOD-YES-88 TO TRUE DTSBD540 01359 END-IF DTSBD540 01360 END-IF. DTSBD540 01361 DTSBD540 01362 P5100-EXIT. DTSBD540 01363 EXIT. DTSBD540 01364 EJECT DTSBD540 01365 P8000-CONSTRUCT-EMP-LEVEL. DTSBD540 01366 MOVE MPRF-FEIN TO IMT-EIN. DTSBD540 01367 DTSBD540 01368 DTSBD540 01369 IF MPRF-PRIMARY-IS-ENTITY-88 DTSBD540 01370 MOVE MPRF-PRIMARY-NAME TO IMT-LEGAL-NAME DTSBD540 01371 ELSE DTSBD540 01372 IF MPRF-ENTITY-NAME = SPACES OR LOW-VALUES DTSBD540 01373 MOVE SPACES TO IMT-LEGAL-NAME DTSBD540 01374 ELSE DTSBD540 01375 MOVE MPRF-ENTITY-NAME TO IMT-LEGAL-NAME. DTSBD540 01376 DTSBD540 01377 DTSBD540 01378 MOVE MPRF-PRIMARY-NAME TO IMT-TRADE-NAME. DTSBD540 01379 DTSBD540 01380 DTSBD540 01381 MOVE MPRF-FISCAL-AGENT-CD TO IMT-AGENT-CODE. DTSBD540 01382 DTSBD540 01383 DTSBD540 01384 PERFORM P8100-UI-ADDR-AND-PHONE THRU P8100-EXIT. DTSBD540 01385 DTSBD540 01386 DTSBD540 01387 PERFORM P8200-PL-ADDR THRU P8200-EXIT. DTSBD540 01388 DTSBD540 01389 DTSBD540 01390 ** MOVE 63 TO IMT-FIELD-LOCK. DTSBD540 01391 MOVE ZEROS TO IMT-FIELD-LOCK. DTSBD540 01392 DTSBD540 01393 DTSBD540 01394 IF WRK-INIT-ESTB-DATE NOT = +0 DTSBD540 01395 MOVE WRK-INIT-ESTB-DATE TO IMT-SETUP-DATE. DTSBD540 01396 DTSBD540 01397 DTSBD540 01398 IF WRK-INIT-LIAB-DATE NOT = +0 DTSBD540 01399 MOVE WRK-INIT-LIAB-DATE TO IMT-INIT-LIAB-DATE. DTSBD540 01400 DTSBD540 01401 DTSBD540 01402 IF (WRK-INIT-INACT-DATE = +0) DTSBD540 01403 OR DTSBD540 01404 (WRK-INIT-ACTIVE-88) DTSBD540 01405 NEXT SENTENCE DTSBD540 01406 ELSE DTSBD540 01407 MOVE WRK-INIT-INACT-DATE TO IMT-END-LIAB-DATE. DTSBD540 01408 DTSBD540 01409 DTSBD540 01410 IF (WRK-MOST-RECENT-LIAB-DATE = +0) DTSBD540 01411 OR DTSBD540 01412 (WRK-MOST-RECENT-LIAB-DATE = WRK-INIT-LIAB-DATE) DTSBD540 01413 NEXT SENTENCE DTSBD540 01414 ELSE DTSBD540 01415 MOVE WRK-MOST-RECENT-LIAB-DATE TO IMT-REACT-DATE. DTSBD540 01416 DTSBD540 01417 DTSBD540 01418 IF WRK-PRED-ACCT = ZERO DTSBD540 01419 NEXT SENTENCE DTSBD540 01420 ELSE DTSBD540 01421 MOVE WRK-PRED-ACCT TO IMT-PRED-ACCT DTSBD540 01422 MOVE ZERO TO IMT-PRED-RPT-UNIT. DTSBD540 01423 DTSBD540 01424 DTSBD540 01425 IF WRK-SUCC-ACCT = ZERO DTSBD540 01426 NEXT SENTENCE DTSBD540 01427 ELSE DTSBD540 01428 MOVE WRK-SUCC-ACCT TO IMT-SUCC-ACCT DTSBD540 01429 MOVE ZERO TO IMT-SUCC-RPT-UNIT. DTSBD540 01430 P8000-EXIT. DTSBD540 01431 EXIT. DTSBD540 01432 DTSBD540 01433 DTSBD540 01434 DTSBD540 01435 P8100-UI-ADDR-AND-PHONE. DTSBD540 01436 MOVE LOW-VALUES TO IMT-PL-ADDRESS DTSBD540 01437 IMT-PL-ADDRESS2 DTSBD540 01438 IMT-RPT-UNIT-DESCR DTSBD540 01439 IMT-PL-CITY DTSBD540 01440 IMT-PL-STATE DTSBD540 01441 IMT-PL-ZIP DTSBD540 01442 IMT-ATTENTION-NAME DTSBD540 01443 IMT-UI-ADDRESS DTSBD540 01444 IMT-UI-ADDRESS2 DTSBD540 01445 IMT-UI-CITY DTSBD540 01446 IMT-UI-STATE DTSBD540 01447 IMT-UI-ZIP DTSBD540 01448 IMT-MO-ADDRESS DTSBD540 01449 IMT-MO-ADDRESS2 DTSBD540 01450 IMT-MO-CITY DTSBD540 01451 IMT-MO-STATE DTSBD540 01452 IMT-MO-ZIP. DTSBD540 01453 DTSBD540 01454 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBD540 01455 DTSBD540 01456 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBD540 01457 DTSBD540 01458 SET MTAD-TAD-88 TO TRUE. DTSBD540 01459 DTSBD540 01460 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBD540 01461 DTSBD540 01462 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD540 01463 DTSBD540 01464 PERFORM S910-READ THRU S910-EXIT. DTSBD540 01465 DTSBD540 01466 IF L910-NO-REC-88 DTSBD540 01467 GO TO P8100-EXIT. DTSBD540 01468 DTSBD540 01469 DTSBD540 01470 MOVE MSKL-REC TO MTAD-REC. DTSBD540 01471 DTSBD540 01472 DTSBD540 01473 PERFORM S1000-REFORMAT-ADDRESS THRU S1000-EXIT. DTSBD540 01474 DTSBD540 01475 DTSBD540 01476 IF ADR-VALID-ADDRESS-NO-88 DTSBD540 01477 NEXT SENTENCE DTSBD540 01478 ELSE DTSBD540 01479 MOVE '2' TO IMT-UI-ADDR-TYPE DTSBD540 01480 IMT-MO-ADDR-TYPE DTSBD540 01481 IF ADR-PHYSICAL-ADDRESS-YES-88 DTSBD540 01482 MOVE '1' TO IMT-UI-ADDR-TYPE DTSBD540 01483 IMT-MO-ADDR-TYPE DTSBD540 01484 END-IF DTSBD540 01485 MOVE ADR-ATTENTION-NAME TO IMT-ATTENTION-NAME DTSBD540 01486 MOVE ADR-ADDRESS TO IMT-UI-ADDRESS DTSBD540 01487 IMT-MO-ADDRESS DTSBD540 01488 MOVE ADR-ADDRESS2 TO IMT-UI-ADDRESS2 DTSBD540 01489 IMT-MO-ADDRESS2 DTSBD540 01490 MOVE ADR-CITY TO IMT-UI-CITY DTSBD540 01491 IMT-MO-CITY DTSBD540 01492 MOVE ADR-STATE TO IMT-UI-STATE DTSBD540 01493 IMT-MO-STATE DTSBD540 01494 MOVE ADR-ZIP TO IMT-UI-ZIP DTSBD540 01495 IMT-MO-ZIP. DTSBD540 01496 DTSBD540 01497 DTSBD540 01498 SET PHONE-NUMBER-VOICE-88 TO TRUE. DTSBD540 01499 DTSBD540 01500 MOVE MTAD-VOICE-1 TO PHONE-IN-AREA. DTSBD540 01501 DTSBD540 01502 PERFORM S2000-REFORMAT-PHONE-NUMBER THRU S2000-EXIT. DTSBD540 01503 DTSBD540 01504 IF PHONE-NUMBER-VALID-NO-88 DTSBD540 01505 NEXT SENTENCE DTSBD540 01506 ELSE DTSBD540 01507 MOVE PHONE-OUT-PHONE-NUM TO IMT-PHONE-NUM DTSBD540 01508 MOVE PHONE-OUT-EXT TO IMT-PHONE-EXT. DTSBD540 01509 DTSBD540 01510 DTSBD540 01511 SET PHONE-NUMBER-FAX-88 TO TRUE. DTSBD540 01512 DTSBD540 01513 MOVE MTAD-FAX TO PHONE-IN-AREA. DTSBD540 01514 DTSBD540 01515 PERFORM S2000-REFORMAT-PHONE-NUMBER THRU S2000-EXIT. DTSBD540 01516 DTSBD540 01517 IF PHONE-NUMBER-VALID-NO-88 DTSBD540 01518 NEXT SENTENCE DTSBD540 01519 ELSE DTSBD540 01520 MOVE PHONE-OUT-PHONE-NUM TO IMT-FAX-PHONE-NUM. DTSBD540 01521 P8100-EXIT. DTSBD540 01522 EXIT. DTSBD540 01523 DTSBD540 01524 DTSBD540 01525 DTSBD540 01526 P8200-PL-ADDR. DTSBD540 01527 IF IMT-UI-ADDR-TYPE = '1' DTSBD540 01528 MOVE IMT-UI-ADDRESS TO IMT-PL-ADDRESS DTSBD540 01529 MOVE IMT-UI-ADDRESS2 TO IMT-PL-ADDRESS2 DTSBD540 01530 MOVE IMT-UI-CITY TO IMT-PL-CITY DTSBD540 01531 MOVE IMT-UI-STATE TO IMT-PL-STATE DTSBD540 01532 MOVE IMT-UI-ZIP TO IMT-PL-ZIP DTSBD540 01533 GO TO P8200-EXIT. DTSBD540 01534 DTSBD540 01535 DTSBD540 01536 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBD540 01537 DTSBD540 01538 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBD540 01539 DTSBD540 01540 SET MTAD-TAD-88 TO TRUE. DTSBD540 01541 DTSBD540 01542 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSBD540 01543 DTSBD540 01544 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD540 01545 DTSBD540 01546 PERFORM S910-READ THRU S910-EXIT. DTSBD540 01547 DTSBD540 01548 IF L910-NO-REC-88 DTSBD540 01549 GO TO P8200-EXIT. DTSBD540 01550 DTSBD540 01551 DTSBD540 01552 MOVE MSKL-REC TO MTAD-REC. DTSBD540 01553 DTSBD540 01554 DTSBD540 01555 PERFORM S1000-REFORMAT-ADDRESS THRU S1000-EXIT. DTSBD540 01556 DTSBD540 01557 DTSBD540 01558 IF (ADR-VALID-ADDRESS-YES-88) DTSBD540 01559 AND DTSBD540 01560 (ADR-PHYSICAL-ADDRESS-YES-88) DTSBD540 01561 MOVE ADR-ADDRESS TO IMT-PL-ADDRESS DTSBD540 01562 MOVE ADR-ADDRESS2 TO IMT-PL-ADDRESS2 DTSBD540 01563 MOVE ADR-CITY TO IMT-PL-CITY DTSBD540 01564 MOVE ADR-STATE TO IMT-PL-STATE DTSBD540 01565 MOVE ADR-ZIP TO IMT-PL-ZIP. DTSBD540 01566 P8200-EXIT. DTSBD540 01567 EXIT. DTSBD540 01568 EJECT DTSBD540 01569 P9000-CONSTRUCT-QTR-LEVEL. DTSBD540 01570 IF WRK-EXT-REVISED-88 (YRQ-SUB) DTSBD540 01571 IF WRK-QTR-LEVEL-MOD-YES-88 DTSBD540 01572 NEXT SENTENCE DTSBD540 01573 ELSE DTSBD540 01574 GO TO P9000-EXIT DTSBD540 01575 ELSE DTSBD540 01576 IF WRK-EXT-INITIAL-88 (YRQ-SUB) DTSBD540 01577 IF WRK-ACTIVE-IN-EXT-YRQ-YES-88 DTSBD540 01578 NEXT SENTENCE DTSBD540 01579 ELSE DTSBD540 01580 GO TO P9000-EXIT DTSBD540 01581 ELSE DTSBD540 01582 GO TO P9000-EXIT. DTSBD540 01583 DTSBD540 01584 DTSBD540 01585 MOVE LOW-VALUES TO IMT-QTR-DATA (YRQ-SUB). DTSBD540 01586 *& INITIALIZE IMT-QTR-DATA (YRQ-SUB). DTSBD540 01587 DTSBD540 01588 MOVE WRK-EXT-YRQ (YRQ-SUB) TO L004-QTR-5-9. DTSBD540 01589 DTSBD540 01590 MOVE L004-QTR-5-YR TO IMTQ-YEAR (YRQ-SUB). DTSBD540 01591 DTSBD540 01592 MOVE L004-QTR-5-Q TO IMTQ-QTR (YRQ-SUB). DTSBD540 01593 DTSBD540 01594 DTSBD540 01595 IF WRK-ACTIVE-IN-EXT-YRQ-YES-88 DTSBD540 01596 MOVE '1' TO IMTQ-STATUS (YRQ-SUB) DTSBD540 01597 ELSE DTSBD540 01598 MOVE '2' TO IMTQ-STATUS (YRQ-SUB). DTSBD540 01599 DTSBD540 01600 MOVE '001' TO IMTQ-CNTY (YRQ-SUB). DTSBD540 01601 DTSBD540 01602 IF MPRF-OWN-CD = '10' OR '20' OR '30' OR '50' OR '51' DTSBD540 01603 OR '52' OR '53' OR '54' OR '55' OR '56' DTSBD540 01604 OR '57' OR '58' OR '59' DTSBD540 01605 MOVE MPRF-OWN-CD TO IMTQ-OWNER (YRQ-SUB) DTSBD540 01606 **NH 052015 DTSBD540 01607 ELSE DTSBD540 01608 ** IF MPRF-OWN-CD = '00' OR LOW-VALUES DTSBD540 01609 MOVE '50' TO IMTQ-OWNER (YRQ-SUB) DTSBD540 01610 ** END-IF DTSBD540 01611 END-IF. DTSBD540 01612 **NH 052015 DTSBD540 01613 DTSBD540 01614 IF (MPRF-NAICS-CD-NONCLASSIF-88) DTSBD540 01615 OR DTSBD540 01616 (MPRF-NAICS-CD = '000000') DTSBD540 01617 OR DTSBD540 01618 (MPRF-NAICS-CD NOT NUMERIC) DTSBD540 01619 * NEXT SENTENCE DTSBD540 01620 MOVE '999999' TO IMTQ-NAICS (YRQ-SUB) DTSBD540 01621 ELSE DTSBD540 01622 MOVE MPRF-NAICS-CD TO IMTQ-NAICS (YRQ-SUB). DTSBD540 01623 DTSBD540 01624 DTSBD540 01625 IF (MPRF-SIC-CD-NONCLASSIF-88) DTSBD540 01626 OR DTSBD540 01627 (MPRF-SIC-CD = '0000') DTSBD540 01628 OR DTSBD540 01629 (MPRF-SIC-CD NOT NUMERIC) DTSBD540 01630 NEXT SENTENCE DTSBD540 01631 *& MOVE SPACES TO IMTQ-SIC (YRQ-SUB) DTSBD540 01632 ELSE DTSBD540 01633 MOVE MPRF-SIC-CD TO IMTQ-SIC (YRQ-SUB). DTSBD540 01634 DTSBD540 01635 DTSBD540 01636 IF MPRF-CLASS-RATED-88 DTSBD540 01637 MOVE '0' TO IMTQ-TYPE-COV (YRQ-SUB) DTSBD540 01638 ELSE DTSBD540 01639 IF MPRF-CLASS-SELF-INS-88 DTSBD540 01640 MOVE '1' TO IMTQ-TYPE-COV (YRQ-SUB) DTSBD540 01641 ELSE DTSBD540 01642 MOVE MSG03-ID TO R907-MSG-ID DTSBD540 01643 MOVE MSG03-TEXT TO R907-MSG-TEXT DTSBD540 01644 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD540 01645 MOVE '0' TO IMTQ-TYPE-COV (YRQ-SUB). DTSBD540 01646 DTSBD540 01647 DTSBD540 01648 IF MPRF-SIC-AUXILIARY-CD = '0' OR '1' OR '2' OR '3' DTSBD540 01649 OR '5' OR '9' DTSBD540 01650 MOVE MPRF-SIC-AUXILIARY-CD TO IMTQ-AUX (YRQ-SUB) DTSBD540 01651 ELSE DTSBD540 01652 MOVE '0' TO IMTQ-AUX (YRQ-SUB). DTSBD540 01653 DTSBD540 01654 DTSBD540 01655 IF MPRF-MULTIPLE-UNIT-88 DTSBD540 01656 MOVE '2' TO IMTQ-MEEI (YRQ-SUB) DTSBD540 01657 ELSE DTSBD540 01658 MOVE '1' TO IMTQ-MEEI (YRQ-SUB). DTSBD540 01659 DTSBD540 01660 DTSBD540 01661 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD540 01662 DTSBD540 01663 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD540 01664 DTSBD540 01665 SET MQTR-QTR-88 TO TRUE. DTSBD540 01666 DTSBD540 01667 MOVE WRK-EXT-YRQ (YRQ-SUB) TO MQTR-YRQ. DTSBD540 01668 DTSBD540 01669 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD540 01670 DTSBD540 01671 PERFORM S910-READ THRU S910-EXIT. DTSBD540 01672 DTSBD540 01673 IF L910-NO-REC-88 DTSBD540 01674 PERFORM P9100-MQTR-DOES-NOT-EXIST THRU P9100-EXIT DTSBD540 01675 ELSE DTSBD540 01676 MOVE MSKL-REC TO MQTR-REC DTSBD540 01677 PERFORM P9200-MQTR-EXISTS THRU P9200-EXIT. DTSBD540 01678 P9000-EXIT. DTSBD540 01679 EXIT. DTSBD540 01680 DTSBD540 01681 DTSBD540 01682 DTSBD540 01683 P9100-MQTR-DOES-NOT-EXIST. DTSBD540 01684 PERFORM P9900-LOOKUP-UI-RATE THRU P9900-EXIT. DTSBD540 01685 DTSBD540 01686 DTSBD540 01687 MOVE ZERO TO IMTQ-M1-EMPL (YRQ-SUB) DTSBD540 01688 IMTQ-M2-EMPL (YRQ-SUB) DTSBD540 01689 IMTQ-M3-EMPL (YRQ-SUB) DTSBD540 01690 IMTQ-TOTAL-WAGE (YRQ-SUB) DTSBD540 01691 IMTQ-TAX-WAGE (YRQ-SUB) DTSBD540 01692 IMTQ-CONTRIB-DUE (YRQ-SUB). DTSBD540 01693 DTSBD540 01694 MOVE 'M' TO IMTQ-M1-IND (YRQ-SUB) DTSBD540 01695 IMTQ-M2-IND (YRQ-SUB) DTSBD540 01696 IMTQ-M3-IND (YRQ-SUB) DTSBD540 01697 IMTQ-TOTW-IND (YRQ-SUB) DTSBD540 01698 IMTQ-TAXW-IND (YRQ-SUB) DTSBD540 01699 IMTQ-CTRB-IND (YRQ-SUB). DTSBD540 01700 P9100-EXIT. DTSBD540 01701 EXIT. DTSBD540 01702 DTSBD540 01703 DTSBD540 01704 DTSBD540 01705 P9200-MQTR-EXISTS. DTSBD540 01706 IF MQTR-NO-UI-RATE-88 DTSBD540 01707 PERFORM P9900-LOOKUP-UI-RATE THRU P9900-EXIT DTSBD540 01708 ELSE DTSBD540 01709 MOVE MQTR-UI-RATE TO IMTQ-TAX-RATE (YRQ-SUB). DTSBD540 01710 DTSBD540 01711 DTSBD540 01712 IF MQTR-CURR-NOT-LIABLE-88 DTSBD540 01713 OR DTSBD540 01714 MQTR-CURR-NOT-DUE-88 DTSBD540 01715 OR DTSBD540 01716 MQTR-CURR-DELINQ-88 DTSBD540 01717 MOVE ZEROS TO IMTQ-M1-EMPL (YRQ-SUB) DTSBD540 01718 IMTQ-M2-EMPL (YRQ-SUB) DTSBD540 01719 IMTQ-M3-EMPL (YRQ-SUB) DTSBD540 01720 IMTQ-TOTAL-WAGE (YRQ-SUB) DTSBD540 01721 IMTQ-TAX-WAGE (YRQ-SUB) DTSBD540 01722 IMTQ-CONTRIB-DUE (YRQ-SUB) DTSBD540 01723 MOVE 'M' TO IMTQ-M1-IND (YRQ-SUB) DTSBD540 01724 IMTQ-M2-IND (YRQ-SUB) DTSBD540 01725 IMTQ-M3-IND (YRQ-SUB) DTSBD540 01726 IMTQ-TOTW-IND (YRQ-SUB) DTSBD540 01727 IMTQ-TAXW-IND (YRQ-SUB) DTSBD540 01728 IMTQ-CTRB-IND (YRQ-SUB) DTSBD540 01729 GO TO P9200-EXIT. DTSBD540 01730 DTSBD540 01731 **CHANGES FOR LMI ESTIMATED REPORT CL*19 01732 IF MQTR-CURR-ESTIM-88 DTSBD540 01733 ** MOVE 'E' TO WRK-IMTQ-IND CL**4 01734 MOVE LOW-VALUES TO WRK-IMTQ-IND CL*16 01735 ELSE DTSBD540 01736 MOVE 'R' TO WRK-IMTQ-IND. DTSBD540 01737 CL*19 01738 **CHANGES FOR LMI ESTIMATED REPORT CL*19 01739 DTSBD540 01740 *& DTSBD540 01741 * TEMPORARY PATCH TO CORRECT EMPLOYEE COUNTS FOR ANNUAL FILERS.DTSBD540 01742 * A PERMANENT FIX WILL BE PUT INTO DTSBD374. DTSBD540 01743 IF MQTR-ANNUAL-YES-88 DTSBD540 01744 IF MQTR-1ST-MTH-EMPL-CNT > 90 DTSBD540 01745 SET MQTR-1ST-MTH-NO-ENTRY-88 TO TRUE DTSBD540 01746 END-IF DTSBD540 01747 IF MQTR-2ND-MTH-EMPL-CNT > 90 DTSBD540 01748 SET MQTR-2ND-MTH-NO-ENTRY-88 TO TRUE DTSBD540 01749 END-IF DTSBD540 01750 IF MQTR-3RD-MTH-EMPL-CNT > 90 DTSBD540 01751 SET MQTR-3RD-MTH-NO-ENTRY-88 TO TRUE DTSBD540 01752 END-IF DTSBD540 01753 END-IF. DTSBD540 01754 *& DTSBD540 01755 DTSBD540 01756 IF MQTR-1ST-MTH-NO-ENTRY-88 DTSBD540 01757 MOVE ZERO TO IMTQ-M1-EMPL (YRQ-SUB) DTSBD540 01758 MOVE 'M' TO IMTQ-M1-IND (YRQ-SUB) DTSBD540 01759 ELSE DTSBD540 01760 MOVE MQTR-1ST-MTH-EMPL-CNT TO IMTQ-M1-EMPL (YRQ-SUB) DTSBD540 01761 MOVE WRK-IMTQ-IND TO IMTQ-M1-IND (YRQ-SUB). DTSBD540 01762 DTSBD540 01763 DTSBD540 01764 IF MQTR-2ND-MTH-NO-ENTRY-88 DTSBD540 01765 MOVE ZERO TO IMTQ-M2-EMPL (YRQ-SUB) DTSBD540 01766 MOVE 'M' TO IMTQ-M2-IND (YRQ-SUB) DTSBD540 01767 ELSE DTSBD540 01768 MOVE MQTR-2ND-MTH-EMPL-CNT TO IMTQ-M2-EMPL (YRQ-SUB) DTSBD540 01769 MOVE WRK-IMTQ-IND TO IMTQ-M2-IND (YRQ-SUB). DTSBD540 01770 DTSBD540 01771 DTSBD540 01772 IF MQTR-3RD-MTH-NO-ENTRY-88 DTSBD540 01773 MOVE ZERO TO IMTQ-M3-EMPL (YRQ-SUB) DTSBD540 01774 MOVE 'M' TO IMTQ-M3-IND (YRQ-SUB) DTSBD540 01775 ELSE DTSBD540 01776 MOVE MQTR-3RD-MTH-EMPL-CNT TO IMTQ-M3-EMPL (YRQ-SUB) DTSBD540 01777 MOVE WRK-IMTQ-IND TO IMTQ-M3-IND (YRQ-SUB). DTSBD540 01778 DTSBD540 01779 DTSBD540 01780 MOVE MQTR-TOT-WAGE TO WRK-ROUND-AMT. DTSBD540 01781 DTSBD540 01782 ADD +0.50 TO WRK-ROUND-AMT. CL*14 01783 CL*17 01784 MOVE WRK-ROUND-AMT TO IMTQ-TOTAL-WAGE (YRQ-SUB) CL*17 01785 CL**6 01786 MOVE WRK-IMTQ-IND TO IMTQ-TOTW-IND (YRQ-SUB). DTSBD540 01787 DTSBD540 01788 DTSBD540 01789 MOVE MQTR-TAX-WAGE TO WRK-ROUND-AMT. DTSBD540 01790 DTSBD540 01791 ADD +0.50 TO WRK-ROUND-AMT. CL*14 01792 DTSBD540 01793 MOVE WRK-ROUND-AMT TO IMTQ-TAX-WAGE (YRQ-SUB) CL*17 01794 DTSBD540 01795 MOVE WRK-IMTQ-IND TO IMTQ-TAXW-IND (YRQ-SUB). DTSBD540 01796 DTSBD540 01797 DTSBD540 01798 MOVE +0 TO WRK-ROUND-AMT. DTSBD540 01799 DTSBD540 01800 PERFORM DTSBD540 01801 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD540 01802 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD540 01803 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD540 01804 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD540 01805 TO WRK-ROUND-AMT DTSBD540 01806 END-IF DTSBD540 01807 END-PERFORM. DTSBD540 01808 DTSBD540 01809 ADD +0.50 TO WRK-ROUND-AMT. DTSBD540 01810 DTSBD540 01811 MOVE WRK-ROUND-AMT TO IMTQ-CONTRIB-DUE (YRQ-SUB) CL*18 01812 DTSBD540 01813 MOVE WRK-IMTQ-IND TO IMTQ-CTRB-IND (YRQ-SUB). DTSBD540 01814 DTSBD540 01815 IF MPRF-CLASS-SELF-INS-88 DTSBD540 01816 MOVE ZERO TO IMTQ-TAX-WAGE (YRQ-SUB) DTSBD540 01817 IMTQ-CONTRIB-DUE (YRQ-SUB). DTSBD540 01818 P9200-EXIT. DTSBD540 01819 EXIT. DTSBD540 01820 DTSBD540 01821 DTSBD540 01822 DTSBD540 01823 P9900-LOOKUP-UI-RATE. DTSBD540 01824 IF MPRF-CLASS-SELF-INS-88 DTSBD540 01825 GO TO P9900-EXIT. DTSBD540 01826 DTSBD540 01827 DTSBD540 01828 MOVE WRK-EXT-YRQ (YRQ-SUB) TO L006-YRQ. DTSBD540 01829 DTSBD540 01830 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD540 01831 DTSBD540 01832 DTSBD540 01833 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBD540 01834 DTSBD540 01835 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBD540 01836 DTSBD540 01837 SET MRTE-RTE-88 TO TRUE. DTSBD540 01838 DTSBD540 01839 MOVE L006-RTE-YR-START-YRQ TO MRTE-EFF-YRQ. DTSBD540 01840 DTSBD540 01841 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBD540 01842 DTSBD540 01843 PERFORM S910-READ THRU S910-EXIT. DTSBD540 01844 DTSBD540 01845 IF L910-NO-REC-88 DTSBD540 01846 GO TO P9900-EXIT. DTSBD540 01847 DTSBD540 01848 DTSBD540 01849 MOVE MSKL-REC TO MRTE-REC. DTSBD540 01850 DTSBD540 01851 DTSBD540 01852 MOVE MRTE-UI-RATE TO IMTQ-TAX-RATE (1). DTSBD540 01853 P9900-EXIT. DTSBD540 01854 EXIT. DTSBD540 01855 EJECT DTSBD540 01856 T0000-TERMINATE. DTSBD540 01857 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD540 01858 DTSBD540 01859 DTSBD540 01860 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD540 01861 DTSBD540 01862 DTSBD540 01863 MOVE -1 TO R907-LENGTH. DTSBD540 01864 DTSBD540 01865 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBD540 01866 DTSBD540 01867 DTSBD540 01868 CLOSE ES202IMT-FILE ES202PRM-FILE. DTSBD540 01869 DTSBD540 01870 DTSBD540 01871 PERFORM T1000-CNTR-OUTPUT THRU T1000-EXIT. DTSBD540 01872 DTSBD540 01873 DTSBD540 01874 DISPLAY ' '. DTSBD540 01875 DTSBD540 01876 DISPLAY ' '. DTSBD540 01877 DTSBD540 01878 DISPLAY '*** ' DTSBD540 01879 WRK-MODULE-NAME DTSBD540 01880 ' TERMINATION STATISTICS'. DTSBD540 01881 DTSBD540 01882 DISPLAY ' '. DTSBD540 01883 DTSBD540 01884 DISPLAY '*** WRK-EXT-YRQ (2) : ' DTSBD540 01885 WRK-EXT-YRQ (2). DTSBD540 01886 DTSBD540 01887 DISPLAY ' '. DTSBD540 01888 DTSBD540 01889 DISPLAY '*** WRK-EXT-YRQ (1) : ' DTSBD540 01890 WRK-EXT-YRQ (1). DTSBD540 01891 DTSBD540 01892 DISPLAY ' '. DTSBD540 01893 DTSBD540 01894 DISPLAY '*** WRK-EXT-TYPE (2) : ' DTSBD540 01895 WRK-EXT-TYPE (2). DTSBD540 01896 DTSBD540 01897 DISPLAY ' '. DTSBD540 01898 DTSBD540 01899 DISPLAY '*** WRK-EXT-TYPE (1) : ' DTSBD540 01900 WRK-EXT-TYPE (1). DTSBD540 01901 DTSBD540 01902 DISPLAY ' '. DTSBD540 01903 DTSBD540 01904 DISPLAY '*** WRK-EXT-INITIAL-DATE (2) : ' DTSBD540 01905 WRK-EXT-INITIAL-DATE (2). DTSBD540 01906 DTSBD540 01907 DISPLAY ' '. DTSBD540 01908 DTSBD540 01909 DISPLAY '*** WRK-EXT-INITIAL-DATE (1) : ' DTSBD540 01910 WRK-EXT-INITIAL-DATE (1). DTSBD540 01911 DTSBD540 01912 DISPLAY ' '. DTSBD540 01913 DTSBD540 01914 DISPLAY '*** WRK-EXT-MOST-RECENT-DATE (2) : ' DTSBD540 01915 WRK-EXT-MOST-RECENT-DATE (2). DTSBD540 01916 DTSBD540 01917 DISPLAY ' '. DTSBD540 01918 DTSBD540 01919 DISPLAY '*** WRK-EXT-MOST-RECENT-DATE (1) : ' DTSBD540 01920 WRK-EXT-MOST-RECENT-DATE (1). DTSBD540 01921 DTSBD540 01922 DISPLAY ' '. DTSBD540 01923 DTSBD540 01924 DISPLAY '*** WRK-EXT-CURRENT-DATE : ' DTSBD540 01925 WRK-EXT-CURRENT-DATE. DTSBD540 01926 DTSBD540 01927 DISPLAY ' '. DTSBD540 01928 DTSBD540 01929 DISPLAY '*** WRK-GLBAL-LAST-INITIAL-DATE : ' DTSBD540 01930 WRK-GLOBAL-LAST-INITIAL-DATE. DTSBD540 01931 DTSBD540 01932 DISPLAY ' '. DTSBD540 01933 DTSBD540 01934 DISPLAY ' '. DTSBD540 01935 DTSBD540 01936 DISPLAY '*** PRF-REC-CNT : ' DTSBD540 01937 PRF-REC-CNT. DTSBD540 01938 DTSBD540 01939 DISPLAY ' '. DTSBD540 01940 DTSBD540 01941 DISPLAY '*** ES202IMT-REC-CNT : ' DTSBD540 01942 ES202IMT-REC-CNT. DTSBD540 01943 T0000-EXIT. DTSBD540 01944 EXIT. DTSBD540 01945 EJECT DTSBD540 01946 T1000-CNTR-OUTPUT. DTSBD540 01947 OPEN OUTPUT CNTR-FILE. DTSBD540 01948 DTSBD540 01949 PERFORM DTSBD540 01950 VARYING CNTR-TABLE-REC-IDX FROM 1 BY 1 DTSBD540 01951 UNTIL CNTR-TABLE-REC-IDX > CNTR-TABLE-CNT DTSBD540 01952 MOVE CNTR-TABLE-REC (CNTR-TABLE-REC-IDX) DTSBD540 01953 TO CNTR-REC DTSBD540 01954 PERFORM T1100-UPDATE-CNTR-REC THRU T1100-EXIT DTSBD540 01955 WRITE CNTR-REC DTSBD540 01956 END-PERFORM. DTSBD540 01957 DTSBD540 01958 DTSBD540 01959 PERFORM T1200-GENERATE-CNTR-REC THRU T1200-EXIT DTSBD540 01960 VARYING YRQ-SUB FROM +1 BY +1 DTSBD540 01961 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 01962 DTSBD540 01963 CLOSE CNTR-FILE. DTSBD540 01964 T1000-EXIT. DTSBD540 01965 EXIT. DTSBD540 01966 DTSBD540 01967 DTSBD540 01968 DTSBD540 01969 T1100-UPDATE-CNTR-REC. DTSBD540 01970 MOVE CNTR-YRQ-9 TO L004-QTR-5-9. DTSBD540 01971 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD540 01972 DTSBD540 01973 IF L004-INVALID-QTR DTSBD540 01974 MOVE 'T1100: UNEXPECTED L004-INVALID-QTR ENCOUNTERED' DTSBD540 01975 TO WRK-ABEND-MSG DTSBD540 01976 PERFORM S999-ABEND THRU S999-EXIT DTSBD540 01977 ELSE DTSBD540 01978 MOVE L004-ABS-QTR TO WRK-CNTR-ABS-QTR. DTSBD540 01979 DTSBD540 01980 PERFORM T1110-CHECK-EXT-YRQ THRU T1110-EXIT DTSBD540 01981 VARYING YRQ-SUB FROM +1 BY +1 DTSBD540 01982 UNTIL YRQ-SUB > WRK-YRQ-OCC-MAX. DTSBD540 01983 DTSBD540 01984 T1100-EXIT. DTSBD540 01985 EXIT. DTSBD540 01986 DTSBD540 01987 T1110-CHECK-EXT-YRQ. DTSBD540 01988 IF WRK-CNTR-ABS-QTR = WRK-EXT-ABS-QTR (YRQ-SUB) DTSBD540 01989 NEXT SENTENCE DTSBD540 01990 ELSE DTSBD540 01991 GO TO T1110-EXIT. DTSBD540 01992 DTSBD540 01993 IF WRK-EXT-INITIAL-88 (YRQ-SUB) DTSBD540 01994 MOVE WRK-EXT-CURRENT-DATE TO CNTR-EXT-INITIAL-DATE-9. DTSBD540 01995 DTSBD540 01996 IF CNTR-EXT-MOST-RECENT-DATE NUMERIC DTSBD540 01997 IF WRK-EXT-CURRENT-DATE > CNTR-EXT-MOST-RECENT-DATE-9 DTSBD540 01998 MOVE WRK-EXT-CURRENT-DATE DTSBD540 01999 TO CNTR-EXT-MOST-RECENT-DATE-9 DTSBD540 02000 ELSE DTSBD540 02001 NEXT SENTENCE DTSBD540 02002 ELSE DTSBD540 02003 MOVE WRK-EXT-CURRENT-DATE DTSBD540 02004 TO CNTR-EXT-MOST-RECENT-DATE-9. DTSBD540 02005 DTSBD540 02006 T1110-EXIT. DTSBD540 02007 EXIT. DTSBD540 02008 DTSBD540 02009 DTSBD540 02010 T1200-GENERATE-CNTR-REC. DTSBD540 02011 MOVE WRK-EXT-YRQ (YRQ-SUB) TO L004-QTR-5-9. DTSBD540 02012 DTSBD540 02013 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD540 02014 DTSBD540 02015 IF L004-INVALID-QTR DTSBD540 02016 MOVE 'T1000: UNEXPECTED L004-INVALID-QTR ENCOUNTERED' DTSBD540 02017 TO WRK-ABEND-MSG DTSBD540 02018 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 02019 DTSBD540 02020 IF (L004-ABS-QTR < +1) DTSBD540 02021 OR DTSBD540 02022 (L004-ABS-QTR > +400) DTSBD540 02023 MOVE 'T1000: UNEXPECTED L004-ABS-QTR VALUE ENCOUNTERED' DTSBD540 02024 TO WRK-ABEND-MSG DTSBD540 02025 PERFORM S999-ABEND THRU S999-EXIT. DTSBD540 02026 DTSBD540 02027 IF CNTR-YRQ-NO-88 (L004-ABS-QTR) DTSBD540 02028 NEXT SENTENCE DTSBD540 02029 ELSE DTSBD540 02030 GO TO T1200-EXIT. DTSBD540 02031 DTSBD540 02032 MOVE SPACES TO CNTR-REC. DTSBD540 02033 DTSBD540 02034 SET CNTR-RECORD-YRQ-88 TO TRUE. DTSBD540 02035 DTSBD540 02036 MOVE WRK-EXT-YRQ (YRQ-SUB) TO CNTR-YRQ-9. DTSBD540 02037 DTSBD540 02038 MOVE WRK-EXT-CURRENT-DATE DTSBD540 02039 TO CNTR-EXT-INITIAL-DATE-9 DTSBD540 02040 CNTR-EXT-MOST-RECENT-DATE-9. DTSBD540 02041 DTSBD540 02042 WRITE CNTR-REC. DTSBD540 02043 T1200-EXIT. DTSBD540 02044 EXIT. DTSBD540 02045 EJECT DTSBD540 02046 S1000-REFORMAT-ADDRESS. DTSBD540 02047 SET ADR-VALID-ADDRESS-YES-88 TO TRUE. DTSBD540 02048 DTSBD540 02049 DTSBD540 02050 IF MTAD-PHYSICAL-ADDRESS-YES-88 DTSBD540 02051 SET ADR-PHYSICAL-ADDRESS-YES-88 TO TRUE DTSBD540 02052 ELSE DTSBD540 02053 SET ADR-PHYSICAL-ADDRESS-NO-88 TO TRUE. DTSBD540 02054 DTSBD540 02055 DTSBD540 02056 MOVE SPACES TO ADR-ES202-ADDRESS. DTSBD540 02057 DTSBD540 02058 DTSBD540 02059 IF MTAD-ATTN-LINE = LOW-VALUES OR SPACES DTSBD540 02060 NEXT SENTENCE DTSBD540 02061 ELSE DTSBD540 02062 MOVE MTAD-ATTN-LINE TO ADR-ATTENTION-NAME. DTSBD540 02063 DTSBD540 02064 DTSBD540 02065 IF MTAD-DELIV-LINE-2 = LOW-VALUES OR SPACES DTSBD540 02066 NEXT SENTENCE DTSBD540 02067 ELSE DTSBD540 02068 MOVE MTAD-DELIV-LINE-2 TO ADR-ADDRESS. DTSBD540 02069 DTSBD540 02070 DTSBD540 02071 IF MTAD-DELIV-LINE-1 = LOW-VALUES OR SPACES DTSBD540 02072 NEXT SENTENCE DTSBD540 02073 ELSE DTSBD540 02074 IF ADR-ADDRESS = SPACES DTSBD540 02075 MOVE MTAD-DELIV-LINE-1 TO ADR-ADDRESS DTSBD540 02076 ELSE DTSBD540 02077 MOVE MTAD-DELIV-LINE-1 TO ADR-ADDRESS2. DTSBD540 02078 DTSBD540 02079 DTSBD540 02080 IF (MTAD-DELIV-LINE-1 (36:5) = LOW-VALUES OR SPACES) DTSBD540 02081 AND DTSBD540 02082 (MTAD-DELIV-LINE-2 (36:5) = LOW-VALUES OR SPACES) DTSBD540 02083 NEXT SENTENCE DTSBD540 02084 ELSE DTSBD540 02085 IF MTAD-ID-TAX-MAILING-ADDR-88 DTSBD540 02086 MOVE MSG02-ID TO R907-MSG-ID DTSBD540 02087 MOVE MSG02-TEXT TO R907-MSG-TEXT DTSBD540 02088 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD540 02089 ELSE DTSBD540 02090 MOVE MSG01-ID TO R907-MSG-ID DTSBD540 02091 MOVE MSG01-TEXT TO R907-MSG-TEXT DTSBD540 02092 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBD540 02093 DTSBD540 02094 DTSBD540 02095 MOVE MTAD-ST TO C072-ST. DTSBD540 02096 DTSBD540 02097 DTSBD540 02098 IF C072-FOREIGN-88 DTSBD540 02099 PERFORM S1100-FOREIGN THRU S1100-EXIT DTSBD540 02100 ELSE DTSBD540 02101 IF C072-CANADA-88 DTSBD540 02102 PERFORM S1200-CANADIAN THRU S1200-EXIT DTSBD540 02103 ELSE DTSBD540 02104 PERFORM S1300-DOMESTIC THRU S1300-EXIT. DTSBD540 02105 DTSBD540 02106 DTSBD540 02107 IF ADR-PHYSICAL-ADDRESS-YES-88 DTSBD540 02108 PERFORM S1400-CONFIRM-PHYSICAL-ADDRESS THRU S1400-EXIT. DTSBD540 02109 S1000-EXIT. DTSBD540 02110 EXIT. DTSBD540 02111 DTSBD540 02112 DTSBD540 02113 DTSBD540 02114 S1100-FOREIGN. DTSBD540 02115 IF ADR-ADDRESS2 = SPACES DTSBD540 02116 MOVE MTAD-CITY TO ADR-CITY DTSBD540 02117 ELSE DTSBD540 02118 MOVE SPACES TO ADR-CITY DTSBD540 02119 STRING DTSBD540 02120 ADR-ADDRESS DELIMITED BY ' ' DTSBD540 02121 ' ' DELIMITED BY SIZE DTSBD540 02122 MTAD-CITY DELIMITED BY ' ' DTSBD540 02123 INTO DTSBD540 02124 ADR-CITY DTSBD540 02125 MOVE ADR-ADDRESS2 TO ADR-ADDRESS DTSBD540 02126 MOVE SPACES TO ADR-ADDRESS2. DTSBD540 02127 DTSBD540 02128 MOVE 'ZZ' TO ADR-STATE. DTSBD540 02129 S1100-EXIT. DTSBD540 02130 EXIT. DTSBD540 02131 DTSBD540 02132 DTSBD540 02133 DTSBD540 02134 S1200-CANADIAN. DTSBD540 02135 MOVE SPACES TO ADR-CITY. DTSBD540 02136 DTSBD540 02137 STRING DTSBD540 02138 MTAD-CITY DELIMITED BY ' ' DTSBD540 02139 ' ' DELIMITED BY SIZE DTSBD540 02140 'CANADA' DELIMITED BY SIZE DTSBD540 02141 INTO DTSBD540 02142 ADR-CITY. DTSBD540 02143 DTSBD540 02144 IF MTAD-ZIP (4:1) = SPACES DTSBD540 02145 MOVE MTAD-ZIP (1:3) TO ADR-ZIP (1:3) DTSBD540 02146 MOVE MTAD-ZIP (5:3) TO ADR-ZIP (4:3) DTSBD540 02147 ELSE DTSBD540 02148 MOVE MTAD-ZIP TO ADR-ZIP. DTSBD540 02149 S1200-EXIT. DTSBD540 02150 EXIT. DTSBD540 02151 DTSBD540 02152 DTSBD540 02153 DTSBD540 02154 S1300-DOMESTIC. DTSBD540 02155 MOVE MTAD-CITY TO ADR-CITY. DTSBD540 02156 DTSBD540 02157 MOVE MTAD-ST TO ADR-STATE. DTSBD540 02158 DTSBD540 02159 MOVE MTAD-ZIP (1:5) TO ADR-ZIP-5. DTSBD540 02160 DTSBD540 02161 IF MTAD-ZIP (7:4) NUMERIC DTSBD540 02162 MOVE MTAD-ZIP (7:4) TO ADR-ZIP-4. DTSBD540 02163 S1300-EXIT. DTSBD540 02164 EXIT. DTSBD540 02165 DTSBD540 02166 DTSBD540 02167 DTSBD540 02168 S1400-CONFIRM-PHYSICAL-ADDRESS. DTSBD540 02169 IF MTAD-ST NOT = 'DC' DTSBD540 02170 SET ADR-PHYSICAL-ADDRESS-NO-88 TO TRUE DTSBD540 02171 GO TO S1400-EXIT. DTSBD540 02172 DTSBD540 02173 DTSBD540 02174 IF (ADR-ADDRESS (1:5) = 'P. O.' OR 'POBOX') DTSBD540 02175 OR DTSBD540 02176 (ADR-ADDRESS (1:4) = 'P O' OR 'P.O.' OR 'P O ') DTSBD540 02177 OR DTSBD540 02178 (ADR-ADDRESS (1:3) = 'P.O' OR 'BOX' OR 'R R' OR 'RR ' DTSBD540 02179 OR 'RTE' OR 'PO ') DTSBD540 02180 OR DTSBD540 02181 (ADR-ADDRESS (1:1) = '%') DTSBD540 02182 SET ADR-PHYSICAL-ADDRESS-NO-88 TO TRUE. DTSBD540 02183 S1400-EXIT. DTSBD540 02184 EXIT. DTSBD540 02185 EJECT DTSBD540 02186 S2000-REFORMAT-PHONE-NUMBER. DTSBD540 02187 SET PHONE-NUMBER-VALID-NO-88 TO TRUE. DTSBD540 02188 DTSBD540 02189 * MOVE LOW-VALUES TO PHONE-OUT-PHONE-NUM. DTSBD540 02190 MOVE ZEROS TO PHONE-OUT-PHONE-NUM. DTSBD540 02191 MOVE SPACES TO PHONE-OUT-EXT. DTSBD540 02192 DTSBD540 02193 DTSBD540 02194 IF (PHONE-IN-AREA-CD NUMERIC) DTSBD540 02195 AND DTSBD540 02196 (PHONE-IN-PREFIX NUMERIC) DTSBD540 02197 AND DTSBD540 02198 (PHONE-IN-SUFFIX NUMERIC) DTSBD540 02199 NEXT SENTENCE DTSBD540 02200 ELSE DTSBD540 02201 GO TO S2000-EXIT. DTSBD540 02202 DTSBD540 02203 DTSBD540 02204 SET PHONE-NUMBER-VALID-YES-88 TO TRUE. DTSBD540 02205 DTSBD540 02206 DTSBD540 02207 MOVE PHONE-IN-AREA TO PHONE-OUT-PHONE-NUM. DTSBD540 02208 DTSBD540 02209 IF PHONE-IN-EXT = SPACES OR LOW-VALUES DTSBD540 02210 NEXT SENTENCE DTSBD540 02211 ELSE DTSBD540 02212 MOVE PHONE-IN-EXT TO PHONE-OUT-EXT. DTSBD540 02213 S2000-EXIT. DTSBD540 02214 EXIT. DTSBD540 02215 EJECT DTSBD540 02216 S001-FROM-CAL-6. DTSBD540 02217 SET L001-FROM-CAL-6 TO TRUE. DTSBD540 02218 GO TO S001-DATE. DTSBD540 02219 DTSBD540 02220 S001-FROM-CAL-8. DTSBD540 02221 SET L001-FROM-CAL-8 TO TRUE. DTSBD540 02222 GO TO S001-DATE. DTSBD540 02223 DTSBD540 02224 S001-FROM-FED-6. DTSBD540 02225 SET L001-FROM-FED-6 TO TRUE. DTSBD540 02226 GO TO S001-DATE. DTSBD540 02227 DTSBD540 02228 S001-FROM-FED-8. DTSBD540 02229 SET L001-FROM-FED-8 TO TRUE. DTSBD540 02230 GO TO S001-DATE. DTSBD540 02231 DTSBD540 02232 S001-DATE. DTSBD540 02233 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD540 02234 S001-EXIT. DTSBD540 02235 EXIT. DTSBD540 02236 DTSBD540 02237 DTSBD540 02238 DTSBD540 02239 S004-FROM-3. DTSBD540 02240 SET L004-FROM-3 TO TRUE. DTSBD540 02241 GO TO S004-YRQ. DTSBD540 02242 DTSBD540 02243 S004-FROM-5. DTSBD540 02244 SET L004-FROM-5 TO TRUE. DTSBD540 02245 GO TO S004-YRQ. DTSBD540 02246 DTSBD540 02247 S004-FROM-ABS. DTSBD540 02248 SET L004-FROM-ABS TO TRUE. DTSBD540 02249 GO TO S004-YRQ. DTSBD540 02250 DTSBD540 02251 S004-YRQ. DTSBD540 02252 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD540 02253 S004-EXIT. DTSBD540 02254 EXIT. DTSBD540 02255 DTSBD540 02256 DTSBD540 02257 DTSBD540 02258 S005-FROM-SYS. DTSBD540 02259 SET L005-FROM-SYS TO TRUE. DTSBD540 02260 GO TO S005-ABSOLUTE-TIME. DTSBD540 02261 DTSBD540 02262 S005-FROM-DATE-TIME. DTSBD540 02263 SET L005-FROM-DATE-TIME TO TRUE. DTSBD540 02264 GO TO S005-ABSOLUTE-TIME. DTSBD540 02265 DTSBD540 02266 S005-ABSOLUTE-TIME. DTSBD540 02267 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD540 02268 S005-EXIT. DTSBD540 02269 EXIT. DTSBD540 02270 DTSBD540 02271 DTSBD540 02272 DTSBD540 02273 S006-FROM-QTR. DTSBD540 02274 SET L006-FROM-QTR TO TRUE. DTSBD540 02275 GO TO S006-RATE-YEAR. DTSBD540 02276 DTSBD540 02277 S006-RATE-YEAR. DTSBD540 02278 CALL 'DTSBU006' USING L006-LINK-AREA. DTSBD540 02279 S006-EXIT. DTSBD540 02280 EXIT. DTSBD540 02281 DTSBD540 02282 DTSBD540 02283 DTSBD540 02284 S064-LOOKUP-FLD-ADDRESS. DTSBD540 02285 CALL 'DTSBU064' USING L064-LINK-AREA. DTSBD540 02286 S064-EXIT. DTSBD540 02287 EXIT. DTSBD540 02288 DTSBD540 02289 DTSBD540 02290 DTSBD540 02291 S910-OPEN-READ. DTSBD540 02292 SET L910-OPEN-READ-88 TO TRUE. DTSBD540 02293 GO TO S910-MSTR-I. DTSBD540 02294 DTSBD540 02295 S910-READ. DTSBD540 02296 SET L910-READ-88 TO TRUE. DTSBD540 02297 GO TO S910-MSTR-I. DTSBD540 02298 DTSBD540 02299 S910-START-BROWSE. DTSBD540 02300 SET L910-START-BROWSE-88 TO TRUE. DTSBD540 02301 GO TO S910-MSTR-I. DTSBD540 02302 DTSBD540 02303 S910-READ-NEXT. DTSBD540 02304 SET L910-READ-NEXT-88 TO TRUE. DTSBD540 02305 GO TO S910-MSTR-I. DTSBD540 02306 DTSBD540 02307 S910-CLOSE. DTSBD540 02308 SET L910-CLOSE-88 TO TRUE. DTSBD540 02309 GO TO S910-MSTR-I. DTSBD540 02310 DTSBD540 02311 S910-MSTR-I. DTSBD540 02312 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD540 02313 MSKL-REC. DTSBD540 02314 S910-EXIT. DTSBD540 02315 EXIT. DTSBD540 02316 DTSBD540 02317 DTSBD540 02318 DTSBD540 02319 S921-OPEN-READ. DTSBD540 02320 SET L921-OPEN-READ-88 TO TRUE. DTSBD540 02321 GO TO S921-AIX-I. DTSBD540 02322 DTSBD540 02323 S921-START-BROWSE. DTSBD540 02324 SET L921-START-BROWSE-88 TO TRUE. DTSBD540 02325 GO TO S921-AIX-I. DTSBD540 02326 DTSBD540 02327 S921-READ-NEXT. DTSBD540 02328 SET L921-READ-NEXT-88 TO TRUE. DTSBD540 02329 GO TO S921-AIX-I. DTSBD540 02330 DTSBD540 02331 S921-CLOSE. DTSBD540 02332 SET L921-CLOSE-88 TO TRUE. DTSBD540 02333 GO TO S921-AIX-I. DTSBD540 02334 DTSBD540 02335 S921-AIX-I. DTSBD540 02336 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD540 02337 ISKL-REC. DTSBD540 02338 S921-EXIT. DTSBD540 02339 EXIT. DTSBD540 02340 DTSBD540 02341 DTSBD540 02342 DTSBD540 02343 S946-WRITE-R907. DTSBD540 02344 CALL 'DTSBU946' USING R907-REC. DTSBD540 02345 GO TO S946-EXIT. DTSBD540 02346 DTSBD540 02347 S946-EXIT. DTSBD540 02348 EXIT. DTSBD540 02349 DTSBD540 02350 DTSBD540 02351 DTSBD540 02352 S999-ABEND. DTSBD540 02353 DISPLAY ' '. DTSBD540 02354 DTSBD540 02355 DISPLAY '*** ' DTSBD540 02356 WRK-MODULE-NAME DTSBD540 02357 ' IS ABENDING BECAUSE: ' DTSBD540 02358 WRK-ABEND-MSG. DTSBD540 02359 DTSBD540 02360 DISPLAY ' '. DTSBD540 02361 DTSBD540 02362 CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBD540 02363 S999-EXIT. DTSBD540 02364 EXIT. DTSBD540