Example Product Rule - XRF Calculations
Scenario: XRF corrections are performed. Total LOI and total oxides calculated if LOI results are available, and the results sent to and SPC file.
Sub Main()
'XRF Corrections Procedure
Dim iNoElems
Dim dT1, dT2, dXFlux, dXSamp, dCorr
Dim dFeX, dFe_XRF, dFe2O3, dFe
Dim dSiO2, dAlsO3, dTiO2, DMn, dMnO, dCaO, dS, SO3, dP, dP2O5, dMgO
Dim dLOI, dTotal, dDiff
Dim sSPCRecord
Dim oSupport, oFileSystem, oTextFile
Const ForAppending = 8
'Set up some defaults for testing purposes
'Current.Pro_Job = "JOB2"
'Current.Cuid = "0000033736"
'Current.Sampleident = "JOB2 0001"
'Current.Sampletype ="UNK"
'Current.Sch_Code = "XRF"
'Current.AnalyteCode = "FEX"
'Current.ProductCode ="GEN_XRF"
Set oSupport = CreateObject("CCSUPP01.clsSupport")
'Ensure XRF-Fe has been analysed
If clsBDProfjob.PopulateByCuid (Current.Cuid, Current.Sch_Code, "FEX") Then
If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then
dFeX = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)
dT1 = 5.4
dT2 = 0.6
If clsBDProfjob.PopulateByCuid (Current.Cuid, "XRFPRP", "XFLUX") Then
dXFlux = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)
If dXFlux < 0.0 Then
dXFlux = dT1
End If
Else
dXFlux = dT1
End If
If clsBDProfjob.PopulateByCuid (Current.Cuid, "XRFPRP", "XSAMP") Then
dXSamp = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)
If dXSamp < 0.0 Then
dXSamp = dT2
End If
Else
dXSamp = dT2
End If
'Get the H2O moisture result and determine the correction factor
If clsBDProfjob.PopulateByCuid (Current.Cuid, Current.Sch_Code, "H2O") Then
dH2O = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)
If dH2O < 0.0 Then
dCorr = (dXFlux / dT1) * (dT2 / dXSamp)
Else
dCorr = (dXFlux / dT1) * (dT2 / dXSamp) * (100 + dH2O) / 100.0
End If
Else
dCorr = (dXFlux / dT1) * (dT2 / dXSamp)
End If
'Do the corrections
'Set BatchUpdate = True so that the record set is not written to the database
'until all data for the current record set is updated
clsBDProfjob.BatchUpdate = True
dFe_XRF = dFeX * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "FE_XRF"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dFe_XRF
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dFe_XRF)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "FE2O3X"
dFe2O3 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "FE2O3"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dFe2O3
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dFe2O3)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "SIO2X"
dSiO2 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "SIO2"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dSiO2
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dSiO2)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "AL2O3X"
dAl2O3 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "AL2O3"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dAl2O3
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dAl2O3)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "TIO2X"
dTiO2 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "TIO2"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dTiO2
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dTiO2)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "MNX"
dMn = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "MN"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dMn
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dMn)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
dMnO = dMn * 1.2912
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "MNO"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dMnO
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dMnO)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "CAOX"
dCaO = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "CAO"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dCaO
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dCaO)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "SX"
dS = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "S"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dS
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dS)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "SO3X"
dSO3 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "SO3"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dSO3
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dSO3)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "PX"
dP = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "P"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dP
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dP)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
dP2O5 = dP * 2.2914
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "P2O5"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dP2O5
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dP2O5)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "MGOX"
dMg0 = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * dCorr
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "MGO"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dMgO
ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dMgO)
'Set BatchUpdate = False so that the record set is written to the database
'before it is overwritten with the next populate
clsBDProfjob.BatchUpdate = False
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
Msgbox "XRF Corrections done", vbOKOnly, "XRF"
'If LOI LOI is done, calculate Total
If clsBDProfjob.PopulateByCuid (Current.Cuid, "LOI", "LOI") Then
If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then
dLOI = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)
'Set BatchUpdate = True so that the record set is not written to the database
'until all data for the current record set is updated
clsBDProfjob.BatchUpdate = True
'If Wet-Fe is present, use it to calculate FE2O3, else use XRF-Fe
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "FE_WET"
If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then
dFe = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue) * 1.4297
Else
dFe = dFe_XRF * 1.4297
End If
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "FE"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dFe
ProfjobCuidSchemeAnalyte.Finalvalue = cStr(dFe)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
'Calculate Total with LOI and Total oxides
dTotal = dFe + dSiO2 + dAl2O3 + dTiO2 + dMnO + dCaO + dS + dP2O5 + dMgO + dLOI
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "TOTAL"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dTotal
ProfjobCuidSchemeAnalyte.Finalvalue = cStr(dTotal)
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
dDiff = dFe_XRF / ((99.96 - (dTotal - dFe2O3)) * 0.6994)
clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "DIFF"
ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"
ProfjobCuidSchemeAnalyte.Numericvalue = dTotal
ProfjobCuidSchemeAnalyte.Finalvalue = cStr(dTotal)
'Set BatchUpdate = False so that the record set is written to the database
'before it is overwritten with the next populate
clsBDProfjob.BatchUpdate = False
clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True
clsBDProfjob.SaveProfjobCuidSchemeAnalyte True
'Pass all results to SPC
Set oFileSystem = CreateObject( "Scripting.FileSystemObject" )
Set oTextFile = oFileSystem.OpenTextFile( "I:\CCLASELSQL\SPC\XRF.SPC", ForAppending, True )
'SPF file format:
'SCHEME 1-20
'IDENT 21-40
'JOB 41-60
'DD/MM/YY 61-68
'HH:MM:SS 69-76
'#EL=nnn 77-83
'ELEMn 84-93
'FLAG 94
'VALUE 95-106
'Determine the list of analytes for this scheme
iNoElems = 0
sSPCRecord = ""
clsBDProfjob.SkipProfjobCuidSchemeAnalyte 0
do while not clsBDProfjob.EOFProfjobCuidSchemeAnalyte
iNoElems = iNoElems + 1
sSPCRecord = sSPCRecord & _
Left( ProfjobCuidSchemeAnalyte.AnalyteCode & Space(20), 20 ) & _
Left( ProfjobCuidSchemeAnalyte.Analytestatus & Space(3), 3 ) & _
Left( ProfjobCuidSchemeAnalyte.Finalvalue & Space(20), 20 )
clsBDProfjob.SkipProfjobCuidSchemeAnalyte 1
loop
oTextFile.WriteLine Left( Current.Sch_Code & Space(20), 20 ) & _
Left( Current.Sampleident & Space(20), 20 ) & _
Left ( Current.Pro_Job & Space(20), 20 ) & _
CCLASDateFormat(Now) & "#ANA=" & Right( "00" & cStr(iNoElems), 3 ) & _
sSPCRecord
oTextFile.Close
MsgBox "SPC file updated", vbOKOnly, "SPC"
Else
Msgbox "LOI-LOI not completed - no totals calculated", vbOKOnly, "XRF"
End If
Else
Msgbox "LOI-LOI not found - no totals calculated", vbOKOnly, "XRF"
End If
End If
Else
Msgbox "XRF-FEX not found", vbOKOnly, "XRF"
End If
End Sub
Function CCLASDateFormat ( DateIn )
Dim dDateIn
CCLASDateFormat = Right("0"&cStr(Day(DateIn)),2) & ":" & Right("0"&cStr(Month(DateIn)),2) & ":" & _
Right("O"&cStr(Year(DateIn)),2) & "0" & Right("0"&cStr(Hour(DateIn)),2) & ":" & _
Right("0"&cStr(Minute(DateIn)),2) & ":" & Right("0" & cStr(Second(DateIn)),2)
End Function
