Option Explicit
Dim bCompleted
Dim bHasErrors
Dim App

Call Main()
If bCompleted = True Then
	If bHasErrors Then
		MsgBox "IdentifyBadDonationDonors Completed - Errors Were Detected / Displayed"
	Else
		MsgBox "IdentifyBadDonationDonors Completed Successfully - No Errors Detected"
	End If
Else
	MsgBox "IdentifyBadDonationDonors Could Not Be Completed"
End If

Sub Main()

	Dim key

	bCompleted = False
	bHasErrors = False
	
	MsgBox "If GiftWorks 2015 is already running, please click 'OK'.  If not, please start it now and log into your database, then click 'OK'."
	set App = CreateObject("missionresearch.giftworks.9")
	If App Is Nothing Then
		msgbox "GiftWorks 2015 must be running to apply this script."
	Else
		If Not App.Security.SignedIn Then
			msgbox "You must be signed in to a GiftWorks 2015 database to apply this script."
		Else
			Call CheckNullTransactionIDs()
			Call CheckNullPaymentIDs()
			Call CheckNullPaymentOnTransactions()
			Call CheckTransactionSums()
			Call CheckInvalidMatchIDs()
			Call CheckInvalidMultipleFundPayments()
			Call CheckTransactionSums2()
			Call CheckTransactioFunds()
			bCompleted = True
		End If
	End If
	App.Shell.SetStatusText " "

End Sub

Sub CheckNullTransactionIDs()

	Dim rs
	Dim out
	Dim bShowMessage

	bShowMessage = False
	App.Shell.SetStatusText "Checking for null payment IDs on gifts"
	Set rs = App.Document.GetDataset("SELECT display FROM donor_donors WHERE id IN (SELECT donorid from donor_gifts WHERE id IN (SELECT giftid from donor_gifts_payments LEFT OUTER JOIN donor_gifts_payments_transactions ON donor_gifts_payments.Id = donor_gifts_payments_transactions.FKPayment WHERE donor_gifts_payments_transactions.Id is null))")

	Do while not rs.eof
		out = out & rs.fields(0) & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	If bShowMessage Then
		App.Shell.Msgbox "The following donors have payments with NULL transaction IDs:" & vbcrlf & vbcrlf & out
	End If
	
End Sub

Sub CheckNullPaymentIDs()

	Dim sdate
	Dim rs
	Dim out
	Dim bShowMessage

	bShowMessage = False
	App.Shell.SetStatusText "Checking for null payment IDs"
'	Set rs = App.Document.GetDataset("SELECT display, id FROM donor_donors WHERE id IN (SELECT donorid from donor_gifts WHERE id IN (SELECT giftid FROM donor_gifts_payments LEFT OUTER JOIN (select FKPayment FROM donor_gifts_payments_transactions  WHERE active=true) T1 ON T1.FKPayment = donor_gifts_payments.Id WHERE T1.FKPayment Is Null))")

'	Do while not rs.eof
'		out = rs.fields("display") & vbcrlf
'		bShowMessage = True
'		bHasErrors = True
'		rs.movenext
'	Loop

	Set rs = App.Document.GetDataset("SELECT donor_gifts.created, donor_gifts.id, donor_gifts_payments.giftid, donor_donors.display, donor_gifts_payments.expectedDate, donor_gifts_payments.expectedAmount FROM ((donor_gifts_payments LEFT JOIN (select FKPayment FROM donor_gifts_payments_transactions  WHERE NOT active=0)  AS T1 ON donor_gifts_payments.Id = T1.FKPayment) LEFT JOIN donor_gifts ON donor_gifts_payments.giftId = donor_gifts.id) LEFT JOIN donor_donors ON donor_gifts.donorId = donor_donors.id WHERE T1.FKPayment Is Null")

	Do while not rs.eof
		out = out & "Fix donation for " & rs.fields("display") & " for donation on " & rs.fields("expectedDate") & " in the amount of " & rs.fields("expectedAmount") & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	If bShowMessage Then
		App.Shell.Msgbox out
	End If
	
