It seems a program like this does not work.
PROGRAM-ID. Test.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CountFile ASSIGN TO "count.dat"
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CountFile.
01 CountDetails.
02 FCountA PIC 99 VALUE 0.
02 FCountB PIC 99 VALUE 0.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
Begin.
OPEN OUTPUT CountFile
ADD 1 TO FCountA
ADD 1 TO FCountB
WRITE CountDetails
CLOSE CountFile
STOP RUN.
This writes 9999 to the count.dat file. ADD works for fields in the WORKING-STORAGE SECTION but not in the FILE SECTION.
Is that true ?
Q: Is that true?
A: No, it isn't.
ADD works for any numeric field, no matter where it is stored.
Note that data in FILE SECTION is only guaranteed to be available at all after a successful OPEN (as you've mentioned GnuCOBOL: this one always provides the storage). It does not have any guaranteed value, so you likely want to INITIALIZE the data.
Sample COBOL sample that shows both and can be adjusted and executed:
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO-WORLD.
ENVIRONMENT DIVISION.
input-output section.
file-control.
select test-file
assign to 'test-file'
organization is line sequential.
data division.
file section.
fd test-file.
01 num-var pic 9 value 0.
working-storage section.
01 num2-var pic 9 value 0.
PROCEDURE DIVISION.
ADD 1 TO num-var num2-var
DISPLAY 'Hello, num ' num2-var ' and file ' num-var.
INITIALIZE num-var num2-var
ADD 1 TO num-var num2-var
DISPLAY 'Hello, num ' num2-var ' and file ' num-var.
ADD num2-var to num-var
ADD num2-var to num-var
DISPLAY 'Hello, num ' num2-var ' and file ' num-var.
ADD num-var to num-var
DISPLAY 'Hello, num ' num2-var ' and file ' num-var.
STOP RUN.
Beware: it is fixed-form reference-format, not necessarily portable, the missing OPEN can mean it aborts - and it isn't any reasonable good style - but demonstrate the issue.
Related
Trying to code a cobol program and it keeps treating multiple lines as one line when compiling with opencobol (have to use opencobol, I've heard GNU is better), giving errors
The code is
IDENTIFICATION DIVISION.
PROGRAM-ID. InteractiveProcessing.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INVENTORY-FILE
ASSIGN TO "C:\COBOL\INVENTORY-FILE.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD INVENTORY-FILE.
01 FILE-OUTPUT.
05 PART-NO PIC X(5).
05 PART-DESC PIC X(15).
05 QTY-ON-HAND PIC 9(5).
05 UNIT-PRICE PIC 999V99.
WORKING-STORAGE SECTION.
01 MORE-DATA PIC X(3) VALUE 'YES'.
PROCEDURE DIVISION.
100-MAIN-MODULE.
OPEN OUTPUT INVENTORY-FILE
PERFORM UNTIL MORE-DATA = 'NO '
PERFORM 200-INVENTORY-MODULE
DISPLAY 'ENTER MORE DATA? (YES/NO)'
ACCEPT MORE-DATA
END-PERFORM
CLOSE INVENTORY-FILE
STOP RUN.
200-INVENTORY-MODULE.
DISPLAY 'ENTER PART NUM (5 CHARACTERS)'
ACCEPT PART-NO
DISPLAY 'ENTER PART DESCRIPTION (15 CHARACTERS)'
ACCEPT PART-DESC
DISPLAY 'ENTER QUANTITY ON HAND(INTEGER, UP TO 5 DIGITS)'
ACCEPT QTY-ON-HAND
DISPLAY 'ENTER UNIT PRICE (5 DIGITS, 2 AFTER DECIMAL)'
ACCEPT UNIT-PRICE
WRITE FILE-OUTPUT.
The errors I keep getting say
'ENTER' undefined
and
syntax error, unexpected UNIT
The line the errors are appearing on is
DISPLAY 'ENTER QUANTITY ON HAND(INTEGER, UP TO 5 DIGITS)'
The errors are from ENTER and UNIT from two lines down and I can't figure out why this is happening. Changing the quotation marks from single to double on just that line then gives an unexpected end of file error as well.
The problem was that I used tab to align the PIC clauses. Had the same issue in another program. Solved by backspacing the tabs then just using the spacebar to get the clauses to the right spot. Looks the same in the end but actually ran this way.
I'm building a cobol system and I can't display an error message to the user using the screen section. How can I do this?
And how do I get the ESC key that the user presses to return to the menu?
I'm using GNUCobol and OpenCobol.
Here comes a very brief example of how you can use screen section in cobol.
*>****************************************************************
*> Author:mnemonics
*> Date:
*> Purpose:
*> Tectonics: cobc
*>****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. using-screen.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 id-in-ws pic x(4).
screen section.
01 id-input line 5 col 10 pic x(4) to id-in-ws.
01 id-input-fld line 5 col 5 value "id: ".
PROCEDURE DIVISION.
MAIN-PROCEDURE.
DISPLAY id-input-fld
accept id-input
STOP RUN.
END PROGRAM using-screen.
Observe the section screen. You have to declare variables that will represent the fields inside the encapsulation of the screen section. The inserted value will be stored in the variable declared under the working-storage section. A great article about how to use screen can be read in the following web page: Using screens in COBOL.
I have a program which reads a GDG file and moves data to working storage. I am interested to know if it can be made to repeat this process for multiple generations of the GDG using a reference to the file definition. Perhaps there is a way to use subscripts on the file definition? My thought is there must be a method to move different file definitions into a reference variable from which to access the files.
Code Sample based on suggested, setenv solution
FILE-CONTROL.
SELECT DATAIN ASSIGN TO UT-S-DATAIN.
DATA DIVISION.
FILE-SECTION.
FD DATAIN
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS DATA-REC.
01 DATA-REC PIC X(133).
WORKING-STORAGE SECTION.
01 ENV-VARS.
02 ENV-NAME PIC X(9).
02 ENV-VALUE PIC X(100).
02 ENV-OVERWRITE PIC S9(8) COMPUTATIONAL VALUE 1.
PROCEDURE DIVISION.
MOVE Z"DATAIN" TO ENV-NAME
MOVE Z"DSN(PROGRAMMER.TEST.GDGFILE(-1)),SHR" TO ENV-VALUE
MOVE 1 TO ENV-OVERWRITE
CALL "setenv" USING ENV-NAME ENV-VALUE ENV-OVERWRITE.
Notes
Pay special attention when moving DSN value to ENV-VALUE. On my first swing I left out the closing parentheses, most likely because of JCL muscle memory.
Be sure to empty out your DD statement in JCL/Step.
In mainframe COBOL, the FD refers to a SELECT which refers to a DD statement attached to the EXEC PGM statement for your program in the invoking JCL. The DD statement may refer to one or many GDGs. This is determined at compile time.
What I think you are asking for is dynamic allocation of a file at runtime. There are a couple of ways to accomplish that, one is BPXWDYN.
Identification Division.
Program-ID. SOMETEST.
Environment Division.
Input-Output Section.
File-Control.
Select MY-FILE Assign SYSUT1A.
Data Division.
File Section.
FD MY-FILE
Record 80
Block 0
Recording F.
01 MY-FILE-REC PIC X(080).
Working-Storage Section.
01 CONSTANTS.
05 BPXWDYN-PGM PIC X(008) VALUE 'BPXWDYN '.
05 ALCT-LIT-PROC PIC X(035)
VALUE 'ALLOC FI(SYSUT1A) SHR MSG(WTP) DSN('.
05 FREE-LIT-PROC PIC X(016)
VALUE 'FREE FI(SYSUT1A)'.
05 A-QUOTE PIC X(001) VALUE "'".
01 WORK-AREAS.
05 WS-DSN PIC X(044) VALUE 'MY.GDG.BASE'.
05 WS-GDG-NB PIC 999 VALUE ZEROS.
05 BPXWDYN-PARM.
10 PIC S9(004) COMP-5 VALUE +100.
10 BPXWDYN-PARM-TXT PIC X(100).
Procedure Division.
* Construct the allocation string for BPXWDYN.
MOVE SPACES TO BPXWDYN-PARM-TXT
STRING
ALCT-LIT-PROC
DELIMITED SIZE
WS-DSN
DELIMITED SPACE
'(-'
DELIMITED SIZE
WS-GDG-NB
DELIMITED SIZE
')'
DELIMITED SIZE
INTO
BPXWDYN-PARM-TXT
END-STRING
CALL BPXWDYN-PGM USING
BPXWDYN-PARM
END-CALL
IF RETURN-CODE = 0
CONTINUE
ELSE
[error handling]
END-IF
[file I/O with MY-FILE]
MOVE SPACES TO BPXWDYN-PARM-TXT
MOVE FREE-LIT-PROC TO BPXWDYN-PARM-TXT
CALL BPXWDYN-PGM USING
BPXWDYN-PARM
END-CALL
IF RETURN-CODE = 0
CONTINUE
ELSE
[error handling]
END-IF
GOBACK.
This is just freehand, so there may be a syntax error, but I hope I've made the idea clear.
There is another technique, using the C RTL function setenv, documented by IBM here. It looks like it might be simpler but I've never done it that way.
I am trying to make the program below to pull out records that have customer names beginning with letter the "M" and write the records to a temporary file. The program runs but it won't write records to the output file. I debugged the code, and it seems like the code line "WRITE MAST2-RECORD" never runs. It skips this line of code.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MAST-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-1\OVERDUE.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY IS M-ACCT-NUM.
SELECT MAST2-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-1\OVERDUE2.IND.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD MAST-FILE
LABEL RECORDS ARE STANDARD.
01 MAST-RECORD.
05 M-ACCT-NUM PIC X(4).
05 M-CUSTOMER-NAME PIC X(15).
05 M-DAYS-OVERDUE PIC 99.
05 M-BALANCE-DUE PIC 999V99.
FD MAST2-FILE
LABEL RECORDS ARE STANDARD.
01 MAST2-RECORD PIC X(50).
WORKING-STORAGE SECTION.
01 COUNTER PIC 9.
01 PROGRAM-DATA-ITEMS.
05 WRITE-OK PIC X VALUE 'Y'.
PROCEDURE DIVISION.
10-MAINLINE.
OPEN OUTPUT MAST-FILE
OUTPUT MAST2-FILE
PERFORM 20-LOAD-MAST-FILE
CLOSE MAST-FILE
MAST2-FILE
STOP RUN.
20-LOAD-MAST-FILE.
PERFORM 30-INPUT-INDEX
PERFORM UNTIL M-ACCT-NUM = 0 OR WRITE-OK = 'N'
PERFORM 40-WRITE-FILE
PERFORM 50-FIND-CUSTOMER-START-WITH-M
PERFORM 30-INPUT-INDEX
END-PERFORM.
30-INPUT-INDEX.
DISPLAY 'ENTER ACCOUNT NUMBER (0 TO QUIT): ' WITH NO ADVANCING
ACCEPT M-ACCT-NUM.
40-WRITE-FILE.
DISPLAY ' ENTER CUSTOMER NAME: ' WITH NO ADVANCING
ACCEPT M-CUSTOMER-NAME
DISPLAY ' ENTER DAYS OVERDUE: ' WITH NO ADVANCING
ACCEPT M-DAYS-OVERDUE
DISPLAY ' ENTER BALANCE DUE: ' WITH NO ADVANCING
ACCEPT M-BALANCE-DUE
WRITE MAST-RECORD
INVALID KEY
MOVE 'N' TO WRITE-OK
DISPLAY 'ERROR ' MAST-RECORD
END-WRITE.
50-FIND-CUSTOMER-START-WITH-M.
MOVE 0 TO COUNTER
INSPECT MAST-RECORD TALLYING COUNTER FOR ALL ' M '
IF COUNTER > 0
WRITE MAST2-RECORD
END-IF.
end program Program1.
You are looking for blank-M-blank, across the entire record.
What you say you want to do is fine customer-names which begin with M.
05 M-CUSTOMER-NAME.
10 M-CUSTOMER-NAME-FIST-CHARACTER PIC X.
88 M-CUSTOMER-NAME-START-M VALUE "M".
If you use that definition in place of what you have, and use the 88 in the test for your write, you should get what you want.
Eg replace:
50-FIND-CUSTOMER-START-WITH-M.
MOVE 0 TO COUNTER
INSPECT MAST-RECORD TALLYING COUNTER FOR ALL ' M '
IF COUNTER > 0
WRITE MAST2-RECORD
END-IF.
By:
50-FIND-CUSTOMER-START-WITH-M.
IF M-CUSTOMER-NAME-START-M
WRITE MAST2-RECORD
END-IF
.
Simpler, easier to understand, so easier to maintain.
You should consider the possible "validity" of your names. In a good system, there will be no leading blanks. In a poor system there may be.
To deal with that, test the first byte of the customer-name for being space as well, if so, test the customer-name for entirely space. If not entirely space, loop until you find the first non-blank. Test that first non-blank for M. So in this case you have two tests.
You can assess the quality of your data separately by copying and cutting-down this program and reporting/outputting where the first byte of the customer-name is blank.
Once you know that, you go to the analyst (tutor) and ask if you need to deal with possible leading blanks. If you don't, keep the test for blank in your actual program, and crash in that case :-)
I have the code,
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLE3.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT EMP-SALARY ASSIGN TO 'input.txt'
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD EMP-SALARY.
01 NEWFILE.
05 FS-EMPNO PIC 9(6).
05 FS-NAME PIC 9(4).
05 FILLER PIC X(63).
WORKING-STORAGE SECTION.
01 WS-EOF PIC A(1) VALUE "N".
PROCEDURE DIVISION.
MAIN-PARA.
OPEN I-O EMP-SALARY
PERFORM READ-PARA THRU READ-PARA-EXIT UNTIL WS-EOF="Y"
STOP RUN.
MAIN-PARA-EXIT.
EXIT.
READ-PARA.
READ EMP-SALARY
AT END
MOVE "Y" TO WS-EOF
NOT AT END
IF FS-EMPNO > 10000
MOVE '1000' TO FS-NAME
REWRITE NEWFILE
DISPLAY " RECORD " NEWFILE
END-IF
END-READ.
READ-PARA-EXIT.
EXIT.
I got the error read statement should be executed first Status=43, and implicit close of file.
This program is to rewrite a record in a file. what is the reason for this error.
It is best to include FILE STATUS processing for any files you use in a program, and always test the value after an IO.
If that is the code you are running, you must have an OPEN failing, a READ failing, and the REWRITE deciding that it just can't go on. Check that it is the code that you are running.
Can you show the version of GnuCOBOL you are running, and the OS you are running on, include the FILE STATUS in your program and test the values, and also include an explicit CLOSE of your file, which is always good practice.
See if structuring your program like this simplifies:
PROCEDURE DIVISION.
OPEN I-O EMP-SALARY
* do file status checking here
PERFORM READ-PARA
PERFORM PROCESS-PARA UNTIL END-OF-INPUT-FILE
* END-OF-INPUT-FILE (make the name relevant to your file) is an 88 on the FILE STATUS
* filed for that file
* close the file
* do file status checking here
STOP RUN
.
READ-PARA.
READ EMP-SALARY
* do file status checking here
PROCESS-PARA.
IF FS-EMPNO > 10000
MOVE '1000' TO FS-NAME
PERFORM UPDATE-RECORD
END-IF
PERFORM READ-PARA
.
UPDATE-RECORD.
REWRITE NEWFILE
* do file status checking here
DISPLAY " RECORD " NEWFILE
.