×
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 SEQQUENTIAL FILE TO CSV

COBOL SEQQUENTIAL FILE TO CSV

COBOL SEQQUENTIAL FILE TO CSV

(OP)
Hello ,
im trying to convert sequential cobol file to csv using data i found online.

CODE

IDENTIFICATION DIVISION.
       PROGRAM-ID.  CPYFILES.
         AUTHOR.  M.

       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       SELECT MY-INPUT-FILE ASSIGN TO
       "C:\Users\Hp\Documents\my_input.txt"
               ORGANIZATION IS LINE SEQUENTIAL.
       SELECT MY-OUTPUT-FILE ASSIGN TO
       "C:\Users\Hp\Documents\my_output.txt"
               ORGANIZATION IS LINE SEQUENTIAL.
       DATA DIVISION.
        FILE SECTION.
       FD MY-INPUT-FILE.
       01 MY-INPUT-LINE    PIC X(180).
       FD MY-OUTPUT-FILE.
       01 MY-OUTPUT-LINE   PIC X(181).
       WORKING-STORAGE SECTION.
       01 END-OF-FILE PIC X VALUE SPACE.
          88 END-OF-INPUT-FILE VALUE 'T'.
          88 NOT-END-OF-INPUT-FILE VALUE 'F'.
       
       01 i  pic 9(3) value zero .
       01 j pic 9(3) value 1 .
       01 k pic 9(3) value 1 .
       PROCEDURE DIVISION.
      
         OPEN INPUT MY-INPUT-FILE
         OPEN EXTEND MY-OUTPUT-FILE

         SET NOT-END-OF-INPUT-FILE TO TRUE

         PERFORM UNTIL END-OF-INPUT-FILE
           READ MY-INPUT-FILE
             NOT AT END
             
               PERFORM VARYING i from 1 by 1 until i>180
               If MY-INPUT-LINE(i:1)= SPACE
                 continue
                ELSE
                    MOVE MY-INPUT-LINE(i:1) to MY-OUTPUT-LINE (j:1)
                
               
               END-IF
               END-PERFORM
               WRITE MY-OUTPUT-LINE
             AT END
                SET END-OF-INPUT-FILE TO TRUE
           END-READ
         END-PERFORM
         CLOSE MY-INPUT-FILE
         CLOSE MY-OUTPUT-FILE
         STOP RUN. 

I looking for a way to replace the first space with a coma and delete the others , is it possible ?

RE: COBOL SEQQUENTIAL FILE TO CSV

Quote (MCM)


I looking for a way to replace the first space with a coma and delete the others , is it possible ?
Are you meaning somethng like this?

Input:

CODE -->

foo bar baz spam eggs 

Output:

CODE -->

foo,barbazspameggs 

RE: COBOL SEQQUENTIAL FILE TO CSV

(OP)
yes but with all of them foo bar,baz,spam,eggs ; specially when there are many spaces

RE: COBOL SEQQUENTIAL FILE TO CSV

I don't understand, first you wrote, that you want "to replace the first space with a coma and delete the others" and then, that from "foo bar baz spam eggs" the result should be "foo bar,baz,spam,eggs", where you just leave the first space and replace the others. They seem to be two contradictory things. Please specify the task with some data examples.

RE: COBOL SEQQUENTIAL FILE TO CSV

(OP)
It was just a typing error , what i want is to replace the first space or the last with a coma :

CODE

exp input : 2400    Xrayonten    Xaviere 2424224THVStreet,e#
            2500 Youngnten    Yannire        25252YongeSStreete#

exp output: 2400,Xrayonten,Xaviere,2424224THVStreet,e#
            2500,Youngnten,Yannire,25252YongeSStreete# 

RE: COBOL SEQQUENTIAL FILE TO CSV

The simplest seems to be counting spaces and to set the comma instead of the first space.

RE: COBOL SEQQUENTIAL FILE TO CSV

I used the examples posted in thread: https://www.tek-tips.com/viewthread.cfm?qid=182054...
I've extended the basic read/write file example by enhancing the logic similar to that used for skipping spaces with counting spaces.

