Base de datos de entrada de pacientes por Urgencias .
Me falla sólo dos cositas...
1) calcular la edad del paciente (incluyendo los días ya que si son niños pequeños es bastante importante ese dato)
2) implementar la fecha del Alta del Paciente.
En el primer punto, he mirado y remirado y hecho miles de combinaciones pero no logro poder hacerlo.
Tengo un campo Fecha de Nacimiento (FechaNac) y al lado un campo EDAD que se debería rellenar automáticamente al salir de la Fecha de Nacimiento.
Tengo este código pero... no me funciona
Código: Seleccionar todo
sub CalculaEdad( Fecha As Object) As String
Dim lFecha1 As Long
Dim lFecha2 As Long
Dim mDatos()
Dim iMeses As Integer
Dim sResultado As String
Dim xano as string
Dim xmes as string
Dim xdia as string
Dim stringano as string
Dim stringmes as string
Dim stringdia as string
Dim oForm As Object
oForm=Evento.Source
Fecha = oForm.getByName("FechaNac")
If Fecha.Year = 0 Then
lFecha1 = CLng(Date())
Else
lFecha1 = CLng(DateSerial(Fecha.Year,Fecha.Month,Fecha.Day))
End If
lFecha2 = CLng(Date())
mDatos = Array( lFecha1, lFecha2, 0 )
iMeses = FuncionCalc( "com.sun.star.sheet.addin.DateFunctions.getDiffMonths", mDatos() )
xano = (iMeses \ 12)
xmes = (iMeses Mod 12)
if xano = 1 then
stringano = " año y "
else
stringano = " años y "
end if
if xano = 0 then
stringano = ""
end if
if xmes = 1 then
stringmes = " mes"
else
stringmes = " meses"
end if
if xmes = 0 then
stringmes = ""
end if
if xdia = 1 then
stringmes = " día"
else
stringdia = " días"
end if
if xdia = 0 then
stringdia = ""
end if
sResultado = xano & stringano & xmes & stringmes & xdia & stringdia
' CalculaEdad = sResultado
Evento.Source.getByName("EDAD").Text = sResultado
End sub
Código: Seleccionar todo
Sub DarAlta(Evento)
Dim oCtrl As Object, oForm As Object
oForm=Evento.Source ' Formulario afectado
oCtrl = oForm.getByName("FechaAlt") ' Control fecha
If oCtrl.BoundField.getString()<>"" Then Exit sub ' Si ya hay una fecha, salimos
oCtrl.BoundField.UpdateString( Format(Now, "dd/mm/yyyy") & " " & Format(Now, "HH:mm:ss") ) ' Ponemos la fecha
end sub
Gracias por adelantado...
)
