Is there a way to parameterize functions in COBOL? - cobol

I'm coding routines like:
READ-A.
READ FILE-A
AT END
MOVE 1 TO EOF-A
NOT AT END
ADD 1 TO CN-READ-A
END-READ.
F-READ-A. EXIT.
to read several files and I was wondering if there's a way to code a routine that is able to read the filename from a variable so I don't have to code the same thing for each file. Thanks!

One solution as said above is to use multiple programs or nested program, for which
I have included an example below, which is solution 1.
Another solution is to COBOL classes, which might not be to your liking but I like them, so I've included an example, which is solution 2.
Solution 1:
program-id. TestProgram.
working-storage section.
01 file-name pic x(128).
01 file-lines pic 9(9).
procedure division.
move 0 to file-lines
move "d:\rts_win32.txt" to file-name
call "program1" using file-name file-lines
display file-lines
stop run
end program TestProgram.
program-id. Program1.
file-control.
select file-a assign to myfile
organization is line sequential.
data division.
fd file-a.
01 file-a-line pic x(80).
working-storage section.
01 EOF-A pic 9 value 0.
linkage section.
01 lk-filename pic x(128).
01 CN-READ-A pic 9(9).
procedure division using lk-filename
CN-READ-A.
move lk-filename to myfile
open input file-a
perform READ-A until EOF-A equals 1
close file-a
goback.
READ-A.
READ FILE-A
AT END
MOVE 1 TO EOF-A
NOT AT END
ADD 1 TO CN-READ-A
END-READ.
F-READ-A.
EXIT.
end program Program1.
Solution 2
program-id. TestProgram.:
working-storage section.
01 file-counter type FileLineCounter.
procedure division.
set file-counter to new type FileLineCounter("d:\rts_win32.txt")
display file-counter::LineCount
stop run
end program TestProgram.
class-id FileLineCounter.
file-control.
select file-a assign to myfile
organization is line sequential.
data division.
fd file-a.
01 file-a-line pic x(80).
working-storage section.
01 cn-read-a binary-long property as "LineCount".
method-id New.
01 EOF-A pic 9 value 0.
procedure division using by value filename as string.
set myfile to filename
open input file-a
perform READ-A until EOF-A equals 1
close file-a
goback.
READ-A.
READ FILE-A
AT END
MOVE 1 TO EOF-A
NOT AT END
ADD 1 TO CN-READ-A
END-READ.
F-READ-A.
EXIT.
end method.
end class.

May not be "in the wild" yet with compiler support, but the current ISO Draft 20xx standard includes FUNCTION-ID in place of PROGRAM-ID. It adds a parameter friendly function call computing paradigm to COBOL.
Might not help today, but maybe in the near future. If I'm not mistaken, User Defined Functions are actually from the COBOL 2002 spec, but it seems compiler vendors are hit or miss on support for the feature.
FUNCTION-ID support is in closed trials for OpenCOBOL 2.0, but the timeline for the 2.0 release is undetermined and could be another year or more before it's made public.

The proper Cobol way to parameterize routines is via the nested subprogram.
You can do what you want, but it is dependant upon your compiler and environment, you can pass a file, or a file name, or a DDname.
What platform are you on?
Edit: On z/OS, you can change what FILE-A points to at runtime using putenv() to adjust the dataset name associated with the DDNAME that FILE-A uses.
See:
http://ibmmainframes.com/post-57281.html
http://cicswiki.org/cicswiki1/index.php?title=How_do_I_allocate_a_file_dynamically_using_COBOL%3F
You will need a OPEN-A and CLOSE-A paragraph as well between switching files.
It isn't exactly passing parameters to your read statement, but it lets you reuse your OPEN/READ/WRITE/CLOSE statements for different files. But only serially.
There was a way, under VS COBOL II, where you could pass an FD to a subprogram, that would look something like:
CALL MYREADPGM USING FILE-A
CALL MYREADPGM USING FILE-B
This possible with Enterprise Cobol but IIRC VisualAge does not support that.

