ISHRI.DeleteEntityId

Example

Display some information about the CDO forms contents and delete the selected entity linked 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 aEntities, aEntity
        
  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

  set aEntities = aProvHRI.GetEntityIdBySource("DataImporter")
  for each aEntity in aEntities
    aProvHRI.DeleteEntityId aEntity
  next     
  
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