Monto_escrito

codigo que permite pasar un valor númerico a cadena de caracteres, por ejemplo cuando en una empresa se generan recibos o cheques con valores.
				FUNCTION montoesc
PARAMETERS cifra
private all *
****************INICIALIZACION DE VARIABLES*************************
literal = ' '
STORE 0.01 TO minimo
STORE 999999999999.99 TO maximo
STORE ' ' TO val_literal
*
*******ARREGLO QUE CONTIENE MILESMILLONES, MILLONES, MILES Y PESOS**
DIMENSION num_a_lite(4,2)
STORE '' TO num_a_lite
*
****PARA CONTENER EL VALOR DE LOS CENTAVOS****
STORE 'CON ' TO parte_con
STORE '/100 MCTE.' TO parte_100
*
*****CARGA UNAS TABLAS PARA UTILIZAR EN LA IMPRESION DEL MONTO
DIMENSION tabla_unid(9)
STORE 'UN ' TO tabla_unid(1)
STORE 'DOS ' TO tabla_unid(2)
STORE 'TRES ' TO tabla_unid(3)
STORE 'CUATRO ' TO tabla_unid(4)
STORE 'CINCO ' TO tabla_unid(5)
STORE 'SEIS ' TO tabla_unid(6)
STORE 'SIETE ' TO tabla_unid(7)
STORE 'OCHO ' TO tabla_unid(8)
STORE 'NUEVE ' TO tabla_unid(9)
*
***************
DIMENSION tabla_dece(9)
STORE 'DIEZ ' TO tabla_dece(1)
STORE 'VEINTE ' TO tabla_dece(2)
STORE 'TREINTA ' TO tabla_dece(3)
STORE 'CUARENTA ' TO tabla_dece(4)
STORE 'CINCUENTA ' TO tabla_dece(5)
STORE 'SESENTA ' TO tabla_dece(6)
STORE 'SETENTA ' TO tabla_dece(7)
STORE 'OCHENTA ' TO tabla_dece(8)
STORE 'NOVENTA ' TO tabla_dece(9)
*
***************
DIMENSION tab_11_15 (5)
STORE 'ONCE ' TO tab_11_15(1)
STORE 'DOCE ' TO tab_11_15(2)
STORE 'TRECE ' TO tab_11_15(3)
STORE 'CATORCE ' TO tab_11_15(4)
STORE 'QUINCE ' TO tab_11_15(5)
*****************************FIN INICIALIZACION***************
*
**********************************************
**********PROGRAMA PRINCIPAL******************
**********************************************
*
IF (cifra < minimo .OR. cifra > maximo)
literal = iif(cifra=0,[CERO PESOS CON 00/100 MCTE.],[**])
ELSE
DO conv_a_l
ENDIF
RETURN(literal)
**********FIN PROGRAMA PRINCIPAL**************
**********************************************
PROCEDURE conv_a_l

*
cifra_alfa = trans(cifra,[@L 999999999999.99])
fraccion = RIGHT(cifra_alfa,2)
milmillon = SUBSTR(cifra_alfa,1,3)
millon = SUBSTR(cifra_alfa,4,6)
miles = SUBSTR(cifra_alfa,7,9)
pesos = SUBSTR(cifra_alfa,10,12)
centenas = 0
decenas = 0
unidades = 0
i = 0

IF milmillon > '000'
I = I + 1
STORE 'MIL ' TO num_a_lite(I,2)
if millon = [000]
num_a_lite(I,2)=num_a_lite(I,2)+[MILLONES ]
endif
if millon+miles+pesos = [000000000]
num_a_lite(I,2)=num_a_lite(I,2)+[DE ]
endif
DO ce_de_un WITH milmillon
DO num_a_le
STORE val_literal TO num_a_lite(I,1)
ENDIF

IF millon > '000'
I = I + 1
*
** ALMACENA TITULO DE MILLON**
DO CASE
CASE millon+miles+pesos = '001000000'
STORE 'MILLON DE ' TO num_a_lite(I,2)
CASE millon=[001] .and. miles+pesos # [000000]
STORE 'MILLON ' TO num_a_lite(I,2)
case millon # [001] .and. miles+pesos=[000000]
STORE 'MILLONES DE ' TO num_a_lite(I,2)
case millon # [001] .and. miles+pesos#[000000]
STORE 'MILLONES ' TO num_a_lite(I,2)
endcase
******
DO ce_de_un WITH millon
DO num_a_le
STORE val_literal TO num_a_lite(I,1)
ENDIF

IF miles > '000'
I = I + 1
STORE 'MIL ' TO num_a_lite(I,2)
DO ce_de_un WITH miles
DO num_a_le
STORE val_literal TO num_a_lite(I,1)
ENDIF

