¿ Quieres imprimir esta página ? Volver a la página principal de Recursos iSeries AS400 ¿ Necesitas ayuda ? En pruebas
System i5 iSeries AS400 Recursos. Compartiendo generamos conocimiento
Novedades en Recursos iSeries AS400
Noticias tecnológicas
Rutina para Convertir Archivos Multicampos a uno Solo

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$

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