416 lines
33 KiB
COBOL
416 lines
33 KiB
COBOL
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
|