IF pesos > '000'
I = I + 1
DO ce_de_un WITH pesos
DO num_a_le
STORE val_literal TO num_a_lite(I,1)
ENDIF

nu_conv_a_l=[]
IF milmillon+millon+miles+pesos == [000000000000]
nu_conv_a_l= fraccion + parte_100
ELSE
*
***************FORMA EL MONTO ESCRITO*****************
*
** NU_CONV_A_L CONTIENE EL MONTO ESCRITO SIN TENER
** EN CUENTA LA LONGITUD DE LA LINEA A IMPRIMIR, OSEA,
** PARA IMPRIMIR EN UNA SOLA LINEA.
*
******************************************************
nu_conv_a_l = num_a_lite(1,1) + num_a_lite(1,2) +;
num_a_lite(2,1) + num_a_lite(2,2) +;
num_a_lite(3,1) + num_a_lite(3,2) +;
num_a_lite(4,1)
nu_conv_a_l = nu_conv_a_l + 'PESOS ' + parte_con + fraccion + parte_100
ENDIF
literal=nu_conv_a_l
RETURN
*
*
***********************************************************************
PROCEDURE ce_de_un
*****************************************
**DIVIDE UN VALOR EN UNIDADES,DECENAS Y CENTENAS**
*****************************************
PARAMETERS valor
centenas = SUBSTR(m->valor,1,1)
decenas = SUBSTR(m->valor,2,1)
unidades = SUBSTR(m->valor,3,1)
RETURN
*
PROCEDURE num_a_le
*****************************************
**ALMACENA LOS VALORES EN FORMA LITERAL**
*****************************************
STORE '' TO val_lit_cen, val_lit_dec, val_lit_uni
IF centenas > '0'
IF centenas = '1'
IF decenas = '0' .AND. unidades = '0'
STORE 'CIEN ' TO val_lit_cen
ELSE
STORE 'CIENTO ' TO val_lit_cen
ENDIF
ELSE
IF centenas = '5'
STORE 'QUINIENTOS ' TO val_lit_cen
ELSE
IF centenas = '7'
STORE 'SETECIENTOS ' TO val_lit_cen
ELSE
IF centenas = '9'
STORE 'NOVECIENTOS ' TO val_lit_cen
ELSE
val_lit_cen = trim(tabla_unid(VAL(centenas)))+'CIENTOS '
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
IF decenas > '0'
IF unidades = '0'
STORE tabla_dece(VAL(decenas)) TO val_lit_dec
ELSE
IF decenas > '2'
val_lit_dec = tabla_dece(VAL(decenas)) + 'Y '
ELSE
IF decenas = '1'
IF unidades <= '5'
STORE tab_11_15(VAL(unidades)) TO val_lit_dec
ELSE
IF unidades = '8'
STORE 'DIECIOCHO ' TO val_lit_dec
ELSE
STORE 'DIECI' TO val_lit_dec
ENDIF
ENDIF
ELSE
IF unidades = '8'
STORE 'VEINTIOCHO ' TO val_lit_dec
ELSE
IF unidades = '1'
STORE 'VEINTIUN ' TO val_lit_dec
ELSE
STORE 'VEINTI' TO val_lit_dec
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
IF unidades > '0'
IF decenas <> '1' .OR. ((unidades > '5').AND.(unidades <> '8'))
IF (decenas <> '2') .OR. ((unidades <> '8') .AND. (unidades <> '1'))
STORE tabla_unid(VAL(unidades)) TO val_lit_uni
ENDIF
ENDIF
ENDIF
val_literal = val_lit_cen + val_lit_dec + val_lit_uni
val_literal = LTRIM(val_literal)
RETURN
*
*****************************************************************
Descargar adjuntos
COMPARTE ESTE TUTORIAL

ENVIAR A UN AMIGO
COMPARTIR EN FACEBOOK
COMPARTIR EN TWITTER
COMPARTIR EN GOOGLE +
TUTORIAL ANTERIOR

SIGUIENTE TUTORIAL

HAY 4 COMENTARIOS
  • Anónimo dijo:

    Me sirvió. Excelente. Felicitaciones Tuve que hacer unos pequeños cambios por los literales. Sustituir /¨ por ". Problema muy menor 9/3/06

  • Anónimo dijo:

    Excelente código felicitaciones, yo estaba diseñando uno para lo mismo pero no me había funcionado bien.

  • Anónimo dijo:

    Baje todo el texto y corri el programa en fox5 y me dio error, hice lo mismo en fox9 y tambien da error, no se como hacerlo funcionar

  • Anónimo dijo:

    Hola, muchas gracias, dado que tenía que implementar esta rutina,-

Conéctate o Regístrate para dejar tu comentario.