'MacroName:MetadataRescue202102_Final
'MacroDescription:Repairs some data lost from bad merges of some Alexander Street Press Classical Scores Library titles
'Version 20210225 for sharing with MOUG and broader
'DESCRIPTION: Takes input file MetadataRescue_Search100.txt and searches OCLC by record # from TSV file, and replaces uncontrolled 100 700 fields with equivalent from earlier record with authority control, removes Anonymous from 100 and adjusts tracing indicator.
'MORE FEATURES: When a record purports to be provider neutral, macro deletes certain kinds of proxy links, and removes 490s and 830s tied to the Alexander Street resource
'PREPARATION: Create text file, MetadataRescue_Search100.txt with these data elements separated by TAB: OCLC #, local Millennium control number, 100 field, 700 fields (instances separated by ^). If no 100 field in bib, supply exact text: no100
'PREPARATION (2): This macro will fairly reliably deal with composite characters consisting of grave and acute accents, cedillas, umlauts, and tildes, but it is best to double check afterwards. Other diacritics require manual intervention, or may be batch-deleted before running the macro if the heading woud control in Connexion and restore it as part of the control process
'PREPARATION (3): Character encoding is the most unresolved part of this macro, and a workaround requires macro input with the diacritics in angle brackets immediately BEFORE the character they modify, e.g. e with grave accent would be "e{grave}"
'CUSTOMIZATIONS IN THIS VERSION: Turns off adding 380, added line to delete 380 if present; suppressed adding 949 for item record
'DISCLAIMER: This macro is being made available with the MIT License described in detail at: https://tpot.ucsd.edu/toolbox/tools-and-tips/index.html


Dim CS As Object
Option Explicit

Dim wasDeanonymized as Integer
Dim makeItSo as String
Dim wasScore007Deleted as Integer
Dim milBib as String
Dim cleanupFlag as Integer
Dim was773Modified as Integer
Dim was490Deleted as Integer
Dim was830Deleted as Integer
Dim BibType as String
Dim BibForm as String
Dim BibDesc as String
Dim proxiesDeleted as Integer

Declare Sub DeAnon(wasDeanonymized)
Declare Sub StringTranslator(makeItSo,cleanupFlag)
Declare Sub RemoveScore007(wasScore007Deleted)
Declare Sub Add949s(milBib)
Declare Sub ASPSeriesDelete(was490Deleted,was830Deleted)
Declare Sub Modify773(was773Modified)
Declare Sub GetMatTypeAndForm(BibType, BibForm, BibDesc)
Declare Sub AddRDAElements()
Declare Sub Add588(BibDesc)
Declare Sub DeleteProxy856s(proxiesDeleted)

Sub RemoveScore007(wasScore007Deleted)
   Dim loop007 as integer
   Dim value007 as string

   loop007 = 1
   value007 = ""
   
   CS.GetField "007",loop007,value007

   Do While value007 <> ""
      If Mid(value007,6,1) = "q" then
         CS.DeleteField "007",loop007
         loop007 = loop007 - 1
         wasScore007Deleted = wasScore007Deleted + 1
      End If
      loop007 = loop007 + 1
      value007 = ""
      CS.GetField "007",loop007,value007
   Loop

End Sub


'**********************************************

Sub DeAnon(wasDeanonymized)

   Dim anonStringCheck as string
   Dim modify245 as string
   Dim indicator245 as string

   If CS.IsOnline = False Then
      CS.Logon "","",""
   End If

   CS.GetField "100",1,anonStringCheck 
   
   If anonStringCheck <> "" and InStr(anonStringCheck,"Anonymous") Then
      CS.DeleteField "100",1
      CS.GetField "245",1,modify245
      indicator245 = mid(modify245,5,1)
      CS.DeleteField "245",1
      CS.AddField 1,"2450" & indicator245 & right(modify245,(len(modify245)-5))      
      wasDeanonymized = wasDeanonymized + 1
   End If

End Sub


'**********************************************

