Overstay Predictor Project Algorithm

The following is the algorithm as implemented to generate the Overstay colour as of 09:55, 2017 July 19 (CDT); this will change soon as we step away from using the DPST form, at which point only the parts for the red/yellow will remain.

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.

Query used

• query check_from_out_of_town