Exemple :
UTSQL SQL('update MaBib/MonFic set MaZone = 'MaValeur' Where ... )
CMD PROMPT('SQL Execute Immediate')
PARM KWD(SQL) TYPE(*CHAR) LEN(2000) MIN(1) +
PROMPT('Insert-Update-Delete.NO Select')
PARM KWD(CR) TYPE(*CHAR) LEN(1) DSPINPUT(*NO) +
CHOICE(*NONE)
pgm &pa_sql dcl &pa_sql *char 2000 dcl &pa_cr *dec ( 1 0 ) 0 dcl &msg *char 80 dcl &msgid *char 7 dcl &msgf *char 10 dcl &msgdta *char 512 call utsql ( &pa_sql &pa_cr ) z010: rcvmsg pgmq( *same ) + msgtype( *any ) + msg( &msg ) + msgdta( &msgdta ) + msgid( &msgid ) + msgf( &msgf ) if ( &msg *ne ' ' ) do sndpgmmsg msgid( &msgid ) msgf( &msgf ) msgdta( &msgdta ) enddo endpgm
h dftactgrp( *no ) actgrp( *caller )
*---------------------------------------------------------------------
* Create parm prototypes
*---------------------------------------------------------------------
d SndPgmMsg PR ExtPgm('QMHSNDPM')
d MessageID 7 Const
d QualMsgF 20 Const
d MsgData 256 Const
d MsgDtaLen 10i 0 Const
d MsgType 10 Const
d CallStkEnt 10 Const
d CallStkCnt 10i 0 Const
d MessageKey 4
d ErrCode * Const
*---------------------------------------------------------------------
* Stand Alone Fields
*---------------------------------------------------------------------
d pa_sql s 2000
d pa_cr s 1 0
d msgid s 7
d msgdta s 80
d msgtype s 10
d CallStkCnt s 10i 0
d wwTheKey s 4
d codsql s like(sqlcod)
d wsq ds
d wsqcod 9
d wsqnum 3 overlay(wsqcod:6)
**************************************************************
* *
* Execute immediate: INSERT, UPDATE, DELETE, CREATE, etc. *
* ( SELECT direct (full select) pas admis ) *
* *
**************************************************************
c *entry plist
c parm pa_sql
c parm pa_cr
c/Exec sql Set Option Commit = *None
c/End-Exec
c eval *inlr = *on
c eval pa_cr = 0
c/Exec sql Execute immediate :pa_sql
c/End-Exec
* sqlcod < 0 --> Error
c if sqlcod < 0
c eval pa_cr = -1
c eval codsql = sqlcod * -1
c eval wsqcod = %editc(codsql:'X')
c eval msgid = 'SQL' + %subst(wsqcod: 6: 4)
c eval msgtype = '*DIAG'
c else
c if %subst(sqlerr: 21: 1) <> x'00'
c eval msgid = 'SQL' + %subst(sqlerr: 21: 4)
c else
c eval wsqcod = %editc(sqlcod:'X')
c eval msgid = 'SQL' + %subst(wsqcod: 6: 4)
c endif
c eval msgtype = '*INFO'
c endif
c eval CallStkCnt = 2
c callp SndPgmMsg( msgid :
c 'QSQLMSG *LIBL' :
c SQLERM :
c SQLERL :
c msgtype :'*' :
c CallStkCnt:wwTheKey:
c *null )
c return
