¿ Quieres imprimir esta página ? Volver a la página principal de Recursos iSeries AS400 ¿ Necesitas ayuda ? En pruebas
Recursos iSeries AS400. Compartiendo generamos conocimiento
Novedades en Recursos iSeries AS400
Últimas noticias del iSeries AS400
Copia reg con sql de diferentes bases de datos por rpg sql

Categoría : Programación
Autor : Miguel Angel Teliz Meneses
Título : Copia reg con sql de diferentes bases de datos por rpg sql


Descripción del truco:
Este programa copia registros de diferentes bases de datos (variables), aun cuando tiene diferente formato, la base de datos origen es variable y la destino tambien, espero les sirva, tambien podran encontrar el texto en free.

     A*********************************************************************
** MARZO 28, 2005 **
** Creador: MIGUEL ANGEL TELIZ MENESES **
** Objetivo: DA DE ALTA REGISTROS EN MODULO **
A*********************************************************************
Foperativl1IF E K DISK
FPAISCANAL1IF E K DISK
D WMODULO S 4 0
D wdescreg S 50A
D wpais S 4 0
D wcanal S 4 0
D resp_dsp S 1A
DREGWRK DS
D tiporeg_orig 2A
D tiporeg_dest 2A
D estr_reg_sel 60A
D SQL_STR 300A
A*--------------------------------------------------------------------
c llave_opera Klist
c Kfld FDESCOPERA
c key_paiscan Klist
c Kfld FDESCOPERA
A*--------------------------------------------------------------------
C *ENTRY PLIST
C PARM OPERAORIG 10
C PARM OPERADEST 10
C PARM MODULO 4 0
C PARM ERROR 4 0
A*--------------------------------------------------------------------
/FREE
error = 0 ;
exsr obt_tipo_registro;
if error = 0 ;
exsr obt_estruc_reg;
exsr arma_select;
exsr obten_dat_orig;
exsr valida_cod_err_sql;
if error = 0 ;
exsr inserta_reg;
exsr valida_cod_err_sql;
endif;
exsr cierra_cursor;
endif;
*inlr = *on;
//------------------------------------------------------------------------
begsr obt_tipo_registro;
chain operaorig operativl1;
tiporeg_orig = ftipregis;
chain operadest operativl1;
tiporeg_dest = ftipregis;
endsr;
//------------------------------------------------------------------------
begsr obt_estruc_reg;
IF tiporeg_orig = '01';
estr_reg_sel = 'FIIDM00001, FCNOM00001' ;
endif;
IF tiporeg_orig = '02';
estr_reg_sel = 'FIIDM00001, FCNOM00001, FICANAL, ' +
'FIPAIS' ;
endif;
endsr;
//------------------------------------------------------------------------
begsr arma_select;
SQL_str = 'SELECT ' + estr_reg_sel
+ ' FROM ' + %TRIM(OPERAORIG) + '/MODUL00001 WHERE '
+ ' FIIDM00001 =' + %char(MODULO) ;
endsr;
//------------------------------------------------------------------------
begsr arma_INSERT;
IF Tiporeg_dest = '01' ;
SQL_str = 'INSERT INTO ' + %TRIM(OPERADEST) + '/MODUL00001 ' +
'VALUES (' + %char(wmodulo) + ', '
+ %SUBST(FSTATUS03 :1 :1) + wdescreg + %SUBST(FSTATUS03 :1 :1)
+ ')';
endif;
IF Tiporeg_dest = '02';
SQL_str = 'INSERT INTO ' + %TRIM(OPERADEST) + '/MODUL00001 ' +
'VALUES (' + %char(wmodulo) + ', '
+ %SUBST(FSTATUS03 :1 :1) + wdescreg + %SUBST(FSTATUS03 :1 :1) + ', '
+ %char(wcanal) + ', ' + %char(wpais) + ')';
endif;
endsr;
//------------------------------------------------------------------------
begsr valida_cod_err_sql;
IF SQLCOD <> 0 AND SQLCOD <> -803;
error = sqlcod;
dsply '--> Ocurrio error al clonar MODULO <----';
dsply ('PROGRAMA: ADNSETR033 , SQLCOD<' + %CHAR(ERROR) + '>');
dsply ('operativa Orig: ' + operaorig );
dsply ('operativa Dest: ' + operadest );
dsply '<-------------------------------------------------->';
dsply ' ' resp_dsp;
endif;
endsr;
//------------------------------------------------------------------------
begsr inserta_reg ;
IF Tiporeg_dest = '02';
SETLL FDESCOPERA paiscanal1;
reade FDESCOPERA paiscanal1;
dow not %eof(paiscanal1);
IF FSTATUSPAC = 'A' ;
wpais = fpais;
wcanal= fcanal;
exsr arma_INSERT;
exsr ejecuta_insert;
exsr valida_cod_err_sql;
endIF;
reade FDESCOPERA paiscanal1;
enddo;
else;
exsr arma_INSERT;
exsr ejecuta_insert;
exsr valida_cod_err_sql;
endif;
endsr;
/end-free
C* ------------------------------------------------------------------------
C obten_dat_origBEGSR
C/EXEC SQL
C+ Prepare S1033 From :SQL_STR
C/End-Exec
*
C/EXEC SQL
C+ DECLARE CURRS033 CURSOR FOR S1033
C/END-EXEC
*
C EXSR ABRE_CURSOR
C SELECT
C WHEN TIPOREG_ORIG = '01'
C/EXEC SQL
C+ FETCH FROM CURRS033 INTO
c+ :wMODULO, :wdescreg
C/END-EXEC
C WHEN TIPOREG_ORIG = '02'
C/EXEC SQL
C+ FETCH FROM CURRS033 INTO
C+ :wMODULO, :wdescreg, :wcanal, :wpais
C/END-EXEC
*
c endsl
C ENDSR
*
*-----------------------------------------------------------------------
C ejecuta_insertBEGSR
*
C/EXEC SQL
C+ Prepare S1033A From :SQL_STR
C/End-Exec
*
C/EXEC SQL
C+ execute S1033A
C/End-Exec
*
C ENDSR
*-----------------------------------------------------------------------
C ABRE_CURSOR BEGSR
C/EXEC SQL
C+ OPEN CURRS033
C/END-EXEC
C*
C ENDSR
*-----------------------------------------------------------------------
C CIERRA_CURSOR BEGSR
C/EXEC SQL
C+ CLOSE CURRS033
C/END-EXEC
C ENDSR

