Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
Public Function Normal(ByVal x As Double, ByVal upper As Boolean) As Double
'This procedure is adapted from Algorithm 304 Normal Curve Integral by I. D. Hill and S. A. Joyce
'which is published in Communications of the ACM, Volume 10, Number 6, June 1967 pages 374-375. It has been
'adapted from the programming language ALGOL 60 to VBA by Philippe Perrault
Dim M As Double
Dim N As Double
Dim p1 As Double
Dim p2 As Double
Dim q1 As Double
Dim q2 As Double
Dim S As Double
Dim t As Double
Dim x2 As Double
Dim Y As Double
Const PI = 3.14159265359
If x = 0 Then
Normal = 0.5 'Area under half the curve
Exit Function
Else
x = Abs(x)
upper = upper Eqv x > 0
x2 = x * x
Y = 1 / (2 * PI) ^ 0.5 * exp(-0.5 * x2)
N = Y / x
End If
If upper = True And 1 - N = 1 Then
Normal = 0 'Area under whole curve since x is a large negative number
Exit Function
End If
If upper = False And N = 0 Then
Normal = 1 'None of the area under the curve since x is a large positive number
Exit Function
End If
q1 = x
p2 = Y * x
N = 1
p1 = Y
q2 = x2 + 1
If upper = True And x > 2.32 Then
M = 1 - p1 / p2
S = M
t = p2 / q2
Normal = NCF(M, N, p1, p2, q1, q2, t, x, upper)
Exit Function
End If
If upper = False And x > 2.32 Then
M = p1 / p2
S = M
Normal = NCF(M, N, p1, p2, q1, q2, t, x, upper)
Exit Function
End If
xy = x * Y
S = x
N = 3
t = 0
S = CRPF(x)
If upper = True Then
Normal = S
Else
Normal = S
End If
End Function
Public Function NCF(M, N, p1, p2, q1, q2, t, x As Double, upper As Boolean) As Double
'Uses the continued fraction method to calculate the Normal Curve Integral at the tails
Do
S = x * p2 + N * p1
p1 = p2
p2 = S
S = x * q2 + N * q1
q1 = q2
q2 = S
S = M
M = t
If upper = True Then
t = p2 / q2
Else
t = 1 - p2 / q2
End If
N = N + 1
Loop While M <> t And S <> t
NCF = t
End Function
Public Function CRPF(x As Double)
'This procedure was adapted from function 26.2.18
'Calculates the Normal Distribution in the central region of the probability function (CRPF)
'accurate to 3 decimal places
Dim B() As Variant
Const p = 0.2316419
Const PI = 3.14159265359
Dim t As Double
Dim z As Double
B = Array(0.196854, 0.115194, 0.000344, 0.019527)
CRPF = 1 - 0.5 * (1 + B(0) * x + B(1) * x ^ 2 + B(2) * x ^ 3 + B(3) * x ^ 4) ^ -4
CRPF = 1 - CRPF
End Function