Could someone help me with this module for Microsoft Access.  At the moment, the module calculates the median of my entire population of patients.  However, in my report I have patients grouped by carepath, hospital, month.  Could I incorporate these groupings so that my report gives me the carepath median, hospital median, and carepath by month median.


Public Function median(qryCarepaths As String, LOS As String) As Single
  Dim MedianDB As DAO.Database
  Dim ssMedian As DAO.Recordset
  Dim RCount As Integer, i As Integer, x As Integer, y As Integer, _
      OffSet As Integer
  Set MedianDB = CurrentDb()
  Set ssMedian = MedianDB.OpenRecordset("SELECT [" & LOS & _
            "] FROM [" & qryCarepaths & "] WHERE [" & LOS & _
            "] IS NOT NULL ORDER BY [" & LOS & "];")
  'NOTE: To include nulls when calculating the median value, omit
  'WHERE [" & fldName & "] IS NOT NULL from the example.
  ssMedian.MoveLast
  RCount% = ssMedian.RecordCount
  x = RCount Mod 2
  If x <> 0 Then
     OffSet = ((RCount + 1) / 2) - 2
     For i% = 0 To OffSet
        ssMedian.MovePrevious
     Next i
     median = ssMedian(LOS)
  Else
     OffSet = (RCount / 2) - 2
     For i = 0 To OffSet
        ssMedian.MovePrevious
     Next i
     x = ssMedian(LOS)
     ssMedian.MovePrevious
     y = ssMedian(LOS)
     median = (x + y) / 2
  End If
  ssMedian.Close
  MedianDB.Close
End Function

I think I don't understand.  MEDIAN generally refers to the "Value in the Middle (of the List)" not the average.  Thus the "calculation":

     x = ssMedian(LOS)
     ssMedian.MovePrevious
     y = ssMedian(LOS)
     median = (x + y) / 2

does not appear to reflect the 'median', but the average 'near' the median ?

Also, the calculation of 'what record' is the middle appears to me somewhat more cumbersome than necessary:

    Offset = (RCount + (RCount Mod 2)) \ 2

Appears, to me, to always get to the (A?) correct median record.  Consider the simple examples:

For xxx = -3 to 3 Step 1: ? RCount + xxx, ((RCount + xxx) + ((RCount + XXX) Mod 2)) \ 2: Next xxx
 753           377
 754           377
 755           378
 756           378
 757           379
 758           379
 759           380
 759           379

(note the addition of the index just to illustrate the Median value for items 'near' the center.


A revised function incorporated this concept, except leaving the 'average' of the two center elements for the even numbered recordcounts.


Public Function median(qryCarepaths As String, LOS As String) As Single

  Dim MedianDB As DAO.Database
  Dim ssMedian As DAO.Recordset
  
  Dim RCount As Integer
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim OffSet As Integer

  Set MedianDB = CurrentDb()

  Set ssMedian = MedianDB.OpenRecordset("SELECT [" & LOS & "]FROM [" & _
                 qryCarepaths & "] WHERE [" & LOS & _
                 "] IS NOT NULL ORDER BY [" & LOS & "];")

                'NOTE: To include nulls when calculating the median value, omit
                'WHERE [" & fldName & "] IS NOT NULL from the example.

  ssMedian.MoveLast
  RCount% = ssMedian.RecordCount

  OffSet = (RCount + (RCount Mod 2)) \ 2

     For i% = 0 To OffSet
        ssMedian.MovePrevious
     Next i

     median = ssMedian(LOS)

    If (OffSet Mod 2) Then              'Leave this out to return a single value

     ssMedian.MovePrevious
     median = median + ssMedian(LOS) / 2

    End If                              'End part to omit to return single value

  ssMedian.Close
  MedianDB.Close

End Function


To get the medians of other groups using this approach you would need to add an additional WHERE clause, with the patient groups as the criteria and re-run/execute this function for each such group.  I would add another (Optional) argument to the function which would be the patient group (optional = "" indicates "All", in which case the sql would NOT include the additional where clause.  I would also construct the sql statement as a string prior to the openrecordset statement and just use the string var as the argument.  This permits the inspection of the sql statement before the execution, so if there is a problem, you can at least review what was buillt.

I have 'attempted' to incorporate the optional parameter and the restructured sql stateemnt in the following.  It is NOT tested, so you need to review it carefully before using.  I also renamed it, so you can probably just cut/paste into your app and test through the debug.window.



Public Function basMedian(qryCarepaths As String, _
                       LOS As String, _
                       Optional PatTyp As String) As Single

    Dim MedianDB As DAO.Database
    Dim ssMedian As DAO.Recordset

    Dim RCount As Integer
    Dim OffSet As Integer
    Dim strSQL As String

    Set MedianDB = CurrentDb()

    strSQL = "SELECT [" & LOS & "] "
    strSQL = strSQL & "FROM [" & qryCarepaths & "] "
    strSQL = strSQL & "Where [" & LOS & "] "
    strSQL = strSQL & "IS NOT NULL "
    If (Not IsMissing(PatTyp)) Then

        'Add additional where clauses/constraints here.
        'We can also omit them if the calling argument is not present

        strSQL = strSQL & "AND [" & PatientGroup & "] = " & PatTyp & " "

    End If
    strSQL = strSQL & "ORDER BY [" & LOS & "];"

    Set ssMedian = MedianDB.OpenRecordset(strSQL)

    'NOTE: To include nulls when calculating the median value, omit
    'WHERE [" & fldName & "] IS NOT NULL from the example.

    ssMedian.MoveLast
    RCount = ssMedian.RecordCount           'Check # Records

    OffSet = (RCount + (RCount Mod 2)) \ 2  'Calc Median Record

    For i% = 0 To OffSet                    'Walk back towards Middle
        ssMedian.MovePrevious               'One Record per
    Next i

    median = ssMedian(LOS)                  'Get the Median Value from the Record

    'Start Omit HERE to Get single Value
    If (RCount Mod 2) Then                  'Odd # of records?

        ssMedian.MovePrevious               'Then get avg of Median & Prev Rec
        median = median + ssMedian(LOS) / 2

    End If
    'End Omit HERE for single Value

    ssMedian.Close
    MedianDB.Close

End Function


MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over