IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

Need information on COBOL MOVE CORRESPONDING


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
subratarec

Active User


Joined: 22 Dec 2007
Posts: 126
Location: Bangalore

PostPosted: Tue Jun 28, 2016 10:38 pm
Reply with quote

Hi,

I have one query related COBOL MOVE CORRESPONDING stmt. I mostly work with PL1 language. But I know COBOL also and in my current project I have started working on COBOL again after couple of years.

Query:
--------------------------------------------------------------------------------------
One small COBOL program to create CSV output. COBOL program will read one PS dataset and for each respective read it will create CSV ourput.

Example:
INPUT -
Code:
AAAAABBBBBBCCCCCDDDDDEEE
FFFFFFGGGGGGHHHHHIIIIIIIJJJJJJJJJ
;
;
KKKKKLLLLLLLLMMMMMNNNNNOOOO


OUTPUT -
Code:
AAAAA,BBBBBB,CCCCC,DDDDD,EEE
FFFFFF,GGGGGG,HHHHH,IIIIIII,JJJJJJJJJ
;
;
KKKKK,LLLLLLLL,MMMMM,NNNNN,OOOO


To Achieve this I created 2 COBOL Structures one for INPUT and another for OUTPUT. Both the structures are having same elements (names are same) under different Group 01 level. Only difference is in OUTPUT structure I have kept FILLER after each 05 element and have used VALUE clause to get it initialized with ','.

Example:
-----------------
INPUT:
---------------------
Code:
01 INPUT-FILE-READ.
     05 A-VALUE  PIC X(5).
     05 B-VALUE  PIC X(5).
     ;
     ;
     05 Z-VALUE  PIC X(5).


OUTPUT:
------------------------------
Code:
01 OUTPUT-FILE-READ.
     05 A-VALUE  PIC X(5).
     05 FILLER     PIC X(1) VALUE ','.
     05 B-VALUE  PIC X(5).
     ;
     ;
     05 FILLER    PIC  X(1) VALUE ','.
     05 Z-VALUE  PIC X(5).


Then I have used MOVE CORRESPONDING to move all the values from INPUT to OUTPUT. There is no issue and values are moving correctly but I expected that when I will code "WRITE OUTPUT-FILE-READ the comma will also come. But instead of that LOW_VALUES are coming.

If I do separate move (moving each and every elements) and then write then comma is coming correctly. But if the structure is very big then it is not good (I think) to go for separate MOVE (cause when we already hve same elements name and MOVE CORRESPONDING is there)

Could someone please let me know wht is this happening and how to resolve the same?

Thanks
Back to top
View user's profile Send private message
Terry Heinze

JCL Moderator


Joined: 14 Jul 2008
Posts: 1249
Location: Richfield, MN, USA

PostPosted: Tue Jun 28, 2016 11:35 pm
Reply with quote

Are your 01 levels defined in the FILE SECTION or WORKING STORAGE SECTION? If the former, any FILLER areas are probably being replaced by LOW-VALUE after each WRITE statement. Try defining your 01 levels in WS then writing your output record FROM the WS group names. Either that, or you'll need to "re-move" your delimiter before every WRITE.
Back to top
View user's profile Send private message
subratarec

Active User


Joined: 22 Dec 2007
Posts: 126
Location: Bangalore

PostPosted: Wed Jun 29, 2016 12:00 am
Reply with quote

Hi Terry,

Thanks for your reply. Yes both (for INPUT and OUTPUT) are defined under File Section. Ok let me check and try.

Actually before writing I was displaying the contents of the OUTPUT structure just to check whether CSV is correctly coming in output or not. But I was getting LOW-VALUES there. I thought MOVE CORRESPONDING is just like separate MOVE but here all identical elements from one structure will move to another structure.
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8696
Location: Dubuque, Iowa, USA

PostPosted: Wed Jun 29, 2016 12:09 am
Reply with quote

Something doesn't make sense here. From the Enterprise COBOL V6.1 Programming Guide manual on page 33:
Quote:
(Filler items in a receiving group item are unchanged by a MOVE CORRESPONDING statement.)
However, if your OUTPUT-FILE-READ (which, by the way, is a really lousy name for an 01 level) is an 01 under the FD of a FILE SECTION entry, then you should be getting a compiler warning message because VALUE clauses in the FD variables are tolerated by Enterprise COBOL (that is, they are recognized syntactically), but they are ignored and hence LOW-VALUES in the FILLER variables would be expected. If either or both 01 are FD variables, you should have noted this in your post.

