RE: Converting packed values in a buffer -- RPG400-L

Hi Griz,

Try this:

**********************************************************************
P EditN           B
**********************************************************************
D EditN           pi
D  cn                            5i 0 const
D  Precision                     3i 0 const options(*nopass)
D  Scale                         3i 0 const options(*nopass)
D  NumType                      10    const options(*nopass)
D  dataIn                         *   value options(*nopass)
D  dataOut                        *   value options(*nopass)

D QECCVTEC        pr                  extpgm('QECCVTEC')
D  EditMask                    256a
D  EditMaskL                    10i 0
D  RcvrVarL                     10i 0
D  ZeroBalF                      1a   const
D  EditCode                      1a   const
D  FillCode                      1a   const
D  pPrecision                   10i 0 const
D  pScale                       10i 0 const
D  Apierror                    120    options(*varsize)

D QECEDT          pr                  extpgm('QECEDT')
D  RcvrVar                     256a
D  RcvrVarL                     10i 0 const
D  SrcVar                       25a   const
D  SrcVarC                      10a   const
D  pPrecision                   10i 0 const
D  EditMask                    256a   const
D  EditMaskL                    10i 0 const
D  FillCode                      1a   const
D  Apierror                    120a   options(*varsize)
D EditCode        s              1a
D FillCode        s              1a
D EditMask        s            256a
D EditMaskL       s             10i 0
D RcvrVar         s            256a   based(dataOut)
D RcvrVarL        s             10i 0
D SrcVar          s             25a   based(dataIn)
D SrcVarC         s             10a
D ZeroBalF        s              1a
D EditMaskS       s             48a   dim(1000) static
D EditMaskSL      s             10i 0 dim(1000) static
D RcvrVarSL       s             10i 0 dim(1000) static
D Initialized     s               n
**********************************************************************
/free

// Initialize edit words...
if cn = 0;
  EditMaskS = *blank;
  EditMaskSL = *zeros;
  RcvrVarSL = *zeros;
  return;
endif;

// Prepare/retrieve edit mask...
if EditMaskS(cn) = ' ';
  if Scale = 2;
    EditCode = 'N';
  else;
    EditCode = 'Q';
  endif;
  QECCVTEC (EditMask:EditMaskL:RcvrVarL:ZeroBalF:EditCode:' ':
   QECCVTEC (EditMask:EditMaskL:RcvrVarL:ZeroBalF:EditCode:' ':
             Precision:Scale:ApiError);
   EditMaskS(cn) = %subst(EditMask:1:EditMaskL);
   EditMaskSL(cn) = EditMaskL;
   RcvrVarSL(cn) = RcvrVarL;
 endif;

 // Edit number...
 EditMask = EditMaskS(cn);
 EditMaskL = EditMaskSL(cn);
 RcvrVarL = RcvrVarSL(cn);
 QECEDT (RcvrVar:RcvrVarL:SrcVar:NumType:Precision:
         EditMask:EditMaskL:' ':ApiError);
 return;

/end-free
**********************************************************************
p EditN           E
**********************************************************************

You can call it lik so:

Packed...
EditN(cn:Precision:Scale:'*PACKED':dataIn:dataOut);

Zoned...
EditN(cn:Precision:Scale:'*ZONED':dataIn:dataOut);

Binary...
EditN(cn:Precision:Scale:'*BINARY':dataIn:dataOut);

You just need to provide the numeric edit code (you can just start at 1 andincrement for each call), the precision, the scale, and two pointers (in foryour number, out for your character).

You can always re-engineer it to only have a sinlge return if it offends.:-)


Cheers

Larry Ducie

P.S. this was originally used by Beppe Costagliola in SQL2XML, but I use ita lot.