DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
510
Batch/DTSBX771.cob
Normal file
510
Batch/DTSBX771.cob
Normal file
@ -0,0 +1,510 @@
|
||||
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
|
||||
Reference in New Issue
Block a user