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