End Sub

Sub CheckNullPaymentOnTransactions()

	Dim rs
	Dim out
	Dim bShowMessage

	bShowMessage = False
	App.Shell.SetStatusText "Checking for null payment IDs on transactions"
	Set rs = App.Document.GetDataset("SELECT expecteddate FROM donor_gifts_payments LEFT OUTER JOIN (select FKPayment FROM donor_gifts_payments_transactions  WHERE NOT active=0) T1 ON T1.FKPayment = donor_gifts_payments.Id WHERE T1.FKPayment Is Null")

	Do while not rs.eof
		out = out & rs.fields(0) & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	If bShowMessage Then
		App.Shell.Msgbox "The following donors have transactions with NULL payment IDs:" & vbcrlf & vbcrlf & out
	End If
	
End Sub

Sub CheckTransactionSums()

	Dim sDate
	Dim rs
	Dim out
	Dim bShowMessage

	bShowMessage = False
	App.Shell.SetStatusText "Checking for incorrect transaction sums"
	Set rs = App.Document.GetDataset("SELECT display, id FROM donor_donors WHERE id IN (SELECT donorid from donor_gifts WHERE id IN (SELECT giftid FROM donor_gifts_payments INNER JOIN (SELECT Sum(amount) as transsum,FKPayment FROM donor_gifts_payments_transactions WHERE NOT active = 0 GROUP  BY FKPayment)  AS T1 ON donor_gifts_payments.Id = T1.FKPayment WHERE (((donor_gifts_payments.actualAmount)<>[T1].[transsum]) AND ((donor_gifts_payments.[actualAmount])>0))))")

	Do while not rs.eof
		out = rs.fields("display") & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	Set rs = App.Document.GetDataset("SELECT created, id from donor_gifts WHERE id IN (SELECT giftid FROM donor_gifts_payments INNER JOIN (SELECT Sum(amount) as transsum,FKPayment FROM donor_gifts_payments_transactions WHERE NOT active = 0 GROUP  BY FKPayment)  AS T1 ON donor_gifts_payments.Id = T1.FKPayment WHERE (((donor_gifts_payments.actualAmount)<>[T1].[transsum]) AND ((donor_gifts_payments.[actualAmount])>0)))")

	Do while not rs.eof
		sdate = rs.fields(0) & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	If bShowMessage Then
		App.Shell.Msgbox "The following donors / gifts have transactions whose sum does not equal the gift / payment amount:" & vbcrlf & vbcrlf & out & "-" & sDate
	End If
	
End Sub

Sub CheckInvalidMatchIDs()

	Dim rs
	Dim out
	Dim bShowMessage

	bShowMessage = False
	App.Shell.SetStatusText "Checking for invalid match IDs"
	Set rs = App.Document.GetDataset("SELECT display, id FROM donor_donors WHERE id IN (SELECT donorid from donor_gifts WHERE id IN (SELECT giftid FROM donor_gifts_payments LEFT OUTER JOIN donor_gifts ON donor_gifts_payments.FKMatch = donor_gifts.Id WHERE donor_gifts.Id is null And donor_gifts_payments.FKMatch > 0))")

	Do while not rs.eof
		out = rs.fields("display") & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	Set rs = App.Document.GetDataset("SELECT created, id from donor_gifts WHERE id IN (SELECT giftid FROM donor_gifts_payments LEFT OUTER JOIN donor_gifts ON donor_gifts_payments.FKMatch = donor_gifts.Id WHERE donor_gifts.Id is null And donor_gifts_payments.FKMatch > 0)")

	Do while not rs.eof
		sdate = rs.fields(0) & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	If bShowMessage Then
		App.Shell.Msgbox "The following donors have gifts / payments with invalid match IDs:" & vbcrlf & vbcrlf & out & "-" & sDate
	End If
	
End Sub

