Ao next action analysis.mmbas

From ActivityOwnerWiki
Jump to: navigation, search
'ao_next_action_analysis 25Jan11 http://creativecommons.org/licenses/by-nc-nd/3.0/
'"Next Action Analysis" (TM) ActivityOwner.com
'
'#uses "ao_common.mmbas"
'recent changes
'add overdue project information
'error trap hyperlink follow
'avoid identifying completed tasks as overdue
'break out common functions to ao_common.mmbas
'add configuration map and version checking
'trap error
'try to avoid naalog overwrite
'getmap fixes
'avoid crash on missint callout topic
'avoid divide by 0 issues and missing callout topic issue (finally?)
'change default to not show web advice
'trap error on most work report
'report number of tasks in biggest context
'change weighting to favor fixing the oldest task
'19Apr change version check strategy
'02May09 Add a metric for setting time estimates for tasks, trim off empty items, add 10/10 advice
'03May09 fix version number
'17May09 change to sigmoidal scoring
'07Jul09 fix bug related to "unimplemented feature" -- looking for central topic callout
'07Sep09 tweak scoring to penalize too many and too old daily capture
'28Feb10 add total time estimate
'09Mar10 fix bug preventing perfect scores and re-shape scoring curve
'14Mar10 gather up in-tray items
'20Mar10 fix bug in "no dates" metric, add support for 2m action
'21Mar10 improve area search
'22Mar10 loosen project count target, allow a few no context/time estimate items
'07Apr10 allow a grace period on no-context item penalty
'12Apr10 lower weight on project count
'17Oct10 Don't count projects with start date= end date as overdue (likely due to mm9 task issue)
'25Jan11 fix bug missing some projects in summary list

Option Explicit
Sub Main
	Const ProgramVersion = "20110125"
	Const VersionCheckLink = "http://activityowner.com/installers/versioncheck.php"
	Dim  showadvice As Boolean 'set this to false if you don't want to be prompted for advice.
	Dim  askadvice  As Boolean  'set this to false if you want to show advice automatically without being prompted.
	Dim  logprompt  As Boolean 'prompt before saving score to log
	Dim checkempty As Boolean
	Const  maxactions = 500
	Const  maxprojects = 200
	Const maxmaps = 600
	Const maxareas = 30
	Const  mapcentralcat= "mc*"
	Const dcmapname="Daily Capture Map"
	Dim addtolog As Boolean
	Dim ie As Object
	Dim numprojects As Integer
	Dim nummainprojects As Integer
	Dim numactions As Integer
	Dim nummaps As Integer
	Dim mostactions As Integer
	Dim mostmap As Integer
	Dim numdatedprojects As Integer
	Dim numnopriorityprojects As Integer
	Dim numdatedactions As Integer
	Dim numdatedintrayactions As Integer
	Dim numnocontext As Integer
	Dim numneednextaction As Integer
	Dim numoverdue As Integer
	Dim numoverdueprojects As Integer
	Dim numpasttarget As Integer
	Dim numoverduewaiting As Integer
	Dim numwaiting As Integer
	Dim numDailyCapture As Integer
	Dim contexttotal As Double
	Dim contextcount As Double
	Dim oldavg As Double

	Dim actions(maxactions) As Topic
	Dim allactions(maxactions) As Topic
	Dim oldestintrayitemxml As String
	Dim oldestintrayage As Integer
	Dim age(maxactions) As Integer
	Dim InTrayAge(maxactions) As Integer
	Dim projectxml(maxprojects) As String
	Dim nextactionxml(maxactions) As String
	Dim nextactioncat(maxactions) As String
	Dim repeating(maxactions) As Boolean
	Dim taskarea(maxactions) As String
	Dim projectarea(maxprojects) As String
	Dim nextactionpriority(maxactions) As Integer
	Dim maplinks(maxmaps) As String
	Dim mapcount(maxmaps) As Integer
	Dim projecttext(maxprojects) As String
	Dim projectpriority(maxprojects) As Integer
	Dim projectdated(maxprojects) As Boolean
	Dim projectoverdue(maxprojects) As Boolean
	Dim actioncount(maxprojects) As Integer
	Dim nextactions(maxactions) As String
	Dim isproject(maxprojects) As Boolean
	Dim isprioritized(maxprojects) As Boolean
	Dim area(maxareas) As String
	Dim numareas As Integer
	Dim cnt As Integer

	'report branches
	Dim reporttopic As Topic
	Dim ratingtopic As Topic
	Dim datedprojects As Topic
	Dim undatedprojects As Topic
	Dim undatedsubprojects As Topic
	Dim deltopic As Topic
	Dim nocontextactions As Topic
	Dim neednextaction As Topic
	Dim ProjectOnlyIntray As Topic
	Dim oldcontexttopic As Topic
	Dim timecategories As Topic
	Dim taskprioritytopic As Topic
	Dim c2m As Topic
    Dim c15m As Topic
    Dim c1h As Topic
    Dim c2h As Topic
    Dim noest As Topic
    Dim ptopic(5) As Topic

	Dim t As Topic
	Dim tt As Topic
	Dim ttt As Topic
	Dim tttt As Topic
	Dim persontopic As Topic
	Dim swap As Topic
	Dim swapa As Integer
	Dim dashboard As Document
	Dim reportdoc As Document
	Dim NextActionDoc As Document
	Dim NoContextDoc As Document
	Dim NoActionDoc As Document
	Dim DeadlinesDoc As Document
	Dim RelationshipDoc As Document
	Dim LogDoc As Document
