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
End If
End If
End If
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 If
End If
End If
End If
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 If
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
