|
Warning, long message. Tim, I have attached (hopefully) a shell I use to return result sets from SQL. I think it might fill your requirement of unlimited result sets. It is based on examples and information from Dan Cruikshank at Rochester iSeries Services Group. I don't remember which release you are on; we are at V5R2. The code is in free form but I think it could easily be changed to columns. Rick -----Original Message----- From: Hatzenbeler, Tim [mailto:thatzenbeler@xxxxxxxxxxxxx] Sent: Wednesday, March 12, 2003 4:22 PM To: 'RPG programming on the AS400 / iSeries' Subject: RE: Stored Procedure? with Result Set. Thanks... I got it to work, but unfortuantly, the calling program, didn't want a result set... It wanted just the in,out paramaters... So I did get it to work... But as for returning a result set, I worked with the example,. that placed the values in a mult-occr-ds and it worked... But I didn't like being constrained to the limits of a DS, but then again, by the time I filled that DS, my end users would not be happy... But for night time batch jobs, I would like unlimited result sets... But oh well, I look forward to reading your article... tim
midrange.com
h bnddir('xxxxxxxxxx') dftactgrp(*no) actgrp(*caller)
?*---------------------------------------------------------------------------------------------
?* Program . . : Author . . : Rick Chevalier
?* Date . . . . : 1/12/2003
?* Purpose . . :
?*---------------------------------------------------------------------------------------------
?* Modifications:
?*
?* Project Date Developer Description
?*---------------------------------------------------------------------------------------------
?* xxxxxxxxx xx/xx/xxxx xxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
?*---------------------------------------------------------------------------------------------
?*
?*---------------------------------------------------------------------------------------------
?* File definitions
?*---------------------------------------------------------------------------------------------
?*
?*---------------------------------------------------------------------------------------------
?* External procedure prototypes
?*---------------------------------------------------------------------------------------------
?* Send a message to the program message queue.
dsndpgmmsg pr 4
d 7
Message ID
d 20
Qualified msg file
d * const
Message data
d 10 options(*nopass)
Message type
d 10 options(*nopass)
Stack entry
d 9b 0 options(*nopass)
Stack counter
?*---------------------------------------------------------------------------------------------
?* Internal procedure prototypes
?*---------------------------------------------------------------------------------------------
?*---------------------------------------------------------------------------------------------
?* Data definitions
?*---------------------------------------------------------------------------------------------
?* Parameters for call to SndPgmMsg
d spmMsgID s 7
d spmMsgF s 20
d spmMsgDta@ s * Inz(%Addr(spmMsgDta))
d spmMsgDta s 1024
d spmMsgTyp s 10
d spmStkEnt s 10
d spmStkCtr s 9b 0
?* Format of returned SQL record
d sqlRecord ds Occurs(xxx) Based(sqlRecord@)
d Field1 3s 0
d Field2 12s 0
d Field3 30
?* SQL control values
d sqlRecord@ s *
Point to 1st record
d sqlMem@ s *
Point to SQL memory
d NbrRows s 10u 0
Rows to be returned
d RowCnt s 10u 0
Actual rows returned
/Free
//?-----------------------------------------------------------------------------------------
//?Calculations
//?-----------------------------------------------------------------------------------------
?* Declare cursor for SQL statement
c/Exec SQL
c+ Declare C1 Cursor for
c+ Select mmCty, mmNote, mmName, mmAdr1, mmAdr2, mmAdr3, mmAdr4, mmAdr5,
c+ mmZip, mmZip2, mmLast, mmFrst
c+ From LNMMAD
c+ Where MMMGID = :pMgID
c+ Order by MMCTY, MMZIP, MMZIP2, MMLAST, MMFRST
c/End-Exec
?* Open cursor
c/Exec SQL
c+ Open C1
c/End-Exec
?* Retrieve first record
c/Exec SQL
c+ Fetch from C1 for :NbrRows rows into :sqlRecord
c/End-Exec
/Free
Select;
//?Fetch returned an empty set
When SQLStt = '02000';
//?Fetch returned a good record set
When SQLStt = '00000';
//?Fetch records until end of file
DoW SQLStt = '00000';
//?Read through returned records
For RowCnt = 1 to SQLER3 by 1;
//?Move to next record
sqlRecord@ = sqlRecord@ + %Size(sqlRecord);
EndFor; //?RowCnt = 1 to SQLER3 by 1
//?If end of table reached exit loop
If SQLER5 = 100;
Leave;
EndIf;
//?Reset to beginning of data structure
sqlRecord@ = sqlMem@;
/End-Free
?* Retrieve next record
c/Exec SQL
c+ Fetch from C1 for :NbrRows rows into :sqlRecord
c/End-Exec
/Free
EndDo; //?SQLStt = '00000'
EndSl;
/End-Free
?* Close cursor
c/Exec SQL
c+ Close C1
c/End-Exec
/Free
*InLr = *On;
//?-----------------------------------------------------------------------------------------
//?*INZSR - Program initialization
//?-----------------------------------------------------------------------------------------
BegSr *INZSR;
//?Allocate memory for number of records returned from SQL fetch
Monitor;
SQLMem@ = %Alloc(%Elem(SQLRecord) * %Size(SQLRecord));
SQLRecord@ = SQLMem@;
NbrRows= %Elem(SQLRecord);
//?If allocate fails send escape message
On-Error 00425 :00426;
spmMsgID = 'LN60110';
spmMsgF = 'LNMSGF *LIBL ';
spmMsgDta = sdsProc + %EditC(sdsStatus :'3');
spmMsgTyp = '*ESCAPE';
spmStkEnt = '*';
spmStkCtr = 3;
CallP SndPgmMsg(spmMsgID: spmMsgF: spmMsgDta@:
spmMsgTyp: spmStkEnt:
spmStkCtr);
EndMon;
EndSr;
//?-----------------------------------------------------------------------------------------
//?Define - Define key lists and parameter lists
//?-----------------------------------------------------------------------------------------
BegSr Define;
EndSr;
/End-Free
?*---------------------------------------------------------------------------------------------
?* Internal procedure
?*---------------------------------------------------------------------------------------------
pinternalproc b export
dinternalproc pi
dparm1 10
dparm2 5s 0
dparm3 9b 0
dparm4 * const
/Free
/End-Free
pinternalproc e
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
