'MacroName:CursorJump
'MacroDescription:Moves the cursor to the selected position in
' the current field.
'
' This macro was written by Walter F. Nickeson,
' University of Rochester, Rochester, NY
' wnickeson@library.rochester.edu
'
' Thanks to Harvey Hahn for some help with dialog boxes.
'
' Last updated: 3 June 2008.
' Check for the latest versions of this and my other macros at
' http://docushare.lib.rochester.edu/docushare/dsweb/View/Collection-2556
' Please e-mail me with bug reports or to suggest improvements.
'
' Works in Connexion client 2.10.
'
'***************************************************************
' How it works. This macro is intended to help quickly find
' illegal characters (i.e., characters that won't validate) in a
' field when the "Validation Results" window gives the positions
' of those characters. Run the macro with the cursor in the
' field in which illegal characters have been identified. The
' macro displays a dialog box in which you enter the position in
' the subfield to which you want to jump. If there are more than
' one subfield, they are presented for selection in a drop-down
' list; if a subfield occurs more than once, the list also asks
' you to specify the occurrence. The macro moves the cursor to
' that position and leaves the character there selected for easy
' editing (i.e., you may simply type to replace it).
'***************************************************************

Option Explicit

Global SubfieldCountTotal%

Declare Function SetDialogBox( Id$, Action%, Suppvalue& )
Declare Function SortSubfieldString$( Previous$, Latest$ )

Sub Main

Dim CS As Object
Set CS = CreateObject("Connex.Client")

Dim CurrentField$
Dim DisplayString$           : DisplayString$ = ""
Dim LabelString1$
Dim LabelString2$
Dim LabelString3$
Dim ListOfSubfields$         : ListOfSubfields$ = ""
Dim Selection$
Dim SortedString$            : SortedString$ = " "
Dim SubfieldChoice$
Dim SubfieldCode1$, SubfieldCode2$
Dim Tag$

Dim Found%
Dim Occurrence%
Dim Start1%                  : Start1% = 1
Dim Start2%
Dim Start3%
Dim SubfieldCountDistinct%
Dim SubfieldLength%
Dim TestChar1%
Dim TestChar2%
Dim a, b, c, d, e, f, g As Integer

Dim BeginsWithA              : BeginsWithA = FALSE
Dim SingleOccurrence         : SingleOccurrence = TRUE

Dim Lengths() As Integer
Dim Positions() As Integer
Dim Subfields() As String

SubfieldCountTotal% = 0

' First, retrieve the field, and make sure it is a variable data
' field (010-999). Then strip it of tag and indicators

If CS.GetFieldLine( CS.CursorRow, CurrentField$ ) = TRUE Then
    If Left$( CurrentField$, 2 ) = "00" Or Left$( CurrentField$, 1 ) = "L" Then
        MsgBox "Sorry, this macro only works in fields 010 and higher.", 64, "Macro won't go"
        Exit Sub
      Else
        Tag$ = Left$( CurrentField, 3 )
        If Asc( Left$( Tag$, 1 ) ) = 252 Then Tag$ = "unlabeled"
        CurrentField$ = Mid$( CurrentField$, 6 )
    End If
  Else
    MsgBox "Sorry, the macro failed.", 48, "Macro failure"
End If

' Since "$a" does not display, it must be added to the beginning
' of the string if it is indeed the first subfield, just to make
' sure it's counted

If Left$( CurrentField$, 1 ) <> Chr$( 223 ) Then
    CurrentField$ = Chr$( 223 ) & "a " & CurrentField$
    BeginsWithA = TRUE
End If

' This loop finds all the subfield codes in the field and
' concatenates them in a string, which it sends to a function to
' get another string representing unique or distinct subfield
' codes. The first string preserves the arrangement of the
' subfields, while the second string, showing subfield codes in
' alphabetical order, is for display purposes, to make it easier
' to select a specific subfield. Two arrays are used here: one
' stores the positions within the field of the first character
' of each subfield, information needed when the field contains
' more than one subfield; the other stores the length of each
' subfield, information needed to validate input by the user

Do
  a = InStr( Start1%, CurrentField$, Chr$( 223 ) )
  If a <> 0 Then
      SubfieldCode1$ = Mid$( CurrentField$, a + 1, 1 )
      ListOfSubfields$ = ListOfSubfields$ & SubfieldCode1$
      SortedString$ = SortSubfieldString$( SortedString$, SubfieldCode1$ )
      SubfieldCountTotal% = SubfieldCountTotal% + 1
      ReDim Preserve Positions( SubfieldCountTotal% )
       Positions( SubfieldCountTotal% - 1 ) = a + 3
      If SubfieldCountTotal% > 1 Then
          SubfieldLength% = (a - 1) - (Start1% )
          ReDim Preserve Lengths( SubfieldCountTotal% + 1 )
           Lengths( SubfieldCountTotal% - 2 ) = SubfieldLength%
      End If
    Else
      SubfieldLength% = Len( CurrentField$ ) - Start1% + 1
      ReDim Preserve Lengths( SubfieldCountTotal% )
       Lengths( SubfieldCountTotal% - 1 ) = SubfieldLength%
  End If
  Start1% = a + 3

