00001 IDENTIFICATION DIVISION. 10/08/02 00002 PROGRAM-ID. DTSBR591. DTSBR591 00003 AUTHOR. TRW. LV008 00004 DATE-WRITTEN. FEBRUARY 2000. DTSBR591 00005 DATE-COMPILED. DTSBR591 00006 SKIP3 DTSBR591 00007 ***** DTSBR591 00008 * DTSBR591 00009 * FUNCTION: CREATE FISCAL AGENT BENEFIT CHARGE ERROR DTSBR591 00010 * REPORT. DTSBR591 00011 ***** DTSBR591 00012 SKIP3 DTSBR591 00013 ENVIRONMENT DIVISION. DTSBR591 00014 INPUT-OUTPUT SECTION. DTSBR591 00015 FILE-CONTROL. DTSBR591 00016 DTSBR591 00017 SELECT DTS-EROR-OUT ASSIGN TO RPT591R1 DTSBR591 00018 FILE STATUS IS WRK-COL-STATUS. DTSBR591 00019 DTSBR591 00020 DTSBR591 00021 SKIP2 DTSBR591 00022 DATA DIVISION. DTSBR591 00023 FILE SECTION. DTSBR591 00024 DTSBR591 00025 FD DTS-EROR-OUT DTSBR591 00026 LABEL RECORDS ARE STANDARD. DTSBR591 00027 DTSBR591 00028 01 PRT-REC1 PIC X(133). DTSBR591 00029 DTSBR591 00030 WORKING-STORAGE SECTION. DTSBR591 000305 77 PAN-VALET PICTURE X(24) VALUE '008DTSBR591 10/08/02'. DTSBR591 00031 SKIP3 DTSBR591 00032 01 WRK-AREA. DTSBR591 00033 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +591.DTSBR591 00034 DTSBR591 00035 05 WRK-FISCAL-AGENT-CD PIC X(03) VALUE SPACES. DTSBR591 00036 05 WRK-EMP-NAME. DTSBR591 00037 10 WRK-EMP-NAMEA PIC X(01) VALUE SPACES. DTSBR591 00038 10 WRK-EMP-NAMEB PIC X(39) VALUE SPACES. DTSBR591 00039 DTSBR591 00040 05 WRK-EMP-PHA PIC X(10) VALUE SPACES. DTSBR591 00041 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBR591'.DTSBR591 00042 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR591 00043 DTSBR591 00044 05 WRK-RATE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBR591 00045 05 WRK-TAPE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBR591 00046 05 WRK-EROR-CNT PIC S9(07) COMP-3 VALUE 0. DTSBR591 00047 DTSBR591 00048 05 WRK-COL-CNT PIC S9(07) COMP-3. DTSBR591 00049 DTSBR591 00050 05 WRK-COL-STATUS PIC X(02). DTSBR591 00051 88 WRK-COL-STAT-OK VALUE '00'. DTSBR591 00052 05 WRK-MPRF-IND PIC X(01). DTSBR591 00053 88 WRK-MPRF-OK VALUE 'Y'. DTSBR591 00054 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBR591 00055 DTSBR591 00056 05 WRK-ERROR-IND PIC X(01) VALUE SPACES. DTSBR591 00057 88 WRK-ERROR-YES VALUE 'Y'. DTSBR591 00058 88 WRK-ERROR-NO VALUE 'N'. DTSBR591 00059 DTSBR591 00060 05 WRK-FISC-AGNT-CODE PIC X(01). DTSBR591 00061 88 WRK-FISC-AGNT-VALID-88 VALUE 'Y'. DTSBR591 00062 88 WRK-FISC-AGNT-INVALID-88 VALUE 'N'. DTSBR591 00063 DTSBR591 00064 05 RPT01-LINE-CNT PIC S9(05) VALUE +65. DTSBR591 00065 05 RPT01-PAGE-CNT PIC S9(05) VALUE +0. DTSBR591 00066 DTSBR591 00067 05 WRK-DATE PIC 9(06) VALUE ZEROS. DTSBR591 00068 05 WRK-DATE-9 REDEFINES WRK-DATE. DTSBR591 00069 10 WRK-DATE-YY PIC 9(02). DTSBR591 00070 10 WRK-DATE-MM PIC 9(02). DTSBR591 00071 10 WRK-DATE-DD PIC 9(02). DTSBR591 00072 05 WRK-TRACE-IND PIC X(01). DTSBR591 00073 DTSBR591 00074 05 WS-REC PIC X(133) VALUE SPACES.DTSBR591 00075 EJECT DTSBR591 00076 01 RPT01DET. DTSBR591 00077 05 FILLER PIC X(2) VALUE SPACES. DTSBR591 00078 05 R591-EMP-NO-OUT PIC X(6) VALUE SPACES. DTSBR591 00079 05 FILLER PIC X(4) VALUE SPACES. DTSBR591 00080 05 R591-EMP-NAME-OUT PIC X(40) VALUE SPACES. DTSBR591 00081 05 FILLER PIC X(4) VALUE SPACES. DTSBR591 00082 05 R591-MESSAGE-OUT PIC X(40) VALUE SPACES. DTSBR591 00083 05 FILLER PIC X(3) VALUE SPACES. DTSBR591 00084 EJECT DTSBR591 00085 DTSBR591 00086 01 REPORT-LINE-AREA. DTSBR591 00087 05 HEAD01. DTSBR591 00088 10 FILLER PIC X(05) VALUE SPACE. DTSBR591 00089 10 HEAD01-RPT-NAME PIC X(05) VALUE '591R1'. DTSBR591 00090 10 FILLER PIC X(47) VALUE SPACES. DTSBR591 00091 10 HEAD01-PROGRAM-NAME PIC X(52). DTSBR591 00092 10 FILLER PIC X(04) VALUE SPACES. DTSBR591 00093 10 FILLER PIC X(06) VALUE 'DATE: '. DTSBR591 00094 10 HEAD01-SYS-DATE. DTSBR591 00095 15 HEAD01-SYS-MM PIC 99. DTSBR591 00096 15 FILLER PIC X(01) VALUE '/'. DTSBR591 00097 15 HEAD01-SYS-DD PIC 99. DTSBR591 00098 15 FILLER PIC X(01) VALUE '/'. DTSBR591 00099 15 HEAD01-SYS-CEN PIC 99 VALUE 20. DTSBR591 00100 15 HEAD01-SYS-YY PIC 99. DTSBR591 00101 DTSBR591 00102 05 HEAD02. DTSBR591 00103 10 FILLER PIC X(01) VALUE SPACE. DTSBR591 00104 10 FILLER PIC X(50) VALUE SPACES. DTSBR591 00105 10 HEAD02-AGY-NAME PIC X(60). DTSBR591 00106 10 HEAD02-SYS-TIME PIC X(10) VALUE SPACES. DTSBR591 00107 DTSBR591 00108 05 HEAD03. DTSBR591 00109 10 FILLER PIC X(01) VALUE SPACE. DTSBR591 00110 10 FILLER PIC X(20) DTSBR591 00111 VALUE 'FISCAL AGENT NAME:'. DTSBR591 00112 10 HEAD03-FA-NAME PIC X(35) VALUE SPACES. DTSBR591 00113 10 FILLER PIC X(05) VALUE SPACES. DTSBR591 00114 10 HEAD03-AGY-MAIL1 PIC X(52). DTSBR591 00115 10 FILLER PIC X(06) VALUE 'PAGE: '. DTSBR591 00116 10 HEAD03-PAGE-CNT PIC ZZZ9. DTSBR591 00117 DTSBR591 00118 05 HEAD04. DTSBR591 00119 10 FILLER PIC X(01) VALUE SPACE. DTSBR591 00120 10 FILLER PIC X(50) VALUE SPACES. DTSBR591 00121 10 HEAD04-TITLE PIC X(39) DTSBR591 00122 VALUE 'FISCAL AGENT CHARGE TAPE ERROR REPORT'. DTSBR591 00123 10 FILLER PIC X(42) VALUE SPACES. DTSBR591 00124 DTSBR591 00125 05 HEAD05. DTSBR591 00126 10 FILLER PIC X(02) VALUE SPACE. DTSBR591 00127 10 FILLER PIC X(43) VALUE DTSBR591 00128 'ACCOUNT EMPLOYER '. DTSBR591 00129 10 FILLER PIC X(32) VALUE DTSBR591 00130 ' MESSAGE '. DTSBR591 00131 10 FILLER PIC X(58) VALUE SPACE. DTSBR591 00132 05 HEAD06. DTSBR591 00133 10 FILLER PIC X(02) VALUE SPACE. DTSBR591 00134 10 FILLER PIC X(43) VALUE DTSBR591 00135 'NUMBER NAME '. DTSBR591 00136 10 FILLER PIC X(58) VALUE SPACES. DTSBR591 00137 DTSBR591 00138 EJECT DTSBR591 00139 DTSBR591 00140 EJECT DTSBR591 00141 DTSBR591 00142 01 L119-LINK-AREA. DTSBR591 00143 ++INCLUDE DTSIL119 DTSBR591 00144 EJECT DTSBR591 00145 01 FISCAL-AGENT-TABLE-AREA. DTSBR591 00146 ++INCLUDE CHGIC001 DTSBR591 00147 EJECT DTSBR591 00148 LINKAGE SECTION. DTSBR591 00149 SKIP3 DTSBR591 00150 01 LRCM-LINK-AREA. DTSBR591 00151 ++INCLUDE DTSILRCM DTSBR591 00152 DTSBR591 00153 01 R591-REC. DTSBR591 00154 ++INCLUDE DTSIR591 DTSBR591 00155 EJECT DTSBR591 00156 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR591 00157 R591-REC. DTSBR591 00158 DTSBR591 00159 IF FIRST-TIME-IND = 'Y' DTSBR591 00160 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR591 00161 MOVE 'N' TO FIRST-TIME-IND. DTSBR591 00162 DTSBR591 00163 IF WRK-ERROR-YES DTSBR591 00164 PERFORM S999-ABEND THRU S999-EXIT DTSBR591 00165 ELSE DTSBR591 00166 IF LRCM-EOR-88 DTSBR591 00167 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBR591 00168 ELSE DTSBR591 00169 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBR591 00170 SKIP2 DTSBR591 00171 GOBACK. DTSBR591 00172 EJECT DTSBR591 00173 I1000-INITIATE. DTSBR591 00174 SKIP2 DTSBR591 00175 MOVE 'N' TO WRK-TRACE-IND. DTSBR591 00176 SET WRK-ERROR-NO TO TRUE. DTSBR591 00177 DTSBR591 00178 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBR591 00179 DTSBR591 00180 SKIP2 DTSBR591 00181 I1000-EXIT. DTSBR591 00182 EXIT. DTSBR591 00183 I2000-OPEN-FILES. DTSBR591 00184 DTSBR591 00185 OPEN OUTPUT DTS-EROR-OUT. DTSBR591 00186 IF NOT WRK-COL-STAT-OK DTSBR591 00187 DISPLAY 'CANNOT OP EROR OUTP FILE ' WRK-COL-STATUS DTSBR591 00188 SET WRK-ERROR-YES TO TRUE. DTSBR591 00189 DTSBR591 00190 ACCEPT WRK-DATE FROM DATE. DTSBR591 00191 MOVE WRK-DATE-DD TO HEAD01-SYS-DD. DTSBR591 00192 MOVE WRK-DATE-MM TO HEAD01-SYS-MM. DTSBR591 00193 MOVE WRK-DATE-YY TO HEAD01-SYS-YY. DTSBR591 00194 PERFORM S119-AGENCY-FACTS THRU S119-EXIT. DTSBR591 00195 DTSBR591 00196 MOVE L119-AGY-NAMEB1 TO HEAD01-PROGRAM-NAME. DTSBR591 00197 DTSBR591 00198 MOVE SPACES TO HEAD02-AGY-NAME. DTSBR591 00199 STRING L119-AGY-NAMEB2 DELIMITED BY ' ' DTSBR591 00200 INTO HEAD02-AGY-NAME. DTSBR591 00201 DTSBR591 00202 MOVE SPACES TO HEAD03-AGY-MAIL1. DTSBR591 00203 STRING L119-TAX-DIV-NAME DELIMITED BY ' ' DTSBR591 00204 INTO HEAD03-AGY-MAIL1. DTSBR591 00205 DTSBR591 00206 I2000-EXIT. DTSBR591 00207 EXIT. DTSBR591 00208 EJECT DTSBR591 00209 P0000-PROCESS. DTSBR591 00210 DTSBR591 00211 DTSBR591 00212 IF R591-ERROR-88 DTSBR591 00213 PERFORM P1000-WRITE-ERROR-RPT THRU P1000-EXIT. DTSBR591 00214 DTSBR591 00215 DTSBR591 00216 P0000-EXIT. DTSBR591 00217 EXIT. DTSBR591 00218 EJECT DTSBR591 00219 P1000-WRITE-ERROR-RPT. DTSBR591 00220 DTSBR591 00221 ADD +1 TO WRK-EROR-CNT. DTSBR591 00222 MOVE R591-EMP-NO TO R591-EMP-NO-OUT. DTSBR591 00223 MOVE R591-EMPLOYER-NAME TO R591-EMP-NAME-OUT. DTSBR591 00224 MOVE R591-MESSAGE TO R591-MESSAGE-OUT. DTSBR591 00225 PERFORM P1100-WRITE-EROR-REPORT THRU P1100-EXIT. DTSBR591 00226 DTSBR591 00227 P1000-EXIT. DTSBR591 00228 EXIT. DTSBR591 00229 EJECT DTSBR591 00230 P1100-WRITE-EROR-REPORT. DTSBR591 00231 DTSBR591 00232 MOVE SPACES TO WS-REC. DTSBR591 00233 IF RPT01-LINE-CNT > 60 OR DTSBR591 00234 R591-FISCAL-AGENT-CD NOT = WRK-FISCAL-AGENT-CD DTSBR591 00235 PERFORM P2000-EROR-HEADINGS THRU P2000-EXIT. DTSBR591 00236 DTSBR591 00237 MOVE RPT01DET TO WS-REC. DTSBR591 00238 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR591 00239 ADD 1 TO RPT01-LINE-CNT. DTSBR591 00240 P1100-EXIT. DTSBR591 00241 EXIT. DTSBR591 00242 P2000-EROR-HEADINGS. DTSBR591 00243 PERFORM P3000-FISCAL-AGENT THRU P3000-EXIT. DTSBR591 00244 ADD 1 TO RPT01-PAGE-CNT. DTSBR591 00245 MOVE RPT01-PAGE-CNT TO HEAD03-PAGE-CNT. DTSBR591 00246 MOVE HEAD01 TO WS-REC DTSBR591 00247 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING PAGE DTSBR591 00248 MOVE HEAD02 TO WS-REC DTSBR591 00249 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR591 00250 MOVE HEAD03 TO WS-REC DTSBR591 00251 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR591 00252 MOVE SPACES TO WS-REC DTSBR591 00253 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR591 00254 MOVE HEAD04 TO WS-REC DTSBR591 00255 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR591 00256 MOVE SPACES TO WS-REC DTSBR591 00257 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR591 00258 MOVE HEAD05 TO WS-REC DTSBR591 00259 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR591 00260 MOVE HEAD06 TO WS-REC DTSBR591 00261 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR591 00262 MOVE SPACES TO WS-REC DTSBR591 00263 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR591 00264 MOVE 10 TO RPT01-LINE-CNT. DTSBR591 00265 P2000-EXIT. DTSBR591 00266 EXIT. DTSBR591 00267 EJECT DTSBR591 00268 P3000-FISCAL-AGENT. DTSBR591 00269 IF R591-FISCAL-AGENT-CD = WRK-FISCAL-AGENT-CD DTSBR591 00270 GO TO P3000-EXIT. DTSBR591 00271 SET WRK-FISC-AGNT-INVALID-88 TO TRUE DTSBR591 00272 DTSBR591 00273 PERFORM VARYING FISCAL-AGENT-IDX FROM 1 BY 1 DTSBR591 00274 UNTIL WRK-FISC-AGNT-VALID-88 DTSBR591 00275 OR FISCAL-AGENT-IDX > FISCAL-AGENT-CNT DTSBR591 00276 OR FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) DTSBR591 00277 = SPACE DTSBR591 00278 IF R591-FISCAL-AGENT-CD = DTSBR591 00279 FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) DTSBR591 00280 SET WRK-FISC-AGNT-VALID-88 TO TRUE DTSBR591 00281 MOVE FISCAL-AGENT-CODE(FISCAL-AGENT-IDX) TO DTSBR591 00282 WRK-FISCAL-AGENT-CD DTSBR591 00283 MOVE FISCAL-AGENT-NAME(FISCAL-AGENT-IDX) TO DTSBR591 00284 HEAD03-FA-NAME DTSBR591 00285 END-IF DTSBR591 00286 END-PERFORM. DTSBR591 00287 DTSBR591 00288 IF WRK-FISC-AGNT-INVALID-88 DTSBR591 00289 MOVE 'INVALID FISCAL AGENT' TO HEAD03-FA-NAME DTSBR591 00290 GO TO P3000-EXIT. DTSBR591 00291 P3000-EXIT. DTSBR591 00292 EXIT. DTSBR591 00293 T0000-TERMINATE. DTSBR591 00294 DTSBR591 00295 DISPLAY ' '. DTSBR591 00296 DTSBR591 00297 DISPLAY '*** DTSBR591 TERMINATION STATISTICS ***'. DTSBR591 00298 DTSBR591 00299 DISPLAY ' '. DTSBR591 00300 DTSBR591 00301 DISPLAY 'NUMBER OF ERROR RECORDS READ : 'DTSBR591 00302 WRK-EROR-CNT. DTSBR591 00303 DTSBR591 00304 DTSBR591 00305 DTSBR591 00306 CLOSE DTS-EROR-OUT. DTSBR591 00307 DTSBR591 00308 T0000-EXIT. DTSBR591 00309 EXIT. DTSBR591 00310 EJECT DTSBR591 00311 SKIP3 DTSBR591 00312 S119-AGENCY-FACTS. DTSBR591 00313 SET L119-REQ-CAPS-88 TO TRUE. DTSBR591 00314 SET L119-REQ-COLLECTIONS-88 TO TRUE. DTSBR591 00315 DTSBR591 00316 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR591 00317 S119-EXIT. DTSBR591 00318 EXIT. DTSBR591 00319 SKIP3 DTSBR591 00320 S999-ABEND. DTSBR591 00321 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR591 00322 S999-EXIT. DTSBR591 00323 EXIT. DTSBR591