Reading floating-point numbers from file in COBOL - cobol

I have fixed-point numbers in file, one in each line, in this format S9(6)V9(2) but when they are actually read, I'm getting non numeric errors while trying to put them in math operations. What is more, when I try to display them in program, a number that is written in file as 567123.45 is saved in variable as +567123.04. And for example the number from file 123.45 is saved in variable as +123.45.00 and it provokes the following error 'WS-VALUE' not numeric: '123.45 0' during a math operation. Why is that?
I'm using OpenCobolIDE 4.7.4 for Windows.
EDIT:
File has records of the following form separated by new lines (read by READ operation record after record):
01 WS-OPERATION.
05 WS-ID PIC A(2).
05 WS-CLIENT PIC 9(5).
05 WS-COUNTRY PIC A(4).
05 WS-VALUE PIC S9(6)V9(2).

The reason is that you try to un-edit a field. 567123.45 in the data is not conforming to PIC S9(6)V9(2) but to -9(6).9(2). - internal stored data vs. print-data.
Simply changing the definition and use MOVE WS-VALUE TO WS-VALUE-INTERNAL (which is defined like you want to) may work with a specific compiler (and specific data) but I'd go a different route:
I'd suggest to always validate the data before doing something with it (the file may be broken or external edited).
At least check the simple numeric data like WS-CLIENT for IS NUMERIC and either do a full validation on the data field WS-VALUE or at least use MOVE FUNCTION NUMVAL(WS-VALUE) TO WS-VALUE-INTERNAL.

Related

Way to "catch" input data through ACCEPT?

I am fairly new to Cobol and am writing a basic application to get started with the language. Right now it is a 100% console application and I ran into a problem that isn't really a problem unless the user inputs the wrong data... And after not being able to find an answer to my "problem" through google I can't seem to get it out of my head, hence the thread here.
I have a variable USER-RECORD X(4) and during run-time I ask the user to enter his/her user record. Let's say they enter '1234', then 1234 is being saved and stored in a file along with the other data being requested. However, if the user were to enter "11234" by mistake, then the program will store 1123 instead of 1234, which is wrong because of the wrongly entered data.
My question is if it is possible to surround the ACCEPT verb with some kind of statement, or "catch" the incoming data in some way that if the data being sent is larger than 4 characters something will happen?
It is probably smarted to handle these things afterwards making the user confirm the data and all, but I can't seem to get this out of my head. Is this possible at all?
01 USER-RECORD PIC X(4).
01 USER-RECORD-REDEFINED REDEFINES USER-RECORD PIC 9(4).
GET-USER-INPUT.
MOVE 'N' TO WS-NUMERIC.
PERFORM UNTIL WS-NUMERIC = 'Y'
DISPLAY 'ENTER YOUR 4 DIGIT RECORD NUMBER: ' NO ADVANCING
ACCEPT USER-RECORD *>---THIS IS WHERE MY QUESTION LIES---
IF USER-RECORD-REDEFINED IS NUMERIC
MOVE 'Y' TO WS-NUMERIC
ELSE
DISPLAY 'VALUE WAS NOT NUMERIC OR 2 SHORT, TRY AGAIN'
END-PERFORM.
Your Micro Focus compiler supports the SCREEN SECTION. If you use a SCREEN, then your data can only be entered up to the size of the field.
See the FORMAT 4 of ACCEPT in the Micro Focus documentation here, https://supportline.microfocus.com/documentation/books/nx51ws01/nx51indx.htm, and from there locate the documentation of the SCREEN SECTION and other documentation about using screens in Micro Focus COBOL.
ACCEPT and DISPLAY are the COBOL verbs which suffer the most difference from compiler to compiler. When COBOL was originally developed, the idea of a user sitting at a screen to interact with a program was, let's say, futuristic.
Assuming that you have already seen the effect you describe and want to use a very simple, and standard-ish, format of ACCEPT, I'd suggest this:
01 USER-RECORD PIC X(80).
01 FILLER REDEFINES USER-RECORD.
05 USER-ID-give-it-a-good-name PIC 9(4).
05 FILLER PIC X(76).
88 USER-RECORD-EXTRAS-BLANK VALUE SPACE.
SET USER-RECORD-EXTRAS-BLANK TO TRUE
ACCEPT USER-RECORD
[your existing code using the nice new name]
IF NOT ( USER-RECORD-EXTRAS-BLANK )
[do something for also an error]
END-IF
The user may be able to circumvent this by idly using the spacebar to get 76 blanks, but probably not worth dealing with that.

