Re: fill Array using SQL -- RPG400-L

Hi,

you have to fetch the single value per row into a workfield and after movethis workfield into the appropriate array element.In your example you always fill A1CODE (or the first array element becauseit's overlayed by the array).


C/EXEC SQL
C+ FETCH C1 INTO :WrkField
C/END-EXEC
C                   EVAL      Array(i) = WrkField
C                   EVAL      i = i + 1

If you want to return multiple rows with a single fetch, you either have todefine a multi occurrence data structure or an array data structure, but notan array.


Mit freunlichen Grüßen / Best regards

Birgitta Hauser

"Shoot for the moon, even if you miss, you'll land among the stars." (LesBrown)

"If you think education is expensive, try ignorance." (Derek Bok)

----- Original Message -----From: <fkany@xxxxxxxxxxxxxxxxxx>

To: <rpg400-l@xxxxxxxxxxxx>
Sent: Friday, October 20, 2006 21:32
Subject: fill Array using SQL


Happy Friday everbody!

I'd appreciate any suggestions on why my program isn't filling an array
using SQL.

I've created the test program below to see how to populate an Array with
SQL.  At first I set my break point at the end of the program so that I
could go check the values in the array.  I found that the array was blank.

I reset my break point at the FETCH(C                   Z-ADD     -4
SQLER6) statement and re-ran the program.
The following line of code populates the array element:
C                   EVAL      A1CODE = SQL_00011

The next line of code clears it out:
C                   EVAL      VNDSVCCDE = SQL_00012

Debug View:
======================================
C*EXEC SQL
C* FETCH C1 INTO :Array1:i
C*END-EXEC
C                   Z-ADD     -4            SQLER6
C                   CALL      SQLROUTE
C                   PARM                    SQLCA
C                   PARM                    SQL_00006
C     SQL_00009     IFEQ      '1'
C                   EVAL      A1CODE = SQL_00011
C                   EVAL      VNDSVCCDE = SQL_00012
C                   EVAL      I = SQL_00013
C                   END
C                   EVAL      i = i + 1
C                   IF        i = 999
C                   LEAVE
C                   ENDIF
C                   ENDDO
C                   ENDIF


Source Code:
=================================
    D i               S              5i 0
    D @SQLCMD         S             47A
     *
     * Vendor Service Code Array
    D Array1          DS
    D  A1Code                        3A
    D VndSvcCde                           LIKE(A1Code) OVERLAY(Array1)
DIM(999)
     *
     * Embedded SQL Initializations
    C/EXEC SQL
    C+ Set Option
    C+     Naming    = *Sys,
    C+     Commit    = *None,
    C+     UsrPrf    = *User,
    C+     DynUsrPrf = *User,
    C+     Datfmt    = *Iso,
    C+     CloSqlCsr = *EndMod,
    C+     Commit    = *NONE
    C/END-EXEC
     *
     * Build Vendor Service Code Array
    C                   EVAL      @SQLCMD = 'select max(SVCD26) ' +
    C                                       'from CARRIER '       +
    C                                       'group by SVCD26'
    C/EXEC SQL
    C+ PREPARE SQL1 FROM :@SQLCMD
    C/END-EXEC
    C/EXEC SQL
    C+ DECLARE C1 CURSOR FOR SQL1
    C/END-EXEC
    C/EXEC SQL
    C+ OPEN C1
    C/END-EXEC
    C                   IF        SQLCOD >= 0
    C                   EVAL      i = 1
    C                   DOU       SQLCOD < 0
    C/EXEC SQL
    C+ FETCH C1 INTO :Array1:i
    C/END-EXEC
    C                   EVAL      i = i + 1
    C                   IF        i = 999
    C                   LEAVE
    C                   ENDIF
    C                   ENDDO
    C                   ENDIF
    C/EXEC SQL
    C+ CLOSE C1
    C/END-EXEC
     *
    C                   EVAL      *INLR = *ON
    C                   RETURN

--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.