'	Dim IntrayDoc As Document

	Dim i As Integer
	Dim j As Integer
	Dim k As Integer

	Dim avgage As Double
	Dim avInTrayAge As Double
	Dim oldest As Double
	Dim found As Boolean
	Dim pct_complete As Double
	Dim done As Double
	Dim rating As Double
	Const nm = 15
	Dim metric(nm) As Double
	Dim weight(nm) As Double
	Dim goal(nm) As Double
	Dim half(nm) As Double
	Dim mname(nm) As String
	Dim advice(nm) As String
	Dim ratings(nm) As Double
	Dim opportunity(nm) As Double
	Dim hlink(nm) As String
	Dim maxopportunity As Double
	Dim secondopportunity As Double
	Dim thirdopportunity As Double
	Dim firstitem As Integer
	Dim seconditem As Integer
	Dim thirditem As Integer

	Dim FocusTopic As Topic
	Dim FinishTopic As Topic
	Dim FreshnessTopic As Topic
	Dim FeasibilityTopic As Topic
	Dim ForesightTopic As Topic
	Dim AdviceTopic As Topic
	Dim AdviceTopic1 As Topic

	Dim reporttitle As String
	Dim logdocname As String
	Dim configdocname As String
	Dim ConfigDoc As Document
	Dim DueInSeven As Integer
	Dim graceperiod As Integer

	Dim dummy As Topic

	graceperiod=2
	DueInSeven=0
	configdocname = "AO\NAAconfig.mmap"
	Set ConfigDoc=getmap(configdocname)
	Upgrade ConfigDoc
	VersionCheck VersionCheckLink, "NAA", ProgramVersion, ConfigDoc
	showadvice=optiontrue("showadvice",ConfigDoc)
	askadvice=optiontrue("askadvice",ConfigDoc)
	logprompt=optiontrue("logprompt",ConfigDoc)
	checkempty=optiontrue("checkempty",ConfigDoc)
	logdocname=getoption("logdocname",ConfigDoc)
	On Error GoTo 0
	'get rid of previous report------------------------------
	reporttitle="NEXT" &  Chr(10) & "ACTION" &  Chr(10) & "ANALYSIS"
	Set dashboard=ActiveDocument
	If dashboard Is Nothing Then End
	If Not InStr(LCase(dashboard.CentralTopic.Text),"actions")>0 Then
		MsgBox("Please open your daily action dashboard")
		End
	End If
	Set reportdoc = Documents.Add(True)
	reportdoc.CentralTopic.Text = "Next Action Analysis In Progress"
	Set deltopic = reportdoc.CentralTopic.AddSubTopic("Status")
	For Each t In dashboard.CentralTopic.AllSubTopics
		If t.Text=reporttitle Then t.Delete
	Next
	Set reporttopic=dashboard.CentralTopic.AddBalancedSubTopic(reporttitle)

	deltopic.AddSubTopic("Creating temporary maps")
	Set NextActionDoc=Documents.Add(False)
	Set NoContextDoc=Documents.Add(False)
	Set NoActionDoc=Documents.Add(False)
	Set DeadlinesDoc=Documents.Add(False)
	Set RelationshipDoc=Documents.Add(False)
	'Set IntrayDoc = Documents.Add(False)

	'---------------------------------------------------------
	'It is easier to do stats on branches if they live on their own temporary map
	deltopic.AddSubTopic("Copying branches to temporary maps")
	copybranchcontainingtomap dashboard.CentralTopic,    "committed next actions",NextActionDoc 'next actions branch
	copybranchcontainingtomap NextActionDoc.CentralTopic,"no context",NoContextDoc 'find no context branch
	copybranchcontainingtomap dashboard.CentralTopic,    "needing next actions",NoActionDoc 'projects needing actions
	copybranchcontainingtomap dashboard.CentralTopic,"deadlines",DeadlinesDoc 'find overdue branch
	copybranchcontainingtomap dashboard.CentralTopic,"relationship",RelationshipDoc 'find branch with word relationship