Ver código fuente
Fecha 28-06-2005

Tienes algún truco que quieras compartir con todos los profesionales de Recursos iSeries i5 AS400?. Envianoslo y si resulta seleccionado te enviaremos un vale de Amazon por valor de 50$

Comentarios de usuarios

Nombre:
Mail:
Comentario:
 

Subir a la parte superior de la web

Dossiers técnicos iSeries y AS400
- Dossier de seguridad
- Alta disponibilidad.
¿Buscas trabajo ?
Inscríbete en nuestra lista laboral y recibirás las ofertas de trabajo en tu buzón de correo electrónico.
Nuestros links preferidos
- Tendencias tecnologías de la información
Expertos en materías relacionadas con las tecnologías de la información, nos dan su punto de vista sobre las tendencias actuales y futuras
- Los últimos anuncios sobre hardware-software para iSeries AS400 realizados por IBM
- Freeware. Software gratuito para el iSeries AS400
- Utilidades para el iSeries AS400 realizadas por profesionales
- Documentos. Trucos e ideas para resolver tus problemas
- Manuales. Los manuales y links más interesantes del iSeries AS400

  Links patrocinados
  •  
  •  

[ Soy nuevo |   Profesionales |   AS qué |   Empresas |    Foros |   Recomiéndanos |    Productos ]
 
Recursos iSeries AS400. Es una web de: PUBLICACIONES HELP400, S.L. CIF:B-60-202827 Gran Vía de les Corts Catalanes, núm. 715, Entresuelo – 3ª - Barcelona - Tel.+34.932.310.049