Calculate the Pediatric SOFA score

CalcPedSOFAScore.vb

Sub Main
	
End Sub

' This function, CalculatePedSOFAScore, calculates the Pediatric Sequential Organ Failure Assessment (pSOFA) score for a child based on various physiological parameters. 
' The pSOFA score is used to assess the extent of organ dysfunction in critically ill patients.
' 
' The function takes several parameters including the age of the child in months, partial pressure of oxygen to fraction of inspired oxygen (PaO2/FiO2),
' saturation of peripheral oxygen to fraction of inspired oxygen (SpO2/FiO2), platelet count, bilirubin, mean arterial pressure (MAP),
' rates of infusion of various vasoactive drugs (Dopamine, Dobutamine, Epinephrine, Norepinephrine), Glasgow Coma Scale (GCS), and Creatinine.
'
' The function calculates the pSOFA score by assessing six organ systems: respiratory, coagulation, hepatic, cardiovascular, neurologic, and renal.
' The worst value in a 24-hour period is used for each variable. If a variable is not recorded, a value of `-1` should be provided, 
' and a score of 0 will be used for that variable.
'
' The scores for each organ system are summed to give the final pSOFA score which is returned as an integer. 
' This score can range from 0 to 24, with higher scores indicating more severe organ dysfunction.
Function CalcPedSOFAScore(intMos As Integer, intPAF As Integer, intSpO2FiO2 As Integer, intPlatelets As Integer, dblBili As Double, intMAP As Integer, dblDopa As Double, dblDobu As Double, dblEpi As Double, dblNor As Double, intGCS As Integer, dblCreat As Double) As Integer
	Dim intScore As Integer = 0

	Const dblCreatToMicroMolePerLiter As Double = 88.42
	If dblCreat <> -1 Then dblCreat = dblCreat / dblCreatToMicroMolePerLiter

	Const dblBiliToMicroMolePerLiter As Double = 17.104
	If dblBili <> -1 Then dblBili = dblBili / dblBiliToMicroMolePerLiter

	'Respiratory
	If intPAF <> -1 Then
		Select Case intPAF
			Case Is >= 400
				intScore += 0
			Case 300 To 399
				intScore += 1
			Case 200 To 299
				intScore += 2
			Case 100 To 199
				intScore += 3
			Case Is < 100
				intScore += 4
		End Select
	ElseIf intSpO2FiO2 <> -1 Then
		Select Case intSpO2FiO2
			Case Is >= 292
				intScore += 0
			Case 264 To 291
				intScore += 1
			Case 221 To 263
				intScore += 2
			Case 148 To 220
				intScore += 3
			Case Is < 148
				intScore += 4
		End Select
	End If

	'Coagulation
	Select Case intPlatelets
		Case Is >= 150
			intScore += 0
		Case 100 To 149
			intScore += 1
		Case 50 To 99
			intScore += 2
		Case 20 To 49
			intScore += 3
		Case Is < 20
			intScore += 4
	End Select

	'Hepatic
	Select Case dblBili
		Case Is < 1.2
			intScore += 0
		Case 1.2 To 1.9
			intScore += 1
		Case 2.0 To 5.9
			intScore += 2
		Case 6.0 To 11.9
			intScore += 3
		Case Is > 11.9
			intScore += 4
	End Select

	'Cardiovascular
	If intMos <> -1 And intMAP <> -1 Then
		Dim ageGroupMAP As Integer
		Select Case intMos
			Case 0 To 1
				ageGroupMAP = 46
			Case 2 To 11
				ageGroupMAP = 55
			Case 12 To 23
				ageGroupMAP = 60
			Case 24 To 59
				ageGroupMAP = 62
			Case 60 To 143
				ageGroupMAP = 65
			Case 144 To 216
				ageGroupMAP = 67
			Case Is > 216
				ageGroupMAP = 70
		End Select

		If intMAP >= ageGroupMAP Then
			intScore += 0
		ElseIf intMAP < ageGroupMAP Then
			intScore += 1
		End If
	End If

	If dblDopa > 0 Or dblDobu > 0 Or dblEpi > 0 Or dblNor > 0 Then
		If dblDopa <= 5 Or dblDobu > 0 Then
			intScore += 2
		ElseIf dblDopa > 5 And dblDopa <= 15 Or dblEpi <= 0.1 Or dblNor <= 0.1 Then
			intScore += 3
		ElseIf dblDopa > 15 Or dblEpi > 0.1 Or dblNor > 0.1 Then
			intScore += 4
		End If
	End If

	'Neurologic
	Select Case intGCS
		Case 15
			intScore += 0
		Case 13 To 14
			intScore += 1
		Case 10 To 12
			intScore += 2
		Case 6 To 9
			intScore += 3
		Case Is < 6
			intScore += 4
	End Select

	'Renal
	If intMos <> -1 And dblCreat <> -1 Then
		Dim arrCreatGroup As Double() = {}
		Select Case intMos
			Case 0 To 1
				arrCreatGroup = {0.8, 0.9, 1.1, 1.5, 1.6}
			Case 2 To 11
				arrCreatGroup = {0.3, 0.4, 0.7, 1.1, 1.2}
			Case 12 To 23
				arrCreatGroup = {0.4, 0.5, 1.0, 1.4, 1.5}
			Case 24 To 59
				arrCreatGroup = {0.6, 0.8, 1.5, 2.2, 2.3}
			Case 60 To 143
				arrCreatGroup = {0.7, 1.0, 1.7, 2.5, 2.6}
			Case 144 To 216
				arrCreatGroup = {1.0, 1.6, 2.8, 4.1, 4.2}
			Case Is > 216
				arrCreatGroup = {1.2, 1.9, 3.4, 4.9, 5}
		End Select

		Select Case dblCreat
			Case Is < arrCreatGroup(0)
				intScore += 0
			Case arrCreatGroup(0) To arrCreatGroup(1)
				intScore += 1
			Case arrCreatGroup(1) + 0.1 To arrCreatGroup(2)
				intScore += 2
			Case arrCreatGroup(2) + 0.1 To arrCreatGroup(3)
				intScore += 3
			Case Is >= arrCreatGroup(4)
				intScore += 4
		End Select
	End If

	Return intScore
End Function