Cobol, Code 65 File Locked - cobol

I am trying to access the same file to do two certain tasks. The first task is to update, add, and delete records. Access has to be random. The second task is to display all records on console. Access has to be sequential. I receive code 65 File locked from COBOL because the program is trying to access the same file twice the same time. Is there any way to fix this error? Or is there an different way to do this? Or do I have to write a separate program to display the record on console? I am stuck!
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MAST-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-5\SALES.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY M-SALESPERSON-NUM.
SELECT MAST2-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-5\SALES.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS SEQUENTIAL
RECORD KEY M2-SALESPERSON-NUM.
DATA DIVISION.
FILE SECTION.
FD MAST-FILE
LABEL RECORDS ARE STANDARD.
01 MAST-RECORD.
05 M-SALESPERSON-NUM PIC XXX.
05 M-CUSTOMER-NAME PIC X(15).
05 M-TOTAL-SALES PIC 9(5)V99.
05 M-COST-OF-SALES PIC 9(4)V99.
FD MAST2-FILE
LABEL RECORDS ARE STANDARD.
01 MAST2-RECORD.
05 M2-SALESPERSON-NUM PIC X(3).
05 M2-SALESPERSON-NAME PIC X(15).
05 M2-TOTAL-SALES PIC 9(5)V99.
05 M2-COST-OF-SALES PIC 9(4)V99.
WORKING-STORAGE SECTION.
01 SALES-DATA.
05 SALESPERSON-NUM PIC X(3).
05 SALESPERSON-NAME PIC X(15).
05 TOTAL-SALES PIC 9(5)V99.
05 COST-OF-SALES PIC 9(4)V99.
01 OUTPUT-RECORD.
05 PIC X(1) VALUE SPACES.
05 O-SALESPERSON-NUM PIC X(3).
05 PIC X(3) VALUE SPACES.
05 O-SALESPERSON-NAME PIC X(3).
05 PIC X(3) VALUE SPACES.
05 O-TOTAL-SALES PIC 9(5)V99.
05 PIC X(3) VALUE SPACES.
05 O-COST-OF-SALES PIC 9(4)V99.
01 PROGRAM-DATA-ITEMS.
05 I-SALESPERSON-NUM PIC XXX.
05 WAIT-OK PIC X.
05 CHOICE PIC 9 VALUE 0.
05 READ-OK PIC X.
05 REWRITE-OK PIC X.
05 DELETE-OK PIC X.
PROCEDURE DIVISION.
10-MAINLINE.
OPEN I-O MAST-FILE
OPEN INPUT MAST2-FILE
PERFORM 20-PROCESS-LOOP
CLOSE MAST-FILE
MAST2-FILE
STOP RUN.
20-PROCESS-LOOP.
PERFORM UNTIL CHOICE = 5
PERFORM 30-DISPLAY-MENU
EVALUATE CHOICE
WHEN 1
PERFORM 40-UPD-SALES
WHEN 2
PERFORM 90-ADD-SALES
WHEN 3
PERFORM 110-DELETE-SALES
WHEN 4
PERFORM 120-DISPLAY-SALES
END-EVALUATE
END-PERFORM.
30-DISPLAY-MENU.
DISPLAY 'SALES MAINTENANCE SYSTEM'
DISPLAY ' '
DISPLAY ' SELECT ONE:'
DISPLAY ' '
DISPLAY ' 1. UPDATE SALES RECORD'
DISPLAY ' 2. ADD SALES RECORD'
DISPLAY ' 3. DELETE SALES RECORD'
DISPLAY ' 4. DISPLAY SALES RECORD'
DISPLAY ' 5. QUIT'
DISPLAY ' '
DISPLAY 'ENTER CHOICE (1 - 5): ' WITH NO ADVANCING
ACCEPT CHOICE
PERFORM UNTIL CHOICE >= 1 AND <= 5
DISPLAY ' '
DISPLAY 'ERROR: ENTER CHOICE (1 - 5): ' WITH NO ADVANCING
ACCEPT CHOICE
END-PERFORM.
40-UPD-SALES.
DISPLAY 'UPDATE SALES: ENTER SALESPERSON NUMBER: ' WITH NO ADVANCING
ACCEPT SALESPERSON-NUM
MOVE SALESPERSON-NUM TO M-SALESPERSON-NUM
PERFORM 50-READ-RECORD
IF READ-OK = 'N'
DISPLAY 'RECORD DOES NOT EXIST - PRESS ENTER'
ACCEPT WAIT-OK
ELSE
DISPLAY SALES-DATA
PERFORM 100-INPUT-NEW-RECORD
PERFORM 60-REWRITE-RECORD
END-IF.
50-READ-RECORD.
MOVE 'Y' TO READ-OK
READ MAST-FILE INTO SALES-DATA
INVALID KEY
MOVE 'N' TO READ-OK
END-READ.
60-REWRITE-RECORD.
REWRITE MAST-RECORD FROM SALES-DATA
INVALID KEY
DISPLAY 'REWRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-REWRITE.
70-WRITE-RECORD.
MOVE 'Y' TO REWRITE-OK
WRITE MAST-RECORD FROM SALES-DATA
INVALID KEY
MOVE 'N' TO REWRITE-OK
END-WRITE
IF REWRITE-OK = 'N'
DISPLAY 'WRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF.
80-DELETE-RECORD.
MOVE 'Y' TO DELETE-OK
DELETE MAST-FILE
INVALID KEY
MOVE 'N' TO DELETE-OK
END-DELETE
IF REWRITE-OK = 'N'
DISPLAY 'WRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF.
90-ADD-SALES.
DISPLAY 'ADD SALES RECORD: ENTER SALESPERSON NUMBER: ' WITH NO ADVANCING
ACCEPT SALESPERSON-NUM
MOVE SALESPERSON-NUM TO M-SALESPERSON-NUM
PERFORM 50-READ-RECORD
IF READ-OK = 'Y'
DISPLAY 'RECORD ALREADY EXISTS - PRESS ENTER'
ACCEPT WAIT-OK
ELSE
PERFORM 100-INPUT-NEW-RECORD
PERFORM 70-WRITE-RECORD
IF REWRITE-OK = 'Y'
DISPLAY 'RECORD ' SALESPERSON-NUM ' ADDED TO FILE'
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF
END-IF.
100-INPUT-NEW-RECORD.
MOVE SALESPERSON-NUM TO M-SALESPERSON-NUM
DISPLAY ' ENTER SALESPERSON NAME: ' WITH NO ADVANCING
ACCEPT SALESPERSON-NAME
DISPLAY ' ENTER TOTAL SALES: ' WITH NO ADVANCING
ACCEPT TOTAL-SALES
DISPLAY ' ENTER COST OF SALES: ' WITH NO ADVANCING
ACCEPT COST-OF-SALES.
110-DELETE-SALES.
DISPLAY 'DELETE SALES RECORD: ENTER SALESPERSON NUMBER: ' WITH NO ADVANCING
ACCEPT SALESPERSON-NUM
MOVE SALESPERSON-NUM TO M-SALESPERSON-NUM
PERFORM 50-READ-RECORD
IF READ-OK = 'N'
DISPLAY 'RECORD DOES NOT EXIST - PRESS ENTER'
ACCEPT WAIT-OK
ELSE
PERFORM 80-DELETE-RECORD
IF DELETE-OK = 'Y'
DISPLAY 'RECORD DELETED - PRESS ENTER'
ACCEPT WAIT-OK
END-IF
END-IF.
120-DISPLAY-SALES.
MOVE SALESPERSON-NUM TO M2-SALESPERSON-NUM
MOVE SALESPERSON-NAME TO M2-SALESPERSON-NAME
MOVE TOTAL-SALES TO M2-TOTAL-SALES
MOVE COST-OF-SALES TO M2-COST-OF-SALES
READ MAST2-FILE
AT END MOVE HIGH-VALUES TO M2-SALESPERSON-NUM
END-READ
PERFORM UNTIL M2-SALESPERSON-NUM = HIGH-VALUES
MOVE M2-SALESPERSON-NUM TO O-SALESPERSON-NUM
MOVE M2-SALESPERSON-NAME TO O-SALESPERSON-NAME
MOVE M2-TOTAL-SALES TO O-TOTAL-SALES
MOVE M2-COST-OF-SALES TO O-COST-OF-SALES
DISPLAY OUTPUT-RECORD
READ MAST2-FILE
AT END MOVE HIGH-VALUES TO M2-SALESPERSON-NUM
END-READ
END-PERFORM.
end program Program1.

