Example Product Rule - LOI Calculation

Scenario: The total LOI is calculated. Total oxides are calculated if XRF results are available, and results emailed.

Sub Main()

'Loss Of Ignition Calculation

Dim dWt1, dWt2, dWt3, dWt4, dWt5, dWt6

Dim dLOI, dLOI105, dLOI371, dLOI538, dLOI900

'Set up some defaults for testing purposes

'Current.Pro_Job = "JOB2"

'Current.Cuid = "0000033736"

'Current.Sampleident = "JOB2 0001"

'Current.Sampletype ="UNK"

'Current.Sch_Code = "LOI"

'Current.AnalyteCode = "WT1"

'Current.ProductCode ="GEN_XRF"

Set oSupport = CreateObject("CCSUPP01.clsSupport")

'Save the record set, using BatchUpdate = True,

'indicating there is more to save for this Cuid

clsBDProfjob.BatchUpdate = True

'Ensure WT1 (weight of Cruc) is done

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "WT1"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dWt1 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'Ensure WT2 (weight of Cruc+Sample) is done

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "WT2"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dWt2 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'Ensure that WT3 (weight of Cruc+Sample post105.C) is done

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "WT3"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dWt3 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'See if LOI105 already calculated

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "LOI105"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dLOI105 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

Else

dLOI105 = (dWt2 - dWt3) / (dWt2 - dWt1) * 100.0

'Update LOI105 for the current Cuid

ProfjobCuidSchemeAnalyte.Analytestatus ="CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dLOI105

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dLOI105)

'Save the record set, using BatchUpdate = True,

'indicating there is more to save for this Cuid

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

End If

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "WT4"

If clsBDProfjob.FoundProfjobSchemeAnalyte Then

'WT4 profiled indicates that a 4 temperature LOI is to be calculated

'Ensure WT4 (weight of Cruc+Sample post371.C) is done

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "WT4"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dWt4 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'See if LOI371 already calculated

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "LOI371"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dLOI371 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

Else

dLOI371 = (dWt3 - dWt4) / (dWt3 - dWt1) * 100.0

'Update LOI371 for the current Cuid

ProfjobCuidSchemeAnalyte.Analytestatus ="CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dLOI371

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dLOI371)

'Save the record set, using BatchUpdate = True,

'indicating there is more to save for this Cuid

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

End If

'Ensure WT5 (weight of Cruc+Sample post538.C) is done

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "WT5"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dWt5 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'See if LOI538 already calculated

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "LOI538"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dLOI538 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

Else

dLOI538 = (dWt4 - dWt5) / (dWt3 - dWt1) * 100.0

'Update LOI538 for the current Cuid

ProfjobCuidSchemeAnalyte.Analytestatus ="CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dLOI538

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dLOI538)

'Save the record set, using BatchUpdate = True,

'indicating there is more to save for this Cuid

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

End If

'Ensure WT6 (weight of Cruc+Sample post900.C) is done

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "WT6"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dWt6 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'See if LOI900 already calculated

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "LOI900"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dLOI900 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

Else

dLOI900 = (dWt5 - dWt6) / (dWt3 - dWt1) * 100.0

'Update LOI900 for the current Cuid

ProfjobCuidSchemeAnalyte.Analytestatus ="CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dLOI900

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dLOI900)

'Save the record set, using BatchUpdate = True,

'indicating there is more to save for this Cuid

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

End If

'Calculate LOI

dLOI = dLOI371 + dLOI538 + dLOI900

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "LOI"

'Update LOI for the current Cuid

ProfjobCuidSchemeAnalyte.Analytestatus ="CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dLOI

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dLOI)

'Save the record set, using BatchUpdate = False,

'indicating there is no more to save for this Cuid + Sch + Anal

clsBDProfjob.BatchUpdate = False

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

'If XRF Fe is done, calculate Total

If clsBDProfjob.PopulateByCuid (Current.Cuid, "XRF", "FE") Then

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

CalcTotal

Else

Msgbox "XRF not available - no totals calculated", vbOKOnly, "LOI"

End If

Else

'Only a 2 temperature LOI is to be calculated

'See if LOI900 already calculated

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "LOI900"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dLOI900 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

Else

dLOI900 = (dWt3 - dWt6) / (dWt3 - dWt1) * 100.0

ProfjobCuidSchemeAnalyte.Analytestatus ="CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dLOI900

