contact image

Structured Query Language (SQL)

Various examples of using SQL on IBM system i - DB2 tables. This section includes both stand alone examples and embedded within SQLRPGLE & CLLE using QSHELL.


Post Your Example

Use SQL in a REXX script


Sample from Martin posted at 2013-05-08 05:36:53

/* Copy a physical file and all it's logical files, with or without data (Y/N) */                                
trace n                                                                                                
copy = '*YES'                                                                                          
parse upper arg file '/' fromlib tolib yn .                                                            
if file = '' then do                                                                                   
   say 'FileFisico/DaLibreria ALibreria Y/N'                                                           
   pull file '/' fromlib tolib yn .                                                                    
end                                                                                                    
if yn = 'N' then copy = '*NO'                                                                          
call DoCmd 'DSPDBR FILE(&FROMLIB/&FILE) OUTPUT(*OUTFILE) OUTFILE(QTEMP/QWHDRDBR)'                      
call DoCmd 'CRTDUPOBJ OBJ(&file) FROMLIB(&FROMLIB) OBJTYPE(*FILE) TOLIB(&TOLIB) DATA('copy')'          
say file 'copied in' tolib copy                                                                       
call DoSql "SET OPTION COMMIT = *NONE"                                                                 
call DoSql "declare dbr scroll cursor for select whrefi from QTEMP/QWHDRDBR order by whrefi"           
call DoSql "open dbr"                                                                                  
do until SqlCode <> 0                                                                                  
  call DoSql "fetch dbr into :whrefi", "100"                                                           
  if SqlCode = 0 & whrefi <> '          ' then do                                                      
    call DoCmd 'CRTDUPOBJ OBJ(&whrefi) FROMLIB(&FROMLIB) OBJTYPE(*FILE) TOLIB(&TOLIB) DATA('copy')'    
    say whrefi 'copied in' tolib copy                                                     
  end                                                                                      
end                                                                                        
call DoSql "close dbr"                                                                     
exit 0                                                                                     
                                                                                           
DoSql:                                                                                     
parse arg cmd, allow                                                                       
ADDRESS '*EXECSQL' 'EXECSQL' cmd                                                           
if rc <> 0 & pos(strip(sqlcode)||' ',allow||' ')=0 then do                                 
  say 'Sql:' cmd                                                                           
  say 'Rc=' rc 'Sqlcode=' strip(sqlcode) 'Sqlstate=' sqlstate                              
  if sqlcode < 0 then do                                                                   
    sqlcode = -sqlcode                                                                     
    if sqlcode <= 9999                                                                     
    then cod = 'SQL' || right('0000' || sqlcode, 4)                                        
    else cod = 'SQ' || right('00000' || sqlcode, 5)                                        
    txt=left(' ',512)                                                                      
    'RTVMSG MSGID(&COD) MSGF(QSYS/QSQLMSG) MSGDTA(&SQLERRMC) MSG(&TXT)'                    
    say cod strip(txt)                                                                     
  end                                                                             
  exit                                                                            
end                                                                               
return                                                                            
                                                                                  
DoCmd:                                                                            
 parse arg cmd, allow, dta                                                        
 ADDRESS '*COMMAND' cmd                                                           
 irc = rc                                                                         
 if rc <> 0 & pos(rc,allow)=0 then do                                             
    say cmd                                                                       
    txt=left(' ',512)                                                             
    'RTVMSG MSGID(&irc) MSGF(QSYS/QCPFMSG) MSGDTA(&DTA) MSG(&TXT)'                
    say 'Rc:' irc strip(txt)                                                      
    exit                                                                          
 end                                                                              
 return                                                                           

Select multiple records into an array in SQLRPGLE program


Sample from Jamie Flanary posted at 2012-04-24 20:03:04

d myrows          s             10i 0                           
                                                                
d MyPoDS          ds                  Qualified  dim(100)       
d  PO#                           7  0                           
                                                                
 /free                                                          
                                                                
     // grab the PO's for this vendor                           
     exec sql declare  A33  cursor for                          
     select bcpo#                                               
     from brc07hst                                              
     join pchspch b on bcpo# = phpo#                            
     join pcavend c on phven# = paven#                          
     where  date(bcprtstmp) = '2012-04-24' and bccompany = 15   
     and phven# = 78123                                         
     group by bcpo#                                             
     order by bcpo#;                                            
                                                                
     exec sql open A33 ;                        
                                                 
    Myrows = %elem(MyPoDS);                      
    exec sql FETCH A33   for :MyRows rows        
             INTO :MyPoDs;                       
                                                 
      *inlr = *on;                               
                                                 
