Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

Emulate the Easytrive IF matched logic in Cobol program

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming
View previous topic :: :: View next topic  
Author Message
VIGNRSH
Warnings : 1

New User


Joined: 18 Mar 2007
Posts: 44
Location: New Jersey,USA

PostPosted: Sat Aug 08, 2009 5:40 am    Post subject: Emulate the Easytrive IF matched logic in Cobol program
Reply with quote

HI ,
I want to do an exact emulation of an Easytrieve program IN COBOL , which is doing SYNCHRONIZED file processing .

Code:

JOB INPUT (FILEA KEY FILEA-KEY, FILEB KEY FILEB-KEY)                       
    IF EOF FILEA
       DISPLAY 'EOF FILEA'                                                   
       STOP                                                                     
    END-IF                                                                     
IF FILEA
IF NOT FILEB
   DISPLAY 'FILEA ' FILEA-KEY.
...
.....
........
   GO TO JOB                                                                   
ELSE                                                                           
   GO TO JOB                                                                   
END-IF                                                                         
END-IF                                                                         


I have done the coding cobol , for the above code, except for one situation.
If Files ( FILEA, FILEB) are having duplicate records !

My Cobol code:
Code:

IF FILEA-KEY = FILEB-KEY                           
   PERFORM 0400-READ-FILEA THRU 0400-EXIT     
   PERFORM 0300-READ-FILEB THRU 0300-EXIT     
...
....
....
ELSE                                             
   IF FILEA-KEY > FILEB-KEY                           
         PERFORM 0300-READ-FILEB THRU 0300-EXIT     
   ELSE                                         
         PERFORM 0400-READ-FILEA THRU 0400-EXIT     
wITH THIS PARAGRAGH BEING PERFORMED UNTIL END OF THE FILEA OR FILEB .....

The way easytrieve produces the output for matching records , when containing dups are different from the one, i have written above.

I want to replicate the exact easytrive logic in COBOL.


Thanks for all your help!!
Back to top
View user's profile Send private message

dick scherrer

Site Director


Joined: 23 Nov 2006
Posts: 19270
Location: Inside the Matrix

PostPosted: Sat Aug 08, 2009 7:24 am    Post subject:
Reply with quote

Hello,

At the top of the cobol part of the forum is a "Sticky" that contains working code that does a 2-file match/merge.

You may need to modify that code to do exactly what you want.

You will need to create reasonably extensive test data to be sure that every sort of multi-duplicate situation is handled the way you want.
Back to top
View user's profile Send private message
mmwife

Super Moderator


Joined: 30 May 2003
Posts: 1592

PostPosted: Sat Aug 08, 2009 9:54 pm    Post subject:
Reply with quote

Hi VIGNRSH,

I usually do something like this; just change it to fit your circumstances:

Do init, opens, etc.
perform 700-GET-BOTH-COMPARE-KEYS, if either EOF, exit.
perform 200-MATCH-TRANSX-MASTERX-RECS
UNTIL BOTH-FILES-EOF
.
.
.
.
STOP RUN
.
Code:

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      .
.
.
.
.
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.
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
This topic is locked: you cannot edit posts or make replies. Cobol GUI (like Editor) Kala Mainframe COBOL Programming 14 Wed May 10, 2017 12:30 pm
No new posts IMS T-Pipe queue counts in a COBOL Pr... Siva NKK Kothamasu IMS DB/DC 0 Tue May 09, 2017 6:31 pm
No new posts COBOL Code Parsers and Lineage Establ... balimanja COBOL Programming 2 Tue May 02, 2017 3:30 am
No new posts Cobol upgrade - source code missing f... gthmrj IBM Tools 1 Wed Apr 26, 2017 6:04 pm
No new posts Need help in REXX CALL program Raje1002 CLIST & REXX 5 Wed Apr 19, 2017 11:18 pm


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us