Intrahealth Profile - Get a table of results for a given set of patients

GetPSAsForListOfPatients

'library:C:\Program Files\Intrahealth\Profile\bin\IHProfBL.bpl
'library:C:\Program Files\Intrahealth\Profile\bin\Profile.exe
Dim Profile 'As ISProfile
Dim client 'As ProfileClient

Set client = CreateObject("Profile.ProfileClient")
If IsNull(client) Then
	WScript.Quit
Else
	Set Profile = client.Login("","","")
End If
' REMOVE THE ABOVE IF RUNNING AS A MACRO INSIDE PROFILE

Dim nhiString, nhiArray, fromDate,toDate
Profile.InputValue nhiString,"Please paste a list of NHIs to retrieve PSAs for. The list must be comma separated, i.e. ABC1234,GBU7348,AWH3258."
nhiArray = Split(nhiString,",")
Profile.InputValue fromDate,"Great, we will search for PSAs for " + CStr(UBound(nhiArray)) + " patients. Please enter date we should start looking for PSAs from in the format 01/01/1999"
fromDate = CDate(fromDate)

Set Report1 = Profile.CreateReportList()
Report1.addheader("PSA")
Report1.addheader("List of patients")
Report1.addColumn "NHI", 60, alignleft, False
numPSAs = 0 'Number of PSA columns we require


For Each nhi In nhiArray
	Set thePt = Profile.FindPatientByNHI(nhi)
	If IsEmpty(thePt) Then
		Report1.AddRow()
		Report1.Cell("NHI").Value = nhi
	Else
		'Find PSA results
		'X80QD is the READ concept code for Prostate Specific Antigen. Change this to whatever result you need.
		'2 at the end is sorting the results from oldest to newest.
		Set obsList = Profile.FindObsByEHCRAndConcept(thePt.EHCRID,"READ","X80QD",fromDate,Date(),,True,,,True,2) ' Get PSAs
		
		While numPSAs < obsList.Count
			Report1.addColumn "Date " & numPSAs, 80, alignleft, false, ctDate
			Report1.addColumn "PSA " & numPSAs, 50, alignleft, false
			numPSAs = numPSAs + 1
		Wend
		Report1.AddRow()
		Report1.Cell("NHI").Value= nhi

		For i = 0 to obsList.Count - 1
			set HRI = obsList.Item(i).AsHRI
			Report1.Cell("Date " & i).Value = HRI.ObservedOn
			Report1.Cell("PSA " & i).Value = HRI.Content.AsString
		Next
	End If
Next