VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} vlnNextROForm 
   Caption         =   "Find RO"
   ClientHeight    =   3390
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   8010
   OleObjectBlob   =   "vlnNextROForm.frx":0000
   ShowModal       =   0   'False
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "vlnNextROForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False




Option Explicit
Dim ContinueProcessing As Boolean

Private Function GetNextField(fld As Field) As Field
    Dim fldNext As Field
    On Error GoTo ehNF
    Set fldNext = fld.Next
    While Not fldNext Is Nothing
        Debug.Print "fldNext " + CStr(fldNext.Index)
        If (Mid(fldNext.Code.Text, 1, 8) = " QUOTE <") Then
            Set GetNextField = fldNext
            Exit Function
        End If
        Set fldNext = fldNext.Next
    Wend
    Set GetNextField = fldNext
    Exit Function
ehNF:
    Set GetNextField = Nothing
    Exit Function
End Function
Private Function GetPreviousField(fld As Field) As Field
    Dim fldPrev As Field
    On Error GoTo ehPF
    Set fldPrev = fld.Previous
    While Not fldPrev Is Nothing
        Debug.Print "fldPrev " + CStr(fldPrev.Index)
        If (Mid(fldPrev.Code.Text, 1, 8) = " QUOTE <") Then
            Set GetPreviousField = fldPrev
            Exit Function
        End If
        Set fldPrev = fldPrev.Previous
    Wend
    Set GetPreviousField = fldPrev
    Exit Function
ehPF:
    Set GetPreviousField = Nothing
    Exit Function
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
Private Sub btnNext_Click()
'    MousePointer = fmMousePointerHourGlass
'    DoEvents
'    Dim rng As Range
'    Set rng = Selection.Range
'    Dim strt As Long
'    strt = rng.End
'    rng.MoveEnd wdCharacter, ActiveDocument.Characters.Count
'    'Debug.Print str(rng.start) & " - " & str(rng.End)
'    Dim flds As Fields
'    Set flds = rng.Fields
'    'Debug.Print str(flds.Count) & " Fields"
'    Dim fld As Field
'    For Each fld In flds
'        Dim txt As String
'        txt = fld.Code.Text
'        If (fld.Code.Start > strt And Mid(fld.Code.Text, 1, 8) = " QUOTE <") Then
'            tbNext.Text = GetNextText(fld)
'            tbPrevious.Text = GetPreviousText(fld)
'            Dim myType As String
'            Dim myRO As String
'            Dim myTxt As String
'            myType = GetType(txt)
'            myRO = GetRO(txt)
'            myTxt = GetTxt(txt)
'            If myType = "STP" Then  'setpoint
'                ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
'    MousePointer = fmMousePointerDefault
'                Exit Sub
'            ElseIf myType = "MEL" Then  'equipment
''                If InStr(myRO, "\n") > 0 And InStr(myRO, myTxt) > 0 Then    'handle only \n for now and only if text is fullname
'                Dim p As Integer
'                p = InStr(myRO, "\")
'                If p > 0 Then
'                    Dim s As String
'                    s = UCase(Mid(myRO, p + 1, 1))
'                    If InStr("NRD", s) > 0 Then
'                        ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
'                        MousePointer = fmMousePointerDefault
'                        Exit Sub
'                    End If
'                End If
''                If InStr(myRO, "\n") > 0 Then    'handle \n name (short or full)
''                    ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
''    MousePointer = fmMousePointerDefault
''                    Exit Sub
''                End If
''                If InStr(myRO, "\r") > 0 Then    'handle \r room
''                    ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
''    MousePointer = fmMousePointerDefault
''                    Exit Sub
''                End If
''                If InStr(myRO, "\d") > 0 Then    'handle \d description
''                    ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
''    MousePointer = fmMousePointerDefault
''                    Exit Sub
''                End If
'            ElseIf myType = "ARP" Then  'alarm
'                ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
'    MousePointer = fmMousePointerDefault
'                Exit Sub
'            End If
'        End If
'    Next
'    tbRO.Text = ""
'    tbText.Text = ""
'    Beep
'    MousePointer = fmMousePointerDefault
End Sub
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
    tbText.Text = txt
    clipboard.SetText tbRO.Text
    clipboard.PutInClipboard
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
Sub ShowMyself()
    vlnNextROForm.Show
End Sub
Public Sub btnNext2_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
    Debug.Print "btnNext2 " + CStr(fld.Index)
    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)
        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("NRD", 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
        End If
    Wend
    Exit Function
myEH:
    ContinueProcessing = True
    Application.OnTime DateAdd("s", 2, Now), "RunAgain"
    Exit Function
'    Set NextRO = NextRO(Selection.NextField)
'    Exit Function
'    Set fld = Selection.NextField
'    GoTo topOfNextRO
End Function
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Unload Me
End Sub