'copybranchcontainingtomap dashboard.CentralTopic,"In-trays",IntrayDoc 'find branch with intrays
	'----------------------------------------------------------
	deltopic.AddSubTopic("Adding up totals")
    numnocontext		=TotalActivities(NoContextDoc) 'add up actions in no-context branch
	numneednextaction	=TotalActivities(NoActionDoc) 'add up projects in no-next action branch
	numoverdue 			=TotalRedActivities(DeadlinesDoc) ' add up overdue activities
	numpasttarget		=TotalRedActivities(NextActionDoc)-numoverdue ' add up number past target date
	numoverduewaiting  	=TotalRedActivitiesWithParentContaining(RelationshipDoc,"waiting") 'add up overdue waiting for task
	numwaiting          =TotalActivitiesWithParentContainingandnoduedate(RelationshipDoc,"waiting") 'add up tasks being waited for
	'---------------------------------------------------------
	'compile parent project info
	numprojects=0
	numdatedprojects=0
	numnopriorityprojects=0
	numoverdueprojects=0
	nummainprojects=0
	deltopic.AddSubTopic("Reviewing projects/priortities")
	For j=1 To maxprojects
		actioncount(j)=0
	Next
	For j=1 To maxmaps
		mapcount(j)=0
	Next

	For Each t In NextActionDoc.Range(mmRangeAllTopics)
		If t.IsCalloutTopic And Not t.Task.Complete=100 Then
		 If Not (t.ParentTopic.IsCalloutTopic And t.ParentTopic.Task.Complete<100) And Not InStr(t.Xml, mapcentralcat )>0 And Not InStr(LCase(t.Xml),"in-tray*")>0 Then  'what if text happens to have in-tray*?
			found=False
			For j=1 To numprojects
				If projecttext(j)=t.Text Then
					found=True
					actioncount(j)=actioncount(j)+1
					Exit For
				End If
			Next
			If Not found Then
				numprojects=numprojects+1
				projecttext(numprojects)=t.Text
				projectarea(numprojects)=getdashboardarea(t)
				projectxml(numprojects)=t.Xml
				projectpriority(numprojects)=t.Task.Priority
				If t.Task.DueDate>0 Then projectdated(numprojects)=True Else projectdated(numprojects)=False
				If t.Task.DueDate>0 Or t.ParentTopic.Task.DueDate>0 Then numdatedprojects=numdatedprojects+1
                If (t.Task.DueDate>0 And t.Task.DueDate<Now) Then
                   If Not Round(t.Task.DueDate-t.Task.StartDate)=0 Then
                	projectoverdue(numprojects)=True
                	numoverdueprojects=numoverdueprojects+1
                   End If
                Else
                	projectoverdue(numprojects)=False
                End If
				If t.Icons.Item(1).Name="CustomIcon--1181845906" Then
					isproject(numprojects)=False
				Else
					isproject(numprojects)=True
					nummainprojects=nummainprojects+1
					If t.Task.Priority=0 Then
						numnopriorityprojects = numnopriorityprojects + 1 'only count projects
						isprioritized(numprojects)=False
					Else
						isprioritized(numprojects)=True
					End If
				End If
				If t.Task.DueDate>0 Then
					If (t.Task.DueDate-Now)<7 Then
						DueInSeven = DueInSeven+1
					End If
				End If
			End If
		End If
	   End If
	   If Not t.IsCalloutTopic Then
			found=False
			If t.HasHyperlink Then
				 For j=1 To nummaps
					If maplinks(j)=t.Hyperlink.Address Then
						found=True
						mapcount(j)=mapcount(j)+1
						Exit For
					End If
				 Next
				If Not found Then
					nummaps=nummaps+1
					maplinks(nummaps)=t.Hyperlink.Address
				End If
			End If
		End If
	Next

    'calculate number of items in daily capture map
	numDailyCapture=0
	For j=1 To nummaps
		If InStr(maplinks(j),dcmapname)>0 Then
			numDailyCapture =mapcount(j)
			Exit For
		End If
    Next

	mostactions=1
    For j=1 To numprojects
		If actioncount(j)>actioncount(mostactions) Then mostactions=j
    Next
    mostmap=1
    For j=1 To nummaps
    	If mapcount(j)>mapcount(mostmap) Then mostmap = j
    Next

	'---------------------------------------------------------
	'calculate percent complete
	done=0
	numactions=0
	deltopic.AddSubTopic("Calculating percentage completion")
	For Each t In NextActionDoc.Range(mmRangeAllTopics)
		If Not t.Task.IsEmpty Then
		    If Not t.IsCalloutTopic Then
				found=False
				For j=1 To numactions
					If nextactions(j)=t.Text Then
						found=True
						Exit For
					End If
				Next
				If Not found Then
					numactions=numactions+1
					nextactions(numactions)=t.Text
					nextactionxml(numactions)=t.Xml
					nextactioncat(numactions)=cat(t)
					nextactionpriority(numactions)=0
					taskarea(numactions)=getdashboardarea(t)
					Set allactions(numactions) = t

					If t.Task.Priority>0 Then
						nextactionpriority(numactions)=t.Task.Priority
					ElseIf t.CalloutTopics.Count>0 Then
						If t.CalloutTopics.Item(1).Task.Complete<100 Then
							If t.CalloutTopics.Item(1).Task.Priority>0 Then
								nextactionpriority(numactions)=t.CalloutTopics.Item(1).Task.Priority
							ElseIf t.CalloutTopics.Item(1).CalloutTopics.Count>0 Then
								If t.CalloutTopics.Item(1).CalloutTopics.Item(1).Task.Complete<100 Then
									nextactionpriority(numactions)=t.CalloutTopics.Item(1).CalloutTopics.Item(1).Task.Priority
								End If
							End If
						End If
					End If
					repeating(numactions)=isrepeating(t)
					If t.Task.IsDone Or t.Icons.HasStockIcon(mmStockIconCheck) Then
						done=done+1
					ElseIf t.Task.Complete>0 Then
						done = done+t.Task.Complete/100
					End If
				End If
			End If
		End If
	Next
	If numactions>0 Then
		pct_complete = Round(100*done/numactions,2)
	Else
		pct_complete = 0
	End If
	'
	'analyze dated tasks
	deltopic.AddSubTopic("Analyzing task aging")
	numdatedactions=0
	For Each t In NextActionDoc.Range(mmRangeAllTopics)
		If Not t.IsCalloutTopic And t.Task.IsValid  Then
			If t.Task.StartDate>0 And t.Task.Complete<100 Then
	       		numdatedactions=numdatedactions+1
	       		Set actions(numdatedactions)=t
	       		age(numdatedactions)=Now-t.Task.StartDate
	       		If age(numdatedactions)<0 Then age(numdatedactions)=0
	       	End If
	     End If
	Next

	For i=1 To numdatedactions-1
      For j=i+1 To  numdatedactions
         If age(i)<age(j) Then
            Set swap= actions(i)
        	Set actions(i)=actions(j)
            Set actions(j)=swap
            swapa = age(i)
            age(i)=age(j)
            age(j)=swapa
          End If
      Next
    Next

    avgage=arrayaverage(age,numdatedactions	)

	oldest = age(1)

	oldavg=0
	For Each t In NextActionDoc.CentralTopic.AllSubTopics
		contexttotal=0
		contextcount=0
		For Each tt In t.AllSubTopics
			If tt.Task.StartDate>0 Then
				contextcount=contextcount+1
				contexttotal=contexttotal+(Now-tt.Task.StartDate)
			End If
		Next
		If contextcount>0 Then
			If contexttotal/contextcount > oldavg Then
				oldavg=contexttotal/contextcount
				Set oldcontexttopic=t
			End If
		End If
	Next

	'count up young noncontext entries

	For Each t In NextActionDoc.CentralTopic.AllSubTopics
		If InStr(LCase(t.Text),"no context")>0 Then
			For Each tt In t.AllSubTopics
				If tt.Task.StartDate>0 Then
					If (Now()-tt.Task.StartDate)<graceperiod Then
						numnocontext=numnocontext-1
					End If
				End If
			Next
			Exit For
		End If
	Next


	deltopic.AddSubTopic("Analyzing in-tray task aging")
	numdatedintrayactions=0
	'oldestintrayitemxml=""
	oldestintrayage=0
	For Each t In NextActionDoc.Range(mmRangeAllTopics)
		If Not t.IsCalloutTopic And t.Task.IsValid  Then
			If t.Task.StartDate>0 And t.Task.Complete<100 Then
				If InStr(LCase(t.CalloutTopics(True).Item(1).Text),"in-tray")>0 Then
					numdatedintrayactions=numdatedintrayactions+1
		       		InTrayAge(numdatedintrayactions)=Now-t.Task.StartDate
		       		If InTrayAge(numdatedintrayactions)>oldestintrayage Then
		       			oldestintrayitemxml=t.Xml
		       			oldestintrayage=InTrayAge(numdatedintrayactions)
		       		End If
		       		If InTrayAge(numdatedintrayactions)<0 Then InTrayAge(numdatedintrayactions)=0
		       	End If
	       	End If
	     End If
	Next
	avInTrayAge=arrayaverage(InTrayAge,numdatedintrayactions)

	Dim numNoEstimate As Integer
	numNoEstimate=0
	Dim TotalTimeEst As Double
	TotalTimeEst =0
	For i = 1 To numactions
		If InStr(nextactioncat(i),"2m")>0 Then
			TotalTimeEst = TotalTimeEst + 0.033
		ElseIf InStr(nextactioncat(i),"15m")>0 Then
			TotalTimeEst = TotalTimeEst + 0.25
		ElseIf InStr(nextactioncat(i),"1h")>0 Then
			TotalTimeEst = TotalTimeEst + 1
		ElseIf InStr(nextactioncat(i),"2h")>0 Then
			TotalTimeEst = TotalTimeEst + 0.25
		Else
			If age(i)>graceperiod Then
				numNoEstimate=numNoEstimate+1
			End If
		End If
	Next


	'---------------------------------------------------------
	'Generate Report

	Const freshness=1
	Const focus=2
	Const feasibility=3
	Const finishing=4
	Const foresight=5

	'Dashboard Scoring

	deltopic.AddSubTopic("Calculating Metrics")

	Dim mclass(15) As Integer
	'freshness metrics
	mclass(1)=freshness:	metric(1)=avgage										:weight(1)=0.1  	:goal(1)=14:		:half(1)=28 : mname(1)="avg age "
	mclass(2)=freshness: 	metric(2)=avInTrayAge									:weight(2)=0.1		:goal(2)=14:		:half(2)=30: mname(2)="In-Tray age"

	'focus metrics
	mclass(3)=focus:		metric(3)=numprojects				:weight(3)=0.02		:goal(3)=40:		:half(3)=80 : mname(3)="# projects "
	mclass(4)=focus
	If numprojects>0 Then
		metric(4)=(numprojects-numdatedprojects)/numprojects	:weight(4)=0.09		:goal(4)=0.5		:half(4)=.75  : mname(4)="no dates   "
	Else
		metric(4)=1												:weight(4)=0.09		:goal(4)=0.5		:half(4)=0  : mname(4)="no dates   "
	End If
	mclass(11)=focus
	If nummainprojects>0 Then
    	metric(11)=numnopriorityprojects/nummainprojects	   :weight(11)=0.08	:goal(11)=0 :half(11)=.1 			: mname(11)="no priority"
    Else
    	metric(11)=1										   :weight(11)=0.08	:goal(11)=0 :half(11)=.1 			: mname(11)="no priority"
    End If

	'finishing metrics
	mclass(6)=finishing:	metric(6)=numoverdue						:weight(6)=0.06		:goal(6)=0			:half(6)=2				: mname(6)="overdue    "
	mclass(7)=finishing:	metric(7)=numoverduewaiting					:weight(7)=0.04 	:goal(7)=0			:half(7)=2				: mname(7)="waiting    "
	mclass(8)=finishing: 	metric(8)=numpasttarget						:weight(8)=0.03		:goal(8)=0			:half(8)=4				: mname(8)="past target"
    mclass(12)=finishing:	metric(12)=numwaiting                       :weight(12)=0.02     :goal(12)=15 		:half(12)=20            : mname(12)="waiting on"
    mclass(13)=finishing:	metric(13)=numoverdueprojects 				:weight(13)=0.05     :goal(13)=0        :half(13)=2             : mname(13)="late projects"

	'foresight metrics
	mclass(9)=foresight:	metric(9)=numnocontext						:weight(9)=0.08		:goal(9)=3			:half(9)=8  			: mname(9)="aging no context "
	mclass(10)=foresight:	metric(10)=numneednextaction			 	:weight(10)=0.08	:goal(10)=0			:half(10)=2 			: mname(10)="next step"
    mclass(14)=foresight:	metric(14)=numNoEstimate					:weight(14)=0.04	 :goal(14)=3		:half(14)=10			: mname(14)="no time estimate"

	'fesibility metrics
	mclass(5)=feasibility:	metric(5)=numactions						:weight(5)=0.1		:goal(5)=60			:half(5)=90				: mname(5)="# actions   "
    mclass(15)=feasibility:	metric(15)=numDailyCapture					:weight(15)=0.1	 	:goal(15)=0		:half(15)=15			: mname(15)="# in Daily Capture"


	advice(1)= "Complete aging actions or put on someday list, delegate, or insert do-able predecessor"
	advice(2)="Deal with old items still sitting in in-trays"
	advice(3)="Reduce your " & numprojects & " project by completing, delegating, deferring, or putting on someday list"
	advice(4)="Add target dates to some of your projects"
	advice(5)="Reduce your " & numactions & " Next Actions by doing, delegating, deferring, or putting on someday list"
	advice(6)="Renegotiate your deadlines or meet them"
	advice(7)="Follow-up with people whose deadlines have slipped"
	advice(8)="Review the tasks that have slipped past their target date"
	advice(9)="Add contexts to actions or replace with better 'physical' next actions"
	advice(10)="Add next steps to projects that need them"
	advice(11)="Add priority to your projects and subprojects"
	advice(12)="Set target dates for items you are waiting for"
	advice(13)="Finish or renegotiate your overdue projects"
	advice(14)="Estimate time required for tasks (set category=2m,15m,1h,2h)"
	advice(15)="Reduce the number of unprocessed items in your daily capture map"

	hlink(1)="http://wiki.activityowner.com/index.php?title=NAA_Average_Age"
	hlink(2)="http://wiki.activityowner.com/index.php?title=NAA_Aging_InTray_Items"
	hlink(3)="http://wiki.activityowner.com/index.php?title=NAA_Many_Projects"
	hlink(4)="http://wiki.activityowner.com/index.php?title=NAA_Doable_Projects"
	hlink(5)="http://wiki.activityowner.com/index.php?title=NAA_Number_of_Actions"
	hlink(6)="http://wiki.activityowner.com/index.php?title=NAA_Overdue"
	hlink(7)="http://wiki.activityowner.com/index.php?title=NAA_Overdue_Waiting"
	hlink(8)="http://wiki.activityowner.com/index.php?title=NAA_Past_Target"
	hlink(9)="http://wiki.activityowner.com/index.php?title=NAA_Context"
	hlink(10)="http://wiki.activityowner.com/index.php?title=NAA_Need_Next_Action"
	hlink(11)="http://wiki.activityowner.com/index.php?title=NAA_Need_Priority"
    hlink(12)="http://wiki.activityowner.com/index.php?title=NAA_Waiting_On"
    hlink(13)="http://wiki.activityowner.com/index.php?title=NAA_Overdue_Projects"
    hlink(14)="http://wiki.activityowner.com/index.php?title=NAA_Time_Estimates"
    hlink(15)="http://wiki.activityowner.com/index.php?title=NAA_Too_Many_Daily_Capture"

	'ratings add up to maximum 1.0 (multipled by 10 later)
	For i = 1 To nm
		ratings(i)= score(metric(i),goal(i),half(i),weight(i))
	Next

	Dim F(5) As Double
    F(freshness)	= ratings(1)	+ratings(2)		'20% freshness
    F(focus) 		= ratings(3)+ratings(4) + ratings(11)	'20% focus
    F(feasibility) 	=ratings(5)+ratings(15)				'20% feasibility
    F(finishing)	= ratings(6)+ratings(7)+ratings(8)+ratings(12)+ratings(13)	'20% finishing
	F(foresight) 	= ratings(9)+ratings(10)+ratings(14)   '20% foresight

	'

	rating=F(1)+F(2)+F(3)+F(4)+F(5)
	deltopic.AddSubTopic("Generating Report")
	Set AdviceTopic = reporttopic.AddSubTopic("Advice:")
	'scoring
	Set ratingtopic = reporttopic.AddSubTopic("Overall NAA Rating: " & Round(rating*10,2) & "/10")
	For i=1 To nm
		ratingtopic.Notes.Text=ratingtopic.Notes.Text & vbCrLf & "Metric " & Str(i) & " : " & mname(i) & "   " &  Str(Round(metric(i),2)) & "  " &  Str(Round(ratings(i),2)) & " of " & Str(Round(weight(i),2))
	Next
	'
	'show in sorted order
	Dim allshown As Boolean
	allshown=False
	Dim minrating As Double
	Dim mintopic As Integer
	Dim shown(5) As Boolean
	For i=1 To 5
		shown(i)=False
	Next
	deltopic.AddSubTopic("Sorting 5F scores")
	While Not allshown
		minrating=10
		For i = 1 To 5
			If F(i)<=minrating And shown(i)=False Then
				minrating=F(i)
				mintopic = i
			End If
		Next
		shown(mintopic)=True
		If mintopic=foresight Then Set ForesightTopic		= ratingtopic.AddSubTopic("Foresight: " 		& Round(F(foresight)  *5*10,2) & "/10")
		If mintopic=freshness Then Set FreshnessTopic		= ratingtopic.AddSubTopic("Freshness: "         & Round(F(freshness)  *5*10,2) & "/10")
		If mintopic=focus Then 	Set FocusTopic				= ratingtopic.AddSubTopic("Focus: "       		& Round(F(focus)      *5*10,2) & "/10")
		If mintopic=feasibility Then Set FeasibilityTopic 	= ratingtopic.AddSubTopic("Feasibility: " 		& Round(F(feasibility)*5*10,2) & "/10")
		If mintopic=finishing Then 	Set FinishTopic 		= ratingtopic.AddSubTopic("Finishing: " 		& Round(F(finishing)  *5*10,2) & "/10")
		allshown=True
		For i=1 To 5
			If shown(i)=False Then allshown = False
		Next
	Wend
	'flag good/bad dimensions
	If rating<0.66 				Then ratingtopic.TextColor.SetARGB(255,255,0,0)
	If rating>0.89 				Then ratingtopic.TextColor.SetARGB(255,0,255,0)
	If F(foresight)<0.65*0.2 	Then ForesightTopic.TextColor.SetARGB(255,255,0,0)
	If F(freshness)<0.65*0.2 	Then FreshnessTopic.TextColor.SetARGB(255,255,0,0)
	If F(focus)<0.65*0.2     	Then FocusTopic.TextColor.SetARGB(255,255,0,0)
	If F(finishing)<0.65*0.2    Then FinishTopic.TextColor.SetARGB(255,255,0,0)
	If F(feasibility)<0.65*0.2  Then FeasibilityTopic.TextColor.SetARGB(255,255,0,0)


	FeasibilityTopic.AddSubTopic("Your tasks with time estimates add up to " & Str(Round(TotalTimeEst,1)) & " hours")
	'add advice for area(s) of most improvement opportunity
	maxopportunity=0
	firstitem=1
	seconditem=1
	thirditem=1
	secondopportunity=0
	thirdopportunity=0
	deltopic.AddSubTopic("Creating Recommendations")
	For i=1 To nm
		opportunity(i)=weight(i)-ratings(i)
		If opportunity(i)>maxopportunity Then
			maxopportunity=opportunity(i)
			firstitem=i
		End If
	Next
	For i=1 To nm
		If opportunity(i)>secondopportunity Then
			If Not (i=firstitem) Then
				secondopportunity=opportunity(i)
				seconditem = i
			End If
		End If
	Next
	For i=1 To nm
		If opportunity(i)>thirdopportunity Then
			If Not (i=firstitem) And Not (i=seconditem) Then
				thirdopportunity=opportunity(i)
				thirditem = i
			End If
		End If
	Next
	If rating >0.89 Then
		AdviceTopic.AddSubTopic("Your system is in great shape -- Go pick a context list and get things done on it!").Icons.AddStockIcon(mmStockIconSmileyHappy)
	End If
	If maxopportunity >0   Then
		Set AdviceTopic1 = AdviceTopic.AddSubTopic(advice(firstitem) & " for " & Round(opportunity(firstitem)*10,2) & " points")
		AdviceTopic1.Task.Complete=0
		AdviceTopic1.Task.Priority=mmTaskPriority1
		AdviceTopic1.CreateHyperlink(hlink(firstitem))
	End If
	If secondopportunity >0   Then
		Set t = AdviceTopic.AddSubTopic(advice(seconditem) & " for " & Round(opportunity(seconditem)*10,2) & " points")
		t.Task.Complete=0
		t.Task.Priority=mmTaskPriority2
		t.CreateHyperlink(hlink(seconditem))
	End If
	If thirdopportunity >0   Then
		Set t = AdviceTopic.AddSubTopic(advice(thirditem) & " for " & Round(opportunity(thirditem)*10,2) & " points")
		t.Task.Complete=0
		t.Task.Priority=mmTaskPriority3
		t.CreateHyperlink(hlink(thirditem))
	End If
	If AdviceTopic.AllSubTopics.Count>0 Then
		AdviceTopic.AddSubTopic("Visit Links for more targeted advice and resources for addressing the challenges above from activityowner.com")
	Else
		AdviceTopic.AddSubTopic("Perfect Score!")
		AdviceTopic.AddSubTopic("go to review dashboard and consider your someday maybes")
		AdviceTopic.AddSubTopic("Do a mind sweep/office sweep/house sweep and make sure you have captured all")
	End If
