Enumerating the Coded Concepts of a Context Group Example for Visual Basic
Private Function DisplayCodedConcept(objDS As LEADDicomDS, _
bYesNo As Boolean) As Boolean
Dim sTitle As String
objDS.MoveCodedConceptGroup
sTitle = "Coded Concept (" & _
objDS.CurrentContextGroup.ContextIdentifier & ")"
Dim sMsg As String
With objDS.CurrentCodedConcept
' Coding Scheme Designator
sMsg = .CodingSchemeDesignator & vbNewLine
' Coding Scheme Version
If Len(.CodingSchemeVersion) Then
sMsg = sMsg & .CodingSchemeVersion & vbNewLine
End If
' Code Value and Code Meaning
sMsg = sMsg & .CodeValue & vbNewLine & .CodeMeaning & vbNewLine
' Context Group Local Version
If .IsContextGroupLocalVersion Then
Dim sYear As String
sYear = .ContextGroupLocalVersion.Year
Do While Len(sYear) < 4
sYear = "0" & sYear
Loop
Dim sMonth As String
sMonth = .ContextGroupLocalVersion.Month
If Len(sMonth) < 2 Then sMonth = "0" & sMonth
Dim sDay As String
sDay = .ContextGroupLocalVersion.Day
If Len(sDay) < 2 Then sDay = "0" & sDay
sMsg = sMsg & sYear & sMonth & sDay & vbNewLine
End If
' Context Group Extension Creator UID
If Len(.ContextGroupExtensionCreatorUID) Then
sMsg = sMsg & .ContextGroupExtensionCreatorUID & vbNewLine
End If
End With
If bYesNo Then
sMsg = sMsg & vbNewLine & "Continue?"
DisplayCodedConcept = MsgBox(sMsg, vbYesNo, sTitle) = vbYes
Else
MsgBox sMsg, vbOKOnly, sTitle
DisplayCodedConcept = True
End If
End Function
Private Sub EnumCodedConcepts(objDS As LEADDicomDS)
Dim bRet As Boolean
' Enumerate the Coded Concepts in the current Context Group (3 possible ways)
If True Then
' One possible way to enumerate the Coded Concepts
bRet = objDS.MoveFirstCodedConcept()
Do While bRet
If Not DisplayCodedConcept(objDS, True) Then
Exit Do
End If
bRet = objDS.MoveNextCodedConcept ()
Loop
ElseIf False Then
' Another way to enumerate the Coded Concepts
Dim I As Long
For I = 0 To objDS.GetCodedConceptCount () - 1
objDS.FindIndexCodedConcept I
If Not DisplayCodedConcept(objDS, True) Then
Exit For
End If
Next
ElseIf False Then
' A third way to enumerate the Coded Concepts
bRet = objDS.MoveLastCodedConcept ()
Do While bRet
If Not DisplayCodedConcept(objDS, True) Then
Exit Do
End If
bRet = objDS.MovePrevCodedConcept ()
Loop
End If
End Sub