Example Product Rule - Balance Calibrations Recorded to an SPC File

Scenario: A job CALIB1 is set up with one scheme BALCAL which has three analytes CURRWT, PREVWT, WTDIFF. Typically, every day, a new sample would be created for the job, with the format CALIBnnnnnn, where nnnnnn is an incremental integer with a step size of 1, starting at 000001. For example, if CALIB000008 was being analysed and CURRWT was read as 3.7, PREVWT is taken to be the CURRWT of the previous sample CALIB0000007, and the WTDIFF is calculated using a defined tolerance. If the WTDIFF for the current sample is out of tolerance, an email message is issued to a defined destination. The SPC file for the balance is updated with the lastest results.

Sub Main()

'Daily Dry Balance Calibration Check Procedure

'CURRWT = Todays weight

'PREVWT = Yesterdays weight

'DIFFWT = Weight Difference

Dim iNoElems

Dim dPrevWt, dCurrWt, dWtDiff, dTol

Dim sPrevIdent

Dim sSPCRecord

Dim oSupport, oFileSystem, oTextFile

Const ForAppending = 8

'Set up some defaults for testing purposes

'Current.Pro_Job ="CALIB1"

'Current.Cuid = "0000033737"

'Current.Sampleident = "CALIB000003"

'Current.Sampletype ="UNK"

'Current.Sch_Code ="BALCAL"

'Current.AnalyteCode = "CURRWT"

'Current.ProductCode ="DAILYBALCHK"

Set oSupport = CreateObject("CCSUPP01.clsSupport")

'Ensure CURRWT is stored

clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "CURRWT"

'Note, when you populate using a particular Cuid, Scheme and Analyte, all schemes and

'all analytes for that Cuid are loaded into the record sets. If you then re-populate

'using the same Cuid, but change the Scheme and/or Analyte, only those affected records

'are updated. If you re-populate using a different Cuid, all record sets are updated.

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

dCurrWt = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "PREVWT"

If ProfjobCuidSchemeAnalyte.Analytestatus = "CPL" Then

'Presume that results have already been passed to SPC

MsgBox "Results have already been passed to SPC", vbOKCancel, "BALCAL"

Else

If ProfjobCuid.Sampleident = "CALIB000001" Then

MsgBox "First sample - no previous weight available for comparison", vbOKCancel, "BALCAL"

Else

'If the Sample ident for this current Cuid is >CALIB000001, get the record sets for the

'previous Sample Ident, if it exists. Copy the CURRWT for that previous Sample

'ident, and copy it into PREVWT for the current Cuid.

sPrevIdent = "CALIB" & Right ("000000" & cStr (cDbl (Right (ProfjobCuid.Sampleident, 6)) - 1) ,6)

clsBDProfjob.PopulateByIdent Current.Pro_Job, Current.Sch_Code, "CURRWT", "UNK", sPrevIdent

If clsBDProfjob.FoundProfjobSchemeAnalyte Then

'Get the current weight from this previous record and use it as the previous weight

dPrevWt = oSupport.cnvdouble(ProfjobCuidSchemeAnalyte.Finalvalue)

'Populate the record set for the current Cuid again, ensuring that BatchUpdate = True

'so that records are not overwritten as you move through the analytes of a cuid+scheme

clsBDProfjob.BatchUpdate = True

'Update the previous weight for the current Cuid

clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "PREVWT"

ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dPrevWt

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dPrevWt)

'Save the record set, using BatchUpdate = True,

'indicating there is more to save for this Cuid

clsBDProfjob.IsProfjobCuidSchemeAnalyteDirty = True

clsBDProfjob.SaveProfjobCuidSchemeAnalyte True

dWtDiff = dCurrWt - dPrevWt

'Update the weight difference for the current Cuid

clsBDProfjob.PopulateByCuid Current.Cuid, Current.Sch_Code, "WTDIFF"

ProfjobCuidSchemeAnalyte.Analytestatus = "CPL"

ProfjobCuidSchemeAnalyte.Numericvalue = dWtDiff

ProfjobCuidSchemeAnalyte.Finalvalue = cStr (dWtDiff)

'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

'Validate that the results are within limits +/- Tolerance

dTol = 0.0003

Msgbox "PREVWT = " & cStr(dPrevWt) & vbCrLf & "CURRWT = " & cStr(dCurrWt) & vbCrLf & _

"EXPECTED = " & cStr(dPrevWt - dTol) & " to " & cStr(dPrevWt + dTol), _

vbOKOnly, "BALCAL"

If (dCurrWt < dPrevWt - dTol) or (dCurrWt > dPrevWt + dTol) Then

'Something is not right. Send a message!

SendEmail "Lab Manager", "Instrument Calibration", _

"Balance" & vbTab & ProfjobCuidScheme.Instcode & vbCrLf & _

"Cuid" & vbTab & Current.Cuid & vbCrLf & _

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

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

"Expected = " & cStr (dPrevWt - dTol) & " to " & cStr (dPrevWt + dTol) & _

"Reading = " & cStr (dCurrWt), _

"labmgr@company.com.", ""

End If

'Pass all results to SPC

Set oFileSystem = CreateObject( "Scripting.FileSystemObject" )

Set oTextFile = oFileSystem.OpenTextFile( "I:\CCLASELSQL\SPC\BalCal_Daily.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

'If the record is not found, copy CURRWT for the current Cuid into PREVWT,

'don't calculate the DIFFWT and don't worry about SPC

MsgBox "Previous sample not found - no previous weight for comparison", vbOKOnly, "BALCAL"

End If

End If

End If

Else

MsgBox "Sample " & Current.Cuid & " " & Current.Sampleident & " is incomplete", vbOKCancel, "BALCAL"

End if

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

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, 4 + 48, "Email" ) = vbYes 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