593 lines
47 KiB
COBOL
593 lines
47 KiB
COBOL
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
|