|
Here it is, it's quite old so can probably be moderised a bit, but
hopefully it'll be something like what you need.
h debug(*yes)
h datfmt(*iso) datedit(*YMD/)
d CrtMINumD...
d pr 10i 0
d pvstfDBNTyp 1a value
d pvbinLen 10i 0 value
d pvbinFrc 10i 0 value
d X_T_SIGNED c const(00)
d X_T_FLOAT c const(01)
d X_T_ZONED c const(02)
d X_T_PACKED c const(03)
d X_T_CHAR c const(04)
d X_T_ONLYNS c const(06)
d X_T_ONLYN c const(07)
d X_T_EITHER c const(08)
d X_T_OPEN c const(09)
d X_T_UNSIGNED c const(10)
d CpyNv pr extproc('_CPYNV')
d TrgMINumD 10i 0 value
d ptrTrgNum * value
d SrcMINumD 10i 0 value
d SrcNum * value
d Example ds
d Packed 9p 2
d Char s 9s 2
d SrcNumDsc s 10i 0
Source descriptor
d TgtNumDsc s 10i 0
Target descriptor
/free
Packed = 12345.67; // Initialise example
// Create the MI numeric descriptors for the source and target
formats.
SrcNumDsc = CrtMINumD('P': 9: 2); // Source format is packed 9.2
TgtNumDsc = CrtMINumD('S': 9: 2); // Target format is zoned 9.2
// Do the conversion.
CpyNV(TgtNumDsc: // Target descriptor
%addr(Char): // Target value
SrcNumDsc: // Source descriptor
%addr(Example)); // Source value
return;
/end-free
//********************************************************************************************
// This procedure emulates the C macro found in QSYSINC/MIH,MICPTCOM
// which is used to create an MI number descriptor for the MI numeric
// instructions.
//********************************************************************************************
p CrtMINumD b
d pi 10i 0
d pvstfDBNTyp 1a value
d pvbinLen 10i 0 value
d pvbinFrc 10i 0 value
d pbinMINTyp s 10i 0
/free
// Convert the database field type to MI field type.
select;
when pvstfDBNTyp = 'S';
pbinMINTyp = X_T_ZONED;
when pvstfDBNTyp = 'F';
pbinMINTyp = X_T_FLOAT;
when pvstfDBNTyp = 'P';
pbinMINTyp = X_T_PACKED;
when pvstfDBNTyp = 'S';
pbinMINTyp = X_T_ZONED;
other;
pbinMINTyp = X_T_CHAR;
endsl;
return pbinMINTyp * (2**24) + // Shift right 24 bits
pvbinFrc * (2**16) + // Shift right 16 bits
pvbinLen * (2**8); // Shift right 8 bits
/end-free
p e
//********************************************************************************************
________________________________
From: MIDRANGE-L <midrange-l-bounces@xxxxxxxxxxxxxxxxxx> on behalf of Jay
Vaughn <jeffersonvaughn@xxxxxxxxx>
Sent: 28 February 2020 18:42
To: Midrange Systems Technical Discussion <midrange-l@xxxxxxxxxxxxxxxxxx>
Subject: Re: parse a negative number out of a before image string
Tim it is indeed... as long as no sql is used in it.
I would very much appreciate it.
Jay
On Fri, Feb 28, 2020 at 12:41 PM Tim Fathers <X700-IX2J@xxxxxxxxxxx>
wrote:
If I understand the problem correctly, you can use the MI function"cpynv"
to extract an arbitrary numeric field from it's binary form (as youmight
find in a trigger buffer, for example) to a string. It can be prototypedJay
as a built-in function and used directly from RPG, the only fiddly bit is
creating the to and from descriptors the function needs.
I have an example somewhere I could dig out if it's what you're after.
Tim.
________________________________
From: MIDRANGE-L <midrange-l-bounces@xxxxxxxxxxxxxxxxxx> on behalf of
Vaughn <jeffersonvaughn@xxxxxxxxx>now
Sent: 28 February 2020 18:21
To: Midrange Systems Technical Discussion <midrange-l@xxxxxxxxxxxxxxxxxx
Subject: Re: parse a negative number out of a before image string
I hate to beat a dead horse with this topic but never really found a
solution using only RPG... my solution was derived from using SQL, but
I need an RPG solution only.wrote:
So running with Barbara's suggestion...
challenge - extract for a number of bytes, the length of a packed decimal
value (may contain decimals)
objective - convert that clear text value
In my pgm i have the below declaration...
d ds_cvtNumeric ds qualified
d charRep 31
d numRep 31 10 overlay(charRep)
d g_zeros s like(ds_cvtNumeric.charRep)
d inz(*all'0')
my string value that contains the packed value is 5 bytes long
(decimal(9.2)... and obviously in debug it is the reverse image
representation (non clear text).
in debug...
evalr ds_cvtNumeric.charRep = g_zeros +
%trim(%subst(srcString
:1
:i_numOfBytes)); = 5
o_clearTextValue = %char(ds_cvtNumeric.numRep);
this ends up with a data decimal error...
the debug eval shows...
EVAL ds_cvtnumeric
DS_CVTNUMERIC.NUMREP = 000000000000000000000.00000
DS_CVTNUMERIC.CHARREP = '00000000000000000000000000 '
I would really like to put this one to bed.
Any assistance is greatly appreciated.
Jay
On Wed, Oct 30, 2019 at 3:10 PM Barbara Morris <bmorris@xxxxxxxxxx>
create a
On 2019-10-30 11:51 a.m.,10/30/2019
dlclark@xxxxxxxxxxxxxxxx wrote:
"MIDRANGE-L" <midrange-l-bounces@xxxxxxxxxxxxxxxxxx> wrote on
11:46:31 AM:
You - what Dave says.
You could make the routine more generic if you needed it but this is
the simple way to map a single field.
Yes, for example (to make it more generic), you could
zoned15-character field and overlay it with a 15-digit (zero decimal)
dividethefield. Then, move zeroes to the zoned field before right justifying
character data into the character field. Then, you just have to
https://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Flists.midrange.com%2Fmailman%2Flistinfo%2Fmidrange-l&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971676106&sdata=%2Fwn6A9uG2sCM741Th4WrBdQhKpOsPUJiwK5czEVSauo%3D&reserved=0ofthe resulting zoned decimal number (into another field) by the number
listdesired decimal places that you got from SYSCOLUMNS.
To get the leading zeros and right-justify the character value in one
go, use EVALR with a character variable initialized to zeros.
dcl-ds cvtzoned qualified;
c char(15);
n zoned(15) overlay(c);
end-ds;
dcl-s zeros like(cvtzoned.c) inz(*all'0');
evalr cvtzoned.c = zeros + '1234N';
dsply (%char(cvtzoned.n));
--
Barbara
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
To post a message email: MIDRANGE-L@xxxxxxxxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit:
https://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Farchive.midrange.com%2Fmidrange-l&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971676106&sdata=8%2BWlK3qN2utN%2Bwj2nDlM6u5LsY9jD8GnmgWnrZpgbYQ%3D&reserved=0or email: MIDRANGE-L-request@xxxxxxxxxxxxxxxxxx
Before posting, please take a moment to review the archives
at
.https://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Famazon.midrange.com&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=I6xQGFIBJm75xguVouLUn2pm2EPs3ZCtoNwAqiOzh%2F8%3D&reserved=0
Please contact support@xxxxxxxxxxxx for any subscription related
questions.
Help support midrange.com by shopping at amazon.com with our affiliate
link:
list--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
To post a message email: MIDRANGE-L@xxxxxxxxxxxxxxxxxxhttps://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Flists.midrange.com%2Fmailman%2Flistinfo%2Fmidrange-l&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=GfM4yTKWnZ%2BIulr4SIwsjXBFUIplwXy7uGxWJmZEi2g%3D&reserved=0
To subscribe, unsubscribe, or change list options,
visit:
or email: MIDRANGE-L-request@xxxxxxxxxxxxxxxxxxhttps://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Farchive.midrange.com%2Fmidrange-l&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=51v2sUXMVLjkClvzovxD1aegrEhaR%2FmCMXXqMsZ%2FYis%3D&reserved=0
Before posting, please take a moment to review the archives
at
.https://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Famazon.midrange.com&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=I6xQGFIBJm75xguVouLUn2pm2EPs3ZCtoNwAqiOzh%2F8%3D&reserved=0
Please contact support@xxxxxxxxxxxx for any subscription related
questions.
Help support midrange.com by shopping at amazon.com with our affiliate
link:
--list
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
To post a message email: MIDRANGE-L@xxxxxxxxxxxxxxxxxxhttps://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Flists.midrange.com%2Fmailman%2Flistinfo%2Fmidrange-l&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=GfM4yTKWnZ%2BIulr4SIwsjXBFUIplwXy7uGxWJmZEi2g%3D&reserved=0
To subscribe, unsubscribe, or change list options,
visit:
or email: MIDRANGE-L-request@xxxxxxxxxxxxxxxxxxhttps://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Farchive.midrange.com%2Fmidrange-l&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=51v2sUXMVLjkClvzovxD1aegrEhaR%2FmCMXXqMsZ%2FYis%3D&reserved=0
Before posting, please take a moment to review the archives
at
.
https://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Famazon.midrange.com&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=I6xQGFIBJm75xguVouLUn2pm2EPs3ZCtoNwAqiOzh%2F8%3D&reserved=0
Please contact support@xxxxxxxxxxxx for any subscription related
questions.
Help support midrange.com by shopping at amazon.com with our affiliate
link:
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@xxxxxxxxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit:
https://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Flists.midrange.com%2Fmailman%2Flistinfo%2Fmidrange-l&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=GfM4yTKWnZ%2BIulr4SIwsjXBFUIplwXy7uGxWJmZEi2g%3D&reserved=0
or email: MIDRANGE-L-request@xxxxxxxxxxxxxxxxxx
Before posting, please take a moment to review the archives
at
https://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Farchive.midrange.com%2Fmidrange-l&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=51v2sUXMVLjkClvzovxD1aegrEhaR%2FmCMXXqMsZ%2FYis%3D&reserved=0
.
Please contact support@xxxxxxxxxxxx for any subscription related
questions.
Help support midrange.com by shopping at amazon.com with our affiliate
link:
https://eur05.safelinks.protection.outlook.com/?url=https%3A%2F%2Famazon.midrange.com&data=02%7C01%7C%7Cf10dfd92ff2c431615a108d7bc75b14b%7C84df9e7fe9f640afb435aaaaaaaaaaaa%7C1%7C0%7C637185085971686100&sdata=I6xQGFIBJm75xguVouLUn2pm2EPs3ZCtoNwAqiOzh%2F8%3D&reserved=0
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@xxxxxxxxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: https://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxxxxxxxx
Before posting, please take a moment to review the archives
at https://archive.midrange.com/midrange-l.
Please contact support@xxxxxxxxxxxx for any subscription related
questions.
Help support midrange.com by shopping at amazon.com with our affiliate
link: https://amazon.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.