384 lines
30 KiB
COBOL
384 lines
30 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/25/10
|
|
00002 PROGRAM-ID. CHGBR111. CHGBR111
|
|
00003 *AUTHOR. TCL. LV097
|
|
00004 *DATE-WRITTEN. JULY 1999. CHGBR111
|
|
00005 DATE-COMPILED. CHGBR111
|
|
00006 SKIP3 CHGBR111
|
|
00007 CHGBR111
|
|
00008 ***** CHGBR111
|
|
00009 * CALLING SEQUENCE: CHGBD300 CALLS CHGBR111
|
|
00010 * CHGBR111 READS CHGIM004 RECORDS CHGBR111
|
|
00011 * CHGBR111 THEN WRITES TPS-CHG-UNIV-REC CHGBR111
|
|
00012 * CHGBR111
|
|
00013 ***** CHGBR111
|
|
00014 * CHGBR111
|
|
00015 * FUNCTION: CHGBR111
|
|
00016 * CHGBR111
|
|
00017 * CREATE TPS BENEFIT CHARGE UNIVERSE RECORDS. CHGBR111
|
|
00018 * CHGBR111
|
|
00019 * RECORDS READ: CHGBR111
|
|
00020 * CHGBR111
|
|
00021 * NONE. CHGBR111
|
|
00022 * CHGBR111
|
|
00023 * INPUT: CHGBR111
|
|
00024 * CHGBR111
|
|
00025 * CHGIM002 RECORD PASSED FROM CHGBD300 CHGBR111
|
|
00026 * CHGBR111
|
|
00027 * OUTPUTS: CHGBR111
|
|
00028 * CHGBR111
|
|
00029 * RECORDS WRITTEN ON DISK - TPD-CHG-UNIV FILE CHGBR111
|
|
00030 * CHGBR111
|
|
00031 * MODULES CALLED: CHGBR111
|
|
00032 * CHGBR111
|
|
00033 * DTSBU001 DATE EDIT/CONVERSION MODULE CHGBR111
|
|
00034 * DTSBU999 ABEND MODULE CHGBR111
|
|
00035 * CHGBR111
|
|
00036 ***** CHGBR111
|
|
00037 CHGBR111
|
|
00038 ******************************************************************CHGBR111
|
|
00039 * MODIFICATION HISTORY: *CHGBR111
|
|
00040 * *CHGBR111
|
|
00041 * 07-02-1999 NEW DEVELOPMENT *CHGBR111
|
|
00042 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBR111
|
|
00043 * *CHGBR111
|
|
00044 * *CHGBR111
|
|
00045 * 05-14-2010 RECOMPILE FOR NEW VERSION OF CHGIM004 *CHGBR111
|
|
00046 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBR111
|
|
00047 * *CHGBR111
|
|
00048 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR111
|
|
00049 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR111
|
|
00050 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBR111
|
|
00051 ******************************************************************CHGBR111
|
|
00052 CHGBR111
|
|
00053 SKIP3 CHGBR111
|
|
00054 ENVIRONMENT DIVISION. CHGBR111
|
|
00055 SKIP3 CHGBR111
|
|
00056 INPUT-OUTPUT SECTION. CHGBR111
|
|
00057 SKIP3 CHGBR111
|
|
00058 FILE-CONTROL. CHGBR111
|
|
00059 * SELECT TPS-CHG-UNIV-FILE ASSIGN TO RPC111R1 CHGBR111
|
|
00060 SELECT TPS-CHG-UNIV-FILE ASSIGN TO TPSCHRG CHGBR111
|
|
00061 FILE STATUS IS TPS-STATUS. CHGBR111
|
|
00062 EJECT CHGBR111
|
|
00063 DATA DIVISION. CHGBR111
|
|
00064 SKIP3 CHGBR111
|
|
00065 FILE SECTION. CHGBR111
|
|
00066 SKIP3 CHGBR111
|
|
00067 FD TPS-CHG-UNIV-FILE CHGBR111
|
|
00068 RECORDING MODE IS F CHGBR111
|
|
00069 BLOCK CONTAINS 0 CHARACTERS. CHGBR111
|
|
00070 SKIP2 CHGBR111
|
|
00071 01 TPS-CHG-UNIV-REC. CHGBR111
|
|
00072 05 SEQ-NMBR PIC 9(8). CHGBR111
|
|
00073 05 REC-TYPE PIC X(5). CHGBR111
|
|
00074 05 TRANS-TYPE PIC X. CHGBR111
|
|
00075 05 SELECT-FLAG PIC X. CHGBR111
|
|
00076 05 DATE-FILE-CREATED PIC X(8). CHGBR111
|
|
00077 05 EMP-ID PIC X(12). CHGBR111
|
|
00078 05 SSN PIC 9(09). CHGBR111
|
|
00079 05 BYB-DATE PIC 9(08). CHGBR111
|
|
00080 05 CLAIM-TYPE PIC X(02). CHGBR111
|
|
00081 05 NAME PIC X(32). CHGBR111
|
|
00082 05 AMOUNT PIC 9(07)V99. CHGBR111
|
|
00083 05 STATE-OPTION PIC X(23). CHGBR111
|
|
00084 CHGBR111
|
|
00085 WORKING-STORAGE SECTION. CHGBR111
|
|
000855 77 PAN-VALET PICTURE X(24) VALUE '097CHGBR111 05/25/10'. CHGBR111
|
|
00086 CHGBR111
|
|
00087 01 CR-TPS-CHG-UNIV-REC. CHGBR111
|
|
00088 05 CR-SEQ-NMBR PIC 9(8). CHGBR111
|
|
00089 05 CR-REC-TYPE PIC X(5). CHGBR111
|
|
00090 05 CR-TRANS-TYPE PIC X. CHGBR111
|
|
00091 05 CR-SELECT-FLAG PIC X. CHGBR111
|
|
00092 05 CR-DATE-FILE-CREATED PIC X(8). CHGBR111
|
|
00093 05 CR-EMP-ID PIC X(12). CHGBR111
|
|
00094 05 CR-SSN PIC 9(09). CHGBR111
|
|
00095 05 CR-BYB-DATE PIC 9(08). CHGBR111
|
|
00096 05 CR-CLAIM-TYPE PIC X(02). CHGBR111
|
|
00097 05 CR-NAME PIC X(32). CHGBR111
|
|
00098 05 CR-AMOUNT PIC 9(07)V99. CHGBR111
|
|
00099 05 CR-STATE-OPTION PIC X(23). CHGBR111
|
|
00100 CHGBR111
|
|
00101 CHGBR111
|
|
00102 01 DB-TPS-CHG-UNIV-REC. CHGBR111
|
|
00103 05 DB-SEQ-NMBR PIC 9(8). CHGBR111
|
|
00104 05 DB-REC-TYPE PIC X(5). CHGBR111
|
|
00105 05 DB-TRANS-TYPE PIC X. CHGBR111
|
|
00106 05 DB-SELECT-FLAG PIC X. CHGBR111
|
|
00107 05 DB-DATE-FILE-CREATED PIC X(8). CHGBR111
|
|
00108 05 DB-EMP-ID PIC X(12). CHGBR111
|
|
00109 05 DB-SSN PIC 9(09). CHGBR111
|
|
00110 05 DB-BYB-DATE PIC 9(08). CHGBR111
|
|
00111 05 DB-CLAIM-TYPE PIC X(02). CHGBR111
|
|
00112 05 DB-NAME PIC X(32). CHGBR111
|
|
00113 05 DB-AMOUNT PIC 9(07)V99. CHGBR111
|
|
00114 05 DB-STATE-OPTION PIC X(23). CHGBR111
|
|
00115 CHGBR111
|
|
00116 CHGBR111
|
|
00117 01 WRK-AREA. CHGBR111
|
|
00118 CHGBR111
|
|
00119 05 WRK-ACCT-SW PIC X VALUE SPACE. CHGBR111
|
|
00120 CHGBR111
|
|
00121 05 WRK-HOLD-ACCT-NUM PIC 9(7) COMP-3 VALUE ZEROS. CHGBR111
|
|
00122 CHGBR111
|
|
00123 05 ABEND-CODE PIC S9(04) COMP CHGBR111
|
|
00124 VALUE +111. CHGBR111
|
|
00125 05 ABEND-MSG PIC X(60). CHGBR111
|
|
00126 CHGBR111
|
|
00127 05 WRK-FIRST-TIME-IND PIC X(01) VALUE 'Y'. CHGBR111
|
|
00128 88 WRK-FIRST-TIME-YES-88 VALUE 'Y'. CHGBR111
|
|
00129 88 WRK-FIRST-TIME-NO-88 VALUE 'N'. CHGBR111
|
|
00130 CHGBR111
|
|
00131 05 WRK-ERROR-IND PIC X(01). CHGBR111
|
|
00132 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBR111
|
|
00133 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBR111
|
|
00134 CHGBR111
|
|
00135 05 TPS-STATUS PIC X(02). CHGBR111
|
|
00136 88 TPS-STATUS-OK-88 VALUE '00'. CHGBR111
|
|
00137 CHGBR111
|
|
00138 05 WRK-EMP-NO-AREA PIC X(12). CHGBR111
|
|
00139 05 FILLER REDEFINES WRK-EMP-NO-AREA. CHGBR111
|
|
00140 10 WRK-EMP-FILLER PIC X(06). CHGBR111
|
|
00141 10 WRK-EMP-NO PIC 9(06). CHGBR111
|
|
00142 CHGBR111
|
|
00143 05 WRK-CURR-DATE PIC 9(08). CHGBR111
|
|
00144 05 WRK-CURR-SSN PIC 9(09). CHGBR111
|
|
00145 05 WRK-CURR-BYE PIC S9(09) COMP-3. CHGBR111
|
|
00146 05 WRK-CURR-EMP PIC S9(07) COMP-3. CHGBR111
|
|
00147 05 WRK-CHG-AMT PIC 9(07).99-. CHGBR111
|
|
00148 05 TPS-RECS-COUNT PIC S9(07) COMP-3 VALUE 0. CHGBR111
|
|
00149 CHGBR111
|
|
00150 01 L001-LINK-AREA. CHGBR111
|
|
00151 ++INCLUDE DTSIL001 CHGBR111
|
|
00152 CHGBR111
|
|
00153 EJECT CHGBR111
|
|
00154 LINKAGE SECTION. CHGBR111
|
|
00155 01 REPORT-LINK-AREA. CHGBR111
|
|
00156 ++INCLUDE CHGIL001 CHGBR111
|
|
00157 CHGBR111
|
|
00158 01 BD210-CHG-REC. CHGBR111
|
|
00159 ++INCLUDE CHGIM004 CHGBR111
|
|
00160 CHGBR111
|
|
00161 PROCEDURE DIVISION USING REPORT-LINK-AREA CHGBR111
|
|
00162 BD210-CHG-REC. CHGBR111
|
|
00163 SKIP2 CHGBR111
|
|
00164 CHGBR111-MAIN. CHGBR111
|
|
00165 CHGBR111
|
|
00166 SET WRK-ERROR-NO-88 TO TRUE. CHGBR111
|
|
00167 CHGBR111
|
|
00168 IF CHG-LINK1-CMD-INIT-88 CHGBR111
|
|
00169 PERFORM I0000-INITIATE THRU I0000-EXIT CHGBR111
|
|
00170 ELSE CHGBR111
|
|
00171 IF CHG-LINK1-CMD-PROCESS-88 CHGBR111
|
|
00172 PERFORM P0000-PROCESS THRU P0000-EXIT CHGBR111
|
|
00173 ELSE CHGBR111
|
|
00174 IF CHG-LINK1-CMD-CLOSE-88 CHGBR111
|
|
00175 PERFORM T0000-TERMINATE THRU T0000-EXIT CHGBR111
|
|
00176 ELSE CHGBR111
|
|
00177 DISPLAY 'CHGBR111 ABENDING: INVALID COMMAND ' CHGBR111
|
|
00178 CHG-LINK1-COMMAND CHGBR111
|
|
00179 PERFORM S999-ABEND THRU S999-EXIT. CHGBR111
|
|
00180 CHGBR111
|
|
00181 CHGBR111-EXIT. CHGBR111
|
|
00182 GOBACK. CHGBR111
|
|
00183 EJECT CHGBR111
|
|
00184 I0000-INITIATE. CHGBR111
|
|
00185 MOVE ZERO TO WRK-CURR-EMP, WRK-HOLD-ACCT-NUM CHGBR111
|
|
00186 WRK-CURR-SSN CHGBR111
|
|
00187 WRK-CURR-BYE. CHGBR111
|
|
00188 CHGBR111
|
|
00189 ACCEPT L001-FED-6-DATE-X FROM DATE. CHGBR111
|
|
00190 PERFORM S001-FROM-FED-6 THRU S001-EXIT. CHGBR111
|
|
00191 IF NOT L001-VALID-DATE CHGBR111
|
|
00192 DISPLAY 'INVALID DATE ' L001-FED-8-DATE-9 CHGBR111
|
|
00193 ELSE CHGBR111
|
|
00194 DISPLAY 'VALID DATE ' L001-FED-8-DATE-9. CHGBR111
|
|
00195 MOVE L001-FED-8-DATE-9 TO WRK-CURR-DATE. CHGBR111
|
|
00196 CHGBR111
|
|
00197 OPEN OUTPUT TPS-CHG-UNIV-FILE. CHGBR111
|
|
00198 IF NOT TPS-STATUS-OK-88 CHGBR111
|
|
00199 DISPLAY 'CHGBR111: CANNOT OPEN TPS FILE ' CHGBR111
|
|
00200 TPS-STATUS CHGBR111
|
|
00201 PERFORM S999-ABEND THRU S999-EXIT CHGBR111
|
|
00202 GO TO I0000-EXIT. CHGBR111
|
|
00203 CHGBR111
|
|
00204 INITIALIZE TPS-CHG-UNIV-REC, CR-TPS-CHG-UNIV-REC CHGBR111
|
|
00205 DB-TPS-CHG-UNIV-REC. CHGBR111
|
|
00206 I0000-EXIT. CHGBR111
|
|
00207 EXIT. CHGBR111
|
|
00208 CHGBR111
|
|
00209 P0000-PROCESS. CHGBR111
|
|
00210 CHGBR111
|
|
00211 COMPUTE WRK-CHG-AMT = CHG4-CURR-BEN-AMT + CHGBR111
|
|
00212 CHG4-CURR-ADJ-AMT. CHGBR111
|
|
00213 CHGBR111
|
|
00214 IF WRK-CHG-AMT = ZERO CHGBR111
|
|
00215 GO TO P0000-EXIT. CHGBR111
|
|
00216 CHGBR111
|
|
00217 IF WRK-ACCT-SW = SPACE CHGBR111
|
|
00218 MOVE 1 TO WRK-ACCT-SW CHGBR111
|
|
00219 MOVE CHG4-EMP-NO TO WRK-HOLD-ACCT-NUM CHGBR111
|
|
00220 PERFORM P0001-CREDIT THRU P0002-EXIT CHGBR111
|
|
00221 PERFORM P0002-DEBIT THRU P0002-EXIT CHGBR111
|
|
00222 GO TO P0000-EXIT. CHGBR111
|
|
00223 CHGBR111
|
|
00224 IF CHG4-EMP-NO = WRK-HOLD-ACCT-NUM CHGBR111
|
|
00225 MOVE CHG4-EMP-NO TO WRK-HOLD-ACCT-NUM CHGBR111
|
|
00226 PERFORM P0001-CREDIT THRU P0002-EXIT CHGBR111
|
|
00227 PERFORM P0002-DEBIT THRU P0002-EXIT CHGBR111
|
|
00228 GO TO P0000-EXIT. CHGBR111
|
|
00229 CHGBR111
|
|
00230 IF CHG4-EMP-NO > WRK-HOLD-ACCT-NUM CHGBR111
|
|
00231 MOVE CHG4-EMP-NO TO WRK-HOLD-ACCT-NUM CHGBR111
|
|
00232 PERFORM P0003-CR-WRITE-TPS THRU P0003-EXIT CHGBR111
|
|
00233 PERFORM P0004-DB-WRITE-TPS THRU P0004-EXIT CHGBR111
|
|
00234 PERFORM P0001-CREDIT THRU P0001-EXIT CHGBR111
|
|
00235 PERFORM P0002-DEBIT THRU P0002-EXIT CHGBR111
|
|
00236 GO TO P0000-EXIT. CHGBR111
|
|
00237 CHGBR111
|
|
00238 P0000-EXIT. CHGBR111
|
|
00239 EXIT. CHGBR111
|
|
00240 CHGBR111
|
|
00241 P0001-CREDIT. CHGBR111
|
|
00242 CHGBR111
|
|
00243 IF WRK-CHG-AMT < ZERO CHGBR111
|
|
00244 NEXT SENTENCE CHGBR111
|
|
00245 ELSE CHGBR111
|
|
00246 GO TO P0001-EXIT. CHGBR111
|
|
00247 CHGBR111
|
|
00248 MOVE ZERO TO CR-SEQ-NMBR. CHGBR111
|
|
00249 MOVE CHG4-SSN TO CR-SSN. CHGBR111
|
|
00250 MOVE CHG4-BYE TO CR-BYB-DATE. CHGBR111
|
|
00251 COMPUTE WRK-CHG-AMT = CHG4-CURR-BEN-AMT + CHGBR111
|
|
00252 CHG4-CURR-ADJ-AMT CHGBR111
|
|
00253 MOVE WRK-CHG-AMT TO CR-AMOUNT. CHGBR111
|
|
00254 CHGBR111
|
|
00255 MOVE SPACES TO CR-CLAIM-TYPE. CHGBR111
|
|
00256 MOVE CHG4-CLMNT-NAME TO CR-NAME CHGBR111
|
|
00257 MOVE SPACES TO CR-STATE-OPTION. CHGBR111
|
|
00258 CHGBR111
|
|
00259 MOVE 'CS044' TO CR-REC-TYPE. CHGBR111
|
|
00260 MOVE '1' TO CR-TRANS-TYPE CHGBR111
|
|
00261 CR-SELECT-FLAG. CHGBR111
|
|
00262 CHGBR111
|
|
00263 MOVE WRK-CURR-DATE TO CR-DATE-FILE-CREATED. CHGBR111
|
|
00264 MOVE SPACES TO WRK-EMP-FILLER. CHGBR111
|
|
00265 MOVE CHG4-EMP-NO TO WRK-EMP-NO. CHGBR111
|
|
00266 MOVE WRK-EMP-NO-AREA TO CR-EMP-ID. CHGBR111
|
|
00267 CHGBR111
|
|
00268 P0001-EXIT. CHGBR111
|
|
00269 EXIT. CHGBR111
|
|
00270 CHGBR111
|
|
00271 P0002-DEBIT. CHGBR111
|
|
00272 CHGBR111
|
|
00273 IF WRK-CHG-AMT > ZERO CHGBR111
|
|
00274 NEXT SENTENCE CHGBR111
|
|
00275 ELSE CHGBR111
|
|
00276 GO TO P0002-EXIT. CHGBR111
|
|
00277 CHGBR111
|
|
00278 MOVE ZERO TO CR-SEQ-NMBR. CHGBR111
|
|
00279 MOVE CHG4-SSN TO DB-SSN. CHGBR111
|
|
00280 MOVE CHG4-BYE TO DB-BYB-DATE. CHGBR111
|
|
00281 COMPUTE WRK-CHG-AMT = CHG4-CURR-BEN-AMT + CHGBR111
|
|
00282 CHG4-CURR-ADJ-AMT. CHGBR111
|
|
00283 MOVE WRK-CHG-AMT TO DB-AMOUNT. CHGBR111
|
|
00284 CHGBR111
|
|
00285 MOVE SPACES TO DB-CLAIM-TYPE CHGBR111
|
|
00286 MOVE CHG4-CLMNT-NAME TO DB-NAME. CHGBR111
|
|
00287 MOVE SPACES TO DB-STATE-OPTION. CHGBR111
|
|
00288 CHGBR111
|
|
00289 MOVE 'CS044' TO DB-REC-TYPE. CHGBR111
|
|
00290 MOVE '1' TO DB-TRANS-TYPE CHGBR111
|
|
00291 DB-SELECT-FLAG. CHGBR111
|
|
00292 CHGBR111
|
|
00293 MOVE WRK-CURR-DATE TO DB-DATE-FILE-CREATED. CHGBR111
|
|
00294 MOVE SPACES TO WRK-EMP-FILLER. CHGBR111
|
|
00295 MOVE CHG4-EMP-NO TO WRK-EMP-NO. CHGBR111
|
|
00296 MOVE WRK-EMP-NO-AREA TO DB-EMP-ID. CHGBR111
|
|
00297 CHGBR111
|
|
00298 P0002-EXIT. CHGBR111
|
|
00299 EXIT. CHGBR111
|
|
00300 CHGBR111
|
|
00301 P0003-CR-WRITE-TPS. CHGBR111
|
|
00302 CHGBR111
|
|
00303 IF CR-SSN > ZERO CHGBR111
|
|
00304 ADD 1 TO TPS-RECS-COUNT CHGBR111
|
|
00305 WRITE TPS-CHG-UNIV-REC FROM CR-TPS-CHG-UNIV-REC CHGBR111
|
|
00306 PERFORM P1000-INIT-TPS-REC THRU P1000-EXIT. CHGBR111
|
|
00307 CHGBR111
|
|
00308 P0003-EXIT. CHGBR111
|
|
00309 EXIT. CHGBR111
|
|
00310 CHGBR111
|
|
00311 P0004-DB-WRITE-TPS. CHGBR111
|
|
00312 CHGBR111
|
|
00313 IF DB-SSN > ZERO CHGBR111
|
|
00314 ADD 1 TO TPS-RECS-COUNT CHGBR111
|
|
00315 WRITE TPS-CHG-UNIV-REC FROM DB-TPS-CHG-UNIV-REC CHGBR111
|
|
00316 PERFORM P1000-INIT-TPS-REC THRU P1000-EXIT. CHGBR111
|
|
00317 CHGBR111
|
|
00318 P0004-EXIT. CHGBR111
|
|
00319 EXIT. CHGBR111
|
|
00320 CHGBR111
|
|
00321 P1000-INIT-TPS-REC. CHGBR111
|
|
00322 CHGBR111
|
|
00323 MOVE ZERO TO SEQ-NMBR, CR-SEQ-NMBR, DB-SEQ-NMBR CHGBR111
|
|
00324 SSN, CR-SSN, DB-SSN CHGBR111
|
|
00325 BYB-DATE, CR-BYB-DATE CHGBR111
|
|
00326 AMOUNT, CR-AMOUNT, DB-AMOUNT. CHGBR111
|
|
00327 CHGBR111
|
|
00328 MOVE SPACES TO CLAIM-TYPE, CR-CLAIM-TYPE, DB-CLAIM-TYPE CHGBR111
|
|
00329 NAME, CR-NAME, DB-NAME CHGBR111
|
|
00330 STATE-OPTION, CR-STATE-OPTION, DB-STATE-OPTIONCHGBR111
|
|
00331 CHGBR111
|
|
00332 MOVE 'CS044' TO REC-TYPE, CR-REC-TYPE, DB-REC-TYPE. CHGBR111
|
|
00333 MOVE '1' TO TRANS-TYPE, CR-TRANS-TYPE, DB-TRANS-TYPE CHGBR111
|
|
00334 SELECT-FLAG, CR-SELECT-FLAG, DB-SELECT-FLAG. CHGBR111
|
|
00335 CHGBR111
|
|
00336 MOVE WRK-CURR-DATE TO CR-DATE-FILE-CREATED CHGBR111
|
|
00337 DB-DATE-FILE-CREATED. CHGBR111
|
|
00338 CHGBR111
|
|
00339 MOVE SPACES TO WRK-EMP-FILLER. CHGBR111
|
|
00340 * MOVE CHG4-EMP-NO TO WRK-EMP-NO. CHGBR111
|
|
00341 CHGBR111
|
|
00342 P1000-EXIT. CHGBR111
|
|
00343 EXIT. CHGBR111
|
|
00344 CHGBR111
|
|
00345 *P2000-SUM-CHARGES. CHGBR111
|
|
00346 *P2000-EXIT. CHGBR111
|
|
00347 * EXIT. CHGBR111
|
|
00348 CHGBR111
|
|
00349 T0000-TERMINATE. CHGBR111
|
|
00350 PERFORM P0003-CR-WRITE-TPS THRU P0003-EXIT. CHGBR111
|
|
00351 PERFORM P0004-DB-WRITE-TPS THRU P0004-EXIT. CHGBR111
|
|
00352 DISPLAY 'BR111 TERMINATE'. CHGBR111
|
|
00353 DISPLAY 'TPS RECS WRITTEN = ' TPS-RECS-COUNT. CHGBR111
|
|
00354 CLOSE TPS-CHG-UNIV-FILE. CHGBR111
|
|
00355 T0000-EXIT. CHGBR111
|
|
00356 EXIT. CHGBR111
|
|
00357 EJECT CHGBR111
|
|
00358 CHGBR111
|
|
00359 CHGBR111
|
|
00360 S1000-WRITE-TPS-REC. CHGBR111
|
|
00361 WRITE TPS-CHG-UNIV-REC. CHGBR111
|
|
00362 ADD 1 TO TPS-RECS-COUNT. CHGBR111
|
|
00363 CHGBR111
|
|
00364 S1000-EXIT. CHGBR111
|
|
00365 EXIT. CHGBR111
|
|
00366 CHGBR111
|
|
00367 S001-FROM-FED-6. CHGBR111
|
|
00368 SET L001-FROM-FED-6 TO TRUE. CHGBR111
|
|
00369 GO TO S001-DATE. CHGBR111
|
|
00370 CHGBR111
|
|
00371 S001-DATE. CHGBR111
|
|
00372 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR111
|
|
00373 S001-EXIT. EXIT. CHGBR111
|
|
00374 CHGBR111
|
|
00375 S999-ABEND. CHGBR111
|
|
00376 DISPLAY '**** CHGBR111 ABENDING ' CHGBR111
|
|
00377 ABEND-MSG. CHGBR111
|
|
00378 *& ABEND COMMENTED OUT FOR TESTING CHGBR111
|
|
00379 CALL 'DTSBU999' USING ABEND-CODE. CHGBR111
|
|
00380 SET WRK-ERROR-YES-88 TO TRUE. CHGBR111
|
|
00381 S999-EXIT. CHGBR111
|
|
00382 EXIT. CHGBR111
|