DUTAS re-platformed to Raincode - Initial Source Code

This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions

488
Batch/DESBR102.cob Normal file
View File

@ -0,0 +1,488 @@
00001 IDENTIFICATION DIVISION. 08/28/02
00002 PROGRAM-ID. DESBR102. DESBR102
00003 AUTHOR. TRW INC. LV003
00004 DATE-WRITTEN. MARCH 2001. DESBR102
00005 DATE-COMPILED. DESBR102
00006 DESBR102
00007 ***** DESBR102
00008 * DESBR102
00009 * CALLING SEQUENCE: DESBE101 CREATES DESIR102 RECORDS. DESBR102
00010 * DTSBD200 CALLS DESBR102 DESBR102
00011 * WHICH PRODUCES THE ELECTRONIC DESBR102
00012 * MEDIA PACKING LIST. DESBR102
00013 * DESBR102
00014 * FUNCTION: WAGE PROCESSING CONFIRMATION REPORT AND DESBR102
00015 * WAGE PROCESSING PROBLEM REPORT. DESBR102
00016 * DESBR102
00017 * DESBR102
00018 * MODIFICATION HISTORY: DESBR102
00019 * DESBR102
00020 * 12-20-94 INITIAL DEVELOPMENT DESBR102
00021 * REFERENCE TAPE TRCKING SYSTEM AUTHOR OF CHANGE - RW1 DESBR102
00022 * DESBR102
00023 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBR102
00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBR102
00025 * REFERENCE RFP #**** PROGRAMMER: XXX DESBR102
00026 * DESBR102
00027 * DESBR102
00028 * DESCRIPTION: DESBR102
00029 * DESBR102
00030 * THIS MODULE PRODUCES THE WAGE PROCESSING CONFIRMATION DESBR102
00031 * REPORT AND WAGE PROCESSING PROBLEM REPORT. DESBR102
00032 * DESBR102
00033 * DESBR102
00034 * RECORDS READ: DESBR102
00035 * DESBR102
00036 * NONE. DESBR102
00037 * DESBR102
00038 * DESBR102
00039 * PRINTED OUTPUTS: DESBR102
00040 * DESBR102
00041 * 102R1 WAGE PROCESSING CONFIRMATION REPORT AND DESBR102
00042 * 102R2 WAGE PROCESSING PROBLEM REPORT. DESBR102
00043 * DESBR102
00044 * DESBR102
00045 * RECORDS WRITTEN: DESBR102
00046 * DESBR102
00047 * NONE. DESBR102
00048 * DESBR102
00049 * DESBR102
00050 * MODULES CALLED: DESBR102
00051 * DESBR102
00052 * DTSBU001 DATE CONVERT. DESBR102
00053 * DESBR102
00054 ***** DESBR102
00055 EJECT DESBR102
00056 ENVIRONMENT DIVISION. DESBR102
00057 DESBR102
00058 CONFIGURATION SECTION. DESBR102
00059 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DESBR102
00060 DESBR102
00061 INPUT-OUTPUT SECTION. DESBR102
00062 FILE-CONTROL. DESBR102
00063 SELECT RPT-FILE1 ASSIGN TO RPT102R1. DESBR102
00064 SELECT RPT-FILE2 ASSIGN TO RPT102R2. DESBR102
00065 DESBR102
00066 DATA DIVISION. DESBR102
00067 FILE SECTION. DESBR102
00068 DESBR102
00069 FD RPT-FILE1 DESBR102
00070 RECORDING MODE IS F. DESBR102
00071 01 REPORT-LISTING1 PIC X(133). DESBR102
00072 DESBR102
00073 FD RPT-FILE2 DESBR102
00074 RECORDING MODE IS F. DESBR102
00075 01 REPORT-LISTING2 PIC X(133). DESBR102
00076 DESBR102
00077 WORKING-STORAGE SECTION. DESBR102
000775 77 PAN-VALET PICTURE X(24) VALUE '003DESBR102 08/28/02'. DESBR102
00078 DESBR102
00079 01 WRK-AREA. DESBR102
00080 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +102.DESBR102
00081 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DESBR102
00082 DESBR102
00083 05 WRK-SUB PIC S9(04) COMP. DESBR102
00084 05 WS-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DESBR102
00085 05 WS-LINE-CNT1 PIC S9(02) COMP-3 VALUE +60.DESBR102
00086 05 WS-PAGE-CNT1 PIC S9(03) COMP-3 VALUE +0. DESBR102
00087 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +60.DESBR102
00088 05 WS-PAGE-CNT2 PIC S9(03) COMP-3 VALUE +0. DESBR102
00089 DESBR102
00090 05 HOLD-ELF-ID PIC S9(07) COMP-3 VALUE +0. DESBR102
00091 DESBR102
00092 01 PAGE-HEADING1. DESBR102
00093 05 HDR1-LINE-1. DESBR102
00094 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00095 10 FILLER PIC X(10) DESBR102
00096 VALUE 'EMT102R1'. DESBR102
00097 10 FILLER PIC X(30) VALUE SPACES.DESBR102
00098 10 HDR1-AGY-NAME-LINE1 PIC X(50). DESBR102
00099 10 FILLER PIC X(27) VALUE SPACES.DESBR102
00100 10 FILLER PIC X(05) DESBR102
00101 VALUE 'DATE:'. DESBR102
00102 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00103 10 HDR1-SYS-DATE PIC X(08). DESBR102
00104 DESBR102
00105 05 HDR1-LINE-2. DESBR102
00106 10 FILLER PIC X(41) VALUE SPACES.DESBR102
00107 10 HDR1-AGY-NAME-LINE2 PIC X(50). DESBR102
00108 10 FILLER PIC X(27) VALUE SPACES.DESBR102
00109 10 FILLER PIC X(05) DESBR102
00110 VALUE 'TIME:'. DESBR102
00111 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00112 10 HDR1-SYS-TIME PIC X(08). DESBR102
00113 DESBR102
00114 05 HDR1-LINE-3. DESBR102
00115 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00116 10 FILLER PIC X(35) VALUE SPACES.DESBR102
00117 10 FILLER PIC X(82) VALUE SPACES.DESBR102
00118 10 FILLER PIC X(05) DESBR102
00119 VALUE 'PAGE:'. DESBR102
00120 10 FILLER PIC X(03) VALUE SPACES.DESBR102
00121 10 HDR1-PAGE-CNT PIC ZZ,ZZ9. DESBR102
00122 DESBR102
00123 05 HDR1-LINE-4. DESBR102
00124 10 FILLER PIC X(49) VALUE SPACES.DESBR102
00125 10 FILLER PIC X(35) VALUE DESBR102
00126 'WAGE PROCESSING CONFIRMATION REPORT'. DESBR102
00127 10 FILLER PIC X(49) VALUE SPACES.DESBR102
00128 DESBR102
00129 05 HDR1-LINE-5 PIC X(133). DESBR102
00130 05 HDR1-LINE-6 PIC X(133). DESBR102
00131 DESBR102
00132 05 HDR1-LINE-7. DESBR102
00133 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00134 10 FILLER PIC X(11) DESBR102
00135 VALUE 'ACCOUNT NBR'. DESBR102
00136 10 FILLER PIC X(02) VALUE SPACES.DESBR102
00137 10 FILLER PIC X(04) VALUE SPACES.DESBR102
00138 10 FILLER PIC X(16) VALUE DESBR102
00139 'NAME AND ADDRESS'. DESBR102
00140 10 FILLER PIC X(20) VALUE SPACES.DESBR102
00141 10 FILLER PIC X(10) VALUE SPACES.DESBR102
00142 10 FILLER PIC X(06) VALUE DESBR102
00143 'FORMAT'. DESBR102
00144 10 FILLER PIC X(63) VALUE SPACES.DESBR102
00145 DESBR102
00146 05 HDR1-LINE-8 PIC X(133). DESBR102
00147 DESBR102
00148 01 DETAIL1-LINE. DESBR102
00149 DESBR102
00150 05 DTL1-LINE-1. DESBR102
00151 10 FILLER PIC X(03) VALUE SPACE. DESBR102
00152 10 DTL1-ACCT-NBR PIC 999B999. DESBR102
00153 10 FILLER PIC X(04) VALUE SPACES.DESBR102
00154 10 DTL1-NAME-ADDR-1 PIC X(40) VALUE SPACES.DESBR102
00155 10 FILLER PIC X(02) VALUE SPACES.DESBR102
00156 10 DTL1-FORMAT PIC X(60). DESBR102
00157 10 FILLER PIC X(17) VALUE SPACES.DESBR102
00158 DESBR102
00159 05 DTL1-LINE-2. DESBR102
00160 10 FILLER PIC X(14) VALUE SPACE. DESBR102
00161 10 DTL1-NAME-ADDR-2 PIC X(40) VALUE SPACES.DESBR102
00162 10 FILLER PIC X(79) VALUE SPACES.DESBR102
00163 DESBR102
00164 05 DTL1-LINE-3. DESBR102
00165 10 FILLER PIC X(14) VALUE SPACE. DESBR102
00166 10 DTL1-NAME-ADDR-3 PIC X(40) VALUE SPACES.DESBR102
00167 10 FILLER PIC X(79) VALUE SPACES.DESBR102
00168 DESBR102
00169 05 DTL1-LINE-4. DESBR102
00170 10 FILLER PIC X(14) VALUE SPACE. DESBR102
00171 10 DTL1-NAME-ADDR-4 PIC X(40) VALUE SPACES.DESBR102
00172 10 FILLER PIC X(79) VALUE SPACES.DESBR102
00173 DESBR102
00174 05 DTL1-LINE-5. DESBR102
00175 10 FILLER PIC X(14) VALUE SPACE. DESBR102
00176 10 DTL1-NAME-ADDR-5 PIC X(40) VALUE SPACES.DESBR102
00177 10 FILLER PIC X(79) VALUE SPACES.DESBR102
00178 DESBR102
00179 01 PAGE-HEADING2. DESBR102
00180 05 HDR2-LINE-1. DESBR102
00181 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00182 10 FILLER PIC X(10) DESBR102
00183 VALUE 'EMT102R2'. DESBR102
00184 10 FILLER PIC X(30) VALUE SPACES.DESBR102
00185 10 HDR2-AGY-NAME-LINE1 PIC X(50). DESBR102
00186 10 FILLER PIC X(27) VALUE SPACES.DESBR102
00187 10 FILLER PIC X(05) DESBR102
00188 VALUE 'DATE:'. DESBR102
00189 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00190 10 HDR2-SYS-DATE PIC X(08). DESBR102
00191 05 HDR2-LINE-2. DESBR102
00192 10 FILLER PIC X(41) VALUE SPACES.DESBR102
00193 10 HDR2-AGY-NAME-LINE2 PIC X(50). DESBR102
00194 10 FILLER PIC X(27) VALUE SPACES.DESBR102
00195 10 FILLER PIC X(05) DESBR102
00196 VALUE 'TIME:'. DESBR102
00197 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00198 10 HDR2-SYS-TIME PIC X(08). DESBR102
00199 05 HDR2-LINE-3. DESBR102
00200 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00201 10 FILLER PIC X(35) VALUE SPACES.DESBR102
00202 10 FILLER PIC X(82) VALUE SPACES.DESBR102
00203 10 FILLER PIC X(05) DESBR102
00204 VALUE 'PAGE:'. DESBR102
00205 10 FILLER PIC X(03) VALUE SPACES.DESBR102
00206 10 HDR2-PAGE-CNT PIC ZZ,ZZ9. DESBR102
00207 DESBR102
00208 05 HDR2-LINE-4. DESBR102
00209 10 FILLER PIC X(51) VALUE SPACES.DESBR102
00210 10 FILLER PIC X(30) VALUE DESBR102
00211 'WAGE PROCESSING PROBLEM REPORT'. DESBR102
00212 10 FILLER PIC X(52) VALUE SPACES.DESBR102
00213 DESBR102
00214 05 HDR2-LINE-5 PIC X(133). DESBR102
00215 05 HDR2-LINE-6 PIC X(133). DESBR102
00216 DESBR102
00217 05 HDR2-LINE-7. DESBR102
00218 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00219 10 FILLER PIC X(11) DESBR102
00220 VALUE 'ACCOUNT NBR'. DESBR102
00221 10 FILLER PIC X(02) VALUE SPACES.DESBR102
00222 10 FILLER PIC X(04) VALUE SPACES.DESBR102
00223 10 FILLER PIC X(16) VALUE DESBR102
00224 'NAME AND ADDRESS'. DESBR102
00225 10 FILLER PIC X(20) VALUE SPACES.DESBR102
00226 10 FILLER PIC X(10) VALUE SPACES.DESBR102
00227 10 FILLER PIC X(06) VALUE DESBR102
00228 'FORMAT'. DESBR102
00229 10 FILLER PIC X(63) VALUE SPACES.DESBR102
00230 DESBR102
00231 05 HDR2-LINE-8 PIC X(133). DESBR102
00232 DESBR102
00233 01 DETAIL2-LINE. DESBR102
00234 DESBR102
00235 05 DTL2-LINE-1. DESBR102
00236 10 FILLER PIC X(03) VALUE SPACE. DESBR102
00237 10 DTL2-ACCT-NBR PIC 999B999. DESBR102
00238 10 FILLER PIC X(04) VALUE SPACES.DESBR102
00239 10 DTL2-NAME-ADDR-1 PIC X(40) VALUE SPACES.DESBR102
00240 10 FILLER PIC X(02) VALUE SPACES.DESBR102
00241 10 DTL2-FORMAT PIC X(60). DESBR102
00242 10 FILLER PIC X(17) VALUE SPACES.DESBR102
00243 DESBR102
00244 05 DTL2-LINE-2. DESBR102
00245 10 FILLER PIC X(14) VALUE SPACE. DESBR102
00246 10 DTL2-NAME-ADDR-2 PIC X(40) VALUE SPACES.DESBR102
00247 10 FILLER PIC X(16) VALUE SPACES.DESBR102
00248 10 FILLER PIC X(60) VALUE SPACES.DESBR102
00249 10 FILLER PIC X(03) VALUE SPACES.DESBR102
00250 DESBR102
00251 05 DTL2-LINE-3. DESBR102
00252 10 FILLER PIC X(14) VALUE SPACE. DESBR102
00253 10 DTL2-NAME-ADDR-3 PIC X(40) VALUE SPACES.DESBR102
00254 10 FILLER PIC X(16) VALUE SPACES.DESBR102
00255 10 FILLER PIC X(60) VALUE SPACES.DESBR102
00256 10 FILLER PIC X(03) VALUE SPACES.DESBR102
00257 DESBR102
00258 05 DTL2-LINE-4. DESBR102
00259 10 FILLER PIC X(14) VALUE SPACE. DESBR102
00260 10 DTL2-NAME-ADDR-4 PIC X(40) VALUE SPACES.DESBR102
00261 10 FILLER PIC X(16) VALUE SPACES.DESBR102
00262 10 FILLER PIC X(60) VALUE SPACES.DESBR102
00263 10 FILLER PIC X(03) VALUE SPACES.DESBR102
00264 DESBR102
00265 05 DTL2-LINE-5. DESBR102
00266 10 FILLER PIC X(14) VALUE SPACE. DESBR102
00267 10 DTL2-NAME-ADDR-5 PIC X(40) VALUE SPACES.DESBR102
00268 10 FILLER PIC X(16) VALUE SPACES.DESBR102
00269 10 FILLER PIC X(60) VALUE SPACES.DESBR102
00270 10 FILLER PIC X(03) VALUE SPACES.DESBR102
00271 DESBR102
00272 05 DTL2-LINE-6 PIC X(133). DESBR102
00273 DESBR102
00274 05 DTL2-LINE-7. DESBR102
00275 10 FILLER PIC X(01) VALUE SPACE. DESBR102
00276 10 FILLER PIC X(15) VALUE DESBR102
00277 'PROBLEMS FOUND:'. DESBR102
00278 10 FILLER PIC X(117) VALUE SPACES.DESBR102
00279 DESBR102
00280 05 DTL2-LINE-8 PIC X(133). DESBR102
00281 DESBR102
00282 05 DTL2-LINE-9. DESBR102
00283 10 FILLER PIC X(05) VALUE SPACE. DESBR102
00284 10 DTL2-ERROR-MSG PIC X(60) VALUE SPACES.DESBR102
00285 10 FILLER PIC X(68) VALUE SPACES.DESBR102
00286 DESBR102
00287 01 L041-LINK-AREA. DESBR102
00288 ++INCLUDE DTSIL041 DESBR102
00289 DESBR102
00290 EJECT DESBR102
00291 LINKAGE SECTION. DESBR102
00292 DESBR102
00293 01 LRCM-LINK-AREA. DESBR102
00294 ++INCLUDE DTSILRCM DESBR102
00295 EJECT DESBR102
00296 01 R102-REC. DESBR102
00297 ++INCLUDE DESIR102 DESBR102
00298 EJECT DESBR102
00299 PROCEDURE DIVISION USING LRCM-LINK-AREA DESBR102
00300 R102-REC. DESBR102
00301 DESBR102
00302 IF FIRST-TIME-IND = 'Y' DESBR102
00303 PERFORM I1000-INITIATE THRU I1000-EXIT DESBR102
00304 MOVE 'N' TO FIRST-TIME-IND. DESBR102
00305 DESBR102
00306 IF LRCM-EOR-88 DESBR102
00307 PERFORM T1000-TERMINATE THRU T1000-EXIT DESBR102
00308 ELSE DESBR102
00309 PERFORM P1000-PROCESS THRU P1000-EXIT. DESBR102
00310 DESBR102
00311 GOBACK. DESBR102
00312 DESBR102
00313 I1000-INITIATE. DESBR102
00314 DESBR102
00315 OPEN OUTPUT RPT-FILE1 DESBR102
00316 RPT-FILE2. DESBR102
00317 DESBR102
00318 MOVE LRCM-SYS-DATE TO HDR1-SYS-DATE DESBR102
00319 HDR2-SYS-DATE. DESBR102
00320 MOVE LRCM-SYS-TIME TO HDR1-SYS-TIME DESBR102
00321 HDR2-SYS-TIME. DESBR102
00322 MOVE LRCM-AGY-NAME-LINE1 TO HDR1-AGY-NAME-LINE1 DESBR102
00323 HDR2-AGY-NAME-LINE1. DESBR102
00324 MOVE LRCM-AGY-NAME-LINE2 TO HDR1-AGY-NAME-LINE2 DESBR102
00325 HDR2-AGY-NAME-LINE2. DESBR102
00326 MOVE SPACES TO REPORT-LISTING1 DESBR102
00327 REPORT-LISTING2. DESBR102
00328 DESBR102
00329 I1000-EXIT. DESBR102
00330 EXIT. DESBR102
00331 DESBR102
00332 P1000-PROCESS. DESBR102
00333 DESBR102
00334 IF R102-ELF-ID NOT = HOLD-ELF-ID DESBR102
00335 MOVE R102-ELF-ID TO HOLD-ELF-ID DESBR102
00336 MOVE +0 TO WS-PAGE-CNT1 WS-PAGE-CNT2 DESBR102
00337 DESBR102
00338 IF WS-NUMBER-ONE = +0 DESBR102
00339 MOVE +99 TO WS-NUMBER-ONE DESBR102
00340 ELSE DESBR102
00341 IF R102-RPT-TYPE-CONFIRM-88 DESBR102
00342 MOVE +60 TO WS-LINE-CNT1 DESBR102
00343 END-IF DESBR102
00344 IF R102-RPT-TYPE-ERROR-88 DESBR102
00345 MOVE +60 TO WS-LINE-CNT2 DESBR102
00346 END-IF DESBR102
00347 END-IF DESBR102
00348 END-IF. DESBR102
00349 DESBR102
00350 IF R102-RPT-TYPE-CONFIRM-88 DESBR102
00351 PERFORM P1100-CONFIRM THRU P1100-EXIT DESBR102
00352 ELSE DESBR102
00353 IF R102-RPT-TYPE-ERROR-88 DESBR102
00354 PERFORM P1200-ERROR THRU P1200-EXIT. DESBR102
00355 DESBR102
00356 P1000-EXIT. DESBR102
00357 EXIT. DESBR102
00358 DESBR102
00359 P1100-CONFIRM. DESBR102
00360 MOVE R102-ELF-ID TO DTL1-ACCT-NBR. DESBR102
00361 MOVE R102-FMT-LINE (1) TO DTL1-NAME-ADDR-1. DESBR102
00362 MOVE R102-FMT-LINE (2) TO DTL1-NAME-ADDR-2. DESBR102
00363 MOVE R102-FMT-LINE (3) TO DTL1-NAME-ADDR-3. DESBR102
00364 MOVE R102-FMT-LINE (4) TO DTL1-NAME-ADDR-4. DESBR102
00365 MOVE R102-FMT-LINE (5) TO DTL1-NAME-ADDR-5. DESBR102
00366 DESBR102
00367 SET L041-EPRF-FORMAT-CD TO TRUE. DESBR102
00368 MOVE R102-FORMAT-CD TO L041-CD-3. DESBR102
00369 PERFORM S041-FORMAT-INFO THRU S041-EXIT. DESBR102
00370 IF L041-VALID DESBR102
00371 MOVE L041-LONG-DSCR TO DTL1-FORMAT DESBR102
00372 ELSE DESBR102
00373 MOVE SPACES TO DTL1-FORMAT DESBR102
00374 END-IF. DESBR102
00375 DESBR102
00376 PERFORM P2000-PRINT-HEADER1 THRU P2000-EXIT. DESBR102
00377 DESBR102
00378 WRITE REPORT-LISTING1 FROM DTL1-LINE-1 AFTER 1. DESBR102
00379 WRITE REPORT-LISTING1 FROM DTL1-LINE-2 AFTER 1. DESBR102
00380 WRITE REPORT-LISTING1 FROM DTL1-LINE-3 AFTER 1. DESBR102
00381 WRITE REPORT-LISTING1 FROM DTL1-LINE-4 AFTER 1. DESBR102
00382 WRITE REPORT-LISTING1 FROM DTL1-LINE-5 AFTER 1. DESBR102
00383 ADD +5 TO WS-LINE-CNT1. DESBR102
00384 DESBR102
00385 P1100-EXIT. DESBR102
00386 EXIT. DESBR102
00387 DESBR102
00388 P1200-ERROR. DESBR102
00389 MOVE R102-ELF-ID TO DTL2-ACCT-NBR. DESBR102
00390 MOVE R102-FMT-LINE (1) TO DTL2-NAME-ADDR-1. DESBR102
00391 MOVE R102-FMT-LINE (2) TO DTL2-NAME-ADDR-2. DESBR102
00392 MOVE R102-FMT-LINE (3) TO DTL2-NAME-ADDR-3. DESBR102
00393 MOVE R102-FMT-LINE (4) TO DTL2-NAME-ADDR-4. DESBR102
00394 MOVE R102-FMT-LINE (5) TO DTL2-NAME-ADDR-5. DESBR102
00395 DESBR102
00396 SET L041-EPRF-FORMAT-CD TO TRUE. DESBR102
00397 MOVE R102-FORMAT-CD TO L041-CD-3. DESBR102
00398 PERFORM S041-FORMAT-INFO THRU S041-EXIT. DESBR102
00399 IF L041-VALID DESBR102
00400 MOVE L041-LONG-DSCR TO DTL2-FORMAT DESBR102
00401 ELSE DESBR102
00402 MOVE SPACES TO DTL2-FORMAT DESBR102
00403 END-IF. DESBR102
00404 DESBR102
00405 PERFORM P3000-PRINT-HEADER2 THRU P3000-EXIT. DESBR102
00406 WRITE REPORT-LISTING2 FROM DTL2-LINE-1 AFTER 1. DESBR102
00407 WRITE REPORT-LISTING2 FROM DTL2-LINE-2 AFTER 1. DESBR102
00408 WRITE REPORT-LISTING2 FROM DTL2-LINE-3 AFTER 1. DESBR102
00409 WRITE REPORT-LISTING2 FROM DTL2-LINE-4 AFTER 1. DESBR102
00410 WRITE REPORT-LISTING2 FROM DTL2-LINE-5 AFTER 1. DESBR102
00411 WRITE REPORT-LISTING2 FROM DTL2-LINE-6 AFTER 1. DESBR102
00412 WRITE REPORT-LISTING2 FROM DTL2-LINE-7 AFTER 1. DESBR102
00413 WRITE REPORT-LISTING2 FROM DTL2-LINE-8 AFTER 1. DESBR102
00414 ADD +8 TO WS-LINE-CNT2. DESBR102
00415 DESBR102
00416 PERFORM DESBR102
00417 VARYING WRK-SUB FROM +1 BY +1 DESBR102
00418 UNTIL WRK-SUB > R102-ERR-CNT DESBR102
00419 MOVE R102-ERROR (WRK-SUB) TO DTL2-ERROR-MSG DESBR102
00420 WRITE REPORT-LISTING2 FROM DTL2-LINE-9 AFTER 1 DESBR102
00421 END-PERFORM. DESBR102
00422 DESBR102
00423 ADD R102-ERR-CNT TO WS-LINE-CNT2. DESBR102
00424 DESBR102
00425 P1200-EXIT. DESBR102
00426 EXIT. DESBR102
00427 DESBR102
00428 P2000-PRINT-HEADER1. DESBR102
00429 DESBR102
00430 IF WS-LINE-CNT1 GREATER 58 DESBR102
00431 MOVE +0 TO WS-LINE-CNT1 DESBR102
00432 ADD +1 TO WS-PAGE-CNT1 DESBR102
00433 MOVE WS-PAGE-CNT1 TO HDR1-PAGE-CNT DESBR102
00434 WRITE REPORT-LISTING1 FROM HDR1-LINE-1 AFTER TOP-OF-PAGE DESBR102
00435 WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1 DESBR102
00436 WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1 DESBR102
00437 WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1 DESBR102
00438 WRITE REPORT-LISTING1 FROM HDR1-LINE-5 AFTER 1 DESBR102
00439 WRITE REPORT-LISTING1 FROM HDR1-LINE-6 AFTER 1 DESBR102
00440 WRITE REPORT-LISTING1 FROM HDR1-LINE-7 AFTER 1 DESBR102
00441 WRITE REPORT-LISTING1 FROM HDR1-LINE-8 AFTER 1 DESBR102
00442 ADD +8 TO WS-LINE-CNT1. DESBR102
00443 DESBR102
00444 P2000-EXIT. DESBR102
00445 EXIT. DESBR102
00446 DESBR102
00447 P3000-PRINT-HEADER2. DESBR102
00448 DESBR102
00449 IF WS-LINE-CNT2 GREATER 58 DESBR102
00450 MOVE +0 TO WS-LINE-CNT2 DESBR102
00451 ADD +1 TO WS-PAGE-CNT2 DESBR102
00452 MOVE WS-PAGE-CNT2 TO HDR2-PAGE-CNT DESBR102
00453 WRITE REPORT-LISTING2 FROM HDR2-LINE-1 AFTER TOP-OF-PAGE DESBR102
00454 WRITE REPORT-LISTING2 FROM HDR2-LINE-2 AFTER 1 DESBR102
00455 WRITE REPORT-LISTING2 FROM HDR2-LINE-3 AFTER 1 DESBR102
00456 WRITE REPORT-LISTING2 FROM HDR2-LINE-4 AFTER 1 DESBR102
00457 WRITE REPORT-LISTING2 FROM HDR2-LINE-5 AFTER 1 DESBR102
00458 WRITE REPORT-LISTING2 FROM HDR2-LINE-6 AFTER 1 DESBR102
00459 WRITE REPORT-LISTING2 FROM HDR2-LINE-7 AFTER 1 DESBR102
00460 WRITE REPORT-LISTING2 FROM HDR2-LINE-8 AFTER 1 DESBR102
00461 ADD +8 TO WS-LINE-CNT2. DESBR102
00462 DESBR102
00463 P3000-EXIT. DESBR102
00464 EXIT. DESBR102
00465 DESBR102
00466 S041-FORMAT-INFO. DESBR102
00467 DESBR102
00468 CALL 'DTSBU041' USING L041-LINK-AREA. DESBR102
00469 DESBR102
00470 S041-EXIT. DESBR102
00471 EXIT. DESBR102
00472 DESBR102
00473 T1000-TERMINATE. DESBR102
00474 DESBR102
00475 CLOSE RPT-FILE1 DESBR102
00476 RPT-FILE2. DESBR102
00477 DESBR102
00478 T1000-EXIT. DESBR102
00479 EXIT. DESBR102
00480 DESBR102
00481 *S999-ABEND. DESBR102
00482 * DESBR102
00483 * CALL 'DTSBU999' USING WRK-ABEND-CD. DESBR102
00484 * DESBR102
00485 *S999-EXIT. DESBR102
00486 * EXIT. DESBR102
00487 DESBR102