Sub CheckInvalidMultipleFundPayments()

	Dim rs
	Dim out
	Dim bShowMessage
	Dim sdate

	bShowMessage = False
	App.Shell.SetStatusText "Checking payment fund IDs with multiple funds selected"
	Set rs = App.Document.GetDataset("SELECT display, id FROM donor_donors WHERE id IN (SELECT donorid from donor_gifts WHERE id IN (SELECT giftid FROM donor_gifts_payments INNER JOIN  (SELECT COUNT(*) as transcount,fkPayment FROM donor_gifts_payments_transactions WHERE NOT active=0 GROUP BY fkpayment) T1 ON T1.FKPayment = donor_gifts_payments.Id WHERE T1.transcount > 1 AND donor_gifts_payments.FKFund <> 1000))")

	Do while not rs.eof
		out = rs.fields("display") & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	Set rs = App.Document.GetDataset("SELECT created, id from donor_gifts WHERE id IN (SELECT giftid FROM donor_gifts_payments INNER JOIN  (SELECT COUNT(*) as transcount,fkPayment FROM donor_gifts_payments_transactions WHERE NOT active=0 GROUP BY fkpayment) T1 ON T1.FKPayment = donor_gifts_payments.Id WHERE T1.transcount > 1 AND donor_gifts_payments.FKFund <> 1000)")

	Do while not rs.eof
		sdate = rs.fields(0) & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	If bShowMessage Then
		App.Shell.Msgbox "The following donors have incorrect payment fund IDs with multiple funds selected:" & vbcrlf & vbcrlf & out & "-" & sDate
	End If
	
End Sub

Sub CheckTransactionSums2()

	Dim rs
	Dim out
	Dim bShowMessage

	bShowMessage = False
	App.Shell.SetStatusText "Checking for incorrect transaction sums (detail)"
	Set rs = App.Document.GetDataset("SELECT donor_donors.Display, donor_gifts_payments.actualDate, donor_gifts_payments.expectedAmount FROM donor_donors INNER JOIN (donor_gifts INNER JOIN (donor_gifts_payments INNER JOIN (SELECT Sum(amount) as transsum,FKPayment FROM donor_gifts_payments_transactions WHERE NOT active = 0 GROUP BY FKPayment)  AS T1 ON donor_gifts_payments.Id = T1.FKPayment) ON donor_gifts.id = donor_gifts_payments.giftId) ON donor_donors.id = donor_gifts.donorId WHERE (((donor_gifts_payments.actualAmount)<>[T1].[transsum]) AND ((donor_gifts_payments.[actualAmount])>0))")

	Do while not rs.eof
		out = out & rs.fields(0) & vbtab & vbtab & rs.fields(1) & vbtab & vbtab & rs.fields(2) & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop

	If bShowMessage Then
		App.Shell.Msgbox "The following are details of gifts / payments with incorrect transaction sums:" & vbcrlf & vbcrlf & out
	End If
	
End Sub

Sub CheckTransactioFunds()
	Dim rs
	Dim out
	Dim bShowMessage

	bShowMessage = False
	App.Shell.SetStatusText "Checking for invalid match IDs"
	Set rs = App.Document.GetDataset("select display,donor_gifts.created from donor_gifts inner join donor_donors on donor_gifts.donorid=donor_donors.id WHERE donor_gifts.id IN (SELECT giftid FROM donor_gifts_payments INNER JOIN donor_gifts_payments_transactions ON donor_gifts_payments_transactions.FKPayment = donor_gifts_payments.Id WHERE NOT donor_gifts_payments_transactions.active = 0 AND NOT IsDate(donor_gifts_payments.actualDate)=0 AND donor_gifts_payments.FKFund <> 1000 AND donor_gifts_payments_transactions.FKFund <> donor_gifts_payments.FKFund)",1,3)

	Do while not rs.eof
		out = out & rs.fields("display") & " -- " & rs.fields("created") & vbcrlf
		bShowMessage = True
		bHasErrors = True
		rs.movenext
	Loop


	If bShowMessage Then
		App.Shell.Msgbox "The following donors have gifts / payments with invalid transactions:" & vbcrlf & vbcrlf & out
	End If

End Sub