Sub StringTranslator(makeItSo,cleanupFlag)

   Dim wo as Integer
   Dim counter as Integer
   Dim fixedChar as String

   cleanupFlag = 0
   
   wo = InStr(4,makeItSo,"$")

   Do While wo <> 0

      makeItSo = Left(makeItSo,wo-1) & " " & Chr(223) & Mid(makeItSo,wo+1,1) & " " & Right(makeItSo,(Len(makeItSo))-(wo+1))
      wo = InStr(makeItSo,"$")

   Loop
   
   counter = 0

   Dim marc8Code(5)
   marc8Code(0) = "{grave}"
   marc8Code(1) = "{acute}"
   marc8Code(2) = "{tilde}"
   marc8Code(3) = "{uml}"
   marc8Code(4) = "{cedil}"
   marc8Code(5) = "XXX"

   Do While marc8code(counter) <> "XXX"

      wo = InStr(4,makeItSo,marc8Code(counter))
      
      Do While wo <> 0
      
         Select Case counter
            case 0
               fixedChar = Mid(makeItSo,wo + Len(marc8Code(counter)),1) & Chr(225)
            case 1
               fixedChar = Mid(makeItSo,wo + Len(marc8Code(counter)),1) & Chr(226)
            case 2
               fixedChar = Mid(makeItSo,wo + Len(marc8Code(counter)),1) & Chr(228)
            case 3
               fixedChar = Mid(makeItSo,wo + Len(marc8Code(counter)),1) & Chr(232)
            case 4
               fixedChar = Mid(makeItSo,wo + Len(marc8Code(counter)),1) & Chr(240)
         End Select

         makeItSo = Left(makeItSo,wo-1) & fixedChar & Right(makeItSo,(Len(makeItSo))-(wo+Len(marc8Code(counter))))' " " & Chr(223) & Mid(makeItSo,wo+1,1) & " " & Right(makeItSo,(Len(makeItSo))-(wo+1))
         wo = InStr(4,makeItSo,marc8Code(counter))
         
      Loop
      
      counter = counter+1

   Loop

      If (InStr(makeItSo,"{") <> 0) and (InStr(makeItSo,"}") <> 0) then cleanupFlag = 1

End Sub


'**********************************************

Sub Add949s(milBib)

'CS.AddField 1, "949  " & Chr(223) & "t 43" & Chr(223) & "x batMAY20;jls;1;PBT;ASP-SHMU" & Chr(223) & "lnnet" & Chr(223) & "s f" & Chr(223) & "r n"
CS.AddField 2, "949 1*recs-binsert;ov-" & milBib & ";bn-net;b1-u;"

End Sub

'**********************************************

Sub ASPSeriesDelete(was490Deleted,was830Deleted)
   Dim loopSeries as integer
   Dim valueSeries as string

   loopSeries = 1
   valueSeries = ""
   
   CS.GetField "490",loopSeries,valueSeries

   Do While valueSeries <> ""
      If (InStr(valueSeries,"Classical scores library") <> 0) or (InStr(valueSeries,"Classical Scores Library") <> 0) then
         CS.DeleteField "490",loopSeries
         loopSeries = loopSeries - 1
         was490Deleted = was490Deleted + 1
      End If
      loopSeries = loopSeries + 1
      valueSeries = ""
      CS.GetField "490",loopSeries,valueSeries
   Loop

   loopSeries = 1
   valueSeries = ""
   
   CS.GetField "830",loopSeries,valueSeries

   Do While valueSeries <> ""
      If (InStr(valueSeries,"Classical scores library") <> 0) or (InStr(valueSeries,"Classical Scores Library") <> 0) then
         CS.DeleteField "830",loopSeries
         loopSeries = loopSeries - 1
         was830Deleted = was830Deleted + 1
      End If
      loopSeries = loopSeries + 1
      valueSeries = ""
      CS.GetField "830",loopSeries,valueSeries
   Loop

End Sub


'**********************************************

Sub Modify773(was773Modified)
   Dim loop773 as integer
   Dim value773 as string

   loop773 = 1
   value773 = ""
   
   CS.GetField "773",loop773,value773

   Do While value773 <> ""
      If InStr(value773,"Recent Researches") <> 0 then
         CS.AddField 99,"500  Digitized from " & Right(value773,len(value773)-8) & "."
         CS.DeleteField "773",loop773
         loop773 = loop773 - 1
         was773Modified = was773Modified + 1
      End If
      loop773 = loop773 + 1
      value773 = ""
      CS.GetField "773",loop773,value773
   Loop

End Sub


'**********************************************

Sub GetMatTypeAndForm(BibType, BibForm, BibDesc)

Set CS = CreateObject("Connex.Client")

CS.CursorRow = 1
CS.CursorColumn = 1

CS.GetFixedField "Type", BibType
CS.GetFixedField "Form", BibForm
CS.GetFixedField "Desc", BibDesc

End Sub


'**********************************************

Sub Add588(BibDesc)

Dim FieldContents588 as String

CS.GetField "588",1,FieldContents588
If Instr(FieldContents588,"Some URIs added to this record for the PCC URI MARC pilot") = FALSE then

   If BibDesc = "c" then
      CS.AddFieldLine 99, "588  Some URIs added to this record for the PCC URI MARC pilot. Please do not remove these subfields"
   Else
      CS.AddFieldLine 99, "588  Some URIs added to this record for the PCC URI MARC pilot. Please do not remove these subfields."
   End If
   
End If

End Sub


'**********************************************

