|
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
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-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.