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