How to code SQL embebed in RPGIII?

[uidamt98]

I have problem and do not know how to solve! (The compiler show error as syntax error)
I use SQL in RPG3 to delete all data from Physical file

It always show error : "THE CONTROL-LEVEL-INDICATOR ENTRY IS INVALID".
I write subroutine as below:

************************************************** *************
* function: Clear data in file ACo002
************************************************** *************
C CLEAR BEGSR
C*/EXEC SQL
C*+ PREPARE D FROM DELETE FROM ACO002
C*+ EXECUTE D
C*/END-EXEC
C ENDSR
************************************************** *************


I read document in RPG. It said that before use embebed SQL, we should declare "some thing" in calculation specification. But I do not know how and where to declare this statement.
Please help me it anyone know how to solve.
I attached my "picture program"!!!

Thanks in advance,

[arrow483]

Re: How to code SQL embebed in RPGIII?

Since SEU is giving the error, I think your first problem is the source "type". Type RPG does not support SQL.

Try type SQLRPG. Note: I would strongly suggest that any SQL-in-RPG be done in RPGLE (thats RPG-IV). There are many enhancements to SQL in RPG-IV.

[jamief]

Re: How to code SQL embebed in RPGIII?

Arrow483

Great to see you back.
Thanks for sharing your knowledge

Take care
Jamie

[uidamt98]

Re: How to code SQL embebed in RPGIII?

I think the same to you. RPGIII can not embeb SQL. But when I read the ebook from IBM name: "Application System/400 RPG/400 User's Guide", it has description as my attached files.
My boss over 20 years not know to use embebed SQL for RPG :-), I also do not want to upgrade to RPGLE!!! This language is very new and strange in Vietnam, so I think I must continue to use CHAIN and READ with " ancient RPG syntax":-)))

I sure that there are not any programmer still code RPG with SEU with old syntax.
Thanks for helping me. Am I really standstill SQL implementation in RPGIII?:-)

[arrow483]

Re: How to code SQL embebed in RPGIII?

I didn't say you couldn't use embedded SQL in RPG-3. What I said is the source TYPE can't be RPG. Change the source TYPE to SQLRPG, then try it.

[jamief]

Re: How to code SQL embebed in RPGIII?

uidamt98,

Try changing the program type to SQLRPG.

