Descripción de un número en letras

Les doy el código de un programa que llamé WORD.PRG que hace la descripción de un valor númerico en letras al estilo de como lo usan los bancos a la hora de emitir cheques.

El programa usa el PARAMETER asi que funciona como una función UDF con lo cual pueden usarlo de varias formas.

Ejemplos:

* Verlo directamente en la ventana de comandos
? WORD(525.87)
? WORD(Fields_Name)

* Asignarlo a una variable de memoria
Z=WORD(525.87)
Z=WORD(Fields_Name)

* Reemplazar campos de tipo caracter por el valor de un campo númerico
Replace all (Fields_Name1) with WORD(Fields_Name2)

Y también por supuesto hacer listados simples o ponerlo dentro de un reporte.

Espero les sea útil, yo soy cubano y solo tengo el VFP 7.0, pues tenemos dificultades para actualizarnos, esto lo hice hace muchos años en FOXPRO pero funciona muy bien, no sé si existe algo similar, espero les sirva para algo. Muchas gracias me encanta PORTALFOX pero estoy bien atrás.

A continuación el código:

FUNCTION WORD()
 LPARAMETERS _NUM
 IF TYPE('_NUM')#'N'
  RETURN 'Solo traduce Cadenas Numericas'
 ENDIF
 STORE ' ' TO _LMILLON,_LMILES,_LET
 _L1='UN DOS TRES CUATRO CINCO SEIS SIETE OCHO NUEVE DIEZ ONCE DOCE TRECE CATORCE QUINCE'
 _G1=' 1  2  3 4  5  6  7  8  9  10 11 12 13 14 15'
 _X1=' 1  4  8 13 20 26 31 37 42 48 53 58 63 69 77'
 _Y1=' 2  3  4 6  5  4  5  4  5  4  4  4  5  7  6'
 _L2='VEINTE TREINTA CUARENTA CINCUENTA SESENTA SETENTA OCHENTA NOVENTA'
 _G2='20 30 40 50 60 70 80 90'
 _X2=' 1  8 16 25 35 43 51 59'
 _Y2=' 6  7 8  9  7  7  7  7'
 _L3='CIENTO DOSC TRESC CUATROC QUIN SEISC SETEC OCHOC NOVEC'
 _G3=' 1  2 3  4  5  6  7  8  9'
 _X3=' 1  8 13 19 27 32 38 44 50'
 _Y3=' 6  4 5  7  4  5  5  5  5'
 IF _NUM=0
  RETURN 'CERO'
 ENDIF
 IF _NUM>999999999
  RETURN 'Solo traduce Numeros inferiores a Mil Millones......'
 ENDIF
 _NOM=_NUM
 _NAM=INT(_NUM)
 _MILLON=VAL(SUBSTR(STR(_NAM,9),1,3))
 _MILES=VAL(SUBSTR(STR(_NAM,9),4,3))
 _CIENTOS=VAL(SUBSTR(STR(_NAM,9),7,3))
 IF _CIENTOS>0
  _X=1
 ENDIF
 IF _MILES>0
  _X=2
 ENDIF
 IF _MILLON>0
  _X=3
 ENDIF
 DO WHILE _X>0
  IF _X=3
   _NUM=_MILLON
  ELSE
   IF _X=2
    _NUM=_MILES
   ELSE
    IF _X=1
     _NUM=_CIENTOS
    ENDIF
   ENDIF
  ENDIF
  _NUM1=_NUM
  _CAD=STR(_NUM,3)
  _C1=SUBSTR(_CAD,2,2)
  IF _NUM>0
   IF _NUM>100
    _NUM2=VAL(_C1)
    _NUM=_NUM2
    _C3=SUBSTR(_CAD,1,1)
    _N3=AT(_C3,_G3)
    _INI3=VAL(SUBSTR(_X3,_N3,2))
    _LON3=VAL(SUBSTR(_Y3,_N3,2))
    _LET3=SUBSTR(_L3,_INI3,_LON3)+IIF(_C3='1',' ','IENTOS ')
   ENDIF
   IF _NUM<10
    _CAD=STR(_NUM,1)
    _C1=SUBSTR(_CAD,1,1)
   ELSE
    IF _NUM<100
     _CAD=STR(_NUM,2)
    ENDIF
   ENDIF
   IF _NUM<16
    _N1=AT(_C1,_G1)
    _INI=VAL(SUBSTR(_X1,_N1,2))
    _LON=VAL(SUBSTR(_Y1,_N1,2))
    _LET=SUBSTR(_L1,_INI,_LON)
   ELSE
    IF _NUM<20
     _C1=SUBSTR(_CAD,2,1)
     _N1=AT(_C1,_G1)
     _INI=VAL(SUBSTR(_X1,_N1,2))
     _LON=VAL(SUBSTR(_Y1,_N1,2))
     _LET='DIECI'+SUBSTR(_L1,_INI,_LON)
    ELSE
     _C2=VAL(SUBSTR(_CAD,2,1))
     _NUM=_NUM-_C2
     _C1=STR(_NUM,2)
     _N1=AT(_C1,_G2)
     _INI=VAL(SUBSTR(_X2,_N1,2))
     _LON=VAL(SUBSTR(_Y2,_N1,2))
     _LET=SUBSTR(_L2,_INI,_LON)
     IF SUBSTR(_CAD,2,1)#'0'
      _C2=SUBSTR(_CAD,2,1)
      _N2=AT(_C2,_G1)
      _INI2=VAL(SUBSTR(_X1,_N2,2))
      _LON2=VAL(SUBSTR(_Y1,_N2,2))
      _LET=_LET+' Y '+SUBSTR(_L1,_INI2,_LON2)
     ENDIF
    ENDIF
   ENDIF
   IF _NUM1>99
    IF _NUM1=100
     _LET='CIEN '
    ELSE
     _LET=_LET3+_LET
    ENDIF
   ENDIF
   IF _X=3
    _LMILLON=_LET+' MILLONES'
    IF SUBSTR(_LET,1,2)='UN'
     _LMILLON=_LET+' MILLON'
    ENDIF
   ENDIF
   IF _X=2
    _LMILES=_LET+' MIL'
    IF SUBSTR(_LET,1,2)='UN'
     _LMILES='MIL'
    ENDIF
   ENDIF
  ENDIF
  _X=_X-1
 ENDDO
 IF _MILLON>0
  IF _MILES=0
   IF _cientos=0
    _BB=_LMILLON
   ELSE
    _BB=_LMILLON+' '+_LET
   ENDIF
  ELSE
   IF _cientos=0
    _BB=_lmillon+' '+_lmiles
   ELSE
    _BB=_LMILLON+' '+_LMILES+' '+_LET
   ENDIF
  ENDIF
 ELSE
  IF _MILES>0
   IF _cientos=0
    _BB=_lmiles
   ELSE
    _BB=_LMILES+' '+_LET
   ENDIF
  ELSE
   _BB=_LET
  ENDIF
 ENDIF
 _BB=_BB+' CON '+SUBSTR(STR(_NOM,13,2),12,2)+'/100'
 RETURN _BB
ENDFUNC

Nelson Maranjes