In fact, if you read the Enterprise COBOL Language Reference manual on the VALUE clause, you will note that reference is made to WORKING-STORAGE and LOCAL SECTION variables but NO mention is made of FILE SECTION variables.
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8696
Location: Dubuque, Iowa, USA

PostPosted: Wed Jun 29, 2016 12:11 am
Reply with quote

Just to make sure you understand, the FD 01 is a BUFFER and as such, it will be cleared each time a record is written. So if you do your WRITE and then attempt to DISPLAY the 01 level, you will see LOW-VALUES since the buffer now points to the next record.

Quote:
I thought MOVE CORRESPONDING is just like separate MOVE but here all identical elements from one structure will move to another structure.
Variables, yes. FILLER, no.
Back to top
View user's profile Send private message
Terry Heinze

JCL Moderator


Joined: 14 Jul 2008
Posts: 1249
Location: Richfield, MN, USA

PostPosted: Wed Jun 29, 2016 12:34 am
Reply with quote

My test:
Code:
000023         FD  OUTPUT-FILE
000024             BLOCK  CONTAINS   0 RECORDS
000025             RECORD CONTAINS  80 CHARACTERS
000026             RECORDING MODE   IS F.
000027         01  OUTPUT-FILE-REC.
000028             05  A-VALUE                 PIC  X(5).
000029             05                          PIC  X     VALUE ','.

S1158-I   A non-level-88 "VALUE" clause was found in the "FILE SECTION" or "LINK
          treated as comments.

000030             05  B-VALUE                 PIC  X(5).
000031             05                          PIC  X     VALUE ','.

S1158-I   A non-level-88 "VALUE" clause was found in the "FILE SECTION" or "LINK
          treated as comments.

000032             05  Z-VALUE                 PIC  X(5).

Code:
 COMMAND INPUT ===>
---+----1----+----2----+----3----+-
OUTPUT-FILE-REC >r1f01 r1f02 r1f03<
DEEDEE6CCDC6DCC469F8FF09F8FF09F8FF4
6437430693509530E91601091602091603C
 ----------------------------------
OUTPUT-FILE-REC >r2f01 r2f02 r2f03<
DEEDEE6CCDC6DCC469F8FF09F8FF09F8FF4
6437430693509530E92601092602092603C
 ----------------------------------

Both displays are after the move corr and before the write.
Back to top
View user's profile Send private message
Rohit Umarjikar

Global Moderator


Joined: 21 Sep 2010
Posts: 3049
Location: NYC,USA

PostPosted: Wed Jun 29, 2016 2:24 am
Reply with quote

You can try with reference modification and append ',' after each 5 byte item till end of input field. If you don't get this worked then you may talk to IBM and get the support Or may be change fillers to some variable names like A1,B1....and move ',' one shot for all after MOVE CORR and then write.
Back to top
View user's profile Send private message
Bill Woodger

Moderator Emeritus


Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix

PostPosted: Thu Jun 30, 2016 10:18 am
Reply with quote

Simplest is to have the record-structure in WORKING-STORAGE.