Get field names while running program

I have a copy book like :
01 MY-STRUCTURE.
05 STRUCTURE-NAME PIC X(20).
05 STRUCTURE-DATE PIC X(8).
05 STRUCTURE-LIB PIC 9(3).
How can I get the name of my fields?
I want to have a program that can get any copybook and write dynamically its fields and values.
I want to write it to an output file like this :
"STRUCTURE-NAME-> TOTO"
"STRUCTURE-DATE-> 19780301"
"STRUCTURE-LIB -> 123"
In the z/OS world, depending upon your compiler level, you can use the debugging information generated by the compiler to do introspection on your names. To do this, you will need to save your ADATA at compile time.
I have a two possible solutions:
You save the names of the fields of the copy in a internal table. And secuential reads the table for your write your output.
Dynamical allocation, is more complicated but it's possible. You allocate the copy in your program using bpxwdyn (subroutine IBM).
You create a subprogram, with name of copy, the length is fixed (80), the name of library of copys, and allocate this copy in subprogram. Then, You can fill a internal table with his datas.
Eg:
http://mainframe-tips-and-tricks.blogspot.com.es/2011/12/cobol-sample-program-for-dynamic-file.html

Buffer in cobol file handling

I have written a code to match the date given by user(instream data) with the date mentioned in an input file. When the date matches, the record is moved to an output file. The program ran successfully. Now i am inserting a header in output file by declaring a variable 'header' in working-storage section, moving the 'header' field to output record and writing the output record. Though it is running successfully i have a doubt. I looked for it everywhere but unable to find it. The problem is-
The concept of buffer tells us that while declaring File Description(FD) it creates a structure. The file description(FD) given with all the records and fields creates a buffer structure. Now all the read/write operation happens through it.
If a program processes more than one file, a record buffer must be defined for each file.
To process all the records in an INPUT file, we must ensure that each record instance is copied from the file, into the record buffer, when required.
To create an OUTPUT file containing data records, we must ensure that each record is placed in the record buffer and then transferred to the file.
To transfer a record from an input file to an output file we must read the record into the input record buffer, transfer it to the output record buffer and then write the data to the output file from the output record buffer.
So when i am giving the date separately and moving it to the output record it is SURELY not going into that buffer which i created using FD in output record. So how is it going there?? If it is creating its own buffer then all data can be moved directly, what is the need of declaring FD??
This is the link to see the concept of buffer
[1]: http://www.csis.ul.ie/cobol/course/SequentialFiles1.htm
This is my code as given below-JUST EMPHASIZE ON STATEMENTS IN SLASHES
IDENTIFICATION DIVISION.
PROGRAM-ID. TXNRPT02 .
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT D01-TXN-FILE ASSIGN TO DETLFILE
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-INSERT-FILE-STATUS1.
SELECT D02-TXN-FILE ASSIGN TO DATEOUT
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-INSERT-FILE-STATUS2.
DATA DIVISION.
FILE SECTION.
FD D01-TXN-FILE. // CREATES A BUFFER
01 D01-TXN-REC.
05 TXN-DATE PIC 9(8).
05 FILLER PIC X(1).
05 TXN-NUMBER PIC 9(5).
05 FILLER PIC X(1).
05 SBACCT-CODE PIC 9(5).
05 FILLER PIC X(1).
05 TXN-AMOUNT PIC 9(5)V9(2).
05 FILLER PIC X(52).
FD D02-TXN-FILE. //CREATES A BUFFER STRUCTURE IN OUTPUT FILE
01 D02-TXN-REC.
05 TXN-DATE1 PIC 9(8).
05 FILLER PIC X(1).
05 TXN-NUMBER1 PIC 9(5).
05 FILLER PIC X(1).
05 SBACCT-CODE1 PIC 9(5).
05 FILLER PIC X(1).
05 TXN-AMOUNT1 PIC 9(5)V9(2).
05 FILLER PIC X(52).
WORKING-STORAGE SECTION.
01 HEAD1 // declaring header
02 FILLER PIC X(20).
02 TEXT PIC X(40) VALUE 'REPORT OF BANK'
01 FILE-STATUS PIC X(02) VALUE '00'.
88 EOF VALUE '10'.
88 SUCCESS VALUE '00'.
01 WS-INSERT-FILE-STATUS1 PIC X(2).
01 WS-INSERT-FILE-STATUS2 PIC X(2).
01 WS-DATE PIC 9(8). // DATE TO BE ACCEPTED FROM INSTREAM DATA
PROCEDURE DIVISION.
MAIN-PARA.
ACCEPT WS-DATE.
PERFORM OPEN-PARA.
PERFORM INIT-PARA.
PERFORM PROCESS-PARA UNTIL EOF.
PERFORM CLOSE-PARA.
STOP RUN.
OPEN-PARA. // OPENS INPUT AND OUTPUT FILES
OPEN INPUT D01-TXN-FILE.
DISPLAY 'INFILE OPEN STATUS' , WS-INSERT-FILE-STATUS1.
OPEN OUTPUT D02-TXN-FILE.
DISPLAY 'OUTFILE OPEN STATUS' ,WS-INSERT-FILE-STATUS2.
INIT-PARA. // INITIALIZES BOTH RECORDS
INITIALIZE D01-TXN-REC.
INITIALIZE D02-TXN-REC.
PROCESS-PARA.
MOVE HEAD1 TO D02-TXN-REC. // MOVING HEADER TO OUTPUT RECORD
WRITE D02-TXN-REC. // WRITING THE HEADER
READ D01-TXN-FILE
AT END MOVE '10' TO FILE-STATUS
NOT AT END PERFORM OPPO-PARA
END-READ.
OPPO-PARA. //PERFORMS EQUAL OPERATION ON BOTH DATES
IF WS-DATE = TXN-DATE
MOVE D01-TXN-REC TO D02-TXN-REC
WRITE D02-TXN-REC
END-IF.
CLOSE-PARA. // CLOSING BOTH FILES
CLOSE D01-TXN-FILE, D02-TXN-FILE.
DISPLAY 'INFILE CLOSE STATUS' , WS-INSERT-FILE-STATUS1.
DISPLAY 'OUTFILE CLOSE STATUS' , WS-INSERT-FILE-STATUS2.
I think you are over-complicating things.
In the FILE SECTION you logically connect a record-layout to a file that will be read, or to a record which will be written (to a file).
No storage is allocated in your COBOL program by the definition of the FD or any 01-levels subordinate to an FD. You simply establish a "map" which will be used to understand the data read from a file, or to use to construct the data which you will write to a file.
When you OPEN a file, some run-time code does that work behind the scenes, and will make the address of the first byte of your record layout(s) under the FD equal to the first byte of the piece of storage that will be used as the "buffer".
A "buffer" in this context is just a piece of storage which is the same size as your BLKSIZE and which will be used, without you having to be aware of it, to store records before they are actually written to the physical output file.
What happens when you WRITE a record is that the record-pointer simply gets changed to the first available byte after the current record.
It is similar when you read.
Although installation-dependent, mostly you will have the default number of buffers for a simple sequential file, which is five. Once a buffer is full the, for an output file, the IO-subsystem will be told it has data available for writing, and the filling will continue, asynchronously, with the next buffer area. What this does is reduce the amount of time your COBOL program is waiting for IO to complete.
It is similar, which obvious reversals, for the READ of a sequential file.
As a beginner, you don't need to know what the buffering is doing. Just keep it conceptually simple. You OPEN, you READ, the record is "under" the FD. You continue doing that until end-of-file, then you CLOSE. At the same time (usually) you OPEN, you WRITE, and you CLOSE at the end. What gets written is the data that is under the FD for the output file.
Also review READ ... INTO ... and WRITE ... FROM .... The concept is the same, it is just that COBOL will "move" the data to the FD for you, rather than you having detailed record-layouts under the FD. Whether you use READ file or READ file INTO record-layout is usually down to local standards for your site - do it the way your team does it.
You have now added some code to your Question.
First thing, you are writing your header inside a loop. You will get one header per record, which is probably not what you want.
Secondly, you've changed to use the FILE STATUS but not fully grasped how it works yet. You don't need the AT END/NOT AT END. The COBOL IO will maintain the FILE STATUS field. When end-of-file is identified by the COBOL run-time the FILE STATUS field will be set to "10", "automatically" as far as you are concerned.
Thirdly, review your use of INITIALIZE. There is never any point in INITIALIZE on an input record. READ always advances the record-pointer. The storage INITIALIZEd is the storage before the record you read. Even if it was not, what is the point of INITIALIZE, just to read a record over the top of the initialised storage? Same with your output.
All that your use of INITIALIZE is doing is using CPU time. Yes, it is not at all uncommon that this happens, but that is no excuse for you to pick up bad habits as well.