/end-free  

How to Concatenate Year(numeric), month(numeri) and Day(Numeric) and then use between.


Sample from Alam Fernandez posted at 2012-02-14 17:37:54

/Free

   Exec SQL                                    
   Select *                                                            
   From Table                                                      
   Where Digits(Year)||Digits(Month)||Digits(Day) Between '20110301' And '20120228' ;

/End-Free

Insert all rows(only one field) from one table to another


Sample from Alam Fernandez posted at 2012-02-13 05:58:55

/Free
   Exec SQL                                    
   Insert Into Table2(Field1)               
          Select field1 From Table1
/End-Free

Update records from a table which the records exist in the other Table


Sample from Alam Fernandez posted at 2012-02-08 06:20:42

/Free

  Exec Sql
  UPDATE LIBRARY/TABLE1 a SET FIELD1 = 'New Value'
  WHERE exists (Select * From LIBRARY/Table2 b where a.ID = b.ID)

/End-Free

Delete records from a table which the records do not exist in the other Table


Sample from Alam Fernandez posted at 2012-02-08 06:20:29

/Free

  Exec Sql
  Delete From Table1 a
  WHERE not exists (select * from Table2 b   
                    where a.ID = b.ID) ;   

/End-Free

Using SQL to load a subfile


Sample from Jamie Flanary posted at 2012-01-22 18:30:41

