|
When I call the SQLDsRsR passing in parameters in debug it works exactly
as expected.
When I call the SQLDsRsRT the SQLDsRsR pgm gets SQL state of 24501 and
returns no data.
I have done many stored procedures that contain only RPG code except for
when returning result set.
This is the first one that I have imbedded SQL code that is used to load
Result set DS.
Create command:
CREATE PROCEDURE
Utilities/Sqldsrsr
(IN VSICode CHARACTER ( 8),
IN Profile CHARACTER ( 4),
IN Class Character ( 4),
IN Environment Character ( 2))
Result Sets 1
LANGUAGE RPGLE
NOT DETERMINISTIC
CONTAINS SQL CALLED ON NULL
INPUT EXTERNAL NAME Utilities/Sqldsrsr
PARAMETER STYLE GENERAL
Procedure SQLDSRSR was created in UTILITIES.
SQLDsRsRT:
H Option(*SrcStmt : *NoDebugIO)
H DftActGrp(*No) ActGrp(*Caller)
//‚ DS For Data Set
D Results DS Occurs(1000)
D RItemNo 15
D RItemDesc 30
D RItemClass 4
D RItemUOM 2
D RItemVSICode 8
D RLot 10
D RLocation 7
D ROnHand 10S 3
D RMLdConv 3S 0
D RMatch 1
D VSICode S 8 Inz('15653000')
D Profile S 4 Inz('0812')
D Class S 4 Inz('MLD ')
D Envir S 2 Inz('AA')
D Done S N Inz('0')
D False S N Inz('0')
D True S N Inz('1')
D RsData S SQLTYPE(RESULT_SET_LOCATOR)
D SqlOK C '00000'
D SqlTrunk C '22002'
Exec SQL
Call SQLDsRsR(:VSICode, :Profile, :Class, :Envir);
If (SQlCode = 466);
Exec SQL
Associate Result Set Locators
(:RsData)
With Procedure SQLDsRsR;
Exec SQL
Allocate Data Cursor
For Result Set :RsData;
DoU Done;
Exec SQL
Fetch Data Into :Results;
If SQLCode = 0;
Else;
Leave;
EndIf;
EndDo;
Exec SQL
Close Data;
EndIf;
*InLr = True;
Return;
SQLDsRsR:
H Option(*SrcStmt : *NoDebugIO)
H DftActGrp(*No) ActGrp(*Caller) BndDir('QC2LE')
FItemAtrb03IF E K DISK
FSlQnty IF E K DISK
FItemAsA IF E K DISK
FParam IF E K DISK
D SDS
D Program *Proc
D JobName 244 253
D UserName 254 263
D JobNumber 264 269
//‚ DS For Data Set
D Results DS Occurs(1000)
D RItemNo 15
D RItemDesc 30
D RItemClass 4
D RItemUOM 2
D RItemVSICode 8
D RLot 10
D RLocation 7
D ROnHand 10S 3
D RMLdConv 3S 0
D RMatch 1
// ‚Input Parameters
D SQLDSRSR PR
D EntVSICode 8
D EntProfile 4
D EntClass 4
D EntEnv 2
D SQLDSRSR PI
D EntVSICode 8
D EntProfile 4
D EntClass 4
D EntEnv 2
D Done S N Inz('0')
D False S N Inz('0')
D Row S 5 0
D True S N Inz('1')
D SqlSelect S 1000
D SqlEndOfData C '02000'
D SqlOK C '00000'
D SqlCmpError C '01557'
D Tick C ''''
//š=========================================================
===========================
//‚ Mainline
//š=========================================================
===========================
/Free
// Set SQL Parameters
Exec SQL Set Option Naming = *SYS;
Clear Row;
Clear Results;
SqlSelect = 'Select Ia.IaText1, +
Ia.IaAttr, +
Im.ItNbr, +
Im.ItCls, +
Im.ItDsc, +
Im.UnMsr, +
Sq.LBhNo, +
Sq.LLocn, +
Sq.LQnty +
From ItemAtrb03 IA +
Inner Join ItemAsA Im On Ia.IaItemNo = Im.ItNbr +
Inner Join SlQnty SQ On Ia.IaItemNo = Sq.ItNbr +
Where Ia.IaAttr = ' + Tick + 'VSI CODE' + Tick +
' And (' +
'(SubStr(Ia.IaText1 , 1 , 8) = ' +
Tick + EntVSICode + Tick + ')' +
' Or ' +
'(SubStr(Ia.IaText1 , 1 , 4) = ' +
Tick + %SubSt(EntVSICode : 1 : 4) + Tick +
' And SubStr(Ia.IaText1 , 7 , 2) = ' +
Tick + %SubSt(EntVSICode : 7 : 2) + Tick + ')'
+
' Or ' +
'(SubStr(Ia.IaText1 , 1 , 4) = ' +
Tick + %SubSt(EntVSICode : 1 : 4) + Tick + ')'
+
' Or (SubStr(Ia.IaText1 , 1 , 2) = ' +
Tick + %SubSt(EntVSICode : 1 : 2) + Tick + ')'
+
')';
If EntProfile <> *Blanks;
SqlSelect = %Trim(SqlSelect) + ' And ' +
'SubStr(Im.ItDsc , 4 , 4) = ' +
Tick + EntProfile + Tick;
EndIf;
If EntClass <> *Blanks;
SqlSelect = %Trim(SqlSelect) + ' And ' +
'Im.ItCls = ' + Tick + EntClass + Tick;
EndIf;
//‚Prepare Sql Statement
Exec SQL Prepare ListCmd From :SqlSelect;
//‚Prepare Sql Statement
Exec SQL Declare ListCursor Cursor For ListCmd;
//‚Run Sql Statement
Exec SQL Open ListCursor;
//‚Init SubFile Control
DoU Done;
Exec Sql Fetch Next From ListCursor Into : IaText1,
: IaAttr,
: ItNbr,
: ItCls,
: ItDsc,
: UnMsr,
: LBhNo,
: LLocn,
: LQnty;
//‚Check For End Of Data
If (SqlSTT <> SqlOK);
Leave;
EndIf;
// Save Info
Row = Row + 1;
%Occur(Results) = Row;
RItemNo = ItNbr;
RItemDesc = ItDsc;
RItemClass = ItCls;
RItemUOM = UnMsr;
RItemVSICode = IaText1;
RLot = LBhNo;
RLocation = LLocn;
ROnHand = LQnty;
If %SubSt(ItCls : 1 : 3) = 'MLD';
Chain ('MOLDING LOT' : 'CONVERSION' : RLot) Param;
If %Found(Param);
RMldConv = PmVal1;
Else;
Clear RMldConv;
EndIf;
EndIf;
Select;
When IaText1 = EntVSICode;
RMatch = '0';
When %SubSt(IaText1 : 1 : 4) = %SubSt(EntVSICode : 1 : 4)
And %SubSt(IaText1 : 7 : 2) = %SubSt(EntVSICode : 7 : 2);
RMatch = '1';
When %SubSt(IaText1 : 1 : 4) = %SubSt(EntVSICode : 1 : 4);
RMatch = '2';
When %SubSt(IaText1 : 1 : 2) = %SubSt(EntVSICode : 1 : 2);
RMatch = '3';
EndSl;
EndDo;
If Row = 0;
Row = Row + 1;
%Occur(Results) = Row;
RItemDesc = 'no data';
EndIf;
Exec SQL
Close ListCursor;
Exec SQL
Set Result Sets Array :Results For :Row Rows;
*InLr = True;
SQLSelect field
Select Ia.IaText1, Ia.IaAttr, Im.ItNbr, Im.ItCls, Im.ItDsc,
Im.UnMsr, Sq.LBhNo, Sq.LLocn, Sq.LQnty From ItemAtrb03 IA In
ner Join ItemAsA Im On Ia.IaItemNo = Im.ItNbr Inner Join SlQ
nty SQ On Ia.IaItemNo = Sq.ItNbr Where Ia.IaAttr = 'VSI COD
E' And ((SubStr(Ia.IaText1 , 1 , 8) = '15653000') Or (SubStr
(Ia.IaText1 , 1 , 4) = '1565' And SubStr(Ia.IaText1 , 7 , 2)
= '00') Or (SubStr(Ia.IaText1 , 1 , 4) = '1565') Or (SubStr
(Ia.IaText1 , 1 , 2) = '15')) And SubStr(Im.ItDsc , 4 , 4) =
'0812' And Im.ItCls = 'MLD '
Subject to Change Notice:
WalzCraft reserves the right to improve designs, and to change
specifications without notice.
Confidentiality Notice:
This message and any attachments may contain confidential and privileged
information that is protected by law. The information contained herein is
transmitted for the sole use of the intended recipient(s) and should "only"
pertain to "WalzCraft" company matters. If you are not the intended
recipient or designated agent of the recipient of such information, you are
hereby notified that any use, dissemination, copying or retention of this
email or the information contained herein is strictly prohibited and may
subject you to penalties under federal and/or state law. If you received
this email in error, please notify the sender immediately and permanently
delete this email. Thank You;
WalzCraft PO Box 1748 La Crosse, WI. 54602-1748
www.walzcraft.com Phone... 608-781-6355
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://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: http://amzn.to/2dEadiD
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.
midrange.com
