00001 IDENTIFICATION DIVISION. 10/27/98 00002 PROGRAM-ID. DTSBE125. DTSBE125 00003 AUTHOR. BDM. LV002 00004 DATE-WRITTEN. AUGUST 1998. DTSBE125 00005 DATE-COMPILED. DTSBE125 00006 SKIP3 DTSBE125 00007 ***** DTSBE125 00008 * DTSBE125 00009 * CALLING SEQUENCE: DTSBD400 CALLS DTSBE125 00010 * DTSBE125 WHICH UPDATES DTSIR125 DTSBE125 00011 * DTSBR125 READS DTSIR125 RECORDS. DTSBE125 00012 * DTSBE125 00013 * DTSBE125 00014 * FUNCTION: CREATE A REPORT RECORD TO BE USED BY DTSBR125. DTSBE125 00015 * MODIFICATION LOG: DTSBE125 00016 * DTSBE125 00017 * 03/26/95 MODIFIED MERA-STATUS-CODE VALUES REPORTED. DTSBE125 00018 * WORK ORDER: CR065 PROGRAMMER: EHH DTSBE125 00019 * DTSBE125 00020 * 10/21/98 MODIFIED P0000-PROCESS TO EXIT THE ROUTINE WHEN DTSBE125 00021 * MPRF-EMP-CLASS NOT = 'S' OR 'R' OR 'U'. DTSBE125 00022 * WORK ORDER: PROGRAMMER: DVS DTSBE125 00023 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00026 * WORK ORDER: PROGRAMMER: XXX CL**2 00027 * DTSBE125 00028 * DESCRIPTION: DTSBE125 00029 * DTSBE125 00030 * DTSBE125 00031 * INITIALIZATION: DTSBE125 00032 * DTSBE125 00033 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE125 00034 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE125 00035 * DTSBE125 00036 * EDIT PARAMTERS (SEE 125R1). DTSBE125 00037 * DTSBE125 00038 * DTSBE125 00039 * PROCESSING: DTSBE125 00040 * DTSBE125 00041 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (125R1). DTSBE125 00042 * DTSBE125 00043 * DTSBE125 00044 * TERMINATION: DTSBE125 00045 * DTSBE125 00046 * NONE. DTSBE125 00047 * DTSBE125 00048 * DTSBE125 00049 * RECORDS READ: DTSBE125 00050 * DTSBE125 00051 * MASTER: DTSBE125 00052 * DTSBE125 00053 * MSOL. DTSBE125 00054 * DTSBE125 00055 * DTSBE125 00056 * ALTERNATE INDEX: DTSBE125 00057 * DTSBE125 00058 * NONE. DTSBE125 00059 * DTSBE125 00060 * DTSBE125 00061 * REFERENCE: DTSBE125 00062 * DTSBE125 00063 * NONE. DTSBE125 00064 * DTSBE125 00065 * DTSBE125 00066 * RECORDS UPDATED: DTSBE125 00067 * DTSBE125 00068 * NONE. DTSBE125 00069 * DTSBE125 00070 * DTSBE125 00071 * REPORT RECORDS WRITTEN: DTSBE125 00072 * DTSBE125 00073 * R125 EMPLOYER ALPHA LIST IN NAME ORDER. DTSBE125 00074 * DTSBE125 00075 * DTSBE125 00076 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE125 00077 * DTSBE125 00078 * NONE. DTSBE125 00079 * DTSBE125 00080 * DTSBE125 00081 * MODULES CALLED: DTSBE125 00082 * DTSBE125 00083 * DTSBU061 FIELD ZIP / FIELD REP ID. DTSBE125 00084 * DTSBU910 MASTER FILE I/O. DTSBE125 00085 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE125 00086 ***** DTSBE125 00087 SKIP3 DTSBE125 00088 ENVIRONMENT DIVISION. DTSBE125 00089 SKIP3 DTSBE125 00090 DATA DIVISION. DTSBE125 00091 SKIP3 DTSBE125 00092 WORKING-STORAGE SECTION. DTSBE125 000925 77 PAN-VALET PICTURE X(24) VALUE '002DTSBE125 10/27/98'. DTSBE125 00093 SKIP3 DTSBE125 00094 01 WRK-AREA. DTSBE125 00095 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +125.DTSBE125 00096 SKIP1 DTSBE125 00097 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE125'.DTSBE125 00098 SKIP3 DTSBE125 00099 05 ABEND-MSG PIC X(60). DTSBE125 00100 SKIP3 DTSBE125 00101 EJECT DTSBE125 00102 01 WK-LIAB-DATE PIC S9(09) COMP-3. DTSBE125 00103 01 WK-INACT-DATE PIC S9(09) COMP-3. DTSBE125 00104 *& IN THIS PROGRAM IT IS EASIER TO CHECK THE RETURN DTSBE125 00105 *& CODE FROM THE I-O MODULE DIRECTLY. DTSBE125 00106 *01 L910-STATUS PIC X(01). DTSBE125 00107 * 88 OK-88 VALUE '0'. DTSBE125 00108 * 88 NO-REC-88 VALUE '1'. DTSBE125 00109 01 L910-LINK-AREA. DTSBE125 00110 ++INCLUDE DTSIL910 DTSBE125 00111 SKIP3 DTSBE125 00112 01 L061-LINK-AREA. DTSBE125 00113 ++INCLUDE DTSIL061 DTSBE125 00114 SKIP3 DTSBE125 00115 01 MSKL-REC. DTSBE125 00116 ++INCLUDE DTSIMSKL DTSBE125 00117 EJECT DTSBE125 00118 01 R125-REC. DTSBE125 00119 ++INCLUDE DTSIR125 DTSBE125 00120 EJECT DTSBE125 00121 01 MSOL-REC. DTSBE125 00122 ++INCLUDE DTSIMSOL DTSBE125 00123 EJECT DTSBE125 00124 LINKAGE SECTION. DTSBE125 00125 SKIP3 DTSBE125 00126 01 LECM-LINK-AREA. DTSBE125 00127 ++INCLUDE DTSILECM DTSBE125 00128 EJECT DTSBE125 00129 01 MPRF-LINK-REC. DTSBE125 00130 ++INCLUDE DTSIMPRF DTSBE125 00131 EJECT DTSBE125 00132 ************************************************************** DTSBE125 00133 * PROCEDURE DIVISION FOR DTSBE125 * DTSBE125 00134 * EXTRACT STARTS HERE. * DTSBE125 00135 ************************************************************** DTSBE125 00136 DTSBE125 00137 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE125 00138 MPRF-LINK-REC. DTSBE125 00139 SKIP2 DTSBE125 00140 IF LECM-PROCESS-88 DTSBE125 00141 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE125 00142 ELSE DTSBE125 00143 IF LECM-INITIALIZE-88 DTSBE125 00144 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE125 00145 ELSE DTSBE125 00146 IF LECM-TERMINATE-88 DTSBE125 00147 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE125 00148 ELSE DTSBE125 00149 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE125 00150 TO ABEND-MSG DTSBE125 00151 PERFORM S999-ABEND THRU S999-EXIT DTSBE125 00152 END-IF. DTSBE125 00153 SKIP2 DTSBE125 00154 GOBACK. DTSBE125 00155 EJECT. DTSBE125 00156 ************************************************************** DTSBE125 00157 * THIS IS THE INITIALIZATION PARAGRAPH FOR DTSBE125 * DTSBE125 00158 ************************************************************** DTSBE125 00159 I0000-INITIALIZE. DTSBE125 00160 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE125 00161 DTSBE125 00162 *& THE FOLLOWING TWO LINES ARE NECESSARY BUT DID NOT DTSBE125 00163 *& EXIST IN THE ORIGINAL PROGRAM. DTSBE125 00164 MOVE LENGTH OF R125-REC TO R125-LENGTH. DTSBE125 00165 MOVE '125' TO R125-REC-TYPE. DTSBE125 00166 DTSBE125 00167 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE125 00168 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE125 00169 *& THIS PARAGRAPH IS CALLED ONLY ONCE DURING THE RUN. DTSBE125 00170 *& THE RESULT IS THAT THE FIELDS BELOW ARE NEVER DTSBE125 00171 *& RE-INITIALIZED. DTSBE125 00172 *& IF WK-LIAB-DATE IS NOT RESET TO ZERO BEFORE THE PROGRAM DTSBE125 00173 *& PROCESSES THE NEXT EMPLOYER, THE PARAGRAPH THAT FINDS DTSBE125 00174 *& THE MOST RECENT MSOL WILL NOT WORK. DTSBE125 00175 *& MOVE ZERO TO WK-LIAB-DATE DTSBE125 00176 *& WK-INACT-DATE. DTSBE125 00177 I0000-EXIT. DTSBE125 00178 EXIT. DTSBE125 00179 SKIP3 DTSBE125 00180 DTSBE125 00181 ************************************************************** DTSBE125 00182 * THIS IS THE PROCESS PARAGRAPH FOR DTSBE125 DTSBE125 00183 ************************************************************** DTSBE125 00184 P0000-PROCESS. DTSBE125 00185 *& THERE IS AN INCONSISTENCY IN THE EXTERNAL DESIGN DTSBE125 00186 *& DOCUMENTATION. IN ONE PLACE IT SAYS THAT THE PROGRAM WILL DTSBE125 00187 *& SELECT ONLY EMPLOYERS WITH STATUS = 'ACTIVE' OR 'INACTIVE.' DTSBE125 00188 *& ELSEWHERE, IT SAYS THAT EMPLOYERS WITH CLASS = 'UNKNOWN' DTSBE125 00189 *& WILL BE REPORTED. IF THE CLASS IS UNKNOWN THE EMPLOYER DTSBE125 00190 *& STATUS WILL BE 'NEVER SUBJECT'. DTSBE125 00191 *& THE ONLY TEST NEEDED IS TO SELECT EMPLOYERS WHERE DTSBE125 00192 *& MPRF-CLASS-SUB-88 IS TRUE. THIS INCLUDES ALL DTSBE125 00193 *& RATED AND SELF-INSURED EMPLOYERS WHETHER ACTIVE OR DTSBE125 00194 *& INACTIVE, AND EXCLUDES CHARGE-ONLY AND NEVER SUBJECT DTSBE125 00195 *& ACCOUNTS. DTSBE125 00196 *& IN ADDITION, USING LEVEL-88S TO TEST VALUES IS MUCH DTSBE125 00197 *& CLEARER. DTSBE125 00198 *& IF MPRF-EMP-STATUS = 'A' OR 'I' DTSBE125 00199 *& CONTINUE DTSBE125 00200 *& ELSE DTSBE125 00201 *& GO TO P0000-EXIT DTSBE125 00202 *& END-IF. DTSBE125 00203 DTSBE125 00204 IF MPRF-CLASS-SUB-88 DTSBE125 00205 NEXT SENTENCE DTSBE125 00206 ELSE DTSBE125 00207 GO TO P0000-EXIT. DTSBE125 00208 DTSBE125 00209 *& ALL PROCESSING THAT FORMATS THE R125 RECORD SHOULD BE DTSBE125 00210 *& IN ONE PLACE (P1000). THERE IS NO NEED TO USE THIS DTSBE125 00211 *& TEST AS PART OF THE SELECTION. DTSBE125 00212 *& IF MPRF-EMP-CLASS = 'R' DTSBE125 00213 *& SET R125-CLASS-RATED-88 TO TRUE DTSBE125 00214 *& ELSE DTSBE125 00215 *& IF MPRF-EMP-CLASS = 'S' DTSBE125 00216 *& SET R125-CLASS-SELF-INS-88 TO TRUE DTSBE125 00217 *& ELSE DTSBE125 00218 *& IF MPRF-EMP-CLASS = 'U' DTSBE125 00219 *& SET R125-CLASS-UNKNOWN-88 TO TRUE DTSBE125 00220 *& ELSE DTSBE125 00221 *& GO TO P0000-EXIT DTSBE125 00222 *& END-IF. DTSBE125 00223 DTSBE125 00224 *& THE FOLLOWING 2 LINES MOVED TO P1000 TO KEEP ALL DTSBE125 00225 *& PROCESSING THAT BUILDS THE R125 RECORD IN ONE PLACE. DTSBE125 00226 *& MOVE MPRF-EMP-NO TO R125-EMP-NO. DTSBE125 00227 *& MOVE MPRF-PRIMARY-NAME TO R125-PRIMARY-NAME. DTSBE125 00228 *& DTSBE125 00229 *& THE LINE BELOW HAS ALREADY BEEN EXECUTED IN I0000. DTSBE125 00230 *& THERE'S NO NEED TO DUPLICATE IT HERE. DTSBE125 00231 *& MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE125 00232 *& DTSBE125 00233 *& IT IS NECESSARY TO INITIALIZE THE KEY AREA BEFORE DTSBE125 00234 *& MOVING NEW VALUES TO IT. DTSBE125 00235 *& FORMAT THE KEY IN THE MSOL AREA, AND THEN MOVE IT TO DTSBE125 00236 *& THE MSKL AREA. DTSBE125 00237 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE125 00238 SET MSOL-SOL-88 TO TRUE. DTSBE125 00239 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE125 00240 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE125 00241 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE125 00242 *& CHECK THE RESPONSE FROM THE I-O MODULE AFTER THE DTSBE125 00243 *& START BROWSE. DTSBE125 00244 *& DTSBE125 00245 *& 'MAIN-LOOP' IS NOT A GOOD NAME AND DOESN'T DESCRIBE WHAT DTSBE125 00246 *& THE PARAPRAPH ACTUALLY DOES. THE ONLY MAIN LOOP OF THIS DTSBE125 00247 *& PROGRAM IS P0000. DTSBE125 00248 *& 'P1000' IS PREFERABLE TO 'P0100' SINCE IT ALLOWS MORE DTSBE125 00249 *& SCOPE FOR PERFORMING PARAGRAPHS LOWER IN THE HIERARCHY: DTSBE125 00250 *& P1000 PERFORMS P1100 WHICH PERFORMS P1110 AND SO ON. DTSBE125 00251 *& WHAT THE MAIN-LOOP PARAPRAPH ACTUALLY DOES IS FORMAT THE DTSBE125 00252 *& R125 REPORT RECORD, AND THE NAME SHOULD REFLECT THIS. DTSBE125 00253 *& I ALSO MOVED ALL THE PROCESSING THAT BUILDS THE R125 TO DTSBE125 00254 *& P1000. IT SHOULDN'T BE SCATTERED IN DIFFERENT PARTS DTSBE125 00255 *& OF THE PROGRAM. DTSBE125 00256 *& DTSBE125 00257 *& PERFORM P0100-MAIN-LOOP THRU P0100-MAIN-EXIT. DTSBE125 00258 SKIP2 DTSBE125 00259 IF L910-OK-88 DTSBE125 00260 PERFORM P1000-FORMAT-R125 THRU P1000-EXIT DTSBE125 00261 ELSE DTSBE125 00262 GO TO P0000-EXIT. DTSBE125 00263 DTSBE125 00264 *& THE FOLLOWING LINE OCCURRED TWICE IN THE PROGRAM. DTSBE125 00265 *& THE OTHER LOCATION, AND THE CORRECT ONE, IS IN DTSBE125 00266 *& P1000. SINCE THERE ARE POSSIBLE ERROR CONDITIONS DTSBE125 00267 *& IN P1000, IT IS BETTER TO DECIDE WHETHER TO WRITE DTSBE125 00268 *& THE RECORD THERE. DTSBE125 00269 *& PERFORM S946-WRITE-R125 THRU S946-EXIT. DTSBE125 00270 P0000-EXIT. DTSBE125 00271 EXIT. DTSBE125 00272 DTSBE125 00273 *P0100-MAIN-LOOP DTSBE125 00274 P1000-FORMAT-R125. DTSBE125 00275 *& THIS IS WHERE WK-LIAB-DATE MUST BE INITIALIZED DTSBE125 00276 MOVE ZERO TO WK-LIAB-DATE DTSBE125 00277 WK-INACT-DATE. DTSBE125 00278 DTSBE125 00279 PERFORM P1100-FIND-MOST-RECENT-MSOL THRU P1100-EXIT DTSBE125 00280 UNTIL L910-NO-REC-88. DTSBE125 00281 *& DTSBE125 00282 *& PERFORM UNTIL NO-REC-88 DTSBE125 00283 *& PERFORM P0200-SWAP-DATES THRU P0200-SWAP-EXIT DTSBE125 00284 *& PERFORM S910-READ-NEXT THRU S910-READ-NEXT-EXIT DTSBE125 00285 *& END-PERFORM. DTSBE125 00286 DTSBE125 00287 *& IF WK-LIAB-DATE IS ZERO, ALL SPANS OF LIABILITY HAVE DTSBE125 00288 *& BEEN WITHDRAWN. BYPASS EMPLOYER. DTSBE125 00289 IF WK-LIAB-DATE = ZERO DTSBE125 00290 GO TO P1000-EXIT. DTSBE125 00291 MOVE MPRF-EMP-NO TO R125-EMP-NO. DTSBE125 00292 MOVE MPRF-PRIMARY-NAME TO R125-PRIMARY-NAME. DTSBE125 00293 IF MPRF-CLASS-RATED-88 DTSBE125 00294 SET R125-CLASS-RATED-88 TO TRUE DTSBE125 00295 ELSE DTSBE125 00296 IF MPRF-CLASS-SELF-INS-88 DTSBE125 00297 SET R125-CLASS-SELF-INS-88 TO TRUE DTSBE125 00298 ELSE DTSBE125 00299 GO TO P1000-EXIT. DTSBE125 00300 MOVE WK-LIAB-DATE TO R125-LIAB-DATE. DTSBE125 00301 MOVE WK-INACT-DATE TO R125-INACT-DATE. DTSBE125 00302 PERFORM S061-FIELD-REP THRU S061-FIELD-EXIT. DTSBE125 00303 PERFORM S946-WRITE-R125 THRU S946-EXIT. DTSBE125 00304 *P0100-MAIN-EXIT. DTSBE125 00305 P1000-EXIT. DTSBE125 00306 EXIT. DTSBE125 00307 DTSBE125 00308 *P0200-SWAP-DATES. DTSBE125 00309 *& THE FOLLOWING IS A MORE INFORMATIVE NAME DTSBE125 00310 P1100-FIND-MOST-RECENT-MSOL. DTSBE125 00311 MOVE MSKL-REC TO MSOL-REC. DTSBE125 00312 IF MSOL-INACT-WITHDRAWN-88 DTSBE125 00313 GO TO P1100-READ-NEXT. DTSBE125 00314 IF MSOL-LIAB-DATE > WK-LIAB-DATE DTSBE125 00315 MOVE MSOL-LIAB-DATE TO WK-LIAB-DATE DTSBE125 00316 MOVE MSOL-INACT-DATE TO WK-INACT-DATE. DTSBE125 00317 *& IF NOT MSOL-INACT-WITHDRAWN-88 AND DTSBE125 00318 *& MSOL-LIAB-DATE GREATER THAN WK-LIAB-DATE THEN DTSBE125 00319 *& MOVE MSOL-LIAB-DATE TO WK-LIAB-DATE DTSBE125 00320 *& MOVE MSOL-INACT-DATE TO WK-INACT-DATE DTSBE125 00321 *& END-IF. DTSBE125 00322 DTSBE125 00323 P1100-READ-NEXT. DTSBE125 00324 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE125 00325 *P0200-SWAP-EXIT. DTSBE125 00326 P1100-EXIT. DTSBE125 00327 EXIT. DTSBE125 00328 DTSBE125 00329 S061-FIELD-REP. DTSBE125 00330 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSBE125 00331 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE125 00332 IF L061-OK DTSBE125 00333 MOVE L061-FLD-REP-ID TO R125-FIELD-REP-CD DTSBE125 00334 *& COVER THE OTHER POSSIBILITY DTSBE125 00335 ELSE DTSBE125 00336 MOVE SPACES TO R125-FIELD-REP-CD. DTSBE125 00337 S061-FIELD-EXIT. DTSBE125 00338 EXIT. DTSBE125 00339 DTSBE125 00340 *& USE THE STANDARD FORMAT FOR I-O ROUTINES. DTSBE125 00341 S910-START-BROWSE. DTSBE125 00342 SET L910-START-BROWSE-88 TO TRUE. DTSBE125 00343 GO TO S910-MSTR-IO. DTSBE125 00344 *& PERFORM S910-MSTR-IO THRU S910-MSTR-EXIT. DTSBE125 00345 *& IF L910-OK-88 DTSBE125 00346 *& SET OK-88 TO TRUE DTSBE125 00347 *& ELSE DTSBE125 00348 *& IF L910-NO-REC-88 DTSBE125 00349 *& SET NO-REC-88 TO TRUE. DTSBE125 00350 *&S910-BROWSE-EXIT. DTSBE125 00351 *& EXIT. DTSBE125 00352 DTSBE125 00353 S910-READ. DTSBE125 00354 SET L910-READ-88 TO TRUE. DTSBE125 00355 GO TO S910-MSTR-IO. DTSBE125 00356 *& PERFORM S910-MSTR-IO THRU S910-MSTR-EXIT. DTSBE125 00357 *& IF L910-OK-88 DTSBE125 00358 *& SET OK-88 TO TRUE DTSBE125 00359 *& ELSE DTSBE125 00360 *& IF L910-NO-REC-88 DTSBE125 00361 *& SET NO-REC-88 TO TRUE. DTSBE125 00362 *&S910-READ-EXIT. DTSBE125 00363 *& EXIT. DTSBE125 00364 DTSBE125 00365 S910-READ-NEXT. DTSBE125 00366 SET L910-READ-NEXT-88 TO TRUE. DTSBE125 00367 GO TO S910-MSTR-IO. DTSBE125 00368 *& PERFORM S910-MSTR-IO THRU S910-MSTR-EXIT. DTSBE125 00369 *& IF L910-OK-88 DTSBE125 00370 *& SET OK-88 TO TRUE DTSBE125 00371 *& ELSE DTSBE125 00372 *& IF L910-NO-REC-88 DTSBE125 00373 *& SET NO-REC-88 TO TRUE. DTSBE125 00374 *&S910-READ-NEXT-EXIT. DTSBE125 00375 *& EXIT. DTSBE125 00376 DTSBE125 00377 ************************************************************** DTSBE125 00378 * THIS IS WHERE THE CALL FOR L910 TO READ MASTER FILE DTSBE125 00379 ************************************************************** DTSBE125 00380 S910-MSTR-IO. DTSBE125 00381 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE125 00382 MSKL-REC. DTSBE125 00383 *S910-MSTR-EXIT. DTSBE125 00384 S910-EXIT. DTSBE125 00385 EXIT. DTSBE125 00386 SKIP3 DTSBE125 00387 DTSBE125 00388 T0000-TERMINATE. DTSBE125 00389 SKIP2 DTSBE125 00390 SKIP2 DTSBE125 00391 T0000-EXIT. DTSBE125 00392 EXIT. DTSBE125 00393 DTSBE125 00394 ************************************************************** DTSBE125 00395 * THIS IS WHERE THE WRITING OF IR125 TAKES PLACE DTSBE125 00396 ************************************************************** DTSBE125 00397 S946-WRITE-R125. DTSBE125 00398 CALL 'DTSBU946' USING R125-REC. DTSBE125 00399 GO TO S946-EXIT. DTSBE125 00400 SKIP1 DTSBE125 00401 S946-EXIT. DTSBE125 00402 EXIT. DTSBE125 00403 SKIP3 DTSBE125 00404 DTSBE125 00405 ************************************************************** DTSBE125 00406 * THIS IS THE ABNORMAL END PART OF BE125 DTSBE125 00407 ************************************************************** DTSBE125 00408 S999-ABEND. DTSBE125 00409 DISPLAY '*** DTSBE125 ABENDING. ' DTSBE125 00410 ABEND-MSG. DTSBE125 00411 SKIP1 DTSBE125 00412 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE125 00413 S999-EXIT. DTSBE125 00414 EXIT. DTSBE125