Calculate due dates for employee medicals (1 Viewer)

[smally]

Hi. I'd like a bit of advice for how I need to design my database to log medical information for my employees and calculate their due date(s) for another medical.

Each of my employees are required to attend a medical assessment for them to work on a construction site.
The medical simply covers hearing, lung function, skin assessment etc. Medicals are performed by an external company, who provide me with an overall report similar to a traffic light system.
The employee's medical is either marked as satisfactory (green), sub-optimal (amber), or unfit (red).

Each employee will need another medical every X years (X depends on their age).
However if their report states something is sub-optimal, annual reviews are required until their report goes to satisfactory.

Examples:
John Smith has a medical 2/3/2017. His medical was satisfactory, he will need another medical due for 2/3/2020.

David Jones also had a medical 2/3/2017. His hearing was sub-optimal, he will require a medical review for 2/3/2018.
His medical review on 2/3/2018 states his hearing is still sub-optimal, he will require another medical review for 2/3/2019.
His medical review on 2/3/2019 states his hearing is still sub-optimal, he will require another annual review however... his full medical will be due:
He will need another full medical due for 2/3/2020.

Andy Johnson also had a medical 2/3/2017. His hearing was sub-optimal, he will require a medical review for 2/3/2018.
His medical review on 2/3/2018 states his hearing is now satisfactory, he will not require a medical review.
He will need another full medical due for 2/3/2020.



I've been using this vba code to calculate due dates in queries, however this does not work properly when it takes the medical reviews.

Function GetMedicalExpiry(medDate As Date, DOB As Date, strResult As String) As Date

    Dim iAge As Integer
    Dim i As Integer

    iAge = age(DOB) ' Function that returns the age from a date of birth

    Select Case iAge
        Case 0 To 54    ' Ages 0 to 54 have medicals every 3 years
            i = 3
        Case 55 To 64   ' Ages 55 to 64 have medicals every 2 years
            i = 2
        Case 65 To 1000 ' Ages 65+ have medicals yearly
            i = 1
    End Select

    Select Case strResult
        Case Is = "Sub-Optimal" ' If medical is reported as sub-optimal, another
            i = 1               ' medical review must be done it 1 year
        Case Is = "Unfit"   ' If medical is reported as unfit, don't add any
            i = 0           ' years
    End Select
    
    i = i * 12

    GetMedicalExpiry = DateAdd("m", i, medDate)
End Function

 

[bob fitz]

I've been using this vba code to calculate due dates in queries, however this does not work properly when it takes the medical reviews.

What does "not work properly" mean exactly. Is the calculation wrong? Do you get an error message? Does the db crash? Does your computer catch fire?

 

[smally]

My medical table fields are:
ID - autonumber
MedDate - date of the medical
EmployeeID - foreign key to the employee
Result - satisfactory, sub-optimal, unfit
Type - full assessment or review

Using the function on a medical review it would give an incorrect date if the review was satisfactory.
I'm aware I could add another parameter to distinguish the differences between the rules for a full or review medical. But this would still not accurately give out the proper due date because the code cannot tell if the review was the employee's first or second.

 

[isladogs]

Hi


I did the attached before reading your field names etc but you can easily adapt it (assuming your PC isn't on fire of course ...)

The following function updates 3 fields in turn
ReviewSchedule, FollowUpReviewDate, FullReviewDate

I would strongly recommend you have two date fields as above - it will make your life easier

Function UpdateMedicalReviewDates()

'update review schedule
CurrentDb.Execute "UPDATE tblMedical SET tblMedical.FullReviewSchedule = IIf([Age]<55,3,IIf([Age]>64,1,2));"

'update review date
CurrentDb.Execute "UPDATE tblMedical SET tblMedical.FullReviewDate = DateAdd('yyyy',[FullReviewSchedule],[MedicalCheckDate]);"

'update followup review date
CurrentDb.Execute "UPDATE tblMedical" & _
    " SET tblMedical.FollowUpReviewDate = IIf([Outcome]='Sub optimal',DateAdd('yyyy',1,[MedicalCheckDate]),Null);"


End Function

To save time, I've added age as a field in the table, but in practice, I would calculate this as you are doing with a separate function
I've done these as 3 steps for clarity but you could easily combine these

Attached example database so you can test this