Re: Zoned field validation

<comments at bottom>

On Mon, 22 Oct 2001, Albino Sousa wrote:
>
> Can someome help me with this: I have a nine digits field (9,0 S), I must
> validate.
> The 3 first positions of that field must be diferent from 0. OTH the remains
> 6 positions can contain a zero, but not in all 6 positions.
> Like this: 234670739 - this is ok
>               034670739 - wrong
>               004670739 - wrong
>               000670739 - wrong
>               234000000 - wrong
> Is there a easy way to handle with this. An array?
>
> A. Sousa

Here's how I would do it, along with some code to demonstrate how
to use it:


     D IsValid         PR             1N
     D   ZonedNum                     9S 0 value

     D TestNum         S              9S 0
     D msg             S             52A

     c                   eval      TestNum = 234670739
     c                   if        IsValid(TestNum)
     c                   eval      msg = %char(TestNum) + ' is valid'
     c                   dsply                   msg
     c                   else
     c                   eval      msg = %char(TestNum) + ' is wrong'
     c                   dsply                   msg
     c                   endif

     c                   eval      TestNum = 034670739
     c                   if        IsValid(TestNum)
     c                   eval      msg = %char(TestNum) + ' is valid'
     c                   dsply                   msg
     c                   else
     c                   eval      msg = %char(TestNum) + ' is wrong'
     c                   dsply                   msg
     c                   endif

     c                   eval      TestNum = 004670739
     c                   if        IsValid(TestNum)
     c                   eval      msg = %char(TestNum) + ' is valid'
     c                   dsply                   msg
     c                   else
     c                   eval      msg = %char(TestNum) + ' is wrong'
     c                   dsply                   msg
     c                   endif

     c                   eval      TestNum = 000670739
     c                   if        IsValid(TestNum)
     c                   eval      msg = %char(TestNum) + ' is valid'
     c                   dsply                   msg
     c                   else
     c                   eval      msg = %char(TestNum) + ' is wrong'
     c                   dsply                   msg
     c                   endif

     c                   eval      TestNum = 234000000
     c                   if        IsValid(TestNum)
     c                   eval      msg = %char(TestNum) + ' is valid'
     c                   dsply                   msg
     c                   else
     c                   eval      msg = %char(TestNum) + ' is wrong'
     c                   dsply                   msg
     c                   endif

     c                   eval      *inlr = *on


      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      *  Check to see if a field is valid.
      *     field will be valid if:
      *       - There are no zeroes in the 1st 3 digits.
      *     AND The last 6 digits are not all zeroes.
      *
      *  You can pass any numeric field to this procedure, it doesn't
      *  matter if it's zoned, packed, or binary because it's passed
      *  by value.
      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P IsValid         B
     D IsValid         PI             1N
     D   InputData                    9S 0 value

     D                 ds
     D CharFld                        9A
     D Zoned                          9S 0 overlay(CharFld:1)

     c                   eval      Zoned = InputData

     c                   if        %subst(CharFld:1:1) = '0'
     c                               or %subst(CharFld:2:1) = '0'
     c                               or %subst(CharFld:3:1) = '0'
     c                               or %subst(CharFld:4:6) = '000000'
     c                   return    *Off
     c                   endif

     c                   return    *On
     P                 E