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