here is a program I found

       *******************************
      *Program Name        :  VFNDOBJ
      *Author              :  Victor Voilevitch
      *Date                :  25.05.1999
      *Programming Language:  RPG
      *Description: This program finds an object by its description text
      *Header Files Included: QUSGEN - Generic Header of a User Space
      *                       QUSEC - Error Code Parameter
      *                               (Copied into Program)
      *                       QUSLOBJ - List Objects API
      *
      *APIs Used:  QUSCRTUS - Create User Space
      *            QUSLOBJ  - List Objects
      *            QUSRTVUS - Retrieve User Space
      *            QUSDLTUS - Delete User Space
      *            QMHSNDPM - Send Program Message
      *            QMHRMVPM - Remove Program Message
      *            QUSRJOBI - Retrieve Job Information API
      *            QWTCHGJB - Change Job API
     F* Display file
     FVFNDOBJDCF  E                    WORKSTN
     E*  Message Arrays                                          
     E                    #ER    80  80  1
     E                    #E2     1   2 80
     E                    #WH     1  25 23
     E*  Message Id Array
     E                    #ID         7  1
     E*  RUNSQL command
     E                    #RS     1   1 50
     E*  Select parameter
     E                    #SS        50  1
     E*  File/Library Name
     E                    #NN        10  1
     E                    #N2        10  1
      *
     I*  Data Structures                                                 
     I* I.   Generic Header of a User Space Include
     I*
     I/COPY QSYSINC/QRPGSRC,QUSGEN
     I*
     I* II.  Error Code Parameter Include for the APIs
     I*
     I* The following QUSEC include is copied into this program
     I* so that the variable length field can be defined as a
     I* fixed length.
     I*
     I*Header File Name: H/QUSEC
     I*
     IQUSBN       DS
     I*                                             Qus EC
     I                                    B   1   40QUSBNB
     I*                                             Bytes Provided
     I                                    B   5   80QUSBNC
     I*                                             Bytes Available
     I                                        9  15 QUSBND
     I*                                             Exception Id
     I                                       16  16 QUSBNF
     I*                                             Reserved
     I*                                      17  17 QUSBNG
     I*
     I*                                      Varying length
     I                                       17 100 QUSBNG
     I*
     I*
     I* III. List Objects API Include
     I*
     I/COPY QSYSINC/QRPGSRC,QUSLOBJ
     I*
     I* Qualified User Space Data Structure
     I*
     IUSERSP      DS
     I I            'VFNDOBJUS '              1  10 USRSPC
     I I            'QTEMP     '             11  20 SPCLIB
     I* Qualified Object Name Data Structure
     I*
     IOBJECT      DS
     I I            '*ALL      '              1  10 OBJNAM
     I I            '*LIBL     '             11  20 OBJLIB
     I*
     I* Miscellaneous Data Structure
     I*
     I            DS
     I* Set up parameters for the Create User Space API
     I I            'VFNDOBJUS '              1  10 EXTATR
     I I            X'00'                    11  11 INTVAL
     I                                       12  12 RSVD1
     I I            256                   B  13  160INTSIZ
     I I            '*ALL      '             17  26 PUBAUT
     I I            'User space for      -   27  76 TEXT
     I              'objects list        -
     I              'STORE     '
     I I            '*YES      '             77  87 REPLAC
     I* Set up parameters for the List Objects API
     I I            'OBJL0200'               88  95 FORMAT
     I I            '*ALL      '             96 105 OBJTYP
     I                                      106 108 RSVD2
     I* Set up parameters for the Retrieve User Space API
     I I            1                     B 109 1120STRPOS
     I I            192                   B 113 1160LENDTA
     I                                    B 117 1200COUNT
     I*
     I* Parameters DS for send pgm msg API
     I*
     I            DS
     I I            'CPF9898'                 1   7 #MSGID
     I                                        8  27 #MSGF
     I I            'QCPFMSG'                 8  17 #MSGFI
     I I            '*LIBL'                  18  27 #MSGFL
     I                                       28 155 #MSGDT
     I I            80                    B 156 1590#MSGDL
     I I            '*INFO'                 160 169 #MSGTP
     I I            'VFNDOBJ'               170 179 #QUEUE
     I I            0                     B 180 1830#SNDTO
     I                                      184 187 #MSGKY
     I I            0                     B 188 1910#ERRCD
     I*
     I* Parameters DS for send pgm msg API (SQL messages)
     I*
     I            DS
     I                                        1   7 #QSGID
     I                                        8  27 #QSGF
     I I            'QCPFMSG'                 8  17 #QSGFI
     I I            '*LIBL'                  18  27 #QSGFL
     I                                       28 155 #QSGDT
     I                                    B 156 1590#QSGDL
     I I            '*INFO'                 160 169 #QSGTP
     I I            'VFNDOBJ'               170 179 #QSQUE
     I I            0                     B 180 1830#QSSTO
     I                                      184 187 #QSMKY
     I I            0                     B 188 1910#QSRCD
     I*
     I* Parameters DS for retrieve Job Information
     I* a) Information Returned
     I@JOBI       DS
     I*                                   Run Priority
     I                                    B  65  680#JIRUN
     I* b) Length of a)
     I            DS
     I I            68                    B   1   40#JILEN
     I*
     I* Parameters DS for changing Job
     I* Information Transferred
     I@JOBC       DS
     I*                             Number Of Keys
     I I            1                     B   1   40#JCKEN
     I*                             Length Of Whole Key
     I I            20                    B   5   80#JCKEL
     I*                             Key
     I I            1802                  B   9  120#JCKEY
     I*                             Type Of Data
     I I            'B'                      13  13 #JCDAP
     I*                             Reserved
     I                                       14  16 #JCD1
     I*                             Length Of Data
     I I            4                     B  17  200#JCDAL
     I*                             Data
     I                                    B  21  240#JCRUN
     I*
     I* Program status information DS
     I*
     I@SPSDS     SDS
     I                                     *PROGRAM MSGPQ
     I*
     I* Binary 4-digits zeroes field
     I              X'00000000'           C         C#0000
     I* Binary 4,0 to Zoned 4,0 conversion DS
     I            DS
     I                                    B   1   40#XER1
     I                                        1   40#XID
     I* Parameters DS for copy into file command
     I*
     I@COPYS      DS
     I I            'CPYF       FROMFILE('    1  20 #CPY1
     I I            'QTEMP/FINDTBL2)     '   21  40 #CPY2
     I I            'TOFILE(             '   41  60 #CPY3
     I                                       61  70 #LNAME
     I I            '/'                      71  71 #CPY4
     I                                       72  81 #FNAME
     I I            ') MBROPT(*ADD)      '   82 101 #CPY5
     I I            'CRTFILE(*YES)       '  102 121 #CPY6
       *
     C*  Mainline                                                  ****
     C*
     C* Change Run Priority.
     C*
     C* a) Retrieve Current Run Priority.
     C                     CALL 'QUSRJOBI'@PJOBI
     C* See if any errors were returned in the error code parameter.
     C           QUSBNC    IFGT 0
     C                     MOVEL*OFF      #RUNF
     C                     ENDIF
     C                     Z-ADD24        #N               Error #
     C                     EXSR ERRCOD
     C*
     C* b) Change Run Priority.
     C           #RUNF     IFEQ *ON
     C                     Z-ADD1         #JCRUN
     C                     CALL 'QWTCHGJB'@PJOBC
     C* See if any errors were returned in the error code parameter.
     C           QUSBNC    IFGT 0
     C                     MOVEL*OFF      #RUNF
     C                     ENDIF
     C                     Z-ADD25        #N               Error #
     C                     EXSR ERRCOD
     C                     ENDIF
     C*
     C* Create a user space.
     C                     Z-ADD100       QUSBNB           len of QUSBN
     C                     CALL 'QUSCRTUS'
     C                     PARM           USERSP
     C                     PARM           EXTATR
     C                     PARM           INTSIZ
     C                     PARM           INTVAL
     C                     PARM           PUBAUT
     C                     PARM           TEXT
     C                     PARM           REPLAC
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD1         #N               Error #
     C                     EXSR ERRCOD
     C*
     C* Default input
     C                     MOVELOBJLIB    $LIBL     P
     C                     MOVELOBJTYP    $TYPE     P
     C                     MOVEL'Y'       $CASE     P
     C*
     C* Create a tables.
     C/EXEC SQL
     C+ Create Table QTEMP/FINDTBL1
     C+ ( Library Char(10),
     C+   Object  Char(10),
     C+   Type    Char( 7),
     C+   Desc    Char(50)
     C+ )
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD6         #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Create Table QTEMP/FINDTBL2
     C+ ( Library Char(10),
     C+   Object  Char(10),
     C+   Type    Char( 7),
     C+   Desc    Char(50)
     C+ )
     C/END-EXEC
     C*
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD7         #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Label On Table QTEMP/FINDTBL2 Is
     C+ 'VFNDOBJ - output file'
     C/END-EXEC
     C*
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD17        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Create Table QTEMP/FINDTBL3
     C+ ( Desc    Char(50)
     C+ )
     C/END-EXEC
     C*
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD18        #N
     C                     EXSR ERRSQL
     C*
     C*=========================
     C*==       Start of main cycle                    
     C*==       get input and process it               
     C*=========================
     C           *INKC     DOWEQ*OFF
     C*
     C* Get user input values
     C                     WRITEMSGCTL
     C                     EXFMTMAIN
     C*
     C* HELP pressed
     C           *IN01     IFEQ *ON
     C                     EXFMTWHELP
     C                     ITER
     C                     ENDIF
     C* F3 pressed
     C           *INKC     IFEQ *ON
     C                     ITER
     C                     ENDIF
     C*
     C* F8 pressed
     C           *INKH     IFEQ *ON                        F8 pressed
     C           *IN20     IFEQ *ON                        Found any
     C                     CALL 'QCMDEXC'              21
     C                     PARM           #RS
     C                     PARM 50        #RSL   155
     C           *IN21     IFEQ *ON                        QCMDEXC error
     C* Process errors returned from the API.
     C                     MOVEL#WH,10    #STR
     C                     MOVEA#STR      #ER,18
     C                     MOVEA#ER       #MSGDT
     C                     EXSR MSGSND
     C                     ENDIF                           QCMDEXC error
     C                     ENDIF                           Found any
     C                     ITER
     C                     ENDIF                           F8 pressed
     C*
     C* F9 pressed
     C           *INKI     IFEQ *ON                        F9 pressed
     C           *IN20     IFEQ *ON                        Found any
     C           *IN26     DOWEQ*ON                        While not Enter
     C           *INKL     ANDEQ*OFF                       And   not F12
     C                     EXFMTWCOPY
     C                     ENDDO
     C           *IN26     IFNE *ON                        Enter Pressed
     C* Prepare names and copy into
     C                     CLEAR#FNAME
     C                     CLEAR#LNAME
     C                     CLEAR#N2
     C* File name...
     C                     MOVEA$FNAME    #NN       P
     C           ' '       CHECK$FNAME    #C             23
     C   23                MOVEA#NN,#C    #FNAME            file......
     C* Library name...
     C                     MOVEA$LNAME    #NN       P
     C           ' '       CHECK$LNAME    #C             23 Left  char
     C           ' '       CHEKR$LNAME    #G      20     23 Right char
     C                     Z-ADD10        #J      20        Last pos to
     C                     Z-ADD#G        #K      20        Last pos from
     C   23      #C        DO   #G        #P
     C                     MOVE #NN,#K    #N2,#J
     C                     SUB  1         #J
     C                     SUB  1         #K
     C                     ENDDO
     C                     MOVEA#N2       #LNAME            .......lib
     C* Copying...
     C                     CALL 'QCMDEXC'              21
     C                     PARM           @COPYS
     C                     PARM 121       #RSL
     C           *IN21     IFEQ *ON                        QCMDEXC error
     C* Process errors returned from the API.
     C                     MOVEL#WH,16    #STR
     C                     MOVEA#STR      #ER,18
     C                     MOVEA#ER       #MSGDT
     C                     EXSR MSGSND
     C                     ENDIF                           QCMDEXC error
     C                     ENDIF                           Enter Pressed
     C                     ENDIF                           Found any
     C                     ITER
     C                     ENDIF                           F9 pressed
     C*
     C* Not Enter pressed
     C           *IN26     IFEQ *ON
     C                     ITER
     C                     ENDIF
     C*
     C* Hide F8, F9 Buttons
     C                     MOVE *OFF      *IN20
     C                     Z-ADD0         NNALL
     C                     Z-ADD0         NNSEL
     C*
     C* Clearing tables.
     C/EXEC SQL
     C+ Delete From QTEMP/FINDTBL1
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD13        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Delete From QTEMP/FINDTBL2
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD14        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Delete From QTEMP/FINDTBL3
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD22        #N
     C                     EXSR ERRSQL
     C*
     C* Clear messages
     C                     CALL 'QMHRMVPM'
     C                     PARM 'VFNDOBJ' #CLRQ  10
     C                     PARM C#0000    #CLRCN  4
     C                     PARM '    '    #CLRKY  4
     C                     PARM '*ALL'    #CLRRM 10
     C                     PARM C#0000    #CLRER  4
     C*
     C* Handle input request
     C                     MOVEL$LIBL     OBJLIB    P
     C                     MOVEL$TYPE     OBJTYP    P
     C*
     C* Get a list of all objects in the library.
     C                     CALL 'QUSLOBJ'
     C                     PARM           USERSP
     C                     PARM           FORMAT
     C                     PARM           OBJECT
     C                     PARM           OBJTYP
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD2         #N
     C                     EXSR ERRCOD
     C*
     C* Look at the generic header. This contains information
     C* about the list data section that is needed when processing
     C* the entries.
     C                     Z-ADD1         STRPOS           start of QUSBP
     C                     Z-ADD192       LENDTA           len of QUSBP
     C                     CALL 'QUSRTVUS'
     C                     PARM           USERSP
     C                     PARM           STRPOS
     C                     PARM           LENDTA
     C                     PARM           QUSBP
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD3         #N
     C                     EXSR ERRCOD
     C*
     C*
     C* Check the information status field, QUSBPJ, to see if the
     C* API was able to return all the information. Possible values
     C* are:  C -- Complete and accurate
     C*       P -- Partial but accurate
     C*       I -- Incomplete.
     C           QUSBPJ    IFEQ 'C'
     C           QUSBPJ    OREQ 'P'
     C*
     C* Issue message how many objects found with any description.
     C                     MOVE *ON       *IN22
     C                     Z-ADDQUSBPS    NNALL
     C*
     C*         --------------------------------
     C*         -- handle list of objects     --
     C*         --------------------------------
     C* Check to see if any entries were put into the user space.
     C           QUSBPS    IFGT 0
     C                     Z-ADD1         COUNT
     C* Because RPG is Base 1, the offset must be increased by one.
     C           QUSBPQ    ADD  1         STRPOS
     C                     Z-ADD91        LENDTA
     C*
     C* Build selecting criteria.
     C*
     C* Convert to Uppercase if needed
     C           $CASE     IFNE 'Y'                        no match case
     C* Add one row into the table 3 for conversion to uppercase
     C/EXEC SQL
     C+ Insert Into QTEMP/FINDTBL3
     C+   Values (:$DESC)
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD20        #N
     C                     EXSR ERRSQL
     C*
     C* Read one row from table 3 (converted to uppercase by standard
     C*                            SQL tools independent of language)
     C/EXEC SQL
     C+ Select Upper(Desc)
     C+   Into :$DESC
     C+   From QTEMP/FINDTBL3
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD21        #N
     C                     EXSR ERRSQL
     C*
     C                     ENDIF                           no match case
     C*
     C                     CLEAR#SS
     C                     MOVEA$DESC     #SS,1
     C* Fill left blanks with '%'
     C           ' '       CHECK$DESC     #C      20     23
     C  N23                Z-ADD50        #C               all blanks
     C   23                SUB  1         #C               last blank
     C           1         DO   #C        #P      20
     C                     MOVE '%'       #SS,#P
     C                     ENDDO
     C* Fill right blanks with '%'
     C           ' '       CHEKR$DESC     #C      20     23
     C   23                ADD  1         #C
     C   23      #C        DO   50        #P
     C                     MOVE '%'       #SS,#P
     C                     ENDDO
     C* Selecting criteria is ready.
     C                     MOVEA#SS       #SELCT 50
     C*
     C* Walk through all the entries in the user space.
     C           COUNT     DOWLEQUSBPS
     C                     CALL 'QUSRTVUS'
     C                     PARM           USERSP
     C                     PARM           STRPOS
     C                     PARM           LENDTA
     C                     PARM           QUSDN
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD4         #N
     C                     EXSR ERRCOD
     C*
     C* ============= Process the concrete object ==============.
     C* 1. Add one row in the table 1 ==========================.
     C/EXEC SQL
     C+ Insert Into QTEMP/FINDTBL1
     C+   Values (:QUSDNC, :QUSDNB, :QUSDND, :QUSDNH)
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD8         #N
     C                     EXSR ERRSQL
     C*
     C* 2. Select the row into table 2 =========================.
     C           $CASE     IFNE 'Y'                        NO match case
     C/EXEC SQL
     C+ Insert Into QTEMP/FINDTBL2
     C+   Select *
     C+     From QTEMP/FINDTBL1
     C+     Where Upper(Desc) Like :#SELCT
     C/END-EXEC
     C                     ELSE                            match case !
     C/EXEC SQL
     C+ Insert Into QTEMP/FINDTBL2
     C+   Select *
     C+     From QTEMP/FINDTBL1
     C+     Where Desc Like :#SELCT
     C/END-EXEC
     C                     ENDIF                           match case ?
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD9         #N
     C                     EXSR ERRSQL
     C*
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD15        #N
     C                     EXSR ERRSQL
     C* 3. Delete the row from table 1 =========================.
     C/EXEC SQL
     C+ Delete From QTEMP/FINDTBL1
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD13        #N
     C                     EXSR ERRSQL
     C*
     C* ============= End of processing the concrete object ====.
     C*
     C                     ADD  1         COUNT
     C                     ADD  QUSBPT    STRPOS
     C*                 ** do for each objects
     C                     ENDDO
     C*
     C* Count the selected objects.
     C/EXEC SQL
     C+ Select Count(*)
     C+   Into :NNSEL
     C+   From QTEMP/FINDTBL2
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD15        #N
     C                     EXSR ERRSQL
     C*
     C* Show F8, F9 Buttons
     C           NNSEL     IFGT 0
     C                     MOVE *ON       *IN20
     C                     ENDIF
     C*
     C*         --------------------------------
     C*         -- end handle list of objects --
     C*         --------------------------------
     C*                 ** if objects > 0
     C                     ENDIF
     C*
     C*                 ** if status is 'C' or 'P'
     C                     ENDIF
     C*
     C* Information in the user space is not accurate.
     C           QUSBPJ    IFEQ 'I'
     C                     MOVEA#E2,1     #MSGDT
     C                     EXSR MSGSND
     C                     ENDIF
     C*
     C* Information in the user space is partial.
     C           QUSBPJ    IFEQ 'P'
     C                     MOVEA#E2,2     #MSGDT
     C                     EXSR MSGSND
     C                     ENDIF
     C*
     C*                 ** do until F3 pressed
     C                     ENDDO
     C*====================================================
     C*==       End   of main cycle                    ====
     C*==       get input and process it               ====
     C*====================================================
     C*
     C* Delete the user space called APIUG1 in library QGPL.
     C                     CALL 'QUSDLTUS'
     C                     PARM           USERSP
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD5         #N
     C                     EXSR ERRCOD
     C*
     C* Deleting tables.
     C/EXEC SQL
     C+ Drop Table QTEMP/FINDTBL1
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD11        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Drop Table QTEMP/FINDTBL2
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD12        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Drop Table QTEMP/FINDTBL3
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD19        #N
     C                     EXSR ERRSQL
     C*
     C*
     C* Restore Run Priority.
     C           #RUNF     IFEQ *ON
     C                     Z-ADD#JIRUN    #JCRUN
     C                     CALL 'QWTCHGJB'@PJOBC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD25        #N               Error #
     C                     EXSR ERRCOD
     C                     ENDIF
     C*
     C*
     C*
     C                     SETON                     LR
     C                     RETRN
     C*
     C*****************************************************************
     C* End of Mainline                                            ****
     C*****************************************************************
     C*
     C*****************************************************************
     C* Subroutine to handle errors returned in the error code     ****
     C* parameter (User Space errors).                             ****
     C*****************************************************************
     C*
     C           ERRCOD    BEGSR
     C           QUSBNC    IFGT 0
     C*
     C* Process errors returned from the API.
     C                     MOVEL#WH,#N    #STR
     C                     MOVEA#STR      #ER,18
     C                     MOVEA#ER       #MSGDT
     C                     EXSR MSGSND
     C* Original message returned by API
     C                     CALL 'QMHSNDPM'
     C                     PARM           QUSBND
     C                     PARM           #MSGF
     C                     PARM           QUSBNG
     C                     PARM           QUSBNC
     C                     PARM           #MSGTP
     C                     PARM           #QUEUE
     C                     PARM           #SNDTO
     C                     PARM           #MSGKY
     C                     PARM           #ERRCD
     C* Exit if US create/delete error
     C           #N        IFEQ 1
     C           #N        OREQ 5
     C                     EXSR EXIT
     C                     ENDIF
     C*
     C                     ENDIF
     C                     ENDSR
     C*
      *
     C*****************************************************************
     C* Subroutine to handle errors returned in the error code     ****
     C* parameter (SQL errors).                                    ****
     C*****************************************************************
     C*
     C           ERRSQL    BEGSR
     C           SQLCOD    IFLT 0
     C*
     C* Process errors returned from the API.
     C                     MOVEL#WH,#N    #STR
     C                     MOVEA#STR      #ER,18
     C                     MOVEA#ER       #MSGDT
     C                     EXSR MSGSND
     C* Original message returned by API
     C                     MOVEA'CPF'     #ID,1
     C                     Z-ADDSQLER1    #XER1
     C                     MOVEL#XID      ##TMPS  4
     C                     MOVEA##TMPS    #ID,4
     C                     MOVEA#ID       #QSGID
     C                     CALL 'QMHSNDPM'
     C                     PARM           #QSGID
     C                     PARM           #QSGF
     C                     PARM SQLERM    #QSGDT
     C                     PARM SQLERL    #QSGDL
     C                     PARM           #QSGTP
     C                     PARM           #QSQUE
     C                     PARM           #QSSTO
     C                     PARM           #QSMKY
     C                     PARM           #QSRCD
     C* Exit if tables create/drop error
     C           #N        IFEQ 6                          create error
     C           SQLCOD    ANDNE-601                       already exist
     C           #N        OREQ 7                          create error
     C           SQLCOD    ANDNE-601                       already exist
     C           #N        OREQ 18                         create error
     C           SQLCOD    ANDNE-601                       already exist
     C           #N        OREQ 11
     C           #N        OREQ 12
     C           #N        OREQ 19
     C                     EXSR EXIT
     C                     ENDIF
     C*
     C                     ENDIF
     C                     ENDSR
     C*
      *
     C*****************************************************************
     C* Subroutine to send program message to current message queue****
     C*****************************************************************
     C*
     C           MSGSND    BEGSR
     C                     CALL 'QMHSNDPM'
     C                     PARM           #MSGID
     C                     PARM           #MSGF
     C                     PARM           #MSGDT
     C                     PARM           #MSGDL
     C                     PARM           #MSGTP
     C                     PARM           #QUEUE
     C                     PARM           #SNDTO
     C                     PARM           #MSGKY
     C                     PARM           #ERRCD
     C                     ENDSR
     C*****************************************************************
     C* Subroutine to exit                                         ****
     C*****************************************************************
     C*
     C           EXIT      BEGSR
     C                     SETON                     LR
     C                     RETRN
     C                     ENDSR
     C*
     C*****************************************************************
     C* Initialization                                             ****
     C*****************************************************************
     C*
     C           *INZSR    BEGSR
     C*
     C           *NAMVAR   DEFN           #N      20       err#
     C           *NAMVAR   DEFN           #STR   23        err data
     C                     MOVEL*ON       #RUNF   1        Run Prty Flag
     C*
     C* Cancel Commitment
     C/EXEC SQL
     C+ Set Transaction Isolation Level No Commit
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD23        #N
     C                     EXSR ERRSQL
     C*
     C                     ENDSR
     C*
     C*****************************************************************
     C* Parameters List                                            ****
     C*****************************************************************
     C*
     C* Retrieving Job Information API
     C           @PJOBI    PLIST
     C                     PARM           @JOBI
     C                     PARM           #JILEN
     C                     PARM 'JOBI0100'P@FORM  8
     C                     PARM '*'       P@JOB  26
     C                     PARM *BLANKS   P@JOBN 16
     C                     PARM           QUSBN
     C*
     C* Change Job API
     C           @PJOBC    PLIST
     C                     PARM '*'       P@JOB  26
     C                     PARM *BLANKS   P@JOBN 16
     C                     PARM 'JOBC0100'P@FORM  8
     C                     PARM           @JOBC
     C                     PARM           QUSBN
     C*
     C*****************************************************************
