Want code snippet to validate decimal number

[Bandi2000]

Hi Cobol-Guru's,

Can anyone send me the Code snippet to validate decimal number (signed) entered on the screen.

Possibel numbers: -0.05 or 200.12 or +6000.1 etc.

Thanks in Advance,
Reddy B.R

 

[slade]

Hi Bandi,

I did something like that a while back. If you want a copy leave your e-Addr and I'll search it down and send it to you.

Jack

 

[Crox]

Hi Jack,

is it that big that it doesn't fit on this site? :-(

Regards,

Crox

 

[Bandi2000]

Thanks alot jack. My e-mail id is 'rvreddy@us.dhl.com'.

Actually, I had written one; but with constraints like Number of decimal precision and size of the field. However, I want more flexible one interms of,say, postion of sign, number of decimal precision, etc.

Here is the code I have written, may be useful for anyone.

***********************************************************
** This Copybook defines the variables used in the number**
** edit routine EDITDEC. **
** Modification to this copybook must be made with prior **
** IS notice. **
***********************************************************
01 WRK-S-EDIT.
03 WRK-S-MAX-DIGITS PIC 9(2) VALUE 11.
03 WRK-S-IN PIC X(011).
03 WRK-S-IN-REDEF REDEFINES WRK-S-IN
OCCURS 11 TIMES.
05 WRK-S-IN-CHAR PIC X(001).
03 WRK-S-TMP-9 PIC 9(11).
03 WRK-S-TMP-X REDEFINES WRK-S-TMP-9
PIC X(11).
03 WRK-S-TMP-X-REDEF REDEFINES WRK-S-TMP-X
OCCURS 11 TIMES.
05 WRK-S-TMP-CHAR PIC X(001).
03 WRK-S-OUT.
05 WRK-S-OUT-11 PIC 9(011) VALUE 0.
05 FILLER PIC X(001) VALUE '.'.
05 WRK-S-OUT-2 PIC 9(002) VALUE 0.
03 WRK-S-OUT-UNSIGNED REDEFINES WRK-S-OUT
PIC 9(011).99.
03 WRK-S-OUT-SIGNED PIC S9(011)V99 VALUE 0.
03 WRK-S-NBR-ERR PIC 9(004) VALUE 0.
03 WRK-S-IN-LEN PIC 9(004) COMP VALUE 0.
03 WRK-S-TEMP PIC 9(004) COMP VALUE 0.
03 WRK-S-NBR-INDEX PIC 9(004) COMP VALUE 0.
03 WRK-S-SIGN-INDX PIC 9(004) COMP VALUE 0.
03 WRK-S-POS-SIGN-INDX PIC 9(004) COMP VALUE 0.
03 WRK-S-NEG-SIGN-INDX PIC 9(004) COMP VALUE 0.
03 WRK-S-DEC-SIGN-INDX PIC 9(004) COMP VALUE 0.
03 WRK-S-DEC-INDX PIC 9(004) COMP VALUE 0.
03 WRK-S-POS-INDX PIC 9(004) COMP VALUE 0.
03 WRK-S-NEG-INDX PIC 9(004) COMP VALUE 0.
03 WRK-S-CUR-INDX PIC 9(004) COMP VALUE 0.
03 WRK-S-DEC-CHAR PIC X(001) VALUE '.'.
03 WRK-S-POS-CHAR PIC X(001) VALUE '+'.
03 WRK-S-NEG-CHAR PIC X(001) VALUE '-'.
03 WRK-S-FILL-CHAR PIC X(001) VALUE '^'.
03 WRK-S-LOW-CHAR PIC X(001) VALUE LOW-VALUES.
03 WRK-S-SPACE-CHAR PIC X(001) VALUE SPACE.
03 WRK-S-NEG-FND-IND PIC X(001).
88 WRK-S-NEG-FND VALUE 'Y'.
88 WRK-S-NEG-NOT-FND VALUE 'N'.
03 WRK-S-POS-FND-IND PIC X(001).
88 WRK-S-POS-FND VALUE 'Y'.
88 WRK-S-POS-NOT-FND VALUE 'N'.
03 WRK-S-DEC-FND-IND PIC X(001).
88 WRK-S-DEC-FND VALUE 'Y'.
88 WRK-S-DEC-NOT-FND VALUE 'N'.