I realize this is an old thread, but hopefully someone might find this useful in the future: IBM's Enterprise COBOL on z/OS 6.4 compiler supports user-defined functions (released May 2022). User-defined functions could be a useful alternative to the other suggestion for internal programs. In contrast to program calls, there are compile time checks for parameters to user-defined function invocations. Also, you can invoke the function in a lot of places where you couldn't call a program, like within a
n expression.
Here's an example based on passing a file name to a function. It might be possible to combine this with the PUTENV() suggestion above.
IDENTIFICATION DIVISION.
FUNCTION-ID. READ-FILE.
DATA DIVISION.
LINKAGE SECTION.
1 FILE-NAME PIC X(50).
1 RET PIC 9(9).
PROCEDURE DIVISION USING FILE-NAME RETURNING RET.
* DO STUFF WITH FILE-NAME
* ...
GOBACK
.
END FUNCTION READ-FILE.
IDENTIFICATION DIVISION.
PROGRAM-ID. MAINPROG.
DATA DIVISION.
WORKING-STORAGE SECTION.
1 READ-RESULT PIC 9(9).
PROCEDURE DIVISION.
COMPUTE READ-RESULT = FUNCTION READ-FILE('MYINPUTFILE')
GOBACK
.
END PROGRAM MAINPROG.
More examples can be found in the Programming Guide Chapter 32 Using user-defined functions.
https://www.ibm.com/support/pages/enterprise-cobol-zos-documentation-library#Table642

You could create a data file of filenames, treat each one as an individual record, and then read each file. In the "SELECT ...ASSIGN" you would need to use a working-storage variable for the filename and move the value from the 'file of filenames' into it.
As you are using VisualAge, I assume in UNIX, you might also be able to run the program from the shell (sh,ksh), with the filename as a parameter, and repeatedly run the program from the shell for each file name.

Related

Getting Overlapping error in COBOL program