Sub AddRDAElements()

   Dim FieldContents006 as String

   If CS.GetField ("006",1,FieldContents006) = FALSE Then
      CS.AddFieldLine 1, "006  m     o  z        "
   ElseIf CS.GetField ("006",1,FieldContents006) <> FALSE and Mid(FieldContents006, 6, 11) <> "m     o  z" Then
      CS.AddFieldLine 1, "006  m     o  z        "
      CS.DeleteField "006", 2
   End If
   CS.DeleteField "336",2
   CS.DeleteField "336",1
   CS.AddFIeldLine 1, "336  notated music ßb ntm ß2 rdacontent ß0 http://rdaregistry.info/termList/RDAContentType/1016"
   CS.DeleteField "337",2
   CS.DeleteField "337",1
   CS.AddFIeldLine 1, "337  computer ßb c ß2 rdamedia ß0 http://rdaregistry.info/termList/RDAMediaType/1003"
   CS.DeleteField "338",2
   CS.DeleteField "338",1
   CS.AddFIeldLine 1, "338  online resource ßb cr ß2 rdacarrier ß0 http://rdaregistry.info/termList/RDACarrierType/1018"
   CS.DeleteField "344",2
   CS.DeleteField "344",1
   CS.AddFieldLine 1, "344  digital ß2 rdatr ß0 http://rdaregistry.info/termList/typeRec/1002"
   CS.DeleteField "380",1
'  *** THE ORIGINAL MACRO ADDED 380 FIELDS FOR SCORES. HOWEVER BEST PRACTICES IS TO USE 380 FOR AUTHORITY DATA, SO REMAREKED OUT HERE
'   CS.AddFieldLine 1, "380  Scores ß2 lcgft ß0 http://id.loc.gov/authorities/genreForms/gf2014027077"

End Sub


'**********************************************

Sub DeleteProxy856s(proxiesDeleted)

   Dim value856 as String
   Dim loop856 as Integer

   loop856 = 1

   CS.GetField "856",loop856,value856

   Do While value856 <> ""
   
      If InStr(value856,"proxy") or Instr(value856,"Proxy") or Instr(value856,"login") or Instr(value856,".ca") then  
         CS.DeleteField "856",loop856
         proxiesDeleted = proxiesDeleted + 1
         loop856 = loop856 - 1
      End If

      loop856 = loop856 + 1
      
      CS.GetField "856",loop856,value856
   
   Loop

End Sub


'**********************************************

