783 lines
62 KiB
COBOL
783 lines
62 KiB
COBOL
00001 IDENTIFICATION DIVISION. 12/04/09
|
|
00002 PROGRAM-ID. CHGBD214. CHGBD214
|
|
00003 *AUTHOR. NGC. LV005
|
|
00004 *DATE-WRITTEN. NOVEMBER 2006. CHGBD214
|
|
00005 DATE-COMPILED. CHGBD214
|
|
00006 SKIP3 CHGBD214
|
|
00007 ***** CHGBD214
|
|
00008 * CHGBD214
|
|
00009 * FUNCTION: CHGBD214
|
|
00010 * CHGBD214
|
|
00011 * TRANSFER BENEFIT CHARGES TO SUCCESSORS. CHGBD214
|
|
00012 * CHGBD214
|
|
00013 * INPUT: CHGBD214
|
|
00014 * CHGBD214
|
|
00015 * DTSFCHG5 - CHARGE REPORT RECORDS GENERATED BY CHGBD214
|
|
00016 * CHGBD212. CHGBD214
|
|
00017 * CHGBD214
|
|
00018 * CHGBD214
|
|
00019 * OUTPUT: CHGBD214
|
|
00020 * CHGBD214
|
|
00021 * CHGBD214
|
|
00022 * CHGBD214
|
|
00023 ***** CHGBD214
|
|
00024 CHGBD214
|
|
00025 ******************************************************************CHGBD214
|
|
00026 * MODIFICATION HISTORY: *CHGBD214
|
|
00027 * *CHGBD214
|
|
00028 * 11-06-2006 INITIAL DEVELOPMENT *CHGBD214
|
|
00029 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD214
|
|
00030 * *CHGBD214
|
|
00031 * 03-09-2009 RECOMPLIED FOR NEW VERSION OF CHGIM005 *CHGBD214
|
|
00032 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD214
|
|
00033 * *CHGBD214
|
|
00034 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD214
|
|
00035 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD214
|
|
00036 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD214
|
|
00037 ******************************************************************CHGBD214
|
|
00038 CHGBD214
|
|
00039 SKIP3 CHGBD214
|
|
00040 ENVIRONMENT DIVISION. CHGBD214
|
|
00041 SKIP3 CHGBD214
|
|
00042 INPUT-OUTPUT SECTION. CHGBD214
|
|
00043 SKIP3 CHGBD214
|
|
00044 FILE-CONTROL. CHGBD214
|
|
00045 SELECT CHARGE-FILE ASSIGN TO DTSFCHG5 CHGBD214
|
|
00046 ORGANIZATION IS INDEXED CHGBD214
|
|
00047 ACCESS MODE IS DYNAMIC CHGBD214
|
|
00048 RECORD KEY IS C5-KEY-AREA CHGBD214
|
|
00049 FILE STATUS IS CHG5-STATUS. CHGBD214
|
|
00050 CHGBD214
|
|
00051 SELECT RELATIONSHIP-FILE ASSIGN TO DTSFIPES CHGBD214
|
|
00052 FILE STATUS IS REL-STATUS. CHGBD214
|
|
00053 CHGBD214
|
|
00054 DATA DIVISION. CHGBD214
|
|
00055 CHGBD214
|
|
00056 FILE SECTION. CHGBD214
|
|
00057 FD CHARGE-FILE CHGBD214
|
|
00058 RECORD CONTAINS 41 CHARACTERS CHGBD214
|
|
00059 DATA RECORD IS CHG5-REC. CHGBD214
|
|
00060 01 CHG5-REC. CHGBD214
|
|
00061 05 C5-KEY-AREA PIC X(31). CHGBD214
|
|
00062 05 FILLER PIC X(10). CHGBD214
|
|
00063 CHGBD214
|
|
00064 FD RELATIONSHIP-FILE CHGBD214
|
|
00065 RECORD CONTAINS 16 CHARACTERS CHGBD214
|
|
00066 DATA RECORD IS REL-REC. CHGBD214
|
|
00067 01 REL-REC. CHGBD214
|
|
00068 05 REL-EFF-DT PIC S9(09) COMP-3. CHGBD214
|
|
00069 05 REL-PRED PIC S9(07) COMP-3. CHGBD214
|
|
00070 05 REL-SUCC PIC S9(07) COMP-3. CHGBD214
|
|
00071 05 REL-PCT PIC S9V9(04) COMP-3. CHGBD214
|
|
00072 CHGBD214
|
|
00073 WORKING-STORAGE SECTION. CHGBD214
|
|
000735 77 PAN-VALET PICTURE X(24) VALUE '005CHGBD214 12/04/09'. CHGBD214
|
|
00074 CHGBD214
|
|
00075 01 WRK-AREA. CHGBD214
|
|
00076 05 WRK-DISP-AREA. CHGBD214
|
|
00077 10 WRK-DATE PIC 9999B99B99. CHGBD214
|
|
00078 10 FILLER PIC X(02) VALUE SPACES. CHGBD214
|
|
00079 10 WRK-EMP-DISP PIC 9(06). CHGBD214
|
|
00080 10 FILLER PIC X(02) VALUE SPACES. CHGBD214
|
|
00081 10 WRK-SSN-DISP PIC 9(10). CHGBD214
|
|
00082 10 FILLER PIC X(02) VALUE SPACES. CHGBD214
|
|
00083 10 WRK-CHG-AMT-DISP PIC --------9.99. CHGBD214
|
|
00084 CHGBD214
|
|
00085 05 C5-TABLE-AREA. CHGBD214
|
|
00086 10 C5-MAX PIC S9(07) COMP-3 CHGBD214
|
|
00087 VALUE +5000. CHGBD214
|
|
00088 10 C5-LAST PIC S9(07) COMP-3 CHGBD214
|
|
00089 VALUE +0. CHGBD214
|
|
00090 10 C5-SUB PIC S9(07) COMP-3. CHGBD214
|
|
00091 CHGBD214
|
|
00092 10 C5-ENTRY OCCURS 5000 TIMES CHGBD214
|
|
00093 PIC X(41). CHGBD214
|
|
00094 CHGBD214
|
|
00095 05 REL-TABLE-AREA. CHGBD214
|
|
00096 10 RSUB PIC S9(04) COMP. CHGBD214
|
|
00097 10 RT-MAX PIC S9(04) COMP CHGBD214
|
|
00098 VALUE +100. CHGBD214
|
|
00099 10 RT-LAST PIC S9(04) COMP. CHGBD214
|
|
00100 10 REL-TABLE OCCURS 100 TIMES. CHGBD214
|
|
00101 15 RT-EFF-DATE PIC S9(09) COMP-3. CHGBD214
|
|
00102 15 RT-PRED PIC S9(07) COMP-3. CHGBD214
|
|
00103 15 RT-SUCC PIC S9(07) COMP-3. CHGBD214
|
|
00104 15 RT-PERCENT PIC S9V9(04) COMP-3. CHGBD214
|
|
00105 CHGBD214
|
|
00106 05 WRK-CURR-EFF-DT PIC S9(09) COMP-3. CHGBD214
|
|
00107 05 WRK-CURR-PRED PIC S9(07) COMP-3. CHGBD214
|
|
00108 05 WRK-CURR-SUCC PIC S9(07) COMP-3. CHGBD214
|
|
00109 05 WRK-CURR-PCT PIC S9V9(04) COMP-3. CHGBD214
|
|
00110 CHGBD214
|
|
00111 CHGBD214
|
|
00112 05 HOLD-LAST PIC S9(07) COMP-3 CHGBD214
|
|
00113 VALUE +0. CHGBD214
|
|
00114 CHGBD214
|
|
00115 05 WRK-TOT-CHG PIC S9(09)V99 COMP-3 CHGBD214
|
|
00116 VALUE +0. CHGBD214
|
|
00117 05 WRK-EMP-TOT-CHG PIC S9(09)V99 COMP-3 CHGBD214
|
|
00118 VALUE +0. CHGBD214
|
|
00119 05 WRK-EMP-SSN-CHG PIC S9(09)V99 COMP-3 CHGBD214
|
|
00120 VALUE +0. CHGBD214
|
|
00121 05 WRK-TOT-CHG-DISP PIC Z(08)9.99-. CHGBD214
|
|
00122 05 WRK-CHG PIC S9(09)V99 COMP-3. CHGBD214
|
|
00123 05 WRK-CURR-EMP PIC S9(07) COMP-3 CHGBD214
|
|
00124 VALUE +0. CHGBD214
|
|
00125 05 WRK-CURR-SSN PIC S9(09) COMP-3 CHGBD214
|
|
00126 VALUE +0. CHGBD214
|
|
00127 05 WRK-BYB PIC S9(09) COMP-3 CHGBD214
|
|
00128 VALUE +0. CHGBD214
|
|
00129 05 WRK-RATE-YRQ PIC S9(05) COMP-3. CHGBD214
|
|
00130 05 WRK-SEQUENCE PIC S9(04) COMP CHGBD214
|
|
00131 VALUE +0. CHGBD214
|
|
00132 CHGBD214
|
|
00133 05 WRK-SSN-CONV PIC 9(10). CHGBD214
|
|
00134 05 FILLER REDEFINES WRK-SSN-CONV. CHGBD214
|
|
00135 10 WRK-SSN-9 PIC 9(09). CHGBD214
|
|
00136 10 FILLER PIC X(01). CHGBD214
|
|
00137 CHGBD214
|
|
00138 05 WRK-CHG-AMT PIC S9(09)V99 COMP-3. CHGBD214
|
|
00139 CHGBD214
|
|
00140 05 WRK-MOD-NAME PIC X(08) CHGBD214
|
|
00141 VALUE 'CHGBD214'. CHGBD214
|
|
00142 05 ABEND-CODE PIC S9(04) COMP CHGBD214
|
|
00143 VALUE +214. CHGBD214
|
|
00144 05 ABEND-MOD PIC X(08) CHGBD214
|
|
00145 VALUE 'DTSBU999'. CHGBD214
|
|
00146 05 ABEND-MSG PIC X(60). CHGBD214
|
|
00147 CHGBD214
|
|
00148 05 CHG5-STATUS PIC X(02) VALUE SPACES. CHGBD214
|
|
00149 88 CHG5-FILE-OK-88 VALUE '00'. CHGBD214
|
|
00150 88 CHG5-FILE-EOF-88 VALUE '10'. CHGBD214
|
|
00151 CHGBD214
|
|
00152 05 REL-STATUS PIC X(02) VALUE SPACES. CHGBD214
|
|
00153 88 REL-FILE-OK-88 VALUE '00'. CHGBD214
|
|
00154 88 REL-FILE-EOF-88 VALUE '10'. CHGBD214
|
|
00155 CHGBD214
|
|
00156 05 WRK-ERROR-IND PIC X(01). CHGBD214
|
|
00157 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD214
|
|
00158 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD214
|
|
00159 CHGBD214
|
|
00160 05 WRK-RPT-TYPE PIC 9(02) VALUE ZERO. CHGBD214
|
|
00161 88 WRK-RPT-TYPE-RATED-88 VALUE 00. CHGBD214
|
|
00162 88 WRK-RPT-TYPE-FED-88 VALUE 01, 02. CHGBD214
|
|
00163 88 WRK-RPT-TYPE-CWC-88 VALUE 04. CHGBD214
|
|
00164 88 WRK-RPT-TYPE-SELF-INS-88 VALUE 08. CHGBD214
|
|
00165 88 WRK-RPT-TYPE-DC-88 VALUE 10. CHGBD214
|
|
00166 88 WRK-RPT-TYPE-TEUC-88 VALUE 16. CHGBD214
|
|
00167 CHGBD214
|
|
00168 05 WRK-REL-CNT PIC 9(09) COMP-3 CHGBD214
|
|
00169 VALUE 0. CHGBD214
|
|
00170 05 WRK-CHG5-CNT PIC 9(09) COMP-3 CHGBD214
|
|
00171 VALUE 0. CHGBD214
|
|
00172 05 WRK-CHG5-WRITE-CNT PIC 9(09) COMP-3 CHGBD214
|
|
00173 VALUE 0. CHGBD214
|
|
00174 05 WRK-100PCT-CNT PIC 9(09) COMP-3 CHGBD214
|
|
00175 VALUE 0. CHGBD214
|
|
00176 CHGBD214
|
|
00177 05 AMT-DISP1 PIC --------9.99. CHGBD214
|
|
00178 05 AMT-DISP2 PIC --------9.99. CHGBD214
|
|
00179 05 AMT-DISP3 PIC --------9.99. CHGBD214
|
|
00180 05 AMT-DISP4 PIC -9.9999. CHGBD214
|
|
00181 ** ADD ERROR MSG TABLE SET UP CHGBD214
|
|
00182 01 MSG-TABLE. CHGBD214
|
|
00183 05 MSG1-NO-MPRF. CHGBD214
|
|
00184 10 MSG1-ID. CHGBD214
|
|
00185 15 MSG1-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD214
|
|
00186 15 MSG1-ID2 PIC X(03) VALUE '210'. CHGBD214
|
|
00187 10 MSG1-SHORT-TEXT PIC X(20) CHGBD214
|
|
00188 VALUE 'EMP NOT ON FILE : '. CHGBD214
|
|
00189 10 MSG1-LONG-TEXT. CHGBD214
|
|
00190 15 FILLER PIC X(29) CHGBD214
|
|
00191 VALUE 'EMPLOYER NOT ON MASTER FILE '. CHGBD214
|
|
00192 15 FILLER PIC X(32) VALUE SPACES. CHGBD214
|
|
00193 CHGBD214
|
|
00194 05 MSG2-NOT-LIABLE. CHGBD214
|
|
00195 10 MSG2-ID. CHGBD214
|
|
00196 15 MSG2-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD214
|
|
00197 15 MSG2-ID2 PIC X(03) VALUE '210'. CHGBD214
|
|
00198 10 MSG2-SHORT-TEXT PIC X(20) CHGBD214
|
|
00199 VALUE 'EMP NOT LIABLE : '. CHGBD214
|
|
00200 10 MSG2-LONG-TEXT. CHGBD214
|
|
00201 15 FILLER PIC X(29) CHGBD214
|
|
00202 VALUE 'EMPLOYER IS NOT LIABLE '. CHGBD214
|
|
00203 15 FILLER PIC X(32) VALUE SPACES. CHGBD214
|
|
00204 CHGBD214
|
|
00205 05 MSG4-PRINTING-TURNED-OFF. CHGBD214
|
|
00206 10 MSG4-ID. CHGBD214
|
|
00207 15 MSG4-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD214
|
|
00208 15 MSG4-ID2 PIC X(03) VALUE '210'. CHGBD214
|
|
00209 10 MSG4-SHORT-TEXT PIC X(20) CHGBD214
|
|
00210 VALUE 'CHG STMT PRINT OFF: '. CHGBD214
|
|
00211 10 MSG4-LONG-TEXT. CHGBD214
|
|
00212 15 FILLER PIC X(36) CHGBD214
|
|
00213 VALUE 'CHARGE STATEMENT PRINTING TURNED OFF'. CHGBD214
|
|
00214 15 FILLER PIC X(25) VALUE SPACES. CHGBD214
|
|
00215 CHGBD214
|
|
00216 05 MSG5-NO-ADDRESS. CHGBD214
|
|
00217 10 MSG5-ID. CHGBD214
|
|
00218 15 MSG5-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD214
|
|
00219 15 MSG5-ID2 PIC X(03) VALUE '210'. CHGBD214
|
|
00220 10 MSG5-SHORT-TEXT PIC X(20) CHGBD214
|
|
00221 VALUE 'NO ADDRESS FOUND: '. CHGBD214
|
|
00222 10 MSG5-LONG-TEXT. CHGBD214
|
|
00223 15 FILLER PIC X(29) CHGBD214
|
|
00224 VALUE 'ADDRESS NOT FOUND '. CHGBD214
|
|
00225 15 FILLER PIC X(25) CHGBD214
|
|
00226 VALUE ' MPRF EMPLOYER NUMBER = '. CHGBD214
|
|
00227 15 MSG5-EMP-NO PIC 9(07). CHGBD214
|
|
00228 CHGBD214
|
|
00229 05 MSG6-INVALID-EMP-NO. CHGBD214
|
|
00230 10 MSG6-ID. CHGBD214
|
|
00231 15 MSG6-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD214
|
|
00232 15 MSG6-ID2 PIC X(03) VALUE '210'. CHGBD214
|
|
00233 10 MSG6-SHORT-TEXT PIC X(20) CHGBD214
|
|
00234 VALUE 'INVALID EMP NO: '. CHGBD214
|
|
00235 10 MSG6-LONG-TEXT. CHGBD214
|
|
00236 15 FILLER PIC X(29) CHGBD214
|
|
00237 VALUE 'INVALID EMPLOYER NUMBER: '. CHGBD214
|
|
00238 15 MSG6-EMP-NO PIC 9(07). CHGBD214
|
|
00239 15 FILLER PIC X(25) CHGBD214
|
|
00240 VALUE ' EMP TYPE = '. CHGBD214
|
|
00241 15 MSG6-EMP-TYPE PIC 9(02). CHGBD214
|
|
00242 CHGBD214
|
|
00243 01 WRK-CHG5-REC. CHGBD214
|
|
00244 ++INCLUDE CHGIM005 CHGBD214
|
|
00245 CHGBD214
|
|
00246 ** REPORT I-O SKELETAL RECORD CHGBD214
|
|
00247 01 RSKL-REC. CHGBD214
|
|
00248 ++INCLUDE DTSIRSK1 CHGBD214
|
|
00249 CHGBD214
|
|
00250 ** MAILING LABEL RECORD CHGBD214
|
|
00251 01 R901-REC. CHGBD214
|
|
00252 ++INCLUDE DTSIR901 CHGBD214
|
|
00253 CHGBD214
|
|
00254 ** ERROR MSG OUTPUT RECORD CHGBD214
|
|
00255 01 R907-REC. CHGBD214
|
|
00256 ++INCLUDE DTSIR907 CHGBD214
|
|
00257 CHGBD214
|
|
00258 01 L910-LINK-AREA. CHGBD214
|
|
00259 ++INCLUDE DTSIL910 CHGBD214
|
|
00260 CHGBD214
|
|
00261 01 MSKL-REC. CHGBD214
|
|
00262 ++INCLUDE DTSIMSKL CHGBD214
|
|
00263 CHGBD214
|
|
00264 01 MHDR-REC. CHGBD214
|
|
00265 ++INCLUDE DTSIMHDR CHGBD214
|
|
00266 CHGBD214
|
|
00267 01 MPRF-REC. CHGBD214
|
|
00268 ++INCLUDE DTSIMPRF CHGBD214
|
|
00269 CHGBD214
|
|
00270 01 L921-LINK-AREA. CHGBD214
|
|
00271 ++INCLUDE DTSIL921 CHGBD214
|
|
00272 CHGBD214
|
|
00273 01 ISKL-REC. CHGBD214
|
|
00274 ++INCLUDE DTSIISKL CHGBD214
|
|
00275 CHGBD214
|
|
00276 01 L001-LINK-AREA. CHGBD214
|
|
00277 ++INCLUDE DTSIL001 CHGBD214
|
|
00278 CHGBD214
|
|
00279 01 L004-LINK-AREA. CHGBD214
|
|
00280 ++INCLUDE DTSIL004 CHGBD214
|
|
00281 CHGBD214
|
|
00282 01 L005-LINK-AREA. CHGBD214
|
|
00283 ++INCLUDE DTSIL005 CHGBD214
|
|
00284 CHGBD214
|
|
00285 01 L006-LINK-AREA. CHGBD214
|
|
00286 ++INCLUDE DTSIL006 CHGBD214
|
|
00287 CHGBD214
|
|
00288 01 L081-LINK-AREA. CHGBD214
|
|
00289 ++INCLUDE DTSIL081 CHGBD214
|
|
00290 CHGBD214
|
|
00291 01 L100-LINK-AREA. CHGBD214
|
|
00292 ++INCLUDE CHGIL100 CHGBD214
|
|
00293 CHGBD214
|
|
00294 01 L111-LINK-AREA. CHGBD214
|
|
00295 ++INCLUDE DTSIL111 CHGBD214
|
|
00296 CHGBD214
|
|
00297 01 L112-LINK-AREA. CHGBD214
|
|
00298 ++INCLUDE DTSIL112 CHGBD214
|
|
00299 CHGBD214
|
|
00300 PROCEDURE DIVISION. CHGBD214
|
|
00301 SKIP2 CHGBD214
|
|
00302 CHGBD214-MAIN. CHGBD214
|
|
00303 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD214
|
|
00304 IF WRK-ERROR-YES-88 CHGBD214
|
|
00305 GO TO CHGBD214-EXIT. CHGBD214
|
|
00306 CHGBD214
|
|
00307 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD214
|
|
00308 CHGBD214
|
|
00309 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD214
|
|
00310 CHGBD214
|
|
00311 CHGBD214-EXIT. CHGBD214
|
|
00312 STOP RUN. CHGBD214
|
|
00313 EJECT CHGBD214
|
|
00314 I0000-INITIATE. CHGBD214
|
|
00315 SET WRK-ERROR-NO-88 TO TRUE. CHGBD214
|
|
00316 CHGBD214
|
|
00317 MOVE LENGTH OF R901-REC TO R901-LENGTH. CHGBD214
|
|
00318 CHGBD214
|
|
00319 MOVE MSG1-ID1 TO R907-MODULE-NAME. CHGBD214
|
|
00320 MOVE LENGTH OF R907-REC TO R907-LENGTH. CHGBD214
|
|
00321 CHGBD214
|
|
00322 PERFORM I1000-INIT-TABLES THRU I1000-EXIT. CHGBD214
|
|
00323 CHGBD214
|
|
00324 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. CHGBD214
|
|
00325 CHGBD214
|
|
00326 PERFORM I4000-INITIALIZE-REL-TBL THRU I4000-EXIT. CHGBD214
|
|
00327 CHGBD214
|
|
00328 READ RELATIONSHIP-FILE. CHGBD214
|
|
00329 CHGBD214
|
|
00330 IF REL-FILE-EOF-88 CHGBD214
|
|
00331 DISPLAY 'REL FILE EMPTY: ' REL-STATUS CHGBD214
|
|
00332 SET WRK-ERROR-YES-88 TO TRUE CHGBD214
|
|
00333 GO TO I0000-EXIT CHGBD214
|
|
00334 ELSE CHGBD214
|
|
00335 ADD +1 TO WRK-REL-CNT CHGBD214
|
|
00336 MOVE REL-EFF-DT TO WRK-CURR-EFF-DT CHGBD214
|
|
00337 MOVE REL-PRED TO WRK-CURR-PRED CHGBD214
|
|
00338 ADD +1 TO RT-LAST CHGBD214
|
|
00339 MOVE REL-REC TO REL-TABLE (RT-LAST) CHGBD214
|
|
00340 END-IF. CHGBD214
|
|
00341 CHGBD214
|
|
00342 I0000-EXIT. CHGBD214
|
|
00343 EXIT. CHGBD214
|
|
00344 CHGBD214
|
|
00345 I1000-INIT-TABLES. CHGBD214
|
|
00346 MOVE +0 TO C5-LAST CHGBD214
|
|
00347 WRK-SEQUENCE. CHGBD214
|
|
00348 PERFORM CHGBD214
|
|
00349 VARYING C5-SUB FROM +1 BY +1 CHGBD214
|
|
00350 UNTIL C5-SUB > C5-MAX CHGBD214
|
|
00351 MOVE LOW-VALUES TO C5-ENTRY (C5-SUB) CHGBD214
|
|
00352 END-PERFORM. CHGBD214
|
|
00353 CHGBD214
|
|
00354 I1000-EXIT. CHGBD214
|
|
00355 EXIT. CHGBD214
|
|
00356 CHGBD214
|
|
00357 I2000-OPEN-FILES-1. CHGBD214
|
|
00358 OPEN I-O CHARGE-FILE. CHGBD214
|
|
00359 IF NOT CHG5-FILE-OK-88 CHGBD214
|
|
00360 DISPLAY 'CHARGE FILE OPEN ERROR: ' CHG5-STATUS CHGBD214
|
|
00361 PERFORM S999-ABEND THRU S999-EXIT CHGBD214
|
|
00362 END-IF. CHGBD214
|
|
00363 CHGBD214
|
|
00364 OPEN INPUT RELATIONSHIP-FILE. CHGBD214
|
|
00365 IF NOT REL-FILE-OK-88 CHGBD214
|
|
00366 DISPLAY 'REL FILE OPEN ERROR: ' REL-STATUS CHGBD214
|
|
00367 PERFORM S999-ABEND THRU S999-EXIT CHGBD214
|
|
00368 END-IF. CHGBD214
|
|
00369 CHGBD214
|
|
00370 PERFORM S910-OPEN-READ THRU S910-EXIT. CHGBD214
|
|
00371 CHGBD214
|
|
00372 MOVE LOW-VALUES TO MSKL-KEY-AREA. CHGBD214
|
|
00373 CHGBD214
|
|
00374 MOVE +0 TO MSKL-EMP-NO. CHGBD214
|
|
00375 CHGBD214
|
|
00376 SET MSKL-HDR-88 TO TRUE. CHGBD214
|
|
00377 CHGBD214
|
|
00378 PERFORM S910-READ THRU S910-EXIT. CHGBD214
|
|
00379 CHGBD214
|
|
00380 IF L910-NO-REC-88 CHGBD214
|
|
00381 MOVE 'MHDR RECORD IS MISSING' CHGBD214
|
|
00382 TO ABEND-MSG CHGBD214
|
|
00383 PERFORM S999-ABEND THRU S999-EXIT. CHGBD214
|
|
00384 CHGBD214
|
|
00385 MOVE MSKL-REC TO MHDR-REC. CHGBD214
|
|
00386 CHGBD214
|
|
00387 I2000-EXIT. CHGBD214
|
|
00388 EXIT. CHGBD214
|
|
00389 CHGBD214
|
|
00390 I4000-INITIALIZE-REL-TBL. CHGBD214
|
|
00391 MOVE +0 TO RT-LAST. CHGBD214
|
|
00392 CHGBD214
|
|
00393 PERFORM CHGBD214
|
|
00394 VARYING RSUB FROM +1 BY +1 CHGBD214
|
|
00395 UNTIL RSUB > RT-MAX CHGBD214
|
|
00396 MOVE +0 TO RT-EFF-DATE (RSUB) CHGBD214
|
|
00397 RT-PRED (RSUB) CHGBD214
|
|
00398 RT-SUCC (RSUB) CHGBD214
|
|
00399 RT-PERCENT (RSUB) CHGBD214
|
|
00400 END-PERFORM. CHGBD214
|
|
00401 CHGBD214
|
|
00402 CHGBD214
|
|
00403 I4000-EXIT. CHGBD214
|
|
00404 EXIT. CHGBD214
|
|
00405 CHGBD214
|
|
00406 P0000-PROCESS. CHGBD214
|
|
00407 READ RELATIONSHIP-FILE. CHGBD214
|
|
00408 CHGBD214
|
|
00409 IF REL-FILE-EOF-88 CHGBD214
|
|
00410 PERFORM P0200-PROCESS-TABLE THRU P0200-EXIT CHGBD214
|
|
00411 GO TO P0000-EXIT CHGBD214
|
|
00412 ELSE CHGBD214
|
|
00413 ADD +1 TO WRK-REL-CNT CHGBD214
|
|
00414 PERFORM CHGBD214
|
|
00415 UNTIL REL-FILE-EOF-88 CHGBD214
|
|
00416 OR WRK-ERROR-YES-88 CHGBD214
|
|
00417 IF REL-EFF-DT = WRK-CURR-EFF-DT CHGBD214
|
|
00418 AND REL-PRED = WRK-CURR-PRED CHGBD214
|
|
00419 PERFORM P0100-ADD-TO-TABLE THRU P0100-EXIT CHGBD214
|
|
00420 ELSE CHGBD214
|
|
00421 PERFORM P0200-PROCESS-TABLE THRU P0200-EXIT CHGBD214
|
|
00422 END-IF CHGBD214
|
|
00423 READ RELATIONSHIP-FILE CHGBD214
|
|
00424 END-PERFORM CHGBD214
|
|
00425 END-IF. CHGBD214
|
|
00426 CHGBD214
|
|
00427 IF RT-LAST > +0 CHGBD214
|
|
00428 PERFORM P0200-PROCESS-TABLE THRU P0200-EXIT CHGBD214
|
|
00429 END-IF. CHGBD214
|
|
00430 CHGBD214
|
|
00431 P0000-EXIT. CHGBD214
|
|
00432 EXIT. CHGBD214
|
|
00433 CHGBD214
|
|
00434 P0100-ADD-TO-TABLE. CHGBD214
|
|
00435 ADD +1 TO RT-LAST. CHGBD214
|
|
00436 IF RT-LAST > RT-MAX CHGBD214
|
|
00437 DISPLAY 'P0100 OVERFLOW ' RT-LAST CHGBD214
|
|
00438 ' PRED ' REL-PRED ' SUCC ' REL-SUCC CHGBD214
|
|
00439 SET WRK-ERROR-YES-88 TO TRUE CHGBD214
|
|
00440 ELSE CHGBD214
|
|
00441 MOVE REL-REC TO REL-TABLE (RT-LAST) CHGBD214
|
|
00442 END-IF. CHGBD214
|
|
00443 CHGBD214
|
|
00444 P0100-EXIT. CHGBD214
|
|
00445 EXIT. CHGBD214
|
|
00446 CHGBD214
|
|
00447 P0200-PROCESS-TABLE. CHGBD214
|
|
00448 PERFORM I1000-INIT-TABLES THRU I1000-EXIT. CHGBD214
|
|
00449 CHGBD214
|
|
00450 PERFORM CHGBD214
|
|
00451 VARYING RSUB FROM +1 BY +1 CHGBD214
|
|
00452 UNTIL RSUB > RT-LAST CHGBD214
|
|
00453 MOVE RT-SUCC (RSUB) TO WRK-CURR-SUCC CHGBD214
|
|
00454 MOVE RT-PERCENT (RSUB) TO WRK-CURR-PCT CHGBD214
|
|
00455 PERFORM P1000-RELATIONSHIPS THRU P1000-EXIT CHGBD214
|
|
00456 END-PERFORM. CHGBD214
|
|
00457 CHGBD214
|
|
00458 PERFORM P2000-WRITE-CHARGES THRU P2000-EXIT CHGBD214
|
|
00459 CHGBD214
|
|
00460 PERFORM I4000-INITIALIZE-REL-TBL THRU I4000-EXIT. CHGBD214
|
|
00461 MOVE REL-EFF-DT TO WRK-CURR-EFF-DT. CHGBD214
|
|
00462 MOVE REL-PRED TO WRK-CURR-PRED. CHGBD214
|
|
00463 ADD +1 TO RT-LAST. CHGBD214
|
|
00464 MOVE REL-REC TO REL-TABLE (RT-LAST). CHGBD214
|
|
00465 CHGBD214
|
|
00466 P0200-EXIT. CHGBD214
|
|
00467 EXIT. CHGBD214
|
|
00468 CHGBD214
|
|
00469 P1000-RELATIONSHIPS. CHGBD214
|
|
00470 IF WRK-CURR-PCT NOT = 1 CHGBD214
|
|
00471 MOVE WRK-CURR-PCT TO AMT-DISP4 CHGBD214
|
|
00472 DISPLAY 'P1000 SUC ' WRK-CURR-SUCC CHGBD214
|
|
00473 ' PRED ' WRK-CURR-PRED CHGBD214
|
|
00474 ' ' AMT-DISP4 ' ' WRK-CURR-EFF-DT CHGBD214
|
|
00475 END-IF. CHGBD214
|
|
00476 CHGBD214
|
|
00477 MOVE LOW-VALUES TO CHG5-REC CHGBD214
|
|
00478 WRK-CHG5-REC. CHGBD214
|
|
00479 MOVE WRK-CURR-PRED TO CHG5-EMP-NO. CHGBD214
|
|
00480 MOVE ZEROS TO CHG5-SSN CHGBD214
|
|
00481 CHG5-BYE. CHGBD214
|
|
00482 CHGBD214
|
|
00483 MOVE CHG5-SORT-KEY-AREA TO C5-KEY-AREA. CHGBD214
|
|
00484 START CHARGE-FILE CHGBD214
|
|
00485 KEY IS >= C5-KEY-AREA. CHGBD214
|
|
00486 CHGBD214
|
|
00487 IF NOT CHG5-FILE-OK-88 CHGBD214
|
|
00488 DISPLAY 'CHARGE FILE START ERROR: ' CHG5-STATUS CHGBD214
|
|
00489 ' ' CHG5-EMP-NO CHGBD214
|
|
00490 ELSE CHGBD214
|
|
00491 READ CHARGE-FILE NEXT INTO WRK-CHG5-REC CHGBD214
|
|
00492 PERFORM P1100-BUILD-CHARGES THRU P1100-EXIT CHGBD214
|
|
00493 END-IF. CHGBD214
|
|
00494 CHGBD214
|
|
00495 P1000-EXIT. CHGBD214
|
|
00496 EXIT. CHGBD214
|
|
00497 CHGBD214
|
|
00498 P1100-BUILD-CHARGES. CHGBD214
|
|
00499 PERFORM CHGBD214
|
|
00500 UNTIL CHG5-FILE-EOF-88 CHGBD214
|
|
00501 OR CHG5-EMP-NO NOT = WRK-CURR-PRED CHGBD214
|
|
00502 OR WRK-ERROR-YES-88 CHGBD214
|
|
00503 ADD +1 TO WRK-CHG5-CNT CHGBD214
|
|
00504 PERFORM P1120-TBL-CHG5 THRU P1120-EXIT CHGBD214
|
|
00505 READ CHARGE-FILE NEXT INTO WRK-CHG5-REC CHGBD214
|
|
00506 END-PERFORM. CHGBD214
|
|
00507 CHGBD214
|
|
00508 P1100-EXIT. CHGBD214
|
|
00509 EXIT. CHGBD214
|
|
00510 CHGBD214
|
|
00511 *P1110-CALC-BYB. CHGBD214
|
|
00512 * MOVE CHG5-BYE TO L001-FED-8-DATE-9. CHGBD214
|
|
00513 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD214
|
|
00514 * IF L001-INVALID-DATE CHGBD214
|
|
00515 * SET WRK-ERROR-YES-88 TO TRUE CHGBD214
|
|
00516 * DISPLAY 'INVALID BYE ' CHG5-BYE ' ' CHG5-EMP-NO CHGBD214
|
|
00517 * ' ' CHG5-SSN CHGBD214
|
|
00518 * GO TO P1110-EXIT CHGBD214
|
|
00519 * ELSE CHGBD214
|
|
00520 * SUBTRACT +363 FROM L001-JUL-ABS-DAY CHGBD214
|
|
00521 * PERFORM S001-FROM-ABS THRU S001-EXIT CHGBD214
|
|
00522 * IF NOT L001-SATURDAY CHGBD214
|
|
00523 * SUBTRACT +1 FROM L001-JUL-ABS-DAY CHGBD214
|
|
00524 * PERFORM S001-FROM-ABS THRU S001-EXIT CHGBD214
|
|
00525 * END-IF CHGBD214
|
|
00526 * END-IF. CHGBD214
|
|
00527 * CHGBD214
|
|
00528 * MOVE L001-FED-8-DATE-9 TO WRK-BYB. CHGBD214
|
|
00529 * CHGBD214
|
|
00530 * CHGBD214
|
|
00531 *P1110-EXIT. CHGBD214
|
|
00532 * EXIT. CHGBD214
|
|
00533 CHGBD214
|
|
00534 P1120-TBL-CHG5. CHGBD214
|
|
00535 ******************************************************** CHGBD214
|
|
00536 * ADD CHARGE TO SUCCESSOR ACCOUNT CHGBD214
|
|
00537 ******************************************************** CHGBD214
|
|
00538 MOVE CHG5-TOT-CHG-AMT TO WRK-CHG. CHGBD214
|
|
00539 CHGBD214
|
|
00540 MOVE WRK-CURR-SUCC TO CHG5-EMP-NO. CHGBD214
|
|
00541 COMPUTE CHG5-TOT-CHG-AMT ROUNDED = CHGBD214
|
|
00542 (WRK-CHG * WRK-CURR-PCT). CHGBD214
|
|
00543 MOVE WRK-CURR-PRED TO CHG5-PRED-EMP-NO. CHGBD214
|
|
00544 MOVE WRK-CURR-SUCC TO CHG5-SUCC-EMP-NO. CHGBD214
|
|
00545 MOVE WRK-CURR-PCT TO CHG5-PERCENT-XFER. CHGBD214
|
|
00546 SET CHG5-TYPE-SUCC-88 TO TRUE. CHGBD214
|
|
00547 MOVE WRK-CURR-EFF-DT TO CHG5-REL-EFF-DT. CHGBD214
|
|
00548 ADD +1 TO WRK-SEQUENCE. CHGBD214
|
|
00549 MOVE WRK-SEQUENCE TO CHG5-SEQUENCE. CHGBD214
|
|
00550 CHGBD214
|
|
00551 IF C5-LAST < C5-MAX CHGBD214
|
|
00552 ADD +1 TO C5-LAST CHGBD214
|
|
00553 ELSE CHGBD214
|
|
00554 DISPLAY 'P1120 TABLE LEN EXCEEDED ' C5-LAST CHGBD214
|
|
00555 ' ' CHG5-EMP-NO CHGBD214
|
|
00556 GO TO P1120-EXIT CHGBD214
|
|
00557 END-IF. CHGBD214
|
|
00558 CHGBD214
|
|
00559 MOVE WRK-CHG5-REC TO C5-ENTRY (C5-LAST). CHGBD214
|
|
00560 CHGBD214
|
|
00561 *& CHGBD214
|
|
00562 * MOVE WRK-CHG TO AMT-DISP1. CHGBD214
|
|
00563 * MOVE WRK-CURR-PCT TO AMT-DISP4. CHGBD214
|
|
00564 * DISPLAY 'P1120 SUCC ' CHG5-EMP-NO ' ' CHG5-SSN CHGBD214
|
|
00565 * ' PRED ' CHG5-PRED-EMP-NO ' SUCC ' CHG5-SUCC-EMP-NO CHGBD214
|
|
00566 * ' ' AMT-DISP1 ' ' AMT-DISP4 ' ' CHG5-SEQUENCE. CHGBD214
|
|
00567 *& CHGBD214
|
|
00568 ******************************************************** CHGBD214
|
|
00569 * SUBTRACT CHARGE FROM PREDECESSOR ACCOUNT CHGBD214
|
|
00570 ******************************************************** CHGBD214
|
|
00571 MOVE WRK-CURR-PRED TO CHG5-EMP-NO. CHGBD214
|
|
00572 COMPUTE CHG5-TOT-CHG-AMT ROUNDED = CHGBD214
|
|
00573 (WRK-CHG * WRK-CURR-PCT * -1). CHGBD214
|
|
00574 MOVE WRK-CURR-PRED TO CHG5-PRED-EMP-NO CHGBD214
|
|
00575 MOVE WRK-CURR-SUCC TO CHG5-SUCC-EMP-NO CHGBD214
|
|
00576 SET CHG5-TYPE-PRED-88 TO TRUE. CHGBD214
|
|
00577 MOVE WRK-CURR-EFF-DT TO CHG5-REL-EFF-DT. CHGBD214
|
|
00578 ADD +1 TO WRK-SEQUENCE. CHGBD214
|
|
00579 MOVE WRK-SEQUENCE TO CHG5-SEQUENCE. CHGBD214
|
|
00580 CHGBD214
|
|
00581 IF C5-LAST < C5-MAX CHGBD214
|
|
00582 ADD +1 TO C5-LAST CHGBD214
|
|
00583 ELSE CHGBD214
|
|
00584 DISPLAY 'P1120 TABLE LEN EXCEEDED ' C5-LAST CHGBD214
|
|
00585 ' ' CHG5-EMP-NO CHGBD214
|
|
00586 GO TO P1120-EXIT CHGBD214
|
|
00587 END-IF. CHGBD214
|
|
00588 CHGBD214
|
|
00589 MOVE WRK-CHG5-REC TO C5-ENTRY (C5-LAST). CHGBD214
|
|
00590 CHGBD214
|
|
00591 *& CHGBD214
|
|
00592 * MOVE CHG5-TOT-CHG-AMT TO AMT-DISP1. CHGBD214
|
|
00593 * DISPLAY 'P1120 PRED ' CHG5-EMP-NO ' ' CHG5-SSN CHGBD214
|
|
00594 * ' PRED ' CHG5-PRED-EMP-NO ' SUCC ' CHG5-SUCC-EMP-NO CHGBD214
|
|
00595 * ' ' AMT-DISP1 ' ' CHG5-SEQUENCE. CHGBD214
|
|
00596 *& CHGBD214
|
|
00597 CHGBD214
|
|
00598 P1120-EXIT. CHGBD214
|
|
00599 EXIT. CHGBD214
|
|
00600 CHGBD214
|
|
00601 P2000-WRITE-CHARGES. CHGBD214
|
|
00602 * DISPLAY 'P2000 ' WRK-CURR-PRED ' ' C5-LAST. CHGBD214
|
|
00603 PERFORM CHGBD214
|
|
00604 VARYING C5-SUB FROM +1 BY +1 CHGBD214
|
|
00605 UNTIL C5-SUB > C5-LAST CHGBD214
|
|
00606 PERFORM P2010-WRITE-CHG5 THRU P2010-EXIT CHGBD214
|
|
00607 END-PERFORM. CHGBD214
|
|
00608 CHGBD214
|
|
00609 CHGBD214
|
|
00610 P2000-EXIT. CHGBD214
|
|
00611 EXIT. CHGBD214
|
|
00612 CHGBD214
|
|
00613 P2010-WRITE-CHG5. CHGBD214
|
|
00614 MOVE C5-ENTRY (C5-SUB) TO WRK-CHG5-REC. CHGBD214
|
|
00615 CHGBD214
|
|
00616 WRITE CHG5-REC FROM WRK-CHG5-REC. CHGBD214
|
|
00617 IF CHG5-FILE-OK-88 CHGBD214
|
|
00618 ADD 1 TO WRK-CHG5-WRITE-CNT CHGBD214
|
|
00619 ELSE CHGBD214
|
|
00620 DISPLAY 'CANNOT WRITE TO CHG5 FILE ' CHG5-STATUS CHGBD214
|
|
00621 ' ' CHG5-EMP-NO CHGBD214
|
|
00622 ' ' CHG5-BYE CHGBD214
|
|
00623 ' ' CHG5-SSN CHGBD214
|
|
00624 ' ' CHG5-PROGRAM CHGBD214
|
|
00625 ' ' CHG5-TYPE CHGBD214
|
|
00626 ' ' CHG5-PRED-EMP-NO CHGBD214
|
|
00627 ' ' CHG5-SUCC-EMP-NO CHGBD214
|
|
00628 ' ' CHG5-REL-EFF-DT CHGBD214
|
|
00629 SET WRK-ERROR-YES-88 TO TRUE CHGBD214
|
|
00630 END-IF. CHGBD214
|
|
00631 CHGBD214
|
|
00632 *& CHGBD214
|
|
00633 * IF CHG5-EMP-NO = 025207 OR 813049 CHGBD214
|
|
00634 * MOVE CHG5-TOT-CHG-AMT TO AMT-DISP1 CHGBD214
|
|
00635 * DISPLAY 'P2010 ' CHG5-EMP-NO ' ' CHG5-SSN CHGBD214
|
|
00636 * ' PRED ' CHG5-PRED-EMP-NO ' SUCC ' CHG5-SUCC-EMP-NO CHGBD214
|
|
00637 * ' ' AMT-DISP1 CHGBD214
|
|
00638 * END-IF. CHGBD214
|
|
00639 *& CHGBD214
|
|
00640 P2010-EXIT. CHGBD214
|
|
00641 EXIT. CHGBD214
|
|
00642 CHGBD214
|
|
00643 CHGBD214
|
|
00644 S001-FROM-FED-8. CHGBD214
|
|
00645 SET L001-FROM-FED-8 TO TRUE. CHGBD214
|
|
00646 GO TO S001-DATE. CHGBD214
|
|
00647 CHGBD214
|
|
00648 S001-FROM-ABS. CHGBD214
|
|
00649 SET L001-FROM-ABS-DAY TO TRUE. CHGBD214
|
|
00650 GO TO S001-DATE. CHGBD214
|
|
00651 CHGBD214
|
|
00652 S001-DATE. CHGBD214
|
|
00653 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD214
|
|
00654 S001-EXIT. EXIT. CHGBD214
|
|
00655 CHGBD214
|
|
00656 S004-FROM-DATE. CHGBD214
|
|
00657 SET L004-FROM-DATE TO TRUE. CHGBD214
|
|
00658 GO TO S004-YRQ. CHGBD214
|
|
00659 CHGBD214
|
|
00660 S004-FROM-5. CHGBD214
|
|
00661 SET L004-FROM-5 TO TRUE. CHGBD214
|
|
00662 GO TO S004-YRQ. CHGBD214
|
|
00663 CHGBD214
|
|
00664 S004-FROM-3. CHGBD214
|
|
00665 SET L004-FROM-3 TO TRUE. CHGBD214
|
|
00666 GO TO S004-YRQ. CHGBD214
|
|
00667 CHGBD214
|
|
00668 S004-FROM-ABS. CHGBD214
|
|
00669 SET L004-FROM-ABS TO TRUE. CHGBD214
|
|
00670 GO TO S004-YRQ. CHGBD214
|
|
00671 CHGBD214
|
|
00672 S004-YRQ. CHGBD214
|
|
00673 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD214
|
|
00674 S004-EXIT. EXIT. CHGBD214
|
|
00675 CHGBD214
|
|
00676 S005-SYSTEM-DATE. CHGBD214
|
|
00677 CALL 'DTSBU005' USING L005-LINK-AREA. CHGBD214
|
|
00678 S005-EXIT. EXIT. CHGBD214
|
|
00679 CHGBD214
|
|
00680 S006-FROM-QTR. CHGBD214
|
|
00681 SET L006-FROM-QTR TO TRUE. CHGBD214
|
|
00682 CALL 'DTSBU006' USING L006-LINK-AREA. CHGBD214
|
|
00683 S006-EXIT. EXIT. CHGBD214
|
|
00684 CHGBD214
|
|
00685 CHGBD214
|
|
00686 S910-OPEN-READ. CHGBD214
|
|
00687 SET L910-OPEN-READ-88 TO TRUE. CHGBD214
|
|
00688 GO TO S910-MSTR-IO. CHGBD214
|
|
00689 CHGBD214
|
|
00690 S910-OPEN-UPDATE. CHGBD214
|
|
00691 SET L910-OPEN-UPDATE-88 TO TRUE. CHGBD214
|
|
00692 GO TO S910-MSTR-IO. CHGBD214
|
|
00693 CHGBD214
|
|
00694 S910-READ. CHGBD214
|
|
00695 SET L910-READ-88 TO TRUE. CHGBD214
|
|
00696 GO TO S910-MSTR-IO. CHGBD214
|
|
00697 CHGBD214
|
|
00698 S910-START-BROWSE. CHGBD214
|
|
00699 SET L910-START-BROWSE-88 TO TRUE. CHGBD214
|
|
00700 GO TO S910-MSTR-IO. CHGBD214
|
|
00701 CHGBD214
|
|
00702 S910-READ-NEXT. CHGBD214
|
|
00703 SET L910-READ-NEXT-88 TO TRUE. CHGBD214
|
|
00704 GO TO S910-MSTR-IO. CHGBD214
|
|
00705 CHGBD214
|
|
00706 S910-WRITE. CHGBD214
|
|
00707 SET L910-WRITE-88 TO TRUE. CHGBD214
|
|
00708 GO TO S910-MSTR-IO. CHGBD214
|
|
00709 CHGBD214
|
|
00710 S910-CLOSE. CHGBD214
|
|
00711 SET L910-CLOSE-88 TO TRUE. CHGBD214
|
|
00712 GO TO S910-MSTR-IO. CHGBD214
|
|
00713 CHGBD214
|
|
00714 S910-MSTR-IO. CHGBD214
|
|
00715 CALL 'DTSBU910' USING L910-LINK-AREA CHGBD214
|
|
00716 MSKL-REC. CHGBD214
|
|
00717 CHGBD214
|
|
00718 S910-EXIT. CHGBD214
|
|
00719 EXIT. CHGBD214
|
|
00720 CHGBD214
|
|
00721 S921-OPEN-READ. CHGBD214
|
|
00722 SET L921-OPEN-READ-88 TO TRUE. CHGBD214
|
|
00723 GO TO S921-AIX-IO. CHGBD214
|
|
00724 CHGBD214
|
|
00725 S921-CLOSE. CHGBD214
|
|
00726 SET L921-CLOSE-88 TO TRUE. CHGBD214
|
|
00727 GO TO S921-AIX-IO. CHGBD214
|
|
00728 CHGBD214
|
|
00729 S921-AIX-IO. CHGBD214
|
|
00730 CALL 'DTSBU921' USING L921-LINK-AREA CHGBD214
|
|
00731 ISKL-REC. CHGBD214
|
|
00732 CHGBD214
|
|
00733 S921-EXIT. CHGBD214
|
|
00734 EXIT. CHGBD214
|
|
00735 CHGBD214
|
|
00736 ** REPORT RECORD I-O CHGBD214
|
|
00737 S946-RPT-REC-O. CHGBD214
|
|
00738 CALL 'DTSBU946' USING RSKL-REC. CHGBD214
|
|
00739 CHGBD214
|
|
00740 S946-EXIT. CHGBD214
|
|
00741 EXIT. CHGBD214
|
|
00742 CHGBD214
|
|
00743 T0000-TERMINATE. CHGBD214
|
|
00744 CHGBD214
|
|
00745 CLOSE CHARGE-FILE CHGBD214
|
|
00746 RELATIONSHIP-FILE. CHGBD214
|
|
00747 CHGBD214
|
|
00748 PERFORM S910-CLOSE THRU S910-EXIT. CHGBD214
|
|
00749 CHGBD214
|
|
00750 DISPLAY '***********************************************'. CHGBD214
|
|
00751 DISPLAY '*** CHGBD214 COUNTS *** '. CHGBD214
|
|
00752 DISPLAY '***'. CHGBD214
|
|
00753 CHGBD214
|
|
00754 DISPLAY ' RELATIONSHIP RECORDS READ : ' CHGBD214
|
|
00755 WRK-REL-CNT. CHGBD214
|
|
00756 CHGBD214
|
|
00757 DISPLAY ' CHARGE RECORDS READ : ' CHGBD214
|
|
00758 WRK-CHG5-CNT. CHGBD214
|
|
00759 CHGBD214
|
|
00760 DISPLAY ' TRANSFER RECORDS SAVED : ' CHGBD214
|
|
00761 C5-LAST. CHGBD214
|
|
00762 CHGBD214
|
|
00763 DISPLAY ' TRANSFER RECORDS WRITTEN : ' CHGBD214
|
|
00764 WRK-CHG5-WRITE-CNT. CHGBD214
|
|
00765 CHGBD214
|
|
00766 DISPLAY ' 100% TRANSFERS : ' CHGBD214
|
|
00767 WRK-100PCT-CNT. CHGBD214
|
|
00768 CHGBD214
|
|
00769 DISPLAY '***********************************************'. CHGBD214
|
|
00770 CHGBD214
|
|
00771 T0000-EXIT. CHGBD214
|
|
00772 EXIT. CHGBD214
|
|
00773 CHGBD214
|
|
00774 S999-ABEND. CHGBD214
|
|
00775 DISPLAY '**** CHGBD214 ABENDING ' CHGBD214
|
|
00776 ABEND-MSG. CHGBD214
|
|
00777 CALL ABEND-MOD USING ABEND-CODE. CHGBD214
|
|
00778 CHGBD214
|
|
00779 S999-EXIT. CHGBD214
|
|
00780 EXIT. CHGBD214
|
|
00781 CHGBD214
|