***********************************************************
** This Copybook perform the edit function of the Decimal**
** Numbers. **
** Modification to this copybook must be made with prior **
** IS notice. **
***********************************************************
*** INPUT: ***
*** ***
*** WRK-S-IN-LEN - LENGTH OF FIELD ***
*** WRK-S-IN - ALPHANUMERIC FIELD ***
*** ***
*** RETURNS: ***
*** ***
*** WRK-S-OUT-UNSIGNED - UNSIGNED NUMERIC VALUE WITH ***
*** DECIMAL POINT ***
*** WRK-S-OUT-SIGNED - SIGNED NUMERIC VALUE WITH ***
*** DECIMAL POINT ***
*** USAGE IN PROGRAM : ***
*** ================== ***
*** MOVE <field> TO WRK-S-IN. ***
*** COMPUTE WRK-S-IN-LEN = FUNCTION LENGTH (<field>) ***
*** PERFORM Z1234-EDIT-DECIMALS ***
*** MOVE WRK-S-OUT-SIGNED TO <field> ***
***********************************************************
Z1234-EDIT-DECIMALS.

IF WRK-S-IN-LEN > WRK-S-MAX-DIGITS
MOVE 0009 TO WRK-S-NBR-ERR
GO TO Z1234-EXIT
END-IF

SET WRK-S-NEG-NOT-FND TO TRUE
SET WRK-S-POS-NOT-FND TO TRUE
SET WRK-S-DEC-NOT-FND TO TRUE
MOVE 0 TO WRK-S-SIGN-INDX
MOVE 0 TO WRK-S-CUR-INDX
MOVE ZEROES TO WRK-S-TMP-9

PERFORM VARYING WRK-S-NBR-INDEX FROM 1 BY 1
UNTIL ( WRK-S-NBR-INDEX > WRK-S-IN-LEN )
IF WRK-S-IN-CHAR (WRK-S-NBR-INDEX) = WRK-S-SPACE-CHAR OR
WRK-S-LOW-CHAR OR
WRK-S-FILL-CHAR
CONTINUE
ELSE
EVALUATE TRUE
WHEN WRK-S-IN-CHAR (WRK-S-NBR-INDEX) =
WRK-S-NEG-CHAR
IF WRK-S-NEG-FND OR WRK-S-POS-FND
MOVE 0009 TO WRK-S-NBR-ERR
MOVE 9999 TO WRK-S-NBR-INDEX
ELSE
MOVE 'Y' TO WRK-S-NEG-FND-IND
COMPUTE WRK-S-NEG-INDX = WRK-S-CUR-INDX + 1
ADD 1 TO WRK-S-SIGN-INDX
MOVE WRK-S-SIGN-INDX TO WRK-S-NEG-SIGN-INDX
END-IF
WHEN WRK-S-IN-CHAR (WRK-S-NBR-INDEX) =
WRK-S-POS-CHAR
IF WRK-S-NEG-FND OR WRK-S-POS-FND
MOVE 0009 TO WRK-S-NBR-ERR
MOVE 9999 TO WRK-S-NBR-INDEX
ELSE
MOVE 'Y' TO WRK-S-POS-FND-IND
COMPUTE WRK-S-POS-INDX = WRK-S-CUR-INDX + 1
ADD 1 TO WRK-S-SIGN-INDX
MOVE WRK-S-SIGN-INDX TO WRK-S-POS-SIGN-INDX
END-IF
WHEN WRK-S-IN-CHAR (WRK-S-NBR-INDEX) =
WRK-S-DEC-CHAR
IF WRK-S-DEC-FND
MOVE 0009 TO WRK-S-NBR-ERR
MOVE 9999 TO WRK-S-NBR-INDEX
ELSE
MOVE 'Y' TO WRK-S-DEC-FND-IND
COMPUTE WRK-S-DEC-INDX = WRK-S-CUR-INDX + 1
ADD 1 TO WRK-S-SIGN-INDX
MOVE WRK-S-SIGN-INDX TO WRK-S-DEC-SIGN-INDX
END-IF
WHEN ( WRK-S-IN-CHAR (WRK-S-NBR-INDEX) >= '0' )
AND ( WRK-S-IN-CHAR (WRK-S-NBR-INDEX) <= '9' )
ADD 1 TO WRK-S-CUR-INDX
MOVE WRK-S-IN-CHAR (WRK-S-NBR-INDEX) TO
WRK-S-TMP-CHAR (WRK-S-CUR-INDX)
WHEN OTHER
MOVE 0009 TO WRK-S-NBR-ERR
MOVE 9999 TO WRK-S-NBR-INDEX
END-EVALUATE
END-IF
END-PERFORM.