txt2csv.cbl

CODE

IDENTIFICATION DIVISION.
       PROGRAM-ID.  TXT2CSV.
         AUTHOR.  MIKROM.

       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       SELECT MY-INPUT-FILE ASSIGN TO "c:\tmp\cobol\my_input.txt"
               ORGANIZATION IS LINE SEQUENTIAL.
       SELECT MY-OUTPUT-FILE ASSIGN TO "c:\tmp\cobol\my_output.csv"
               ORGANIZATION IS LINE SEQUENTIAL.

       DATA DIVISION.
       FILE SECTION.
       FD MY-INPUT-FILE.
       01 MY-INPUT-LINE    PIC X(256).
       FD MY-OUTPUT-FILE.
       01 MY-OUTPUT-LINE   PIC X(256).
       WORKING-STORAGE SECTION.
       01 END-OF-FILE-FLAG PIC X VALUE SPACE.
          88 END-OF-INPUT-FILE VALUE 'T'.
          88 NOT-END-OF-INPUT-FILE VALUE 'F'.
       01 WS-FIELDS.
          05 WS-LINE     PIC X(256).
          05 LINE-LENGTH PIC 9(3).
          05 NR-SPACES   PIC 9(3).
          05 I           PIC 9(3).
          05 J           PIC 9(3).

       PROCEDURE DIVISION.
       MAIN-PARA.
         OPEN INPUT MY-INPUT-FILE
         OPEN OUTPUT MY-OUTPUT-FILE

         SET NOT-END-OF-INPUT-FILE TO TRUE

         PERFORM UNTIL END-OF-INPUT-FILE
           READ MY-INPUT-FILE
             NOT AT END
               PERFORM PROCESS-LINE
               WRITE MY-OUTPUT-LINE
             AT END
                SET END-OF-INPUT-FILE TO TRUE
           END-READ
         END-PERFORM
         CLOSE MY-INPUT-FILE
         CLOSE MY-OUTPUT-FILE
         STOP RUN.

       PROCESS-LINE.
         INITIALIZE MY-OUTPUT-LINE
      *  remove leading spaces from INPUT-LINE
         MOVE FUNCTION TRIM(MY-INPUT-LINE) TO WS-LINE
      *  compute length of trimmed line (without trailing spaces)
         COMPUTE LINE-LENGTH = FUNCTION LENGTH(FUNCTION TRIM(WS-LINE))
         MOVE 1 TO J
         MOVE 0 TO NR-SPACES
         PERFORM VARYING I FROM 1 BY 1 UNTIL I > LINE-LENGTH
           IF WS-LINE(I:1) = ' '
             ADD 1 TO NR-SPACES
             IF NR-SPACES = 1
               MOVE ',' TO MY-OUTPUT-LINE(J:1)
               ADD 1 TO J
             ELSE
               CONTINUE
             END-IF
           ELSE
             MOVE WS-LINE(I:1) TO MY-OUTPUT-LINE(J:1)
             ADD 1 TO J
      *      reset spaces counter
             MOVE 0 TO NR-SPACES
           END-IF
         END-PERFORM. 

From the input file:
my_input.txt

CODE

2400    Xrayonten    Xaviere 2424224THVStreet,e#
            2500 Youngnten    Yannire        25252YongeSStreete# 

the program creates this output file:
my_output.csv

CODE

2400,Xrayonten,Xaviere,2424224THVStreet,e#
2500,Youngnten,Yannire,25252YongeSStreete# 

RE: COBOL SEQQUENTIAL FILE TO CSV

Too bad he wants to do it in COBOL and not in REXX. It's about 8 lines in REXX.

Frank Clarke
--America's source for adverse opinions since 1943.

RE: COBOL SEQQUENTIAL FILE TO CSV

(OP)
@MIKROM , thank you very much , if you could clarify something for me :

CODE

*  remove leading spaces from INPUT-LINE
         MOVE FUNCTION TRIM(MY-INPUT-LINE) TO WS-LINE
      *  compute length of trimmed line (without trailing spaces)
         COMPUTE LINE-LENGTH = FUNCTION LENGTH(FUNCTION TRIM(WS-LINE)) 