Loop Until a = 0

' The string of unique codes produced by the function
' "SortSubfieldString$" is in ASCII order, meaning any numeric
' codes precede alphabetic codes. This section flips the string,
' if necessary, to get alphabetic codes first, by removing any
' numeric sequence (which will always be at the beginning of the
' string) and sticking it on to the end. This ordering is
' helpful because alphabetic subfield codes predominate in data
' fields, and illegal characters are more likely to be found in
' those subfields

For b = 1 to Len( SortedString$)
  TestChar1% = Asc( Mid$( SortedString$, b, 1 ) )
  If TestChar1% > 57 Then
      If b = 1 Then
          Exit For
        Else
          SortedString$ = Mid$( SortedString$, b ) & Left$( SortedString$, b - 1 )
          Exit For
      End If
  End If
Next b

' Populate the array used in the DropListBox in the dialog box
' by filling it with the unique subfields used in the field
' along with their occurrences in the form "t [1]," "t [2],"
' etc. Each element in the array is created by matching the
' subfield with a range of numbers corresponding to the number
' of occurrences of that subfield. If there is only one
' occurrence of a subfield, omit the superfluous "[1]"

ReDim Subfields( SubfieldCountTotal% - 1 )
c = 0

For d = 1 To Len( SortedString$ )
  SubfieldCountDistinct% = 0
  Start2% = 1
  Do
    SubfieldCode2$ = Mid$( SortedString$, d, 1 )
    e = InStr( Start2%, ListOfSubfields$, SubfieldCode2$ )
    If e = 0 Then
        Exit Do
      Else
        SubfieldCountDistinct% = SubfieldCountDistinct% + 1
        DisplayString$ = SubfieldCode2$ & " [ " & CStr( SubfieldCountDistinct% ) & " ]"
        Subfields( c ) = Trim$( DisplayString$ )
        Start2% = e + 1
        c = c + 1
    End If
  Loop Until e = 0
  If SubfieldCountDistinct% = 1 Then
      Subfields( c - 1 )= Left$( DisplayString$, Len( DisplayString$ ) - 6 )
    Else
      SingleOccurrence = FALSE
  End If
Next d

' This is the dialog box in which the user directs the macro to
' find a position in a field. First, the user must select the
' appropriate subfield (and occurrence of the subfield, if it
' appears more than once) from a drop-down list, although if
' there is only one subfield in the field, no selection is
' necessary. Then the user must enter the position to which to
' jump. The function "SetDialogBox" alters the appearance of the
' dialog box according to whether or not there is more than one
' subfield. The alternative to using this sort of function seems
' to be to code two or three different dialog boxes for the
' different cases

' First, define the different text boxes in the dialog box.
' Their wording will differ depending on the number of subfields
' in the field and if any subfields occur more than once

If SingleOccurrence = FALSE Then
    LabelString1$ = "Select the subfield and its occurence and enter the position within the subfield you wish to go to in this " & Tag$ & " field:"
    LabelString2$ = "Subfield [Occurrence]"
  Else
    LabelString1$ = "Select the subfield and enter the position within the subfield you wish to go to in this " & Tag$ & " field:"
    LabelString2$ = "          Subfield"
End If

LabelString3$ = "Enter the position you wish to go to within this " & Tag$ & " field:"

Recycle:

Begin Dialog SelectPosition 198, 100, "Jump to position ...", .SetDialogBox
  Text 10, 6, 182, 20, LabelString1$, .InstructionMultiple
  Text 36, 30, 66, 8, LabelString2$, .Legend
   DropListBox 52, 44, 36, 70, Subfields, .SubfieldList
  Text 16, 40, 84, 24, LabelString3$, .InstructionSingle
  Text 122, 30, 26, 8, "Position"
   TextBox 122, 44, 24, 11, .Target
  ButtonGroup .GoCancel
    PushButton 32, 70, 54, 16, "&Go"
    PushButton 112, 70, 54, 16, "&Cancel"
End Dialog
Dim CursorJump as SelectPosition
Dialog CursorJump

If CursorJump.GoCancel = 1 Then GoTo Done:

Selection$ = Subfields( CursorJump.SubfieldList )
SubfieldChoice$ = Left$( Selection$, 1 )