IF WRK-S-NBR-ERR < 1
PERFORM Z2345-VALIDATE-PROCESS
IF WRK-S-NBR-ERR < 1
PERFORM Z3456-PROCESS-OUTPUT
END-IF
END-IF.

Z1234-EXIT.
EXIT.

Z2345-VALIDATE-PROCESS.

IF WRK-S-NEG-FND AND ( WRK-S-NEG-INDX NOT = 1)
MOVE 0009 TO WRK-S-NBR-ERR
END-IF
IF WRK-S-POS-FND AND ( WRK-S-POS-INDX NOT = 1)
MOVE 0009 TO WRK-S-NBR-ERR
END-IF
IF WRK-S-DEC-FND
IF WRK-S-NEG-FND AND ( WRK-S-DEC-SIGN-INDX
< WRK-S-NEG-SIGN-INDX )
MOVE 0009 TO WRK-S-NBR-ERR
END-IF
IF WRK-S-POS-FND AND ( WRK-S-DEC-SIGN-INDX
< WRK-S-POS-SIGN-INDX )
MOVE 0009 TO WRK-S-NBR-ERR
END-IF
END-IF.


Z3456-PROCESS-OUTPUT.

MOVE ZEROES TO WRK-S-OUT-11
WRK-S-OUT-2.

IF WRK-S-TMP-X NOT NUMERIC
MOVE 0009 TO WRK-S-NBR-ERR
ELSE
IF WRK-S-DEC-FND
MOVE WRK-S-TMP-9 ( WRK-S-DEC-INDX : 2)
TO WRK-S-OUT-2
IF WRK-S-DEC-INDX < 2
MOVE ZEROES TO WRK-S-OUT-11
ELSE
MOVE WRK-S-TMP-9 ( 1: WRK-S-DEC-INDX - 1)
TO WRK-S-OUT-11
END-IF
ELSE
MOVE WRK-S-TMP-9 ( 1: WRK-S-CUR-INDX )
TO WRK-S-OUT-11
END-IF
MOVE WRK-S-OUT-UNSIGNED TO WRK-S-OUT-SIGNED
IF WRK-S-NEG-FND
COMPUTE WRK-S-OUT-SIGNED = WRK-S-OUT-SIGNED * -1
END-IF
END-IF.

 

[slade]

Hi Crox,

It runs for about 250 lines, I'll send you a copy though, when I hunt it down.

Bandi,

Have faith, I'm working on finding it.

Regards, Jack.

 

[mrregan]

Hi,
How about something like this (untested).

01 input-value pic x(12).
01 new-value.
02 new-sign pic x.
02 new-left pic x(9).
02 new-dec pic x(2).
01 new-dec redefines new-value pic s9(9)v99.
01 left-ct pic 99.
01 right-ct pic 99.
01 dec-ct pic 99.
01 pos-ct pic 99.
01 neg-ct pic 99.
01 point pic 99.

perform get-value.
...
...
...
...

get-value.
accept input-value.
move 0 to left-ct, dec-ct, pos-ct, neg-ct, right-ct.
inspect input-value tallying dec-ct for all &quot;.&quot;
inspect input-value tallying pos-ct for all &quot;+&quot;.
inspect input-value tallying neg-ct for all &quot;-&quot;.
if dec-ct > 1 or neg-ct > 1 or pos-ct > 1
or (pos-ct =1 and neg-ct = 1)
perform bad-value-message
go to val-exit
inspect input-value replacing all &quot;+&quot; by space.
inspect input-value replacing all &quot;-&quot; by space.
inspect input-value tallying left-ct for all characters
before initial &quot;.&quot;.
inspect input-value tallying right-ct for all characters
after initial &quot;.&quot;
if left-ct > 9 or right-ct > 2
perform too-many-digits-message
go to val-exit
move 0 to new-dec.
subtract left-ct from 9 giving point.
add 1 to point.
if left-ct = 0 string input-value delimited by size
into new-dec
else string input-value delimited by size
into new-left with pointer point
add 1 to left-ct
unstring input-value into new-dec
with pointer left-ct.

