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
*
*****************************************************************
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.
Descargar adjuntos
COMPARTE ESTE TUTORIAL
COMPARTIR EN FACEBOOK
COMPARTIR EN TWITTER
COMPARTIR EN LINKEDIN
COMPARTIR EN WHATSAPP
Me sirvió. Excelente. Felicitaciones Tuve que hacer unos pequeños cambios por los literales. Sustituir /¨ por ". Problema muy menor 9/3/06
Excelente código felicitaciones, yo estaba diseñando uno para lo mismo pero no me había funcionado bien.
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
Hola, muchas gracias, dado que tenía que implementar esta rutina,-