511 lines
40 KiB
COBOL
511 lines
40 KiB
COBOL
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
|