Cobol program :
PROGRAM-ID. SCHPROG.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MYFILE ASSIGN TO INDD
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD MYFILE.
01 FILERECORDS.
05 NAME PIC A(10).
05 CLASS-IN PIC 9(1).
05 ROLL PIC 9(5).
WORKING-STORAGE SECTION.
COPY SCHMAPA.
COPY SCHMAPB.
COPY SCHMAPC.
01 END-OF-FILE PIC A(3) VALUE 'NO'.
PROCEDURE DIVISION.
000-MAIN-PARA.
PERFORM 100-SEND-MAPA.
PERFORM 100-RECEIVE-MAPA.
IF CHOICEI = '1'
PERFORM 200-SEND-MAPB
PERFORM 200-RECEIVE-MAPB
PERFORM 200-SEND-MAPB
PERFORM 100-SEND-MAPA
END-IF.
IF CHOICEI = '2'
PERFORM 300-SEND-MAPC
PERFORM 300-RECEIVE-MAPC
PERFORM 500-SRCH-REC
PERFORM 300-SEND-MAPC
PERFORM 100-SEND-MAPA
END-IF.
STOP RUN.
100-SEND-MAPA.
EXEC CICS
SEND
MAP('SCHOLA') MAPSET('SCHMAPA')
ERASE
END-EXEC.
100-RECEIVE-MAPA.
EXEC CICS
RECEIVE
MAP('SCHOLA') MAPSET('SCHMAPA')
END-EXEC.
200-SEND-MAPB.
EXEC CICS
SEND
MAP('SCHOLB') MAPSET('SCHMAPB')
ERASE
END-EXEC.
200-RECEIVE-MAPB.
EXEC CICS
RECEIVE
MAP('SCHOLB') MAPSET('SCHMAPB')
END-EXEC.
PERFORM 400-FILE-PROCESS.
300-SEND-MAPC.
EXEC CICS
SEND
MAP('SCHOLC') MAPSET('SCHMAPC')
ERASE
END-EXEC.
300-RECEIVE-MAPC.
EXEC CICS
RECEIVE
MAP('SCHOLC') MAPSET('SCHMAPC')
END-EXEC.
400-FILE-PROCESS.
OPEN OUTPUT MYFILE.
MOVE NAMEI TO NAME.
MOVE CLASSI TO CLASS-IN.
MOVE ROLLI TO ROLL.
WRITE FILERECORDS.
CLOSE MYFILE.
MOVE 'RECORD INSERTED' TO MSGBO.
500-SRCH-REC.
OPEN INPUT MYFILE.
PERFORM UNTIL END-OF-FILE = 'YES'
READ MYFILE INTO FILERECORDS
AT END
MOVE 'YES' TO END-OF-FILE
NOT AT END
IF ROLL = ROLLCI
MOVE NAME TO NAMECO
MOVE CLASS-IN TO CLASSCO
END-IF
END-READ
END-PERFORM.
CLOSE MYFILE.
Getting error.
IGYPA3043-E Data-item "FILERECORDS (GROUP)" and record "FILERECORDS (GROUP)"
had overlapping storage. Movement of data may not occur at execution time.
I have provided my cobol program. please check and help me to find the issue.
I am updating file from Cics region and using the same file to get the details and put in cics region.
Not sure why I am getting this error.
Earlier I am using same Group data Item to add record to file and it is working fine.
Please help !!
While the other answers correctly answer your question, compiling for CICS entails some restrictions documented here and quoted as of 06-Apr-2021 below. You may also want to consult the CICS documentation for your version and release of CICS.
Restriction: You cannot run COBOL programs that have object-oriented
syntax for Java™ interoperability in CICS. In addition, if you write
programs to run under CICS, do not use the following code:
FILE-CONTROL entry in the ENVIRONMENT DIVISION, unless the
FILE-CONTROL entry is used for a SORT statement
FILE SECTION of the
DATA DIVISION, unless the FILE SECTION is used for a SORT statement
User-specified parameters to the main program USE declaratives (except
USE FOR DEBUGGING)
These COBOL language statements:
ACCEPT format 1:
data transfer (you can use format-2 ACCEPT to retrieve the system date
and time)
CLOSE
DELETE
DISPLAY UPON CONSOLE
DISPLAY UPON SYSPUNCH
MERGE
OPEN
READ
RERUN
REWRITE
START
STOP literal
WRITE
[...]
Coding file input and output: You must use CICS commands for most input and output processing. Therefore, do not describe files or code
any OPEN, CLOSE, READ, START, REWRITE, WRITE, or DELETE statements.
Instead, use CICS commands to retrieve, update, insert, and delete
data.
READ MYFILE INTO FILERECORDS is a duplicate because those are already assigned to each other.
To fix that simply use READ MYFILE (the INTO somewhere would only be used if you don't want to place that into FILERECORDS but somewhere else).
Similar answer to #simon's.
READ already places the record into the 01 definition in MYFILE. READ INTO is used when you want the data to be placed in another area in WORKING-STORAGE. Executing a READ INTO to the FD area is simply moving the data over itself.
I was always taught to do a READ INTO an area that I defined or was a COPYBOOK in WORKING-STORAGE to separate the I/O area from the data manipulation.
In assembler what you are doing with READ is the equivalent of a GET LOCATE as opposed to a GET MOVE type of operation.

Cobol: cannot find entry point of a text file

Hi i am learning cobol from tutorialpoints and every program from there works as i've tested them in OpenCobolIDE(some needed a little editing). Then i came across the File Handling chapter and in there the program had a lot of errors. I did manage to rewrite the program until it didn't show me any errors but it doesn't do anything.
Here's my code:
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT STUDENT ASSIGN TO
'C:\Cobol\FIle Handling\input.txt'
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY IS STUDENT-ID
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD STUDENT.
01 STUDENT-FILE.
05 STUDENT-ID PIC 9(5).
05 NAME PIC A(25).
WORKING-STORAGE SECTION.
01 WS-STUDENT-FILE.
05 WS-STUDENT-ID PIC 9(5).
05 WS-NAME PIC A(25).
01 FS PIC 9(02).
PROCEDURE DIVISION.
OPEN I-O STUDENT.
MOVE 20005 TO STUDENT-ID.
READ STUDENT RECORD INTO WS-STUDENT-FILE
KEY IS STUDENT-ID
INVALID KEY DISPLAY 'Invalid Key'
NOT INVALID KEY DISPLAY WS-STUDENT-FILE
END-READ.
CLOSE STUDENT.
STOP RUN.
This is the text file:
20003 Mohtashim M.
20004 Nishant Malik
20005 Amitabh Bachhan
The result should be the text:
20005 Amitabh Bachhan
It's doing something: It's reading the file. But that's all; you didn't ask for it to display or do anything else beyond reading the record into memory. You might want to look at using the DISPLAY statement or maybe create another file to write the output to.
Might I make a couple of suggestions?
In modern COBOL, stylistically, you don't put a period after everything in the procedure division -- you only put it in where it is necessary. For example:
PROCEDURE DIVISION.
OPEN I-O STUDENT
MOVE 20005 TO STUDENT-ID
READ STUDENT RECORD INTO WS-STUDENT-FILE
KEY IS STUDENT-ID
INVALID KEY DISPLAY 'Invalid Key'
NOT INVALID KEY DISPLAY WS-STUDENT-FILE
END-READ
CLOSE STUDENT
STOP RUN
.
Although the compiler doesn't care about spaces and returns, if I were you, I'd try to indent my code a bit better (I like how I indented the above :-) ). It's up to you and a lot of people like to do it differently, but if you are consistent you can spot problems that might sneak through your code.
Edit: I didn't notice that you were reading with a key from a text file. So, either you need to:
read from a pre-built indexed file, or
read the file sequentially and search for what you want by comparing what you read for the student id you wanted.

