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