Cálculo de edades

[TecniSoftware]

Acá les paso mis rutinas de cálculo de edades para el que las pueda necesitar, es sencillo pero siempre viene bien.

Saludos!

Code: Select all

//--------------------------------------------------------------------------------------------------------------------//

// Descompone en meses, la diferencia de tiempo entre las fechas

Function EdadMeses( dNacimiento, dCalculo )
DEFAULT dCalculo := Date()

Return Year( dCalculo ) * 12 + Month( dCalculo ) - ( Year( dNacimiento ) * 12 + Month( dNacimiento ) ) + If( Day( dCalculo ) < Day( dNacimiento ), -1, 0 )

//--------------------------------------------------------------------------------------------------------------------//

/*

Edad( dNacimiento, dFecha, nMode )
dNacimiento = Fecha de nacimiento ( que mas ? )
dFecha      = Fecha de cálculo, por omisión, fecha actual
nMode       = Tipo de cálculo

1 = Edad exacta a una fecha determinada
2 = Edad con decimales, es decir 10 años y nacido a mitad de junio, devulve 10,5
3 = Edad redondeada, es decir 10,7 años, devuelve 11. 

*/

Function Edad( dNacimiento, dFecha, nMode )
Local nYears   := 0
Local nMonths  := 0
Local nDays    := 0
Local nEdad    := 0
Local nReturn  := 0
Local dCalc1   := CtoD("")
Local dCalc2   := CtoD("")
Local nDif
Local nDecimal
Local lYear    := .F.

DEFAULT dFecha := Date()
DEFAULT nMode  := 1 // Edad exacta o actuarial

If dFecha < dNacimiento
   Return 0
EndIf

nYears  := Year(dFecha)  - Year(dNacimiento)
nMonths := Month(dFecha) - Month(dNacimiento)
nDays   := Day(dFecha)   - Day(dNacimiento)

If ( nYears > 0 .AND. nMonths = 0 .AND. nDays >= 0) .OR. (nYears > 0 .AND. nMonths > 0 )
   lYear := .T.
EndIf

nEdad := ( Year(dFecha) - Year(dNacimiento) ) - If( lYear, 0, 1 )

If nEdad < 0 .OR. nEdad = Year(dFecha)
   Return 0
EndIf

// Calculo de decimales
dCalc1 := DMY2Date( Day(dNacimiento), Month(dNacimiento), Year(dFecha) )
Do Case
   Case dCalc1 = dFecha                 // Cumpleaños
        nDif   := 0

   Case dCalc1 < dFecha                 // Falta para cumplir este año
        nDif   := ( dFecha - dCalc1 )   

   Case dCalc1 > dFecha                 // Ya cumplió este año
        dCalc2 := DMY2Date( Day(dNacimiento), Month(dNacimiento), Year(dFecha) - 1 )
        nDif   := ( dFecha - dCalc2 )  

EndCase
nDecimal := nDif / 365

Do Case

   Case nMode == 1 // Edad exacta o actuarial
        nReturn := nEdad

   Case nMode == 2 // Edad con decimales
        nReturn := ( nEdad + nDecimal )

   Case nMode == 3 // Edad redondeada a 0
        nReturn := Round( nEdad + nDecimal, 0 )
   
EndCase

Return nReturn

//--------------------------------------------------------------------------------------------------------------------//

Function DMY2Date( nDia, nMes, nAnio )
Local cFormato   := Set( 4, "YYYY/MM/DD" )
Local dResultado := CtoD( Str( nAnio ) + "/" + Str( nMes ) + "/" + Str( nDia ) )

Set( 4, cFormato )

Return dResultado

//--------------------------------------------------------------------------------------------------------------------//

[dobfivewin]

Aca le dejo la mia....

devuelve Año, meses y dias entre dos fechas

Code: Select all

* Calculo AÑOS/MESES/DIAS entre 2 Fechas (por David Barrio)
Function CalculaAMD(Fecha1,Fecha2)
local Tiempo:='',FechaX,CantiMeses:=0
If Fecha1>Fecha2.or.Fecha1=ctod('  -  -    ').or.Fecha2=ctod('  -  -    ') ; return '' ; EndIf
Set Date ANSI
FechaX:=If( ctod(str(Year(Fecha2),4)+substr(dtoc(Fecha1),5,6)) > Fecha2,;
            ctod(str((Year(Fecha2)-1),4)+substr(dtoc(Fecha1),5,6)) ,;
					  ctod(str(Year(Fecha2),4)+substr(dtoc(Fecha1),5,6)) )
Tiempo:=If(Year(FechaX)-Year(Fecha1)<>0,;
           Str(Year(FechaX)-Year(Fecha1),2)+;
					 ' Año'+If(Year(FechaX)-Year(Fecha1)>1,'s',''),'')
While If(Month(FechaX)=12,;
         ctod(str(Year(FechaX)+1,4)+'.01.'+str(Day(FechaX),2)),;
         ctod(str(Year(FechaX),4)+'.'+str(Month(FechaX)+1,2)+'.'+str(Day(FechaX),2)) ) < Fecha2
  FechaX := If(Month(FechaX)=12,;
	             ctod(str(Year(FechaX)+1,4)+'.01.'+str(Day(FechaX),2)),;
	             ctod(str(Year(FechaX),4)+'.'+str(Month(FechaX)+1,2)+'.'+str(Day(FechaX),2)) )
	CantiMeses := CantiMeses + 1
EndDo
Tiempo:=alltrim(Tiempo+If(CantiMeses<>0,' '+Str(CantiMeses,2)+;
                          ' Mes'+If(CantiMeses>1,'es',''),'')+;
                       If(Fecha2-FechaX<>0,' '+str((Fecha2-FechaX),3)+;
                          ' Dia'+If(Fecha2-FechaX>1,'s',''),''))
*msginfo(Tiempo)
Set Date BRITISH
Return Tiempo