00001 IDENTIFICATION DIVISION. 07/26/02 00002 PROGRAM-ID. DTSBR763. DTSBR763 00003 AUTHOR. TRW LV042 00004 DATE-WRITTEN. SEPTEMBER 1999 DTSBR763 00005 DATE-COMPILED. DTSBR763 00006 DTSBR763 00007 ***** DTSBR763 00008 * DTSBR763 00009 * FUNCTION: LIST OF NEW EMPLOYERS WITHIN THE REPORTING PERIOD DTSBR763 00010 * FOR JOB SERVICE. DTSBR763 00011 * DTSBR763 00012 * CALLING SEQUENCE: DTSBD400 CALLS DTSBE763 DTSBR763 00013 * WHICH CREATES DTSIR763 RECORDS DTSBR763 00014 * DTSBD800 CALLS DTSBR763 DTSBR763 00015 * WHICH USES THE DTSIR763 RECORDS DTSBR763 00016 * TO FORMAT AND PRINT THE REPORT DTSBR763 00017 * DTSBR763 00018 * MODIFICATION HISTORY: DTSBR763 00019 * DTSBR763 00020 * 09-18-99 INITIAL DEVELOPMENT DTSBR763 00021 * REFERENCE DIR #00043 AUTHOR OF CHANGE - TKT DTSBR763 00022 * DTSBR763 00023 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR763 00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR763 00025 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR763 00026 * DTSBR763 00027 * DTSBR763 00028 * DESCRIPTION: DTSBR763 00029 * DTSBR763 00030 * THIS MODULE REPORTS ON ALL EMPLOYERS WHO WERE REGISTERED DTSBR763 00031 * WITHIN THE REPORTING PERIOD, ARE ACTIVE AS OF THE DTSBR763 00032 * EXTRACT RUN DATE, AND WHO EMPLOY AT LEAST 40 WORKERS. DTSBR763 00033 * DTSBR763 00034 * THIS IS AN "AT LEAST ONCE" MODULE. DTSBR763 00035 * DTSBR763 00036 * DTSBR763 00037 * RECORDS READ: DTSBR763 00038 * DTSBR763 00039 * NONE. DTSBR763 00040 * DTSBR763 00041 * DTSBR763 00042 * PRINTED OUTPUTS: DTSBR763 00043 * DTSBR763 00044 * 763R1 JOB SERVICE NEW EMPLOYERS LIST DTSBR763 00045 * DTSBR763 00046 * DTSBR763 00047 * RECORDS WRITTEN: DTSBR763 00048 * DTSBR763 00049 * NONE. DTSBR763 00050 * DTSBR763 00051 * DTSBR763 00052 * MODULES CALLED: DTSBR763 00053 * DTSBR763 00054 * NONE DTSBR763 00055 * DTSBR763 00056 * DTSBR763 00057 ***** DTSBR763 00058 DTSBR763 00059 ENVIRONMENT DIVISION. DTSBR763 00060 DTSBR763 00061 CONFIGURATION SECTION. DTSBR763 00062 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR763 00063 DTSBR763 00064 INPUT-OUTPUT SECTION. DTSBR763 00065 DTSBR763 00066 FILE-CONTROL. DTSBR763 00067 SELECT PRT-FILE ASSIGN TO RPT763R1. DTSBR763 00068 DTSBR763 00069 DATA DIVISION. DTSBR763 00070 DTSBR763 00071 FILE SECTION. DTSBR763 00072 DTSBR763 00073 FD PRT-FILE DTSBR763 00074 RECORDING MODE IS F. DTSBR763 00075 01 REPORT-LISTING1 PIC X(133). DTSBR763 00076 DTSBR763 00077 WORKING-STORAGE SECTION. DTSBR763 000775 77 PAN-VALET PICTURE X(24) VALUE '042DTSBR763 07/26/02'. DTSBR763 00078 DTSBR763 00079 01 WRK-AREA. DTSBR763 00080 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +763.DTSBR763 00081 DTSBR763 00082 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR763 00083 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR763 00084 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR763 00085 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBR763 00086 DTSBR763 00087 05 WS-VOICE-EXT-X. DTSBR763 00088 10 FILLER PIC X(01) VALUE 'X'. DTSBR763 00089 10 WS-EXT PIC X(04). DTSBR763 00090 DTSBR763 00091 05 WS-VOICE-EXT PIC X(05). DTSBR763 00092 05 WS-R763-EMP-STATUS PIC X(05) VALUE SPACES. DTSBR763 00093 DTSBR763 00094 05 WS-IDXX PIC X. DTSBR763 00095 05 WS-IDX REDEFINES WS-IDXX PIC 9. DTSBR763 00096 DTSBR763 00097 05 FIRST-TIME-IND PIC X VALUE 'Y'. DTSBR763 00098 DTSBR763 00099 05 WS-R763-VOICE. DTSBR763 00100 10 R763-VOICE-AREA-CD PIC X(03). DTSBR763 00101 10 FILLER PIC X VALUE '-'. DTSBR763 00102 10 R763-VOICE-PREFIX PIC X(03). DTSBR763 00103 10 FILLER PIC X VALUE '-'. DTSBR763 00104 10 R763-VOICE-SUFFIX PIC X(04). DTSBR763 00105 DTSBR763 00106 05 WS-VOICE PIC X(12). DTSBR763 00107 DTSBR763 00108 01 L001-LINK-AREA. DTSBR763 00109 ++INCLUDE DTSIL001 DTSBR763 00110 EJECT DTSBR763 00111 01 L112-LINK-AREA. DTSBR763 00112 ++INCLUDE DTSIL112 DTSBR763 00113 EJECT DTSBR763 00114 DTSBR763 00115 01 PAGE-HEADING. DTSBR763 00116 05 HDR-LINE-1. DTSBR763 00117 10 FILLER PIC X(01) VALUE SPACE. DTSBR763 00118 10 FILLER PIC X(05) DTSBR763 00119 VALUE '763R1'. DTSBR763 00120 10 FILLER PIC X(35) VALUE SPACES. DTSBR763 00121 10 HDR-AGY-NAME-LINE1 PIC X(50). DTSBR763 00122 10 FILLER PIC X(28) VALUE SPACES. DTSBR763 00123 10 FILLER PIC X(05) DTSBR763 00124 VALUE 'DATE:'. DTSBR763 00125 10 FILLER PIC X(01) VALUE SPACE. DTSBR763 00126 10 HDR-SYS-DATE PIC X(08). DTSBR763 00127 DTSBR763 00128 05 HDR-LINE-2. DTSBR763 00129 10 FILLER PIC X(41) VALUE SPACES. DTSBR763 00130 10 HDR-AGY-NAME-LINE2 PIC X(50). DTSBR763 00131 10 FILLER PIC X(28) VALUE SPACES. DTSBR763 00132 10 FILLER PIC X(05) DTSBR763 00133 VALUE 'TIME:'. DTSBR763 00134 10 FILLER PIC X(01) VALUE SPACE. DTSBR763 00135 10 HDR-SYS-TIME PIC X(08). DTSBR763 00136 DTSBR763 00137 05 HDR-LINE-3. DTSBR763 00138 10 FILLER PIC X(01) VALUE SPACE. DTSBR763 00139 10 FILLER PIC X(33) DTSBR763 00140 VALUE 'ROUTE TO: JOB SERVICE '. DTSBR763 00141 10 FILLER PIC X(85) VALUE SPACES. DTSBR763 00142 10 FILLER PIC X(05) DTSBR763 00143 VALUE 'PAGE:'. DTSBR763 00144 10 FILLER PIC X(03) VALUE SPACES. DTSBR763 00145 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DTSBR763 00146 DTSBR763 00147 05 HDR-LINE-4. DTSBR763 00148 10 FILLER PIC X(44) VALUE SPACES. DTSBR763 00149 10 FILLER PIC X(32) DTSBR763 00150 VALUE 'JOB SERVICE NEW AND REACTIVATED '. DTSBR763 00151 10 FILLER PIC X(14) DTSBR763 00152 VALUE 'EMPLOYERS LIST'. DTSBR763 00153 DTSBR763 00154 05 HDR-LINE-5. DTSBR763 00155 10 FILLER PIC X(54) VALUE SPACES. DTSBR763 00156 10 WS-START-DT PIC X(10). DTSBR763 00157 10 FILLER PIC X(06) DTSBR763 00158 VALUE ' THRU '. DTSBR763 00159 10 WS-END-DT PIC X(10). DTSBR763 00160 DTSBR763 00161 05 HDR-LINE-6 PIC X(133) VALUE SPACES. DTSBR763 00162 DTSBR763 00163 05 HDR-LINE-7. DTSBR763 00164 10 FILLER PIC X(05) VALUE SPACES. DTSBR763 00165 10 FILLER PIC X(08) DTSBR763 00166 VALUE 'INDUSTRY'. DTSBR763 00167 10 FILLER PIC X(06) VALUE SPACES. DTSBR763 00168 10 FILLER PIC X(12) DTSBR763 00169 VALUE 'PRIMARY NAME'. DTSBR763 00170 10 FILLER PIC X(30) VALUE SPACES. DTSBR763 00171 10 FILLER PIC X(15) DTSBR763 00172 VALUE 'MAILING ADDRESS'. DTSBR763 00173 10 FILLER PIC X(28) VALUE SPACES. DTSBR763 00174 10 FILLER PIC X(16) DTSBR763 00175 VALUE 'TELEPHONE NUMBER'. DTSBR763 00176 DTSBR763 00177 05 HDR-LINE-8. DTSBR763 00178 10 FILLER PIC X(25) VALUE SPACES. DTSBR763 00179 10 FILLER PIC X(11) DTSBR763 00180 VALUE 'EMP ACCT NO'. DTSBR763 00181 10 FILLER PIC X(08) VALUE SPACES. DTSBR763 00182 10 FILLER PIC X(09) DTSBR763 00183 VALUE 'NEW/REACT'. DTSBR763 00184 05 HDR-LINE-9 PIC X(133) VALUE SPACES. DTSBR763 00185 DTSBR763 00186 01 DETAIL-LINE-1. DTSBR763 00187 05 DTL1-LINE-2. DTSBR763 00188 10 FILLER PIC X(06) VALUE SPACES. DTSBR763 00189 10 DTL1-INDUSTRY-CODE PIC X(06). DTSBR763 00190 10 FILLER PIC X(05) VALUE SPACES. DTSBR763 00191 10 DTL1-PRIMARY-NAME PIC X(40). DTSBR763 00192 10 FILLER PIC X(02) VALUE SPACES. DTSBR763 00193 10 DTL1-MAILING-LINE-1 PIC X(40). DTSBR763 00194 10 FILLER PIC X(05) VALUE SPACES. DTSBR763 00195 10 DTL1-VOICE PIC X(12). DTSBR763 00196 10 FILLER PIC X(02) VALUE SPACES. DTSBR763 00197 10 DTL1-VOICE-EXT PIC X(05). DTSBR763 00198 DTSBR763 00199 01 DETAIL-LINE-2. DTSBR763 00200 05 DTL2-LINE-1. DTSBR763 00201 10 FILLER PIC X(27) VALUE SPACES. DTSBR763 00202 10 DTL2-EMP-NO PIC 999B999. DTSBR763 00203 10 FILLER PIC X(11) VALUE SPACES. DTSBR763 00204 10 DTL2-EMP-STATUS PIC X(05). DTSBR763 00205 10 FILLER PIC X(09) VALUE SPACES. DTSBR763 00206 10 DTL2-MAILING-LINE-2 PIC X(40). DTSBR763 00207 DTSBR763 00208 01 DETAIL-LINE-3. DTSBR763 00209 05 DTL3-LINE-1. DTSBR763 00210 10 FILLER PIC X(59) VALUE SPACES. DTSBR763 00211 10 DTL3-MAILING-LINE-3 PIC X(40). DTSBR763 00212 DTSBR763 00213 01 DETAIL-LINE-4. DTSBR763 00214 05 DTL4-LINE-1. DTSBR763 00215 10 FILLER PIC X(59) VALUE SPACES. DTSBR763 00216 10 DTL4-MAILING-LINE-4 PIC X(40). DTSBR763 00217 DTSBR763 00218 01 DETAIL-LINE-5. DTSBR763 00219 05 DTL5-LINE-1. DTSBR763 00220 10 FILLER PIC X(59) VALUE SPACES. DTSBR763 00221 10 DTL5-MAILING-LINE-5 PIC X(40). DTSBR763 00222 DTSBR763 00223 01 CONTROL-FOOTING-FINAL. DTSBR763 00224 05 CFF-LINE-2. DTSBR763 00225 10 FILLER PIC X(04) VALUE SPACES. DTSBR763 00226 10 FILLER PIC X(38) DTSBR763 00227 VALUE 'TOTAL NUMBER OF NEW EMPLOYERS WITH AT '. DTSBR763 00228 10 FILLER PIC X(18) DTSBR763 00229 VALUE 'LEAST 40 WORKERS: '. DTSBR763 00230 10 CFF-NUMBER-ONE PIC ZZ,ZZ9. DTSBR763 00231 DTSBR763 00232 05 CFF-LINE-6. DTSBR763 00233 10 FILLER PIC X(31) VALUE SPACES. DTSBR763 00234 10 FILLER PIC X(17) DTSBR763 00235 VALUE '*** END OF REPORT'. DTSBR763 00236 EJECT DTSBR763 00237 LINKAGE SECTION. DTSBR763 00238 DTSBR763 00239 01 LRCM-LINK-AREA. DTSBR763 00240 ++INCLUDE DTSILRCM DTSBR763 00241 EJECT DTSBR763 00242 01 R763-REC. DTSBR763 00243 ++INCLUDE DTSIR763 DTSBR763 00244 EJECT DTSBR763 00245 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR763 00246 R763-REC. DTSBR763 00247 DTSBR763 00248 IF FIRST-TIME-IND = 'Y' DTSBR763 00249 PERFORM I1000-INITIATE DTSBR763 00250 THRU I1000-EXIT DTSBR763 00251 MOVE 'N' TO FIRST-TIME-IND. DTSBR763 00252 DTSBR763 00253 IF LRCM-EOR-88 DTSBR763 00254 PERFORM T1000-TERMINATE DTSBR763 00255 THRU T1000-EXIT DTSBR763 00256 ELSE DTSBR763 00257 PERFORM P1000-PROCESS DTSBR763 00258 THRU P1000-EXIT. DTSBR763 00259 DTSBR763 00260 GOBACK. DTSBR763 00261 DTSBR763 00262 I1000-INITIATE. DTSBR763 00263 DTSBR763 00264 MOVE R763-START-DT TO L001-FED-8-DATE-9. DTSBR763 00265 PERFORM S001-FROM-FED-8 DTSBR763 00266 THRU S001-EXIT. DTSBR763 00267 MOVE L001-SLASH-8-DATE TO WS-START-DT. DTSBR763 00268 DTSBR763 00269 MOVE R763-END-DT TO L001-FED-8-DATE-9. DTSBR763 00270 PERFORM S001-FROM-FED-8 DTSBR763 00271 THRU S001-EXIT. DTSBR763 00272 MOVE L001-SLASH-8-DATE TO WS-END-DT. DTSBR763 00273 DTSBR763 00274 OPEN OUTPUT PRT-FILE. DTSBR763 00275 MOVE LRCM-SYS-DATE TO HDR-SYS-DATE. DTSBR763 00276 MOVE LRCM-SYS-TIME TO HDR-SYS-TIME. DTSBR763 00277 MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1. DTSBR763 00278 MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2. DTSBR763 00279 MOVE SPACES TO REPORT-LISTING1. DTSBR763 00280 DTSBR763 00281 I1000-EXIT. DTSBR763 00282 EXIT. DTSBR763 00283 DTSBR763 00284 P1000-PROCESS. DTSBR763 00285 DTSBR763 00286 SET L112-TAD-ADDR-88 TO TRUE. DTSBR763 00287 SET L112-ANCHOR-FIRST-88 TO TRUE DTSBR763 00288 MOVE R763-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBR763 00289 MOVE SPACES TO L112-NAME. DTSBR763 00290 MOVE SPACES TO L112-TITLE. DTSBR763 00291 DTSBR763 00292 MOVE R763-ADDRESS TO L112-ADDRESS. DTSBR763 00293 PERFORM S112-FORMAT-ADDR DTSBR763 00294 THRU S112-EXIT. DTSBR763 00295 DTSBR763 00296 PERFORM DTSBR763 00297 UNTIL L112-MAILING-LINE-1 NOT = SPACES DTSBR763 00298 PERFORM DTSBR763 00299 VARYING L112-MAILING-IDX FROM 1 BY 1 DTSBR763 00300 UNTIL L112-MAILING-IDX > 4 DTSBR763 00301 MOVE L112-MAILING-LINE (L112-MAILING-IDX + 1) DTSBR763 00302 TO L112-MAILING-LINE (L112-MAILING-IDX) DTSBR763 00303 END-PERFORM DTSBR763 00304 MOVE SPACES TO L112-MAILING-LINE-5 DTSBR763 00305 END-PERFORM. DTSBR763 00306 DTSBR763 00307 PERFORM DTSBR763 00308 VARYING L112-MAILING-IDX FROM 1 BY 1 DTSBR763 00309 UNTIL L112-MAILING-IDX > 5 DTSBR763 00310 IF L112-MAILING-LINE (L112-MAILING-IDX) > SPACES DTSBR763 00311 SET WS-IDX TO L112-MAILING-IDX DTSBR763 00312 EVALUATE WS-IDXX DTSBR763 00313 WHEN '1' DTSBR763 00314 PERFORM P2000-TELEPHONE-CHECK THRU P2000-EXIT DTSBR763 00315 MOVE R763-INDUSTRY-CODE TO DTL1-INDUSTRY-CODE DTSBR763 00316 MOVE R763-PRIMARY-NAME TO DTL1-PRIMARY-NAME DTSBR763 00317 MOVE L112-MAILING-LINE-1 TO DTL1-MAILING-LINE-1DTSBR763 00318 MOVE WS-VOICE TO DTL1-VOICE DTSBR763 00319 MOVE WS-VOICE-EXT TO DTL1-VOICE-EXT DTSBR763 00320 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR763 00321 WRITE REPORT-LISTING1 FROM DTL1-LINE-2 AFTER 2 DTSBR763 00322 ADD +2 TO WS-LINE-CNT2 DTSBR763 00323 ADD +1 TO WS-NUMBER-ONE DTSBR763 00324 WHEN '2' DTSBR763 00325 PERFORM P3000-STATUS-CHECK THRU P3000-EXIT DTSBR763 00326 MOVE R763-EMP-NO TO DTL2-EMP-NO DTSBR763 00327 MOVE WS-R763-EMP-STATUS TO DTL2-EMP-STATUS DTSBR763 00328 MOVE L112-MAILING-LINE-2 TO DTL2-MAILING-LINE-2DTSBR763 00329 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR763 00330 WRITE REPORT-LISTING1 FROM DTL2-LINE-1 AFTER 1 DTSBR763 00331 ADD +1 TO WS-LINE-CNT2 DTSBR763 00332 WHEN '3' DTSBR763 00333 MOVE L112-MAILING-LINE-3 TO DTL3-MAILING-LINE-3DTSBR763 00334 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR763 00335 WRITE REPORT-LISTING1 FROM DTL3-LINE-1 AFTER 1 DTSBR763 00336 ADD +1 TO WS-LINE-CNT2 DTSBR763 00337 WHEN '4' DTSBR763 00338 MOVE L112-MAILING-LINE-4 TO DTL4-MAILING-LINE-4DTSBR763 00339 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR763 00340 WRITE REPORT-LISTING1 FROM DTL4-LINE-1 AFTER 1 DTSBR763 00341 ADD +1 TO WS-LINE-CNT2 DTSBR763 00342 WHEN '5' DTSBR763 00343 MOVE L112-MAILING-LINE-5 TO DTL5-MAILING-LINE-5DTSBR763 00344 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR763 00345 WRITE REPORT-LISTING1 FROM DTL5-LINE-1 AFTER 1 DTSBR763 00346 ADD +1 TO WS-LINE-CNT2 DTSBR763 00347 END-EVALUATE DTSBR763 00348 END-IF DTSBR763 00349 END-PERFORM. DTSBR763 00350 P1000-EXIT. DTSBR763 00351 EXIT. DTSBR763 00352 DTSBR763 00353 P2000-TELEPHONE-CHECK. DTSBR763 00354 DTSBR763 00355 IF R763-VOICE NOT > SPACES DTSBR763 00356 MOVE SPACES TO WS-VOICE DTSBR763 00357 ELSE DTSBR763 00358 MOVE CORR R763-VOICE TO WS-R763-VOICE DTSBR763 00359 MOVE WS-R763-VOICE TO WS-VOICE. DTSBR763 00360 DTSBR763 00361 IF R763-VOICE-EXT NOT > SPACES DTSBR763 00362 MOVE SPACES TO WS-VOICE-EXT DTSBR763 00363 ELSE DTSBR763 00364 MOVE R763-VOICE-EXT TO WS-EXT DTSBR763 00365 MOVE WS-VOICE-EXT-X TO WS-VOICE-EXT. DTSBR763 00366 DTSBR763 00367 P2000-EXIT. DTSBR763 00368 EXIT. DTSBR763 00369 DTSBR763 00370 P3000-STATUS-CHECK. DTSBR763 00371 DTSBR763 00372 IF R763-EMP-STATUS = 'N' DTSBR763 00373 MOVE 'NEW ' TO WS-R763-EMP-STATUS DTSBR763 00374 ELSE DTSBR763 00375 MOVE 'REACT' TO WS-R763-EMP-STATUS DTSBR763 00376 END-IF. DTSBR763 00377 DTSBR763 00378 P3000-EXIT. DTSBR763 00379 EXIT. DTSBR763 00380 DTSBR763 00381 P4000-PRINT-HEADER. DTSBR763 00382 DTSBR763 00383 IF WS-LINE-CNT GREATER 56 OR DTSBR763 00384 WS-LINE-CNT2 GREATER 56 DTSBR763 00385 MOVE +0 TO WS-LINE-CNT DTSBR763 00386 MOVE +0 TO WS-LINE-CNT2 DTSBR763 00387 ADD +1 TO WS-PAGE-CNT DTSBR763 00388 MOVE WS-PAGE-CNT TO HDR-PAGE-CNT DTSBR763 00389 WRITE REPORT-LISTING1 FROM HDR-LINE-1 DTSBR763 00390 AFTER TOP-OF-PAGE DTSBR763 00391 WRITE REPORT-LISTING1 FROM HDR-LINE-2 AFTER 1 DTSBR763 00392 WRITE REPORT-LISTING1 FROM HDR-LINE-3 AFTER 1 DTSBR763 00393 WRITE REPORT-LISTING1 FROM HDR-LINE-4 AFTER 1 DTSBR763 00394 WRITE REPORT-LISTING1 FROM HDR-LINE-5 AFTER 1 DTSBR763 00395 WRITE REPORT-LISTING1 FROM HDR-LINE-6 AFTER 1 DTSBR763 00396 WRITE REPORT-LISTING1 FROM HDR-LINE-7 AFTER 1 DTSBR763 00397 WRITE REPORT-LISTING1 FROM HDR-LINE-8 AFTER 1 DTSBR763 00398 WRITE REPORT-LISTING1 FROM HDR-LINE-9 AFTER 1 DTSBR763 00399 ADD +9 TO WS-LINE-CNT2. DTSBR763 00400 DTSBR763 00401 P4000-EXIT. DTSBR763 00402 EXIT. DTSBR763 00403 DTSBR763 00404 T1000-TERMINATE. DTSBR763 00405 DTSBR763 00406 MOVE WS-NUMBER-ONE TO CFF-NUMBER-ONE. DTSBR763 00407 WRITE REPORT-LISTING1 FROM CFF-LINE-2 AFTER 4. DTSBR763 00408 WRITE REPORT-LISTING1 FROM CFF-LINE-6 AFTER 2. DTSBR763 00409 CLOSE PRT-FILE. DTSBR763 00410 DTSBR763 00411 T1000-EXIT. DTSBR763 00412 EXIT. DTSBR763 00413 DTSBR763 00414 S001-FROM-FED-8. DTSBR763 00415 SET L001-FROM-FED-8 TO TRUE. DTSBR763 00416 GO TO S001-DATE. DTSBR763 00417 DTSBR763 00418 S001-DATE. DTSBR763 00419 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR763 00420 S001-EXIT. DTSBR763 00421 DTSBR763 00422 S112-FORMAT-ADDR. DTSBR763 00423 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBR763 00424 S112-EXIT. DTSBR763 00425 EXIT. DTSBR763 00426 DTSBR763 00427 *S999-ABEND. DTSBR763 00428 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR763 00429 *S999-EXIT. DTSBR763 00430 * EXIT. DTSBR763 00431 DTSBR763