**
Error occured by
**
The objects information is incomplete - process stopped
The objects information is partial but accurate - process was continued
**
creating userspace                 1
getting list of objects            2
retrieving header                  3
retrieving object info             4
deleting userspace                 5
creating table 1                   6
creating table 2                   7
inserting into table 1             8
inserting into table 2             9
viewing table 2                   10
dropping table 1                  11
dropping table 2                  12
deleting from table 1             13
deleting from table 2             14
counting table 2                  15
copying into file                 16
labeling table 2                  17
creating table 3                  18
dropping table 3                  19
inserting into table 3            20
selecting from table 3            21
deleting from table 3             22
cancelling commitment             23
retrieving Job inf.               24
changing run priority             25
**
RUNQRY QRYFILE((QTEMP/FINDTBL2))

[uidamt98]

Re: How to code SQL embebed in RPGIII?

To Mr Arrow, sorry for not understand clearly your idea. But I do not know how to change the source TYPE to SQLRPG. Please support me whenever you have time!

I try to implement as jamief description. Thanks:-)
Thanks in advance!

[uidamt98]

Re: How to code SQL embebed in RPGIII?

I try to code as sample code above but still have error "The Control-Level-Indicator Entry is invalid". Why does it show this error? and How to solve this problem?

Thanks

[jamief]

