Do periods count as numerics (COBOL)

I am working on a bit of code at home and that is suppose to find and identify errors is a i开发者_StackOverflownput file. I got it just about right, but two little errors are hitting me. The major problem though is this. I have to make a code that identifies "3077.B22" as an error because the first 5 columns are suppose to be numeric, but my current code is letting it pass. It hits every thing else though so I have to believe that it is seeing the period as a decimal point. Here is what I got that concerns to this part.

   01  PART-NUMBER-CHECK.
       05 P-N-NUM-1                PIC X(5).
       05 P-N-LETTER               PIC X.
       05 P-N-NUM-2                PIC XX.

   300-VALIDATE-PART-NUMBER.
       MOVE 'NO' TO FIELD-ERROR-SWITCH
       MOVE PART-NUMBER TO PART-NUMBER-CHECK
       EVALUATE P-N-NUM-1
           WHEN 00001 THRU 99999  CONTINUE

           WHEN OTHER              MOVE 'YES' TO FIELD-ERROR-SWITCH
       END-EVALUATE
       IF P-N-LETTER IS NUMERIC
           MOVE 'YES' TO FIELD-ERROR-SWITCH
       END-IF
       IF P-N-LETTER IS ALPHABETIC-LOWER
           MOVE 'YES' TO FIELD-ERROR-SWITCH
       END-IF
       IF P-N-NUM-2 IS ALPHABETIC
           MOVE 'YES' TO FIELD-ERROR-SWITCH
       END-IF
       IF (P-N-NUM-2 > 00 AND < 69)
           OR (P-N-NUM-2 >77 AND < 100)
               CONTINUE
       ELSE
           MOVE 'YES' TO FIELD-ERROR-SWITCH
       END-IF
       IF FIELD-ERROR-SWITCH = 'YES'
           MOVE 'YES' TO RECORD-ERROR-SWITCH
           MOVE 'Part Number' TO FIELD-NAME
           MOVE PART-NUMBER TO FIELD-VALUE
           PERFORM 400-WRITE-DETAIL-LINE
       END-IF.

My second problem is similar cause it is seeing an * in another field as a alphabetic. Here is the paragraph to that:

   340-VALIDATE-INITIAL.
       MOVE 'NO' TO FIELD-ERROR-SWITCH
       INSPECT INITIALS
           TALLYING I-CHECK FOR ALL SPACES
       IF I-CHECK > 0
           MOVE 'YES' TO FIELD-ERROR-SWITCH
           MOVE 0 TO I-CHECK
       END-IF
       IF INITIALS IS NUMERIC
           MOVE 'YES' TO FIELD-ERROR-SWITCH
       END-IF
       IF FIELD-ERROR-SWITCH = 'YES'
           MOVE 'YES' TO RECORD-ERROR-SWITCH
           MOVE 'Initials' TO FIELD-NAME
           MOVE INITIALS TO FIELD-VALUE
           PERFORM 400-WRITE-DETAIL-LINE
       END-IF.

Please help, I am done as soon as I get over this little bump in the road.

Given the following declaration:

01  PART-NUMBER-CHECK.
    05 P-N-NUM-1                PIC X(5).
    05 P-N-LETTER               PIC X.
    05 P-N-NUM-2                PIC XX.

and something like:

   MOVE 'NO' TO FIELD-ERROR-SWITCH
   MOVE '3077.B22' TO PART-NUMBER-CHECK
   EVALUATE P-N-NUM-1
       WHEN 00001 THRU 99999  CONTINUE
       WHEN OTHER              MOVE 'YES' TO FIELD-ERROR-SWITCH
   END-EVALUATE

Why isn't the FIELD-ERROR-SWITCH set to 'YES'? COBOL casts 00001 and 99999 into their PIC X equivalents before applying the range tests (casting rules here are rather complicated so I'm not going to get into it). The actual test COBOL performs here is roughly equivalent to the following:

IF '00001' <= '3077.' AND '99999' >= '3077.'

Given that these are string tests the condition is true, meaning that you bypass setting the FIELD-ERROR-SWITCH. Using a THRU range test in COBOL is very useful but requires a bit of caution. Only use THRU when you know you have valid data to begin with or are doing single character comparisons. For example

 05 TEST-CHAR PIC X.
    88 IS-DIGIT        VALUE '0' THRU '9'.
    88 IS-LOWER-LETTER VALUE 'a' THRU 'i', 
                             'j' THRU 'r', 
                             's' THRU 'z'.
    88 IS-UPPER-LETTER VALUE 'A' THRU 'I', 
                             'J' THRU 'R', 
                             'S' THRU 'Z'.
    88 IS-SPACE        VALUE SPACE.