t t  H Option(*SrcStmt: *NoDebugIO) DftActGRP(*No)                                                  
t t   *                                                                                             
      * PROGRAM - SQLSBFR                                                                           
      * PURPOSE - example load subfile using sql                                                    
      * WRITTEN - 99/99/9999                                                                        
      * AUTHOR  - xxxxx xxxxxxxx                                                                    
                                                                                                    
      * PROGRAM DESCRIPTION                                                                         
      *   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                                
      *                                                                                             
      * INDICATOR USAGE                                                                             
      *   03 - leave current screen                                                                 
      *-----------------------------------------------------------------------------                
                                                                                                    
                                                                                                    
     fSQLSBFD   cf   e             workstn INFDS(INFDS)                                             
     f                                     SFILE(SUB01:RRN1)                                        
      *                                                                                             
      * Variable Definition                                                                         
      *                                                                                             
     d count           s              4  0                                                          
     d EndScreen1      s               n                                                            
     d LenStr          s              4  0                                                          
     d messagecsc      s             10i 0                                                          
     d messagedata     s             80A                                                            
     d messagekey      s              4A                                                            
     d messagelen      s             10i 0                                                          
     d messagefile     s             20    inz('QCPFMSG   *LIBL')                                   
     d messageid       s              7                                                             
     d RRN1            s                   like(SCRRN)                                              
     d Savrrn          s                   like(SCRRN)                                              
     d screenerror     s               n                                                            
     d sqlstmt         s           2000    varying                                                  
     d title30         s             30                                                             
     d title40         s             40                                                             
     d year1           s              4  0                                                          
     d year2           s              4  0                                                          
     d year3           s              4  0                                                          
      //                                                                                            
      // Program Info                                                                               
      //                                                                                            
     d                SDS                                                                           
     d  @PGM                 001    010                                                             
     d  @PARMS               037    039  0                                                          
     d  @MSGDTA               91    170                                                             
     d  @MSGID               171    174                                                             
     d  @JOB                 244    253                                                             
     d  @USER                254    263                                                             
     d  @JOB#                264    269  0                                                          
                                                                                                    
      // Command Keys                                                                               
                                                                                                    
     d Cmd01           c                   const(x'31')                         Cmd-1               
     d Cmd02           c                   const(x'32')                         Cmd-2               
     d LeaveProgram    c                   const(x'33')                         Cmd-3               
     d Cmd04           c                   const(x'34')                         Cmd-4               
     d Cmd05           c                   const(x'35')                         Cmd-5               
     d Cmd06           c                   const(x'36')                         Cmd-6               
     d Cmd07           c                   const(x'37')                         Cmd-7               
     d Cmd08           c                   const(x'38')                         Cmd-8               
     d Cmd09           c                   const(x'39')                         Cmd-9               
     d Cmd10           c                   const(x'3A')                         Cmd-10              
     d Cmd11           c                   const(x'3B')                         Cmd-11              
     d Cmd12           c                   const(x'3C')                         Cmd-12              
     d Cmd13           c                   const(x'B1')                         Cmd-13              
     d Cmd14           c                   const(x'B2')                         Cmd-14              
     d Cmd15           c                   const(x'B3')                         Cmd-15              
     d Cmd16           c                   const(x'B4')                         Cmd-16              
     d Cmd17           c                   const(x'B5')                         Cmd-17              
     d Cmd18           c                   const(x'B6')                         Cmd-18              
     d Cmd19           c                   const(x'B7')                         Cmd-19              
     d Cmd20           c                   const(x'B8')                         Cmd-20              
     d Cmd21           c                   const(x'B9')                         Cmd-21              
     d Cmd22           c                   const(x'BA')                         Cmd-22              
     d Cmd23           c                   const(x'BB')                         Cmd-23              
     d Cmd24           c                   const(x'BC')                         Cmd-24              
     d EnterKey        c                   const(x'F1')                                             
     d RollUp          c                   const(x'F5')                         Roll Up             
     d RollDown        c                   const(x'F4')                         Roll Down           
                                                                                                    
     d Infds           ds                                                       INFDS data structure
     d Choice                369    369                                                             
     d Currec                378    379I 0                                                          
                                                                                                    
      //                                                                                            
      //  external called programs                                                                  
      //                                                                                            
                                                                                                    
     d $sendmsg        PR                  ExtPgm('QMHSNDPM')                                       
     d   MessageID                    7A   Const                                                    
     d   QualMsgF                    20A   Const                                                    
     d   MsgData                    256A   Const                                                    
     d   MsgDtaLen                   10I 0 Const                                                    
     d   MsgType                     10A   Const                                                    
     d   CallStkEnt                  10A   Const                                                    
     d   CallStkCnt                  10I 0 Const                                                    
     d   Messagekey                   4A                                                            
     d   ErrorCode                  256A                                                            
                                                                                                    
     d $clearmsg       pr                  extpgm('QMHRMVPM')                                       
     d   messageq                   276a   const                                                    
     d   CallStack                   10i 0 const                                                    
     d   Messagekey                   4a   const                                                    
     d   messagermv                  10a   const                                                    
     d   ErrorCode                  256                                                             
                                                                                                    
     d APIError        ds                  Qualified                                                
     d  BytesP                 1      4I 0 inz(%size(apiError))                                     
     d  BytesA                 5      8I 0 inz(0)                                                   
     d  Messageid              9     15                                                             
     d  Reserved              16     16                                                             
     d  messagedta            17    256                                                             
                                                                                                    
                                                                                                    
     d openList        PR                                                                           
     d FetchNext       PR              N                                                            
     d closeList       PR                                                                           
                                                                                                    
                                                                                                    
     d sqldata         ds                  Qualified                                                
     d  Customer                      7  0 overlay(sqldata:1)                                       
     d  sales10                       9  2 overlay(sqldata:*next)                                   
     d  Qty10                         7  0 overlay(sqldata:*next)                                   
     d  sales11                       9  2 overlay(sqldata:*next)                                   
     d  Qty11                         7  0 overlay(sqldata:*next)                                   
     d  sales12                       9  2 overlay(sqldata:*next)                                   
     d  Qty12                         7  0 overlay(sqldata:*next)                                   
                                                                                                    
      /Free                                                                                         
                                                                                                    
        //--------------------------------------------------------                                  
        // MAIN PROGRAM                                                                             
        //--------------------------------------------------------                                  
                                                                                                    
            PGMQ = @PGM;                                                                            
            hdprogram = @PGM;                                                                       
            year1 = %subdt(%date():*years);                                                         
            c1year1 = year1;                                                                        
            c1year2 = c1year1;                                                                      
            year2 = %subdt(%date()-%years(1):*years);                                               
            c1year3 = year2;                                                                        
            c1year4 = c1year2;                                                                      
            year3 = %subdt(%date()-%years(2):*years);                                               
            c1year5 = year3;                                                                        
            c1year6 = c1year3;                                                                      
                                                                                                    
            Title30 = 'Code400.com';                                                                
            LenStr = ((%len(Title30) -                                                              
            %len(%trim(Title30))) / 2) + 1;                                                         
            %subst(hdcompany:LenStr) = %trim(Title30);                                              
                                                                                                    
            Title40 = 'SQL Load *All subfile';                                                      
            LenStr = ((%len(Title40) -                                                              
            %len(%trim(Title40))) / 2) + 1;                                                         
            %subst(c1title:LenStr) = %trim(Title40);                                                
                                                                                                    
            exsr $clearsfl;                                                                         
            exsr $loadsfl;                                                                          
            exsr $screen1;                                                                          
                                                                                                    
            *inlr = *on;                                                                            
                                                                                                    
        //--------------------------------------------------------                                  
        // $Screen1 - parameter screen                                                              
        //--------------------------------------------------------                                  
             begsr $Screen1;                                                                        
                                                                                                    
             reset  EndScreen1;                                                                     
              dow  EndScreen1 = *off;                                                               
                                                                                                    
               if ScreenError = *off;                                                               
                $clearmsg('*' : *zero : *Blanks : '*ALL' : APIError);                               
               endif;                                                                               
                                                                                                    
               write FKEY01;                                                                        
               write MSGCTL;                                                                        
               exfmt SUB01CTL;                                                                      
               $clearmsg('*' : *zero : *Blanks : '*ALL' : APIError);                                
               reset ScreenError;                                                                   
                                                                                                    
               if Currec <> *Zeros;                                                                 
                RRN1  =  Currec;                                                                    
                SCRRN =  Currec;                                                                    
               endif;                                                                               
                                                                                                    
               select;                                                                              
            //                                                                                      
            // F3 pressed end the program F3 = LeaveProgram                                         
            //                                                                                      
                when  Choice = LeaveProgram;                                                        
                 EndScreen1 = *on;                                                                  
            //                                                                                      
            // Enter Key pressed                                                                    
            //                                                                                      
                when  Choice = enterKey;                                                            
                                                                                                    
                endsl;                                                                              
               enddo;                                                                               
                                                                                                    
             endsr;                                                                                 
                                                                                                    
        //--------------------------------------------------------                                  
        // $Validate - Validate screen entries                                                      
        //--------------------------------------------------------                                  
             begsr $Validate;                                                                       
                                                                                                    
                                                                                                    
             endsr;                                                                                 
                                                                                                    
        //--------------------------------------------------------                                  
        // $process - process subfile number one                                                    
        //--------------------------------------------------------                                  
             begsr $process;                                                                        
                                                                                                    
              for count = 1 to SAVRRN;                                                              
               chain count SUB01;                                                                   
                if %found;                                                                          
                endif;                                                                              
              endfor;                                                                               
                                                                                                    
                                                                                                    
             endsr;                                                                                 
                                                                                                    
        //----------------------------------------                                                  
        // $clearSfl - clear the subfile                                                            
        //----------------------------------------                                                  
             begsr $clearSFL;                                                                       
                                                                                                    
              // clear the subfile first                                                            
                                                                                                    
               *in31 = *Off;                                                                        
               *in32 = *Off;                                                                        
               *in30 = *On;                                                                         
                                                                                                    
               write  SUB01CTL;                                                                     
                                                                                                    
               *in31 = *On;                                                                         
               *in32 = *On;                                                                         
               *in30 = *Off;                                                                        
                                                                                                    
               clear RRN1;                                                                          
               clear SCRRN;                                                                         
               clear SavRrn;                                                                        
                                                                                                    
                                                                                                    
             endsr;                                                                                 
                                                                                                    
        //--------------------------------------------------------                                  
        // $loadsfl- load up the entire subfile                                                     
        //--------------------------------------------------------                                  
             begsr $loadsfl;                                                                        
                                                                                                    
              if  SavRrn  > *zeros;                                                                 
               RRN1  =  SavRrn;                                                                     
               SCRRN =  SavRrn;                                                                     
              endif;                                                                                
                                                                                                    
            sqlstmt =                                                                               
             ' select  cstnumber , ' +                                                              
             ' dec(sum(case when year(transdate) = ' + %char(year3) +                               
             ' then amount$ else 0 end),10,2) as Sales10, ' +                                       
             ' dec(sum(case when year(transdate) = ' + %char(year3)  +                              
             ' then amount# else 0 end),7,0) as Qty10, ' +                                          
             ' dec(sum(case when year(transdate) = ' + %char(year2) +                               
             ' then amount$ else 0 end),10,2) as Sales11 , ' +                                      
             ' dec(sum(case when year(transdate) = ' + %char(year2) +                               
             ' then amount# else 0 end),7,0) as Qty11, '  +                                         
             ' dec(sum(case when year(transdate) = ' + %char(year1) +                               
             ' then amount$ else 0 end),10,2) as Sales12 , ' +                                      
             ' dec(sum(case when year(transdate) = ' + %char(year1) +                               
             ' then amount# else 0 end),7,0) as Qty12 ' +                                           
             ' from orderp  ' +                                                                     
             '     group by cstnumber  order by sales12 desc';                                      
                                                                                                    
                                                                                                    
                                                                                                    
                                                                                                    
            openList();                                                                             
            dow fetchNext();                                                                        
                                                                                                    
             S1CUSTOMER = sqldata.Customer;                                                         
             S1SALES3 = sqldata.sales10;                                                            
             S1QTY3 = sqldata.Qty10;                                                                
             S1SALES2 = sqldata.sales11;                                                            
             S1QTY2 = sqldata.Qty11;                                                                
             S1SALES1 = sqldata.sales12;                                                            
             S1QTY1 =  sqldata.Qty12;                                                               
                                                                                                    
             rrn1 += 1;                                                                             
             SCRRN = rrn1;                                                                          
             write sub01;                                                                           
                                                                                                    
            enddo;                                                                                  
            closeList();                                                                            
                                                                                                    
              *in33 = *on;                                                                          
              savrrn = SCRRN;                                                                       
           //                                                                                       
           //  If no records in subfile then do not disply the subfile.                             
           //                                                                                       
              if SavRrn  = *zeros;                                                                  
               *in31 = *off;                                                                        
              else;                                                                                 
               RRN1  = 1;                                                                           
               SCRRN  = 1;                                                                          
              endif;                                                                                
                                                                                                    
             endsr;                                                                                 
                                                                                                    
        //----------------------------------------                                                  
        // $sendmessage - send the program message                                                  
        //----------------------------------------                                                  
             begsr $sendmessage;                                                                    
                                                                                                    
              $sendmsg(messageID   :                                                                
                       messageFile :                                                                
                       messagedata :                                                                
                       messageLen  :                                                                
                       '*DIAG'     :                                                                
                       @PGM        :                                                                
                       messagecsc  :                                                                
                       messagekey  :                                                                
                       APIError                                                                     
                                   );                                                               
                                                                                                    
             endsr;                                                                                 
                                                                                                    
      /End-Free                                                                                     
      *--------------------------------------------------------                                     
      *  openList  - Open a cursor to read file                                                     
      *--------------------------------------------------------                                     
     p openList        b                                                                            
                                                                                                    
     d openList        pi                                                                           
                                                                                                    
     c/exec sql                                                                                     
     c+ declare MyCursor cursor                                                                     
     c+    for statement                                                                            
     c/end-exec                                                                                     
     c/exec sql                                                                                     
     c+ prepare statement from :sqlstmt                                                             
     c/end-exec                                                                                     
     c/exec sql                                                                                     
     c+ open mycursor                                                                               
     c/end-exec                                                                                     
                                                                                                    
     p openList        e                                                                            
      *--------------------------------------------------------                                     
      *  fetchNext  - read one record at a time                                                     
      *--------------------------------------------------------                                     
     p fetchNext       b                                                                            
                                                                                                    
     d fetchNext       pi              n                                                            
                                                                                                    
     c/exec sql                                                                                     
     c+ fetch next from mycursor                                                                    
     c+    into :sqldata                                                                            
     c/end-exec                                                                                     
      /free                                                                                         
         if sqlstt < '02000';                                                                       
           return *on;                                                                              
         else;                                                                                      
           return *off;                                                                             
         endif;                                                                                     
      /end-free                                                                                     
                                                                                                    
     p fetchNext       e                                                                            
      *--------------------------------------------------------                                     
      *  closeOrderList  - Close the OrderHdr cursor                                                
      *--------------------------------------------------------                                     
     p closeList       b                                                                            
                                                                                                    
     d closeList       pi                                                                           
                                                                                                    
     c/exec sql                                                                                     
     c+ close MyCursor                                                                              
     c/end-exec                                                                                     
                                                                                                    
     p closeList       e                                                                            

