Return to the RPG Tips
Test a packed number for validity
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
[report a broken link by clicking here]