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