How can I check Work-Trig to make sure that it is all digits?
code:
Work-Trig is --> 20140101
CHECK-TRIG.
IF WORK-TRIG IS NUMERIC THEN
MOVE "FALSE" TO ERR-TRIG
ELSE
MOVE "TRUE" TO ERR-TRIG
END-IF.
DISPLAY 'ERR-TRIG' ERR-TRIG.
X-CHECK. EXIT.
01 WORK-TRIG.
05 TRIG-YEAR PIC X(08) VALUE SPACES.
05 TRIG-MONTH PIC X(01) VALUE SPACES.
05 TRIG-DAY PIC X(01) VALUE SPACES.
05 FILLER PIC X(70) VALUE SPACES.
The problem is that WORK-TRIG is 80 bytes long. The first eight bytes contain your data, but the entire 80 bytes will be tested for being NUMERIC.
You have a data-name for the first eight bytes. If you test that instead of the group-item, your code will work.
CHECK-TRIG.
IF WORK-YEAR IS NUMERIC THEN
MOVE "FALSE" TO ERR-TRIG
ELSE
MOVE "TRUE" TO ERR-TRIG
END-IF.
DISPLAY 'ERR-YEAR' ERR-TRIG.
X-CHECK. EXIT.
If you have a data-name called WORK-YEAR, it should only contain a year. It should not contain an entire date. The point of good names for data is so that we, humans, can read and understand your code better. When looking for a problem, we find WORK-YEAR as eight bytes long, and have to spend time finding out if that is the correct length, or the correct name and a wrong length.
Given the code change, it would be good to use a different name for ERR-TRIG as well.
There are more obscure ways to test the first eight bytes of a group item, but since you already had a name, hopefully we'll keep reference-modification out of this one.
The following code example works and will check each position in you WORK-TRIG1 to see if that value is a NUMERIC. I tested this and it does work. This example uses a PERFORM VARYING loop to index through each "location" in the string to see if it is valid.
Should Work ALSO:
IF A IS NUMERIC THEN
//code here
END-IF
I do know that the below code works because I took it directly from a program that is running perfectly and has since 88 or 89.
Code:
CHECK-TRIG.
PERFORM VARYING SUB1 FROM 1 BY 1 UNTIL SUB1 > 8
IF WORK-TRIG(1:SUB1) IS NUMERIC THEN
MOVE 'FALSE' TO ERR-TRIG
ELSE
MOVE 'TRUE' TO ERR-TRIG
MOVE SUB1 TO SV-RTN-CODE
MOVE 9 TO SUB1
END-IF
END-PERFORM.
X-CHECK. EXIT.
--Code--New this does not work
PERFORM VARYING SUB1 FROM 1 BY 1 UNTIL SUB1 > 8
IF WORK-TRIG(SUB1:8) IS NUMERIC THEN
MOVE 'FALSE' TO ERR-TRIG
ELSE
MOVE 'TRUE' TO ERR-TRIG
MOVE SUB1 TO SV-RTN-CODE
MOVE ' TRIGGER CARD ERROR (SEE DATE BELOW)' TO
ERR-DET
MOVE 9 TO SUB1
END-IF
END-PERFORM.
Recently had experienced non-numeric being successfully processed into a numeric (COMP-3) field.
Value of 'FALSE99999999' moved into a COMP-3 field and became 6132599999999 and the program never encounter an S0C7 ABEND.
Looks like verifying each byte of the source field is the only way to identify such issue.
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.
I am trying to accept input from jcl for example 'John Snow' and run it from my cobol program Im using JUSTIFIED RIGHT VALUE SPACES to move the string to the right side however I need to delete the extra spaces using my cobol pgm.
example
my working storage is:
01 ALPHA-ITEM PIC X(50).
01 MOVE-ITEM REDEFINES ALPHA-ITEM PIC X(50).
01 NUM-ITEM PIC X(50) JUSTIFIED RIGHT VALUE SPACES.
and in my PROCEDURE DIVISION
ACCEPT ALPHA-ITEM.
MOVE MOVE-ITEM TO NUM-ITEM.
DISPLAY NUM-ITEM.
it displays 'John Snow' on the right of the screen however i don't know how to remove the extra spaces.
you need something like this:
01 ALPHA-ITEM PIC X(50).
01 WS-INDEX PIC 99.
ACCEPT ALPHA-ITEM
PERFORM VARYING WS-INDEX
FROM 50 BY -1
UNTIL ALPHA-ITEM(WS-INDEX:1) NOT EQUAL SPACE
OR WS-INDEX < 1
END-PERFORM
DISPLAY ALPHA-ITEM(1:WS-INDEX).
This code will accept the alpha item, then run a loop to find out how long the data actually is. Then it will display that field starting from position 1 until the counter that was set in the loop.
There is also.. Unpopular for some reason.
UNSTRING MOVE-ITEM DELIMITED BY SPACES INTO NUM-ITEM.
Record has name in this format:
01 LAST-NAME PIC X(18).
01 FIRST-NAME PIC X(12).
01 MI-NAME PIC X(01).
The last and first names can of course be any size when they come in.
I need to put the name fields together (with no trailing spaces - but with a SPACE between each name) into a single working storage field 42 spaces in length:
01 WS-FULL-NAME PIC X(42)
Example:
LAST-NAME = Smithington
FIRST-NAME = Edward
MI-NAME = H
Desired result:
Edward H Smithington
If Middle initial is blank I of course don't include it and desired result would be:
Edward Smithington
I have a routine to determine the actual length of each name field already that takes care of the trailing spaces (*I don't need to worry about leading spaces) (SEE BELOW):
01 W-SUB PIC 9(02) VALUE 0.
PROCESS-LAST-NAME.
PERFORM VARYING W-SUB FROM LENGTH OF LAST-NAME BY -1
UNTIL W-SUB LESS THAN 1
OR LAST-NAME(W-SUB:1) NOT = ' '
END-PERFORM
IF W-SUB > ZERO
MOVE LAST-NAME(1:W-SUB) TO ?????
'MOVE LAST-NAME(1:W-SUB) TO ?????' is where I am 'stuck'.
i.e. How to 'STRING' the three name fields together to produce DESIRED RESULT = Edward H Smithington (* Including a space between F, MI + L).
You were asked to do it with STRING. The argument against using STRING for names is that names can have embedded spaces. DE LA HAYE for instance as a last-name, 'ST JOHN' (pronounced sinjun) as a first-name. There can also be typos giving leading blanks and embedded blanks. You seem to know that you have no leading blanks, but genuine or false embedded blanks make the simple use of STRING more tricky.
If you can guarantee no leading or embedded blanks (absolutely guarantee) then
IF MI-NAME EQUAL TO SPACE
STRING FIRST-NAME
DELIMITED BY SPACE
' '
DELIMITED BY SIZE
LAST-NAME
DELIMITED BY SPACE
INTO FULL-NAME
ELSE
STRING FIRST-NAME
DELIMITED BY SPACE
' '
DELIMITED BY SIZE
MI-NAME
DELIMITED BY SIZE
' '
DELIMITED BY SIZE
LAST-NAME
DELIMITED BY SPACE
INTO FULL-NAME
END-IF
Before the IF you need to MOVE SPACE to FULL-NAME, else you'll end up with part of the previous name when the current name is shorter than the previous.
If you can't guarantee the lack of leading and embedded blanks, you have to use reference-modified fields for the first-name and last-name (one length each) and use DELIMITED BY SIZE for those. Then what's the point?
01 W-FULL-NAME.
05 W-FIRST-NAME.
10 FILLER OCCURS 0 TO 12 TIMES
DEPENDING ON length-of-first-name.
15 FILLER PIC X.
05 SPACE-AFTER-FIRST-NAME PIC X.
05 W-MI-NAME.
10 FILLER OCCURS 0 TO 2 TIMES
DEPENDING ON length-for-mi.
15 FILLER PIC X.
05 W-LAST-NAME.
10 FILLER OCCURS 0 TO 18 TIMES
DEPENDING ON length-of-last-name.
15 FILLER PIC X.
You have your two PERFORMs to get the length of the first-name and last-name (as already). You MOVE ZERO to length-for-mi if WS-MI-NAME is space, else make it two.
Then:
MOVE SPACE TO SPACE-AFTER-FIRST-NAME
MOVE FIRST-NAME TO W-FIRST-NAME
MOVE LAST-NAME TO W-LAST-NAME
MOVE MI-NAME TO W-MI-NAME
The W-FULL-NAME, a variable-length field, contains the data you want in the format you want, and then you do what you like with it.
By shifting the "complexity" into the DATA DIVISION with the definition of the data, the code in the PROCEDURE DIVISION becomes very simple.
Try it out, and to see the formatted data, do this:
DISPLAY
">"
W-FULL-NAME
"<"
The > and < are just to show you exactly what the data is (I always do that when DISPLAYing data). You'll see the length of the field changing with different test-data (assuming to test with different length data...).
Test with all the input as space, you'd see this on your SYSOUT spool dataset:
><
A zero-length field.
With reference-modification you'd do it something like this:
do your PERFORM to count the first-name trailing spaces
MOVE FIRST-NAME TO WS-FULL-NAME
ADD 1 WS-SUB
GIVING next-available-output
IF MI-NAME NOT EQUAL TO SPACE
MOVE MI-NAME TO WS-FULL-NAME
( next-available-output : 1 )
ADD 2 TO next-available-output
END-IF
do your PERFORM for the last-name
MOVE LAST-NAME TO WS-FULL-NAME
( next-available-output : W-SUB )
The first MOVE to the output will copy the first name to the full-name. Neither needs to be reference-modified, the effect will be that other than the characters of the name the rest of the target field will be blank.
The number of characters present are known, so the next available position for data in the target field can be calculated by adding one.
The second MOVE is made conditional on whether there is any middle-initial data, and if so it is MOVEd to the next available output position calculated above. The number of bytes (one) MOVEd are limited in the target.
The third MOVE is like the second MOVE, except unconditional and the limit for the bytes MOVEd is variable.
Variations of the above are possible. There's a much neater way, but depends somewhat on your compiler. So which one are you using?
You calculation of the number of trailing blanks can be simplified:
01 W-SUB COMP PIC 9(4).
PROCESS-LAST-NAME.
MOVE ZERO TO W-SUB
IF LAST-NAME NOT EQUAL TO SPACE
MOVE FUNCTION LENGTH ( LAST-NAME )
TO W-SUB
PERFORM
UNTIL LAST-NAME ( W-SUB : 1 )
NOT EQUAL TO SPACE
SUBTRACT 1 FROM W-SUB
END-PERFORM
END-IF
That way, you don't have to have the double termination-conditions. I'd REDEFINES the field, and use subscripting not reference-modification. I'd also rename W-SUB to indicate that it contains the length of the data.
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 :-)