00001 IDENTIFICATION DIVISION. 04/01/25 00002 PROGRAM-ID. DTSBN581. DTSBN581 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV231 00004 DATE-WRITTEN. JUNE 1992. DTSBN581 00005 DATE-COMPILED. DTSBN581 00006 SKIP3 DTSBN581 00007 ***** DTSBN581 00008 * DTSBN581 00009 * FUNCTION: CREATE ASCII FILE FOR UPLOAD TO SUN SYSTEM 581 CL*35 00010 CL**9 00011 * DTSBN581 00012 * MODIFICATION LOG: DTSBN581 00013 * DTSBN581 00014 * 11/29/16 INITIAL DEVELOPMENT. CL*35 00015 * WORK ORDER: ETA581 AUTOMATION PROGRAMMER: NH CL*35 00016 * DTSBN581 00017 * DTSBN581 00018 * DESCRIPTION: DTSBN581 00019 * DTSBN581 00020 * DTSBN581 00021 * DTSBN581 00022 * DTSBN581 00023 * DTSBN581 00024 ***** DTSBN581 00025 SKIP3 DTSBN581 00026 ENVIRONMENT DIVISION. DTSBN581 00027 INPUT-OUTPUT SECTION. CL*61 00028 FILE-CONTROL. CL*39 00029 CL*39 00030 SELECT OUT-FILE ASSIGN TO DTSOZ581 CL*39 00031 FILE STATUS IS Z581-STATUS. CL*39 00032 SKIP2 CL*39 00033 DATA DIVISION. CL*39 00034 FILE SECTION. CL*39 00035 FD OUT-FILE CL*39 00036 RECORDING MODE IS F CL*71 00037 RECORD CONTAINS 79 CHARACTERS. CL*72 00038 CL*45 00039 01 OUT-REC PIC X(79). CL*72 00040 CL*39 00041 WORKING-STORAGE SECTION. DTSBN581 000415 77 PAN-VALET PICTURE X(24) VALUE '231DTSBN581 04/01/25'. DTSBN581 00042 CL*39 00043 77 PAN-VALET PICTURE X(24) VALUE '006DTSBZ931 12/28/99'. DTSBN581 00044 SKIP3 DTSBN581 00045 01 WRK-AREA. DTSBN581 00046 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +931.DTSBN581 00047 DTSBN581 00048 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBN581'. CL*41 00049 CL*43 00050 05 WRK-CHR-NAME PIC X(09). CL*97 00051 05 WRK-INT-NAME PIC 9(09). CL*97 00052 05 WRK-DEC-NAME. DTSBN581 00053 10 WRK-DEC-NAMEA PIC 9(09). CL*63 00054 10 FILLER PIC X VALUE '.'. CL*63 00055 10 WRK-DEC-NAMEB PIC 99. CL*63 00056 CL147 00057 05 WRK-DATE-NAME PIC X(10). CL146 00058 CL147 00059 05 WRK-DATE-NAM. CL147 00060 10 WRK-DT-MTH PIC X(02). CL147 00061 10 FILLER PIC X VALUE '/'. CL147 00062 10 WRK-DT-DAY PIC X(02). CL147 00063 10 FILLER PIC X VALUE '/'. CL147 00064 10 WRK-DT-YEAR PIC X(04). CL147 00065 CL147 00066 05 WRK-YRQ PIC 9(05). CL120 00067 05 Z581-STATUS PIC X(02). CL*40 00068 88 Z581-FILE-OK-88 VALUE '00'. CL*40 00069 CL117 00070 05 WRK-QTR. CL117 00071 10 WRK-MONTH PIC X(05). CL130 00072 10 FILLER PIC X VALUE '/'. CL130 00073 10 WRK-YEAR PIC 9(04). CL117 00074 CL214 00075 05 WS-AUDIT-UNDERRPT-TAX-WAGES PIC 9(11)- VALUE ZERO. CL215 00076 05 WS-AUDIT-UNDERRPT-CONTRIB PIC 9(11)- VALUE ZERO. CL215 00077 05 WS-AUDIT-OVERRPT-TAX-WAGES PIC 9(11)- VALUE ZERO. CL215 00078 05 WS-AUDIT-OVERRPT-CONTRIB PIC 9(11)- VALUE ZERO. CL215 00079 CL215 00080 05 WS-CON-RECVBL-BEG-PERIOD PIC S9(11). CL214 00081 05 WS-CON-RECVBL-DETERM PIC S9(11). CL214 00082 05 WS-CON-RECVBL-LIQUID PIC S9(11). CL214 00083 05 WS-CON-RECVBL-UNCOLLECT PIC S9(11). CL214 00084 05 WS-CON-RECVBL-REMOVED PIC S9(11). CL214 00085 05 WS-CON-RECVBL-END-PERIOD PIC S9(11). CL214 00086 05 WS-CON-RECVBL-6-MOS PIC S9(11). CL214 00087 05 WS-CON-RECVBL-9-MOS PIC S9(11). CL214 00088 05 WS-CON-RECVBL-12-MOS PIC S9(11). CL214 00089 05 WS-CON-RECVBL-15-MOS PIC S9(11). CL214 00090 05 WS-CON-RECVBL-OVER15-MOS PIC S9(11). CL214 00091 SKIP1 CL214 00092 05 WS-REIMB-RECVBL-BEG-PERIOD PIC S9(11). CL214 00093 05 WS-REIMB-RECVBL-DETERM PIC S9(11). CL214 00094 05 WS-REIMB-RECVBL-LIQUID PIC S9(11). CL214 00095 05 WS-REIMB-RECVBL-UNCOLLECT PIC S9(11). CL214 00096 05 WS-REIMB-RECVBL-REMOVED PIC S9(11). CL214 00097 05 WS-REIMB-RECVBL-END-PERIOD PIC S9(11). CL214 00098 05 WS-REIMB-RECVBL-6-MOS PIC S9(11). CL214 00099 05 WS-REIMB-RECVBL-9-MOS PIC S9(11). CL214 00100 05 WS-REIMB-RECVBL-12-MOS PIC S9(11). CL214 00101 05 WS-REIMB-RECVBL-15-MOS PIC S9(11). CL214 00102 05 WS-REIMB-RECVBL-OVER15-MOS PIC S9(11). CL214 00103 SKIP1 CL214 00104 05 WS-AUDIT-TOT-WAGES-PRE PIC S9(11). CL214 00105 05 WS-AUDIT-UNDERRPT-TOT-WAGES PIC S9(11). CL214 00106 05 WS-AUDIT-OVERRPT-TOT-WAGES PIC S9(11). CL214 00107 05 WS-AUDIT-TOT-WAGES-POST PIC S9(11). CL214 00108 EJECT DTSBN581 00109 01 L931-LINK-AREA. DTSBN581 00110 ++INCLUDE DTSIL931 DTSBN581 00111 EJECT DTSBN581 00112 01 MSKL-REC. CL109 00113 ++INCLUDE DTSIMSKL CL109 00114 EJECT CL109 00115 01 FSKL-REC. DTSBN581 00116 ++INCLUDE DTSIFSKL DTSBN581 00117 EJECT DTSBN581 00118 01 F581-REC. CL*99 00119 ++INCLUDE DTSIF581 CL100 00120 EJECT DTSBN581 00121 01 MHDR-REC. CL100 00122 ++INCLUDE DTSIMHDR CL100 00123 EJECT CL*98 00124 01 L910-LINK-AREA. CL114 00125 ++INCLUDE DTSIL910 CL114 00126 EJECT CL114 00127 PROCEDURE DIVISION. DTSBN581 00128 SKIP2 DTSBN581 00129 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBN581 00130 DTSBN581 00131 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBN581 00132 DTSBN581 00133 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBN581 00134 SKIP2 DTSBN581 00135 GOBACK. DTSBN581 00136 EJECT DTSBN581 00137 I0000-INITIATE. DTSBN581 00138 MOVE 'N' TO L931-TRACE-IND. DTSBN581 00139 DTSBN581 00140 MOVE WRK-MOD-NAME TO L931-MOD-NAME. DTSBN581 00141 DTSBN581 00142 OPEN OUTPUT OUT-FILE. CL*60 00143 CL*59 00144 I0000-EXIT. DTSBN581 00145 EXIT. DTSBN581 00146 EJECT DTSBN581 00147 P0000-PROCESS. DTSBN581 00148 * MOVE LOW-VALUES TO F581-REC. CL**2 00149 DTSBN581 00150 SET F581-581-88 TO TRUE. DTSBN581 00151 DTSBN581 00152 MOVE 20251 TO F581-YRQ. CL230 00153 DTSBN581 00154 DTSBN581 00155 MOVE F581-KEY-AREA TO FSKL-KEY-AREA. DTSBN581 00156 SET L931-OPEN-READ-88 TO TRUE. CL*75 00157 PERFORM S931-REFERENCE-FILE-I-O THRU S931R-EXIT. CL*79 00158 IF L931-NO-REC-88 DTSBN581 00159 * PERFORM S931-WRITE THRU S931-EXIT CL**2 00160 DISPLAY ' 581 REC NOT FOUND ' F581-KEY-AREA CL**2 00161 ELSE DTSBN581 00162 DISPLAY ' 581 REC FOUND ' F581-YRQ. CL*77 00163 PERFORM S931-READ THRU S931-EXIT. CL*77 00164 MOVE FSKL-REC TO F581-REC. CL**2 00165 CL**9 00166 PERFORM P19951-NUMBERS THRU P19951-EXIT. CL*83 00167 CL*10 00168 * MOVE 20141118 TO F581-CHNG-DATE. CL*29 00169 * F581-ESTB-DATE. CL*10 00170 CL*10 00171 MOVE F581-MANDATORY-XFER-CNT TO WRK-INT-NAME. CL*51 00172 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00173 CL*96 00174 MOVE F581-PROHIBITED-XFER-CNT TO WRK-INT-NAME. CL*62 00175 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00176 CL*96 00177 MOVE F581-SUTA-CONTRIB-DUE TO WRK-INT-NAME. CL*51 00178 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00179 CL196 00180 MOVE '000' TO WRK-INT-NAME. CL196 00181 WRITE OUT-REC FROM WRK-INT-NAME. CL196 00182 CL*96 00183 MOVE '000' TO WRK-INT-NAME. CL196 00184 WRITE OUT-REC FROM WRK-INT-NAME. CL196 00185 CL196 00186 MOVE '000' TO WRK-INT-NAME. CL196 00187 WRITE OUT-REC FROM WRK-INT-NAME. CL196 00188 CL196 00189 ** MOVE F581-REC TO FSKL-REC. CL*51 00190 ** PERFORM S931-REWRITE THRU S931-EXIT. CL*51 00191 P0000-EXIT. DTSBN581 00192 EXIT. DTSBN581 00193 EJECT DTSBN581 00194 P19951-NUMBERS. DTSBN581 00195 * MOVE 19990701 TO F581-PERIOD-BEGIN-DATE. CL*25 00196 * MOVE 19990930 TO F581-PERIOD-END-DATE. CL*25 00197 CL*95 00198 ** MOVE 'DC' TO WRK-CHR-NAME. CL131 00199 ** WRITE OUT-REC FROM WRK-CHR-NAME AFTER ADVANCING 1 LINE. CL131 00200 PERFORM P1500-READ-HEADER. CL102 00201 ** MOVE ZERO TO WRK-INT-NAME. CL129 00202 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00203 ** MOVE ZERO TO WRK-INT-NAME. CL129 00204 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00205 ** MOVE ZERO TO WRK-INT-NAME. CL129 00206 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00207 ** MOVE ZERO TO WRK-INT-NAME. CL129 00208 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00209 ** MOVE ZERO TO WRK-INT-NAME. CL129 00210 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00211 ** MOVE ZERO TO WRK-INT-NAME. CL129 00212 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00213 ** MOVE ZERO TO WRK-INT-NAME. CL129 00214 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00215 ** MOVE ZERO TO WRK-INT-NAME. CL129 00216 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00217 ** MOVE ZERO TO WRK-INT-NAME. CL129 00218 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL129 00219 CL220 00220 MOVE F581-CON-EMP-CNT TO WRK-INT-NAME. CL*51 00221 WRITE OUT-REC FROM WRK-INT-NAME. CL192 00222 CL*95 00223 MOVE F581-REIMB-EMP-CNT TO WRK-INT-NAME. CL*51 00224 WRITE OUT-REC FROM WRK-INT-NAME. CL192 00225 CL*95 00226 MOVE F581-TOTAL-EMP-CNT TO WRK-INT-NAME. CL*51 00227 WRITE OUT-REC FROM WRK-INT-NAME. CL192 00228 DTSBN581 00229 MOVE F581-DEL-CUTOFF-DATE TO WRK-DATE-NAME. CL*85 00230 MOVE WRK-DATE-NAME(2:4) TO WRK-DT-YEAR. CL149 00231 MOVE WRK-DATE-NAME(6:2) TO WRK-DT-MTH. CL149 00232 MOVE WRK-DATE-NAME(8:2) TO WRK-DT-DAY. CL149 00233 MOVE WRK-DATE-NAM TO WRK-DATE-NAME. CL150 00234 WRITE OUT-REC FROM WRK-DATE-NAME. CL194 00235 CL*85 00236 MOVE F581-NEW-DETERM-CNT TO WRK-INT-NAME. CL151 00237 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00238 CL151 00239 MOVE '000' TO WRK-INT-NAME. CL151 00240 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00241 CL151 00242 MOVE '000' TO WRK-INT-NAME. CL151 00243 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00244 CL151 00245 COMPUTE WS-CON-RECVBL-BEG-PERIOD ROUNDED CL198 00246 = F581-CON-RECVBL-BEG-PERIOD. CL198 00247 MOVE WS-CON-RECVBL-BEG-PERIOD TO WRK-INT-NAME. CL198 00248 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00249 CL151 00250 MOVE F581-WAGE-ITEM-RCVD-CNT TO WRK-INT-NAME. CL131 00251 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00252 CL131 00253 COMPUTE WS-CON-RECVBL-LIQUID ROUNDED CL225 00254 = F581-CON-RECVBL-LIQUID. CL225 00255 CL225 00256 COMPUTE WS-CON-RECVBL-REMOVED ROUNDED CL225 00257 = F581-CON-RECVBL-REMOVED. CL225 00258 CL225 00259 COMPUTE WS-CON-RECVBL-END-PERIOD ROUNDED CL225 00260 = F581-CON-RECVBL-END-PERIOD. CL225 00261 CL225 00262 COMPUTE WS-CON-RECVBL-UNCOLLECT ROUNDED CL225 00263 = F581-CON-RECVBL-UNCOLLECT. CL225 00264 CL225 00265 * COMPUTE WS-CON-RECVBL-DETERM ROUNDED CL225 00266 * = F581-CON-RECVBL-DETERM. CL225 00267 COMPUTE WS-CON-RECVBL-DETERM CL225 00268 = WS-CON-RECVBL-LIQUID + WS-CON-RECVBL-UNCOLLECT CL225 00269 + WS-CON-RECVBL-REMOVED + WS-CON-RECVBL-END-PERIOD CL225 00270 - WS-CON-RECVBL-BEG-PERIOD. CL225 00271 CL225 00272 MOVE WS-CON-RECVBL-DETERM TO WRK-INT-NAME. CL210 00273 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00274 CL151 00275 MOVE WS-CON-RECVBL-LIQUID TO WRK-INT-NAME. CL203 00276 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00277 CL151 00278 MOVE '000' TO WRK-INT-NAME. CL151 00279 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00280 CL151 00281 MOVE WS-CON-RECVBL-END-PERIOD TO WRK-INT-NAME. CL204 00282 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00283 CL151 00284 COMPUTE WS-REIMB-RECVBL-BEG-PERIOD ROUNDED CL206 00285 = F581-REIMB-RECVBL-BEG-PERIOD. CL206 00286 MOVE WS-REIMB-RECVBL-BEG-PERIOD TO WRK-INT-NAME. CL206 00287 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00288 CL151 00289 MOVE F581-CON-RECVBL-EMP-CNT TO WRK-INT-NAME. CL151 00290 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00291 CL151 00292 COMPUTE WS-REIMB-RECVBL-LIQUID ROUNDED CL225 00293 = F581-REIMB-RECVBL-LIQUID. CL225 00294 CL225 00295 COMPUTE WS-REIMB-RECVBL-REMOVED ROUNDED CL225 00296 = F581-REIMB-RECVBL-REMOVED. CL225 00297 CL225 00298 COMPUTE WS-REIMB-RECVBL-END-PERIOD ROUNDED CL225 00299 = F581-REIMB-RECVBL-END-PERIOD. CL225 00300 CL225 00301 COMPUTE WS-REIMB-RECVBL-UNCOLLECT ROUNDED CL225 00302 = F581-REIMB-RECVBL-UNCOLLECT. CL225 00303 CL225 00304 * COMPUTE WS-REIMB-RECVBL-DETERM ROUNDED CL225 00305 * = F581-REIMB-RECVBL-DETERM. CL225 00306 CL225 00307 COMPUTE WS-REIMB-RECVBL-DETERM CL225 00308 = WS-REIMB-RECVBL-LIQUID + WS-REIMB-RECVBL-UNCOLLECT CL225 00309 + WS-REIMB-RECVBL-REMOVED + WS-REIMB-RECVBL-END-PERIOD CL225 00310 - WS-REIMB-RECVBL-BEG-PERIOD. CL225 00311 CL225 00312 MOVE WS-REIMB-RECVBL-DETERM TO WRK-INT-NAME. CL210 00313 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00314 CL151 00315 MOVE WS-REIMB-RECVBL-LIQUID TO WRK-INT-NAME. CL206 00316 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00317 CL151 00318 MOVE '000' TO WRK-INT-NAME. CL151 00319 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00320 CL151 00321 MOVE WS-REIMB-RECVBL-END-PERIOD TO WRK-INT-NAME. CL206 00322 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00323 CL151 00324 MOVE F581-REIMB-RECVBL-EMP-CNT TO WRK-INT-NAME. CL151 00325 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00326 CL151 00327 MOVE F581-AUDIT-TOT-EMP-CNT TO WRK-INT-NAME. CL151 00328 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00329 CL151 00330 MOVE F581-AUDIT-LARGE-EMP-CNT TO WRK-INT-NAME. CL151 00331 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00332 CL151 00333 MOVE F581-AUDIT-QTR-CNT TO WRK-INT-NAME. CL151 00334 WRITE OUT-REC FROM WRK-INT-NAME. CL194 00335 CL151 00336 MOVE F581-AUDIT-CHANGE-CNT TO WRK-INT-NAME. CL151 00337 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00338 CL151 00339 MOVE F581-AUDIT-HOURS-CNT TO WRK-INT-NAME. CL217 00340 WRITE OUT-REC FROM WRK-INT-NAME. CL217 00341 CL151 00342 COMPUTE WS-AUDIT-UNDERRPT-TOT-WAGES ROUNDED CL206 00343 = F581-AUDIT-UNDERRPT-TOT-WAGES. CL206 00344 MOVE WS-AUDIT-UNDERRPT-TOT-WAGES TO WRK-INT-NAME CL206 00345 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00346 CL151 00347 COMPUTE WS-AUDIT-UNDERRPT-TAX-WAGES ROUNDED CL206 00348 = F581-AUDIT-UNDERRPT-TAX-WAGES. CL206 00349 MOVE WS-AUDIT-UNDERRPT-TAX-WAGES TO WRK-INT-NAME. CL217 00350 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00351 CL151 00352 COMPUTE WS-AUDIT-UNDERRPT-CONTRIB ROUNDED CL206 00353 = F581-AUDIT-UNDERRPT-CONTRIB. CL206 00354 MOVE WS-AUDIT-UNDERRPT-CONTRIB TO WRK-INT-NAME. CL206 00355 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00356 CL151 00357 COMPUTE WS-AUDIT-OVERRPT-TOT-WAGES ROUNDED CL206 00358 = F581-AUDIT-OVERRPT-TOT-WAGES. CL206 00359 MOVE WS-AUDIT-OVERRPT-TOT-WAGES TO WRK-INT-NAME. CL206 00360 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00361 CL151 00362 COMPUTE WS-AUDIT-OVERRPT-TAX-WAGES ROUNDED CL206 00363 = F581-AUDIT-OVERRPT-TAX-WAGES. CL206 00364 MOVE WS-AUDIT-OVERRPT-TAX-WAGES TO WRK-INT-NAME. CL206 00365 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00366 CL151 00367 COMPUTE WS-AUDIT-OVERRPT-CONTRIB ROUNDED CL206 00368 = F581-AUDIT-OVERRPT-CONTRIB. CL206 00369 MOVE WS-AUDIT-OVERRPT-CONTRIB TO WRK-INT-NAME. CL206 00370 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00371 CL223 00372 COMPUTE WS-CON-RECVBL-9-MOS ROUNDED CL223 00373 = F581-CON-RECVBL-9-MOS. CL223 00374 CL223 00375 COMPUTE WS-CON-RECVBL-12-MOS ROUNDED CL223 00376 = F581-CON-RECVBL-12-MOS. CL223 00377 CL223 00378 COMPUTE WS-CON-RECVBL-15-MOS ROUNDED CL223 00379 = F581-CON-RECVBL-15-MOS. CL223 00380 CL223 00381 COMPUTE WS-CON-RECVBL-OVER15-MOS ROUNDED CL223 00382 = F581-CON-RECVBL-OVER15-MOS. CL223 00383 CL223 00384 COMPUTE WS-CON-RECVBL-6-MOS CL223 00385 = WS-CON-RECVBL-END-PERIOD - WS-CON-RECVBL-9-MOS CL223 00386 - WS-CON-RECVBL-12-MOS - WS-CON-RECVBL-15-MOS CL223 00387 - WS-CON-RECVBL-OVER15-MOS. CL223 00388 MOVE WS-CON-RECVBL-6-MOS TO WRK-INT-NAME. CL210 00389 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00390 CL151 00391 MOVE WS-CON-RECVBL-9-MOS TO WRK-INT-NAME. CL206 00392 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00393 CL151 00394 MOVE WS-CON-RECVBL-12-MOS TO WRK-INT-NAME. CL206 00395 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00396 CL151 00397 MOVE WS-CON-RECVBL-15-MOS TO WRK-INT-NAME. CL206 00398 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00399 CL151 00400 MOVE WS-CON-RECVBL-OVER15-MOS TO WRK-INT-NAME. CL206 00401 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00402 CL151 00403 COMPUTE WS-REIMB-RECVBL-9-MOS ROUNDED CL225 00404 = F581-REIMB-RECVBL-9-MOS. CL225 00405 CL225 00406 COMPUTE WS-REIMB-RECVBL-12-MOS ROUNDED CL225 00407 = F581-REIMB-RECVBL-12-MOS. CL225 00408 CL225 00409 COMPUTE WS-REIMB-RECVBL-15-MOS ROUNDED CL225 00410 = F581-REIMB-RECVBL-15-MOS. CL225 00411 CL225 00412 COMPUTE WS-REIMB-RECVBL-OVER15-MOS ROUNDED CL225 00413 = F581-REIMB-RECVBL-OVER15-MOS. CL225 00414 CL225 00415 COMPUTE WS-REIMB-RECVBL-6-MOS CL225 00416 = WS-REIMB-RECVBL-END-PERIOD - WS-REIMB-RECVBL-9-MOS CL225 00417 - WS-REIMB-RECVBL-12-MOS - WS-REIMB-RECVBL-15-MOS CL225 00418 - WS-REIMB-RECVBL-OVER15-MOS. CL225 00419 CL225 00420 MOVE WS-REIMB-RECVBL-6-MOS TO WRK-INT-NAME. CL210 00421 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00422 CL151 00423 MOVE WS-REIMB-RECVBL-9-MOS TO WRK-INT-NAME. CL207 00424 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00425 CL151 00426 MOVE WS-REIMB-RECVBL-12-MOS TO WRK-INT-NAME. CL207 00427 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00428 CL151 00429 MOVE WS-REIMB-RECVBL-15-MOS TO WRK-INT-NAME. CL207 00430 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00431 CL151 00432 MOVE WS-REIMB-RECVBL-OVER15-MOS TO WRK-INT-NAME. CL207 00433 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00434 CL151 00435 MOVE F581-CON-TIMELY-CNT TO WRK-INT-NAME. CL132 00436 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00437 CL132 00438 MOVE F581-CON-SECURED-CNT TO WRK-INT-NAME. CL132 00439 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00440 CL132 00441 MOVE F581-CON-RESOLVED-CNT TO WRK-INT-NAME. CL132 00442 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00443 CL132 00444 MOVE F581-REIMB-TIMELY-CNT TO WRK-INT-NAME. CL132 00445 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00446 CL132 00447 MOVE F581-REIMB-SECURED-CNT TO WRK-INT-NAME. CL132 00448 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00449 CL132 00450 MOVE F581-REIMB-RESOLVED-CNT TO WRK-INT-NAME. CL132 00451 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00452 CL133 00453 MOVE F581-SUC-DETERM-T90-CNT TO WRK-INT-NAME. CL151 00454 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00455 CL151 00456 MOVE F581-SUC-DETERM-T180-CNT TO WRK-INT-NAME. CL151 00457 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00458 CL*85 00459 MOVE F581-NEW-DETERM-T90-CNT TO WRK-INT-NAME. CL133 00460 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00461 CL133 00462 MOVE F581-NEW-DETERM-T180-CNT TO WRK-INT-NAME. CL133 00463 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00464 CL133 00465 MOVE F581-TERMINATION-CNT TO WRK-INT-NAME. CL151 00466 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00467 CL151 00468 MOVE WS-CON-RECVBL-REMOVED TO WRK-INT-NAME. CL207 00469 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00470 CL151 00471 MOVE WS-REIMB-RECVBL-REMOVED TO WRK-INT-NAME. CL207 00472 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00473 CL151 00474 COMPUTE WS-AUDIT-TOT-WAGES-PRE ROUNDED CL207 00475 = F581-AUDIT-TOT-WAGES-PRE. CL207 00476 MOVE WS-AUDIT-TOT-WAGES-PRE TO WRK-INT-NAME. CL207 00477 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00478 CL151 00479 COMPUTE WS-AUDIT-TOT-WAGES-POST CL225 00480 = WS-AUDIT-TOT-WAGES-PRE CL225 00481 + WS-AUDIT-UNDERRPT-TOT-WAGES CL225 00482 - WS-AUDIT-OVERRPT-TOT-WAGES. CL225 00483 CL225 00484 MOVE WS-AUDIT-TOT-WAGES-POST TO WRK-INT-NAME. CL211 00485 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00486 CL151 00487 MOVE F581-SUC-DETERM-CNT TO WRK-INT-NAME. CL151 00488 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00489 CL151 00490 MOVE F581-AUDIT-INDCON-TO-EMPL-CNT TO WRK-INT-NAME. CL151 00491 WRITE OUT-REC FROM WRK-INT-NAME. CL195 00492 CL151 00493 ** MOVE F581-REIMB-RECVBL-UNCOLLECT TO WRK-INT-NAME. CL151 00494 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL151 00495 CL151 00496 ** MOVE F581-CON-RECVBL-UNCOLLECT TO WRK-INT-NAME. CL151 00497 ** WRITE OUT-REC FROM WRK-INT-NAME AFTER ADVANCING 1 LINE. CL151 00498 CL*85 00499 CL*86 00500 * MOVE 19991225 TO F581-ESTB-DATE CL*26 00501 * F581-CHNG-DATE. CL*26 00502 P19951-EXIT. CL103 00503 EXIT. CL103 00504 EJECT CL103 00505 P1500-READ-HEADER. CL107 00506 CL118 00507 MOVE F581-YRQ TO WRK-YRQ. CL118 00508 CL121 00509 MOVE WRK-YRQ(1:4) TO WRK-YEAR. CL122 00510 CL122 00511 IF WRK-YRQ(5:1) = '1' CL122 00512 MOVE '03/31' TO WRK-MONTH CL130 00513 ELSE CL122 00514 IF WRK-YRQ(5:1) = '2' CL122 00515 MOVE '06/30' TO WRK-MONTH CL130 00516 ELSE CL122 00517 IF WRK-YRQ(5:1) = '3' CL122 00518 MOVE '09/30' TO WRK-MONTH CL130 00519 ELSE CL122 00520 MOVE '12/31' TO WRK-MONTH CL130 00521 END-IF. CL122 00522 CL102 00523 MOVE WRK-QTR TO WRK-DATE-NAME. CL122 00524 DISPLAY WRK-DATE-NAME. CL111 00525 WRITE OUT-REC FROM WRK-DATE-NAME. CL195 00526 * WRITE OUT-REC FROM WRK-DATE-NAME AFTER ADVANCING 1 LINE. CL195 00527 T0000-TERMINATE. DTSBN581 00528 PERFORM S931-CLOSE THRU S931-EXIT. DTSBN581 00529 T0000-EXIT. DTSBN581 00530 EXIT. DTSBN581 00531 EJECT DTSBN581 00532 S931-REFERENCE-FILE-I-O. CL*76 00533 CL*76 00534 CALL 'DTSBU931' USING L931-LINK-AREA CL*76 00535 FSKL-REC. CL*76 00536 CL*76 00537 S931R-EXIT. CL*78 00538 EXIT. CL*76 00539 CL*76 00540 S910-READ. CL116 00541 SET L910-READ-88 TO TRUE. CL116 00542 GO TO S910-MSTR-IO. CL116 00543 SKIP1 CL116 00544 S910-MSTR-IO. CL116 00545 CALL 'DTSBU910' USING L910-LINK-AREA CL116 00546 MSKL-REC. CL116 00547 S910-EXIT. CL116 00548 EXIT. CL116 00549 SKIP3 CL116 00550 S931-OPEN-UPDATE. DTSBN581 00551 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBN581 00552 GO TO S931-MSTR-CALL. DTSBN581 00553 DTSBN581 00554 S931-CLOSE. DTSBN581 00555 SET L931-CLOSE-88 TO TRUE. DTSBN581 00556 GO TO S931-MSTR-CALL. DTSBN581 00557 DTSBN581 00558 S931-READ. DTSBN581 00559 SET L931-READ-88 TO TRUE. DTSBN581 00560 GO TO S931-MSTR-CALL. DTSBN581 00561 DTSBN581 00562 S931-START-BROWSE. DTSBN581 00563 SET L931-START-BROWSE-88 TO TRUE. DTSBN581 00564 GO TO S931-MSTR-CALL. DTSBN581 00565 DTSBN581 00566 S931-READ-NEXT. DTSBN581 00567 SET L931-READ-NEXT-88 TO TRUE. DTSBN581 00568 GO TO S931-MSTR-CALL. DTSBN581 00569 DTSBN581 00570 S931-WRITE. DTSBN581 00571 SET L931-WRITE-88 TO TRUE. DTSBN581 00572 GO TO S931-MSTR-CALL. DTSBN581 00573 DTSBN581 00574 S931-REWRITE. DTSBN581 00575 SET L931-REWRITE-88 TO TRUE. DTSBN581 00576 GO TO S931-MSTR-CALL. DTSBN581 00577 DTSBN581 00578 S931-DELETE. DTSBN581 00579 SET L931-DELETE-88 TO TRUE. DTSBN581 00580 GO TO S931-MSTR-CALL. DTSBN581 00581 DTSBN581 00582 S931-MSTR-CALL. DTSBN581 00583 CALL 'DTSBU931' USING L931-LINK-AREA DTSBN581 00584 FSKL-REC. DTSBN581 00585 S931-EXIT. DTSBN581 00586 EXIT. DTSBN581 00587 SKIP3 DTSBN581 00588 S999-ABEND. DTSBN581 00589 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBN581 00590 S999-EXIT. DTSBN581 00591 EXIT. DTSBN581