Using Case & group in SQL to total sales by year


Sample from Jamie Flanary posted at 2012-01-21 10:15:50

select  cstnumber ,                         
dec(sum(case when year(transdate) = 2010    
then amount$ else 0 end),10,2) as Sales10,  
dec(sum(case when year(transdate) = 2010    
then amount# else 0 end),7,0) as Qty10,     
                                            
dec(sum(case when year(transdate) = 2011    
then amount$ else 0 end),10,2) as Sales11 , 
dec(sum(case when year(transdate) = 2011    
then amount# else 0 end),7,0) as Qty11,     
                                            
dec(sum(case when year(transdate) = 2012    
then amount$ else 0 end),10,2) as Sales12 , 
dec(sum(case when year(transdate) = 2012    
then amount# else 0 end),7,0) as Qty12      

from orderp              
    group by cstnumber   

using SQL date and time functions IBM DB2 *ISO *USA *JIS *EUR date formats SQL values and set options


Sample from Jamie Flanary posted at 2012-01-04 17:49:15

     H dftactgrp( *no )  OPTION(*NODEBUGIO)                                                         
                                                                                                    
       //---------------------------------------------                                              
       //  using SQL date and time functions                                                        
       // IBM DB2 *ISO *USA *JIS *EUR date formats                                                  
       // SQL values and set options                                                                
       //---------------------------------------------                                              
                                                                                                    
     d Mystring        s            512    varying                                                  
     d MyStamp         s               z                                                            
     d MyIsoDate       s               d                                                            
     d SQLIso          s             10                                                             
     d SQLUsa          s             10                                                             
     d SQLEur          s             10                                                             
     d SQLJis          s             10                                                             
     d SQLUsaDate      s               d   datfmt(*USA)                                             
     d WorkIsoDate     s               d                                                            
                                                                                                    
      /Free                                                                                         
                                                                                                    
              exec sql set option commit=*none,datfmt=*iso;                                         
                                                                                                    
             //---------------------------------------------                                        
             // M A I N  L I N E                                                                    
             //---------------------------------------------                                        
                                                                                                    
             MyString = 'This is a upper case test';                                                
                                                                                                    
             exec sql                                                                               
              select upper(:MyString)                                                               
              into :MyString                                                                        
                  from sysibm/sysdummy1;                                                            
                                                                                                    
              // after processed string will be:                                                    
              //  'THIS IS A UPPER CASE TEST'                                                       
                                                                                                    
              // retrieve a timestamp in SQL                                                        
             exec sql                                                                               
              select (CURRENT TIMESTAMP)                                                            
              into :MyStamp                                                                         
              from sysibm/sysdummy1;                                                                
                                                                                                    
              // after processed MyStamp will be something like:                                    
              // '2012-01-04-08.05.08.811000'                                                       
                                                                                                    
                                                                                                    
              // retrieve a date in 'YYYY /MM / DD' format                                          
             exec sql                                                                               
              select (CURRENT_DATE)                                                                 
              into :MyIsoDate                                                                       
              from sysibm/sysdummy1;                                                                
                                                                                                    
              // some SQL data math                                                                 
             exec sql                                                                               
              select (CURRENT_DATE + 3 YEARS + 2 MONTHS + 15 DAYS)                                  
              into :MyIsoDate                                                                       
              from sysibm/sysdummy1;                                                                
                                                                                                    
              // select date in character multiple formats                                          
              exec sql                                                                              
              select  char(CURRENT_DATE,ISO),                                                       
                      char(CURRENT_DATE,USA),                                                       
                      char(CURRENT_DATE,EUR),                                                       
                      char(CURRENT_DATE,JIS)                                                        
              into :SQLiso, :SQLusa, :SQLeur, :SQLjis                                               
              from sysibm/sysdummy1;                                                                
                                                                                                    
              // select date in usa format *note  datfmt on variable definition                     
              exec sql                                                                              
              select  (CURRENT_DATE)                                                                
              into :SQLUSADate                                                                      
              from sysibm/sysdummy1;                                                                
                                                                                                    
              //output : '01/04/2012'                                                               
                                                                                                    
              // now that I've posted this all in selects using sysdummy try using                  
              // Values or set                                                                      
                                                                                                    
              exec sql values(CURRENT_DATE - 30 DAYS) into :WorkIsoDate;                            
              exec sql Set :WorkIsoDate = Current_Date - 30 Days;                                   
                                                                                                    
              *inlr = *On;                                                                          
                                                                                                    
      /End-Free                                                                                     

Selecting multiple records at once with SQL.


Sample from Jamie Flanary posted at 2011-12-18 20:06:10

      *===================================================                                          
      *                                                                                             
      *  Field Definitions.                                                                         
      *                                                                                             
     d Count           s              6  0                                                          
     d reply           s              1                                                             
     d workdata        s            112                                                             
      *                                                                                             
      * some data                                                                                   
      *                                                                                             
     d somedata      e ds                  extname(QRPGLESRC) occurs(10)                            
                                                                                                    
      //                                                                                            
      //  external calls                                                                            
      //                                                                                            
                                                                                                    
     d $nuther         pr                  extpgm('OCCUR2')                                         
                                                                                                    
      /free                                                                                         
                                                                                                    
          exec sql    declare  A33  cursor for                                                      
                      select * from QRPGLESRC;                                                      
                                                                                                    
          exec sql    open A33 ;                                                                    
                                                                                                    
          exec sql    FETCH A33   for 10 rows                                                       
                      INTO :SomeData;                                                               
                                                                                                    
          for  count = 1 to 10;                                                                     
           %occur(somedata) = count;                                                                
           workdata = somedata;                                                                     
           dsply %subst(workdata:1:52)  reply;                                                      
          endfor;                                                                                   
          $nuther();                                                                                
          exec sql    close A33 ;                                                                   
                                                                                                    
                                                                                                    
          *inlr = *on;                                                                              
                                                                                                    
      /end-free                                                                                     

SQL being used to build INPUT table for use with FTP.


Sample from Jamie Flanary posted at 2011-12-10 12:05:02

     d FTP             pr
     d  inprogram                    10a

     d FTP             pi
     d  inprogram                    10a
      *
      * Variable Definition
      *
     d cmdlength       s             15  5
     d cmdstring       s             80
     d count           s              4  0
     d Q               s              1    inz('''')
     d SQLcmd          s             80

     d $command        pr                  extpgm('QCMDEXC')
     d   command                   5000    options(*varsize)
     d   Length                      15  5


      /free

                exsr  Hskpg;
                exsr  $BuildFile;
                exsr  $StartFTP;

                monitor;
                  cmdstring = 'DLTOVR FILE(INPUT) LVL(*)';
                  cmdlength = %len(%trim(cmdstring));
                  $command (cmdstring:cmdlength);
                on-error;
                endmon;




                *inlr = *on;

        //--------------------------------------------------------
        // $BuildFile - build the workfile
        //--------------------------------------------------------

             begsr $buildFile;

               select;
                 when inprogram = 'OENBZ1';
                   for count = 1 to 10;
                     select;
                       when count = 1;
                         sqlcmd = 'userid password';
                       when count = 2;
                         sqlcmd = 'namefmt 1 ';
                       when count = 3;
                         sqlcmd = 'lcd /home/orderentry';
                       when count = 4;
                         sqlcmd = 'BIN';
                       when count = 5;
                         sqlcmd = 'CD /shareit/formscape/xml_files';
                       when count = 6;
                         sqlcmd = 'mkdir ' + %trim(inprogram);
                       when count = 7;
                         sqlcmd = 'cd ' + %trim(inprogram);
                       when count = 8;
                         sqlcmd = 'put conford.xml  conford.xml';
                       when count = 9;
                         sqlcmd = 'quit';
                       when count = 10;
                         sqlcmd = 'exit';
                     endsl;
                         exsr $insert;
                   endfor;
               endsl;

             endsr;

        //--------------------------------------------------------
        // $StartFTP  - start the ftp process
        //--------------------------------------------------------

             begsr $StartFTP;

               cmdstring = 'OVRDBF FILE(INPUT) TOFILE(QTEMP/sqlinput)';
               cmdlength = %len(%trim(cmdstring));
               $command (cmdstring:cmdlength);


               cmdstring = 'FTP ' + Q + '10.0.1.201' + Q;
               cmdlength = %len(%trim(cmdstring));
               $command (cmdstring:cmdlength);



             endsr;
        //--------------------------------------------------------
        // $insert - insert one record into ftp input file
        //--------------------------------------------------------
             begsr $insert;
      /End-Free
     c/exec sql
     c+ INSERT INTO QTEMP/sqlinput VALUES(: SQLCmd )
     c/end-exec
      /free

             endsr;
        //--------------------------------------------------------
        // Hskpg - one time run subroutine
        //--------------------------------------------------------

             begsr Hskpg;

           //
           // create the FTP input file in QTEMP
           //

      /End-Free
      *
     c/Exec Sql
     c+ declare global temporary table sqlinput
     c+ (ftpcmd      char(80))
     c+ with replace
     c/End-Exec
      *
      /free

             endsr;
      /End-Free  

using SQL to revoke and allow access to a table.


Sample from Jamie Flanary posted at 2011-12-10 11:25:17

      *                                                                                             
      //                                                                                            
      // Variable Definition                                                                        
      //                                                                                            
     d count           s              3  0                                                          
     d cmdstring       s            512                                                             
     d cmdlength       s             15  5                                                          
     d ISodate         s               d                                                            
     d workorder       s              7s 0 inz(1000000)                                             
     d workcustomer    s              5s 0 inz(12345)                                               
     d workshipdate    s               D                                                            
     d workpacked      s              5  0                                                          
     d workvary        s            200    varying                                                  
                                                                                                    
     d $command        pr                  extpgm('QCMDEXC')                                        
     d   command                   5000    options(*varsize)                                        
     d   Length                      15  5                                                          
                                                                                                    
      /Free                                                                                         
       exec sql  set option commit=*none,datfmt=*iso;                                               
                                                                                                    
                                                                                                    
        //--------------------------------------------------------                                  
        // MAIN PROGRAM                                                                             
        //--------------------------------------------------------                                  
                                                                                                    
         //                                                                                         
         // create table to play with security                                                      
         //                                                                                         
          exsr  $Createtable;                                                                       
          exsr  $add10records;                                                                      
         //                                                                                         
         // okay now for the playing with security                                                  
         // dont ask why they are just examples                                                     
         //                                                                                         
          exsr  $securitytest;                                                                      
                                                                                                    
          *inlr = *on;                                                                              
                                                                                                    
        //--------------------------------------------------------                                  
        // $createTable - create our work table                                                     
        //--------------------------------------------------------                                  
                                                                                                    
         begsr $createtable;                                                                        
                                                                                                    
              // use drop to delete the header in QTEMP                                             
          exec sql drop table qtemp/pizzapie;                                                       
                                                                                                    
          //                                                                                        
          //  Create table in Qtemp                                                                 
          //                                                                                        
          exec sql create table qtemp/pizzapie(                                                     
                   order numeric(7)        ,                                                        
                   customer numeric(6)     ,                                                        
                   shipdate date           ,                                                        
                   Packed5 dec(5)          ,                                                        
                   Varyfld varchar(200)                                                             
                                           );                                                       
                                                                                                    
            //                                                                                      
            // adding text to the the fields                                                        
            //                                                                                      
          exec sql label on column qtemp/pizzapie(                                                  
                   Order     text is 'Test Order number'    ,                                       
                   customer  text is 'Test Customer number' ,                                       
                   shipdate  text is 'Test Ship Date'       ,                                       
                   Packed5   text is 'Test Packed Field'    ,                                       
                   Varyfld   text is 'Test Variable len'                                            
                                                            );                                      
                                                                                                    
                                                                                                    
             endsr;                                                                                 
        //--------------------------------------------------------                                  
        // $add10records - add 10 records to pizzapie                                               
        //--------------------------------------------------------                                  
                                                                                                    
         begsr $add10records;                                                                       
                                                                                                    
          for count = 1 to 10;                                                                      
           workorder += 1;                                                                          
           workcustomer += 1;                                                                       
           workshipdate = %date();                                                                  
           workpacked = count;                                                                      
           workvary = 'test-' + %char(count);                                                       
                                                                                                    
           //                                                                                       
           // use sql to insert the records...                                                      
           //                                                                                       
           exec sql insert into qtemp/pizzapie VALUES(                                              
                    : workorder    ,                                                                
                    : workcustomer ,                                                                
                    : workshipdate ,                                                                
                    : workpacked   ,                                                                
                    : workvary                                                                      
                                    );                                                              
          endfor;                                                                                   
                                                                                                    
         endsr;                                                                                     
                                                                                                    
        //--------------------------------------------------------                                  
        // $securitytest - messin with security                                                     
        //--------------------------------------------------------                                  
                                                                                                    
         begsr $securitytest;                                                                       
                                                                                                    
           // give everyone all authority just so we can pull the                                   
           // rug out later ;)                                                                      
                                                                                                    
           exec sql grant                                                                           
                    select   ,                                                                      
                    insert   ,                                                                      
                    delete   ,                                                                      
                    update                                                                          
                    on pizzapie                                                                     
                    to FLANARY;                                                                     
                                                                                                    
           exec sql delete from qtemp/pizzapie                                                      
                    where customer = 12346;                                                         
                                                                                                    
           exec sql revoke ALL                                                                      
                    on pizzapie                                                                     
                    from FLANARY;                                                                   
                                                                                                    
           exec sql delete from qtemp/pizzapie                                                      
                    where customer = 12347;                                                         
                                                                                                    
         endsr;                                                                                     
                                                                                                    
        //--------------------------------------------------------                                  
        // *inzsr - one time run subroutine                                                         
        //--------------------------------------------------------                                  
                                                                                                    
         begsr *inzsr;                                                                              
                                                                                                    
         endsr;                                                                                     
                                                                                                    
      /End-Free