ISHRI.AddEntityId

Example

Display some information about the CDO forms contents and add a new entity to the specified HRIs.

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


  set aMapTrans = Profile.StartMapTransaction 

  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
  
  aMapTrans.SnapShot
  
  '--- 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
  Dim aSource, aIdentifier, aValue 
  
  const CID_IBCDO_HRIText = 100511
  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.AddTextHRI(aProviderConcept, "Additional Provider")
    aProvHRI.Content.Value = aProvider.Code
    
    aSource = "DataImporter"    
    aIdentifier = "AdditionalProviderNumber"
    aValue = "PI31415"     
    set aEntity = aProvHRI.AddEntityId(aSource, aIdentifier, aValue)
  end if
end sub 

function GetHRIInfo(aHRI, aLevel)
  Dim aInfo, aSep
  Dim aEntities, aEntity
  aSep = Space(4 * aLevel)
  aInfo = aSep & " * HRI name: " & aHRI.Name & vbTab & aHRI.TypeID & vbTab & aHRI.ConceptCode & VbNewLine
  
  set aEntities = aHRI.GetEntityIdBySource("DataImporter")
  for each aEntity in aEntities
    aInfo = aInfo &_
      aSep & "  - EntityId source: " & aEntity.Source & VbNewLine &_
      aSep & "    EntityId Identifier:  " & aEntity.Identifier & VbNewLine &_
      aSep & "    EntityId Value:  " & aEntity.EntityValue & VbNewLine             
  next    
  
  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