Is there a way to automatically fill in array after getting user input?

I have an array of 5 elements and each of the elements holds a character. I want to accept user input in one line. For example: ABCDE. And I intend element 1 of the array to have A and element 2 of the array to have B and so on. Could someone help with this? I have attached the relevant portions of the code below:
environment division.
input-output section.
file-control.
select standard-input assign to keyboard.
select standard-output assign to display.
data division.
file section.
fd standard-input.
01 stdin-record pic x(80).
fd standard-output.
01 stdout-record pic x(80).
working-storage section.
01 input-area.
02 inputCharacters pic x(1) occurs 5 times.
01 print-line.
02 inputCharacters pic x(1) occurs 5 times.
procedure division.
open input standard-input, output standard-output.
read standard-input into input-area
at end
close standard-input, standard-output
end-read.
write
stdout-record from print-line after advancing 5 line
end-write
stop run.
MOVE input-area TO print-line
For the code you have, you could also do this:
write
stdout-record from input-area after advancing 5 line
end-write
If you don't need two copies of a table (COBOL doesn't really have "arrays" in the way you're probably used to) then don't have two copies.
If you do have two tables, I'd suggest making the item names different. If you don't, you're making things tougher by having to use "qualification" to make the references unique.
MOVE inputCharacters ( 1 ) OF input-area
TO inputCharacters ( 1 ) OF print-line
Instead of
MOVE inputCharacters ( 1 )
TO outputCharacters ( 1 )
If you don't mind qualification yourself, you may find that colleagues or future maintainers hate it.
I'm not quite sure what you want to happen with this:
read standard-input into input-area
at end
close standard-input, standard-output
end-read.
You only do one read, you you'll only get at end when there is no data (whatever that means with keyboard). In that case, you don't have data to do anything with.
You should look at how to use FILE STATUS for each file. Check the file-status field after each IO, and I'd also recommend using the file-status field for end-of-file checking, rather than the cumbersome AT END.
However, as I said, I don't know what that means with keyboard... so perhaps that won't work :-)

Programs hangs when opening COBOL Indexed file