If Len( Selection$ ) = 1 Then
    Occurrence% = 1
  Else
    If Mid$( Selection$, 6, 1 ) = " " Then
        Occurrence% = Val( Mid$( Selection$, 5, 1 ) )
      Else
        Occurrence% = Val( Mid$( Selection$, 5, 2 ) )
    End If
End If

' Test the input from the dialog box to make sure it is valid.
' For all cases of invalid input, display a warning message,
' then go back to the dialog box to try again

' Test 1: Something more than a space must be input!

If CursorJump.Target = "" Or CursorJump.Target = " " Then
    MsgBox "Please enter a position to jump to!", 48, "Number entry problem"
    GoTo Recycle:
End If

' Test 2: A zero is invalid

If Val( CursorJump.Target ) = 0 Then
    MsgBox "The first character is in position 1. Please enter a number bigger than zero!", 48, "Number entry problem"
    GoTo Recycle:
End If

' Test 3: The character string entered must be digits only

For f = 1 To Len( CursorJump.Target )
  TestChar2% = Asc( Mid$( CursorJump.Target, f, 1 ) )
  If TestChar2% < 48 Or TestChar2% > 57 Then
      MsgBox "Please enter numbers 0-9 only!", 48, "Number entry problem"
      GoTo Recycle:
  End If
Next f

' Test 4: The number entered must not be bigger than the length
' of the chosen subfield

Start3% = 1
Found% = 0
Do Until Found% = Occurrence%
  g = InStr( Start3%, ListOfSubfields$, SubfieldChoice$ )
  Found% = Found% + 1
  Start3% = g + 1
Loop

If Val( CursorJump.Target ) > Lengths( g - 1 ) Then
    MsgBox "The number you entered is too large! The length of the subfield is only " & CStr( Lengths( g - 1 ) ) & " characters.", 48, "Number entry problem"
    GoTo Recycle:
End If

' If the number entered is valid, send the cursor to that
' position. Note that for validation purposes, character
' positions start with the data in subfield $a, not with the
' characters of the tag; this is different than with the various
' field editing commands, which count column positions from the
' beginning of the tag. Thus, we have to add characters to the
' position given by the validator to get to the right place in
' the field

If BeginsWithA = TRUE Then
    CS.CursorColumn = Positions( g - 1 ) + Val( CursorJump.Target ) + 1
  Else
    CS.CursorColumn = Positions( g - 1 ) + Val( CursorJump.Target ) + 4
End If

' Finish by selecting the character at the chosen position so it
' can be readily replaced

SendKeys "+{RIGHT}"

Done:

End Sub

'***************************************************************
Function SetDialogBox( Id$, Action%, Suppvalue& )

' This function controls the appearance of the dialog box when
' it opens, according to the number of subfields in the current
' field. If there is only one subfield, then the instruction
' shown is simply to enter a position within the field to go to,
' and the DropListBox is hidden. Otherwise, the instruction
' shown is to select a subfield and occurrence--which requires
' that the DropListBox also be made visible

If Action% = 1 Then
    If SubfieldCountTotal% = 1 Then
        DlgFocus "Target"
        DlgVisible "SubfieldList", 0
        DlgVisible "Legend", 0
        DlgVisible "InstructionMultiple", 0
      Else
        DlgVisible "InstructionSingle", 0
    End If
End If

End Function
'***************************************************************
Function SortSubfieldString$( Previous$, Latest$ )

' This function receives, one at a time, all the subfields used
' from the main routine's loop through the field. It discards
' duplicate codes and adds each new one in alphabetical (or
' numerical) order to produce a list of the unique subfield
' codes in the field. Since it's a simple ASCII sort, any
' numeric subfield codes will be inserted at the beginning of
' the string; this order will be fixed later in the main routine

Dim TempString$
Dim j, k As Integer

If Previous$ = " " Then
    TempString$ = Latest$
    SortSubfieldString$ = TempString$
    Exit Function
  Else
    j = InStr( Previous$, Latest$ )
    If j <> 0 Then
        SortSubfieldString$ = Previous$
        Exit Function
      Else
        If Asc( Latest$ ) < Asc( Left$( Previous$, 1 ) ) Then
            TempString$ = Latest$ & Previous
          ElseIf Len( Previous$ ) = 1 Then
            TempString$ = Previous$ & Latest$
          Else
            For k = 2 To Len( Previous$ )
              If Asc( Latest$ ) < Asc( Mid$( Previous$, k, 1 ) ) Then
                  TempString$ = Left$( Previous$, k - 1 ) & Latest$ & Mid$( Previous$, k )
                  Exit For
                ElseIf k = Len( Previous$ ) Then
                  TempString$ = Previous$ & Latest$
                  SortSubfieldString$ = TempString$
                  Exit For
              End If
            Next k
        End If
    End If
End If

SortSubfieldString$ = TempString$

End Function
'***************************************************************