Re: parse a negative number out of a before image string

I converted my code to a (service) procedure, which should be able
to be used just as is. However, though it compiles clean I am unable to
test it. So, it will have to be vetted.

**free
// Though untested, this idea is sound. This procedure will return a
// piece of a data buffer -- whether that piece is a character string,
// integer (binary numeric) data, packed numeric data, zoned numeric
// data, or variable-length character data. All types are returned as
// a variable length string with the numeric types converted from
// their buffer form to a (zoned) character string with trailing sign.
// For data type, pass: C = character (default)
// B = big integer
// I = integer
// P = packed numeric
// S = small integer
// V = varchar (scale 4 or 2 by default)
// Z = zoned numeric
dcl-proc GetBufferPiece export;
dcl-pi *n varchar(256);
string_buffer char(65536) options(*varsize);
piece_type char(1) const;
beg_byte_pos packed(5:0);
max_byte_len packed(3:0);
max_scale packed(2:0) options(*omit);
end-pi;

dcl-ds char_area len(260);
varchar2_data varchar(256) pos(1);
varchar4_data varchar(256:4) pos(1);
zoned_data zoned(31:0) pos(1);
packed_data packed(31:0) pos(1);
bigint_data int(20) pos(1);
integer_data int(10) pos(1);
smallint_data int(5) pos(1);
end-ds;

dcl-c t_char 'C';
dcl-c t_bigint 'B';
dcl-c t_integer 'I';
dcl-c t_packed 'P';
dcl-c t_smallint 'S';
dcl-c t_varchar 'V';
dcl-c t_zoned 'Z';

dcl-s use_scale like(max_scale);

if %parms < %parmnum(max_scale)
or %addr(max_scale) = *null
or piece_type = t_varchar
and max_scale <> 4;
if piece_type = t_varchar;
use_scale = 2;
else;
use_scale = 0;
endif;
else;
use_scale = max_scale;
endif;

select;
when piece_type = t_bigint;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(bigint_data);
when piece_type = t_integer;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(integer_data);
when piece_type = t_packed;
packed_data = *zero;
%subst(char_area:%size(packed_data)-max_byte_len+1:max_byte_len)
= %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(packed_data / (10 ** use_scale));
when piece_type = t_smallint;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(smallint_data);
when piece_type = t_varchar and use_scale = 2;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len+2);
return varchar2_data;
when piece_type = t_varchar and use_scale = 4;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len+4);
return varchar4_data;
when piece_type = t_zoned;
zoned_data = *zero;
%subst(char_area:%size(zoned_data)-max_byte_len+1:max_byte_len)
= %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(zoned_data / (10 ** use_scale));
endsl;

char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %subst(char_area:1:max_byte_len);
end-proc;


Sincerely,

Dave Clark