I've recently started a COBOL course and, because of my computer configuration (Windows 7 64 Bits and GNU/Linux 64Bits) I have to use Dosbox to compile and execute programs.
Everything is going well but, I'n finding some troubles when I try to open an Indexed file, either I-O or Ouput mode. I can compile and link but at execution time, dosbox get frozen.
My compiler version is MS-COBOL 5.0 and DosBox is 0.74 (last version).
Does anybody have had this issue? Can someone tell how to fix it.
My code is this one.
Thanks in advance.
IDENTIFICATION DIVISION.
PROGRAM-ID. AGENDA.
AUTHOR. JOSE MARIA RAMIREZ MIRA.
DATE-WRITTEN. 06/05/2014.
DATE-COMPILED. 06/05/2014.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-PC.
OBJECT-COMPUTER. IBM-PC.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT AGENDA ASSIGN TO DISK "AGENDA.DAT"
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY IS AG-NICK
FILE STATUS IS AG-STATUS.
DATA DIVISION.
FILE SECTION.
FD AGENDA
RECORD CONTAINS 112 CHARACTERS
LABEL RECORD IS STANDARD
DATA RECORD IS AG-PERSONA.
01 AG-PERSONA.
03 AG-NICK PIC X(25).
03 AG-NOMBRE PIC X(25).
03 AG-APELLIDOS PIC X(50).
03 AG-TELEFONO PIC X(12).
WORKING-STORAGE SECTION.
77 AG-STATUS PIC 99.
88 EXITO VALUE 00.
88 CLAVE-DUPLICADA VALUE 22.
88 CLAVE-NO-ENCONTRADA VALUE 23.
88 SIN-ESPACIO-EN-DISCO VALUE 34.
88 FICHERO-NO-EXISTE VALUE 35.
88 EOF VALUE 10.
PROCEDURE DIVISION.
MAIN-PROCEDURE.
DISPLAY "PROCEDO A ABRIR EL ARCHIVO".
OPEN I-O AGENDA.
IF EXITO THEN
DISPLAY "EL ARCHIVO SE HA ABIERTO"
ELSE
EVALUATE TRUE
WHEN FICHERO-NO-EXISTE
DISPLAY "EL ARCHIVO NO EXISTE"
END-EVALUATE
END-IF.
CLOSE AGENDA.
STOP RUN.
END PROGRAM AGENDA.
Have you tried selecting the file using the OPTIONAL phrase. For example,
SELECT OPTIONAL AGENDA ASSIGN TO DISK "AGENDA.DAT"
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY IS AG-NICK
FILE STATUS IS AG-STATUS.
The OPTIONAL phrase must be specified for files opened for INPUT, I-O, or EXTEND that need not be present when the program runs.
Against this being the problem is your statement that the problem also occurs with OPEN OUTPUT and the program should in any case be producing some output but as others have remarked the version of COBOL is not well known.
By the way I plugged your program into the online COBOL at http://www.compileonline.com/compile_cobol_online.php
and it worked fine triggering the FICHERO-NO-EXISTE condition name.
But this does raise another point. In my Microfocus manual the file status code of 35 is given as being returned when an OPEN INPUT, I-O or EXTEND is attempted on a NON-OPTIONAL file that does not exist. A file status of 05 is returned if you have used the OPTIONAL phrase and the file does not exist at the time the OPEN is executed.
What is the absolute path to AGENDA.DAT?
Sometimes with legacy DOS programs you can't read/write files inside folders with spaces on its name. Say, if your current folder is C:\ms cobol\ , rename it to C:\mscobol\.
It's worth a try, if this is your case.
DOSBox was designed for gaming.
The problem could be DOSBox missing file and record locking.
DOSBox has more issues like internal file caching, a time bomb with multi-user enabled programs.
You could try vDos: http://sourceforge.net/projects/vdos/.
It is Windows only, but integrates better with it.

SUBSTRING for a String Literal in COBOL

Is there anyway to get a SUBSTRING of string literal in COBOL without using a temporary variable?
Let's say in the following code:
MOVE "HELLO" TO MY-VAR.
MOVE MY-VAR(1:3) TO SUB-STR.
Is there any way to do the same thing, but without MY-VAR?
EDIT:
I did tried following code, but it's failed.
MOVE "HELLO"(1:3) TO SUB-STR * COMPILE ERROR
You can accomplish what you are trying to do by type-laundering the literal through a function. You can then substring, or reference modify, the output of the function. Consider that calling reverse twice on the same data returns the original data.
Move function reverse
( function reverse(
'abcdefg'
)
) (3:1) to text-out
The above will result in a 'c' being moved to text-out.
Of course, the example code in your question does not make any sense, as why would you write "HELLO"(1:3) when you could just write "HEL".
So you must be wanting to use a variable (or 2) in the reference modifier field(s).
If you are wanting to get the first 'N' characters of the literal, you can do this by using the reference modifier on the destination item. For example, if you compile and run the following program:
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 LEN PIC 99 VALUE 8.
01 SUB-STR PIC X(80).
PROCEDURE DIVISION.
MOVE "HELLO WORLD" TO SUB-STR(1:LEN).
DISPLAY SUB-STR.
STOP RUN.
You get the resulting output:
HELLO WO
Unfortunately this method only works if you want the first 'N' characters of the literal string.
Also, the destination string must be empty before you start. In the above program, if you changed the definition of SUB-STR to be:
01 SUB-STR PIC X(80) VALUE "BLAH BLAH BLAH".
Then the result of running the program becomes:
HELLO WOH BLAH
Put the "literal" into a field, like a constant.
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 LITERAL-HELLO PIC X(5) VALUE 'HELLO'.
PROCEDURE DIVISION.
DISPLAY LITERAL-HELLO(1:3).
STOP RUN.

Resources