×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

COBOL General discussion FAQ

Conditionals

How do I update a master file from a transaction file? by slade
Posted: 18 Sep 01 (Edited 23 Sep 03)

The file match construct along with the control break (see conditionals FAQ) account easily for 80-90% of all batch programming problems. So a generalized solution (or methodology) is extremely valuable. To provide that generalized solution is the purpose of this FAQ and that mentiond above.

The program code for the file match solution is included below. Before this pgm is executed both files must be sorted on the same key. See pgm code for masterx-file-key and transx-file-key. Sorry for the alignment.
 
00001  IDENTIFICATION DIVISION.
00002  PROGRAM-ID.    FILE-MATCH-MODEL.
00003 *AUTHOR.        JACK SLEIGHT
00004 *DATE-WRITTEN   JANUARY  1997.
00005 *REMARKS.
00006 *
00007 *        THIS IS A MODEL FOR THE FILE MATCH CONSTRUCT. THIS MODEL
00008 *        ASSUMES A MASTER FILE UPDATE FROM XACTION RECS. THE GEN-
00009 *        ERALIZED SOLUTION CONTAINED HERE ILLUSTRATES HOW TO INT-
00009 *        ERROGATE 2 FILES TO DETERMINE THE ORDER OF ACCESSING BOTH
00009 *        FILES WHEN ATTEMPTING TO MATCH THEIR RECS. I'VE DELIBER-
00009 *        ATELY INCLUDED FILE HDR CHECKING AND SOME DATE PROCESSING.
00009 *        WHILE IT'S BESIDE THE POINT, SOME FILES USE HDRS AND THE
00009 *        CODE MAY PROVE USEFUL.
00010 **
00011 ******************************************************************
00012 *                           CHANGE LOG
00013 ******************************************************************
00014 *
00015 * 01/15/97 J.S. - CREATED.
00016 *
00017 ******************************************************************
00018
00019
00020  ENVIRONMENT DIVISION.
00021  INPUT-OUTPUT SECTION.
00022
00023  FILE-CONTROL.
00024      SELECT  TRANSX-FILE-IP ASSIGN TO TRANSXDD.
00025      SELECT MASTERX-FILE-IP ASSIGN TO MSTRXIDD.
00026      SELECT MASTERX-FILE-OP ASSIGN TO MSTRXODD.
00027
00028  DATA DIVISION.
00029  FILE SECTION.
00030  FD  TRANSX-FILE-IP.
00031  01  TRANSX-REC-IP               PIC  X(???).
00032
00033  FD  MASTERX-FILE-IP.
00034  01  MASTERX-REC-IP              PIC  X(???).
00035
00036  FD  MASTERX-FILE-OP
00037      RECORD CONTAINS ??? CHARACTERS
00038      BLOCK  CONTAINS 000 RECORDS.
00039  01  MASTERX-REC-OP              PIC  X(???).
00040
00041  WORKING-STORAGE SECTION.
00044
00045  01  WS-TRANSX-HDR.
00046  ++INCLUDE XXXXXXXX
00047  01  WS-TRANSX-DTL.
00048  ++INCLUDE XXXXXXXX
00049
00050  01  WS-MASTERX-HDR.
00051  ++INCLUDE XXXXXXXX
00052  01  WS-MASTERX-DTL.
00053  ++INCLUDE XXXXXXXX
00054
00055  01  WS-WORK-AREAS.
00056      05  WS-INFLAT-IDX-TODAY     PIC S9(003)V9(6) COMP-3.
00057      05  WS-INFLAT-IDX-NBDAY     PIC S9(003)V9(6) COMP-3.
00058      05  WS-REC-CNT              PIC S9(007) VALUE +0 COMP-3.
00059      05  WS-INFLAT-IDX-PGM       PIC  X(008) VALUE 'XXXXXXX'.
00060
00061      05  WS-CURR-DATE-CYMD.
00062          10  WCD-CC              PIC  X(002).
00063          10  WS-CURR-DATE-YMD.
00064              15  WCD-YY          PIC  X(002).
00065              15  WCD-MM          PIC  X(002).
00066              15  WCD-DD          PIC  X(002).
00067
00068  01  WS-SWITCHES-AND-COUNTERS.
00069
00070      05  WS-BOTH-FILES-EOF.
00071          88  BOTH-FILES-EOF                       VALUE 'YY'.
00072          10  FILLER              PIC  X(001) VALUE 'N'.
00073              88  TRANSX-FILE-EOF                  VALUE 'Y'.
00074          10  FILLER              PIC  X(001) VALUE 'N'.
00075              88  MASTERX-FILE-EOF                 VALUE 'Y'.
00076
00077      05  FILLER                  PIC  X(001) VALUE 'A'.
00078          88  NOT-TRANSX-FILE                      VALUE 'N'.
00079
00080      05  WS-TRANSX-REC-CNT       PIC S9(008) VALUE +0 COMP-3.
00081      05  WS-NO-TRANSX-CNT        PIC S9(008) VALUE +0 COMP-3.
00082      05  WS-MASTERX-REC-CNT      PIC S9(008) VALUE +0 COMP-3.
00083      05  WS-NO-MASTERX-CNT       PIC S9(008) VALUE +0 COMP-3.
00084      05  WS-MATCH-CNT            PIC S9(008) VALUE +0 COMP-3.
00085      05  WS-MIS-MATCH-CNT        PIC S9(008) VALUE +0 COMP-3.
00086
00087  01  WS-WORK-FIELDS.
00088
00089      05  WS-BOTH-COMPARE-KEYS.
00090          10  WS-TRANSX-COMPARE-KEY.
00091              15  WTC-USR-CDE     PIC  X(002).
00092              15  WTC-ACCT-NBR    PIC  X(008).
00093              15  WTC-SEC-NBR     PIC  X(005).
00094
00095          10  WS-MASTERX-COMPARE-KEY.
00096              15  WMC-USR-CDE     PIC  X(002).
00097              15  WMC-ACCT-NBR    PIC  X(008).
00098              15  WMC-SEC-NBR     PIC  X(005).
00099
00100      05  WS-PROJ-START-DATE      PIC  X(008) VALUE
00101          '19970126'.
00102
00103
00104  PROCEDURE DIVISION.
00105 ***************
00106  000-MAIN-LINE.
00107 ***************
00108      PERFORM 810-DISP-MSG-AND-OPEN-FILES
00109      PERFORM 820-VERIFY-HEADERS
00110      PERFORM 830-SET-GO-NOGO
00111      PERFORM 840-CHECK-FOR-NEW-YEAR
00112      PERFORM 850-GET-CURR-DATE
00113      WRITE MASTERX-REC-OP        FROM WS-TRANSX-HDR
00114      PERFORM 200-MATCH-TRANSX-MASTERX-RECS
00115        UNTIL BOTH-FILES-EOF
00116      PERFORM 900-END-IT
00117      STOP RUN
00118      .
00119 *******************************
00120  200-MATCH-TRANSX-MASTERX-RECS.
00121 *******************************
00122      EVALUATE TRUE
00123      WHEN WS-TRANSX-COMPARE-KEY = WS-MASTERX-COMPARE-KEY
00124           PERFORM 210-UPDATE-MASTERX-REC
00125           PERFORM 700-GET-BOTH-COMPARE-KEYS THRU 700-EXIT
00126      WHEN WS-TRANSX-COMPARE-KEY > WS-MASTERX-COMPARE-KEY
00127 *===> I.E., NO TRANSX RECORD
00129           PERFORM 220-REWRITE-MASTERX-REC
00130           PERFORM 700-GET-MASTERX-COMPARE-KEY
00131      WHEN OTHER
00132 *===> I.E., NEW TRANSX RECORD, ADD TO MASTERX FILE
00134           WRITE MASTERX-REC-OP              FROM WS-TRANSX-DTL
00135           ADD  +1                             TO WS-NO-MASTERX-CNT
00136           PERFORM 700-GET-TRANSX-COMPARE-KEY
00137      END-EVALUATE
00138      .
00139 ************************
00140  210-UPDATE-MASTERX-REC.
00141 ************************
00142      IF NEW-MONTH  IN WS-TRANSX-HDR
00143         MOVE ZEROS TO PAD-MTD-AMT OF WS-MASTERX-DTL
00144      END-IF
00145      COMPUTE PAD-MTD-AMT          OF WS-TRANSX-DTL
00146              =
00147              PAD-MTD-AMT          OF WS-MASTERX-DTL
00148              +
00149              PAD-DAY-AMT          OF WS-TRANSX-DTL
00150      COMPUTE PAD-YTD-AMT          OF WS-TRANSX-DTL
00151              =
00152              PAD-YTD-AMT          OF WS-MASTERX-DTL
00153              +
00154              PAD-DAY-AMT          OF WS-TRANSX-DTL
00155      WRITE MASTERX-REC-OP FROM WS-TRANSX-DTL
00156      .
00157 *************************
00158  220-REWRITE-MASTERX-REC.
00159 *************************
00160      IF NEW-MONTH                        IN WS-TRANSX-HDR
00161         MOVE ZEROS TO PAD-MTD-AMT OF WS-MASTERX-DTL
00162      END-IF
00163      MOVE ZEROS TO PAD-DAY-AMT           OF WS-MASTERX-DTL
00164      WRITE MASTERX-REC-OP              FROM WS-MASTERX-DTL
00165      ADD  +1                             TO WS-NO-TRANSX-CNT
00166      .
00167 ***************************
00168  700-GET-BOTH-COMPARE-KEYS.
00169 ***************************
00170      .
00171 ***************************
00172  700-GET-TRANSX-COMPARE-KEY.
00173 ***************************
00174      IF NOT TRANSX-FILE-EOF
00175         READ TRANSX-FILE-IP INTO WS-TRANSX-DTL
00176         AT END
00177              SET TRANSX-FILE-EOF TO TRUE
00178              MOVE HIGH-VALUES   TO WS-TRANSX-COMPARE-KEY
00179         NOT AT END
00132 *===>         ***  SET TRANSX KEY  ***
00180              ADD  +1            TO WS-TRANSX-REC-CNT
00181              MOVE PAD-USR-CDE   OF WS-TRANSX-DTL
00182                   TO
00183                   WTC-USR-CDE
00184              MOVE PAD-ACCT-NBR  OF WS-TRANSX-DTL
00185                   TO
00186                   WTC-ACCT-NBR
00187              MOVE PAD-SEC-NBR   OF WS-TRANSX-DTL
00188                   TO
00189                   WTC-SEC-NBR
00190         END-READ
00191      END-IF
00192      .
00193 ****************************
00194  700-GET-MASTERX-COMPARE-KEY.
00195 ****************************
00196      IF NOT MASTERX-FILE-EOF
00197         READ MASTERX-FILE-IP        INTO WS-MASTERX-DTL
00198         AT END
00199              MOVE HIGH-VALUES    TO WS-MASTERX-COMPARE-KEY
00200              SET MASTERX-FILE-EOF TO TRUE
00201         NOT AT END
00132 *===>         ***  SET MASTERX KEY  ***
00202              ADD +1              TO WS-MASTERX-REC-CNT
00203              MOVE PAD-USR-CDE    OF WS-MASTERX-DTL
00204                   TO
00205                   WMC-USR-CDE
00206              MOVE PAD-ACCT-NBR   OF WS-MASTERX-DTL
00207                   TO
00208                   WMC-ACCT-NBR
00209              MOVE PAD-SEC-NBR    OF WS-MASTERX-DTL
00210                   TO
00211                   WMC-SEC-NBR
00212         END-READ
00213      END-IF
00214      .
00215  700-EXIT. EXIT.
00216
00217 *****************************
00218  810-DISP-MSG-AND-OPEN-FILES.
00219 *****************************
00220      DISPLAY '*****************************************'
00221      DISPLAY '            FILEMATCH STARTED            '
00222      DISPLAY '*****************************************'
00223      OPEN  INPUT MASTERX-FILE-IP
00224                   TRANSX-FILE-IP
00225           OUTPUT MASTERX-FILE-OP
00226      .
00227 ********************
00228  820-VERIFY-HEADERS.
00229 ********************
00230 *===>    VERIFY TRANSX HEADER
00231 *
00232      READ TRANSX-FILE-IP          INTO WS-TRANSX-HDR
00233      AT END
00234          SET NOT-TRANSX-FILE        TO TRUE
00235      NOT AT END
00236          IF PAH-HDR-ID OF WS-TRANSX-HDR NOT = 'HDR'
00237             SET NOT-TRANSX-FILE     TO TRUE
00238          END-IF
00239      END-READ
00240      IF NOT-TRANSX-FILE
00241         DISPLAY 'ERROR!!!! '
00242                 'INPUT FILE NOT A TRANSX FILE'
00243         MOVE +2  TO RETURN-CODE
00244         STOP RUN
00245      END-IF
00246
00247 *===>    VERIFY MASTERX HEADER
00248 *
00249      READ MASTERX-FILE-IP          INTO WS-MASTERX-HDR
00250      AT END
00251          SET MASTERX-FILE-EOF        TO TRUE
00252          MOVE HIGH-VALUES            TO WS-MASTERX-COMPARE-KEY
00253      NOT AT END
00254          IF PAH-HDR-ID OF WS-MASTERX-HDR NOT = 'HDR'
00255             DISPLAY 'ERROR!!!! '
00256                     'INPUT FILE NOT A MASTERX FILE'
00257             MOVE +2  TO RETURN-CODE
00258             STOP RUN
00259          END-IF
00260      END-READ
00261      .
00262 *****************
00263  830-SET-GO-NOGO.
00264 *****************
00265 *===>  IF THE TRANSX FILE CONTAINS NO DATA AND
00266 *===>     THE MASTERX FILE IS A NULL FILE THE PROJECT HAS
00267 *===>     HAS NOT PRODUCED DATA YET. SET RC=2 TO NOT EXECUTE
00268 *===>     REPORT PROGRAM.
00269 *
00270      PERFORM 700-GET-TRANSX-COMPARE-KEY
00271      IF TRANSX-FILE-EOF
00272         AND
00273         MASTERX-FILE-EOF
00274         DISPLAY 'NOTE!!!! '
00275                 'NO INPUT FOR ????? YET'
00276         MOVE +2  TO RETURN-CODE
00277         STOP RUN
00278      END-IF
00279      PERFORM 700-GET-MASTERX-COMPARE-KEY
00280      .
00281 ************************
00282  840-CHECK-FOR-NEW-YEAR.
00283 ************************
00284 *===>     AT NEW YEAR FORCE NEW MASTERX TO BE CREATED
00285 *
00286      IF NEW-YEAR            IN WS-TRANSX-HDR
00287         MOVE HIGH-VALUES    TO WS-MASTERX-COMPARE-KEY
00288         SET MASTERX-FILE-EOF TO TRUE
00289      END-IF
00290      .
00291 *******************
00292  850-GET-CURR-DATE.
00293 *******************
00294      ACCEPT WS-CURR-DATE-YMD       FROM DATE
00295      IF WCD-YY                        < '96'
00296         MOVE '20'                    TO WCD-CC
00297      ELSE
00298         MOVE '19'                    TO WCD-CC
00299      END-IF
00300      .
00301 ************
00302  900-END-IT.
00303 ************
00304      CLOSE        TRANSX-FILE-IP
00305                  MASTERX-FILE-IP
00306                  MASTERX-FILE-OP
00307      DISPLAY ' '
00308      EVALUATE TRUE
00309      WHEN NEW-YEAR IN WS-TRANSX-HDR
00310           DISPLAY 'NOTE!!!! MTD AND YTD $ TOTALS '
00311                   'RESET FOR NEW YEAR'
00312           DISPLAY ' '
00313      WHEN NEW-MONTH IN WS-TRANSX-HDR
00314           DISPLAY 'NOTE!!!! MTD $ TOTALS '
00315                   'RESET FOR NEW MONTH'
00316           DISPLAY ' '
00317      END-EVALUATE
00318      DISPLAY WS-TRANSX-REC-CNT '  TRANSX RECORDS READ'
00319      DISPLAY WS-MASTERX-REC-CNT ' MASTERX RECORDS READ'
00320      DISPLAY ' '
00321      DISPLAY WS-MATCH-CNT      ' MASTERX RECORDS UPDATED'
00322      DISPLAY WS-NO-TRANSX-CNT  ' MASTERX RECORDS UNCHANGED'
00323      DISPLAY WS-NO-MASTERX-CNT ' MASTERX RECORDS ADDED'
00324      DISPLAY ' '
00325      DISPLAY '*****************************************'
00326      DISPLAY '      FILEMATCH ENDED RETURN CODE = ' RETURN-CODE
00327      DISPLAY '*****************************************'
00328      .
 
 

Back to COBOL General discussion FAQ Index
Back to COBOL General discussion Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close