Then code like:

 MOVE SOME-CHAR TO TEST-CHAR
 EVALUATE TRUE
     WHEN IS-DIGIT
         DISPLAY 'IS A DIGIT'
     WHEN IS-LOWER-LETTER OR IS-UPPER-LETTER
         DISPLAY 'IS ALPHA'
     WHEN IS-SPACE
         DISPLAY 'IS A SPACE'
     WHEN OTHER
         DISPLAY 'IS A SOMETHING ELSE'
 END-EVALUATE

is pretty much bullet proof. Why did I break the alphabet range up into distinct groups? Check out the EBCDIC collating sequence and you will find that some non alphabet characters sneak in between 'i' and 'j' then again between 'r' and 's'! Oh, how I love EBCDIC!

How to solve your problem? Something as simple as:

IF P-N-NUM-1 IS NUMERIC
   IF P-N-NUM-1 = ZERO
      MOVE 'YES' TO FIELD-ERROR-SWITCH
   END-IF
ELSE       
   MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF

would do the trick. The NUMERIC test ensures that P-N-NUM-1 is composed of only digits. The ZERO test ensures that it is not zero. In this case negative numbers are excluded on the NUMERIC test. Period/plus/minus are not NUMERIC when the item being tested is declared as PIC X or PIC 9. Had the elementary item been declared as PIC S9(5) PACKED-DECIMAL, then a leading sign would be pass the NUMERIC test. The COBOL NUMERIC class test takes a bit of study to fully understand.

Big hint: Ensure that things that are supposed to be numeric are stored in elementary items that are declared as numeric. I would try declaring P-N-NUM-1 and P-N-NUM-2 using PIC 9. Move un-validated data into PART-NUMBER-CHECK which by default is PIC X so no errors occur, then validate elementary numeric data items using IF NUMERIC tests. Once you know you have numeric data then your range tests (e.g. 00001 THRU 99999, greater/less than) will not lead you astray - as happened here.

Why is an '*' sneaking through your second bit of code? You never set an error on non-alpha characters, only on numerics. Why not try flipping your NUMERIC test into a NOT ALPHABETIC test?

See if that helps!

You are on the right track, but does your compiler support the NumVal function? You could do this:

01 Part-Num 9(5).9(2).

Compute Part-Num = Function NumVal( Part-Num-Input ) on exception Set Part-Num-Not-Valid to true End-Compute

A long time since I wrote my last COBOL, and I don't have a compiler at hand, so expect some sintax checks in the code, but you'll get the idea ...

01  PART-NUMBER-CHECK.  
   05 P-N-NUM-1                .  
      07 p-x-occ occurs 5      pic X.  
   05 P-N-NUM-1-N    redefines P-N-NUM-1.           .  
      07 p-n-occ occurs 5      pic 9.  
   05 P-N-LETTER               PIC X.  
   05 P-N-NUM-2                PIC XX.  

01 FIELD-ERROR-SWITCH pic x(3).   
   88 no-error value 'NO'.   

300-VALIDATE-PART-NUMBER.
   MOVE 'NO' TO FIELD-ERROR-SWITCH  
   MOVE PART-NUMBER TO PART-NUMBER-CHECK.  
   perform validate-p-n-occurs varying I from 1 to 5.  
   if no-error  
      IF ( P-N-LETTER IS NUMERIC or P-N-LETTER IS ALPHABETIC-LOWER or  
           P-N-NUM-2 IS ALPHABETIC)  
         MOVE 'YES' TO FIELD-ERROR-SWITCH  
      ELSE    
          IF (P-N-NUM-2 < 0) OR (P-N-NUM-20 > 68 AND < 79) OR (P-N-NUM-2 >99)  
             MOVE 'YES' TO FIELD-ERROR-SWITCH  
          END-IF  
      END-IF
   END-IF  

   IF FIELD-ERROR-SWITCH = 'YES'  
       MOVE 'YES' TO RECORD-ERROR-SWITCH  
       MOVE 'Part Number' TO FIELD-NAME  
       MOVE PART-NUMBER TO FIELD-VALUE  
       PERFORM 400-WRITE-DETAIL-LINE  
   END-IF.  

validate-p-n-occurs.  
   IF p-x-occ(I) is not NUMERIC or (p-n-occ(I) < 0 or  > 10)
         MOVE 'YES' TO FIELD-ERROR-SWITCH  
   END-IF.