When you open a file I-O, that means you open it for Input and Output. Get rid of your second file.
To position your file for displaying the data, you can READ with a KEY and then READ ... NEXT ..., or you can use START ... and then READ ... NEXT.
Always use the FILE STATUS in the ASSIGN. Then use the file-status field you tell COBOL to put the file status in to, to check the previous IO. Use it for end-of-file (value of "10"). Use 88s. You don't then need the INVALID KEY and AT END and all the END- statements associated with IO can go, because you then don't have a built-in condition with the IO. Which will simplify things.
Your structure is very good for a beginner. Refreshing to see no PERFORM ... THRU ....
I'd suggest you try the effect of a single full-stop/period in column 12 on a line of its own. You'll then be able to move the last line of code from a paragraph without having to think about the full-stop/period attached to it (because it isn't attached to it).
Use more PERFORMs. OPEN and CLOSE are not vital to the logic of the program. Hide them away in paragraphs, do the FILE STATUS checking on them. Same with the READ/WRITE/DELETE and any other IO statements you end up with. Hide them in well-named procedures which you PERFORM.
Consider the size (number of lines) of some of your IFs. Put the code in a well-named procedure, and the code can be "read" at a high level by a human, with the detail only being looked at if needed.
Do not, do not, do not, mess around with two files. Do not, do not, do not OPEN the same file twice (I've written a few COBOL programs in my time, and I've never, ever, considered that a reasonable way to achieve anything, let alone the simple task you have).
You may want to consider DYNAMIC instead of RANDOM (this is what it is for). You use RANDOM if you are only doing random access. You actually want to do sequential access as well (look for references to skip-sequential access for further discussion).
SELECT MAST-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-5\SALES.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS RANDOMREWRITE-OK = 'N'
RECORD KEY M-SALESPERSON-NUM
FILE STATUS IS W-MAST-FILE-STATUS.
...
01 W-MAST-FILE-STATUS PIC XX.
88 W-MAST-FILE-LAST-IO-OK VALUE "00".
88 W-MAST-FILE-EOF VALUE "10".
88 W-MAST-FILE-REC-NOT-FOUND VALUE "23".
88 W-MAST-FILE-OR-OR-NOT-FOUND VALUE "00" "23".
...
50-READ-RECORD.
MOVE 'Y' TO READ-OK
READ MAST-FILE INTO SALES-DATA
INVALID KEY
MOVE 'N' TO READ-OK
END-READ.
Becomes:
50-READ-RECORD.
READ MAST-FILE KEY key-name INTO SALES-DATA
IF NOT ( W-MAST-FILE-OR-OR-NOT-FOUND )
some code to deal with the pickle, which is nothing to do with
business-logic, so hide it away
END-IF
.
80-DELETE-RECORD.
MOVE 'Y' TO DELETE-OK
DELETE MAST-FILE
INVALID KEY
MOVE 'N' TO DELETE-OK
END-DELETE
IF REWRITE-OK = 'N'
DISPLAY 'WRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF.
Becomes:
80-DELETE-RECORD.
DELETE MAST-FILE
IF NOT W-MAST-FILE-LAST-IO-OK
DISPLAY 'WRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF
.
Each IO paragraph becomes self-contained, self-verifying, and the FILE STATUS field naturally bears only good conditions when you are in your business logic. The "can't happen" (but will, one day) you deal with in these paragraphs.
You code elsewhere simplifies. Your number of "flags" is reduced (the value of the FILE STATUS field replaces the need for the flags) your IOs have no conditional part, so don't need the END- scope delimiter.
A tip about numbering paragraphs. Don't do it until you have tested sufficiently that you are happy with the structure of the logic. Once you are happy with that, rearrange the paragraphs so that the paragraph is always physically after the PERFORM of it. Then put the numbers on. The physical layout of your code then represents the structure of your program logic.
If you number first, you'll end up with the situation you have - you have numbers, but they infer nothing. It is much more tedious to "renumber" paragraphs than it is to add paragraph numbers where there were none (use the power of the editor/utilities available to you to do this numbering).

Related

COBOL error with numeric variable, not numeric

problem
I'm a beginner in COBOL and I'm running into this annoying problem which I can not find a solution for.
I want to add the value of the amount of sales to another numeric variable so that I can use it as a condition for a perform loop but when it tries to add that value to this new variable it triggers this error:
"libcob: PROG-PAGOS-F.cbl: 57: 'WS-CANTIDAD-VENTAS' not numeric: '2 '
WARNING - Implicit CLOSE of REG-VENDEDORES ('REG-MAESTRO.DAT')"
and I can not find a way around it; I'm stuck.
current code (not finished)
What this program is supposed to do is output data of employees' salary, sells, price of each sell into a file and then do some other operations with them but I can't do any progress because of this error, I'd love some help, and perhaps some advices to makes this code better. Thank you!
My variables are in Spanish because I'm Argentinian, sorry if it's hard to understand.
IDENTIFICATION DIVISION.
PROGRAM-ID. PROG-PAGOS-F.
AUTHOR. LUCAS GALEANO.
DATE-WRITTEN. 1/2/2023.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT REG-VENDEDORES ASSIGN TO "REG-MAESTRO.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT REG-VENTAS ASSIGN TO "REG-VENTAS-MAESTRO.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD REG-VENDEDORES.
01 VENDEDORES PIC 9(11).
FD REG-VENTAS.
01 COBRO-VENTAS PIC 9(5).
WORKING-STORAGE SECTION.
01 WS-VENDEDORES.
05 WS-EMPLEADO PIC 999.
05 WS-SUELDO-BASE PIC 9(5).
05 WS-CANTIDAD-VENTAS PIC 999.
77 WS-COBROS PIC 9(5).
77 WS-SUM-VENTAS PIC 99.
77 WS-CONTADOR PIC 99 VALUE ZEROS.
01 WS-TABLAS.
05 WS-REGISTRO-COBROS PIC 9(5)
OCCURS 100 TIMES.
PROCEDURE DIVISION.
BEGIN-OUTPUT.
OPEN OUTPUT REG-VENDEDORES.
DISPLAY "INGRESE DATOS SOLICITADOS".
PERFORM INGRESO-DATOS-EMPLEADOS.
PERFORM UNTIL WS-VENDEDORES EQUALS SPACES
WRITE VENDEDORES FROM WS-VENDEDORES
PERFORM INGRESO-DATOS-EMPLEADOS
END-PERFORM.
DISPLAY "INGRESE COBROS DE CADA VENTA:".
PERFORM INGRESO-VENTAS WITH TEST AFTER
UNTIL WS-CONTADOR EQUALS WS-SUM-VENTAS
MOVE WS-COBROS TO WS-REGISTRO-COBROS(1)
CLOSE REG-VENDEDORES.
STOP RUN.
INGRESO-DATOS-EMPLEADOS.
DISPLAY "EEE$$$$$VVV".
ACCEPT WS-VENDEDORES.
ADD WS-CANTIDAD-VENTAS TO WS-SUM-VENTAS.
INGRESO-VENTAS.
ADD 1 TO WS-CONTADOR.
DISPLAY "$$$$$".
ACCEPT WS-COBROS.
example input data
INGRESE DATOS SOLICITADOS
EEE$$$$$VVV
1 400002
There is no implicit conversion in ACCEPT data-item, so you need to convert - and validate it on your own (or switch to "extended" screenio with ACCEPT data-item AT / SCREEN SECTION, but then the result would be depending on the actual COBOL environment).
The easiest option to convert (will sip leading/trailing spaces and invalid data) is something like the following:
ACCEPT WS-VENDEDORES. *> all data may now be invalid
MOVE FUNCTION NUMVAL (WS-EMPLEADO) TO WS-EMPLEADO
MOVE FUNCTION NUMVAL (WS-SUELDO-BASE) TO WS-SUELDO-BASE
MOVE FUNCTION NUMVAL (WS-CANTIDAD-VENTAS) TO WS-CANTIDAD-VENTAS
*> all data is now valid
For validation you may want to use FUNCITON TEST-NUMVAL (data-to-verify).
In any case I'd suggest to check out SCREEN SECTION, as this would allow you to input the data in three separate fields and commonly would do validation and conversion "on the fly".

Cobol Programming Display Issue, Decimal Place in the output part of the program

Can someone please help me how to fix this kind of problem? The output part only displayed one decimal place even if I have inserted two decimal places in the input part.
I already tried all the possible thing that I could do but still it doesn't change.
Issue/Problem
I typed 1.25 to midterm grade and 1.75 to my final grade in the input part but the output part showed only 1.2 to my midterm grade and 1.7 to my final grade
Data definition
WORKING-STORAGE SECTION.
01 STUD-REC.
05 STUDNO PIC X(12).
05 STUDNA PIC X(20).
05 MIDGRD PIC 9V9(2).
05 FINGRD PIC 9V9(2).
05 EOF PIC A VALUE 'Y'.
01 REP-OUT.
05 FILLER PIC X(5).
05 STUDNUM PIC X(17).
05 FILLER PIC X(5).
05 STUDNAME PIC X(20).
05 FILLER PIC X(5).
05 MIDTRM GRD PIC 9.9(2).
05 FILLER PIC X(17).
05 FINALGRD PIC 9.9(2).
05 FILLER PIC X(5).
procedure code
INPUT-RTN.
DISPLAY SCR.
DISPLAY 'INPUT: ' AT LINE 1.
DISPLAY 'STUDENT NUMBER: ' AT LINE 2.
ACCEPT STUDNO AT LINE 2 COLUMN 18.
DISPLAY 'STUDENT NAME: ' AT LINE 3.
ACCEPT STUDNA AT LINE 3 COLUMN 18.
DISPLAY 'MIDTERM GRADE: ' AT LINE 4.
ACCEPT MIDGRD AT LINE 4 COLUMN 18.
DISPLAY 'FINAL GRADE: ' AT LINE 5.
ACCEPT FINGRD AT LINE 5 COLUMN 18.
MOVE STUDNO TO STUDNUM.
MOVE STUDNA TO STUDNAME.
MOVE MIDGRD TO MIDTRMGRD.
MOVE FINGRD TO FINALGRD.
DISPLAY 'OUTPUT: ' AT LINE 7.
DISPLAY 'STUDENT NUMBER: ' STUDNUM AT LINE 8.
DISPLAY 'STUDENT NAME: ' STUDNAME AT LINE 9.
DISPLAY 'MIDTERM GRADE: ' MIDTRMGRD AT LINE 10.
DISPLAY 'FINAL GRADE: ' FINALGRD AT LINE 11.
WRITE STUD-REP FROM REP-OUT.
DISPLAY 'INPUT AGAIN? [Y\N]: ' AT LINE 13.
ACCEPT EOF AT LINE 13 COLUMN 20.
The issue with the code is that it assumes there is some auto-conversion during ACCEPT, which may be true depending on the COBOL implementation and settings, but which isn't guaranteed - especially not outside of SCREEN SECTION.
The ACCEPT - as used - just provides some way to input "bytes" into some "storage" and your storage is 9V9(2) which means "3 bytes, assumed to be numeric, having an implied decimal point after the first place.
With the input "1.25" in there you may (depending on the implementation) place three bytes containing "1.2" into the storage.
The MOVE to an edited field 9.99 will do some "conversion" of the data and if the data stored is not valid to its PICTURE, then you get to undefined behavior.
You could test that by doing your input as plain numbers and see if your program then works "as expected".
In general it is always important to verify input data, and that is missing in your code.
I'd suggest to adjust the code doing something similar to:
ACCEPT PIC-X-5-VAR
*> verify that there was no bad data entered
*> if that's not available then either drop that part
*> or test manually via INSPECT
IF FUNCTION TEST-NUMVAL (PIC-X-5-VAR) <> 0
*> verify that there we're in the general bounds (TODO: adjust to your rules)
OR FUNCTION NUMVAL (PIC-X-5-VAR) <= 1
OR >= 6
DISPLAY "BAD INPUT".
*> now place the numeric value in there ...
MOVE NUMVAL (PIC-X-5-VAR) TO GRADE-VAR
*> ... and verify there was no truncation (input of "0.111")
IF GRADE-VAR NOT = NUMVAL (PIC-X-5-VAR)
DISPLAY "TRUNCATION ON INPUT".
all wrapped in an own INPUT-GRADE SECTION - with your code style in an own paragraph - that also does the ACCEPT and the goes back to the input after displaying the error.

Extract records by first letter of name

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 :-)

