I am a beginner in COBOL and I am having a little error. When I do a simple statement like ACCEPT (variable) FROM ESCAPE KEY, the program doesn't react to the esc key. I understand that something needs to be done with the compiler but I'm not too sure. I use OpenCobolIDE. Does anyone know what's wrong?
I've searched everywhere but can't find an answer. I leave my Cobol code here although it is very simple.It is basically a menu in Spanish (my native language) in which if you press esc the program will end.
ID DIVISION.
PROGRAM-ID. ALUMAIN.
* Menu principal de la aplicación. ALUMAIN.CBL
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 OK PIC X.
77 ESC PIC 99.
88 SALIDA VALUE 27.
PROCEDURE DIVISION.
XXX.
PERFORM UNTIL SALIDA OR OK = "S" OR OK = "s"
DISPLAY "SISTEMA DE ALUMNOS" LINE 1 POSITION 31
ERASE SCREEN
"A ALTAS" LINE 8 POSITION 33
"B BAJAS" LINE 10 POSITION 33
"M MODIFICACIONES" LINE 12 POSITION 33
"C CONSULTAS" LINE 14 POSITION 33
"L LISTADO" LINE 16 POSITION 33
"S SALIR (ESC)" LINE 18 POSITION 33
MOVE 0 TO ESC
ACCEPT OK LINE 25 POSITION 79
ACCEPT ESC FROM ESCAPE KEY
IF OK = "A" OR OK = "a"
CALL "ALUALTAS"
END-IF
IF OK = "B" OR OK = "b"
CALL "ALUBAJA"
END-IF
IF OK = "C" OR OK = "c"
CALL "ALUMNOS"
END-IF
IF OK = "M" OR OK = "m"
CALL "ALUMODI"
END-IF
IF OK = "L" OR OK = "l"
CALL "ALUMLIST"
END-IF
END-PERFORM
STOP RUN.
You very likely would have to go to the runtime settings, enable "run in external terminal" as well as adding the settings COB_SCREEN_EXCEPTIONS=Y and COB_SCREEN_ESC=Y there or do so in the code.
As OCIDE is not maintained any more you likely want to setup a custom compiler to update from the obsolete GnuCOBOL 1.1 or switch to Gix-IDE in general.
Related
I was practicing array processing and table handling and there's this output of my program that I don't understand.
01 TABLE-VALUES.
05 TABLE-ELEMENTS OCCURS 2 TIMES.
10 A-A PIC X(5).
10 A-B PIC S9(5)V99 COMP-3.
01 WS-STRING PIC X(10).
01 S PIC 99.
01 WS-COUNT PIC 99.
...
PROCEDURE DIVISION.
0000-MAIN.
DISPLAY 'HELLO WORLD'
MOVE '1234567890ABCDEFGHI' TO TABLE-VALUES
DISPLAY 'TABLE VALUES ' TABLE-VALUES
MOVE 0 TO WS-COUNT
INSPECT TABLE-VALUES TALLYING WS-COUNT FOR CHARACTERS
DISPLAY WS-COUNT
PERFORM 1000-PARA VARYING S FROM 1 BY 1 UNTIL S > 2
STOP RUN.
1000-PARA.
MOVE 'A-A(&&) = ' TO WS-STRING
INSPECT WS-STRING REPLACING FIRST '&&' BY S
DISPLAY WS-STRING A-A(S)
MOVE 'A-B(&&) = ' TO WS-STRING
INSPECT WS-STRING REPLACING FIRST '&&' BY S
DISPLAY WS-STRING A-B(S).
The output turned out to be:
HELLO WORLD
TABLE VALUES 1234567890ABCDEFGHI
18
A-A(01) = 12345
A-B(01) = 6 7 8
A-A(02) = 0ABCD
A-B(02) = 5 6 7
I don't understand how A-B(1) and A-B(2) turned out like that. Why are there spaces in between? Where did digit 9 go to?
Try removing the COMP-3 from the A-B definition, it should work better.
Cobol comp-3
Comp-3 is cobol's binary coded decimal format. Each 4 bytes (1/2 byte or nyble) represents a decimal digit with the sign held in the last digit. Moving a character string to a comp-3 value (like you do) will result in a invalid comp-3 value.
Normally the value 1234 would be stored as
`01234C`x
In your case (if using an EBCDIC machine) you are moving 6789 hex string 'f6f7f8f9'x
to the variable A-B(01). The F's are not valid decimal digits and 9 is not a valid comp-3 sign.
Move to Table Explanation
Explanation of
MOVE '1234567890ABCDEFGHI' TO TABLE-VALUES
in the above TABLE-VALUES is treated as a pic x(18). The move completely ignores the definitions of A-A and A-B.
Assuming a definition of
01 TABLE-VALUES.
05 TABLE-ELEMENTS OCCURS 2 TIMES.
10 A-A PIC X(5).
10 A-B PIC S9(5)V99.
The following would make more sense
MOVE 'A-A 100234567A-A 200234567' TO TABLE-VALUES
When doing a move to a group level, The string has to exactly match the
map of the fields in the Group.
For the above Cobol Layout, the fields are aligned like
Field Position Length
A-A(1) 1 5
A-B(1) 6 7
A-A(2) 13 5
A-B(2) 18 7
I don’t know which compiler and directives you are using, but I would have expected the original DISPLAY of the comp-3 usage to ABEND with a numeric exception.
As for the follow up question about the letters in the numeric field, you valued the field by moving a literal to a group item, TABLE-VALUES. Group items always are USAGE ALPHANUMERIC.
As the title implies, I'm doing a software that calculate and verify if the number inserted is a happy number (OR NOT). In COBOL language (For reference about what a happy number is https://mathworld.wolfram.com/HappyNumber.html).
Right now, my code doesnt calculate correctly if the number is happy or not (In the program HEY = Happy and HOY = not happy :C)
My question is, what am i doing wrong in the code? All i need now is to properly detect if its happy or not. Any help is well welcome.
This is my current code:
IDENTIFICATION DIVISION.
PROGRAM-ID. YOUR-PROGRAM-NAME.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 num PIC 9(36).
01 addc PIC 9(36).
01 rem PIC 9(36).
01 pow PIC 9(36).
01 toast PIC 9.
01 k PIC 999 VALUE 0.
01 l PIC 9(36).
PROCEDURE DIVISION.
MAIN-PROCEDURE.
DISPLAY"Escribe numero "
ACCEPT num
PERFORM WITH TEST AFTER UNTIL addc = 1
MOVE 0 TO addc
PERFORM WITH TEST AFTER UNTIL num = 0
DIVIDE num BY 10 GIVING num REMAINDER rem
MULTIPLY rem BY rem GIVING pow
MOVE pow TO addc
END-PERFORM
IF addc = 1
MOVE 1 TO toast
ELSE
MOVE addc TO num
ADD 1 TO k
IF k = 20
MOVE 1 TO addc
MOVE 0 TO toast
END-IF
END-IF
END-PERFORM
IF toast = 1
DISPLAY "HEY"
ELSE
DISPLAY "HOY"
END-IF
STOP RUN.
END PROGRAM YOUR-PROGRAM-NAME.
Also, as an extra question, how can i handle numbers above the maximum limit of 36? without using the equivalent of strings and chars in Cobol.
The line:
PERFORM UNTIL num > 0
makes the PERFORM loop to not enter, as num is likely to be greater than 0. What you want to do is to execute the loop, getting all the digits from num UNTIL num is 0.
Besides,
MOVE pow TO addc
should be
ADD pow TO addc
Is there a kind of "Wait" function in COBOL?
I wrote a calculator, and to make it more 50s, i Print " Computing." "Computing.." ecc
For example:
DISPLAY "SECONDO NUMERO"
ACCEPT B
COMPUTE C= A * B
DISPLAY "Computing"
DISPLAY "Computing."
DISPLAY "Computing.."
DISPLAY "Computing..."
DISPLAY "Computing...."
DISPLAY "Computing....."
DISPLAY "Computing......"
DISPLAY A "x" B " FA..."
DISPLAY C
Now, is there a way to make a little delay (half a second) on COBOL where I put the "Computing" piece? I created a github repo (https://github.com/aIDserse/Super-utility-Submachine-COBOL-CALCULATOR) to this project, look at it (refer to version 1.3) for the complete code (and maybye spread it hahah). Thx!!!
There is a statement for sleeping in standard COBOL, but only with COBOL 202x:
CONTINUE AFTER arithmetic-expression SECONDS
As this standard is in the committee draft state it is hard to find an implementation, but as you've asked for GnuCOBOL - GnuCOBOL 3.1 already implements it.
Other than this there are some dialect specific library routines that can be used, like CALL "C$SLEEP" originating from ACUCOBOL-GT (also implemented with GnuCOBOL, but be aware that pre 3.1-versions only use the non-decimal part, so "0.9" will sleep zero seconds).
For OpenCOBOL/GnuCOBOL you can call the CBL_OC_NANOSLEEP/CBL_GC_NANOSLEEP library routines.
For any COBOL environment that can call native routines you have variants of CALL "sleep".
As mentioned by Rick Smith Many COBOL implementations also implement a callable SYSTEM where you may use something like a ping localhost with a timeout, but whatever you call may not be available (or the process running the COBOL environment has no access to it).
Stephen Gennard mentioned a very common extension:
ACCEPT something WITH TIMEOUT
which has a "beware" that different environments use a different scale (some seconds, some milliseconds). This has the pro/con that the user can "break" out by pressing a key (normally a function key); and the additional issue that it may only work in "graphical" environments.
Anton's answer highlights the IBM library routine CEE3DLY.
There's no wait statement in any ISO Standard COBOL.
However, if you got built in system routines available either C$SLEEP (for seconds) or CBL_GC_NANOSLEEP (for nanoseconds) should do the trick.
Example (sleeps for half a second):
call "CBL_GC_NANOSLEEP" using "500000000" end-call
For IBM's Enterprise COBOL (LE enabled) the CEE3DLY routine is most suitable (there are also other legacy routines available).
For GnuCobol call the C$SLEEP with the number of seconds you want to wait.
CALL "C$SLEEP" USING 2 END-CALL
COBOL has no build in language feature to handle waiting. This is a system specific request and I believe always requires calling an external module to interface with said system.
There is no wait or delay statement in standard COBOL. There may be, for GnuCOBOL, a CALL "SYSTEM" to effect a delay.
I took some code that I use for elapsed time measurement and modified the code to create a procedure for a delay.
Wherever you need a delay, insert the statement PERFORM timed-delay. Of course, the delay may be changed. This code is set to work even if the delay crosses midnight.
Code:
working-storage section.
01 t pic 9(8).
01 t-start.
03 t-start-hour pic 99.
03 t-start-minute pic 99.
03 t-start-second pic 99v99.
01 t-end.
03 t-end-hour pic 99.
03 t-end-minute pic 99.
03 t-end-second pic 99v99.
77 t-elapsed pic 9(7)v99.
procedure division.
begin.
accept t from time
display t
perform timed-delay
accept t from time
display t
stop run
.
timed-delay.
accept t-start from time
move 0 to t-elapsed
perform until t-elapsed > 0.5 *> one-half second
accept t-end from time
perform get-elapsed
end-perform
.
get-elapsed.
if t-start > t-end
move 86400 to t-elapsed
else
move 0 to t-elapsed
end-if
compute t-elapsed = t-elapsed
+ (t-end-hour - t-start-hour) * 3600
+ (t-end-minute - t-start-minute) * 60
+ (t-end-second - t-start-second)
end-compute
.
Output: (shows a delay of 0.55 seconds)
21424364
21424419
The initial PERFORM WITH TEST AFTER ... is nothing like the code I provided in: Cobol-Restart from the program , so I turned it into comments. It should be removed.
If you want to use SLEEP-SEC instead of a fixed value, replace the 0.5 with SLEEP-SEC; but provide a VALUE clause for SLEEP-SEC or MOVE a value to it before the displaying the menu.
For example, in your code (with most code removed):
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SLEEP-SEC PIC S9(2)V9(2).
01 A PIC S9(7)V9(7).
01 B PIC S9(7)V9(7).
01 C PIC S9(7)V9(7).
01 D PIC S9(11)V9(7).
01 INPUT1 PIC 9(14).
01 Q PIC X VALUE "Y".
01 t-start.
03 t-start-hour pic 99.
03 t-start-minute pic 99.
03 t-start-second pic 99v99.
01 t-end.
03 t-end-hour pic 99.
03 t-end-minute pic 99.
03 t-end-second pic 99v99.
77 t-elapsed pic 9(7)v99.
PROCEDURE DIVISION.
MAIN.
* PERFORM WITH TEST AFTER
* UNTIL Q ="YES" OR "Y" OR "y" OR "yes" OR "Yes"
* END-PERFORM.
DISPLAY "CALCULATOR".
DISPLAY "WHAT DO YOU WANT DO DO?".
DISPLAY "1 ADDITION".
DISPLAY "15 EXIT"
DISPLAY "CHOOSE AN OPTION"
ACCEPT INPUT1
EVALUATE INPUT1
WHEN = 15
DISPLAY "OK, GOOD JOB :)"
STOP RUN
WHEN = 1
DISPLAY "FIRST NUMBER"
ACCEPT A
DISPLAY "SECOND NUMBER"
ACCEPT B
COMPUTE C= A + B
DISPLAY "Computing"
PERFORM timed-delay
DISPLAY "(" A ")" "+" "(" B ")" "RESULTS..."
DISPLAY C
END-EVALUATE
IF INPUT1 NOT = 15
DISPLAY "DO YOU WANT TO DO OTHER CALCULATIONS?"
ACCEPT Q
IF Q = "YES" OR "Y" OR "y" OR "yes" OR "Yes" GO TO MAIN
ELSE DISPLAY "OK, GOOD JOB :)"
END-IF
STOP RUN.
timed-delay.
accept t-start from time
move 0 to t-elapsed
perform until t-elapsed > 0.5 *> one-half second
accept t-end from time
perform get-elapsed
end-perform
.
get-elapsed.
if t-start > t-end
move 86400 to t-elapsed
else
move 0 to t-elapsed
end-if
compute t-elapsed = t-elapsed
+ (t-end-hour - t-start-hour) * 3600
+ (t-end-minute - t-start-minute) * 60
+ (t-end-second - t-start-second)
end-compute
.
With Microsoft COBOL Compiler version 2.2 and I have this code that completely worked fine.
IDENTIFICATION DIVISION.
PROGRAM-ID. COCENTRY.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT COC-FILE
ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS COCNO
FILE STATUS IS FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD COC-FILE LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "COC.DAT".
01 COC-RECORD.
03 COCNO PIC 9(5).
03 COCDESC PIC X(40).
WORKING-STORAGE SECTION.
01 FILE-STATUS PIC XX.
01 ESC-CODE PIC 99 VALUE 0.
88 ESC-KEY VALUE 1.
88 F2 VALUE 3.
88 F10 VALUE 11.
01 ERRMSG PIC X(70) VALUE SPACES.
01 ERR PIC 9 VALUE 0.
SCREEN SECTION.
01 FORM1.
03 BLANK SCREEN BACKGROUND-COLOR 1.
03 LINE 1 COLUMN 1 'COCNO'.
03 LINE 2 COLUMN 1 'COCDESC'.
03 LINE 24 COLUMN 1 "Esc=Exit F2=Save F10=Cancel".
03 LINE 25 COLUMN 1 PIC X(70) FROM ERRMSG HIGHLIGHT.
01 FORM2.
03 LINE 1 COLUMN 14 PIC 9(5)
USING COCNO REVERSE-VIDEO.
03 LINE 2 COLUMN 14 PIC X(40)
USING COCDESC REVERSE-VIDEO.
03 LINE 24 COLUMN 1 PIC 99
USING ESC-CODE.
PROCEDURE DIVISION.
MAIN.
OPEN I-O COC-FILE.
IF FILE-STATUS NOT = '00'
OPEN OUTPUT COC-FILE
CLOSE COC-FILE
OPEN I-O COC-FILE.
PERFORM ENTRY1 THRU ENTRYX UNTIL ESC-KEY.
CLOSE COC-FILE.
STOP RUN.
ENTRY1.
MOVE SPACES TO COC-RECORD.
MOVE ZEROES TO COCNO.
ENTRY2.
DISPLAY FORM1 FORM2.
ACCEPT FORM2.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF F10
MOVE 'Entries canceled...' TO ERRMSG
GO ENTRY1
ELSE IF F2
GO ENTRY3
ELSE IF ESC-KEY
GO ENTRYX
ELSE
GO ENTRY2.
ENTRY3.
MOVE 0 TO ERR.
WRITE COC-RECORD INVALID KEY MOVE 1 TO ERR.
IF ERR = 1
MOVE 'Duplicate key not allowed...' TO ERRMSG
GO ENTRY2
ELSE
MOVE 'Entries recorded...' TO ERRMSG
GO ENTRY1.
ENTRYX.
EXIT.
Now I am using OpenCobol IDE 4.3.0 having GNUCobol version 1.1.0 and I am being prompted with this lines of
syntax error, unexpected "Literal", expecting LEADING or TRAILING
03 LINE 1 COLUMN 1 'COCNO'.
03 LINE 2 COLUMN 1 'COCDESC'.
03 LINE 24 COLUMN 1 "Esc=Exit F2=Save F10=Cancel".
So I fix them by adding VALUE keyword:
03 LINE 1 COLUMN 1 VALUE 'COCNO'.
03 LINE 2 COLUMN 1 VALUE 'COCDESC'.
03 LINE 24 COLUMN 1 VALUE "Esc=Exit F2=Save F10=Cancel".
but as soon as I do this I get a another prompt of
'ACCEPT .. FROM ESCAPE KEY' not implemented
on this line
ACCEPT ESC-CODE FROM ESCAPE KEY.
What could be the possible cause of this? And what could be the fix for this?
Your actual answer is here, https://sourceforge.net/p/open-cobol/discussion/help/thread/26a01c5f/, on the GnuCOBOL part of SourceForge. With minor changes your code will "completely work" with the change you've already made to include the VALUE clause, and if you use release 2.0 or higher of the GnuCOBOL compiler.
Your code may "completely work" but it is spaghetti code.
The term comes from the old days, and relates to the use of many branches in programs, a common practice at that time, but which made trying to follow the logic a process like trying to follow one strand of cooked spaghetti which is part of a pile of cooked spaghetti.
If you change this:
PERFORM ENTRY1 THRU ENTRYX UNTIL ESC-KEY.
To this:
PERFORM ENTRY1 THRU ENTRYX.
Your program will still work. Confused? Yes, because you have spaghetti. Your program flow will only ever get to ENTRYX once. The value when it arrives at ENTRYX is ESC-KEY, but that is superfluous, because it can only ever get there once, when it is ESC-KEY. Clear? No? Because you have spaghetti.
Here is your logic, re-written:
PROCEDURE DIVISION.
OPEN I-O COC-FILE
IF FILE-STATUS NOT = '00'
[the following code is a horror. Deal with this outside the
program. Crash for an unexpected FILE STATUS on OPEN]
OPEN OUTPUT COC-FILE
CLOSE COC-FILE
OPEN I-O COC-FILE
END-IF
PERFORM PROCESS-USER-INPUT
UNTIL ESC-KEY
CLOSE COC-FILE
IF FILE-STATUS NOT = '00'
[something bad has happened, so don't go quietly]
END-IF
GOBACK
.
PROCESS-USER-INPUT.
PERFORM BLANK-OUTPUT-RECORD
PERFORM PROCESS-COC
UNTIL ESC-KEY
.
PROCESS-COC.
DISPLAY FORM1 FORM2
ACCEPT FORM2
ACCEPT ESC-CODE FROM ESCAPE KEY
EVALUATE TRUE
WHEN F10
MOVE 'Entries canceled...' TO ERRMSG
WHEN F2
PERFORM CREATE-OUTPUT
END-EVALUATE
.
CREATE-OUTPUT.
WRITE COC-RECORD
IF ATTEMPT-TO-WRITE-DUPLICATE [22 on the FILE STATUS field]
MOVE 'Duplicate key not allowed...' TO ERRMSG
ELSE
MOVE 'Entries recorded...' TO ERRMSG
PERFORM BLANK-OUTPUT-RECORD
END-IF
.
BLANK-OUTPUT-RECORD.
MOVE SPACES TO COC-RECORD
MOVE ZEROES TO COCNO
.
Does that make your program look simpler? Easier to follow, change, understand what it does when someone else looks at it (or when you do in two weeks time)?
There are other things, like why set COC-RECORD to space, and then COCNO to zero? Move the spaces to COCDESC.
Make your data/procedure names good and descriptive. FILE STATUS having a good name (don't call it FILE-STATUS) and one per file when you have more than one file. Use full-stops/periods only where you have to, and use scope-delimiters for all conditional constructs that you use. Use FILE STATUS checking for all IO, and don't use the tortuous AT on IO.
If you look now the first code in your program is quite long, executes only once, and is (should be) irrelevant to the business function of your program. So stick all that in a paragraph, and PERFORM that. Same for the close. Then you can have as much code as you need when starting up and closing down, without making your program more difficult to follow.
The screen and keyboard I/O was a MicroSoft Cobol specific flavor. You will likely need to tweak that a bit to make it work with OpenCobol.
PROCEDURE DIVISION.
SET ENVIRONMENT 'COB_SCREEN_EXCEPTIONS' TO 'Y'.
SET ENVIRONMENT 'COB_SCREEN_ESC' TO 'Y'.
Escape: IF cob-crt-status = 2005......
Enter: IF cob-crt-status = 0........
F1: IF cob-crt-status = 1001......
F2: IF cob-crt-status = 1002......
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 :-)