DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
415
Batch/DTSBE125.cob
Normal file
415
Batch/DTSBE125.cob
Normal file
@ -0,0 +1,415 @@
|
||||
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
|
||||
Reference in New Issue
Block a user