Overstay Predictor Project Algorithm
Legacy Content
This page contains Legacy Content.- Explanation: no more overstay
- Successor: No successor was entered
Click Expand to show legacy content.
See \\ad.wrha.mb.ca\WRHA\HSC\shared\MED\MED_CCMED\Julie\MedProjects\LegacyByName\RodrigoVivanco for project details.
Option Compare Database
Option Explicit
' colours used on viewer to direct collector action
Public Const overstay_green = 2537789
Public Const overstay_yellow = 648439
Public Const overstay_red = 206
Public Const overstay_gray = -2147483633
' logistic regression coefficients etc
'2013-03-20 was Const Log_Reg_threshold = 0.23 'threshold determines how many come through, .23 provided by Leigh Anne
'2013-05-30 changed Const Log_Reg_threshold back from 0.4 to 0.23 as requested by Linda
Const Log_Reg_threshold = 0.23
Const L_c_age = 0.0584403
Const L_c_OutsideWpg = -1.702245
Const L_c_mb = 1.921782
Const L_c_mi = -0.2284896
Const L_c_Pulmonary = -0.1948701
Const L_c_Connective = 0.1682782
Const L_c_Renal = -0.1862202
Const L_c_bath = 0.1889576
Const L_c_dress = 0.1591606
Const L_c_toilet = 0.2145833
Const L_c_transfer = 0.1756111
Const L_c_continence = 0.1526968
Const L_c_Dementia_AdCo = 0.8951998
Const L_c_eye = 0.5605131
Const L_c_verb = -0.3018936
Const L_c_adlmean_nh = -0.0875967
Const L_c_adlmean_age = -0.0012927
Const L_c_charlson_nh = -0.106952
Const L_c_cons = -11.23138
Public Function Transition_Coordinator_colour(Pat_ID As Long) As Long
On Error GoTo Err_goto
Dim colour As String
Dim DOB As Date
Dim admit As Date
Dim age As Double
Dim bath As Integer
Dim dress As Integer
Dim toilet As Integer
Dim transfer As Integer
Dim continence As Integer
Dim mi As Integer
Dim Pulmonary As Integer
Dim Connective As Integer
Dim Renal As Integer
Dim Dementia_AdCo As Integer
Dim feeding As Integer 'needed as part of SCORE
Dim adlscore As Integer
Dim ADL_center As Integer
Dim ADL_center_sqr As Integer
Dim OutsideWpg As Integer
Dim mb As Integer
Dim eye As Integer
Dim verb As Integer
Dim adlmean_nh As Integer
Dim Adlmean_age As Integer
Dim Charlson_nh As Integer
Dim from_PCH As Boolean
Dim NFE As String
Dim pt_from_PCH As String
' if patient is transferred, msg so and be done with
' If Not IsNull(DLookup("Pat_ID", "L_TmpV2", "Pat_ID = " & Form_View.Pat_ID & " and Project = ""Overstay"" and Item = ""Transferred form""")) Then
' Transition_Coordinator_colour = overstay_gray
' MsgBox "Patient transferred in from other unit, you should not update the sticker colour."
' GoTo Exit_sub
' End If
' Commented out 2017-07-29 as part of Overstay changes abandoning DPST component.
'
' if Nursing Discharge Screen Tool indicated no discharge trouble make green be done with
' NFE = NurseFormEval(Form_View.Pat_ID)
' If NFE = "green" Then 'i.e. if "red" or "undefined", keep checking.
' Transition_Coordinator_colour = overstay_green
' GoTo Got_Colour
' Else
' If NFE = "undefined" Then
' Transition_Coordinator_colour = overstay_gray
' GoTo Got_Colour
' End If
' End If ' if "red" keep checking, pt can become red or yellow
' check if patient comes from a ward where we collect, if so msg and make gray
If DLookup("Pat_ID", "check_overstay_pt_from_our_med", "Pat_ID = " & Pat_ID) = Pat_ID Then
MsgBox "Patient was admitted from ward at your site where we collect data; use the colour that was generated there. "
Transition_Coordinator_colour = overstay_gray
GoTo Got_Colour
End If
' populate variables
DOB = CDate(Nz(Form_View.Birth, #1/1/1800#))
admit = Nz(Form_View.Accept_DtTm, Nz(Form_View.Arrive_DtTm, #1/1/1800#))
If DOB = #1/1/1800# Or admit = #1/1/1800# Then
MsgBox "can't evaluate overstay algorithm without DOB and Admit Date."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
age = (admit - DOB) / 365.25
'MsgBox "confirming that age is integer, part of comments sent to Leigh Anne"
If age < 10 Or age > 107 Then
MsgBox "Age is <10 or >107, not allowed, check admit date and DOB."
Transition_Coordinator_colour = overstay_gray
GoTo Got_Colour
End If
bath = adl_sc(Nz(Form_View.ADL_Bathing))
dress = adl_sc(Nz(Form_View.ADL_Dressing))
toilet = adl_sc(Nz(Form_View.ADL_Toileting))
transfer = adl_sc(Nz(Form_View.ADL_Transfering))
continence = adl_sc(Nz(Form_View.ADL_Continence))
feeding = adl_sc(Nz(Form_View.ADL_Feeding))
If bath < 0 Or dress < 0 Or toilet < 0 Or transfer < 0 Or continence < 0 Or feeding < 0 Then
MsgBox "Can't evaluate overstay algorithm without ADLs."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
adlscore = feeding + bath + dress + toilet + transfer + continence
pt_from_PCH = pt_is_from_PCH(Form_View.Pat_ID)
If InStr(pt_from_PCH, "undefined") > 0 Then ' error msg is generated in that function
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
from_PCH = (pt_from_PCH = "yes")
'OutsideWpg
'OutsideWpg = transferred in from a facility outside of Winnipeg
' Julie wrote: OutsideWpg=(fromhosp in ('X','Y'));
'OutsideWpg = -1 * (Mid(Form_View.R_AdmitFrom, 1, 1) = "x" Or Mid(Form_View.R_AdmitFrom, 1, 1) = "y")
OutsideWpg = -1 * (Not IsNull(DLookup("Pat_ID", "check_from_out_of_town", "Pat_ID = " & Form_View.Pat_ID)))
If IsNull(Form_View.R_Province) Then
MsgBox "No ""Province"" entry found. Please enter and re-evaluate if this is not a Manitoba patient. (see http://ccmdb.kuality.ca/index.php/Overstay_Predictor_Project_Collection_Instructions)"
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
mb = ((Form_View.R_Province = "MB") * -1)
If IsNull(Form_View.Ap_Eye) Or IsNull(Form_View.Ap_Verbal) Then
MsgBox "Can't evaluate overstay algorithm without Glasgow Coma Scale."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
Else
eye = GCS_Eye_pts(Form_View.Ap_Eye)
verb = GCS_Verbal_pts(Form_View.Ap_Verbal)
End If
adlmean_nh = adlmean_nh_function(adlscore, from_PCH)
Adlmean_age = adlmean_age_function(adlscore, age)
Charlson_nh = Charlson_nh_function(Form_View.Pat_ID, Charlson_score_function(Form_View.Pat_ID), from_PCH)
'2018-12-26 pre-ICD10 codes that were WRONG
' mi = IIf(DCount("Charlson_category", "s_tmp_overstay_c_mi", "Pat_ID = " & Pat_ID) > 0, 1, 0)
' Pulmonary = IIf(DCount("Charlson_category", "s_tmp_overstay_c_mi", "Pat_ID = " & Pat_ID) > 0, 1, 0)
' Connective = IIf(DCount("Charlson_category", "s_tmp_overstay_c_mi", "Pat_ID = " & Pat_ID) > 0, 1, 0)
' Renal = IIf(DCount("Charlson_category", "s_tmp_overstay_c_mi", "Pat_ID = " & Pat_ID) > 0, 1, 0)
mi = IIf(Nz(DLookup("group", "L_ICD10_Charlson_component_points", "Pat_ID = " & 12687 & " and group = ""myo""")) > "", 1, 0)
Pulmonary = IIf(Nz(DLookup("group", "L_ICD10_Charlson_component_points", "Pat_ID = " & 12687 & " and group = ""pulmonary""")) > "", 1, 0)
Connective = IIf(Nz(DLookup("group", "L_ICD10_Charlson_component_points", "Pat_ID = " & 12687 & " and group = ""connective""")) > "", 1, 0)
Renal = IIf(Nz(DLookup("group", "L_ICD10_Charlson_component_points", "Pat_ID = " & 12687 & " and group = ""renal""")) > "", 1, 0)
' Dementia_AdCo = has either admit or comorbid dementia dx
Dementia_AdCo = -1 * (Nz(DLookup("Pat_ID", "s_tmp_overstay_Dementia_adm_como", "Pat_ID = " & Form_View.Pat_ID), 0) > 0)
' if none of above have kicked out of function, then make sure we have data to eval the rest
If bath = -1 Then
MsgBox "can't evaluate overstay algorithm without ADL bath."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
If dress = -1 Then
MsgBox "can't evaluate overstay algorithm without ADL dressing."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
If toilet = -1 Then
MsgBox "can't evaluate overstay algorithm without ADL toilet."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
If transfer = -1 Then
MsgBox "can't evaluate overstay algorithm without ADL transfer."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
If continence = -1 Then
MsgBox "can't evaluate overstay algorithm without ADL continence."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
If feeding = -1 Then
MsgBox "can't evaluate overstay algorithm without ADL feeding."
Transition_Coordinator_colour = overstay_gray
GoTo Exit_sub
End If
Dim LRS As Double
LRS = Log_reg_shafer(age, OutsideWpg, mb, mi, Pulmonary, Connective, Renal, _
bath, dress, toilet, transfer, continence, _
Dementia_AdCo, eye, verb, adlmean_nh, Adlmean_age, Charlson_nh)
'evaluate whether patient will be yellow or red
If LRS > Log_Reg_threshold Then
Transition_Coordinator_colour = overstay_red
CreateMail "Patient " & Form_View.FirstName & " " & Form_View.LastName & " has overstay color red. (EOM)"
Else
Transition_Coordinator_colour = overstay_yellow
End If
Got_Colour:
colour = ""
If Transition_Coordinator_colour = overstay_red Then colour = "red"
If Transition_Coordinator_colour = overstay_yellow Then colour = "yellow"
If Transition_Coordinator_colour = overstay_gray Then colour = "gray"
'If Transition_Coordinator_colour = overstay_green Then colour = "green"
If colour > "" Then
If MsgBox("Is this the final colour you want to actually send?", vbYesNo) = vbYes Then
GenerUpdate_tmp_entry Form_View.Pat_ID, "Overstay_autoentry", "Overstay_Colour", True, , , , , , , , colour
' add colour to beginning of notes field
Form_View.Dirty = False
Form_View.Notes = colour & "-" & Form_View.Notes
End If
End If
Exit_sub:
Exit Function
Err_goto:
MsgBox err.description
Resume Exit_sub
End Function
Public Function Log_reg_shafer(ByVal age As Double, OutsideWpg As Integer, ByVal mb As Integer, ByVal mi As Integer, ByVal Pulmonary As Integer, ByVal Connective As Integer, ByVal Renal As Integer, ByVal _
bath As Integer, ByVal dress As Integer, ByVal toilet As Integer, ByVal transfer As Integer, ByVal continence As Integer, ByVal _
Dementia_AdCo As Integer, ByVal eye As Integer, ByVal verb As Integer, ByVal adlmean_nh As Integer, ByVal Adlmean_age As Integer, ByVal Charlson_nh As Integer) As Double
On Error GoTo Err_goto
Dim sum, probability As Double
sum = _
L_c_cons + _
L_c_age * age + _
L_c_OutsideWpg * OutsideWpg + _
L_c_mb * mb + _
L_c_mi * mi + _
L_c_Pulmonary * Pulmonary + _
L_c_Connective * Connective + _
L_c_Renal * Renal + _
L_c_bath * bath + _
L_c_dress * dress + _
L_c_toilet * toilet + _
L_c_transfer * transfer + _
L_c_continence * continence + _
L_c_Dementia_AdCo * Dementia_AdCo + _
L_c_eye * eye + _
L_c_verb * verb + _
L_c_adlmean_nh * adlmean_nh + _
L_c_adlmean_age * Adlmean_age + _
L_c_charlson_nh * Charlson_nh
probability = Exp(sum) / (1 + Exp(sum))
Log_reg_shafer = probability
Exit_sub:
Exit Function
Err_goto:
MsgBox err.description
Resume Exit_sub
End Function
' Commented out 2017-07-29 as part of Overstay changes abandoning DPST component.
'
'Public Function NurseFormEval(ByVal Pat_ID As Long) As String
'On Error GoTo Err_goto
'
' Dim r As Recordset
' Dim has_positive As Boolean
' Dim q(6) As Integer
' Dim i As Integer
'
' has_positive = False
'
' ' if exists "form data missing" consider as if there was at least one "no"
' If Not IsNull(DLookup("Pat_ID", "L_TmpV2", "Pat_ID = " & Form_View.Pat_ID & " and Project = ""Overstay"" and Item = ""DPST data missing""")) Then
' NurseFormEval = "red"
' MsgBox """DPST data missing"" variable set, form will be evaluated as requiring assistance. "
' GoTo Exit_sub
' End If
'
' Set r = CurrentDb.OpenRecordset("Select * from s_tmp_overstay_nurseForm where Pat_ID = " & Pat_ID, , dbReadOnly)
'
' If r.RecordCount <> 6 Then
' NurseFormEval = "undefined"
' MsgBox "For each of the 6 questions you must either enter a specific answer, or a ""Form Data Missing"" entry. You don't have the correct number of entries. "
' GoTo Exit_sub
' End If
'
' r.MoveFirst
'
' For i = 1 To 6
' q(i) = 1 ' non-boolean to express not-set, i.e. default
' Next
'
' 'get data into variable "q"
' While Not r.EOF
' If IsNumeric(Mid(r(1), 1, 1)) Then
' q(Mid(r(1), 1, 1)) = r(2)
' End If
' r.MoveNext
' Wend
'
' ' iterate through q and validate colour
' ' check that there are entries for each and that none are positive
' For i = 1 To 6
' Select Case q(i)
' Case 1 ' no answer
' MsgBox "Overstay question " & i & " was not filled in and ""Form Data Missing"" wasn't either; fill in one or the other to be able to evaluate colour."
' NurseFormEval = "undefined"
' GoTo Exit_sub
' Case 0 ' answer is unchecked-"patient not OK", calling function will use Rodrigo's algorithm to get colour
' NurseFormEval = "red"
' GoTo Exit_sub
' Case -1 ' answer is checked-"patient OK"
' NurseFormEval = "green"
' ' keep cycling through q, see if next has non-green
' Case Else ' should never happen
' MsgBox "Error in Function NurseFormEval, talk to Tina."
' NurseFormEval = "undefined"
' GoTo Exit_sub
' End Select
' Next
'
' Set r = Nothing
'
'Exit_sub:
' Exit Function
'
'Err_goto:
' MsgBox Err.Description
' Resume Exit_sub
'End Function
Public Function pt_is_from_PCH(Pat_ID) As String 'returns "yes", "no" or "undefined - <explanation>"
On Error GoTo Err_goto
' ensure necessary data entered to evaluate "from Nursing home"
Dim nr_of_froms As Integer
Dim Pre_Acute_Living_Situation As Variant 'to allow null
Pre_Acute_Living_Situation = DLookup("pre_acute_living_situation", "check_pt_from_pch", "Pat_ID = " & Pat_ID)
If IsNull(Pre_Acute_Living_Situation) Then
MsgBox "Overstay Pre-acute Living Situation: The field is empty, needs to be entered before Overstay Colour can be generated. (see http://ccmdb.kuality.ca/index.php/Overstay_Predictor_Project_Collection_Instructions#admitted_from)"
pt_is_from_PCH = "undefined - pre_acute_living_situation not entered"
GoTo Exit_sub
End If
If Pre_Acute_Living_Situation = "location missing/unknown" Then
MsgBox "Overstay Pre-acute Living Situation: The field is ""location missing/unknown""if info is available please enter and re-evaluate colour. (see http://ccmdb.kuality.ca/index.php/Overstay_Predictor_Project_Collection_Instructions#admitted_from)"
pt_is_from_PCH = "No"
GoTo Exit_sub
End If
If (Pre_Acute_Living_Situation = "Personal Care Home") Or (Pre_Acute_Living_Situation = "Chronic Health Facility") Then
pt_is_from_PCH = "Yes"
Else
pt_is_from_PCH = "No"
End If
Exit_sub:
Exit Function
Err_goto:
MsgBox err.description
Resume Exit_sub
End Function
Public Function adlmean_nh_function(adlscore As Integer, from_PCH As Boolean) As Integer
On Error GoTo Err_goto
' Adlmean_nh
' Adlmean_nh = the additional impact of ADL Score only among those who came from a NH
' Adlmean_nh = (ADLScore - 12)*(from a nursing home)
adlmean_nh_function = (adlscore - 12) * (-from_PCH)
Exit_sub:
Exit Function
Err_goto:
MsgBox err.description
Resume Exit_sub
End Function
Public Function adlmean_age_function(adlscore As Integer, age As Double) As Integer
On Error GoTo Err_goto
' Adlmean_age
' Adlmean_age = An interaction between age and ADL Score
' Adlmean_age = (ADLScore - 12)*(age)
adlmean_age_function = (adlscore - 12) * age
Exit_sub:
Exit Function
Err_goto:
MsgBox err.description
Resume Exit_sub
End Function
Public Function Charlson_nh_function(Pat_ID As Long, charlsonscore As Integer, from_PCH As Boolean) As Integer
On Error GoTo Err_goto
'Charlson_nh
'Charlson_nh = the additional impact of Charlson Score only among those who came from a NH
'Charlson_nh = (Charlson score)*(from a nursing home)
Charlson_nh_function = Charlson_score_function(Pat_ID) * (-from_PCH)
Exit_sub:
Exit Function
Err_goto:
MsgBox err.description
Resume Exit_sub
End Function
Explanations
Patients from nursing homes can be red
The fact that a patient is from a nursing home is a factor in some of the parameters above (adlmean_nh = -0.0875967 and charlson_nh = -0.106952) but both are relatively minor factors.
Patients on Comfort Care / Palliative care / Palliative Service can be red
None of these are factors in the equation. DC Treatment isn't related at all because it's only collected in critical care.