'----------------------------------------------------------------------------------------------------------------------------
	'add supporting information
	deltopic.AddSubTopic("Adding Supporting Information for ...")
	'--------------------FEASIBILITY------------------------------------------------------------------------
	deltopic.AddSubTopic(" * Feasibility")
	Set t=FeasibilityTopic.AddSubTopic("You have " & numactions & " next actions")
	If numactions>100 Then t.TextColor.SetARGB(255,255,0,0)
	Set t=maxbranch(NextActionDoc)
	If Not t Is Nothing Then
		Set tt = FeasibilityTopic.AddSubTopic("You have " & Str(t.AllSubTopics.Count) & " actions (" & Str(Round(t.AllSubTopics.Count*100/numactions,0)) & "%) in the " & t.Text & " context")
		For Each ttt In t.AllSubTopics
			tt.AddSubTopic("").Xml=ttt.Xml
		Next
		tt.SetLevelOfDetail(0)
	End If
	If numprojects>0 Then
		FeasibilityTopic.AddSubTopic("You have " & actioncount(mostactions) & " actions in...").AddSubTopic("").Xml = projectxml(mostactions)
	End If
	FeasibilityTopic.AddSubTopic("You have " & mapcount(mostmap) & " actions in " & Mid(maplinks(mostmap),InStrRev(maplinks(mostmap),"\")+1,Len(maplinks(mostmap))-InStrRev(maplinks(mostmap),"\")-4)).CreateHyperlink(maplinks(mostmap))
	Set tt = FeasibilityTopic.AddSubTopic("Repeating Actions")
	numareas=0
	For i = 1 To numactions
		If repeating(i) Then tt.AddSubTopic("").Xml=nextactionxml(i)
		found=False
		If numareas>0 Then
			For j=1 To numareas
				If LCase(taskarea(i))=LCase(area(j)) Then
					found=True
					Exit For
				End If
			Next
		End If
		If Not found Then
			numareas=numareas+1
			area(numareas)=taskarea(i)
		End If
	Next
	Set tt=Nothing
	Set ttt=Nothing
'----FINISHING-----------------------------------------------------------------------------------------------------------------------
	deltopic.AddSubTopic(" * Finishing")
	If metric(13)>0 Then
		If metric(13)=1 Then
			Set t=FinishTopic.AddSubTopic(metric(13) & " project is overdue (see note)")
			t.Notes.Text="Note others may actually be overdue if they happen to have start date = due date. These are ignored as a MM9 workaround."
		Else
				Set t=FinishTopic.AddSubTopic(metric(13) & " projects are overdue (see note)")
				t.Notes.Text="Note others may actually be overdue if they happen to have start date = due date. These are ignored as a MM9 workaround."
		End If
		For i=1 To numprojects
			If projectoverdue(i)=True Then
				 t.AddSubTopic("").Xml=projectxml(i)
			End If
		Next
		t.SetLevelOfDetail(0)
	End If
	If metric(6)>0 Then
		Set t=FinishTopic.AddSubTopic(metric(6) & " actions are past hard deadline")
		If numoverdue>0 Then t.TextColor.SetARGB(255,255,0,0)
		For Each tt In DeadlinesDoc.Range(mmRangeAllTopics)
			If isred(tt) And tt.Task.Complete<100 And tt.Task.Complete>=0 Then t.AddSubTopic("").Xml=tt.Xml
		Next
		t.SetLevelOfDetail(0)
	End If

	If metric(8)>0 Then
		Set t=FinishTopic.AddSubTopic(metric(8) & " next actions are past target")
		If numoverdue>0 Then t.TextColor.SetARGB(255,255,0,0)
		For Each tt In NextActionDoc.Range(mmRangeAllTopics)
			'don't enumerate an item from an overdue project
			If isred(tt) Then
			  If Not tt.IsCalloutTopic Then
			  	If Not tt.Icons.HasStockIcon(mmStockIconExclamationMark) And Not tt.IsCentralTopic Then
			  	 	If tt.CalloutTopics.Count>0 Then
			  			If Not (tt.CalloutTopics.Item(1).Task.DueDate>0 And tt.CalloutTopics.Item(1).Task.DueDate < Now) Then
			  				t.AddSubTopic("").Xml=tt.Xml
			  			End If
			  		End If
			  	End If
			  End If
			End If
		Next
		t.SetLevelOfDetail(0)
	End If
    If metric(7)>0 Then
		Set t=FinishTopic.AddSubTopic(metric(7)	 & " things you are waiting for are overdue")
		If numoverduewaiting>0 Then
			t.TextColor.SetARGB(255,255,0,0)
		Else
			t.Delete
		End If
		For Each tt In RelationshipDoc.Range(mmRangeAllTopics)
			If isred(tt) Then
				If parentcontains(tt,"waiting") Then
					t.AddSubTopic("").Xml = tt.Xml
				End If
			End If
		Next
		t.SetLevelOfDetail(0)
	End If

	Set t = FinishTopic.AddSubTopic("Targeted for Today or tomorrow")
	For i =1 To numactions
		If allactions(i).Task.DueDate=Date Or allactions(i).Task.DueDate=Date+1Then
			t.AddSubTopic("").Xml = nextactionxml(i)
		ElseIf allactions(i).AllCalloutTopics.Count > 0 Then
			If allactions(i).AllCalloutTopics.Item(1).Task.DueDate=Date Or allactions(i).AllCalloutTopics.Item(1).Task.DueDate=Date+1 Then
				t.AddSubTopic("").Xml= nextactionxml(i)
			End If
		End If
	Next
	t.SetLevelOfDetail(0)
	Set t=FinishTopic.AddSubTopic(pct_complete  & " percent complete overall so far")

	If numwaiting>0 Then
		Set t = FinishTopic.AddSubTopic("Waiting for " & numwaiting & " tasks with no target date")
	End If
	For Each tt In RelationshipDoc.CentralTopic.AllSubTopics
		For Each ttt In tt.AllSubTopics
			If InStr(ttt.Text,"waiting")>0 Then
				Set persontopic = t.AddSubTopic(tt.Text)
				For Each tttt In ttt.AllSubTopics
					If tttt.Task.DueDate<=0 Then
						If tttt.CalloutTopics.Count>0 Then
						 	If tttt.CalloutTopics.Item(1).Task.DueDate<=0 Then
								persontopic.AddSubTopic("").Xml=tttt.Xml
							End If
						End If
					End If
				Next
				If persontopic.AllSubTopics.Count=0 Then persontopic.Delete
			End If
		Next
	Next
	t.SetLevelOfDetail(0)

 '----FORESIGHT--------------------------------------------------------------------------------------------------------------------------
	deltopic.AddSubTopic(" * Foresight")
	Set nocontextactions = ForesightTopic.AddSubTopic(Round(metric(9)) & " of your next actions do not have a context")
	If metric(9)=0 Then
		nocontextactions.Delete
	Else
		If numactions>0 Then
			If  numnocontext/numactions>0.2 Then nocontextactions.TextColor.SetARGB(255,255,0,0)
		End If
		If numnocontext>0 Then
			For Each t In NoContextDoc.CentralTopic.AllSubTopics
				nocontextactions.AddSubTopic("").Xml = t.Xml
			Next
		End If
		nocontextactions.SetLevelOfDetail(0)
	End If
	If numNoEstimate>0 Then
		Set timecategories = ForesightTopic.AddSubTopic("tasks by time (" & numNoEstimate & " need estimates)")
	Else
		Set timecategories = ForesightTopic.AddSubTopic("tasks by time")
	End If
	Set noest = timecategories.AddSubTopic("no time estimate")
	Set c2m = timecategories.AddSubTopic("2m")
	Set c15m = timecategories.AddSubTopic("15m")
	Set c1h = timecategories.AddSubTopic("1h")
	Set c2h = timecategories.AddSubTopic("2h")
	For i = 1 To numactions
		If InStr(nextactioncat(i),"2m")>0 Then
			c2m.AddSubTopic("").Xml= nextactionxml(i)
		ElseIf InStr(nextactioncat(i),"15m")>0 Then
			c15m.AddSubTopic("").Xml= nextactionxml(i)
		ElseIf InStr(nextactioncat(i),"1h")>0 Then
			c1h.AddSubTopic("").Xml= nextactionxml(i)
		ElseIf InStr(nextactioncat(i),"2h")>0 Then
			c2h.AddSubTopic("").Xml= nextactionxml(i)
		Else
			noest.AddSubTopic("").Xml= nextactionxml(i)
		End If
	Next
	For Each t In timecategories.AllSubTopics
		If t.AllSubTopics.Count=0 Then t.Delete
	Next
	'gather up in-tray items
	Dim intrayitems
	Set intrayitems=ForesightTopic.AddSubTopic("Items in Intrays")
	For Each t In NextActionDoc.Range(mmRangeAllTopics)
		If Not t.IsCalloutTopic And t.Task.IsValid  Then
			If t.Task.StartDate>0 And t.Task.Complete<100 Then
				If InStr(LCase(t.CalloutTopics(True).Item(1).Text),"in-tray")>0 Then
					intrayitems.AddSubTopic("").Xml = t.Xml
		       	End If
	       	End If
	     End If
	Next
	Set intrayitems = Nothing
'---FRESHNESS-----------------------------------------------------------------------------------------------------------------------
	deltopic.AddSubTopic(" * Freshness")
	Set t=FreshnessTopic.AddSubTopic("Your " & numdatedactions & " dated next actions average " & Round(avgage) & " days old" )
	If avgage>40 Then	t.Text = t.Text & "!"
	If avgage>40 Then	t.TextColor.SetARGB(255,255,0,0)

	Set t=FreshnessTopic.AddSubTopic("They have been around for a grand total of " & Round(numdatedactions*avgage/365,1) & " years")
	If numdatedactions*avgage/365 > 7 Then t.Text=t.Text & "!"
	If numdatedactions*avgage/365 > 7 Then t.TextColor.SetARGB(255,255,0,0)
	Set t=FreshnessTopic.AddSubTopic("Your oldest in-tray item is " & oldestintrayage & " days old")
	If Not oldestintrayitemxml="" Then
		Set dummy=t.AddSubTopic("")
		dummy.Xml=oldestintrayitemxml
		Debug.Print t.Task.DueDate
	End If

	On Error Resume Next
	If numactions>0 Then
		Set t = reporttopic.AddSubTopic("Random Activities for the Day:")
		t.AddSubTopic("").Xml=actions(Round(Rnd*(numactions-1))+1).Xml
		t.AddSubTopic("").Xml=actions(Round(Rnd*(numactions-1))+1).Xml
		t.AddSubTopic("").Xml=actions(Round(Rnd*(numactions-1))+1).Xml
	End If
	On Error GoTo 0
	If numdatedactions>0 Then
		Set t = FreshnessTopic.AddSubTopic("Oldest Next Actions")
		If 0.1*numdatedactions>1 Then
			For i=1 To Round(0.1*numdatedactions)
				t.AddSubTopic(Str(age(i))).AddSubTopic("").Xml= actions(i).Xml
			Next
		End If
		t.SetLevelOfDetail(0)
		Set t=FreshnessTopic.AddSubTopic("Youngest Next Actions")
		If 0.9*numdatedactions>1 Then
			For i= Round(0.9*numdatedactions) To numdatedactions
				t.AddSubTopic(Str(age(i))).AddSubTopic("").Xml= actions(i).Xml
			Next
		End If
		t.SetLevelOfDetail(0)
		Set t=FreshnessTopic.AddSubTopic("Undated Next Actions")
		If numactions>0 Then
			For i =1 To numactions
				If allactions(i).Task.StartDate<=0 Then t.AddSubTopic("").Xml = allactions(i).Xml
			Next
		End If
		t.SetLevelOfDetail(0)
	End If
	If Not oldcontexttopic Is Nothing Then
		Set t = FreshnessTopic.AddSubTopic("Items in your " & oldcontexttopic.Text & " average " & Round(oldavg) & " days old")
		For Each tt In oldcontexttopic.AllSubTopics
			t.AddSubTopic("").Xml = tt.Xml
		Next
	End If
	t.SetLevelOfDetail(0)




'---Focus----------------------------------------------------------------------------------------------------------------
	deltopic.AddSubTopic(" * Focus")
	Set t=FocusTopic.AddSubTopic("You are trying to advance " & Str(numprojects) & " projects and Sub-projects this week")
	If numprojects>50 Then t.Text=t.Text & "!"
	If numprojects>50 Then t.TextColor.SetARGB(255,255,0,0)

	FocusTopic.AddSubTopic("Your next actions are derived from " & nummaps & " maps")
	FocusTopic.AddSubTopic(Str(DueInSeven) & " of your next actions are targeted for completion in next 7 days")
	If metric(11)>0 Then Set t=FocusTopic.AddSubTopic(Round(metric(11)*100,0) & "% of your main projects have not been prioritized.")
	If numnopriorityprojects>0 Then
		For i=1 To numprojects
			If  isproject(i) And projectpriority(i)=0 Then t.AddSubTopic("").Xml = projectxml(i)
		Next
		t.SetLevelOfDetail(0)
	End If
	If numneednextaction> 0 Then
		Set neednextaction = ForesightTopic.AddSubTopic(numneednextaction & " committed projects need next actions")
		If NoActionDoc.CentralTopic.AllSubTopics.Count>0 Then
			For Each t In NoActionDoc.CentralTopic.AllSubTopics
				neednextaction.AddSubTopic("").Xml = t.Xml
			Next
			neednextaction.TextColor.SetARGB(255,255,0,0)
		End If
	End If
	Set taskprioritytopic= FocusTopic.AddSubTopic("tasks by priority")
	For i=2 To 5
		Set ptopic(i)=taskprioritytopic.AddSubTopic(Str(i-1))
	Next
	Set ptopic(1)=taskprioritytopic.AddSubTopic("Unprioritized")
	For i =1 To 5
		For j=1 To numactions
			If nextactionpriority(j)=(i-1) Then
				ptopic(i).AddSubTopic("").Xml=nextactionxml(j)
			End If
		Next
	Next
    taskprioritytopic.SetLevelOfDetail(0)
    For i =1 To 5
     	ptopic(i).SetLevelOfDetail(0)
    Next
	ForesightTopic.SetLevelOfDetail(1)
	If numactions>0 Then
		If  numnocontext/numactions>0.2 Then nocontextactions.TextColor.SetARGB(255,255,0,0)
	End If

	If numprojects>0 Then
		Set t=FocusTopic.AddSubTopic(Round(numdatedprojects/numprojects*100,0) & "% of projects/sub-projects have target dates")
		If numdatedprojects/numprojects<0.50 Then t.Text = "Only " & t.Text & "!"
		If numdatedprojects/numprojects<0.50 Then t.TextColor.SetARGB(255,255,0,0)
	End If
	Set datedprojects  		=t.AddSubTopic("Target Date Projects")
	Set undatedprojects = t.AddSubTopic("Undated Projects")
	Set undatedsubprojects	=t.AddSubTopic("Undated Sub-Projects")

	If numareas>0 Then
		Set t=FocusTopic.AddSubTopic("Tasks by Area")
		For i=1 To numareas
			Set tt=t.AddSubTopic(area(i))
			If area(i)="" Then tt.Text="undefined"
			For k=0 To 4
				Set ttt=tt.AddSubTopic(Str(k))
				If k=0 Then ttt.Text="No Priority"
				For j=1 To numactions
					If LCase(taskarea(j))=LCase(area(i)) And nextactionpriority(j)= k Then
						ttt.AddSubTopic("").Xml = nextactionxml(j)
					End If
				Next
				If ttt.AllSubTopics.Count=0 Then ttt.Delete
			Next
		Next
		For Each tt In t.AllSubTopics
			cnt=0
			For Each ttt In tt.AllSubTopics
				cnt=cnt+ttt.AllSubTopics.Count
			Next
			If numactions>0 Then
				tt.Text=tt.Text & " (" & LTrim(Str(Round(cnt/numactions*100,0))) & "%)"
			End If
			tt.SetLevelOfDetail(0)
			If tt.AllSubTopics.Count=0 Then tt.Delete
		Next
		t.SetLevelOfDetail(0)
		Set t=FocusTopic.AddSubTopic("Projects by Area")
		For i=1 To numareas
			Set tt=t.AddSubTopic(area(i))
			If area(i)="" Then tt.Text="undefined"
			For k=0 To 4
				Set ttt=tt.AddSubTopic(Str(k))
				If k=0 Then ttt.Text="No Priority"
				For j=1 To numprojects
					If LCase(projectarea(j))=LCase(area(i)) And projectpriority(j)=k Then
						ttt.AddSubTopic("").Xml = projectxml(j)
					End If
				Next
				If ttt.AllSubTopics.Count=0 Then ttt.Delete
			Next
		Next
			For Each tt In t.AllSubTopics
				cnt=0
				For Each ttt In tt.AllSubTopics
					cnt=cnt+ttt.AllSubTopics.Count
				Next
				If numprojects>0 Then
					tt.Text=tt.Text & " (" & LTrim(Str(Round(cnt/numprojects*100,0))) & "%)"
				End If
				tt.SetLevelOfDetail(0)
				If tt.AllSubTopics.Count=0 Then tt.Delete
			Next
		t.SetLevelOfDetail(0)
	End If


	For j=0 To 9
		For i=1 To numprojects
			If projectpriority(i)=j Then
				If projectdated(i) Then
					datedprojects.AddSubTopic("").Xml=projectxml(i)
				Else
					If isproject(i) Then
						undatedprojects.AddSubTopic("").Xml=projectxml(i)
					Else
						undatedsubprojects.AddSubTopic("").Xml=projectxml(i)
					End If
				End If
			End If
		Next
	Next
	addtolog = True
	If logprompt Then
		addtolog=MsgBox("Do you want to save your scores to the log?",vbYesNo)=vbYes
	End If
	If addtolog Then
		deltopic.AddSubTopic("Updating Log map")
		On Error Resume Next
		Set LogDoc = getmap(logdocname)
		On Error GoTo 0
		If Not LogDoc Is Nothing Then
			LogDoc.CentralTopic.Notes.Text=LogDoc.CentralTopic.Notes.Text & vbCrLf & Now & "," &  Str(Round(rating*10,2))

			For i=1 To 12
				LogDoc.CentralTopic.Notes.Text=LogDoc.CentralTopic.Notes.Text & "," & Str(Round(ratings(i)*10,2))
				Set t = createmainbranch(mname(i),LogDoc)
				t.Notes.Text=t.Notes.Text & vbCrLf & Now & "," &  Str(Round(metric(i),2))
			Next
			Set t=createmainbranch("Overall Score",LogDoc)
			t.Notes.Text=t.Notes.Text & vbCrLf & Now & "," &  Str(Round(rating,2))
			LogDoc.SaveAs(GetPath(mmDirectoryMyMaps) & logdocname)
			LogDoc.Close
			Set LogDoc=Nothing
		End If
	End If
	datedprojects.SetLevelOfDetail(0)
	undatedprojects.SetLevelOfDetail(0)
	undatedsubprojects.SetLevelOfDetail(0)
	FeasibilityTopic.SetLevelOfDetail(1)


	'For Each t In reporttopic.AllSubTopics
'		If t.AllSubTopics.Count=0 Then t.Delete
'	Next
	If showadvice Then
		If Not askadvice Then
			'Set ie = CreateObject("InternetExplorer.Application")
	        'ie.Visible = True
	        'ie.navigate hlink(firstitem)
	        'Set ie=Nothing
	        On Error Resume Next
	        AdviceTopic1.Hyperlink.Follow
	        On Error GoTo 0
	    ElseIf MsgBox("Do you want web advice on improving your score?",vbYesNo)=vbYes Then
			'Set ie = CreateObject("InternetExplorer.Application")
	        'ie.Visible = True
	        'ie.navigate hlink(firstitem)
	        'Set ie=Nothing
	        AdviceTopic1.Hyperlink.Follow
	    End If
    End  If
    On Error Resume Next
	deltopic.AddSubTopic("Closing temporary files")
	NextActionDoc.Close
	NoContextDoc.Close
	NoActionDoc.Close
	DeadlinesDoc.Close
	RelationshipDoc.Close
	deltopic.AddSubTopic("Cleaning Up")
	Set NextActionDoc= Nothing
	Set NoContextDoc = Nothing
	Set NoActionDoc = Nothing
	Set RelationshipDoc = Nothing
	For i=1 To 500
		Set actions(i)=Nothing
		Set allactions(i)=Nothing
	Next
	Set t=Nothing
	Set tt=Nothing
	Set ttt=Nothing
	Set tttt=Nothing
	Set persontopic=Nothing
	Set AdviceTopic=Nothing
	Set swap = Nothing
	Set deltopic=Nothing
	reportdoc.Close
	Set reportdoc = Nothing
	Set reporttopic=Nothing
	Set oldcontexttopic = Nothing
	Set c15m =Nothing
	Set c1h = Nothing
	Set c2h = Nothing
	For i=1 To 5
		Set ptopic(i)=Nothing
	Next
	Set taskprioritytopic = Nothing
	'IntrayDoc.Close
	dashboard.Activate
	Set dashboard=Nothing

End Sub
Function score(value As Variant, goal As Double, half As Double,weight As Double) As Double
	If value<=goal Then
			score =weight
	ElseIf value <half Then
 		score =weight * (0.5+ 0.5* Cos((value-goal)/(goal-half)*0.5*3.1416))
 	Else
		score=weight * 0.5 * 1/Exp(-(value-half)/(goal-half))
	End If
	If score <0 Then score =0
End Function
Sub Upgrade(ByRef ConfigDoc As Document)
	Dim a As Topic
	Dim lastupgrade As String
	Dim RunUpgrade As Boolean
	Const currentversion="20090109"
	lastupgrade = getoption("lastupgrade",ConfigDoc)
	If lastupgrade="" Then
		RunUpgrade=True
	ElseIf Eval(lastupgrade) < currentversion Then 'do not want to eval("")
		RunUpgrade=True
	End If
	If RunUpgrade Then
		'OPTIONS-----------------------------------------------------------
			Const showadvice = True 'set this to false if you don't want to be prompted for advice.
	Const askadvice = False  'set this to false if you want to show advice automatically without being prompted.
	Const logprompt = False 'prompt before saving score to log
		createoption "showadvice", "0", ConfigDoc
		createoption "askadvice", "0", ConfigDoc
		createoption "logprompt", "0", ConfigDoc
		createoption "lastversioncheck",     Str(Date),    ConfigDoc
		createoption "versioncheckfrequency",     "30",    ConfigDoc
		createoption "checkempty", "0", ConfigDoc
		createoption "logdocname", "AO\NAAlog.mmap", ConfigDoc
		checkforduplicates(ConfigDoc)
		'Mark map as upgraded
		setoption "lastupgrade", currentversion, ConfigDoc
		If ConfigDoc.IsModified Then ConfigDoc.Save
		Set a=Nothing
	End If
End Sub
Function getdashboardarea(ByRef t As Topic) As String
	If Len(getfirstarea(t))>0 Then
						getdashboardarea=getfirstarea(t)
					Else
						If t.CalloutTopics.Count>0 Then
							getdashboardarea=getfirstarea(t.CalloutTopics.Item(1))
						Else
							getdashboardarea=""
						End If
					End If
					If getdashboardarea="" And t.CalloutTopics.Count>0 Then
						If t.CalloutTopics.Item(1).CalloutTopics.Count>0 Then
							If t.CalloutTopics.Item(1).CalloutTopics.Item(1).Task.Complete<100 Then
								getdashboardarea=getfirstarea(t.CalloutTopics.Item(1).CalloutTopics.Item(1))
							End If
						End If
					End If
End Function