Compare BINARY INTEGER variable with ALPHANUMERIC variable in COBOL

IF AWA-REQ-DATE < WS-JULIAN-DATE
MOVE VAR1 to VAR2
The AWA-REQ-DATE is a binary integer i.e. PIC S9(09) COMP, whereas Julian date is PIC X(10) VALUE SPACES.
Both have Julian date inside them like 2013031 & 2013099.
This gives:
ERROR:REQ-DATE (BINARY INTEGER)" was compared with "WS-JULIAN-date (ALPHANUMERIC)". Discarded
Can I compare then with converting one of them to other format right here in code?
All your four-digit-year Julian dates will contain seven digits. They are dates, so naturally are positive.
It is unclear why you have a nine-digit, signed, binary to hold such or date. Nor a 10-byte alphanumeric. It is also unclear why this should have an initial value of SPACE.
01 WS-JULIAN-DATE VALUE SPACE.
05 WS-JULIAN-DATE-NUM PIC 9(7).
05 FILLER PIC XXX.
This assumes all your WS-JULIAN-DATE values are left-aligned.
IF AWA-REQ-DATE < WS-JULIAN-DATE
MOVE VAR1 to VAR2
END-IF
Hopefully VAR1 and VAR2 are just sample names for the question. If not, please make them meaningful, as it will make it much easier for the next person reading the program to understand. And that might be you.
If the values of WS-... are not guaranteed to be NUMERIC, test them for NUMERIC and take appropriate action (according to your spec) if they are not.
The nine-digit binary will potentially generate extra code beyond what is needed.
Another possibility is:
01 WS-AWA-REQ-JULIAN-DATE VALUE SPACE.
05 WS-AWA-REQ-JULIAN-DATE-NUM PIC 9(7).
05 FILLER PIC XXX.
MOVE AWA-REQ-DATE TO WS-AWA-REQ-JULIAN-DATE-NUM
IF WS-AWA-REQ-JULIAN DATE < WS-JULIAN-DATE
MOVE VAR1 to VAR2
END-IF
Which you choose can depend on what else you are doing with the fields.
Also, if one is "invariant", convert that to the same format as the variable one, once only.
In the various ISO/ANSI COBOL standards, comparing alphanumeric (PIC X) and numeric (PIC 9) is like comparing apples and oranges. There are defined rules. Of course, each compiler has different ways of interpreting the standard. Therefore, you are best off converting one of the fields to the other format and comparing those. Bill Woodger has some good comments about which field to convert, and how.
In summary, you should always compare like data types. For numeric items, it's best if you can compare the same COMP format, but sometimes this can't be done. If that is the case, you need to read your compiler documentation to see how comparisons are performed between different computational types, and any gotchas (such as COMP-4 and COMP-5 in IBM's Enterprise COBOL).
The answer probably depends on which compiler you are using. On GNU Cobol, the comparison works after applying FUNCTION NUMVAL to the Julian (text) date.
As the error message is describing: a numeric value PIC S9(9) COMP cannot be compared to a string PIC X(10).
A COMP variable is a system dependent, numeric representation of the value. There are variations to the internal representation (binary, BCD,...) used for COMPutation. The value of your date is,depending on the machine though, internally represented as: 0011110 10110111 01100111
Display variables are storing each position of your variable according to an encoding standard (ASCII, EBCDIC, UNICODE). Again depending on your machine and the encoding table, the representation of your variable might be: 00110010 00110000 00110001 00110011 00110000 00111001 00111001
I do some guessing here in order to address the underlying problem
First guess: The alpha definition PIC X(10) looks like the date is in printing format and should contain separators in order to make it 10 characters long
21.02.2014
123456789A
Such a variable shouldn't hold a julian date after all and you probably need a date comparing function.
Second guess: for some displaying reason, you want to have a variable of 10 characters long, holding the julian date in the first 7 characters. In this case, I'd define a structure and you can keep your comparison as is:
01 WS-JULIAN-DATE-PRINT VALUE SPACE.
05 WS-JULIAN-DATE PIC 9(7).
05 FILLER PIC X(3).

Implicit Close of file

I have written the following COBOL program:
*************************************************************
* VERKOOP
*************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. VERKOOP.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PRODUCTEN ASSIGN TO "BESTANDEN/PRODUCTEN"
ACCESS MODE IS RANDOM
ORGANIZATION IS INDEXED
RECORD KEY IS PRODUCTID
FILE STATUS IS WS-FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD PRODUCTEN BLOCK CONTAINS 10 RECORDS.
01 PRODUCT.
02 PRODUCTID PIC X(6).
02 LEVERANCIERID PIC X(6).
02 AANTAL PIC 9(6).
WORKING-STORAGE SECTION.
77 FOUT PIC X.
88 PRODUCT-NIET-GEVONDEN VALUE 1.
77 WS-PRODUCTID PIC X(6).
77 WS-AANTAL PIC 9(6).
77 WS-FILE-STATUS PIC XX.
LINKAGE SECTION.
01 LS-PRODUCTID PIC X(6).
01 LS-AANTAL PIC 9(6).
PROCEDURE DIVISION.
* USING LS-PRODUCTID, LS-AANTAL.
MAIN.
PERFORM INITIALISEER
PERFORM LEES-PRODUCT-IN
PERFORM LEES-BESTAND
PERFORM SLUIT-BESTAND
STOP RUN.
INITIALISEER.
MOVE ZEROS TO PRODUCT
OPEN I-O PRODUCTEN.
* DISPLAY WS-FILE-STATUS..
LEES-PRODUCT-IN.
* MOVE LS-PRODUCTID TO WS-PRODUCTID
* MOVE LS-AANTAL TO WS-AANTAL.
DISPLAY "GEEF PRODUCTID OP: "
ACCEPT WS-PRODUCTID
DISPLAY "GEEF AANTAL OP: "
ACCEPT WS-AANTAL.
LEES-BESTAND.
* DISPLAY "LEES-BESTAND"
MOVE WS-PRODUCTID TO PRODUCTID
* DISPLAY PRODUCTID
READ PRODUCTEN INVALID KEY SET PRODUCT-NIET-GEVONDEN TO TRUE
END-READ
DISPLAY "END-READ" WS-FILE-STATUS
IF PRODUCT-NIET-GEVONDEN PERFORM FOUTJE
ELSE
MOVE WS-PRODUCTID TO PRODUCTID
SUBTRACT WS-AANTAL FROM AANTAL
PERFORM UPDATE-PRODUCT
END-IF.
UPDATE-PRODUCT.
REWRITE PRODUCT INVALID KEY PERFORM FOUTJE.
SLUIT-BESTAND.
* DISPLAY "SLUIT-BESTAND"
CLOSE PRODUCTEN.
FOUTJE.
DISPLAY "ER IS EEN FOUT OPGETREDEN"
* DISPLAY WS-FILE-STATUS
STOP RUN.
The idea is that I find a product by its productid in the file PRODUCTEN.dat and subtract the amount (aantal) by a given number. However everytime I run it I get the following error: WARNING - Implicit CLOSE of PRODUCTEN <"BESTANDEN/PRODUCTEN">. I don't really see the problem, the WS-FILE-STATUS line even gives me back a 00 status. I am 100% sure the product is in the file so I'm not trying to subtract from a non-existing product or anything.
UPDATE: I fixed it by assign PRODUCTEN to a newly declared file as the last one (somehow) got corrupt and was behaving in an unintended way.
To get that Implicit Close message, you must have a STOP RUN before you close the file.
You have a STOP RUN in paragraph FOUTJE, before the file is closed, so paragraph FOUTJE is being used.
You use paragraph FOUTJE in a PERFORM when PRODUCT-NIET-GEVONDEN is true.
PRODUCT-NIET-GEVONDEN is set to true on the INVALID KEY of the READ.
So INVALID KEY is true.
You get a FILE STATUS of ZERO. Unexpected, but fits what you have presented.
I don't have COBOL-IT and I don't know what OS you are using.
I also don't know in your set-up what a READ of a keyed file which does not explicitly reference a key does.
I don't know in any set-up, because I don't do it. If I'm doing a keyed read, I always specify the key.
I don't put data in the key on the file. I use a WORKING-STORAGE field for the key.
Why, well, implementation-dependent for the compiler, but unless your file is OPEN and unless there is a current record on the file, then the content, even the address, of a file record is/can be (implementation dependent) undefined.
As far as I am concerned, the KEY on the SELECT is to define the presence of the key on the file. The key you are using to READ the file obviously comes from elsewhere.
So, I would remove these:
MOVE ZEROS TO PRODUCT
MOVE WS-PRODUCTID TO PRODUCTID
I'd change this to include the KEY of WS-PRODUCTID
READ PRODUCTEN INVALID KEY SET PRODUCT-NIET-GEVONDEN TO TRUE
I'd not use INVALID KEY, I'd just use the value of WS-FILE-STATUS, which I'd expect to be "23" for "not found". I'd do the test with an 88. You then don't need your "flag" (FOUT and PRODUCT-NIET-GEVONDEN) anyway. Check the FILE STATUS field after each IO. This time you spelled your filename correctly, another time you won't and you may waste more time chasing your tail.
Work on consistent indentation, it will make your program easier to read, for you, and anyone else.
If you want to use DISPLAY to verify the logical path, you need to DISPLAY the value which is used to determine the logical path (FOUT in this case).
There are two "formats" of the READ statement. One is for sequential reads, one is for reads using a key. When each is reduced to its mandatory-only content, they are identical. Therefore it is not clear, per compiler, which type of READ is the default (when not explicit) or when it is the default (per file). So I always make it explicit:
READ PRODUCTEN KEY IS WS-PRODUCTID
I would then use the FILE STATUS field to determine whether the key was read (00 in the status) or not found (23) or something else (something else).
NOTE: This Answer as a resolution to your problem only works if everything is as you have described. Further information may invalidate this Answer as a Resolution.
The Answer does work as a generally clearer (therefore better) way to code your COBOL program.
Turns out to have been a suspected corrupted file. This may have caused a disparity between INVALID KEY and FILE STATUS, but in the normal course of events that is not going to happen. It is the only thing which fits all the evidence, but this is an exceptional case, perhaps not able to reproduce without the exact-same file corruption and clutching at this straw in a general case for why a given program is not working is probably the first refuge of a scoundrel.

Resources