Next is to have Enterprise COBOL 6.1 (INITIALIZE is extended and you should be able to change the VALUEs of the FILLERs, but why do it every time if the values don't get lost (WORKING-STORAGE))?

Name the comma fields.

You could use reference-modification, but it's a bit of a nightmare iif anything changes (and in understanding why it is ther ein the first place).
Back to top
View user's profile Send private message
Terry Heinze

JCL Moderator


Joined: 14 Jul 2008
Posts: 1249
Location: Richfield, MN, USA

PostPosted: Thu Jun 30, 2016 7:52 pm
Reply with quote

I prefer assigning the delimiter at run time as follows:
Code:
=COLS> ----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
****** ***************************** Top of Data ******************************
000001            SELECT FILE0001-FILE
000002                ASSIGN      TO FILE001I
000003                FILE STATUS IS WS-FILE001I-STATUS.
000004
000005            SELECT FILE0002-FILE
000006                ASSIGN      TO FILE002O
000007                FILE STATUS IS WS-FILE002O-STATUS.
000008        DATA           DIVISION.
000009        FILE           SECTION.
000010        FD  FILE0001-FILE
000011            BLOCK  CONTAINS   0 RECORDS
000012            RECORD CONTAINS  23 CHARACTERS
000013            RECORDING MODE   IS F.
000014        01  FILE0001-RCD                PIC  X(23).
000015        FD  FILE0002-FILE
000016            BLOCK  CONTAINS   0 RECORDS
000017            RECORD CONTAINS  28 CHARACTERS
000018            RECORDING MODE   IS F.
000019        01  FILE0002-RCD                PIC  X(28).
000020        WORKING-STORAGE SECTION.
000021        01  WS-FILE001I-RCD.
000022       *    REPLACE THE FOLLOWING WITH YOUR  INPUT RECORD LAYOUT
000023            05 WS-PAYMENT-RECORD.
000024                10 WS-FIELD-1           PIC X(09).
000025                10 WS-FIELD-2           PIC S9(7)V99.
000026                10 WS-FIELD-3           PIC X(05).
000027        01  WS-FILE002O-RCD.
000028       *    REPLACE THE FOLLOWING WITH YOUR OUTPUT RECORD LAYOUT
000029            05 WS-PAYMENT-RECORD.
000030                10 WS-FIELD-1           PIC X(09).
000031                10                      PIC X.
000032                10 WS-FIELD-2           PIC Z(6)9.99-.
000033                10                      PIC X.
000034                10 WS-FIELD-3           PIC X(5).
000035                10                      PIC X.
000036        LINKAGE        SECTION.
000037        01  LS-PARM-AREA.
000038            05  LS-PARM-LENGTH          PIC S9(4)   COMP-5.
000039            05  LS-PARM-DATA.
000040                10  LS-DELIMITER        PIC  X.
000041        PROCEDURE DIVISION              USING LS-PARM-AREA.
000042            PERFORM A10-INITIATE        THRU A10-X
000043            PERFORM B10-PROCESS         THRU B10-X
000044              UNTIL WS-END-OF-FILE001I
000045            MOVE ZERO                   TO RETURN-CODE
000046            GOBACK
000047            .
000048        A10-INITIATE.
000049       *  THE FOLLOWING STATEMENTS POPULATE THE OUTPUT RECORD AREA WITH
000050       *  THE DELIMITER
000051            MOVE SPACE                  TO WS-FILE002O-RCD
000052            INSPECT WS-FILE002O-RCD
000053                REPLACING ALL SPACE     BY LS-DELIMITER
000054            PERFORM O10-OPEN-FILES      THRU O10-X
000055            PERFORM R10-READ-FILE001I   THRU R10-X
000056            .
000057        A10-X.
000058            EXIT
000059            .
000060        B10-PROCESS.
000061            MOVE CORRESPONDING WS-FILE001I-RCD  TO WS-FILE002O-RCD
000062            PERFORM W10-WRITE-FILE002O          THRU W10-X
000063            PERFORM R10-READ-FILE001I           THRU R10-X
000064            .
000065        B10-X.
000066            EXIT
000067            .
Back to top
View user's profile Send private message
subratarec

Active User


Joined: 22 Dec 2007
Posts: 126
Location: Bangalore

PostPosted: Thu Jun 30, 2016 11:35 pm
Reply with quote

Hi All,

I do appreciate for all your help and suggestion. Actually yesterday itself I had to show some sample output. For time being I have used INSPECT with REPLACE option (Replacing LOW-VALUES to Comma)

I know this is not a good solution. But It gave me the sample result for now. But I am going to change the program again. What I had thought to do individual move but Many suggestions I got here and I am going to try them.

I will come back after changing my program.

Thanks a Lot!
Back to top
View user's profile Send private message
seagull

New User


Joined: 28 May 2007
Posts: 24
Location: Dublin

PostPosted: Thu Jul 14, 2016 9:32 pm
Reply with quote

I trust you don't have any packed fields with that INSPECT REPLACING.
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Similar Topics
Topic Forum Replies
No new posts Replace each space in cobol string wi... COBOL Programming 3
No new posts COBOL -Linkage Section-Case Sensitive COBOL Programming 1
No new posts COBOL ZOS Web Enablement Toolkit HTTP... COBOL Programming 0
No new posts Calling DFSORT from Cobol, using OUTF... DFSORT/ICETOOL 5
No new posts Generate random number from range of ... COBOL Programming 3
Search our Forums:

Back to Top