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
         
' 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
         
' 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
        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)
     
    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)
 
    ' 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
    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_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
 
 
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