Issues with GO TO statement on execution past the first time

Having issues with using the GO-TO statement. This is suppose to run until the user types 'END'. If I type 'END' when I first open the program it will close out but if I type it after entering valid data for the first pass thru it just continues to bring back the user input data screen.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT USED-CAR-FILE-OUT
ASSIGN TO 'USED-CAR.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD USED-CAR-FILE-OUT.
01 USED-CAR-RECORD-OUT PIC X(80).
WORKING-STORAGE SECTION.
01 FIRST-RECORD PIC X(3) VALUE 'YES'.
01 ID-CODE PIC X(3).
01 TOTAL-CASH-PAYMENT PIC 9(5).
01 MONTHLY-PAYMENT PIC 9(4).
01 NUMBER-OF-MONTHS PIC 9(3).
01 TOTAL-BALANCE PIC S9(6)V99 VALUE ZEROS.
01 INTEREST-COLLECTED PIC 99V99 VALUE ZEROS.
01 MONTH-DIFF PIC 99 VALUE ZEROS.
01 MONTH-NUM PIC 99 VALUE ZEROS.
01 YEAR-NUM PIC 99 VALUE ZEROS.
01 ID-HOLD PIC X(3) VALUE SPACES.
01 PAYMENT-HOLD PIC X(3) VALUE SPACES.
01 DETAIL-LINE.
05 ID-CODE-DL PIC X(3).
05 PIC X(3) VALUE SPACES.
05 PIC X(4) VALUE 'Yr='.
05 YEAR-NUMBER-DL PIC Z9.
05 PIC X(4) VALUE SPACES.
05 PIC X(4) VALUE 'MO='.
05 MONTH-NUMBER-DL PIC Z9.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'Pmt='.
05 PAYMENT-DL PIC $$$,$$$.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'Int='.
05 INTEREST-EARNED-DL PIC $$$$.99.
05 PIC X(3) VALUE SPACES.
05 PIC X(5) VALUE 'Bal='.
05 BALANCE-DL PIC $$$,$$$.99.
PROCEDURE DIVISION.
100-MAIN.
OPEN OUTPUT USED-CAR-FILE-OUT
PERFORM 200-USER-INPUT THRU 299-EXIT
CLOSE USED-CAR-FILE-OUT
STOP RUN.
200-USER-INPUT.
DISPLAY 'Used Car Sales Report'
DISPLAY 'Enter the ID code (or END) - maxium three char.'
ACCEPT ID-CODE
IF ID-CODE = 'END'
GO TO 299-EXIT
END-IF
DISPLAY 'Enter the Total Cash Payment - maximum five digits'
ACCEPT TOTAL-CASH-PAYMENT
DISPLAY 'Enter the Monthly Payment - maximum four digits'
ACCEPT MONTHLY-PAYMENT
DISPLAY 'Enter the Number of Months - maximum three digits'
ACCEPT NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS.
299-EXIT.
EXIT.
300-RECORD-PROCESS.
IF TOTAL-CASH-PAYMENT > 0
IF FIRST-RECORD = 'YES'
MOVE ID-CODE TO ID-CODE-DL
MOVE 1 TO YEAR-NUMBER-DL
MOVE 1 TO YEAR-NUM
move 1 to MONTH-NUMBER-DL
MOVE TOTAL-CASH-PAYMENT TO PAYMENT-DL
MOVE PAYMENT-DL TO MONTHLY-PAYMENT
ADD MONTHLY-PAYMENT TO TOTAL-BALANCE
MOVE 'NO' TO FIRST-RECORD
END-IF
COMPUTE INTEREST-COLLECTED ROUNDED = TOTAL-BALANCE
* .0175 / 12
MOVE INTEREST-COLLECTED TO INTEREST-EARNED-DL
ADD INTEREST-COLLECTED TO TOTAL-BALANCE
MOVE TOTAL-BALANCE TO BALANCE-DL
ADD 1 TO MONTH-DIFF
MOVE MONTH-DIFF TO MONTH-NUMBER-DL
IF MONTH-NUMBER-DL > 13
ADD 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUMBER-DL = 13
MOVE 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUM = 1
ADD 1 TO YEAR-NUM
MOVE YEAR-NUM TO YEAR-NUMBER-DL
END-IF
MOVE DETAIL-LINE TO USED-CAR-RECORD-OUT
WRITE USED-CAR-RECORD-OUT
AFTER ADVANCING 1 LINE
MOVE ID-HOLD TO ID-CODE-DL
IF MONTH-DIFF < NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS
END-IF
PERORM 200-USER-INPUT
END-IF
IF MONTHLY-PAYMENT > 0
IF FIRST-RECORD = 'YES'
MOVE ID-CODE TO ID-CODE-DL
MOVE 1 TO YEAR-NUMBER-DL
MOVE 1 TO YEAR-NUM
move 1 to MONTH-NUMBER-DL
MOVE 'NO' TO FIRST-RECORD
END-IF
MOVE MONTHLY-PAYMENT TO PAYMENT-DL
MOVE PAYMENT-DL TO MONTHLY-PAYMENT
ADD MONTHLY-PAYMENT TO TOTAL-BALANCE
COMPUTE INTEREST-COLLECTED ROUNDED = TOTAL-BALANCE
* .0175 / 12
MOVE INTEREST-COLLECTED TO INTEREST-EARNED-DL
ADD INTEREST-COLLECTED TO TOTAL-BALANCE
MOVE TOTAL-BALANCE TO BALANCE-DL
ADD 1 TO MONTH-DIFF
MOVE MONTH-DIFF TO MONTH-NUMBER-DL
IF MONTH-NUMBER-DL > 13
ADD 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUMBER-DL = 13
MOVE 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUM = 1
ADD 1 TO YEAR-NUM
MOVE YEAR-NUM TO YEAR-NUMBER-DL
END-IF
MOVE DETAIL-LINE TO USED-CAR-RECORD-OUT
WRITE USED-CAR-RECORD-OUT
AFTER ADVANCING 1 LINE
MOVE ID-HOLD TO ID-CODE-DL
IF TOTAL-CASH-PAYMENT > 0
MOVE 0 TO TOTAL-CASH-PaYMENT
MOVE 0 TO PAYMENT-DL
END-IF
IF MONTH-DIFF < NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS
END-IF
PERFORM 200-USER-INPUT
END-IF.
EDIT solved the issue below
I also am having issues if months > 24. I step through the program and it shows my last detail line as the correct result but yet my output stops at 24 months. Thanks in advance.
AAAAAAAk!
PERFORM SEVERE-BEATING-ON-WHOEVER-MENTIONED-PERFORM-THROUGH
USING HEAVY-OBJECT
UNTIL PROMISE-EXTRACTED-TO-NEVER-DO-IT-AGAIN.
PERFORM THOUGH is EVIL. It causes layout-dependent code.
At the top control-level, use
PERFORM 200-USER-INPUT
UNTIL ID-CODE = 'END'.
(or possibly use 88 USER-INPUT-ENDED on ID-CODE - matter of style)
How you then determine whether to continue with input in 200-... is your choice, either
IF NOT USER-INPUT-ENDED
DISPLAY 'Enter the Total Cash Payment - maximum five digits'
ACCEPT TOTAL-CASH-PAYMENT
...
ACCEPT NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS.
OR
IF NOT USER-INPUT-ENDED
PERFORM 210-ACCEPT-DETAILS.
210-ACCEPT-DETAILS.
DISPLAY 'Enter the Total Cash Payment - maximum five digits'.
ACCEPT TOTAL-CASH-PAYMENT.
...
ACCEPT NUMBER-OF-MONTHS.
PERFORM 300-RECORD-PROCESS.
Since you PERFORMED 200-... then only 200-... will be executed; 210-... is a new paragraph which can only be reached from 200-... IF END is not entered.
Next step is to slightly modify 300-...
Move the initialisation ( FIRST-RECORD = 'YES' code) before the PERFORM 300-... in 200-... and then modify the PERFORM 300-RECORD-PROCESS. to
PERFORM 300-RECORD-PROCESS
UNTIL TOTAL-BALANCE = 0.
(I'm assuming here that this is the report-terination condition; if it isn't, substitute your report-termination condition)
You can now restructure 300-... to calculate the interest payable, modify the year and month numbers and show the result. ALL of the PERFORMs in 300-... will disappear.
So, in essence you have
MAIN:perform user-input until end-detected.
user-input: get user data; perform calculations until balance is zero.
calculations: one month's calculations at a time.
This also has the advantage that if you choose, you could insert
IF MONTHLY-PAYMENT IS LESS THAN INTEREST-COLLECTED
MOVE 'ERR' TO ID-CODE.
And use 'ERR' in ID-CODE to produce an appropriate error-message in 300-... instead of the progressive report lines AND at the same time assign 0 to TOTAL-BALANCE which terminates the PERFORM 300-... UNTIL ....
Your use of GO TO and PERFORM THROUGH paragraph ranges has corrupted the procedure return mechanism that COBOL
uses to maintain proper program flow of control. In essence, you have a program that is invalid - it might compile
without error but is still an invalid program according to the rules of COBOL.
Here is an outline of what your program is doing from a flow of control perspective. The
mainline program is essentially:
100-MAIN.
PERFORM 200-USER-INPUT THRU 299-EXIT
This is asking COBOL to execute all the code found from the beginning of
200-USER-INPUT through to the end of 299-EXIT. The outline for these
procedures is:
200-USER-INPUT.
IF some condition GO TO 299-EXIT
...
PERFORM 300-RECORD-PROCESS
.
299-EXIT.
Notice that if some condition is true, program flow will skip past the end
of 200-USER-INPUT and jump into 299-EXIT. 299-EXIT does not do anything
very interesting, it is just an empty paragraph serving as the end of a
PERFORMed range of paragraphs.
In paragraph 300-RECORD-PROCESS you have a fair bit of code. The interesting
bit is:
300-RECORD-PROCESS.
...
PERFORM 200-USER-INPUT
Notice that PERFORM 200-USER-INPUT this is not a PERFORM THRU, as you had coded in 100-MAIN.
The problem is that when you get back into 200-USER-INPUT and some codition becomes
true (as it will when you enter 'EXIT'), the flow of control
jumps to 299-EXIT which is past the end of the paragraph
you are currently performing. From this point
forward the flow of control mechanism used by COBOL to manage return from PERFORM verbs has
been corrupted. There is no longer a normal flow of control mechanism to return back to where 200-USER-INPUT
was performed from in 300-RECORD-PROCESS.
What happens next is not what most programmers would expect. Most programmers seem to expect
that when the end of 299-EXIT is reached program flow should return to wherever the last PERFORM
was done. In this case, just after PERFORM 200-USER-INPUT. No, COBOL doesn't work that way, flow of control
will continue with the next executable statement following 299-EXIT. This gets you
right back to the first executable statement in 300-RECORD-PROCESS! And that is why you
are not getting expected behaviour from this program.
Logic flow in COBOL programs must ensure that the end of performed procedures are
always reached in the reverse order from which they were made. This corresponds to the call/return
stack semantics that
most programmers are familiar with.
My advice to you is to avoid the use of PERFORM THRU and GO TO. These are two of the biggest
evils left in the COBOL programming language today. These constructs are hang-overs from a
bygone era of programming and have no constructive benefit today.
Your problem is that you have created an infinite loop for yourself. You 200- paragraph PERFORMs the 300- paragraph, and your 300- paragraph PERFORMS your 200- paragraph.
You need to restructure your program.
A paragraph called 200-USER-INPUT should just concern itself with that.
repeat until end of input
get some input
if there is input to process
process the input
Yoiks! I just noticed you also PERFORM 300- from within 300-!