When using the function length was it necessary to put FUNCTION TRIM(WS-LINE instead of just WS-LINE , because it has already the trim data of the input ?
And I also don't understand the need to initialize MY-INPUT-LINE , i thought INITIALIZE was only used to replace characters in a variable .

RE: COBOL SEQQUENTIAL FILE TO CSV

On the data i tested, it was necessary.
For example, this satetment

CODE

MOVE FUNCTION TRIM(MY-INPUT-LINE) TO WS-LINE 
makes from the second input line from the file

CODE

2400    Xrayonten    Xaviere 2424224THVStreet,e#
            2500 Youngnten    Yannire        25252YongeSStreete# 
this working storage field

CODE

2500 Youngnten    Yannire        25252YongeSStreete# 
If your input data comes without leading spaces you don't need it.

The LENGTH without TRIM, i.e.:

CODE

COMPUTE LINE-LENGTH = FUNCTION LENGTH(WS-LINE) 
computes the length of the line as defined in working storage, i.e. 256 when defined as

CODE

05 WS-LINE     PIC X(256). 
The LENGTH with TRIM, i.e:

CODE

COMPUTE LINE-LENGTH = FUNCTION LENGTH(FUNCTION TRIM(WS-LINE)) 
computes the length of data contained in the field without leading and trailing spaces, for example for

CODE

2500 Youngnten    Yannire        25252YongeSStreete# 
it computes 52

The best way to see what the specific statement causes is to comment it out or modify it and try to run the program to see what happens.

RE: COBOL SEQQUENTIAL FILE TO CSV

(OP)
OK , thank you for your help.

RE: COBOL SEQQUENTIAL FILE TO CSV

You are welcome.

RE: COBOL SEQQUENTIAL FILE TO CSV

(OP)
HELLO ,

CODE

INITIALIZE MY-OUTPUT-LINE
      *  remove leading spaces from INPUT-LINE
         MOVE FUNCTION TRIM(MY-INPUT-LINE) TO WS-LINE
         MOVE FUNCTION TRIM(LEADING zeros FROM MY-INPUT-LINE) to WS-LINE 

I tried adding the third line to remove leading zeros from another file i have but it gives an error with "LEADING" , I researched the syntax for Trim function and it seems to be wright .

CODE

000000000100 Anderson                    Adrian              1113 Peachtree Plaza, Suite 111 


I tried using the unstring function but it also doesnt work .

RE: COBOL SEQQUENTIAL FILE TO CSV

(OP)
https://www.ibm.com/docs/en/app-connect/11.0.0?top...

This is the web site i went to ., after that i found that excel does it automatically for csv data , sorry to have wasted your time .
But the problem i found is that i want comas between more than 2 space i.e the columns of my txt file . I tried to do it with a 3rd index but i havnt found the solution yet .

RE: COBOL SEQQUENTIAL FILE TO CSV

The link you provided is not for COBOL but for an IBM product IBM App Connect.

You can remove the 8 leading zeros as follows:

CODE

MOVE '000000000100' TO WS-CHAR-12
DISPLAY 'With Leading Zeros:'
DISPLAY WS-CHAR-12

MOVE FUNCTION SUBSTITUTE(WS-CHAR-12,'00000000', SPACE) 
     TO WS-CHAR-12
DISPLAY 'With 8 Leading Zeros substituted with space:'
DISPLAY WS-CHAR-12

MOVE FUNCTION TRIM(WS-CHAR-12 LEADING) 
     TO WS-CHAR-12
DISPLAY 'With leading space trimmed:'                 
DISPLAY WS-CHAR-12 

Output:

CODE

With Leading Zeros:
000000000100
With 8 Leading Zeros substituted with space:
 0100       
With leading space trimmed:
0100 

RE: COBOL SEQQUENTIAL FILE TO CSV

(OP)
OK , Thank you for your help , sorry for the delay of the answer

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

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