Aquí te adjunto un ejemplo en rpg. Espero te sirva. Saludos, hector De: [email protected] [mailto:[email protected]] En nombre de Peñaherrera, Mauro Enviado el: Martes, 17 de Marzo de 2009 05:37 p.m. Para: forum.help400 Asunto: rutina conversión
Compañeros del foro: Tengo una rutina para convertir un numero en letras (se utiliza para la impresión en los cheques) está en COBOL 400, pero se requiere hacer unos cambios, no soy muy bueno en COBOL, quería ver si alguien tiene una rutina en RPG, RPGLE o diferente de COBOL que me pueda facilitar o si conocen de alguna dirección electrónica donde pueda revisar. Gracias. Saludos Mauro Peñaherrera Ruiz Departamento de Tecnología ' (593-2) 2981-300 *: [email protected] [cid:[email protected]] ________________________________ Nota de descargo: La información contenida en este e - mail y sus anexos es confidencial y sólo puede ser utilizada por el destinatario del mismo. Esta información no debe ser distribuida, ni copiada total o parcialmente por ningún medio sin la autorización de DINERS/INTERDIN. Además, DINERS/INTERDIN no asume responsabilidad sobre información, opiniones o criterios contenidos en este e-mail. Disclaimer: The information contained in this e-mail and its attached files are confidential and intended only for the use of the person to which it is addressed. This information can not be totally or partially distributed nor copied by any media without the authorization from DINERS/INTERDIN. In addition, DINERS/INTERDIN does not assume responsibility about this information, opinions or criteria contented in this e-mail. ________________________________ Este mensaje se transmite exclusivamente para el uso del destinatario previsto y puede contener información que es PRIVILEGIADA y/o CONFIDENCIAL. Dicha información no expresa la posición de la compañía. Si usted no es el destinatario previsto, se le notifica por este medio, que cualquier uso, difusión, acceso o copia de esta comunicación está prohibida terminantemente. Si usted ha recibido esta comunicación por error, destruya por favor todas las copias de este mensaje y sus adjuntos y notifíquenos inmediatamente. This message is sent exclusively for the use of the intended recipient and may contain information that is PRIVILEGED and/or CONFIDENTIAL. This information do not express the position of the company. If you are not the intended recipient, you are hereby notified that any use, dissemination, disclosure or copying of this communication is strictly prohibited. If you have received this communication by mistake, please destroy all copies of this message and its attachments and notify us immediately "Bienvenido a la Vida, Bienvenido a InVita"
<<inline: image001.jpg>>
E*---------------- RUTINA DE MONTO ESCRITO -----------------------
E*
E* CONVIERTE UN IMPORTE DE HASTA 14,2 DE LONGITUD EN LETRAS.
E* EL TEXTO PUEDE SER DIVIDO HASTA EN 3 LINEAS DE IMPRESION DE
E* DISTINTA LONGITUD CADA UNA.
E* LA RUTINA ENTREGA EL TEXTO EN UN SOLO CAMPO QUE DEBERA SER
E* DIVIDIDO EN LAS LINEAS DESEADAS EN EL PROGRAMA PRINCIPAL.
E* TENGA EN CUENTA QUE EL IMPORTE EN LETRAS MAS LARGO OCUPA
E* 156 POSICIONES.
E* AL FINAL DEL CAMPO SE RELLENAN LAS POSICIONES NO OCUPADAS
E* POR TEXTO CON '='.
E*
E* DATOS DE ENTRADA: @MONTO (14,2) = IMPORTE A TRADUCIR.
E* ---------------- @L1 (3,0) = LONGITUD DE LA 1RA.LINEA.
E* MINIMO 20, MAXIMO 80.
E* @L2 (3,0) = LONGITUD DE LA 2DA.LINEA.
E* MINIMO 20, MAXIMO 80.
E* @LET = CAMPO DE 240 POS. EN BLANCO
E* @DES = CAMPO DE 20 POS. SI VIENE EN
E* BLANCO LA RUTINA NO LO USA.
E* SI VIENE LA DESCRIPCION DE LA
E* MONEDA LA RUTINA LO PONE AL FINAL.
E*
E* DATOS DE SALIDA: @LET = CONTIENE EL IMPORTE EN LETRAS CORTADO
E* --------------- A LA LONGITUD DE @L1 Y @L2.
E* LA LONGITUD DE LA 3RA.LINEA SALE POR DIFE-
E* RENCIA DE 240 - (@L1 + @L2).
E*
E* 06/05/2003 JULIO DESPOSORIO NO FUNCIONABA 1000XX.YY
E*----------------------------------------------------------------
E*
E @NOM1 80 225 1
E @NOM2 80 225 1
E @NOM3 1 2 80
E @NOM 225 1
E @TX 280 1
URD E @T1 280 1
URD E @T2 280 1
URD E @T3 280 1
E @DIG 9 1 0
E @MM 20 1
C**---------------------------------------------------------------
C *ENTRY PLIST
C PARM @MONTO 142
C PARM @L1 30
C PARM @L2 30
C PARM @LET 240
C PARM @DES 20
C*
C mo...@des @MM
C ' ' SCAN @DES ¥¥ 30
C Z-ADD1 @X 30
C Z-ADD270 @FINR 30
C mo...@monto @MILL 60
C MOVE @MILL @UNO 10
I1C @MILL IFNE 0
C z-...@mill @NETO 82
C EXSR @NULET
D2C @PRU DOUEQ'00/'
C ADD 1 @N 30
C mo...@tx,@N @PRU 3
D2C END
C SUB 5 @N
I2C @MILL IFEQ 1
C SUB 1 @N
C mo...@nom3,1 @TX,@N
C @N ADD 9 @X
X2C ELSE
I3C @UNO IFEQ 1
C SUB 1 @N
E2C END
C mo...@nom3,2 @TX,@N
C @N ADD 12 @X
E2C END
E1C END
C MOVE *BLANKS @TX,@X
C z-...@monto @NETO
C EXSR @NULET
C*
C @L1 IFLT 20
C @L1 ORGT 80
C Z-ADD80 @L1
C END
C @L2 IFLT 20
C @L2 ORGT 80
C Z-ADD80 @L2
C END
C @L1 ADD @L2 @L3 30
C 240 SUB @L3 @L3
C*
C Z-ADD0 @Y 30
C Z-ADD0 @X
D1C @L1 do...@y
C ADD 1 @X
C ADD 1 @Y
I2C @TX,@X IFNE '-'
C MOVE @TX,@X @T1,@Y
I3C @TX,@X IFEQ ' '
C z-...@x @N
C z-...@y @Z
E3C END
X2C ELSE
C z-...@x @N
C z-...@y @Z
C SUB 1 @Y
E2C END
D1C END
C @T1,@L1 COMP ' ' 99
C N99 @T1,@L1 COMP '-' 99
C 99 GOTO BIEN1
C MOVE @TX,@N @T1,@Z
C ADD 1 @Z
C MOVEA*BLANK @T1,@Z
C z-...@n @X
C*
C BIEN1 TAG
I1C @L2 IFNE 0
C Z-ADD0 @Y
D2C @L2 do...@y
C ADD 1 @X
C ADD 1 @Y
I3C @TX,@X IFNE '-'
C MOVE @TX,@X @T2,@Y
I4C @TX,@X IFEQ ' '
C z-...@x @N
C z-...@y @Z
E4C END
X3C ELSE
C z-...@x @N
C z-...@y @Z
C SUB 1 @Y
E3C END
D2C END
C @T2,@L2 COMP ' ' 99
C N99 @T2,@L2 COMP '-' 99
C 99 GOTO BIEN2
C MOVE @TX,@N @T2,@Z
C ADD 1 @Z
C MOVEA*BLANK @T2,@Z
C z-...@n @X
E1C END
C*
C BIEN2 TAG
I1C @L3 IFNE 0
C Z-ADD0 @Y
D2C @L3 do...@y
C ADD 1 @X
C ADD 1 @Y
I3C @TX,@X IFNE '-'
C MOVE @TX,@X @T3,@Y
I4C @TX,@X IFEQ ' '
C z-...@x @N
C z-...@y @Z
E4C END
X3C ELSE
C z-...@x @N
C z-...@y @Z
C SUB 1 @Y
E3C END
D2C END
C @T3,@L3 COMP ' ' 99
C N99 @T3,@L3 COMP '-' 99
C 99 GOTO BIEN3
C MOVE @TX,@N @T3,@Z
C ADD 1 @Z
C MOVEA*BLANK @T3,@Z
C z-...@n @X
E1C END
C BIEN3 TAG
C MOVE *ALL' ' @TX
C mo...@t1 @TX
C @L1 ADD 1 @N
C mo...@t2 @TX,@N
C ADD @L2 @N
C mo...@t3 @TX,@N
C Z-ADD1 @N
C '.' lo...@tx,@N 95
C *IN95 IFEQ '1'
C ADD 1 @N
C MOVEA*ALL'=' @TX,@N
C END
C mo...@tx @LET
C @DES IFNE ' '
C Z-ADD1 @N
C '=' lo...@tx,@N 95
C *IN95 IFEQ '1'
C MOVE ' ' @TX,@N
C DO ¥¥ @I
C ADD 1 @N
C MOVE @MM,@I @TX,@N
C END
C END
C END
C mo...@tx @LET
C SETON LR
C**---------------------------------------------------------------
C @NULET BEGSR
C MOVE *BLANKS @NOM
C MLLZO'1' @NETO
C z-...@neto @PESOS 60
C z-...@neto @CENTS 22
C Z-ADD279 @TOPE 30
C SETOF 9495
C SETOF 9899
C SETON 92
C Z-ADD0 @D 20
C mo...@pesos @TRES 3
C MOVE @TRES @DOS 2
C mo...@tres @DIG,1
C mo...@dos @DIG,2
C MOVE @DOS @DIG,3
C MOVE @PESOS @TRES
C MOVE @TRES @DOS
C mo...@tres @DIG,4
C mo...@dos @DIG,5
C MOVE @DOS @DIG,6
C*
C @@01 TAG
C Z-ADD1 @ORD 20
C @@02 TAG
C ADD 1 @D
C @DIG,@D COMP 0 93
C 93 GOTO @@05
C @ORD COMP 2 93
C N93 GOTO @@04
C N92 GOTO @@20
C 95 GOTO @@21
C @@03 TAG
C SETOF 92
C GOTO @@01
C @@04 TAG
C ADD 1 @ORD
C GOTO @@02
C*
C @@05 TAG
C SETON 95 SE¥AL 'V'.
C @DIG,@D COMP 2 94 93
C 93 GOTO @@10 ES 2
C 94 GOTO @@11 ES DE 3 A 9
C @ORD COMP 2 9699
C 99 GOTO @@12 SE¥AL 'C'.
C 96 GOTO @@13 SE¥AL 'U'.
C @D ADD 1 @Z 30
C @DIG,@Z COMP 0 94
C 94 GOTO @@@14
C Z-ADD3 @ORD
C MOVE @Z @D
C @DIG,@D SUB 1 @I 30
C MULT 13 @I
C ADD 108 @I
C MOVE @NOM2 @NOM
C GOTO @@@15
C*
C @@10 TAG
C @ORD COMP 2 9493
C 94 GOTO @@13
C 93 GOTO @@12
C @D ADD 1 @Z
C @DIG,@Z COMP 0 98 SE¥AL 'I'.
C GOTO @@@14
C*
C @@11 TAG
C @ORD COMP 2 94 97 SE¥AL 'Y'.
C 94 GOTO @@13
C N97 GOTO @@12
C*
C @@@14 TAG
C @DIG,@D SUB 1 @I DECENAS
C MULT 12 @I
C MOVE @NOM2 @NOM
C GOTO @@@15
C @@13 TAG
C @DIG,@D SUB 1 @I UNIDADES
C MULT 8 @I
C ADD 153 @I
C MOVE @NOM1 @NOM
C GOTO @@@15
C @@12 TAG
C @DIG,@D SUB 1 @I CENTENAS
C MULT 17 @I
C MOVE @NOM1 @NOM
C*
C @@@15 TAG TRANSFIERE
C ADD 1 @I @NOM EN @TX
C MOVE @NOM,@I @TX,@X
C @NOM,@I COMP '-' 93
C 93 GOTO @@06
C ADD 1 @X
C GOTO @@@15
C @@06 TAG
C 96
COR 98
COR 99 GOTO @@09
C @X ca...@finr @@09 93
C SUB 1 @TOPE
C GOTO @@28
C*
C @@09 TAG
C ADD 1 @X
C @@28 TAG
C 98 GOTO @@16
C 99 GOTO @@17
C 97 GOTO @@18
C N96 GOTO @@19
C SETOF 96
C N92 GOTO @@20
C*
C SUB 2 @X CONVIERTE
C MOVE ' ' @TX,@X 'UNO' EN 'UN'
C ADD 1 @X
C*
C @@21 TAG PONE 'MIL'
C MOVEA'MIL' @TX,@X
C ADD 4 @X
C GOTO @@03
C*
C @@17 TAG CONVIERTE
C @D ADD 1 @Z 'CIENTO' EN
C @DIG,@Z COMP 0 93 'CIEN'
C 93 ADD 1 @Z
C 93 @DIG,@Z COMP 0 93
C N93 GOTO @31
C @Z IFEQ 7 JD01
C *IN93 ANDEQ'1' JD01
C ELSE JD01
C SUB 3 @X
C ENDIF JD01
C MOVE ' ' @TX,@X
C ADD 1 @X
C MOVE @Z @D
C GOTO @@23
C @31 TAG
C @X ca...@finr @@22 93
C SUB 2 @TOPE
C GOTO @@22
C*
C @@16 TAG CONVIERTE
C SUB 2 @X 'VEINTE' EN
C MOVE 'I' @TX,@X 'VEINTI'
C ADD 1 @X
C*
C @@22 TAG
C SETOF 979899
C @@19 TAG
C @ORD COMP 2 93
C 93 GOTO @@23
C GOTO @@04
C @@18 TAG
C*
C @D ADD 1 @Z PONE 'Y' SI
C @DIG,@Z COMP 0 94 ESTANDO EN DE-
C 94 GOTO @@22 CENAS UNIDADES
C MOVE 'Y' @TX,@X NO ES CERO.
C SETOF 93
C @X IFLT @FINR
C ADD 2 @X
C END
C GOTO @@22
C @@23 TAG
C 92 GOTO @@21
C @@20 TAG
C*
C *IN95 IFEQ '1' HUBO PESOS
C MOVEA'CON' @TX,@X PONE 'CON'
C ADD 4 @X
C END
C mo...@cents @TX,@X
C ADD 1 @X
C MOVE @CENTS @TX,@X
C @X IFLT @FINR
C ADD 1 @X
C END
C MOVEA'/100.' @TX,@X PONE '/100.'
C ADD 6 @X
C ENDSR
C**---------------------------------------------------------------
** @NOM1
CIEN-TO DOS-CIEN-TOS TRES-CIEN-TOS CUA-TRO-CIEN-TOS QUI-NIEN-TOS
SEIS-CIEN-TOS SETE-CIEN-TOS OCHO-CIEN-TOS NOVE-CIEN-TOS UNO
DOS TRES CUA-TRO CIN-CO SEIS SIE-TE OCHO NUE-VE
** @NOM2
DIEZ VEIN-TE TREIN-TA CUA-REN-TA CIN-CUEN-TA SE-SEN-TA SE-TEN-T
A O-CHEN-TA NO-VEN-TA ONCE DOCE TRE-CE CA-TOR-CE
QUIN-CE DIE-CI-SEIS DIE-CI-SIETE DIE-CI-OCHO DIE-CI-NUEVE
** @NOM3
MI-LLON
MI-LLO-NES
__________________________________________________ Forum.HELP400 es un servicio m&#225;s de ServerNEWS. &#169; Publicaciones Help400, S.L. - Todos los derechos reservados http://www.help400.es _____________________________________________________ Para darte de baja visita la siguente URL: http://listas.combios.es/mailman/listinfo/forum.help400
