H Debug Option(*nodebugio)                                              
 *                                                                      
 *                                                                      
 **    Sistema     : Consulta masiva on-line                         *  
 **    Modulo      :                                                 *  
 **    Analisis    :  Carlos Robles Espnoza                            *  
 **    Programacion: Carlos Robles Espinoza      SIDESYS             *  
 **    Fecha.......: Octubre  2004 - Argentina                       *  
 *                                                                   *   
 **    Descripción : Arma un SQL dinamicamente segun parametros      *  
 **                  ingresados.                                                           *  
 **                  Es un fuente Beta que va a servir como base     *  
 **                  para una aplicacion on-line de consulta masiva para    *  
 **                  usuarios finales.                               *  
 *                                                                   *
 *                                                                   * 
  
FTCIPICCOUTIF A E           K DISK    rename(CIPICCTI:OUPICCTI)         
F                                     prefix(ou:2) usropn               
 * ===================================================================  
 *  Auxiliares para SQL                                                 
 * Variables tipo const                                                 
D VarSelect       c                   const('select tifecp, tifdpf, tificc- 
D                                     ,tifrec, tihora, tinnrr, tirrec     -
D                                     from tcipicc where ')             
D VarEq           c                   const(' = ')                      
D VarAnd          c                   const(' and ')                    
D VarFdpf         c                   const(' tifdpf')                  
D VarFicc         c                   const(' tificc')                  
D VarFecp         c                   const(' tifecp')                  
 *                                                                      
D VarAll          s           1000a   inz(*blanks)                      
 *                                                                      
 * Sentencia para SQL    
D Str_sql         s           1000a   inz(*blanks)                 
 * =============================================================== 
                                                                   
D s$_fdpf         s                   like(oufdpf) inz(*blanks)    
D s$_ficc         s                   like(ouficc) inz(*zeros)     
D s$_fecp         s                   like(oufecp) inz(*zeros)     
D ip_flag          s               n   DIM(3)                   
                                                                   
 * Definicion de un Prototipo para QCMDEXC                         
D CmdData         s             80A   inz('Clrpfm *libl/TCIPICCOUT') 
                                                                   
D RunSysCmd       PR                  extpgm('QCMDEXC')            
D Cmd                          200A   options(*varsize) const      
D CmdLen                        15P 5 const                        
                                                                 
D                SDS                                              
D  Prog             *proc                                         
D  Parms            *parms                                        
D  Pgm_lib               81     90                                
D  Job_name             244    253                                
D  User                 254    263                                
D  Job_num              264    269s 0                             
                                                                  
C     *entry        plist                                         
C                   parm                    ip_fdpf          10   
C                   parm                    ip_ficc           8   
C                   parm                    ip_fecp           8   
     
C                   exsr      rinicio                             
                                                                  
 * Asigna valores por Num. parametros ingresados                  
C                   if        ip_fdpf <> *blanks                           
C                   move      ip_fdpf       s$_fdpf 
C                   eval      ip_flag(1) = *on 
C                   endif   
                                       
C                   if        ip_ficc <> *blanks                            
C                   move      ip_ficc       s$_ficc
C                   eval      ip_flag(2) = *on                
C                   endif 
                                         
C                   if        ip_fecp <> *blanks                             
C                   move      ip_fecp       s$_fecp
C                   eval      ip_flag(3) = *on               
C                   endif                                          
                                                                   
 /free                                                             
     VarAll = VarSelect;                                           
     if ip_flag(1);                                                
      VarAll = %trimr(VarAll) + VarFdpf + VarEq                    
               + '''' + s$_fdpf + '''';                            
     endif;  
                                                      
     if ip_flag(2);                                            
      if VarAll <> VarSelect;                                  
        VarAll = %trimr(VarAll) + VarAnd;                      
      endif;                                                   
      VarAll = %trimr(VarAll) + VarFicc + VarEq                
               + %char(s$_ficc);                               
     endif;                                                    
                                                               
     if ip_flag(3);                                            
      if VarAll <> VarSelect;                                  
        VarAll = %trimr(VarAll) + VarAnd;                      
      endif;                                                   
      VarAll = %trimr(VarAll) + VarFecp + VarEq                
               + %char(s$_fecp);                               
     endif;                                                    
                                                               
     Str_sql = VarAll;                                         
                                                               
                                                                 
 /end-free                                                       
                                                                 
 * Prepara y carga variables SQL                                 
C/EXEC SQL                                                       
C+ Prepare P1 From : str_sql                                     
C/End-Exec                                                       
                                                                 
 * Declara Cursor                                                
C/EXEC SQL                                                       
C+ DECLARE C1 CURSOR FOR P1                                      
C/END-EXEC                                                       
                                                                 
 *                                                               
C/EXEC SQL                                                       
C+ OPEN C1                                                       
C/END-EXEC       
                                                                
C                   exsr      ex_fetch                          
                                                                
 *  FIN Pgm                                                    
C                   eval      *inlr = *on                       
                                                                
 *    -----------   -------                                     
C     ex_fetch      Begsr                                       
 *    -----------   -------                                     
                                                                
C/EXEC SQL FETCH C1 INTO                                        
C+ :oufecp,:oufdpf,:ouficc,:oufrec,:ouhora,:ounnrr,:ourrec      
C/END-EXEC                                                      
                                                                
 * Graba Mientras no es fin de DB                               
C                   DOW       SQLCOD = 0                        
C                   write     OUPICCTI                          
                                                                
                                                                   
C/EXEC SQL FETCH C1 INTO                                           
C+ :oufecp,:oufdpf,:ouficc,:oufrec,:ouhora,:ounnrr,:ourrec         
C/END-EXEC                                                         
C                   enddo                                          
                                                                   
C/EXEC SQL CLOSE C1                                                
C/END-EXEC                                                         
                                                                   
C                   Endsr                                          
 *                  -------                                        
                                                                   
 *    -----------   -------                                        
C     rinicio       Begsr                                          
 *    -----------   -------                                        
                                                                   
 * Borra archivo fisico (CLRPFM)                                   
C                   CALLP(E)  RunSysCmd(CmdData: %size(CmdData))   
C                   Open      TCIPICCOUT                           
                                                                   
C                   Endsr