ลองแกะในโปรแกรม ISWIN นะครับ ใน Module1 ได้ดังนี้
Function RTScal(COMA As Variant, BP As Variant, RR As Variant) As Variant
If IsNull(COMA) Or IsNull(BP) Or IsNull(RR) Or Trim(BP) = "999" Or Trim(RR) = "99" Then
RTScal = Null
Exit Function
End If
Dim GCS(5) As Integer, sbp(5) As Integer, rrr(5) As Integer
Dim mgcs As Integer, msbp As Integer, mrr As Integer, XX As Integer
GCS(0) = 3
GCS(1) = 5
GCS(2) = 8
GCS(3) = 12
GCS(4) = 15
sbp(0) = 0
sbp(1) = 49
sbp(2) = 75
sbp(3) = 89
sbp(4) = 300
rrr(0) = 0
rrr(1) = 5
rrr(2) = 9
rrr(3) = 29
rrr(4) = 100
mgcs = 0
msbp = 0
mrr = 0
XX = 0
Do While XX < 6
If COMA <= GCS(XX) Then
mgcs = XX
Exit Do
End If
XX = XX + 1
Loop
XX = 0
Do While XX < 6
If BP <= sbp(XX) Then
msbp = XX
Exit Do
End If
XX = XX + 1
Loop
XX = 0
Do While XX < 6
If RR <= rrr(XX) Then
mrr = XX
Exit Do
End If
XX = XX + 1
Loop
Select Case mrr
Case 4
mrr = 3
Case 3
mrr = 4
End Select
RTScal = 0.9368 * mgcs + 0.7326 * msbp + 0.2908 * mrr
End Function
---------------------------------------------------------------------------------------------------
Function ISScal(BR1 As Variant, AIS1 As Variant, BR2 As Variant, AIS2 As Variant, BR3 As Variant, AIS3 As Variant, BR4 As Variant, AIS4 As Variant, BR5 As Variant, AIS5 As Variant, BR6 As Variant, AIS6 As Variant) As Variant
Dim D As Database, R As Recordset, n As Integer, A(1 To 3) As Integer
Set D = CurrentDb
Set R = D.OpenRecordset("temp_AIS")
Do Until R.EOF
R.Delete
R.MoveNext
Loop
If Not IsNull(BR1) And BR1 <> 9 And Not IsNull(AIS1) And AIS1 <> 9 Then
R.AddNew
R!
= BR1
R![AIS] = AIS1
R.Update
End If
If Not IsNull(BR2) And BR2 <> 9 And Not IsNull(AIS2) And AIS2 <> 9 Then
R.AddNew
R!
= BR2
R![AIS] = AIS2
R.Update
End If
If Not IsNull(BR3) And BR3 <> 9 And Not IsNull(AIS3) And AIS3 <> 9 Then
R.AddNew
R!
= BR3
R![AIS] = AIS3
R.Update
End If
If Not IsNull(BR4) And BR4 <> 9 And Not IsNull(AIS4) And AIS4 <> 9 Then
R.AddNew
R!
= BR4
R![AIS] = AIS4
R.Update
End If
If Not IsNull(BR5) And BR5 <> 9 And Not IsNull(AIS5) And AIS5 <> 9 Then
R.AddNew
R!
= BR5
R![AIS] = AIS5
R.Update
End If
If Not IsNull(BR6) And BR6 <> 9 And Not IsNull(AIS6) And AIS6 <> 9 Then
R.AddNew
R!
= BR6
R![AIS] = AIS6
R.Update
End If
Set R = D.OpenRecordset("AIS_Q")
For n = 1 To 3
A(n) = 0
Next
n = 1
Do Until n > 3 Or R.EOF
A(n) = R!MaxOfAIS
n = n + 1
R.MoveNext
Loop
If A(1) = 6 Or A(2) = 6 Or A(3) = 6 Then
ISScal = 75
Else
ISScal = A(1) ^ 2 + A(2) ^ 2 + A(3) ^ 2
ISScal = IIf(ISScal = 0, Null, ISScal)
End If
End Function
---------------------------------------------------------------------------------------------------
Function PScal(COMA As Variant, BP As Variant, RR As Variant, AGE As Variant, INJT As Variant, ISS As Variant) As Variant
If IsNull(COMA) Or IsNull(BP) Or IsNull(RR) Or Trim(BP) = "999" Or Trim(RR) = "99" Or IsNull(AGE) Or IsNull(INJT) Or IsNull(ISS) Or ISS = 0 Then
PScal = Null
Exit Function
End If
Dim GCS(5) As Integer, sbp(5) As Integer, rrr(5) As Integer
Dim mgcs As Integer, msbp As Integer, mrr As Integer, XX As Integer
Dim RTS As Double
GCS(0) = 3
GCS(1) = 5
GCS(2) = 8
GCS(3) = 12
GCS(4) = 15
sbp(0) = 0
sbp(1) = 49
sbp(2) = 75
sbp(3) = 89
sbp(4) = 300
rrr(0) = 0
rrr(1) = 5
rrr(2) = 9
rrr(3) = 29
rrr(4) = 100
mgcs = 0
msbp = 0
mrr = 0
XX = 0
Do While XX < 6
If COMA <= GCS(XX) Then
mgcs = XX
Exit Do
End If
XX = XX + 1
Loop
XX = 0
Do While XX < 6
If BP <= sbp(XX) Then
msbp = XX
Exit Do
End If
XX = XX + 1
Loop
XX = 0
Do While XX < 6
If RR <= rrr(XX) Then
mrr = XX
Exit Do
End If
XX = XX + 1
Loop
Select Case mrr
Case 4
mrr = 3
Case 3
mrr = 4
End Select
RTS = 0.9368 * mgcs + 0.7326 * msbp + 0.2908 * mrr
Dim ag As Integer
ag = IIf(AGE > 54, 1, 0)
Dim B0 As Double, B1 As Double, b2 As Double, B3 As Double, bt As Double
If INJT = "2" Then
B0 = -0.6029
B1 = 1.143
b2 = -0.1516
B3 = -2.6676
Else
B0 = -1.247
B1 = 0.9544
b2 = -0.0768
B3 = -1.9052
End If
bt = B0 + B1 * RTS + b2 * ISS + B3 * ag
PScal = 1 / (1 + Exp(bt * -1))
End Function
หัวข้อ: HOSxP & ISWIN (อ่าน 14122 ครั้ง)