Re: How to code SQL embebed in RPGIII?

Arrow & I keep telling you....

when you go to work with your member in your source file

WRKMBRPDM

The type of that member is RPG It should be SQLRPG
Then you will be fine..


Change the type of the source member in PDM


Cheers

Jamie

[uidamt98]

Re: How to code SQL embebed in RPGIII?

Dear all,
I changed type from RPG to PDM. The compiler do not show error as above.
And I copy this funtion to my program:
************************************************** *************
* function: Clear data in file ACo002
************************************************** *************
C CLEAR BEGSR
C/EXEC SQL
C+ DELETE FROM PNEVJUN/ACO002
C/END-EXEC
C ENDSR
************************************************** *************
But when I compile this program. It shows error as file attached!

Please help me explain what happened and how fix this error? (I am going to "destination"!:-)))

Thanks a lot.

[jamief]

Re: How to code SQL embebed in RPGIII?

uidamt98 says:

I changed type from RPG to PDM.


Please change from RPG to SQLRPG
Then you will be fine

RPG to SQLRPG


Thanks
Jamie

[uidamt98]

Re: How to code SQL embebed in RPGIII?

Thanks for supporting,
I already change type to SQLRPG.
But when I compile, it still shows errors:

10500 C CLEAR BEGSR
10600 C/EXEC SQL
* 5175 5175-**.. . . .
* 5006 5006-*. . . .
* 5007 5007-** . . .
* 5007 5007-**. .
* 5006 5006-* .
* 5015 5015-*****
5722WDS V5R3M0 030905 IBM RPG/400 PNE
SEQUENCE
NUMBER *...1....+....2....+....3....+....4....+....5....+ ....6....+....
10700 C+ DELETE FROM ACO002
* 5175 5175-**.. .. . . .
* 5006 5006-*. .. . . .
* 5007 5007-**.. . . .
* 5006 5006-*. . . .

I think the width of SEU source not suitable of this type! Isn't it?
Why does the compiler always catch error in blank character? Please help me!

Thanks!

[jamief]

Re: How to code SQL embebed in RPGIII?

I would guess at this point you dont have SQL installed on your system...which seems odd you being on v5r3......


to check use command GO LICPGM
take option 10
look for SQL installed.
5722ST1 *COMPATIBLE DB2 Query Mgr and SQL DevKit


post your entire source code
use iseries navigator or client access to export it in proper format and I will test on my box.


thanks
Jamie

[pjk]

Re: How to code SQL embebed in RPGIII?

Or try using RPGiLE instead... That might be another option.

[arrow483]

Re: How to code SQL embebed in RPGIII?

ARe you compiling with CRTRPGPGM or CRTRPGSQL ? You need to use CRTRPGSQL to compile if SQL is embedded.