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

Jay,

The following is my final solution for your situation. This is
all tested and seems to be working perfectly for the eight types of data I
came up with and will handle both positive and negative numbers as well as
up to 15 decimal places. Just be sure that you are using %SIZE for the
max_byte_len parameter as demonstrated in the following demo program. For
your own use you would just need to move the three procedures to a service
program that uses ctl-opt decprec(63).


**free
ctl-opt main(dlctest) dftactgrp(*no) decprec(63);

dcl-ds buffer len(1024);
b_char char(50);
b_bigint int(20);
b_integer int(10);
b_packed packed(11:2);
b_smallint int(5);
b_varchar2 varchar(256);
b_varchar4 varchar(256:4);
b_zoned zoned(11:2);
end-ds;

dcl-s pos packed(5:0);
dcl-s r_result varchar(50);

dcl-proc dlctest;
// build the buffer
pos = 1;
PutBufferPiece( buffer: 'This is a character string test.'
: 'C': pos: %size(b_char) );

pos += %size(b_char);
PutBufferPiece( buffer: %char(-9223372036854775807)
: 'B': pos: %size(b_bigint) );

pos += %size(b_bigint);
PutBufferPiece( buffer: %char(-2147483647)
: 'I': pos: %size(b_integer) );

pos += %size(b_integer);
PutBufferPiece( buffer: %char(-1234567.89)
: 'P': pos: %size(b_packed): %decpos(b_packed) );

pos += %size(b_packed);
PutBufferPiece( buffer: %char(-32767)
: 'S': pos: %size(b_smallint) );

pos += %size(b_smallint);
PutBufferPiece( buffer: 'This is a variable-character2 string test.'
: 'V': pos: %size(b_varchar2) );

pos += %size(b_varchar2);
PutBufferPiece( buffer: 'This is a variable-character4 string test.'
: 'V': pos: %size(b_varchar4): 4 );

pos += %size(b_varchar4);
PutBufferPiece( buffer: %char(-1234567.89)
: 'Z': pos: %size(b_zoned): %decpos(b_zoned) );

// now test the buffer
pos = 1;
r_result = GetBufferPiece( buffer: 'C': pos: %size(b_char) );

pos += %size(b_char);
r_result = GetBufferPiece( buffer: 'B': pos: %size(b_bigint) );

pos += %size(b_bigint);
r_result = GetBufferPiece( buffer: 'I': pos: %size(b_integer) );

pos += %size(b_integer);
r_result = GetBufferPiece( buffer: 'P': pos: %size(b_packed)
: %decpos(b_packed) );

pos += %size(b_packed);
r_result = GetBufferPiece( buffer: 'S': pos: %size(b_smallint) );

pos += %size(b_smallint);
r_result = GetBufferPiece( buffer: 'V': pos: %size(b_varchar2): 2 );

pos += %size(b_varchar2);
r_result = GetBufferPiece( buffer: 'V': pos: %size(b_varchar4): 4 );

pos += %size(b_varchar4);
r_result = GetBufferPiece( buffer: 'Z': pos: %size(b_zoned)
: %decpos(b_zoned) );
return;
end-proc;

// This procedure formats the result of a numeric expression as a
// variable-length numeric character string with the maximum scale
// requested. (Precision can be up to 46 and scale up to 15.)
dcl-proc Dec2CharFormat export;
dcl-pi *n varchar(50);
number_data zoned(46:15) const;
max_scale packed(2:0) const options(*nopass);
end-pi;

dcl-s use_scale like(max_scale);

if %parms < %parmnum(max_scale)
or %addr(max_scale) = *null;
use_scale = 0;
else;
use_scale = max_scale;
endif;

select;
when use_scale = 15;
return %char(%dech(number_data:46:15));
when use_scale = 14;
return %char(%dech(number_data:46:14));
when use_scale = 13;
return %char(%dech(number_data:46:13));
when use_scale = 12;
return %char(%dech(number_data:46:12));
when use_scale = 11;
return %char(%dech(number_data:46:11));
when use_scale = 10;
return %char(%dech(number_data:46:10));
when use_scale = 9;
return %char(%dech(number_data:46:9));
when use_scale = 8;
return %char(%dech(number_data:46:8));
when use_scale = 7;
return %char(%dech(number_data:46:7));
when use_scale = 6;
return %char(%dech(number_data:46:6));
when use_scale = 5;
return %char(%dech(number_data:46:5));
when use_scale = 4;
return %char(%dech(number_data:46:4));
when use_scale = 3;
return %char(%dech(number_data:46:3));
when use_scale = 2;
return %char(%dech(number_data:46:2));
when use_scale = 1;
return %char(%dech(number_data:46:1));
endsl;

return %char(%dech(number_data:46:0));
end-proc;

// 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 leading sign. For data type, pass:
// C = character (default)
// B = big integer
// I = integer
// P = packed numeric (max 46 precision)
// S = small integer
// V = varchar (scale 4, or 2 by default)
// Z = zoned numeric (max 46 precision)
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) const;
max_byte_len packed(3:0) const;
max_scale packed(2:0) const options(*nopass);
end-pi;

dcl-ds char_area len(260);
varchar2_data varchar(256) pos(1);
varchar4_data varchar(256:4) pos(1);
packed_data packed(46:0) pos(1);
zoned_data zoned(46: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);
dcl-s d_shift packed(17:0);

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;

d_shift = %int(10 ** use_scale);

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 Dec2CharFormat(packed_data/d_shift: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);
return varchar2_data;

when piece_type = t_varchar and use_scale = 4;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
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 Dec2CharFormat(zoned_data/d_shift:use_scale);
endsl;

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

// This procedure will update 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.
// For data type, pass:
// C = character (default)
// B = big integer
// I = integer
// P = packed numeric (max 46 precision)
// S = small integer
// V = varchar (scale 4, or 2 by default)
// Z = zoned numeric (max 46 precision)
dcl-proc PutBufferPiece export;
dcl-pi *n;
string_buffer char(65536) options(*varsize);
data_piece varchar(256) const;
piece_type char(1) const;
beg_byte_pos packed(5:0) const;
max_byte_len packed(3:0) const;
max_scale packed(2:0) const options(*nopass);
end-pi;

dcl-ds char_area len(260);
varchar2_data varchar(256) pos(1);
varchar4_data varchar(256:4) pos(1);
packed_data packed(46:0) pos(1);
zoned_data zoned(46: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);
dcl-s d_shift packed(17:0);

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;

d_shift = %int(10 ** use_scale);

select;
when piece_type = t_bigint;
bigint_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);

when piece_type = t_integer;
integer_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);

when piece_type = t_packed;
packed_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:%size(packed_data)-max_byte_len+1:max_byte_len
);

when piece_type = t_smallint;
smallint_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);

when piece_type = t_varchar and use_scale = 2;
varchar2_data = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);

when piece_type = t_varchar and use_scale = 4;
varchar4_data = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);

when piece_type = t_zoned;
zoned_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:%size(zoned_data)-max_byte_len+1:max_byte_len);

other;
char_area = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
endsl;

return;
end-proc;


Sincerely,

Dave Clark