00001 IDENTIFICATION DIVISION. 02/01/04 00002 PROGRAM-ID. DTSBX771. DTSBX771 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX771 00005 DATE-COMPILED. DTSBX771 00006 SKIP3 DTSBX771 00007 ***** DTSBX771 00008 * DTSBX771 00009 * DTSBX771 00010 * FUNCTION: BUILD ACTIVE EMPLOYER RECONSTRUCTION FILE DTSBX771 00011 * RECORDS FOR ETA581 DATA VALIDATION SYSTEM. DTSBX771 00012 * DTSBX771 00013 * DTSBX771 00014 * MODIFICATION LOG: DTSBX771 00015 * DTSBX771 00016 * 11/28/2002 INITIAL DEVELOPMENT. DTSBX771 00017 * REFERENCE: DATA VALIDATION PROGRAMMER: GD DTSBX771 00018 * DTSBX771 00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX771 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX771 00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX771 00022 * DTSBX771 00023 * DTSBX771 00024 * DESCRIPTION: DTSBX771 00025 * DTSBX771 00026 * DTSBX771 00027 * INITIATION: DTSBX771 00028 * DTSBX771 00029 * OPEN DTSX771 DTSBX771 00030 * DTSBX771 00031 * DTSBX771 00032 * PROCESSING: DTSBX771 00033 * DTSBX771 00034 * BUILD POPULATION 1 RECONSTRUCTION FILE RECORD (DTSIX771) DTSBX771 00035 * FROM DTSIY771 INPUT RECORD. DTSBX771 00036 * DTSBX771 00037 * TERMINATION: DTSBX771 00038 * DTSBX771 00039 * CLOSE DTSX771 DTSBX771 00040 * DTSBX771 00041 * RECORDS READ: DTSBX771 00042 * DTSBX771 00043 * MASTER: DTSBX771 00044 * DTSBX771 00045 * NONE DTSBX771 00046 * DTSBX771 00047 * DTSBX771 00048 * ALTERNATE INDEX: DTSBX771 00049 * DTSBX771 00050 * NONE. DTSBX771 00051 * DTSBX771 00052 * DTSBX771 00053 * REFERENCE: DTSBX771 00054 * DTSBX771 00055 * DTSBX771 00056 * DTSBX771 00057 * RECORDS UPDATED: DTSBX771 00058 * DTSBX771 00059 * NONE DTSBX771 00060 * DTSBX771 00061 * DTSBX771 00062 * OUTPUT RECORDS WRITTEN: DTSBX771 00063 * DTSBX771 00064 * DTSIX771 POPULATION 1 DOWNLOAD DTSBX771 00065 * DTSBX771 00066 * DTSBX771 00067 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX771 00068 * DTSBX771 00069 * NONE. DTSBX771 00070 * DTSBX771 00071 * DTSBX771 00072 * MODULES CALLED: DTSBX771 00073 * DTSBX771 00074 * DTSBU001 DATE EDIT/CONVERSION. DTSBX771 00075 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX771 00076 * DTSBU910 MASTER FILE I/O. DTSBX771 00077 * DTSBX771 00078 * DTSBX771 00079 * DTSBX771 00080 ***** DTSBX771 00081 SKIP3 DTSBX771 00082 ENVIRONMENT DIVISION. DTSBX771 00083 INPUT-OUTPUT SECTION. DTSBX771 00084 FILE-CONTROL. DTSBX771 00085 SELECT ACTIVE-EMPLOYERS ASSIGN TO DTSX771 DTSBX771 00086 FILE STATUS IS BX771-STATUS. DTSBX771 00087 EJECT DTSBX771 00088 DATA DIVISION. DTSBX771 00089 FILE SECTION. DTSBX771 00090 FD ACTIVE-EMPLOYERS DTSBX771 00091 RECORDING MODE IS F DTSBX771 00092 LABEL RECORDS ARE STANDARD DTSBX771 00093 BLOCK CONTAINS 0 RECORDS. DTSBX771 00094 01 ACTIVE-EMPLOYERS-REC PIC X(235). DTSBX771 00095 SKIP3 DTSBX771 00096 WORKING-STORAGE SECTION. DTSBX771 000965 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX771 02/01/04'. DTSBX771 00097 SKIP3 DTSBX771 00098 01 WRK-AREA. DTSBX771 00099 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +771.DTSBX771 00100 DTSBX771 00101 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX771'.DTSBX771 00102 DTSBX771 00103 05 ABEND-MSG PIC X(60). DTSBX771 00104 DTSBX771 00105 05 BX771-STATUS PIC X(02) VALUE SPACES. DTSBX771 00106 88 BX771-STATUS-OK-88 VALUE ZEROS. DTSBX771 00107 SKIP3 DTSBX771 00108 05 WRK-PARM-SUBJECT-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBX771 00109 DTSBX771 00110 05 WRK-OBS-NBR PIC S9(07) COMP-3 VALUE +0. DTSBX771 00111 DTSBX771 00112 05 WRK-STATUS-AREA. DTSBX771 00113 10 WRK-DV-STATUS PIC X(01). DTSBX771 00114 88 WRK-DV-STATUS-ACTIVE-88 VALUE 'A'. DTSBX771 00115 10 FILLER PIC X(01) VALUE '-'. DTSBX771 00116 10 WRK-MPRF-STATUS PIC X(01). DTSBX771 00117 88 WRK-MPRF-STATUS-ACTIVE-88 VALUE 'A'. DTSBX771 00118 10 FILLER PIC X(21) VALUE SPACES. DTSBX771 00119 05 WRK-STATUS REDEFINES WRK-STATUS-AREA DTSBX771 00120 PIC X(24). DTSBX771 00121 DTSBX771 00122 05 WRK-EMP-CLASS-AREA. DTSBX771 00123 10 WRK-DV-EMP-CLASS PIC X(01). DTSBX771 00124 88 WRK-DV-EMP-CLASS-CONTRIB-88 VALUE 'C'. DTSBX771 00125 88 WRK-DV-EMP-CLASS-REIMB-88 VALUE 'R'. DTSBX771 00126 10 FILLER PIC X(01) VALUE '-'. DTSBX771 00127 10 WRK-MPRF-EMP-CLASS PIC X(01). DTSBX771 00128 10 FILLER PIC X(21) VALUE SPACES. DTSBX771 00129 05 WRK-EMP-CLASS REDEFINES WRK-EMP-CLASS-AREA DTSBX771 00130 PIC X(24). DTSBX771 00131 DTSBX771 00132 05 WRK-RECS-WRITTEN-CNT PIC S9(07) COMP-3 DTSBX771 00133 VALUE +0. DTSBX771 00134 05 WRK-CON-EMP-CNT PIC S9(07) COMP-3 DTSBX771 00135 VALUE +0. DTSBX771 00136 05 WRK-REIMB-EMP-CNT PIC S9(07) COMP-3 DTSBX771 00137 VALUE +0. DTSBX771 00138 05 DISPLAY-CNT PIC Z(06)9. DTSBX771 00139 DTSBX771 00140 05 DISPLAY-AMT-X PIC X(15). DTSBX771 00141 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX771 00142 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX771 00143 DTSBX771 00144 01 WRK-LEN PIC S9(04) COMP VALUE +235. DTSBX771 00145 01 WRK-REC-AREA PIC X(235). DTSBX771 00146 DTSBX771 00147 01 X771-DATA-AREA. DTSBX771 00148 ++INCLUDE DTSIX771 DTSBX771 00149 05 X771-REC1-FILLER PIC X(21) VALUE SPACES. DTSBX771 00150 05 X771-REC2-FILLER PIC X(11) VALUE SPACES. DTSBX771 00151 05 X771-REC3-FILLER PIC X(11) VALUE SPACES. DTSBX771 00152 05 X771-REC4-FILLER PIC X(01) VALUE SPACES. DTSBX771 00153 EJECT DTSBX771 00154 01 L001-LINK-AREA. DTSBX771 00155 ++INCLUDE DTSIL001 DTSBX771 00156 EJECT DTSBX771 00157 01 L004-LINK-AREA. DTSBX771 00158 ++INCLUDE DTSIL004 DTSBX771 00159 EJECT DTSBX771 00160 01 Y771-REC. DTSBX771 00161 ++INCLUDE DTSIY771 DTSBX771 00162 EJECT DTSBX771 00163 LINKAGE SECTION. DTSBX771 00164 SKIP3 DTSBX771 00165 01 XL771-LINK-AREA. DTSBX771 00166 ++INCLUDE DTSXL771 DTSBX771 00167 DTSBX771 00168 01 L770-PARM-REC. DTSBX771 00169 ++INCLUDE DTSIX770 DTSBX771 00170 DTSBX771 00171 01 RSKL-REC. DTSBX771 00172 ++INCLUDE DTSIRSK1 DTSBX771 00173 DTSBX771 00174 PROCEDURE DIVISION USING XL771-LINK-AREA DTSBX771 00175 L770-PARM-REC DTSBX771 00176 RSKL-REC. DTSBX771 00177 DTSBX771 00178 IF XL771-CMD-PROCESS-88 DTSBX771 00179 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX771 00180 ELSE DTSBX771 00181 IF XL771-CMD-INIT-88 DTSBX771 00182 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX771 00183 ELSE DTSBX771 00184 IF XL771-CMD-TERMINATE-88 DTSBX771 00185 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX771 00186 ELSE DTSBX771 00187 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBX771 00188 TO ABEND-MSG DTSBX771 00189 PERFORM S999-ABEND THRU S999-EXIT. DTSBX771 00190 SKIP2 DTSBX771 00191 GOBACK. DTSBX771 00192 EJECT DTSBX771 00193 I0000-INITIALIZE. DTSBX771 00194 OPEN OUTPUT ACTIVE-EMPLOYERS DTSBX771 00195 IF NOT BX771-STATUS-OK-88 DTSBX771 00196 DISPLAY 'FILE STATUS IS : ' BX771-STATUS DTSBX771 00197 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX771 00198 PERFORM S999-ABEND THRU S999-EXIT. DTSBX771 00199 DTSBX771 00200 MOVE ZERO TO XL771-CON-EMP-CNT DTSBX771 00201 XL771-REIMB-EMP-CNT DTSBX771 00202 XL771-TOT-EMP-CNT. DTSBX771 00203 I0000-EXIT. DTSBX771 00204 EXIT. DTSBX771 00205 EJECT DTSBX771 00206 P0000-PROCESS. DTSBX771 00207 MOVE RSKL-REC TO Y771-REC. DTSBX771 00208 PERFORM P1000-WRITE-OUTPUT THRU P1000-EXIT. DTSBX771 00209 DTSBX771 00210 P0000-EXIT. DTSBX771 00211 EXIT. DTSBX771 00212 DTSBX771 00213 P1000-WRITE-OUTPUT. DTSBX771 00214 ADD +1 TO WRK-OBS-NBR. DTSBX771 00215 ADD +1 TO WRK-RECS-WRITTEN-CNT. DTSBX771 00216 DTSBX771 00217 MOVE Y771-EMP-NO TO X771-EMP-NO. DTSBX771 00218 MOVE WRK-OBS-NBR TO X771-OBS-NBR. DTSBX771 00219 SET WRK-DV-STATUS-ACTIVE-88 TO TRUE. DTSBX771 00220 SET WRK-MPRF-STATUS-ACTIVE-88 TO TRUE. DTSBX771 00221 MOVE WRK-STATUS-AREA TO X771-EMP-STATUS. DTSBX771 00222 DTSBX771 00223 IF Y771-CLASS-RATED-88 DTSBX771 00224 SET WRK-DV-EMP-CLASS-CONTRIB-88 TO TRUE DTSBX771 00225 ADD +1 TO WRK-CON-EMP-CNT DTSBX771 00226 ELSE DTSBX771 00227 IF Y771-CLASS-SELF-INS-88 DTSBX771 00228 SET WRK-DV-EMP-CLASS-REIMB-88 TO TRUE DTSBX771 00229 ADD +1 TO WRK-REIMB-EMP-CNT DTSBX771 00230 ELSE DTSBX771 00231 DISPLAY 'INVALID EMPLOYER CLASS ' Y771-EMP-NO DTSBX771 00232 ' CLASS: ' Y771-EMP-CLASS DTSBX771 00233 GO TO P1000-EXIT. DTSBX771 00234 DTSBX771 00235 MOVE Y771-EMP-CLASS TO WRK-MPRF-EMP-CLASS. DTSBX771 00236 MOVE WRK-EMP-CLASS-AREA TO X771-EMP-TYPE. DTSBX771 00237 DTSBX771 00238 MOVE Y771-LIAB-DATE TO L001-FED-8-DATE-9. DTSBX771 00239 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX771 00240 MOVE L001-SLASH-8-DATE TO X771-LIAB-DATE. DTSBX771 00241 DTSBX771 00242 IF Y771-REOPEN-PROCESS-DATE = ZERO DTSBX771 00243 MOVE SPACES TO X771-REOPEN-PROCESS-DATE DTSBX771 00244 ELSE DTSBX771 00245 MOVE Y771-REOPEN-PROCESS-DATE DTSBX771 00246 TO L001-FED-8-DATE-9 DTSBX771 00247 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX771 00248 MOVE L001-SLASH-8-DATE TO X771-REOPEN-PROCESS-DATE. DTSBX771 00249 DTSBX771 00250 IF Y771-INACTIVE-DATE = ZERO DTSBX771 00251 MOVE SPACES TO X771-INACTIVE-DATE DTSBX771 00252 ELSE DTSBX771 00253 MOVE Y771-INACTIVE-DATE TO L001-FED-8-DATE-9 DTSBX771 00254 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX771 00255 MOVE L001-SLASH-8-DATE TO X771-INACTIVE-DATE. DTSBX771 00256 DTSBX771 00257 MOVE Y771-PROCESS-DATE TO L001-FED-8-DATE-9. DTSBX771 00258 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX771 00259 MOVE L001-SLASH-8-DATE TO X771-PROCESS-DATE. DTSBX771 00260 DTSBX771 00261 MOVE Y771-LIAB-QTR-CNT TO X771-LIAB-QTR-CNT. DTSBX771 00262 DTSBX771 00263 MOVE Y771-QTR1-WAGES TO X771-QTR1-WAGES. DTSBX771 00264 MOVE Y771-QTR2-WAGES TO X771-QTR2-WAGES. DTSBX771 00265 MOVE Y771-QTR3-WAGES TO X771-QTR3-WAGES. DTSBX771 00266 MOVE Y771-QTR4-WAGES TO X771-QTR4-WAGES. DTSBX771 00267 MOVE Y771-QTR5-WAGES TO X771-QTR5-WAGES. DTSBX771 00268 MOVE Y771-QTR6-WAGES TO X771-QTR6-WAGES. DTSBX771 00269 MOVE Y771-QTR7-WAGES TO X771-QTR7-WAGES. DTSBX771 00270 MOVE Y771-QTR8-WAGES TO X771-QTR8-WAGES. DTSBX771 00271 DTSBX771 00272 IF X771-REOPEN-PROCESS-DATE = SPACES DTSBX771 00273 IF X771-INACTIVE-DATE = SPACES DTSBX771 00274 PERFORM P1100-WRITE-REC1 THRU P1100-EXIT DTSBX771 00275 ELSE DTSBX771 00276 PERFORM P1200-WRITE-REC2 THRU P1200-EXIT DTSBX771 00277 END-IF DTSBX771 00278 ELSE DTSBX771 00279 IF X771-INACTIVE-DATE = SPACES DTSBX771 00280 PERFORM P1300-WRITE-REC3 THRU P1300-EXIT DTSBX771 00281 ELSE DTSBX771 00282 PERFORM P1400-WRITE-REC4 THRU P1400-EXIT DTSBX771 00283 END-IF DTSBX771 00284 END-IF. DTSBX771 00285 DTSBX771 00286 IF NOT BX771-STATUS-OK-88 DTSBX771 00287 DISPLAY 'FILE STATUS IS : ' BX771-STATUS DTSBX771 00288 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX771 00289 PERFORM S999-ABEND THRU S999-EXIT. DTSBX771 00290 DTSBX771 00291 DTSBX771 00292 P1000-EXIT. DTSBX771 00293 EXIT. DTSBX771 00294 DTSBX771 00295 P1100-WRITE-REC1. DTSBX771 00296 MOVE SPACES TO WRK-REC-AREA. DTSBX771 00297 DTSBX771 00298 STRING DTSBX771 00299 X771-OBS-NBR ',' DTSBX771 00300 X771-EMP-NO ',' DTSBX771 00301 X771-EMP-STATUS ',' DTSBX771 00302 X771-EMP-TYPE ',' DTSBX771 00303 X771-LIAB-DATE ',' ',' ',' DTSBX771 00304 X771-PROCESS-DATE ',' DTSBX771 00305 X771-LIAB-QTR-CNT ',' DTSBX771 00306 X771-QTR1-WAGES ',' DTSBX771 00307 X771-QTR2-WAGES ',' DTSBX771 00308 X771-QTR3-WAGES ',' DTSBX771 00309 X771-QTR4-WAGES ',' DTSBX771 00310 X771-QTR5-WAGES ',' DTSBX771 00311 X771-QTR6-WAGES ',' DTSBX771 00312 X771-QTR7-WAGES ',' DTSBX771 00313 X771-QTR8-WAGES ',' DTSBX771 00314 X771-REC1-FILLER DTSBX771 00315 DELIMITED BY SIZE DTSBX771 00316 INTO WRK-REC-AREA DTSBX771 00317 END-STRING. DTSBX771 00318 DTSBX771 00319 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX771 00320 ACTIVE-EMPLOYERS-REC (1:WRK-LEN). DTSBX771 00321 DTSBX771 00322 WRITE ACTIVE-EMPLOYERS-REC. DTSBX771 00323 DTSBX771 00324 P1100-EXIT. DTSBX771 00325 EXIT. DTSBX771 00326 DTSBX771 00327 P1200-WRITE-REC2. DTSBX771 00328 MOVE SPACES TO WRK-REC-AREA. DTSBX771 00329 DTSBX771 00330 STRING DTSBX771 00331 X771-OBS-NBR ',' DTSBX771 00332 X771-EMP-NO ',' DTSBX771 00333 X771-EMP-STATUS ',' DTSBX771 00334 X771-EMP-TYPE ',' DTSBX771 00335 X771-LIAB-DATE ',' ',' DTSBX771 00336 X771-INACTIVE-DATE ',' DTSBX771 00337 X771-PROCESS-DATE ',' DTSBX771 00338 X771-LIAB-QTR-CNT ',' DTSBX771 00339 X771-QTR1-WAGES ',' DTSBX771 00340 X771-QTR2-WAGES ',' DTSBX771 00341 X771-QTR3-WAGES ',' DTSBX771 00342 X771-QTR4-WAGES ',' DTSBX771 00343 X771-QTR5-WAGES ',' DTSBX771 00344 X771-QTR6-WAGES ',' DTSBX771 00345 X771-QTR7-WAGES ',' DTSBX771 00346 X771-QTR8-WAGES ',' DTSBX771 00347 X771-REC2-FILLER DTSBX771 00348 DELIMITED BY SIZE DTSBX771 00349 INTO WRK-REC-AREA DTSBX771 00350 END-STRING. DTSBX771 00351 DTSBX771 00352 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX771 00353 ACTIVE-EMPLOYERS-REC (1:WRK-LEN). DTSBX771 00354 DTSBX771 00355 WRITE ACTIVE-EMPLOYERS-REC. DTSBX771 00356 DTSBX771 00357 P1200-EXIT. DTSBX771 00358 EXIT. DTSBX771 00359 DTSBX771 00360 P1300-WRITE-REC3. DTSBX771 00361 MOVE SPACES TO WRK-REC-AREA. DTSBX771 00362 DTSBX771 00363 STRING DTSBX771 00364 X771-OBS-NBR ',' DTSBX771 00365 X771-EMP-NO ',' DTSBX771 00366 X771-EMP-STATUS ',' DTSBX771 00367 X771-EMP-TYPE ',' DTSBX771 00368 X771-LIAB-DATE ',' DTSBX771 00369 X771-REOPEN-PROCESS-DATE ',' ',' DTSBX771 00370 X771-PROCESS-DATE ',' DTSBX771 00371 X771-LIAB-QTR-CNT ',' DTSBX771 00372 X771-QTR1-WAGES ',' DTSBX771 00373 X771-QTR2-WAGES ',' DTSBX771 00374 X771-QTR3-WAGES ',' DTSBX771 00375 X771-QTR4-WAGES ',' DTSBX771 00376 X771-QTR5-WAGES ',' DTSBX771 00377 X771-QTR6-WAGES ',' DTSBX771 00378 X771-QTR7-WAGES ',' DTSBX771 00379 X771-QTR8-WAGES ',' DTSBX771 00380 X771-REC3-FILLER DTSBX771 00381 DELIMITED BY SIZE DTSBX771 00382 INTO WRK-REC-AREA DTSBX771 00383 END-STRING. DTSBX771 00384 DTSBX771 00385 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX771 00386 ACTIVE-EMPLOYERS-REC (1:WRK-LEN). DTSBX771 00387 DTSBX771 00388 WRITE ACTIVE-EMPLOYERS-REC. DTSBX771 00389 DTSBX771 00390 P1300-EXIT. DTSBX771 00391 EXIT. DTSBX771 00392 DTSBX771 00393 P1400-WRITE-REC4. DTSBX771 00394 MOVE SPACES TO WRK-REC-AREA. DTSBX771 00395 DTSBX771 00396 STRING DTSBX771 00397 X771-OBS-NBR ',' DTSBX771 00398 X771-EMP-NO ',' DTSBX771 00399 X771-EMP-STATUS ',' DTSBX771 00400 X771-EMP-TYPE ',' DTSBX771 00401 X771-LIAB-DATE ',' DTSBX771 00402 X771-REOPEN-PROCESS-DATE ',' DTSBX771 00403 X771-INACTIVE-DATE ',' DTSBX771 00404 X771-PROCESS-DATE ',' DTSBX771 00405 X771-LIAB-QTR-CNT ',' DTSBX771 00406 X771-QTR1-WAGES ',' DTSBX771 00407 X771-QTR2-WAGES ',' DTSBX771 00408 X771-QTR3-WAGES ',' DTSBX771 00409 X771-QTR4-WAGES ',' DTSBX771 00410 X771-QTR5-WAGES ',' DTSBX771 00411 X771-QTR6-WAGES ',' DTSBX771 00412 X771-QTR7-WAGES ',' DTSBX771 00413 X771-QTR8-WAGES ',' DTSBX771 00414 X771-REC4-FILLER DTSBX771 00415 DELIMITED BY SIZE DTSBX771 00416 INTO WRK-REC-AREA DTSBX771 00417 END-STRING. DTSBX771 00418 DTSBX771 00419 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX771 00420 ACTIVE-EMPLOYERS-REC (1:WRK-LEN). DTSBX771 00421 DTSBX771 00422 WRITE ACTIVE-EMPLOYERS-REC. DTSBX771 00423 DTSBX771 00424 P1400-EXIT. DTSBX771 00425 EXIT. DTSBX771 00426 DTSBX771 00427 T0000-TERMINATE. DTSBX771 00428 PERFORM T1000-UPDATE-LINK THRU T1000-EXIT. DTSBX771 00429 DTSBX771 00430 MOVE WRK-RECS-WRITTEN-CNT TO DISPLAY-CNT. DTSBX771 00431 DTSBX771 00432 DISPLAY '*********************************************'. DTSBX771 00433 DISPLAY ' DTSBX771 TERMINATION STATISTICS '. DTSBX771 00434 DISPLAY '***'. DTSBX771 00435 DISPLAY ' RECORDS WRITTEN ' DISPLAY-CNT. DTSBX771 00436 DTSBX771 00437 MOVE XL771-CON-EMP-CNT TO DISPLAY-CNT. DTSBX771 00438 DISPLAY ' CONTRIBUTORY COUNT ' DISPLAY-CNT. DTSBX771 00439 DTSBX771 00440 MOVE XL771-REIMB-EMP-CNT TO DISPLAY-CNT. DTSBX771 00441 DISPLAY ' REIMBURSABLE COUNT ' DISPLAY-CNT. DTSBX771 00442 DTSBX771 00443 MOVE XL771-TOT-EMP-CNT TO DISPLAY-CNT. DTSBX771 00444 DISPLAY ' TOTAL COUNT ' DISPLAY-CNT. DTSBX771 00445 DTSBX771 00446 DISPLAY '***'. DTSBX771 00447 DISPLAY '*********************************************'. DTSBX771 00448 DTSBX771 00449 CLOSE ACTIVE-EMPLOYERS. DTSBX771 00450 T0000-EXIT. DTSBX771 00451 EXIT. DTSBX771 00452 DTSBX771 00453 T1000-UPDATE-LINK. DTSBX771 00454 MOVE WRK-CON-EMP-CNT TO XL771-CON-EMP-CNT. DTSBX771 00455 MOVE WRK-REIMB-EMP-CNT TO XL771-REIMB-EMP-CNT. DTSBX771 00456 COMPUTE XL771-TOT-EMP-CNT = DTSBX771 00457 (WRK-CON-EMP-CNT + WRK-REIMB-EMP-CNT). DTSBX771 00458 DTSBX771 00459 T1000-EXIT. DTSBX771 00460 EXIT. DTSBX771 00461 DTSBX771 00462 S001-FROM-FED-8. DTSBX771 00463 SET L001-FROM-FED-8 TO TRUE. DTSBX771 00464 GO TO S001-DATE. DTSBX771 00465 DTSBX771 00466 S001-FROM-ABS-DAY. DTSBX771 00467 SET L001-FROM-ABS-DAY TO TRUE. DTSBX771 00468 GO TO S001-DATE. DTSBX771 00469 DTSBX771 00470 S001-FROM-CAL-6. DTSBX771 00471 SET L001-FROM-CAL-6 TO TRUE. DTSBX771 00472 GO TO S001-DATE. DTSBX771 00473 DTSBX771 00474 S001-DATE. DTSBX771 00475 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX771 00476 S001-EXIT. DTSBX771 00477 EXIT. DTSBX771 00478 SKIP3 DTSBX771 00479 S004-FROM-5. DTSBX771 00480 SET L004-FROM-5 TO TRUE. DTSBX771 00481 GO TO S004-QTR. DTSBX771 00482 DTSBX771 00483 S004-FROM-ABS. DTSBX771 00484 SET L004-FROM-ABS TO TRUE. DTSBX771 00485 GO TO S004-QTR. DTSBX771 00486 DTSBX771 00487 S004-FROM-3. DTSBX771 00488 SET L004-FROM-3 TO TRUE. DTSBX771 00489 GO TO S004-QTR. DTSBX771 00490 DTSBX771 00491 S004-FROM-DATE. DTSBX771 00492 SET L004-FROM-DATE TO TRUE. DTSBX771 00493 GO TO S004-QTR. DTSBX771 00494 DTSBX771 00495 S004-QTR. DTSBX771 00496 DTSBX771 00497 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX771 00498 DTSBX771 00499 S004-EXIT. DTSBX771 00500 EXIT. DTSBX771 00501 SKIP3 DTSBX771 00502 DTSBX771 00503 S999-ABEND. DTSBX771 00504 DISPLAY '*** DTSBD771 ABENDING. ' DTSBX771 00505 ABEND-MSG. DTSBX771 00506 DTSBX771 00507 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX771 00508 S999-EXIT. DTSBX771 00509 EXIT. DTSBX771