 |
|
|
|
|
|
|
The Clinical Information Consultancy
Last updated: 26/06/02
|
|
The Clinical Information Consultancy
Last updated: 26/06/02 |
This example code could be used to integrate the CLUE browser in a simple database or spreadsheet application using Visual Basic for Applications.
Global serv As New Server
Global ref As Reference
Global brw As Browser
Sub SelectFromBrowser()
'** CALLS THE BROWSER AND SETS SOME STARTING/DEFAULT INFORMATION **
'call the MkBrw routine to create a browser object if not already created
MkBrw
'set an initial/default Read Code
Brw.ReadCode=StartingReadCode
'set a restriction so all browsing is in a particular branch of the hierarchy
Brw.Configuration.Ancestor=HierarchyCode
'show the browser
Brw.Show
'set a timer to poll the browser object
timWaitBrowser.Enabled=True
timWaitBrowser.Interval=100 ' implies 100 milliseconds
End Sub
Sub timWaitBrowser_Timer()
'** AT SPECIFIED TIME INTERVALS CHECKS IF BROWSER SELECTION COMPLETE **
Static oldstate As Integer
'poll the browser object for changes in state each time the timer is activated
If brw Is Nothing Then Exit Sub
If brw.State = oldstate Then Exit Sub
oldstate = brw.State
Select Case brw.State
'if the state is ok the use the browser 'properties to read the selected information
Case RU_OK
SelectedReadCode = brw.ReadCode
SelectedTermId = brw.TermId
SelectedTerm = brw.Term
SelectedQualifiers = brw.ReadComplex
'…other states may have different consequences not shown here
End Select
'reset the browser state using the "action" property
brw.Action = 0
'hide the browser window
brw.hide
End Sub
Sub MkBrw()
'** CREATES THE GLOBAL BROWSER OBJECT IF NOT ALREADY CREATED **
'allow the application to detect OLE errors
App.OleServerBusyRaiseError = True
'create a new browser object unless brw is already set
If brw Is Nothing Then Set brw = serv.NewBrowser
'configure the browser to work only with items with the concept status "current"
brw.Configuration.ConceptStatus = RVS_CURRENT
End Sub
This example code can be used with the CLUE Reference object to generate a list of all the terms matching a one or two word phrase. Selecting an item in the list produced then causes the list to be replaced with a list of the hierarchical children of the selected concept.
Global serv As New Server
Global ref As Reference
Global brw As Browser
Sub SearchList(Phrase As String)
''** SEARCHES BY KEYWORD AND DISPLAYS LIST **
Dim i As Integer, TList As Variant
'Create reference object if not already available
MkRef
'cause time out every second to update list display
ref.Configuration.EventInterval = 1
'generate the list
TList = ref.ListTerms(Phrase, LMODE_TERMID_TERM)
lstSearch.Clear
Do
'build the diplay list for terms found
For i = lstSearch.ListCount To ref.ListCount - 1
lstSearch.AddItem TList(i)
Next
DoEvents
'handle time-outs to allow for long searches
If ref.ObjErr <> ERR_TIMEOUT Then Exit Do
TList = ref.ListTerms(Key, LMODE_TERMID_TERM)
Loop
End Sub
Sub lstSearch_Click(ListIndex as Integer)
'** RESPONDS TO SELECTION OF A SPECIFIED ITEM IN THE LIST **
Dim cpt As Concept, i As Long, TList As Variant
'get the concept for the selected term
Set cpt = ref.FoundTerm(ListIndex).FirstConcept
If ref.ObjErr <> 0 Then Exit Sub
'generate the list of children
TList = cpt.ListChildren(LMODE_READCODE_TERM)
lstChildren.Clear
'build the display list of the children found
For i = lstChildren.ListCount To ref.ListCount - 1
lstChildren.AddItem TList(i)
Next
End Sub
Sub MkRef()
'** CREATES THE GLOBAL REFERENCE OBJECT IF NOT ALREADY CREATED **
'allow the application to detect OLE errors
App.OleServerBusyRaiseError = True
'create a new reference object unless ref is already set
If ref Is Nothing Then Set ref = serv.NewReference
'configure the reference object to work only with items with the concept status "current"
ref.Configuration.ConceptStatus = RVS_CURRENT
End Sub