2366 lines
187 KiB
COBOL
2366 lines
187 KiB
COBOL
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
|