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

428
Batch/DTSBR123.cob Normal file
View File

@ -0,0 +1,428 @@
00001 IDENTIFICATION DIVISION. 01/29/01
00002 PROGRAM-ID. DTSBR123. DTSBR123
00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION. LV017
00004 UPDATED BY TRW/BDM OCT 1998. DTSBR123
00005 DATE-WRITTEN. AUGUST 1998. DTSBR123
00006 DATE-COMPILED. DTSBR123
00007 DTSBR123
00008 ***** DTSBR123
00009 * DTSBR123
00010 * CALLING SEQUENCE: DTSBD400 CALLS DTSBR123
00011 * DTSBE123 WHICH WRITES DTSIR123 DTSBR123
00012 * DTSBR123 READS DTSIR122 RECORDS. DTSBR123
00013 * DTSBR123
00014 * SELECTED CYCLE A STATUS CODES. DTSBR123
00015 * DTSBR123
00016 * DTSBR123
00017 * MODIFICATION HISTORY: DTSBR123
00018 * DTSBR123
00019 * 11-08-94 INITIAL DEVELOPMENT DTSBR123
00020 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR123
00021 * DTSBR123
00022 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR123
00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR123
00024 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR123
00025 * DTSBR123
00026 * DTSBR123
00027 * DESCRIPTION: DTSBR123
00028 * DTSBR123
00029 * THIS MODULE PRODUCES A PERIODIC LIST OF ALL EMPLOYERS DTSBR123
00030 * WITH CYCLE A STATUS CODES OF 04, 05, 09 AND 11. DTSBR123
00031 * DTSBR123
00032 * DTSBR123
00033 * RECORDS READ: DTSBR123
00034 * DTSBR123
00035 * NONE. DTSBR123
00036 * DTSBR123
00037 * DTSBR123
00038 * PRINTED OUTPUTS: DTSBR123
00039 * DTSBR123
00040 * 123R1 POTENTIAL EMPLOYERS WITH SELECTED CYCLE A STATUS DTSBR123
00041 * CODES DTSBR123
00042 * DTSBR123
00043 * DTSBR123
00044 * RECORDS WRITTEN: DTSBR123
00045 * DTSBR123
00046 * NONE. DTSBR123
00047 * DTSBR123
00048 * DTSBR123
00049 * MODULES CALLED: DTSBR123
00050 * DTSBR123
00051 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBR123
00052 * DTSBU031 REGISTRATION CODES EDIT/DESCRIPTION MODULE DTSBR123
00053 * DTSBU071 NAME EDIT/CONVERSION MODULE DTSBR123
00054 * DTSBU082 OPERATOR ID EDIT/LOOKUP MODULE DTSBR123
00055 * DTSBR123
00056 * DTSBR123
00057 ***** DTSBR123
00058 EJECT DTSBR123
00059 ENVIRONMENT DIVISION. DTSBR123
00060 DTSBR123
00061 CONFIGURATION SECTION. DTSBR123
00062 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR123
00063 DTSBR123
00064 INPUT-OUTPUT SECTION. DTSBR123
00065 DTSBR123
00066 FILE-CONTROL. DTSBR123
00067 SELECT PRT-FILE ASSIGN TO RPT123R1. DTSBR123
00068 DTSBR123
00069 DATA DIVISION. DTSBR123
00070 DTSBR123
00071 FILE SECTION. DTSBR123
00072 DTSBR123
00073 FD PRT-FILE DTSBR123
00074 RECORDING MODE IS F. DTSBR123
00075 01 PRT-RECORD PIC X(133). DTSBR123
00076 DTSBR123
00077 WORKING-STORAGE SECTION. DTSBR123
000775 77 PAN-VALET PICTURE X(24) VALUE '017DTSBR123 01/29/01'. DTSBR123
00078 DTSBR123
00079 01 WRK-AREA. DTSBR123
00080 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +123.DTSBR123
00081 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR123
00082 05 WS-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR123
00083 05 WS-NUMBER-TWO PIC S9(03) COMP-3 VALUE +0. DTSBR123
00084 05 WS-OP-ID-HOLD PIC X(08) VALUE SPACES. DTSBR123
00085 05 WS-OP-ID-NAME-PREV PIC X(32) VALUE SPACES. DTSBR123
00086 05 WS-STATUS-CD-HOLD PIC X(02) VALUE SPACES. DTSBR123
00087 05 WS-STATUS-CODE-SHORT-DSCR PIC X(10) VALUE SPACES. DTSBR123
00088 DTSBR123
00089 05 WS-FOOT-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR123
00090 05 WS-FOOT-NUMBER-TWO PIC S9(03) COMP-3 VALUE +0. DTSBR123
00091 05 WS-SUM-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR123
00092 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR123
00093 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR123
00094 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR123
00095 DTSBR123
00096 05 WS-STATUS-CODE9-FORMAT-DSCR. DTSBR123
00097 10 FILLER PIC X(02) VALUE SPACES. DTSBR123
00098 10 WS-STATUS-CODE9-DSCR PIC X(06) VALUE SPACES. DTSBR123
00099 10 FILLER PIC X(02) VALUE SPACES. DTSBR123
00100 EJECT DTSBR123
00101 01 L001-LINK-AREA. DTSBR123
00102 ++INCLUDE DTSIL001 DTSBR123
00103 EJECT DTSBR123
00104 01 L031-LINK-AREA. DTSBR123
00105 ++INCLUDE DTSIL031 DTSBR123
00106 EJECT DTSBR123
00107 01 L071-LINK-AREA. DTSBR123
00108 ++INCLUDE DTSIL071 DTSBR123
00109 EJECT DTSBR123
00110 01 L082-LINK-AREA. DTSBR123
00111 ++INCLUDE DTSIL082 DTSBR123
00112 EJECT DTSBR123
00113 DTSBR123
00114 01 HEADER-1. DTSBR123
00115 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00116 05 FILLER PIC X(05) VALUE DTSBR123
00117 '123R1'. DTSBR123
00118 05 FILLER PIC X(35) VALUE SPACES. DTSBR123
00119 05 WS-AGY-NAME-LINE1 PIC X(50). DTSBR123
00120 05 FILLER PIC X(28) VALUE SPACES. DTSBR123
00121 05 FILLER PIC X(05) VALUE DTSBR123
00122 'DATE:'. DTSBR123
00123 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00124 05 WS-SYS-DATE PIC X(08). DTSBR123
00125 01 HEADER-2. DTSBR123
00126 05 FILLER PIC X(41) VALUE SPACES. DTSBR123
00127 05 WS-AGY-NAME-LINE2 PIC X(50). DTSBR123
00128 05 FILLER PIC X(28) VALUE SPACES. DTSBR123
00129 05 FILLER PIC X(05) VALUE DTSBR123
00130 'TIME:'. DTSBR123
00131 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00132 05 WS-SYS-TIME PIC X(08). DTSBR123
00133 01 HEADER-3. DTSBR123
00134 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00135 05 FILLER PIC X(33) VALUE DTSBR123
00136 'ROUTE TO: REGISTRATION AND RATES'. DTSBR123
00137 05 FILLER PIC X(05) VALUE SPACES. DTSBR123
00138 05 FILLER PIC X(40) VALUE DTSBR123
00139 'POTENTIAL EMPLOYERS WITH SELECTED CYCLE '. DTSBR123
00140 05 FILLER PIC X(14) DTSBR123
00141 VALUE 'A STATUS CODES'. DTSBR123
00142 05 FILLER PIC X(26) VALUE SPACES. DTSBR123
00143 05 FILLER PIC X(05) VALUE DTSBR123
00144 'PAGE:'. DTSBR123
00145 05 FILLER PIC X(03) VALUE SPACES. DTSBR123
00146 05 HDR3-PAGE-CNT PIC ZZ,ZZ9. DTSBR123
00147 01 HEADER-4 PIC X(133) VALUE SPACES. DTSBR123
00148 01 HEADER-5. DTSBR123
00149 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00150 05 FILLER PIC X(11) VALUE DTSBR123
00151 'RESP OPID: '. DTSBR123
00152 05 WS-RESPONSIBLE-OP-ID PIC X(08). DTSBR123
00153 05 FILLER PIC X(03) VALUE SPACE. DTSBR123
00154 05 WS-OP-ID-NAME PIC X(32). DTSBR123
00155 01 HEADER-6 PIC X(133) VALUE SPACES. DTSBR123
00156 01 HEADER-7 PIC X(133) VALUE SPACES. DTSBR123
00157 01 HEADER-8. DTSBR123
00158 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00159 05 FILLER PIC X(21) VALUE DTSBR123
00160 'CYCLE A STATUS CODE: '. DTSBR123
00161 05 WS-STATUS-CD PIC X(02). DTSBR123
00162 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00163 05 WS-STATUS-CODE-SHORT-DSCR-8 PIC X(10). DTSBR123
00164 01 HEADER-9. DTSBR123
00165 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00166 05 WS-STATUS-CODE-SHORT-DSCR-9 PIC X(10). DTSBR123
00167 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00168 05 FILLER PIC X(15) VALUE DTSBR123
00169 'DATE PRIOR TO: '. DTSBR123
00170 05 WS-CUTOFF-DATE PIC X(08). DTSBR123
00171 01 HEADER-10 PIC X(133) VALUE SPACES. DTSBR123
00172 01 HEADER-11 PIC X(133) VALUE SPACES. DTSBR123
00173 01 HEADER-12. DTSBR123
00174 05 FILLER PIC X(70) VALUE SPACES. DTSBR123
00175 05 WS-PRINT-STATUS-CODE9-DSCR PIC X(10). DTSBR123
00176 05 FILLER PIC X(07) VALUE SPACES. DTSBR123
00177 05 FILLER PIC X(09) VALUE DTSBR123
00178 'FIELD REP'. DTSBR123
00179 01 HEADER-13. DTSBR123
00180 05 FILLER PIC X(09) VALUE SPACES. DTSBR123
00181 05 FILLER PIC X(06) VALUE DTSBR123
00182 'EMP NO'. DTSBR123
00183 05 FILLER PIC X(06) VALUE SPACES. DTSBR123
00184 05 FILLER PIC X(13) VALUE DTSBR123
00185 'PRIMARY NAME '. DTSBR123
00186 05 FILLER PIC X(39) VALUE SPACES. DTSBR123
00187 05 FILLER PIC X(04) VALUE DTSBR123
00188 'DATE'. DTSBR123
00189 05 FILLER PIC X(12) VALUE SPACES. DTSBR123
00190 05 FILLER PIC X(04) VALUE DTSBR123
00191 'CODE'. DTSBR123
00192 DTSBR123
00193 01 DETAIL-LINE-2. DTSBR123
00194 05 FILLER PIC X(08) VALUE SPACES. DTSBR123
00195 05 WS-EMP-NO PIC 999B999. DTSBR123
00196 05 FILLER PIC X(06) VALUE SPACES. DTSBR123
00197 05 WS-PRIMARY-NAME PIC X(40). DTSBR123
00198 05 FILLER PIC X(09) VALUE SPACES. DTSBR123
00199 05 WS-CHNG-DATE PIC X(08). DTSBR123
00200 05 FILLER PIC X(12) VALUE SPACES. DTSBR123
00201 05 WS-FLD-REP-ID PIC X(02). DTSBR123
00202 DTSBR123
00203 01 FOOTER-STA-CD-LINE-3. DTSBR123
00204 05 FILLER PIC X(35) VALUE SPACES. DTSBR123
00205 05 WS-RSP-STA-CD-CNT PIC ZZ,ZZ9. DTSBR123
00206 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00207 05 FILLER PIC X(40) VALUE DTSBR123
00208 'EMPLOYERS FOR RESPONSIBLE OPID/STATUS CO'. DTSBR123
00209 05 FILLER PIC X(02) VALUE DTSBR123
00210 'DE'. DTSBR123
00211 DTSBR123
00212 01 FOOTER-RSP-CD-LINE-3. DTSBR123
00213 05 FILLER PIC X(35) VALUE SPACES. DTSBR123
00214 05 WS-RSP-CD-CNT PIC ZZ,ZZ9. DTSBR123
00215 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00216 05 FILLER PIC X(30) VALUE DTSBR123
00217 'EMPLOYERS FOR RESPONSIBLE OPID'. DTSBR123
00218 DTSBR123
00219 01 SUM-LINE-3. DTSBR123
00220 05 FILLER PIC X(35) VALUE SPACES. DTSBR123
00221 05 SUM-NUMBER-ONE PIC ZZ,ZZ9. DTSBR123
00222 05 FILLER PIC X(01) VALUE SPACE. DTSBR123
00223 05 FILLER PIC X(30) VALUE DTSBR123
00224 'EMPLOYERS LISTED ON REPORT '. DTSBR123
00225 EJECT DTSBR123
00226 LINKAGE SECTION. DTSBR123
00227 DTSBR123
00228 01 LRCM-LINK-AREA. DTSBR123
00229 ++INCLUDE DTSILRCM DTSBR123
00230 EJECT DTSBR123
00231 01 R123-REC. DTSBR123
00232 ++INCLUDE DTSIR123 DTSBR123
00233 EJECT DTSBR123
00234 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR123
00235 R123-REC. DTSBR123
00236 DTSBR123
00237 IF FIRST-TIME-IND = 'Y' DTSBR123
00238 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR123
00239 MOVE 'N' TO FIRST-TIME-IND. DTSBR123
00240 DTSBR123
00241 IF LRCM-EOR-88 DTSBR123
00242 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR123
00243 ELSE DTSBR123
00244 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR123
00245 DTSBR123
00246 GOBACK. DTSBR123
00247 EJECT DTSBR123
00248 I1000-INITIATE. DTSBR123
00249 DTSBR123
00250 OPEN OUTPUT PRT-FILE. DTSBR123
00251 MOVE SPACES TO WS-OP-ID-HOLD WS-STATUS-CD-HOLD. DTSBR123
00252 MOVE LRCM-SYS-DATE TO WS-SYS-DATE. DTSBR123
00253 MOVE LRCM-SYS-TIME TO WS-SYS-TIME. DTSBR123
00254 MOVE LRCM-AGY-NAME-LINE1 TO WS-AGY-NAME-LINE1. DTSBR123
00255 MOVE LRCM-AGY-NAME-LINE2 TO WS-AGY-NAME-LINE2. DTSBR123
00256 MOVE SPACES TO PRT-RECORD. DTSBR123
00257 DTSBR123
00258 I1000-EXIT. DTSBR123
00259 EXIT. DTSBR123
00260 EJECT DTSBR123
00261 P1000-PROCESS. DTSBR123
00262 DTSBR123
00263 IF R123-RESPONSIBLE-OP-ID NOT = WS-OP-ID-HOLD DTSBR123
00264 MOVE R123-RESPONSIBLE-OP-ID TO WS-OP-ID-HOLD DTSBR123
00265 L082-OP-ID DTSBR123
00266 PERFORM S082-OP-ID-INFO THRU S082-EXIT DTSBR123
00267 MOVE L082-NAME TO L071-NAM DTSBR123
00268 SET L071-FROM-LAST-NAME-FIRST TO TRUE DTSBR123
00269 PERFORM S071-DESLASH-NAME THRU S071-EXIT DTSBR123
00270 MOVE L071-NAM TO WS-OP-ID-NAME DTSBR123
00271 * DTSBR123
00272 IF WS-NUMBER-ONE = +0 AND WS-NUMBER-TWO = +0 DTSBR123
00273 MOVE +99 TO WS-NUMBER-ONE WS-NUMBER-TWO DTSBR123
00274 ELSE DTSBR123
00275 PERFORM P4000-PRINT-FOOTER THRU P4000-EXIT DTSBR123
00276 MOVE +60 TO WS-LINE-CNT2 DTSBR123
00277 END-IF. DTSBR123
00278 * DTSBR123
00279 IF R123-STATUS-CD NOT = WS-STATUS-CD-HOLD DTSBR123
00280 MOVE R123-STATUS-CD TO WS-STATUS-CD-HOLD DTSBR123
00281 L031-CD-2 WS-STATUS-CD DTSBR123
00282 SET L031-MERA-STATUS-CD TO TRUE DTSBR123
00283 PERFORM S031-CODES-DESCRIPTION THRU S031-EXIT DTSBR123
00284 MOVE L031-SHORT-DSCR TO WS-STATUS-CODE-SHORT-DSCR DTSBR123
00285 MOVE WS-STATUS-CODE-SHORT-DSCR TO WS-STATUS-CODE9-DSCR DTSBR123
00286 WS-STATUS-CODE-SHORT-DSCR-8 DTSBR123
00287 WS-STATUS-CODE-SHORT-DSCR-9 DTSBR123
00288 MOVE WS-STATUS-CODE9-FORMAT-DSCR TO DTSBR123
00289 WS-PRINT-STATUS-CODE9-DSCR DTSBR123
00290 MOVE R123-STATUS-CUTOFF-DATE TO L001-FED-8-DATE-9 DTSBR123
00291 SET L001-FROM-FED-8 TO TRUE DTSBR123
00292 PERFORM S001-DATE THRU S001-EXIT DTSBR123
00293 MOVE L001-SLASH-DATE TO WS-CUTOFF-DATE DTSBR123
00294 * DTSBR123
00295 IF WS-FOOT-NUMBER-ONE NOT = +0 DTSBR123
00296 PERFORM P3000-PRINT-FOOTER THRU P3000-EXIT DTSBR123
00297 MOVE +60 TO WS-LINE-CNT2 DTSBR123
00298 END-IF. DTSBR123
00299 * DTSBR123
00300 MOVE R123-STATUS-CHNG-DATE TO L001-FED-8-DATE-9. DTSBR123
00301 SET L001-FROM-FED-8 TO TRUE. DTSBR123
00302 PERFORM S001-DATE THRU S001-EXIT. DTSBR123
00303 MOVE L001-SLASH-DATE TO WS-CHNG-DATE. DTSBR123
00304 * DTSBR123
00305 ADD +1 TO WS-FOOT-NUMBER-TWO. DTSBR123
00306 ADD +1 TO WS-FOOT-NUMBER-ONE. DTSBR123
00307 MOVE R123-RESPONSIBLE-OP-ID TO WS-RESPONSIBLE-OP-ID. DTSBR123
00308 MOVE R123-EMP-NO TO WS-EMP-NO. DTSBR123
00309 MOVE R123-PRIMARY-NAME TO WS-PRIMARY-NAME. DTSBR123
00310 MOVE R123-FLD-REP-ID TO WS-FLD-REP-ID. DTSBR123
00311 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR123
00312 WRITE PRT-RECORD FROM DETAIL-LINE-2 AFTER 2. DTSBR123
00313 ADD +2 TO WS-LINE-CNT2. DTSBR123
00314 ADD +1 TO WS-SUM-NUMBER-ONE. DTSBR123
00315 DTSBR123
00316 P1000-EXIT. DTSBR123
00317 EXIT. DTSBR123
00318 EJECT DTSBR123
00319 DTSBR123
00320 P2000-PRINT-HEADER. DTSBR123
00321 IF WS-LINE-CNT GREATER 58 OR DTSBR123
00322 WS-LINE-CNT2 GREATER 58 DTSBR123
00323 MOVE +0 TO WS-LINE-CNT DTSBR123
00324 MOVE +0 TO WS-LINE-CNT2 DTSBR123
00325 ADD +1 TO WS-PAGE-CNT DTSBR123
00326 MOVE WS-PAGE-CNT TO HDR3-PAGE-CNT DTSBR123
00327 MOVE WS-OP-ID-NAME TO WS-OP-ID-NAME-PREV DTSBR123
00328 WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE DTSBR123
00329 WRITE PRT-RECORD FROM HEADER-2 AFTER 1 DTSBR123
00330 WRITE PRT-RECORD FROM HEADER-3 AFTER 1 DTSBR123
00331 WRITE PRT-RECORD FROM HEADER-4 AFTER 1 DTSBR123
00332 WRITE PRT-RECORD FROM HEADER-5 AFTER 1 DTSBR123
00333 WRITE PRT-RECORD FROM HEADER-6 AFTER 1 DTSBR123
00334 WRITE PRT-RECORD FROM HEADER-7 AFTER 1 DTSBR123
00335 WRITE PRT-RECORD FROM HEADER-8 AFTER 1 DTSBR123
00336 WRITE PRT-RECORD FROM HEADER-9 AFTER 1 DTSBR123
00337 WRITE PRT-RECORD FROM HEADER-10 AFTER 1 DTSBR123
00338 WRITE PRT-RECORD FROM HEADER-11 AFTER 1 DTSBR123
00339 WRITE PRT-RECORD FROM HEADER-12 AFTER 1 DTSBR123
00340 WRITE PRT-RECORD FROM HEADER-13 AFTER 1 DTSBR123
00341 ADD +13 TO WS-LINE-CNT2. DTSBR123
00342 P2000-EXIT. DTSBR123
00343 EXIT. DTSBR123
00344 DTSBR123
00345 P3000-PRINT-FOOTER. DTSBR123
00346 IF WS-LINE-CNT2 > 52 DTSBR123
00347 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DTSBR123
00348 END-IF. DTSBR123
00349 DTSBR123
00350 MOVE WS-FOOT-NUMBER-ONE TO WS-RSP-STA-CD-CNT. DTSBR123
00351 WRITE PRT-RECORD FROM FOOTER-STA-CD-LINE-3 AFTER 3. DTSBR123
00352 MOVE +0 TO WS-FOOT-NUMBER-ONE. DTSBR123
00353 DTSBR123
00354 P3000-EXIT. DTSBR123
00355 EXIT. DTSBR123
00356 DTSBR123
00357 P4000-PRINT-FOOTER. DTSBR123
00358 IF WS-LINE-CNT2 > 52 DTSBR123
00359 MOVE WS-OP-ID-NAME-PREV TO WS-OP-ID-NAME DTSBR123
00360 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DTSBR123
00361 MOVE L071-NAM TO WS-OP-ID-NAME DTSBR123
00362 END-IF. DTSBR123
00363 DTSBR123
00364 MOVE WS-FOOT-NUMBER-ONE TO WS-RSP-STA-CD-CNT DTSBR123
00365 WRITE PRT-RECORD FROM FOOTER-STA-CD-LINE-3 AFTER 3. DTSBR123
00366 MOVE WS-FOOT-NUMBER-TWO TO WS-RSP-CD-CNT DTSBR123
00367 WRITE PRT-RECORD FROM FOOTER-RSP-CD-LINE-3 AFTER 3. DTSBR123
00368 MOVE +0 TO WS-FOOT-NUMBER-TWO. DTSBR123
00369 MOVE +0 TO WS-FOOT-NUMBER-ONE. DTSBR123
00370 DTSBR123
00371 P4000-EXIT. DTSBR123
00372 EXIT. DTSBR123
00373 DTSBR123
00374 T1000-TERMINATE. DTSBR123
00375 DTSBR123
00376 IF WS-LINE-CNT2 > 52 DTSBR123
00377 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DTSBR123
00378 END-IF. DTSBR123
00379 DTSBR123
00380 MOVE WS-FOOT-NUMBER-ONE TO WS-RSP-STA-CD-CNT. DTSBR123
00381 MOVE WS-FOOT-NUMBER-TWO TO WS-RSP-CD-CNT. DTSBR123
00382 WRITE PRT-RECORD FROM FOOTER-STA-CD-LINE-3 AFTER 3. DTSBR123
00383 WRITE PRT-RECORD FROM FOOTER-RSP-CD-LINE-3 AFTER 3. DTSBR123
00384 DTSBR123
00385 MOVE WS-SUM-NUMBER-ONE TO SUM-NUMBER-ONE. DTSBR123
00386 WRITE PRT-RECORD FROM SUM-LINE-3 AFTER 3. DTSBR123
00387 DTSBR123
00388 CLOSE PRT-FILE. DTSBR123
00389 DTSBR123
00390 T1000-EXIT. DTSBR123
00391 EXIT. DTSBR123
00392 EJECT DTSBR123
00393 S001-DATE. DTSBR123
00394 DTSBR123
00395 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR123
00396 DTSBR123
00397 S001-EXIT. DTSBR123
00398 EXIT. DTSBR123
00399 DTSBR123
00400 S031-CODES-DESCRIPTION. DTSBR123
00401 DTSBR123
00402 CALL 'DTSBU031' USING L031-LINK-AREA. DTSBR123
00403 DTSBR123
00404 S031-EXIT. DTSBR123
00405 EXIT. DTSBR123
00406 DTSBR123
00407 S071-DESLASH-NAME. DTSBR123
00408 DTSBR123
00409 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR123
00410 DTSBR123
00411 S071-EXIT. DTSBR123
00412 EXIT. DTSBR123
00413 DTSBR123
00414 S082-OP-ID-INFO. DTSBR123
00415 DTSBR123
00416 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR123
00417 DTSBR123
00418 S082-EXIT. DTSBR123
00419 EXIT. DTSBR123
00420 DTSBR123
00421 S999-ABEND. DTSBR123
00422 DTSBR123
00423 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR123
00424 DTSBR123
00425 S999-EXIT. DTSBR123
00426 EXIT. DTSBR123
00427 DTSBR123