ProfjobCuidSchemeAnalyte.Finalvalue = cStr(dLOI900)

'Save the record set, using BatchUpdate = True,

'indicating there is more to save for this Cuid

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

End If

'Calculate LOI

dLOI = dLOI900

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "LOI"

'Update LOI for the current Cuid

ProfjobCuidSchemeAnalyte.Analytestatus ="CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dLOI

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dLOI)

'Save the record set, using BatchUpdate = False,

'indicating there is no more to save for this Cuid

clsBDProfjob.BatchUpdate = False

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

'If XRF Fe is done, calculate Total

If clsBDProfjob.PopulateByCuid (Current.Cuid, "XRF", "FE") Then

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

CalcTotal

Else

Msgbox "XRF not available - no totals calculated", vbOKOnly, "LOI"

End If

End Sub

Sub CalcTotal ()

'Calculation of Total oxides with LOI

Dim dTotal

Set oSupport = CreateObject("CCSUPP01.clsSupport")

'Save the record set, using BatchUpdate = True,

'indicating there is more to save for this Cuid

clsBDProfjob.BatchUpdate = True

'Get LOI-LOI

clsBDProfjob.PopulateByCuid Current.Cuid, "LOI", "LOI"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dTotal = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'Get XRF-Fe2O3,SiO2,Al2O3,TiO2,MnO,CaO,S,P2O5,MgO

If clsBDProfjob.PopulateByCuid (Current.Cuid, "XRF", "FE2O3") Then

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "SIO2"

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "AL2O3"

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "TIO2"

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "MNO"

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "CAO"

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "S"

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "P2O5"

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "MGO"

dTotal = dTotal + oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'Update the calculated Total for the current Cuid

clsBDProfjob.PopulateByCuid Current.Cuid, "XRF", "TOTAL"

ProfjobCuidSchemeAnalyte.Analytestatus ="CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dTotal

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dTotal)

'Save the record set, using BatchUpdate = False,

'indicating there is no more to save for this Cuid

clsBDProfjob.BatchUpdate = False

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

'Send message with Total details

SendEmail "Lab manager", "XRF Totals", "Cuid" & vbTab & Current.Cuid & vbCrLf & _

"Job" & vbTab & Current.Pro_Job & vbCrLf & _

"Sample" & vbTab & Current.Sampleident & vbCrLf & _

"Total = " & ProfjobCuidSchemeAnalyte.Finalvalue, _

"labmgr@company.com", ""

End If

End Sub

Sub SendEmail ( sProfile, sSubject, sMessage, sRecipient, sAttach )

Dim oEmail

Set oEmail = New clsEmail

With oEmail

.Session = sProfile

.Subject = sSubject

.Text = sMessage

.Recipient = sRecipient

.Attach = sAttach

If Msgbox ("OK to send to " & .Recipient & vbCrLf & sSubject, 4 + 48, "Email" ) = 6 Then

.Send

End If

End With

Set oEmail = Nothing

End Sub

Class clsEmail

'Simple Email Class

Private msSession, msSubject, msText, msRecipient, msAttach

Property Let Session (sSession)

msSession = sSession

End Property

Property Let Subject (sSubject)

msSubject = sSubject

End Property

Property Let Text (sText)

msText = sText

End Property

Property Let Recipient (sRecipient)

msRecipient = sRecipient

End Property

Property Let Attach (sAttach)

msAttach = sAttach

End Property

Property Get Session ()

Session = msSession

End Property

Property Get Subject ()

Subject = msSubject

End Property

Property Get Text ()

Text = msText

End Property

Property Get Recipient ()

Recipient = msRecipient

End Property

Property Get Attach ()

Attach = msAttach

End Property

Sub Send ()

'Send the email

Dim oSession, oMessage, oRecipient, oAttach

Set oSession = CreateObject ("MAPI.Session")

oSession.Logon msSession

Set oMessage = oSession.Outbox.Messages.Add

oMessage.Subject = msSubject

oMessage.Text = msText

If msAttach <> "" Then

Set oAttach = oMessage.Attachments.Add

oAttach.Source = msAttach

End If

Set oRecipient = oMessage.Recipients.Add

oRecipient.Name = msRecipient

oRecipient.Resolve

oMessage.Update

oMessage.Send

oSession.Logoff

set oAttach = Nothing

set oMessage = Nothing

set oRecipient = Nothing

set oSession = Nothing

End Sub

End Class