Sub Click(Source As Button)
Dim session As New NotesSession
Dim wksp As New notesuiworkspace
Dim db As notesdatabase
Dim uidoc As notesuidocument
Dim doc As notesdocument
Dim Founddoc As NotesDocument
Dim Founddoc1 As notesdocument
Dim Inititem As notesitem
Dim foundfirstitem As NotesItem
Dim foundseconditem As NotesItem
Const Calledfrom = "BasedOnService"
Dim gotrtitem As NotesRichTextItem
Dim thisrtitem As notesrichtextitem
Dim me_reportdoc As notesdocument
Dim me_rtitem As NotesRichTextItem
Dim OK As Boolean
Dim arrRetFieldNames As Variant
Dim ret As Integer
Dim strT As String
Set db = session.CurrentDatabase
Set uidoc = wksp.CurrentDocument
' first find the Specifications
If uidoc.Document.HasItem("RelatedspecificationsUNID") = True Then
Set inititem = uidoc.document.GetFirstItem("RelatedSpecificationsUNID")
If inititem.Text <> "" Then
' lets rock and roll
' at first create a new item for this document
Set thisrtitem = New Notesrichtextitem(uidoc.Document,"ServiceBody")
' find the descriptive document with FormName and a Suffix and build the first entry
' Begin reporting part1
Set me_reportdoc = KeyView.GetDocumentByKey(uidoc.Document.form(0)+ "~" + "BasedOnService")
Set me_rtitem = me_Reportdoc.GetFirstItem("Body")
Set rtnav = me_rtItem.CreateNavigator
Set rtrange = me_rtItem.CreateRange
strTemp = ""
If rtnav.FindFirstString ( TAG_PREFIX, _
RT_FIND_CASEINSENSITIVE) Then
Do
Call rtrange.SetBegin ( rtnav )
strTemp = strTemp + TAG_DELIMITER + Mid ( rtrange.textRun, 3, Instr( rtrange.textRun,TAG_SUFFIX ) -3 )
Loop While rtnav.FindNextString ( TAG_PREFIX, RT_FIND_CASEINSENSITIVE )
End If
arrRetFieldNames = Arrayunique ( Split ( strTemp, TAG_DELIMITER ), 5 )
Set rtrange = me_rtItem.CreateRange
Forall t In arrRetFieldNames
strT = Cstr ( t )
If ( Not strT = "" ) Then
If ItemTextExists ( uidoc.document, strT ) Then
ret = rtrange.FindAndReplace _
( TAG_PREFIX & strT & TAG_SUFFIX,_ ' find
uidoc.document.GetFirstItem( strT ).Text, _ ' replaceWith
RT_REPL_ALL + RT_FIND_CASEINSENSITIVE)
Call me_rtItem.Update ' Must update before looping
End If
End If
End Forall
'End reporting Part1
Call ThisRtitem.AppendRtItem(me_RTItem)
If inititem.Text <> "" Then
Forall v In inititem.Values
' Get all the related documents
Set founddoc = db.GetDocumentByUNID(v)
If Not founddoc Is Nothing Then
' Begin reporting part2
Set me_reportdoc = KeyView.GetDocumentByKey(Founddoc.form(0)+ "~" + "BasedOnService")
Set me_rtitem = me_Reportdoc.GetFirstItem("Body")
Set rtnav = me_rtItem.CreateNavigator
Set rtrange = me_rtItem.CreateRange
strTemp = ""
If rtnav.FindFirstString ( TAG_PREFIX, _
RT_FIND_CASEINSENSITIVE) Then
Do
Call rtrange.SetBegin ( rtnav )
strTemp = strTemp + TAG_DELIMITER + Mid ( rtrange.textRun, 3, Instr( rtrange.textRun,TAG_SUFFIX ) -3 )
Loop While rtnav.FindNextString ( TAG_PREFIX, RT_FIND_CASEINSENSITIVE )
End If
arrRetFieldNames = Arrayunique ( Split ( strTemp, TAG_DELIMITER ), 5 )
Set rtrange = me_rtItem.CreateRange
Forall t In arrRetFieldNames
strT = Cstr ( t )
If ( Not strT = "" ) Then
If ItemTextExists ( founddoc, strT ) Then
ret = rtrange.FindAndReplace _
( TAG_PREFIX & strT & TAG_SUFFIX,_ ' find
founddoc.GetFirstItem( strT ).Text, _ ' replaceWith
RT_REPL_ALL + RT_FIND_CASEINSENSITIVE)
Call me_rtItem.Update ' Must update before looping
End If
End If
End Forall
'End reporting Part2
Call ThisRtitem.AppendRtItem(me_RTItem)
If founddoc.HasItem("RelatedContractsUNID") = True Then
Set Founditem = Founddoc.GetFirstItem("RelatedContractsUNID")
If founditem.text <> "" Then
' at first create a new item for this document
Forall x In founditem.Values
' Get all the related documents
Set founddoc1 = db.GetDocumentByUNID(x)
If Not founddoc Is Nothing Then
' Begin reporting part3
Set me_reportdoc = KeyView.GetDocumentByKey(founddoc1.form(0)+ "~" + "BasedOnService")
Set me_rtitem = me_Reportdoc.GetFirstItem("Body")
Set rtnav = me_rtItem.CreateNavigator
Set rtrange = me_rtItem.CreateRange
strTemp = ""
If rtnav.FindFirstString ( TAG_PREFIX, _
RT_FIND_CASEINSENSITIVE) Then
Do
Call rtrange.SetBegin ( rtnav )
strTemp = strTemp + TAG_DELIMITER + Mid ( rtrange.textRun, 3, Instr( rtrange.textRun,TAG_SUFFIX ) -3 )
Loop While rtnav.FindNextString ( TAG_PREFIX, RT_FIND_CASEINSENSITIVE )
End If
arrRetFieldNames = Arrayunique ( Split ( strTemp, TAG_DELIMITER ), 5 )
Set rtrange = me_rtItem.CreateRange
Forall t In arrRetFieldNames
strT = Cstr ( t )
If ( Not strT = "" ) Then
If ItemTextExists ( founddoc1, strT ) Then
ret = rtrange.FindAndReplace _
( TAG_PREFIX & strT & TAG_SUFFIX,_ ' find
founddoc1.GetFirstItem( strT ).Text, _ ' replaceWith
RT_REPL_ALL + RT_FIND_CASEINSENSITIVE)
Call me_rtItem.Update ' Must update before looping
End If
End If
End Forall
'End reporting Part3
Call ThisRtitem.AppendRtItem(me_rtitem)
End If
End Forall
End If
End If
End If
End Forall
End If
End If
End If
Call uidoc.Document.save(True,False)
Call uidoc.close(True)
End Sub