¿ 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
Calendario semestral

Categoría : Programación
Autor : Pedro Pinedo
Título : Conversión de fecha a texto

Descripción del truco:
Convierte la fecha en formato AAAA/MM/DD en una fecha en texto

Código en formato texto
Fecha 24-03-2004

***************************************************************** * * * CONVERSION DE FECHA A TEXTO * * * ***************************************************************** H/EJECT H DECEDIT('0,') ALTSEQ(*EXT) DATEDIT(*DMY.) * D* D* TABLAS DE TRABAJO D* D D S 13 DIM(43) CTDATA PERRCD(1) D C S 14 DIM(10) CTDATA PERRCD(1) D M S 11 DIM(12) CTDATA PERRCD(1) D A S 26 DIM(2) CTDATA PERRCD(1) D* D* TABLAS DE TRABAJO D* D TEX S 1 DIM(80) D CAM S 1 DIM(80) * ***************************************************************** * * * ESTRUCTURAS DE DATOS * * * ***************************************************************** D DS D AÑO 1 4 0 D MES 5 6 0 D DIA 7 8 0 D FECHA 1 8 0 D DS D NO1 1 30 D NO2 31 60 D NO3 61 80 D FECHN 1 80 ***************************************************************** * * * PROCESO INICIAL * * * ***************************************************************** * * PARMETROS TRANSFERIDOS * * SWFEC - CAMPO PARA FECHA * * SWNO1 - CAMPO DE RETORNO 1 * SWNO2 - CAMPO DE RETORNO 2 * SWNO3 - CAMPO DE RETORNO 3 * C *ENTRY PLIST C PARM SWFEC 8 C PARM SWNO1 30 C PARM SWNO2 30 C PARM SWNO3 20 * * INICIALIZACION DE CONSTANTES * C MOVE SWFEC FECHA C MOVE AÑO AÑO2 2 0 C EXSR NOMNUM C MOVE NO1 SWNO1 C MOVE NO2 SWNO2 C MOVE NO3 SWNO3 C SETON LR ***************************************************************** * * * NOMNUM: TRASFORMA FECHA DE NUMERO A NOMBRE * * * ***************************************************************** C NOMNUM BEGSR C* C MOVE *BLANKS BLANCO 80 C MOVEA BLANCO TEX C MOVEA BLANCO CAM C MOVEA D(DIA) CAM C Z-ADD 1 N 2 0 C Z-ADD 1 Z 2 0 C N DOWLE 13 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 13 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C DIA IFEQ 31 C MOVEA BLANCO CAM C MOVEA D(1) CAM C Z-ADD 1 N 2 0 C N DOWLE 13 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 13 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C END C* C MOVE 'd' TEX(Z) C ADD 1 Z C MOVE 'e' TEX(Z) C ADD 2 Z C* C MOVEA BLANCO CAM C MOVEA M(MES) CAM C Z-ADD 1 N 2 0 C N DOWLE 11 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 11 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C* C MOVE 'd' TEX(Z) C ADD 1 Z C MOVE 'e' TEX(Z) C ADD 1 Z C* C AÑO IFLT 2000 C ADD 1 Z C MOVEA BLANCO CAM C MOVEA A(1) CAM C Z-ADD 1 N 2 0 C N DOWLE 26 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 26 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C ELSE C ADD 1 Z C MOVEA BLANCO CAM C MOVEA A(2) CAM C Z-ADD 1 N 2 0 C N DOWLE 26 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 26 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C END C MOVE AÑO AÑO3 3 0 C MOVEL AÑO3 AÑ13 1 0 C Z-ADD AÑ13 A13 2 0 C AÑO3 IFGT 0 C AÑ13 IFGT 0 C AÑO3 IFEQ 100 C MOVEA BLANCO CAM C MOVEA C(A13) CAM C ELSE C ADD 1 A13 C MOVEA BLANCO CAM C MOVEA C(A13) CAM C END C Z-ADD 1 N 2 0 C N DOWLE 14 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 14 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C END C* C AÑO2 IFGT 0 C AÑO2 IFLT 31 C MOVEA BLANCO CAM C MOVEA D(AÑO2) CAM C Z-ADD 1 N 2 0 C N DOWLE 13 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 13 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C* C ELSE C MOVE AÑO2 AÑO1 1 0 C MOVEL AÑO2 AÑ11 1 0 C Z-ADD AÑ11 A11 2 0 C A11 IFGE 3 C Z-ADD 30 H 2 0 C SUB 3 A11 C 2 MULT A11 A11 C ADD A11 H C AÑO1 IFGT 0 C ADD 1 H C END C MOVEA BLANCO CAM C MOVEA D(H) CAM C ELSE C MOVEA BLANCO CAM C MOVEA D(AÑO2) CAM C END C Z-ADD 1 N 2 0 C N DOWLE 13 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 13 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C AÑO1 IFGT 0 C MOVEA BLANCO CAM C MOVEA D(AÑO1) CAM C Z-ADD 1 N 2 0 C N DOWLE 13 C MOVE CAM(N) TEX(Z) C CAM(N) IFEQ ' ' C *IN70 IFEQ '0' C SETON 70 C ELSE C SETOFF 70 C Z-ADD 13 N C SUB 1 Z C END C ELSE C SETOFF 70 C END C ADD 1 N C ADD 1 Z C ENDDO C END C END C END C END C SUB 1 Z C MOVE '.' TEX(Z) C MOVEA TEX FECHN C* C ENDSR C/EJECT ** uno dos tres cuatro cinco seis siete ocho nueve diez once doce trece catorce quince dieciseis diecisiete dieciocho diecinueve veinte veintiuno veintidos veintitres veinticuatro veinticinco veintiseis veintisiete veintiocho veintinueve treinta treinta y cuarenta cuarenta y cincuenta cincuenta y sesenta sesenta y setenta setenta y ochenta ochenta y noventa noventa y ** cien ciento doscientos trescientos cuatrocientos quinientos seiscientos setecientos ochocientos novecientos ** enero febrero marzo abril mayo junio julio agosto septiembre octubre noviembre diciembre ** mil dos mil
 

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

Symtrax
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: Poliedric, s.c.p. CIF:G63005011 Urgell 143 1º1ª 08036 - Barcelona - Tel.+34.902.361.344