| Categoría
:Otros
Autor : Yon Tomas Briceño
Título : Rutina para Convertir Archivos Multicampos
a uno Solo
Descripción del truco:
Esta rutina la utilizo para dejar un archivo de multiples
campos en uno solo, para dejar el archivo tipo plano,
para subir al PC, con cualquier separador. El usaurio
define que tipo de separador quiere y como quiere los
formatos de fechas
A* ***********************************************************************
A* Table: Archivo de Parametros de Tablas Para Reportes
A* ***********************************************************************
A* Date/Time: 07 de Abril de 2006
A* User: Yon Tomas Briceño Buitrago **
A* ***********************************************************************
A*
A R RARCPAR TEXT(\'Parametros de Tablas Para Rep-
A ortes \')
A*
A*Datos Principales
A NOMARC 10A TEXT(\'Nombre de Archivo \')
A COLHDG(\'Nombre de Archivo\')
A NOMLIB 10A TEXT(\'Nombre de Libreria \')
A COLHDG(\'Nombre de Libreri\')
A DESCRI 40A TEXT(\'Descripcion Archivo\')
A COLHDG(\'Descripcion Archi\')
A SEPARA 5A TEXT(\'Separador Campos \')
A COLHDG(\'Separador Campos \')
A* Datos de Auditoria
A USRCRE 10A COLHDG(\'Cod. Usuario\' \'Creac\')
A TEXT(\'Codigo Usuario Creac\')
A FECCRE 8S 0 COLHDG(\'Fecha de \' \'Creac\')
A*
A K NOMARC
A K NOMLIB
Se debe Crear una tabla con el nombre ICFARCREP, este contendra los Campos de las tablas parametrizadas, en ICFARCPAR.
A* ***********************************************************************
A* Table: Archivo de Parametros de Campos Para Reportes
A* ***********************************************************************
A* Date/Time: 07 de Abril de 2006
A* User: Yon Tomas Briceño Buitrago ** **************************
A*
A R RARCREP TEXT(\'Parametros de Tablas Para Rep-
A ortes \')
A*
A*Datos Principales
A NOMARC 10A TEXT(\'Nombre de Archivo \')
A COLHDG(\'Nombre de Archivo\')
A NOMLIB 10A TEXT(\'Nombre de Libreria \')
A COLHDG(\'Nombre de Libreri\')
A NOMCAM 10A TEXT(\'Nombre de Campo \')
A COLHDG(\'Nombre de Campo \')
A DESCAM 40A TEXT(\'Descripcion Campo \')
A COLHDG(\'Descripcion Campo\')
A POSDES 5S 0 TEXT(\'Posicion Desde \')
A COLHDG(\'Posicion Desde \')
A POSHAS 5S 0 TEXT(\'Posicion Hasta \')
A COLHDG(\'Posicion Hasta \')
A LONGIT 5S 0 TEXT(\'Longitud \')
A COLHDG(\'Longitud \')
A INDFEC 1S 0 TEXT(\'Es Campo Fecha? \')
A COLHDG(\'Es Campo Fecha? \')
A FORFEE 10A TEXT(\'Formato Fecha Entra\')
A COLHDG(\'Formato Fecha Ent\')
A FORFES 10A TEXT(\'Formato Fecha Entra\')
A COLHDG(\'Formato Fecha Ent\')
A* Datos de Auditoria
A USRCRE 10A COLHDG(\'Cod. Usuario\' \'Creac\')
A TEXT(\'Codigo Usuario Creac\')
A FECCRE 8S 0 COLHDG(\'Fecha de \' \'Creac\')
A TEXT(\'Fecha de Creac\')
A USRMOD 10A COLHDG(\'Cod. Usuario\' \'Modif\')
A TEXT(\'Codigo Usuario Modif\')
A FECMOD 8S 0 COLHDG(\'Fecha de \' \'Modif\')
A TEXT(\'Fecha de Modif\')
A*
A K NOMARC
A K NOMLIB
A K NOMCAM
Se debe Crear una Vista Logica, al archivo ICFARCREP, con el nopmbre ICFARCREP1
A* ***********************************************************************
A* Table: Archivo de Parametros de Campos Para Reportes
A* ***********************************************************************
A* Date/Time: 07 de Abril de 2006
A* User: Yon Tomas Briceño Buitrago **
A* ***********************************************************************
A*
A R RARCREP PFILE(ICFARCREP)
A*
A K NOMARC
A K NOMLIB
A K POSDES
Se crea un CL, que recibe como parametros el Archivo y la libreria a parametrizar, este CL ayuda al usuario a llenar el Archivo ICFARCREP.
PGM PARM(&XNOMARC &XNOMLIB)
/* ----------------------------------------------------------------- */
/* PROGRAMA: ICCPRT003D */
/* FUNCION : ACTUALIZA ARCHIVO DE PARAMETROS DE CAMPOS */
/* */
/* AUTOR: YON TOMAS BRICEÑO ** COLNEX *** */
/* FECHA: ABRIL 07 DE 2006 */
/* ----------------------------------------------------------------- */
/* ----------------------------------------------------------------- */
/* DECLARACION DE VARIABLES */
/* ----------------------------------------------------------------- */
DCL VAR(&XNOMARC) TYPE(*CHAR) LEN(10)
DCL VAR(&XNOMLIB) TYPE(*CHAR) LEN(10)
/* ----------------------------------------------------------------- */
/* GENERA ARCHIVO DE SALIDA */
/* ----------------------------------------------------------------- */
DSPFFD FILE(&XNOMLIB/&XNOMARC) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/ICFCAMPOS)
ENDPGM
Entrar a Parametrizar los archivos ya sea por UPDDTA o Alguna herramienta que se tenga, para actualizar Archivos directamente.
Se crea el programa ICCARREGLA, que es el que va a realizar el cambio, asi:
/* ----------------------------------------------------------------- */
/* PROGRAMA: ICARREGLA */
/* FUNCION : ARREGLA ARCHIVOS PARA ENVIAR A PC */
/* */
/* AUTOR: YON TOMAS BRICEÑO ** *** */
/* FECHA: ABRIL 07 DE 2006 */
/* ----------------------------------------------------------------- */
PGM PARM(&XNOMARC &XNOMLIB &XNOMARS )
/* ----------------------------------------------------------------- */
/* DECLARACION DE VARIABLES */
/* ----------------------------------------------------------------- */
DCL VAR(&XNOMARC) TYPE(*CHAR) LEN(10)
DCL VAR(&XNOMLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&XNOMARS) TYPE(*CHAR) LEN(10)
DCL VAR(&XCODUSU) TYPE(*CHAR) LEN(10)
/* ----------------------------------------------------------------- */
/* RECUPERA USUARIO */
/* ----------------------------------------------------------------- */
RTVJOBA USER(&XCODUSU)
/* ----------------------------------------------------------------- */
/* DUPLICA ARCHIVOS */
/* ----------------------------------------------------------------- */
CRTDUPOBJ OBJ(ICFSALIIN) FROMLIB(PPSYVDTA) +
OBJTYPE(*FILE) TOLIB(QTEMP) NEWOBJ(ICFSALIIN)
MONMSG MSGID(CPF0000)
CRTDUPOBJ OBJ(ICFSALIDA) FROMLIB(PPSYVDTA) +
OBJTYPE(*FILE) TOLIB(QTEMP) NEWOBJ(ICFSALIDA)
MONMSG MSGID(CPF0000)
CHGVAR VAR(%SST(&XNOMARS 1 5)) VALUE(%SST(&XNOMARC +
4 5))
CHGVAR VAR(%SST(&XNOMARS 6 5)) VALUE(%SST(&XCODUSU +
6 5))
CRTDUPOBJ OBJ(ICFSALIDA) FROMLIB(PPSYVDTA) +
OBJTYPE(*FILE) TOLIB(&XNOMLIB) +
NEWOBJ(&XNOMARS)
MONMSG MSGID(CPF0000)
/* ----------------------------------------------------------------- */
/* DUPLICA ARCHIVOS */
/* ----------------------------------------------------------------- */
CPYF FROMFILE(&XNOMLIB/&XNOMARC) +
TOFILE(QTEMP/ICFSALIIN) MBROPT(*REPLACE) +
FMTOPT(*NOCHK)
OVRDBF FILE(ICFSALIIN) TOFILE(QTEMP/ICFSALIIN)
OVRDBF FILE(ICFSALIDA) TOFILE(QTEMP/ICFSALIDA)
CALL PGM(ICRARREGLA) PARM(&XNOMARC &XNOMLIB)
CPYF FROMFILE(QTEMP/ICFSALIDA) +
TOFILE(&XNOMLIB/&XNOMARS) +
MBROPT(*REPLACE) FMTOPT(*NOCHK)
ENDPGM
Y por ultimo el programa RPGLE, ICRARREGLA, que se encargara de realizar el Cambio.
*-------------------------------------------------------------
* ICRARREGLA +
*PROCESO: TOMA LOS DATOS DE UN ARCHIVO DE ENTRADA Y CON +
* BASE EN UNOS PARAMETROS GENERA UNO DE SALIDA +
* +
* ........................ +
*FECHA : ABRIL 07 DEL 2006 +
*AUTOR : YTBB ** YON TOMAS BRICEÑO B. ** +
*MODIFICADO POR: +
*-------------------------------------------------------------
H DATEDIT(*YMD/)
*
*%.. Lógico del BOFCPOLI X Núm documento DESCEND
FICFSALIIN IP E DISK PREFIX (E_)
FICFSALIDA UF A E DISK PREFIX (S_)
FICFARCPAR IF A E K DISK PREFIX (PA)
FICFARCREP1IF A E K DISK PREFIX (P_)
* ------------------------------------------------------
D SDS
DUSUARI 254 263
DPROGRA 324 333
DJOB 244 253
DNUMJOB 264 269
DFECHA 191 198
DHORA 282 287
D*
DW_FECHA_ENT 10
DW_ANO_SUB 4
DW_MES_SUB 2
DW_DIA_SUB 2
DW_FECHA_SAL 10
C*
C *ENTRY PLIST
C PARM NOMARC 10
C PARM NOMLIB 10
C*
C KREP1 KLIST
C KFLD P_NOMARC
C KFLD P_NOMLIB
C KFLD P_POSDES
C*
C KREP KLIST
C KFLD P_NOMARC
C KFLD P_NOMLIB
C*
C KPAR KLIST
C KFLD PANOMARC
C KFLD PANOMLIB
C*
C IF *IN96 = \'0\'
C MOVEL NOMARC PANOMARC
C MOVEL NOMLIB PANOMLIB
C KPAR CHAIN RARCPAR 86
C IF *IN86 = \'0\'
C SETON 87
C ELSE
C SETOFF 87
C ENDIF
C SETON 96
C ENDIF
C IF *IN87 = \'1\'
C MOVEL NOMARC P_NOMARC
C MOVEL NOMLIB P_NOMLIB
C MOVE *ALL\'0\' P_POSDES
C SETOFF 95
C KREP1 SETLL RARCREP
C KREP READE RARCREP 85
C DOW *IN85 = \'0\'
C*
C* Mueve Nombre Archivo
C MOVEL *ALL\' \' W_SUBSTR 1000
C EVAL W_SUBSTR = %SUBST(E_CAMSAI:P_POSDES:P_LONGIT)
C IF P_INDFEC = 1
C IF P_FORFEE <> P_FORFES
C EXSR CAMBIA_FMT
C ENDIF
C ENDIF
C IF *IN95 = \'0\'
C EVAL S_CAMSAL = %TRIM(W_SUBSTR ) + PASEPARA
C SETON 95
C ELSE
C EVAL S_CAMSAL = %TRIM( S_CAMSAL ) +
C %TRIM( W_SUBSTR ) + PASEPARA
C ENDIF
C*
C KREP READE RARCREP 85
C ENDDO
C*
C WRITE RSALIDA
C*
C ELSE
C*
C SETON LR
C*
C ENDIF
CLR SETON LR
C* ***************************************************************
C* CAMBIA-FMT : CAMBIA FORMATO DE FECHA
C* ***************************************************************
C CAMBIA_FMT BEGSR
C*
C MOVEL *ALL\' \' W_FECHA_ENT
C MOVEL *ALL\' \' W_FECHA_SAL
C MOVEL *ALL\'0\' W_ANO_SUB
C MOVEL *ALL\'0\' W_MES_SUB
C MOVEL *ALL\'0\' W_DIA_SUB
C MOVEL W_SUBSTR W_FECHA_ENT
C* Desbarata Fecha de Entrada
C SELECT
C WHEN P_FORFEE = \'AAAA-MM-DD\' OR
C P_FORFEE = \'AAAA/MM/DD\'
C EVAL W_ANO_SUB = %SUBST(W_FECHA_ENT:1:4)
C EVAL W_MES_SUB = %SUBST(W_FECHA_ENT:6:2)
C EVAL W_DIA_SUB = %SUBST(W_FECHA_ENT:9:2)
C WHEN P_FORFEE = \'AAAA-DD-MM\' OR
C P_FORFEE = \'AAAA/DD/MM\'
C EVAL W_ANO_SUB = %SUBST(W_FECHA_ENT:1:4)
C EVAL W_DIA_SUB = %SUBST(W_FECHA_ENT:6:2)
C EVAL W_MES_SUB = %SUBST(W_FECHA_ENT:9:2)
C WHEN P_FORFEE = \'DD-MM-AAAA\' OR
C P_FORFEE = \'DD/MM/AAAA\'
C EVAL W_DIA_SUB = %SUBST(W_FECHA_ENT:1:2)
C EVAL W_MES_SUB = %SUBST(W_FECHA_ENT:4:2)
C EVAL W_ANO_SUB = %SUBST(W_FECHA_ENT:7:4)
C WHEN P_FORFEE = \'MM-DD-AAAA\' OR
C P_FORFEE = \'MM/DD/AAAA\'
C EVAL W_MES_SUB = %SUBST(W_FECHA_ENT:1:2)
C EVAL W_DIA_SUB = %SUBST(W_FECHA_ENT:4:2)
C EVAL W_ANO_SUB = %SUBST(W_FECHA_ENT:7:4)
C WHEN P_FORFEE = \'AAAAMMDD\'
C EVAL W_ANO_SUB = %SUBST(W_FECHA_ENT:1:4)
C EVAL W_MES_SUB = %SUBST(W_FECHA_ENT:5:2)
C EVAL W_DIA_SUB = %SUBST(W_FECHA_ENT:7:2)
C WHEN P_FORFEE = \'AAAADDMM\'
C EVAL W_ANO_SUB = %SUBST(W_FECHA_ENT:1:4)
C EVAL W_DIA_SUB = %SUBST(W_FECHA_ENT:5:2)
C EVAL W_MES_SUB = %SUBST(W_FECHA_ENT:7:2)
C WHEN P_FORFEE = \'DDMMAAAA\'
C EVAL W_DIA_SUB = %SUBST(W_FECHA_ENT:1:2)
C EVAL W_MES_SUB = %SUBST(W_FECHA_ENT:3:2)
C EVAL W_ANO_SUB = %SUBST(W_FECHA_ENT:5:4)
C WHEN P_FORFEE = \'MMDDAAAA\'
C EVAL W_MES_SUB = %SUBST(W_FECHA_ENT:1:2)
C EVAL W_DIA_SUB = %SUBST(W_FECHA_ENT:3:2)
C EVAL W_ANO_SUB = %SUBST(W_FECHA_ENT:5:4)
C ENDSL
C*
C* Arma Fecha de Salida
C*
C SELECT
C WHEN P_FORFES = \'AAAA/MM/DD\'
C EVAL %SUBST(W_FECHA_SAL:1:4) = W_ANO_SUB
C EVAL %SUBST(W_FECHA_SAL:5:1) = \'/\'
C EVAL %SUBST(W_FECHA_SAL:6:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:8:1) = \'/\'
C EVAL %SUBST(W_FECHA_SAL:9:2) = W_DIA_SUB
C WHEN P_FORFES = \'AAAA-MM-DD\'
C EVAL %SUBST(W_FECHA_SAL:1:4) = W_ANO_SUB
C EVAL %SUBST(W_FECHA_SAL:5:1) = \'-\'
C EVAL %SUBST(W_FECHA_SAL:6:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:8:1) = \'-\'
C EVAL %SUBST(W_FECHA_SAL:9:2) = W_DIA_SUB
C WHEN P_FORFES = \'AAAA/DD/MM\'
C EVAL %SUBST(W_FECHA_SAL:1:4) = W_ANO_SUB
C EVAL %SUBST(W_FECHA_SAL:5:1) = \'/\'
C EVAL %SUBST(W_FECHA_SAL:6:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:8:1) = \'/\'
C EVAL %SUBST(W_FECHA_SAL:9:2) = W_MES_SUB
C WHEN P_FORFES = \'AAAA-DD-MM\'
C EVAL %SUBST(W_FECHA_SAL:1:4) = W_ANO_SUB
C EVAL %SUBST(W_FECHA_SAL:5:1) = \'-\'
C EVAL %SUBST(W_FECHA_SAL:6:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:8:1) = \'-\'
C EVAL %SUBST(W_FECHA_SAL:9:2) = W_MES_SUB
C WHEN P_FORFES = \'DD/MM/AAAA\'
C EVAL %SUBST(W_FECHA_SAL:1:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:3:1) = \'/\'
C EVAL %SUBST(W_FECHA_SAL:4:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:6:1) = \'/\'
C EVAL %SUBST(W_FECHA_SAL:7:4) = W_ANO_SUB
C WHEN P_FORFES = \'DD-MM-AAAA\'
C EVAL %SUBST(W_FECHA_SAL:1:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:3:1) = \'-\'
C EVAL %SUBST(W_FECHA_SAL:4:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:6:1) = \'-\'
C EVAL %SUBST(W_FECHA_SAL:7:4) = W_ANO_SUB
C WHEN P_FORFES = \'MM/DD/AAAA\'
C EVAL %SUBST(W_FECHA_SAL:1:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:3:1) = \'/\'
C EVAL %SUBST(W_FECHA_SAL:4:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:6:1) = \'/\'
C EVAL %SUBST(W_FECHA_SAL:7:4) = W_ANO_SUB
C WHEN P_FORFES = \'MM-DD-AAAA\'
C EVAL %SUBST(W_FECHA_SAL:1:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:3:1) = \'-\'
C EVAL %SUBST(W_FECHA_SAL:4:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:6:1) = \'-\'
C EVAL %SUBST(W_FECHA_SAL:7:4) = W_ANO_SUB
C WHEN P_FORFES = \'AAAAMMDD\'
C EVAL %SUBST(W_FECHA_SAL:1:4) = W_ANO_SUB
C EVAL %SUBST(W_FECHA_SAL:5:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:7:2) = W_DIA_SUB
C WHEN P_FORFES = \'AAAADDMM\'
C EVAL %SUBST(W_FECHA_SAL:1:4) = W_ANO_SUB
C EVAL %SUBST(W_FECHA_SAL:5:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:7:2) = W_MES_SUB
C WHEN P_FORFES = \'DDMMAAAA\'
C EVAL %SUBST(W_FECHA_SAL:1:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:3:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:5:4) = W_ANO_SUB
C WHEN P_FORFES = \'MMDDAAAA\'
C EVAL %SUBST(W_FECHA_SAL:1:2) = W_MES_SUB
C EVAL %SUBST(W_FECHA_SAL:3:2) = W_DIA_SUB
C EVAL %SUBST(W_FECHA_SAL:5:4) = W_ANO_SUB
C ENDSL
C*
C* Actualiza Campo de String
C MOVEL *ALL\' \' W_SUBSTR
C MOVEL W_FECHA_SAL W_SUBSTR
C*
C ENDSR
Código
en formato texto
Fecha Mayo 2006
Tienes algún truco que quieras compartir con todos
los profesionales de Recursos iSeries AS400?.Envianoslo
y si resulta seleccionado te enviaremos un vale de Amazon
por valor de 50$
|