inspect new-value replacing all space by zero.
if new-left not numeric or new-dec not numeric
perform not-numeric-characters-message
go to val-exit.
if neg-ct = 1 move &quot;-&quot; to new-sign
else move &quot;+&quot; to new-sign.
val-exit. exit.

 

[BettyScherber]

Since you requested a snippet, I thought you might appreciate this, it's relatively short:

In WORKING-STORAGE:

01  REQUIRED-VARIABLES.
  05  NUMBER-TO-PARSE		PIC X(20).
  05  SIGN-CHAR			PIC X.
    88  NUMBER-IS-NEGATIVE		  VALUE "-".
  05  INTEGER-CHARS		PIC X(18) JUST RIGHT.
  05  INTEGER-PORTION  REDEFINES INTEGER-CHARS
				PIC 9(18).
  05  DECIMAL-CHARS		PIC X(18).
  05  DECIMAL-PORTION  REDEFINES DECIMAL-CHARS
				PIC V9(18).
  05  START-POSITION		PIC 99.
  05  RESULTING-NUMBER		PIC S9(18)V9(18).

(of course, RESULTING-NUMBER can't be longer than 18 total digits in the real world, but you can modify to suit your needs.

In the PROCEDURE DIVISION:

MOVE ZEROS TO INTEGER-PORTION  DECIMAL-PORTION.
MOVE 1 TO START-POSITION.
MOVE SPACES TO SIGN-CHAR.
INSPECT NUMBER-TO-PARSE TALLYING START-POSITION FOR LEADING SPACES.
IF NUMBER-TO-PARSE (START-POSITION: 1) "-" OR "+"
  MOVE NUMBER-TO-PARSE (START-POSITION: 1) TO SIGN-CHAR
  ADD 1 TO START-POSITION
END-IF.
UNSTRING NUMBER-TO-PARSE (START-POSITION:) DELIMITED BY "."
  INTO INTEGER-CHARS  DECIMAL-CHARS.
ADD INTEGER-PORTION  DECIMAL-PORTION GIVING RESULTING-NUMBER.
IF NUMBER-IS-NEGATIVE
  MULTIPLY -1 BY RESULTING-NUMBER
END-IF.

Betty Scherber
Brainbench MVP for COBOL II

http://www.brainbench.com

 

[k5tm]

Not picking on Betty, but a caution and then a suggestion.

The INSPECT can result in START-POSITION > length of NUMBER-TO-PARSE, which should cause IF NUMBER-TO-PARSE (START-POSITION:1) to terminate your run unit in a rather hostile manner. This could happen if your user enters nothing whatsoever, resulting in NUMBER-TO-PARSE = SPACES.

Other pathological cases would be a &quot;-&quot; or &quot;+&quot; alone (without any digits).

Now for the suggestion:

An often overlooked feature of the ANSI 1985 standard is the ability to de-edit a numeric edited item with a simple MOVE statement in the following style:

MOVE numeric-edited-item TO numeric-item.

This is found in 6.19.4 (4) b.:
... When the sending operand is numeric edited, de-editing is implied to establish the operand's unedited numeric value, which may be signed; then the unedited numeric value is moved to the receiving field.

Now this suggestion comes with a word of caution. The ANSI COBOL Committee never really clarified the de-editing rules so there are some differences in implementation of this de-editing capability.

Perhaps this is all you need?
Tom Morrison

 

[slade]

Hi Tom,

I've used the deedit move with pgm created data, including machine readable report data. A great time saver! But, as you point out, be very careful using it otherwise.

My ideal numeric edit routine should/could have the following features:

1) The data can be placed anywhere in the input field.
2) It can be signed or unsigned, leading or trailing, or trailing DB, CR.
3) Can contain leading $ and/or commas (,).
4) Detects as illegal, multiple signs, $, dec pts (.), con-
secutive commas, imbedded spaces, and other &quot;non-numeric&quot; chars.
5) Allows missing commas. Why? User may need the room. I've seen screen and report items that &quot;drop&quot; commas to enable the field to fit the space.`
6) The IP field can contain any number of dec places, up to the limit of 18 digits (or 31 for the new expanded versions of zOS).
7 The edited field is placed in a pic S9(x)V9 result field aligned at the implied dec pt and be algebraically correct (i.e. represents the value of the sign).

