00001 IDENTIFICATION DIVISION. 02/17/99 00002 PROGRAM-ID. DTSBU971. DTSBU971 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. NOVEMBER 1994. DTSBU971 00005 DATE-COMPILED. DTSBU971 00006 SKIP3 DTSBU971 00007 ***** DTSBU971 00008 * DTSBU971 00009 * FUNCTION: BATCH CURRENT YEAR FUTA CERTIFICATION DTSBU971 00010 * INPUT/OUTPUT. DTSBU971 00011 * DTSBU971 00012 * DTSBU971 00013 * MODIFICATION LOG: DTSBU971 00014 * DTSBU971 00015 * 11/25/94 INITIAL DEVELOPMENT. DTSBU971 00016 * WORK ORDER: PROGRAMMER: TCL DTSBU971 00017 * DTSBU971 00018 * 02/17/1999 REVIEWED AND MODIFIED FOR DC. CL**2 00019 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2 00020 * CL**2 00021 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00022 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00023 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2 00024 * DTSBU971 00025 * DTSBU971 00026 * DESCRIPTION: DTSBU971 00027 * DTSBU971 00028 * DTSBU971 00029 * GENERAL SPECIFICATIONS: DTSBU971 00030 * DTSBU971 00031 * ALL COMMANDS ARE VALID. DTSBU971 00032 * DTSBU971 00033 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSBU971 00034 * MODULE. DTSBU971 00035 * DTSBU971 00036 * IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS DTSBU971 00037 * ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A DTSBU971 00038 * FILE-STATUS OF '97' FROM AN OPEN COMMAND). DTSBU971 00039 * DTSBU971 00040 * DTSBU971 00041 * DTSBU971 00042 * COMMAND SPECIFIC SPECIFICATIONS: DTSBU971 00043 * DTSBU971 00044 * OPEN-READ DTSBU971 00045 * OPEN INPUT. DTSBU971 00046 * DTSBU971 00047 * OPEN-UPDATE DTSBU971 00048 * OPEN I-O. DTSBU971 00049 * DTSBU971 00050 * CLOSE DTSBU971 00051 * DTSBU971 00052 * READ DTSBU971 00053 * DTSBU971 00054 * START BROWSE DTSBU971 00055 * IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE DTSBU971 00056 * READ-NEXT LOGIC. A SUCCESSFUL START-BROWSE RETURNS DTSBU971 00057 * A RECORD. DTSBU971 00058 * DTSBU971 00059 * READ NEXT DTSBU971 00060 * RETURN L971-NO-REC-88 AT A BREAK IN REC-TYPE. DTSBU971 00061 * DTSBU971 00062 * WRITE DTSBU971 00063 * DTSBU971 00064 * REWRITE DTSBU971 00065 * DTSBU971 00066 * DELETE DTSBU971 00067 * DTSBU971 00068 * DTSBU971 00069 ***** DTSBU971 00070 SKIP3 DTSBU971 00071 ENVIRONMENT DIVISION. DTSBU971 00072 SKIP2 DTSBU971 00073 INPUT-OUTPUT SECTION. DTSBU971 00074 CL**2 00075 FILE-CONTROL. DTSBU971 00076 SELECT CERT-FILE ASSIGN TO DTSFCERT CL**2 00077 ORGANIZATION IS INDEXED DTSBU971 00078 RECORD KEY IS X971-KEY-AREA OF FILE-REC DTSBU971 00079 FILE STATUS IS FILE-STATUS DTSBU971 00080 ACCESS IS DYNAMIC. DTSBU971 00081 SKIP3 DTSBU971 00082 DATA DIVISION. DTSBU971 00083 SKIP3 DTSBU971 00084 FILE SECTION. DTSBU971 00085 SKIP3 DTSBU971 00086 FD CERT-FILE. DTSBU971 00087 CL**2 00088 01 FILE-REC. DTSBU971 00089 ++INCLUDE DTSIX971 CL**2 00090 EJECT DTSBU971 00091 WORKING-STORAGE SECTION. DTSBU971 000915 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU971 02/17/99'. DTSBU971 00092 SKIP3 DTSBU971 00093 01 WRK-AREA. DTSBU971 00094 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +971.DTSBU971 00095 CL**2 00096 05 FILE-STATUS PIC X(02). DTSBU971 00097 88 FILE-OK-88 VALUE '00'. DTSBU971 00098 88 FILE-NO-REC-88 VALUE '10' '23'. DTSBU971 00099 88 FILE-VERIFY-88 VALUE '97'. DTSBU971 00100 EJECT DTSBU971 00101 01 L991-LINK-AREA. DTSBU971 00102 ++INCLUDE DTSIL991 CL**2 00103 EJECT DTSBU971 00104 LINKAGE SECTION. DTSBU971 00105 SKIP3 DTSBU971 00106 01 L971-LINK-AREA. DTSBU971 00107 ++INCLUDE DTSIL971 CL**2 00108 EJECT DTSBU971 00109 01 LINK-REC. DTSBU971 00110 05 X971-REC. DTSBU971 00111 ++INCLUDE DTSIX971 CL**2 00112 EJECT DTSBU971 00113 PROCEDURE DIVISION USING L971-LINK-AREA DTSBU971 00114 LINK-REC. DTSBU971 00115 CL**2 00116 CL**2 00117 SET L971-OK-88 TO TRUE. DTSBU971 00118 DTSBU971 00119 CL**2 00120 IF L971-TRACE-88 DTSBU971 00121 PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT. DTSBU971 00122 DTSBU971 00123 IF L971-READ-NEXT-88 DTSBU971 00124 PERFORM P2300-READ-NEXT THRU P2300-EXIT DTSBU971 00125 ELSE DTSBU971 00126 IF L971-READ-88 DTSBU971 00127 PERFORM P2100-READ THRU P2100-EXIT DTSBU971 00128 ELSE DTSBU971 00129 IF L971-START-BROWSE-88 DTSBU971 00130 PERFORM P2200-START-BROWSE THRU P2200-EXIT DTSBU971 00131 ELSE DTSBU971 00132 IF L971-WRITE-88 DTSBU971 00133 PERFORM P3100-WRITE THRU P3100-EXIT DTSBU971 00134 ELSE DTSBU971 00135 IF L971-REWRITE-88 DTSBU971 00136 PERFORM P3200-REWRITE THRU P3200-EXIT DTSBU971 00137 ELSE DTSBU971 00138 IF L971-DELETE-88 DTSBU971 00139 PERFORM P3300-DELETE THRU P3300-EXIT DTSBU971 00140 ELSE DTSBU971 00141 IF L971-OPEN-READ-88 DTSBU971 00142 OR DTSBU971 00143 L971-OPEN-UPDATE-88 DTSBU971 00144 PERFORM P1100-OPEN THRU P1100-EXIT DTSBU971 00145 ELSE DTSBU971 00146 IF L971-CLOSE-88 DTSBU971 00147 PERFORM P1200-CLOSE THRU P1200-EXIT DTSBU971 00148 ELSE DTSBU971 00149 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00150 CL**2 00151 IF L971-TRACE-88 DTSBU971 00152 PERFORM S9200-POST-DISPLAY THRU S9200-EXIT. DTSBU971 00153 CL**2 00154 CL**2 00155 GOBACK. DTSBU971 00156 EJECT DTSBU971 00157 P1100-OPEN. DTSBU971 00158 IF L971-OPEN-UPDATE-88 DTSBU971 00159 OPEN I-O CERT-FILE DTSBU971 00160 ELSE DTSBU971 00161 OPEN INPUT CERT-FILE. DTSBU971 00162 DTSBU971 00163 IF FILE-OK-88 OR FILE-VERIFY-88 DTSBU971 00164 NEXT SENTENCE DTSBU971 00165 ELSE DTSBU971 00166 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00167 P1100-EXIT. DTSBU971 00168 EXIT. DTSBU971 00169 SKIP3 DTSBU971 00170 P1200-CLOSE. DTSBU971 00171 CLOSE CERT-FILE. DTSBU971 00172 CL**2 00173 IF FILE-OK-88 DTSBU971 00174 NEXT SENTENCE DTSBU971 00175 ELSE DTSBU971 00176 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00177 P1200-EXIT. DTSBU971 00178 EXIT. DTSBU971 00179 EJECT DTSBU971 00180 P2100-READ. DTSBU971 00181 MOVE X971-KEY-AREA OF LINK-REC DTSBU971 00182 TO X971-KEY-AREA OF FILE-REC. DTSBU971 00183 DTSBU971 00184 READ CERT-FILE. DTSBU971 00185 DTSBU971 00186 IF FILE-OK-88 DTSBU971 00187 PERFORM S2200-FILE-TO-LINK THRU S2200-EXIT DTSBU971 00188 ELSE DTSBU971 00189 IF FILE-NO-REC-88 DTSBU971 00190 PERFORM S1100-NO-REC THRU S1100-EXIT DTSBU971 00191 ELSE DTSBU971 00192 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00193 P2100-EXIT. DTSBU971 00194 EXIT. DTSBU971 00195 EJECT DTSBU971 00196 P2200-START-BROWSE. DTSBU971 00197 MOVE X971-KEY-AREA OF LINK-REC DTSBU971 00198 TO X971-KEY-AREA OF FILE-REC. DTSBU971 00199 DTSBU971 00200 START CERT-FILE DTSBU971 00201 KEY IS NOT < X971-KEY-AREA OF FILE-REC. DTSBU971 00202 DTSBU971 00203 IF FILE-OK-88 DTSBU971 00204 PERFORM P2300-READ-NEXT THRU P2300-EXIT DTSBU971 00205 ELSE DTSBU971 00206 IF FILE-NO-REC-88 DTSBU971 00207 PERFORM S1100-NO-REC THRU S1100-EXIT DTSBU971 00208 ELSE DTSBU971 00209 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00210 P2200-EXIT. DTSBU971 00211 EXIT. DTSBU971 00212 EJECT DTSBU971 00213 P2300-READ-NEXT. DTSBU971 00214 READ CERT-FILE NEXT. DTSBU971 00215 DTSBU971 00216 IF FILE-OK-88 DTSBU971 00217 PERFORM S2200-FILE-TO-LINK THRU S2200-EXIT DTSBU971 00218 ELSE DTSBU971 00219 IF FILE-NO-REC-88 DTSBU971 00220 PERFORM S1100-NO-REC THRU S1100-EXIT DTSBU971 00221 ELSE DTSBU971 00222 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00223 P2300-EXIT. DTSBU971 00224 EXIT. DTSBU971 00225 EJECT DTSBU971 00226 P3100-WRITE. DTSBU971 00227 PERFORM S2100-LINK-TO-FILE THRU S2100-EXIT. DTSBU971 00228 CL**2 00229 WRITE FILE-REC. DTSBU971 00230 CL**2 00231 IF FILE-OK-88 DTSBU971 00232 NEXT SENTENCE DTSBU971 00233 ELSE DTSBU971 00234 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00235 P3100-EXIT. DTSBU971 00236 EXIT. DTSBU971 00237 EJECT DTSBU971 00238 P3200-REWRITE. DTSBU971 00239 PERFORM S2100-LINK-TO-FILE THRU S2100-EXIT. DTSBU971 00240 CL**2 00241 REWRITE FILE-REC. DTSBU971 00242 CL**2 00243 IF FILE-OK-88 DTSBU971 00244 NEXT SENTENCE DTSBU971 00245 ELSE DTSBU971 00246 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00247 P3200-EXIT. DTSBU971 00248 EXIT. DTSBU971 00249 EJECT DTSBU971 00250 P3300-DELETE. DTSBU971 00251 MOVE X971-KEY-AREA OF LINK-REC DTSBU971 00252 TO X971-KEY-AREA OF FILE-REC. DTSBU971 00253 CL**2 00254 DELETE CERT-FILE. DTSBU971 00255 CL**2 00256 IF FILE-OK-88 DTSBU971 00257 NEXT SENTENCE DTSBU971 00258 ELSE DTSBU971 00259 PERFORM S999-ABEND THRU S999-EXIT. DTSBU971 00260 P3300-EXIT. DTSBU971 00261 EXIT. DTSBU971 00262 EJECT DTSBU971 00263 S1100-NO-REC. DTSBU971 00264 SET L971-NO-REC-88 TO TRUE. DTSBU971 00265 S1100-EXIT. DTSBU971 00266 EXIT. DTSBU971 00267 SKIP3 DTSBU971 00268 S2100-LINK-TO-FILE. DTSBU971 00269 MOVE LINK-REC TO FILE-REC. DTSBU971 00270 S2100-EXIT. DTSBU971 00271 EXIT. DTSBU971 00272 EJECT DTSBU971 00273 S2200-FILE-TO-LINK. DTSBU971 00274 MOVE FILE-REC TO LINK-REC. DTSBU971 00275 S2200-EXIT. DTSBU971 00276 EXIT. DTSBU971 00277 EJECT DTSBU971 00278 S9100-PRE-DISPLAY. DTSBU971 00279 DISPLAY ' '. DTSBU971 00280 CL**2 00281 DISPLAY ' '. DTSBU971 00282 CL**2 00283 DISPLAY '*** DTSBU971 PRE TRACE DISPLAY ***'. CL**2 00284 CL**2 00285 DISPLAY L971-MOD-NAME DTSBU971 00286 ' = L971-MOD-NAME'. DTSBU971 00287 CL**2 00288 DISPLAY L971-CMND-CD DTSBU971 00289 ' = L971-CMND-CD'. DTSBU971 00290 CL**2 00291 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU971 00292 S9100-EXIT. DTSBU971 00293 EXIT. DTSBU971 00294 SKIP3 DTSBU971 00295 S9200-POST-DISPLAY. DTSBU971 00296 DISPLAY ' '. DTSBU971 00297 CL**2 00298 DISPLAY ' '. DTSBU971 00299 CL**2 00300 DISPLAY '*** DTSBU971 POST TRACE DISPLAY ***'. CL**2 00301 CL**2 00302 DISPLAY L971-RESULT-IND DTSBU971 00303 ' = L971-RESULT-IND'. DTSBU971 00304 CL**2 00305 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU971 00306 S9200-EXIT. DTSBU971 00307 EXIT. DTSBU971 00308 SKIP3 DTSBU971 00309 S9300-REC-DISPLAY. DTSBU971 00310 DISPLAY ' '. DTSBU971 00311 CL**2 00312 MOVE +4 TO L991-REQ-CHAR-CNT. DTSBU971 00313 CL**2 00314 MOVE X971-KEY-AREA OF LINK-REC TO L991-REQ-AREA. DTSBU971 00315 CL**2 00316 PERFORM S991-HEX-FORMAT THRU S991-EXIT. DTSBU971 00317 CL**2 00318 DISPLAY 'KEY AREA = ' DTSBU971 00319 L991-REPLY-HEX-1-AREA. DTSBU971 00320 CL**2 00321 DISPLAY ' ' DTSBU971 00322 L991-REPLY-HEX-2-AREA. DTSBU971 00323 CL**2 00324 DISPLAY ' ' DTSBU971 00325 L991-REPLY-AN-AREA. DTSBU971 00326 S9300-EXIT. DTSBU971 00327 EXIT. DTSBU971 00328 EJECT DTSBU971 00329 S991-HEX-FORMAT. DTSBU971 00330 CALL 'DTSBU991' USING L991-LINK-AREA. CL**2 00331 S991-EXIT. DTSBU971 00332 EXIT. DTSBU971 00333 SKIP3 DTSBU971 00334 S999-ABEND. DTSBU971 00335 DISPLAY '*** I/O MODULE ABENDING'. DTSBU971 00336 CL**2 00337 DISPLAY '*** CMND-CD = ' L971-CMND-CD. DTSBU971 00338 CL**2 00339 DISPLAY '*** FILE-STATUS = ' FILE-STATUS. DTSBU971 00340 CL**2 00341 DISPLAY '*** CALLING MODULE = ' L971-MOD-NAME. DTSBU971 00342 CL**2 00343 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU971 00344 CL**2 00345 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00346 S999-EXIT. DTSBU971 00347 EXIT. DTSBU971