ISHRI.SetContentType

Example

Display some information about the loaded CDO forms contents, including the content types IDs of the HRIs.

sub main                     
  Dim aPatient
  Dim aFilter
  Dim aCDOForms, aCDOForm 
  Dim aConcepts, aProviderConcept
  Dim aProvider
  Dim aFormRootHRC
  Dim i
  Dim aMessage

  Set aPatient = Profile.SelectPatient
  set aFilter = Profile.CreateCdoFormFilter
  aFilter.PatientId = aPatient.Id
  set aCDOForms = Profile.LoadCdoForms(aFilter) ' ISHRObservations

  '--- Add Provider Information into every CDO form
  set aFilter = Profile.CreateConceptsFilter
  aFilter.AddConceptRef "IH", "IH191", False
  set aConcepts = Profile.LoadConcepts(aFilter)
  set aProviderConcept = aConcepts.Item(0) 

  set aProvider = Profile.LoadProvider(Profile.CurrentUserCode)

  for i = 0 to aCDOForms.Count - 1  
    set aFormRootHRC = aCDOForms.Item(i).AsHRC
    AppendObservedProvider aFormRootHRC, aProviderConcept, aProvider 
  next
  
  '--- Display forms content
  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

sub AppendObservedProvider(aFormRootHRC, aProviderConcept, aProvider)
  Dim aProvHRI, aObs
  Dim i
  
  const CID_IBCDO_HRIText = 100511
  const CID_IBCDO_Text = 100610  
  
  set aProvHRI = nothing
  for i = 0 to aFormRootHRC.Count - 1
    set aObs = aFormRootHRC.Item(i)
    if (aObs.TypeId = CID_IBCDO_HRIText) and _ 
      (aObs.TermsetCode = aProviderConcept.Termset) and _ 
      (aObs.ConceptCode = aProviderConcept.Code) then
      set aProvHRI = aObs.AsHRI
    end if
  next 'i

  if aProvHRI is nothing then  
    set aProvHRI = aFormRootHRC.Add(CID_IBCDO_HRIText, aProviderConcept).AsHRI
    aProvHRI.SetContentType CID_IBCDO_Text
    aProvHRI.Content.Value = aProvider.Code
  end if  
end sub 

function GetHRIInfo(aHRI, aLevel)
  Dim aInfo, aSep
  aSep = Space(4 * aLevel)
  aInfo = aSep & " * HRI: " & aHRI.Name & VbNewLine & vbTab &_
   " TypeID: " & aHRI.TypeID & vbTab &_
   " Concept Code: " & aHRI.ConceptCode & vbTab &_
   " Content Type Id: " & aHRI.Content.TypeId & VbNewLine
  GetHRIInfo = aInfo    
end function

function GetHRCInfo(aHRC, aLevel)
  Dim aInfo, aSep
  Dim i
  Dim aObs 
 
  aSep = Space(4 * aLevel)
  aInfo = vbNewLine &_ 
    aSep & " * HRC name: " & aHRC.Name & VbNewLine
    
  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