| 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$
|