Sub main

   Set CS = CreateObject("Connex.Client")
   Dim breakpoint as Integer
   Dim nSaveFileNumber as Integer
   Dim tosplitreport as String
   Dim tosplit as String
   Dim ocnsearch as String
   Dim namestring as String
   Dim add100 as String
   Dim searchstring as String
   Dim user as String
   Dim NumberProcessed as Integer
   Dim NumberNotProcessed as Integer
   Dim mainEntryString as string
   Dim embargodate as string
   Dim msgtext as string
   Dim addedEntries as String
   Dim add700 as String
   Dim value700 as String
   Dim counter700 as Integer
   Dim breakpoint700 as Integer
   Dim compareLength as Integer
   Dim cleanup100 as String
   Dim cleanup700 as String
   Dim value040 as string
   
   user = Environ("username")
   If Dir("C:\users\" & user & "\desktop\MetadataRescue_Search100.txt") = "" Then Goto Handler
   Open "C:\users\" & user & "\desktop\MetadataRescue_Search100.txt" For Input As #1
   Open "C:\users\" & user & "\desktop\MetadataRescue_Report100.txt" For Append As #2
   Write #2, "**********************************" & now & "**********************************"
 
   
   NumberProcessed=0
   NumberNotProcessed=0
   wasScore007Deleted = 0
   wasDeanonymized = 0
   was773Modified = 0
   was490Deleted = 0
   was830Deleted = 0
   proxiesDeleted = 0
 
   Do Until EOF(1)
      Line Input #1, tosplit
      tosplitreport = tosplit
      breakpoint = InStr(tosplit,Chr(9))
      ocnsearch = Left(tosplit,breakpoint-1)
      If ocnsearch = "" Then Exit Do
      tosplit = Right(tosplit,(Len(tosplit)-breakpoint))
      breakpoint = InStr(tosplit,Chr(9))
      milBib = Left(tosplit,breakpoint-1)
      tosplit = Right(tosplit,(Len(tosplit)-breakpoint))
      breakpoint = InStr(tosplit,Chr(9))
      add100 = Left(tosplit,breakpoint-1)
      addedEntries = Right(tosplit,(Len(tosplit)-breakpoint))

      searchstring = "#" & ocnsearch
      
      If CS.IsOnline = False Then
         CS.Logon "","",""
      End If
      
      If CS.Search("WC", searchstring) then

         Call RemoveScore007(wasScore007Deleted)
         
         If add100 <> "no100" then
            CS.GetField "100",1,mainEntryString
            If mainEntryString <> "" then CS.DeleteField "100",1
            makeItSo = add100
            Call StringTranslator(makeItSo,cleanupFlag)
            If Right(makeItSo,1) <> "." and (InStr(makeItSo,"http:") = 0 and InStr(makeItSo,Chr(223) & "4") = 0 ) then makeItSo = makeItSo & "."
            CS.AddField 2,"1001 " & makeItSo
            If cleanupFlag = 1 then 
               cleanup100 = "Clean Up 100"
               cleanupFlag = 0
            End If
         Else
            cleanup100 = ""
         End If 
         
         If addedEntries <> "" then
         
            Do
               breakpoint700 = InStr(addedEntries,"^")
               
               If breakpoint700 <> 0 then
                  add700 = Left(addedEntries,breakpoint700-1)
                  addedEntries = Right(addedEntries,(Len(addedEntries)-breakpoint700))
              
               Else
                 add700 = addedEntries
                 addedEntries = ""
              
               End If
                              
               makeItSo = add700
               Call StringTranslator(makeItSo,cleanupFlag)

               If Len(makeItSo) < 6 then 
                     compareLength = Len(add700)
               Else
                     compareLength = 6
               End If              
                              
               Counter700 = 1
               CS.GetField "700",counter700,value700
' ONLY NEEDED IF INPUT FILE HAS MARC FIELD TAGS AND DELIMITERS BEFORE MAIN STRING TO BE PROCESSED               
'               value700 = Right(value700,Len(value700)-5)
               
               Do Until value700 = ""

' ALTERNATE WAY TO DETECT IF 700 IS SAME AS STRING, MAY MISS VARIATIONS SUCH AS ADDED PARTICLES BEFORE NAMES               
'                  If Left(makeItSo,comparelength) = Left(value700,compareLength) then 

                  If InStr(value700,Left(makeItSo,comparelength)) then 
                     CS.DeleteField "700",counter700
                     If Right(makeItSo,1) <> "." and (InStr(makeItSo,"http:") = 0 and InStr(makeItSo,Chr(223) & "4") = 0 ) then makeItSo = makeItSo & "."
                     CS.AddField counter700, "7001 " & makeItSo
                     value700 = ""

                     If cleanupFlag = 1 then 
                     
                        cleanup700 = "Clean Up 700" 
                        cleanupFlag = 0                     
                     
                     End If            

                  Else
                     counter700 = counter700 + 1
                     CS.GetField "700",counter700,value700 
                     if value700 <> "" then value700 = Right(value700,Len(value700)-5)                    
                  End If
                                 
               Loop
                        
            Loop Until addedEntries = ""
            
            Else
               cleanup700 = ""
               
         End If
         
         Call Modify773(was773Modified)   
         Call GetMatTypeAndForm(BibType, BibForm, BibDesc)
         Call Add588(BibDesc)
         Call AddRDAElements()
         Call DeAnon(wasDeanonymized)
         Call Add949s(milBib)

'********** START: PROVIDER-NEUTRAL OPERATIONS   

         CS.GetField "040",1,value040
         If InStr(value040,Chr(223) & "e pn ") then       
            Call ASPSeriesDelete(was490Deleted,was830Deleted)
            Call DeleteProxy856s(proxiesDeleted)
         End If
         
'*********** END: PROVIDER-NEUTRAL OPERATIONS


         CS.ControlHeadingsAll
'*********** REPLACING THE MASTER RECORD HERE IS REMARKED OUT TO ALLOW MANUAL INSPECTION OF THE FILE BEFORE REPLACING		 
'         CS.ReplaceRecord
         If cleanup100 = "" and cleanup700 = "" then CS.ReplaceRecord
         nSaveFileNumber = CS.SaveToLocalFile (False, True)
         Write #2, "Processed and saved in local file #" & nSaveFileNumber & Chr(9) & tosplitreport & Chr(9) & cleanup100 & Chr(9) & cleanup700
         cleanup100 = ""
         cleanup700 = ""
         cleanupFlag = 0
         NumberProcessed = NumberProcessed + 1
         
      Else

         Write #2, "Did not find Search key " & Chr(9) & tosplitreport
         NumberNotProcessed = NumberNotProcessed + 1

      End If  
     

   Loop


   
   msgtext = "File processing completed / Number of records processed: " & NumberProcessed & " / Number of records not processed: " & NumberNotProcessed & " / Number of 100s de-anonymized: " & wasDeanonymized
   Write #2, msgtext
   Close #2
   Close #1
   MsgBox msgtext
Goto EndMacro

Handler:
MsgBox "The file MetadataRescue_Search100.txt was not found on your desktop. Please make sure the file is present before restarting this macro."
Goto EndMacro

EndMacro:
End Sub