Standard way to remove spaces from input in cobol?

I'm just learning COBOL; I'm writing a program that simply echos back user input. I have defined a variable as:
User-Input PIC X(30).
Later when I ACCEPT User-Input, then DISPLAY User-Input " plus some extra text", it has a bunch of spaces to fill the 30 characters. Is there a standard way (like Ruby's str.strip!) to remove the extra spaces?
One would hope for a more elegant way of simply trimming text strings
but this is pretty much the standard solution... The trimming part
is done in the SHOW-TEXT paragraph.
*************************************
* TRIM A STRING... THE HARD WAY...
*************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTX.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 USER-INPUT PIC X(30).
01 I PIC S9(4) BINARY.
PROCEDURE DIVISION.
MOVE SPACES TO USER-INPUT
PERFORM SHOW-TEXT
MOVE ' A B C' TO USER-INPUT
PERFORM SHOW-TEXT
MOVE 'USE ALL 30 CHARACTERS -------X' TO USER-INPUT
PERFORM SHOW-TEXT
GOBACK
.
SHOW-TEXT.
PERFORM VARYING I FROM LENGTH OF USER-INPUT BY -1
UNTIL I LESS THAN 1 OR USER-INPUT(I:1) NOT = ' '
END-PERFORM
IF I > ZERO
DISPLAY USER-INPUT(1:I) '# OTHER STUFF'
ELSE
DISPLAY '# OTHER STUFF'
END-IF
.
Produces the following output:
# OTHER STUFF
A B C# OTHER STUFF
USE ALL 30 CHARACTERS -------X# OTHER STUFF
Note that the PERFORM VARYING statement relies on the left to
right evaluation of the UNTIL clause to avoid out-of-bounds
subscripting on USER-INPUT in the case where it contains only
blank spaces.
Use OpenCOBOL 1.1 or greater.
Identification division.
Program-id. 'trimtest'.
*> Compile:
*> cobc -x -free -ffunctions-all TrimTest.cbl
*>
Data division.
Working-Storage Section.
1 myBigStr Pic X(32768) Value Spaces.
Procedure Division.
Display "Enter Something? " With no advancing.
Accept myBigStr.
Display "[" Trim(myBigStr) "]".
Goback.
The trim function also has the options; Leading or Trailing.
cobc -h formore info.
Here's a solution if you work on OpenVMS:
01 WS-STRING-LENGTH PIC S9(04) COMP.
CALL "STR$TRIM" USING BY DESCRIPTOR user_output,
user_input,
BY REFERENCE WS-STRING-LENGTH.
a more general solution:
01 length pic 99.
perform varying length from 1 by 1
until length > 30 or user-input[length] = space
end-perform.
if length > 30
display user-input 'plus some extra text'
else
display user-input[1:length] 'plus some extra text'
end-if.
untested, I don't have a compiler at hand at the moment
There are three ways you can do this.
Use the COBOL functions to determine the string's "length". This is a mix of a couple functions. This is my preferred method, but requires declaring extra variables.
Write your own function to get the "length".
Use knowledge of a "terminating" string. You have to know what key characters indicates an end-of-string, like three spaces or a low-value character.
This example code demonstrates all three.
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTPROG.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ONE-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 ONE-A-TLY PIC 9(02) VALUE ZERO.
01 ONE-A-LEN PIC 9(02) VALUE ZERO.
01 ONE-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 ONE-B-TLY PIC 9(02) VALUE ZERO.
01 ONE-B-LEN PIC 9(02) VALUE ZERO.
01 TWO-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 TWO-A-LEN PIC 9(02) VALUE ZERO.
01 TWO-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 TWO-B-LEN PIC 9(02) VALUE ZERO.
01 THREE-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 THREE-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 THREE-C PIC X(80) VALUE SPACES.
PROCEDURE DIVISION.
DISPLAY ' -- METHOD ONE -- '
INSPECT FUNCTION REVERSE(ONE-A)
TALLYING ONE-A-TLY FOR LEADING SPACES.
SUBTRACT ONE-A-TLY FROM LENGTH OF ONE-A GIVING ONE-A-LEN.
INSPECT FUNCTION REVERSE(ONE-B)
TALLYING ONE-B-TLY FOR LEADING SPACES.
SUBTRACT ONE-B-TLY FROM LENGTH OF ONE-A GIVING ONE-B-LEN.
DISPLAY ONE-A(1:ONE-A-LEN)
' ' ONE-B(1:ONE-B-LEN)
'.'.
DISPLAY ' -- METHOD TWO -- '
PERFORM VARYING TWO-A-LEN FROM LENGTH OF TWO-A BY -1
UNTIL TWO-A-LEN < 1 OR TWO-A(TWO-A-LEN:1) > SPACE
END-PERFORM.
PERFORM VARYING TWO-B-LEN FROM LENGTH OF TWO-B BY -1
UNTIL TWO-B-LEN < 1 OR TWO-B(TWO-B-LEN:1) > SPACE
END-PERFORM.
DISPLAY TWO-A(1:TWO-A-LEN)
' ' TWO-B(1:TWO-B-LEN)
'.'.
DISPLAY ' -- METHOD THREE, NAIVE -- '
* DELIMITING BY JUST ANY SPACES ISN'T GOOD ENOUGH.
STRING THREE-A DELIMITED BY SPACES
' ' DELIMITED BY SIZE
THREE-B DELIMITED BY SPACES
'.' DELIMITED BY SIZE
INTO THREE-C.
DISPLAY THREE-C.
DISPLAY ' -- METHOD THREE, OK -- '
STRING THREE-A DELIMITED BY ' '
' ' DELIMITED BY SIZE
THREE-B DELIMITED BY ' '
'.' DELIMITED BY SIZE
INTO THREE-C.
DISPLAY THREE-C.
EXIT-PROG.
STOP RUN.
and the output looks like this:
-- METHOD ONE --
RALPH WIGGAM LIKES LEARNDING.
-- METHOD TWO --
RALPH WIGGAM LIKES LEARNDING.
-- METHOD THREE, NAIVE --
RALPH LIKES.
-- METHOD THREE, OK --
RALPH WIGGAM LIKES LEARNDING.

Resources