I may have missed a few points or been a bit too rigid, but it's the beginning of a &quot;one size fits all&quot; edit routine.

Regards, Jack.

 

[k5tm]

Hi Jack,

I wrote the de-edit routine for RM/COBOL, and it meets your criteria with the exception that it is permissive for your requirement (4). This is due partially as a result of the inattention of the COBOL committee to this particular feature.

Our main criterion was to accept just about anything that could be generated by a numeric editing picture. That would include strings of contiguous commas, for example. (Yes, PIC 999,,,,,999.99 is a perfectly valid picture.) However, when we started talking to our customers about this new feature, most wanted the most permissive interpretation possible, fearing that a lot of rules would make this new feature unusable. Therefore, we do not use the editing picture at all in our extraction of a numeric value from the field contents. We also use the rightmost decimal point if multiple decimal points exist. (And, yes, we do pay attention to DECIMAL POINT IS COMMA.) The algebraic value is negative if a &quot;-&quot; exists anywhere in the string. Our implementation has been this way for almost two decades without complaint (which could mean that noone is using this, but I know otherwise).

So, it is quite possible to use the 'MOVE numeric-edited TO numeric' feature to extract the value and should you desire more severe editing rules (disallow multiple signs, radix points, etc) then you can do that with a few simple INSPECTs.
Tom Morrison

 

[slade]

Tom,

I don't have a compiler available, so perhaps you would walk me thru the following:

I/P field: "  +-1 57A2..999   "
Edit PIC : ?   PIC ????
O/P field: "  ????            "

Do you:

move I/P field to edit PIC field at grp level
move edit PIC field to O/P field

where, I/P is A/N, move1 doesn't convert the format of the
field, move2 de-edits I/P field.

What does O/P field look like after processing; how is it defined, etc.?

Thanx, Jack.

 

[k5tm]

Jack,

How about this example?

01  a-strange-value      value "  +-1 57A2..999   ".
    02  an-edited-number pic Z(18).
01  a-number-we-can-use  pic S9(9)V9(9).


MOVE an-edited-number TO a-number-we-can-use.

should result in a-number-we-can-use having the algebraic value -1572.999 (on RM/COBOL; YMMV).

But then the suggestion in the last paragraph of my message would suggest something like:

MOVE 0 TO algebraic-sign-count, radix-count.
INSPECT a-strange-value 
    TALLYING algebraic-sign-count FOR ALL "+"    
    TALLYING algebraic-sign-count FOR ALL "-"
    TALLYING radix-count FOR ALL ".".
IF algebraic-sign-count > 1 OR radix-count > 1
    <process an error>
END-IF.

This is not thorough, but suffices for an example.
Tom Morrison

 

[slade]

Hello again, Tom,

Thanx for the reply. Some additional ques (surprise, suprise).

1) Will the Z(18) result in the desired dpt alignment on
OP or do we get X'001572999V00000000}' ? The &quot;V&quot; being
virtual, of course.
2) Are ALL non-numeric chars dropped on OP?

Thanx again, Jack.

 

[k5tm]

Jack,

1) We do not use the editing picture at all in the extraction process (other than to determine the length of the item and the fact that it is indeed numeric edited). If there is a decimal point in the contents of the numeric edited item, that decimal point will be used to determine the algebraic value. So to use your example, you would get (with V being virtual) X'000001572V999000000-' (sign is trailing separate).

2) Yes that is what we chose to do. We previously had more esoteric rules, but, absent and standards to follow, we ended up with simpler rules desired by our customers. In the process, the trailing CR/DB equating to algebraic negative was removed -- nobody (no customer, that is) cared!

[Now the interesting part is that I have gone back to the code, to check on the accuracy of the documentation, and I think I have discovered that, contrary to our documentation we do use the edit picture for the purpose of removing insertion zeros. This whole thread probably will cause me to enter a defect, since either the code or the doc is wrong.]

Best regards,
Tom Morrison

 

[k5tm]

Back again...

I have checked the history of the removal of insertion zeros. We do this because this is one area where the ANSI COBOL committee issued an opinion (flawed as it may be, strictly in my opinion). I don't know if there ever was a test in the CCVS (COBOL Compiler Validation Suite) that tested removal of insertion zeros, but there it is anyway.
Tom Morrison