ISHRC.SourceProviderID

Example

Display some information about the CDO forms contents, including the full names of their HRC source providers.

sub main
  Dim aPatient
  Dim aFilter
  Dim aCDOForms, aCDOForm
  Dim i
  Dim aMessage

  Set aPatient = Profile.SelectPatient
  set aFilter = Profile.CreateCdoFormFilter
  aFilter.PatientId = aPatient.Id
  set aCDOForms = Profile.LoadCdoForms(aFilter) ' ISHRObservations
    aMessage = "CDO Forms (Count = " & aCDOForms.Count & "):"
    
  for i = 0 to aCDOForms.Count - 1  
    set aCDOForm = aCDOForms.Item(i) 'ISHRObservation
    aMessage = aMessage & vbNewLine & (i + 1) & ") " & aCDOForm.Name &_
      GetHRCInfo(aCDOForm.AsHRC, 0)  
  next  
  Profile.MsgBox(aMessage)
end sub

function GetHRIInfo(aHRI, aLevel)
  Dim aSep
  Dim aInfo
  Dim aSrcProvider
 
  aSep = Space(4 * aLevel)
  aInfo = vbNewLine &_ 
    aSep & " * HRI name: " & aHRI.Name & VbNewLine
  if aHRI.SourceProviderID > 0 then
    set aSrcProvider = Profile.LoadProviderById(aHRI.SourceProviderID)    
    aInfo = aInfo & aSep & " - Source Provider : " & aSrcProvider.FullName & vbNewLine
  else          
    aInfo = aInfo & aSep & " - Source Provider : None " & vbNewLine
  end if 
    
  GetHRIInfo = aInfo    
end function

function GetHRCInfo(aHRC, aLevel)
  Dim aSep
  Dim aInfo
  Dim i
  Dim aObs
  Dim aSrcProvider 
 
  aSep = Space(4 * aLevel)
  aInfo = vbNewLine &_ 
    aSep & " * HRC name: " & aHRC.Name & VbNewLine
  if aHRC.SourceProviderID > 0 then
    set aSrcProvider = Profile.LoadProviderById(aHRC.SourceProviderID)    
    aInfo = aInfo & aSep & " - Source Provider : " & aSrcProvider.FullName & vbNewLine
  else          
    aInfo = aInfo & aSep & " - Source Provider : None " & vbNewLine
  end if

  for i = 0 to aHRC.Count - 1
    set aObs = aHRC.Item(i)
    if aObs.IsHRI then
      aInfo = aInfo & GetHRIInfo(aObs.AsHRI, aLevel + 1)
    else          
      aInfo = aInfo & GetHRCInfo(aObs.AsHRC, aLevel + 1)
    end if 
  next

  GetHRCInfo = aInfo
end function