472 lines
15 KiB
Plaintext
472 lines
15 KiB
Plaintext
VERSION 5.00
|
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} vlnWestROConvert
|
|
Caption = "Convert Westinghouse Field to PROMS RO"
|
|
ClientHeight = 4065
|
|
ClientLeft = 45
|
|
ClientTop = 345
|
|
ClientWidth = 7365
|
|
OleObjectBlob = "vlnWestROConvert.frx":0000
|
|
ShowModal = 0 'False
|
|
StartUpPosition = 1 'CenterOwner
|
|
End
|
|
Attribute VB_Name = "vlnWestROConvert"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
Dim continueProcessing As Boolean
|
|
Dim dicTypeTranslate As Scripting.Dictionary
|
|
Dim dicDBTranslate As Scripting.Dictionary
|
|
Dim dicInvalidRO As Scripting.Dictionary
|
|
Dim dicValidRO As Scripting.Dictionary
|
|
Dim validAccPageID As String
|
|
Private Function GetNextField(fld As Field) As Field
|
|
If fld.Next Is Nothing Then
|
|
Set GetNextField = fld.Next
|
|
Else
|
|
Dim fldNext As Field
|
|
Set fldNext = fld.Next
|
|
If (Mid(fldNext.Code.Text, 1, 8) = " QUOTE <") Then
|
|
Set GetNextField = fldNext
|
|
Else
|
|
Set GetNextField = GetNextField(fldNext)
|
|
End If
|
|
End If
|
|
End Function
|
|
Private Function GetPreviousField(fld As Field) As Field
|
|
If fld.Previous Is Nothing Then
|
|
Set GetPreviousField = fld.Previous
|
|
Else
|
|
Dim fldPrev As Field
|
|
Set fldPrev = fld.Previous
|
|
If (Mid(fldPrev.Code.Text, 1, 8) = " QUOTE <") Then
|
|
Set GetPreviousField = fldPrev
|
|
Else
|
|
Set GetPreviousField = GetPreviousField(fldPrev)
|
|
End If
|
|
End If
|
|
End Function
|
|
Private Function GetNextText(fld As Field) As String
|
|
Dim fldNext As Field
|
|
Set fldNext = GetNextField(fld)
|
|
If fldNext Is Nothing Then
|
|
GetNextText = ""
|
|
Else
|
|
GetNextText = GetRO(fldNext.Code.Text)
|
|
End If
|
|
End Function
|
|
Private Function GetPreviousText(fld As Field) As String
|
|
Dim fldPrev As Field
|
|
Set fldPrev = GetPreviousField(fld)
|
|
If fldPrev Is Nothing Then
|
|
GetPreviousText = ""
|
|
Else
|
|
GetPreviousText = GetRO(fldPrev.Code.Text)
|
|
End If
|
|
End Function
|
|
Sub ProcessField(fld As Field, ro As String, txt As String, roPrev As String, roNext As String)
|
|
fld.Select
|
|
ActiveWindow.ScrollIntoView Selection.Range, True
|
|
Dim clipboard As MSForms.DataObject
|
|
Set clipboard = New MSForms.DataObject
|
|
Dim roText As String
|
|
If Left(ro, 4) = "<ARP" Then
|
|
roText = GetARPRO(ro, roPrev, roNext)
|
|
Else
|
|
roText = ro
|
|
End If
|
|
tbRO.Text = roText
|
|
tbPROMSRO.Text = PromsRO(roText, fld)
|
|
tbText.Text = txt
|
|
clipboard.SetText tbRO.Text
|
|
clipboard.PutInClipboard
|
|
End Sub
|
|
Private Function ReadableText(txt As String)
|
|
txt = Replace(txt, Chr(7), "")
|
|
txt = Replace(txt, Chr(12), "")
|
|
txt = Replace(txt, Chr(13), "")
|
|
txt = Replace(txt, Chr(30), "-")
|
|
ReadableText = ""
|
|
Dim i As Integer
|
|
For i = 1 To Len(txt)
|
|
If Asc(Mid(txt, i, 1)) < 32 Then
|
|
ReadableText = ReadableText + "[" + CStr(Asc(Mid(txt, i, 1))) + "]"
|
|
Else
|
|
ReadableText = ReadableText + Mid(txt, i, 1)
|
|
End If
|
|
Next
|
|
End Function
|
|
Private Function PromsRO(wro As String, fld As Field) As String
|
|
PromsRO = RoDBConvert(Mid(wro, 1, 4))
|
|
Dim nextSpace As Integer
|
|
nextSpace = InStr(6, wro, " ")
|
|
If nextSpace = 0 Then
|
|
nextSpace = InStr(6, wro, "\")
|
|
End If
|
|
PromsRO = PromsRO + Mid(wro, 6, nextSpace - 6)
|
|
Dim accPageID As String
|
|
accPageID = Design() + "-" + Mid(PromsRO, 2)
|
|
Dim firstSlash As Integer
|
|
firstSlash = InStr(wro, "\")
|
|
Dim roType As String
|
|
roType = UCase(Mid(wro, firstSlash + 1, 1))
|
|
Dim typeSub As String
|
|
typeSub = Mid(wro, 2, 3) + roType
|
|
If Not ValidRO(accPageID) Then ' Not a valid RO
|
|
tbPROMSRO.BackColor = RGB(255, 255, 0)
|
|
btnConvert.Caption = "Convert Missing RO to Text"
|
|
PromsRO = ReadableText(fld.Result)
|
|
ElseIf typeSub = "MELC" Then
|
|
tbPROMSRO.BackColor = RGB(128, 255, 128)
|
|
btnConvert.Caption = "Convert Common Description to Text"
|
|
PromsRO = ReadableText(fld.Result)
|
|
Else
|
|
If accPageID <> validAccPageID Then
|
|
PromsRO = Replace(PromsRO, Mid(accPageID, 5), Mid(validAccPageID, 5))
|
|
End If
|
|
tbPROMSRO.BackColor = RGB(255, 255, 255)
|
|
btnConvert.Caption = "Convert to PROMS RO"
|
|
PromsRO = PromsRO + RoTypeConvert(typeSub) + ">"
|
|
End If
|
|
End Function
|
|
Private Function Design() As String
|
|
Design = tbDesign.Text
|
|
'On Error Resume Next
|
|
'Design = Mid(ActiveDocument.CustomDocumentProperties("Doc_Number").Value, 1, 3)
|
|
End Function
|
|
Private Function InvalidRO(accPageID As String)
|
|
If dicInvalidRO Is Nothing Then
|
|
BuildDicInvalidRO
|
|
End If
|
|
InvalidRO = dicInvalidRO.Exists(accPageID)
|
|
End Function
|
|
Private Sub BuildDicInvalidRO()
|
|
Set dicInvalidRO = New Scripting.Dictionary
|
|
AddInvalids "APP-ARP-", "Select * FROM APPARPFieldsNotInROs_qry"
|
|
AddInvalids "APP-MEL-", "Select * FROM APPMELFieldsNotInROs_qry"
|
|
AddInvalids "APP-STP-", "Select * FROM APPSTPFieldsNotInROs_qry"
|
|
AddInvalids "CPP-ARP-", "Select * FROM CPPARPFieldsNotInROs_qry"
|
|
AddInvalids "CPP-MEL-", "Select * FROM CPPMELFieldsNotInROs_qry"
|
|
AddInvalids "CPP-STP-", "Select * FROM CPPSTPFieldsNotInROs_qry"
|
|
End Sub
|
|
Private Sub AddInvalids(prefix As String, query As String)
|
|
Dim dbs As DAO.Database
|
|
Dim rst As DAO.Recordset
|
|
'Establish connection
|
|
Set dbs = OpenDatabase("c:\vewest\westfields.mdb")
|
|
'Fill recordset
|
|
Set rst = dbs.OpenRecordset(query)
|
|
'Fill combo by looping through the recordset
|
|
Do While Not rst.EOF
|
|
Dim key As String
|
|
key = prefix + rst.Fields(0)
|
|
dicInvalidRO.Add key, 0
|
|
rst.MoveNext
|
|
Loop
|
|
'Clean up
|
|
Set rst = Nothing
|
|
Set dbs = Nothing
|
|
End Sub
|
|
Private Function ValidRO(accPageID As String) As Boolean
|
|
If dicValidRO Is Nothing Then
|
|
BuildDicValidRO
|
|
End If
|
|
If IsValidRO(accPageID) Then GoTo ValidRODone
|
|
If IsValidRO(accPageID + "-HI1") Then GoTo ValidRODone
|
|
If IsValidRO(accPageID + "-LO1") Then GoTo ValidRODone
|
|
If IsValidRO(accPageID + "-HI2") Then GoTo ValidRODone
|
|
If IsValidRO(accPageID + "-LO2") Then GoTo ValidRODone
|
|
If IsValidRO(accPageID + "-HI3") Then GoTo ValidRODone
|
|
If IsValidRO(accPageID + "-LO3") Then GoTo ValidRODone
|
|
If IsValidRO(accPageID + "-HI4") Then GoTo ValidRODone
|
|
If IsValidRO(accPageID + "-LO4") Then GoTo ValidRODone
|
|
ValidRO = False
|
|
Exit Function
|
|
ValidRODone:
|
|
ValidRO = True
|
|
End Function
|
|
Private Function IsValidRO(accPageID As String) As Boolean
|
|
IsValidRO = dicValidRO.Exists(accPageID)
|
|
If IsValidRO Then
|
|
validAccPageID = accPageID
|
|
Else
|
|
validAccPageID = ""
|
|
End If
|
|
End Function
|
|
Private Sub BuildDicValidRO()
|
|
Set dicValidRO = New Scripting.Dictionary
|
|
AddValids "APP-ARP-", "Select Alarm FROM AlarmAPP"
|
|
AddValids "APP-MEL-", "Select FullName From MELAPP"
|
|
AddValids "APP-STP-", "Select Name FROM SetpointData"
|
|
AddValids "CPP-ARP-", "Select Alarm from AlarmSMG"
|
|
AddValids "CPP-MEL-", "Select FullName From MELCPP"
|
|
AddValids "CPP-STP-", "Select Name From SetpointDataCPP"
|
|
End Sub
|
|
Private Sub AddValids(prefix As String, query As String)
|
|
Dim dbs As DAO.Database
|
|
Dim rst As DAO.Recordset
|
|
'Establish connection
|
|
Set dbs = OpenDatabase("c:\vewest\westfields.mdb")
|
|
'Fill recordset
|
|
Set rst = dbs.OpenRecordset(query)
|
|
'Fill combo by looping through the recordset
|
|
Do While Not rst.EOF
|
|
Dim key As String
|
|
key = prefix + rst.Fields(0)
|
|
dicValidRO.Add key, 0
|
|
rst.MoveNext
|
|
Loop
|
|
'Clean up
|
|
Set rst = Nothing
|
|
Set dbs = Nothing
|
|
End Sub
|
|
Private Function RoDBConvert(wType As String)
|
|
If dicDBTranslate Is Nothing Then
|
|
BuildDicDBTranslate
|
|
End If
|
|
RoDBConvert = dicDBTranslate(wType)
|
|
End Function
|
|
Private Sub BuildDicDBTranslate()
|
|
Set dicDBTranslate = New Scripting.Dictionary
|
|
dicDBTranslate.Add "<STP", "<SP-"
|
|
dicDBTranslate.Add "<MEL", "<MEL-"
|
|
dicDBTranslate.Add "<ARP", "<ARP-"
|
|
End Sub
|
|
Private Function RoTypeConvert(wType As String) As String
|
|
If dicTypeTranslate Is Nothing Then
|
|
BuildDicTypeTranslate
|
|
End If
|
|
If dicTypeTranslate.Exists(wType) Then
|
|
RoTypeConvert = dicTypeTranslate(wType)
|
|
Else
|
|
RoTypeConvert = "[" + Mid(wType, 4, 1) + "]"
|
|
End If
|
|
End Function
|
|
Private Sub BuildDicTypeTranslate()
|
|
Set dicTypeTranslate = New Scripting.Dictionary
|
|
dicTypeTranslate.Add "STPV", ".A"
|
|
dicTypeTranslate.Add "STPD", ".B"
|
|
dicTypeTranslate.Add "STPN", ".C"
|
|
|
|
dicTypeTranslate.Add "MELN", ".A"
|
|
dicTypeTranslate.Add "MELD", ".B"
|
|
dicTypeTranslate.Add "MELR", ".C"
|
|
|
|
dicTypeTranslate.Add "ARPN", ".A"
|
|
dicTypeTranslate.Add "ARPV", ".B"
|
|
dicTypeTranslate.Add "ARPT", ".C"
|
|
dicTypeTranslate.Add "ARPD", ".D"
|
|
End Sub
|
|
Function GetARPRO(ro As String, roPrev As String, roNext As String) As String
|
|
'<ARP CDS-LT046-MED \n\H>
|
|
'<MEL FWS-PL-V037 \d>
|
|
'<ARP CDS-LT046-MED \t\h\1>
|
|
Dim roNum As String
|
|
Dim roFlag As String
|
|
roNum = Trim(Left(ro, InStr(ro, "\") - 1))
|
|
roFlag = Trim(Mid(ro, InStr(ro, "\")))
|
|
Dim roPNum As String
|
|
Dim roPFlag As String
|
|
If roPrev = "" Then
|
|
roPNum = roPrev
|
|
roPFlag = roPrev
|
|
Else
|
|
roPNum = Trim(Left(roPrev, InStr(roPrev, "\") - 1))
|
|
roPFlag = Trim(Mid(roPrev, InStr(roPrev, "\")))
|
|
End If
|
|
Dim roNNum As String
|
|
Dim roNFlag As String
|
|
If roNext = "" Then
|
|
roNNum = roNext
|
|
roNFlag = roNext
|
|
Else
|
|
roNNum = Trim(Left(roNext, InStr(roNext, "\") - 1))
|
|
roNFlag = Trim(Mid(roNext, InStr(roNext, "\")))
|
|
End If
|
|
If InStr(ro, "\h") > 0 Or InStr(ro, "\l") > 0 Then
|
|
GetARPRO = roNum + GetARPExt(roFlag) + " " + roFlag
|
|
ElseIf roNum = roNNum And InStr(roNext, "\h") > 0 Or InStr(roNext, "\l") > 0 Then
|
|
GetARPRO = roNum + GetARPExt(roNFlag) + " " + roFlag
|
|
ElseIf roNum = roPNum And InStr(roPrev, "\h") > 0 Or InStr(roPrev, "\l") > 0 Then
|
|
GetARPRO = roNum + GetARPExt(roPFlag) + " " + roFlag
|
|
Else
|
|
GetARPRO = ro
|
|
End If
|
|
'<ARP CDS-LT046-MED-HI1 \n\H>
|
|
End Function
|
|
Function GetARPExt(flg As String) As String
|
|
'\t\h\1
|
|
If InStr(flg, "\h") > 0 Then
|
|
GetARPExt = "-HI"
|
|
End If
|
|
If InStr(flg, "\l") > 0 Then
|
|
GetARPExt = "-LO"
|
|
End If
|
|
If InStr(flg, "\1") > 0 Then
|
|
GetARPExt = GetARPExt + "1"
|
|
ElseIf InStr(flg, "\2") > 0 Then
|
|
GetARPExt = GetARPExt + "2"
|
|
ElseIf InStr(flg, "\3") > 0 Then
|
|
GetARPExt = GetARPExt + "3"
|
|
End If
|
|
End Function
|
|
Function GetType(str As String) As String
|
|
Dim startpt As Integer
|
|
startpt = InStr(str, "<") + 1
|
|
GetType = Mid(str, startpt, 3)
|
|
End Function
|
|
Function GetRO(str As String) As String
|
|
Dim startpt As Integer
|
|
startpt = InStr(str, "<")
|
|
Dim endpt As Integer
|
|
endpt = InStr(str, ">")
|
|
GetRO = Mid(str, startpt, 1 + endpt - startpt)
|
|
End Function
|
|
Function GetTxt(txt As String) As String
|
|
txt = Replace(txt, Chr(30), "-")
|
|
Dim startpt As Integer
|
|
startpt = InStr(txt, ">""")
|
|
Dim endpt As Integer
|
|
endpt = InStr(txt, """<")
|
|
GetTxt = Mid(txt, startpt + 2, endpt - startpt - 2)
|
|
End Function
|
|
|
|
Private Sub btnAll_Click()
|
|
Dim dtStart As Date
|
|
dtStart = Now
|
|
Dim cnt As Long
|
|
cnt = 0
|
|
Dim fld As Field
|
|
Set fld = NextRO(Selection.NextField)
|
|
While Not fld Is Nothing
|
|
Dim txt As String
|
|
Dim myType As String
|
|
Dim myRO As String
|
|
Dim myTxt As String
|
|
txt = fld.Code.Text
|
|
tbNext.Text = GetNextText(fld)
|
|
tbPrevious.Text = GetPreviousText(fld)
|
|
myType = GetType(txt)
|
|
myRO = GetRO(txt)
|
|
myTxt = GetTxt(txt)
|
|
ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
If tbPROMSRO.Text <> "" Then
|
|
Selection.Text = tbPROMSRO.Text
|
|
cnt = cnt + 1
|
|
End If
|
|
Set fld = NextRO(Selection.NextField)
|
|
Wend
|
|
tbRO.Text = ""
|
|
tbText.Text = ""
|
|
Beep
|
|
Dim secs As Integer
|
|
secs = DateDiff("s", dtStart, Now)
|
|
MsgBox CStr(cnt) + " RO converted in " + CStr(secs) + " seconds", vbOKOnly, "End of Document"
|
|
End Sub
|
|
Private Sub btnConvert_Click()
|
|
If tbPROMSRO.Text <> "" Then
|
|
Selection.Text = tbPROMSRO.Text
|
|
btnFindRO_Click
|
|
End If
|
|
End Sub
|
|
Private Sub btnFindRO_Click()
|
|
continueProcessing = False
|
|
Dim fld As Field
|
|
Set fld = NextRO(Selection.NextField)
|
|
If fld Is Nothing Then
|
|
If continueProcessing Then
|
|
Exit Sub
|
|
End If
|
|
tbRO.Text = ""
|
|
tbText.Text = ""
|
|
Beep
|
|
MsgBox "No more ROs", vbOKOnly, "End of Document"
|
|
Exit Sub
|
|
End If
|
|
Dim txt As String
|
|
Dim myType As String
|
|
Dim myRO As String
|
|
Dim myTxt As String
|
|
txt = fld.Code.Text
|
|
tbNext.Text = GetNextText(fld)
|
|
tbPrevious.Text = GetPreviousText(fld)
|
|
myType = GetType(txt)
|
|
myRO = GetRO(txt)
|
|
myTxt = GetTxt(txt)
|
|
ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
End Sub
|
|
Private Function NextRO(fld As Field) As Field
|
|
Set NextRO = Nothing
|
|
TopOfNextRO:
|
|
While Not (fld Is Nothing)
|
|
DoEvents
|
|
On Error GoTo myEH
|
|
If Mid(fld.Code.Text, 1, 8) = " QUOTE <" Then
|
|
Dim txt As String
|
|
Dim myType As String
|
|
Dim myRO As String
|
|
txt = fld.Code.Text
|
|
If tbSearch.TextLength = 0 Or InStr(txt, tbSearch.Text) > 0 Then
|
|
myType = GetType(txt)
|
|
myRO = GetRO(txt)
|
|
If myType = "STP" Then 'setpoint
|
|
Set NextRO = fld
|
|
Exit Function
|
|
ElseIf myType = "MEL" Then 'equipment
|
|
Dim p As Integer
|
|
p = InStr(myRO, "\")
|
|
If p > 0 Then
|
|
Dim s As String
|
|
s = UCase(Mid(myRO, p + 1, 1))
|
|
If InStr("NRDC", s) > 0 Then
|
|
Set NextRO = fld
|
|
Exit Function
|
|
End If
|
|
End If
|
|
ElseIf myType = "ARP" Then 'alarm
|
|
Set NextRO = fld
|
|
Exit Function
|
|
End If
|
|
End If
|
|
End If
|
|
Set fld = fld.Next
|
|
If fld Is Nothing Then
|
|
Set fld = Selection.NextField
|
|
'ActiveWindow.Activate
|
|
End If
|
|
Wend
|
|
Exit Function
|
|
myEH:
|
|
'ActiveWindow.Activate
|
|
Set fld = Selection.NextField
|
|
GoTo TopOfNextRO
|
|
End Function
|
|
Sub ShowMyself()
|
|
vlnWestROConvert.Show
|
|
End Sub
|
|
Sub BuildROList()
|
|
Dim dbs As DAO.Database
|
|
Dim rst As DAO.Recordset
|
|
|
|
'Establish connection
|
|
Set dbs = OpenDatabase("c:\vewest\westfields.mdb")
|
|
'Fill recordset
|
|
Set rst = dbs.OpenRecordset("Select * FROM APPARPFieldsNotInROs_qry")
|
|
|
|
'Fill combo by looping through the recordset
|
|
Do While Not rst.EOF
|
|
Debug.Print rst.Fields(0)
|
|
rst.MoveNext
|
|
Loop
|
|
|
|
'Clean up
|
|
Set rst = Nothing
|
|
Set dbs = Nothing
|
|
|
|
End Sub
|
|
|
|
Private Sub btnLoad_Click()
|
|
BuildROList
|
|
End Sub
|