'MacroName:CatME2Cnx
'MacroDescription:Copy an unfinished CatME save file record to Connexion's save file
'Macro written by: Joel Hahn, Niles Public Library District
'Last modified: 13 June 2005

Sub Main

   'Change to "N" to copy records to your online save file instead
   SaveLocal$ = "Y" 

   Dim CS As Object
   On Error Resume Next
   Set CS  = GetObject(,"Connex.Client")
   On Error GoTo 0
   If CS  Is Nothing Then
      Set CS  = CreateObject("Connex.Client")
   End If
   
   Dim CM as Object
   Set CM = CreateObject("CatME.Application")

   WinNum = CS.WindowCount
   i = 0
   Do Until i >= WinNum
     If CS.ItemType = 17 or CS.ItemType = 18 Then
       bool = CS.GetWindowTitle(i, wintitle)
       If InStr(wintitle, "Workform") Then
         MsgBox "You have an open workform.  Please close it before running this macro. Exiting..."
         Exit Sub
       End If
     End If
     i = i + 1
   Loop
   
   Err = 0
   On Error Resume Next
   CM.GetActiveRecord
   If Err = 440 Then
     MsgBox "You do not have a record displayed in CatME. Exiting..."
     Exit Sub
   End If
   On Error Goto 0
   If CM.GetItemType <> 0 Then
     MsgBox "You do not have a full record displayed in CatME. Exiting..."
     Exit Sub
   End If
   bool = CM.GetFixedField("OCLC:", ONum$)
   If ONum$ <> "NEW" And ONum$ <> "" Then
     MsgBox "You do not have an incomplete original record displayed in CatME.  Exiting..." & Chr(10) & Chr(10) & "(For complete records and incomplete copy-cataloging, you can simply export the record to a file then import the file into Connexion.)"
     Exit Sub
   End If

   bool = CM.GetFixedField("Type:", RecType$)
   'z = Auth; anything else = Bib
   
   Select Case RecType$
     Case "z"
       bool = CS.OpenWorkform("apn")
     Case "a", "t" 
       bool = CM.GetFixedField("BLvl:", BLvl$)
       If BLvl$ = "s" Then
         bool = CS.OpenWorkform("ser")
       Else
         bool = CS.OpenWorkform("bks")
       End If
     Case "m"
       bool = CS.OpenWorkform("com")
     Case "e", "f"
       bool = CS.OpenWorkform("map")
     Case "p"
       bool = CS.OpenWorkform("mix")
     Case "c", "d"
       bool = CS.OpenWorkform("sco")
     Case "i", "j"
       bool = CS.OpenWorkform("rec")
     Case "g", "k", "r", "o"
       bool = CS.OpenWorkform("vis")
     Case Else
       MsgBox "Type fixed field does not match a format that this macro can handle. Exiting..."
       Exit Sub
   End Select
   bool = CS.DeleteField("049", 1)

   FFPos = CS.FixedFieldPosition
   If FFPos <> 0 Then
     CS.FixedFieldPosition = 0
   End If

   CMFF = CM.IsOCLCFixedFieldOff
   If CMFF = FALSE Then
     bool = CM.SetOCLCFixedField(FALSE)
   End If

   bool = CM.GetFieldData(1, LDR$)
   LDR$ = Mid(LDR$, 2, 3) & "  " & Mid(LDR$, 9)
   bool = CM.GetFieldData(3, DateStamp$)
   DateStamp$ = Mid(DateStamp$, 2, 3) & "  " & Mid(DateStamp$, 9)
   bool = CM.GetFieldData(4, FF$)
   FF$ = Mid(FF$, 2, 3) & "  " & Mid(FF$, 9)

   bool = CS.SetField(1, LDR$)
   bool = CS.SetField(1, DateStamp$)
   bool = CS.SetField(1, FF$)
   
   bool = CM.SetOCLCFixedField(TRUE)
   'CS.FixedFieldPosition = 1

   bool = TRUE : cc% = 0 : TagNum% = 0
   Do Until bool = FALSE
     cc% = cc% + 1
     If cc > 999 Then
       MsgBox "Error: macro linecounter is out of control. Exiting..."
       Goto Done
     End If
     bool = CM.GetFieldData(cc%, indata$)
     If bool = FALSE Then Exit Do
     If Mid(indata$, 2, 3) <> "040" Then
        outdata$ = Mid(indata$, 2, 3) & Mid(indata$, 6, 2) & Mid(indata$, 9)

        'Move nonspacing diacritics to be after the letter they modify
        i = 1
        NewText$ = ""
        Do
          CurChar$ = Mid(outdata$, i, 1)
          Select Case Asc(CurChar$)
            Case 224 To 237, 239 To 251,254
              'Temporarily store nonspacing diacritics, to be added back in later
              NextChar$ = NextChar$ & CurChar$
            Case Else
              'Add any the current character, followed by any nonspacing diacritics that immediately preceded it
              NewText$ = NewText$ & CurChar$ & NextChar$
              'Empty out the temporary storage for nonspacing diacritics
              NextChar$ = ""
          End Select
          i = i + 1
        Loop While i <= Len(outdata$)
        outdata$ = NewText$

       bool = CS.AddFieldLine(cc% + 3, outdata$)
     End If

  Loop
  bool = CS.Reformat

    'FixedFieldPosition has a bug that erases all changes to a record; un-comment this section after the bug is fixed.
'   If FFPos <> 1 Then
'     CS.FixedFieldPosition = FFPos
'   End If
   
   If SaveLocal$ = "Y" Then
     bool = CS.SaveToLocalFile(FALSE,FALSE)
   Else
     If CS.IsOnline = FALSE Then
       bool = CS.Logon("", "", "")
     End If
     bool = CS.SaveOnline
   End If  
   CS.CloseRecord(FALSE)

   If CMFF = TRUE Then
     bool = CM.SetOCLCFixedField(FALSE)
   End If
   
   MsgBox "Done!"
Done:
End Sub