|
midrange.com
Well, it seems to me that he is initializing the string using
hexadecimal. First byte is 00, Fifth byte is 01, Sixth byte is
23, etc.. 'til we get to the last byte which is 0C (13 decimal).
The last nibble (half byte) of the last byte (using MSBF) is the
sign, positive or negative. I've never really understood when it
would be a C, a D or an F. I'm guessing one is negative, one is
positive, and the other is unsigned, but that's just a guess.
Regards,
Jim Langston
Incidentally, Buck, thanks for the code!
Andrew Batch wrote:
>
> The definition of validc is:
>
> d validC s 10 inz(x'0000000001234567890C')
>
> what does the C at the end of the inz statement mean?
>
> Cheers,
>
> Andy
>
> -----Original Message-----
> From: Buck Calabro [SMTP:buck.calabro@aptissoftware.com]
> Sent: 18 January 2001 22:21
> To: RPG400-L@midrange.com
> Subject: Test a packed number for validity - code included
>
> After the recent messages regarding TESTN, I came across a need to
> validate
> a packed number for validity. I'm getting essentially packed data
> (x'00518C5551212C') from a telephone switch and occasionally the
> data has an
> error. TESTN won't work on packed data so I had to roll my own.
> Included
> is the code for that solution. I'm looking for comments (and
> donating it to
> the archives...)
>
> h bnddir('QC2LE')
> h/copy qrpglesrc,stdhspec
> * dbgview(*list)
>
> d validFlag s n
> d validF s 10
> inz(x'0000000001234567890F')
> d validC s 10
> inz(x'0000000001234567890C')
> d invalid s 10
> inz(x'0110C00001234567890C')
>
> d tstPackNum pr n opdesc
> d inpChar 64 const options(*varsize)
>
> d H2C pr extProc('cvthc')
> d * value
> d * value
> d 10I 0 value
>
> d getStrInf pr ExtProc('CEEGSI')
> d parmNum 10I 0 const
> d dataType 10I 0
> d currLen 10I 0
> d maxLen 10I 0
>
> c eval validFlag = tstPackNum(validF)
> c eval validFlag = tstPackNum(validC)
> c eval validFlag = tstPackNum(invalid)
>
> c eval *inlr = *on
>
> p tstPackNum b
> d tstPackNum pi n opdesc
> d inpChar 64 const options(*varsize)
>
> d validFlag s n
> d wrkChar s like(inpChar)
> d outChar s 128
> d recPtr s * inz
> d srcPtr s * inz
> d size s 10I 0
> d dataType s 10I 0
> d currLen s 10I 0
> d maxLen s 10I 0
> d i s 10I 0
> d wrkByte s 1a
>
> c* Find out how long the input string is
> c callp getStrInf(1: dataType: currLen:
> maxLen)
>
> c eval validFlag = *on
> c eval wrkChar = inpChar
>
> * expand each nybble into a full byte
> c eval srcPtr = %addr(wrkChar)
> c eval recPtr = %addr(outChar)
> c eval size = currLen * 2
>
> c callp H2C(recPtr :
> c srcPtr :
> c size)
>
> c* validate each (expanded) byte
> c for i = 1 to size
> c eval wrkByte = %subst(outChar: i: 1)
> * each byte needs to be between 0 and 9 inclusive...
> * except the last byte
> c if i < size
> c if wrkByte < '0' or
> c wrkByte > '9'
> c eval validFlag = *off
> * short circuit - why test more now that we have a
> failure?
> c leave
> c endif
> * which needs to be C, D or F
> c else
> c if wrkByte <> 'C' and
> c wrkByte <> 'D' and
> c wrkByte <> 'F'
> c eval validFlag = *off
> c endif
> c endif
> c endfor
>
> c return validFlag
> p e
>
> Buck Calabro
> Aptis; Albany, NY
> "Nothing is so firmly believed as
> that which we least know" -- Michel Montaigne
> Visit the Midrange archives at http://www.midrange.com
> +---
> | This is the RPG/400 Mailing List!
> | To submit a new message, send your mail to RPG400-L@midrange.com.
> | To subscribe to this list send email to RPG400-L-SUB@midrange.com.
> | To unsubscribe from this list send email to
> RPG400-L-UNSUB@midrange.com.
> | Questions should be directed to the list owner/operator:
> david@midrange.com
> +---
> +---
> | This is the RPG/400 Mailing List!
> | To submit a new message, send your mail to RPG400-L@midrange.com.
> | To subscribe to this list send email to RPG400-L-SUB@midrange.com.
> | To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
> | Questions should be directed to the list owner/operator: david@midrange.com
> +---
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
