'MacroName:DerivePlus
'MacroDescription:performs common activities when deriving a new record
'written by John Lavalie, Aug. 1, 2006

Global CS As Object
'$Include "CCS!replace"

'-------------------
sub deleteTags(tag as string)

   found = CS.GetField (tag, 1, temp) 
   do while found
      CS.DeleteField tag, 1
      found = CS.GetField (tag, 1, temp) 
   loop
   
end sub
'---------------------
Sub Main

   Set CS = CreateObject("Connex.Client")
    
   subfieldB = chr(223) + "b"
   subfield2 = chr(223) + "2"
   subfieldT = chr(223) + "t"
   subfieldX = chr(223) + "x"
   subfieldW = chr(223) + "w"
   subfieldL = chr(223) + "l"
   DDC = "23"                                             'current ed. of Dewey
   
   'grab data from old record     
   CS.CopyControlNumber
   bool = CS.GetField ("040", 1, tag040)
   bool = CS.GetField ("082", 1, tag082)
   CS.GetFixedField "BLvl", recType
   CS.DeriveNewRecord (TRUE)

   deleteTags("020")
   deleteTags("024")
   deleteTags("250")
   deleteTags("520")
       
   'modify new record
   if instr(tag040, subfieldB) and recType <> "s" then    'parallel record      
      
      'fix NUKAT records
      found246 = false: x% = 1
      do
         found246 = CS.GetField ("246", x%, tag$)
         if instr(tag$, "Tyt. oryg") then
            CS.DeleteField "246", x%
            tag$ = "24010" & mid$(tag$, instr(tag$, chr(223) & "a") + 3) & ". " & subfieldL & " Polish"
            CS.AddField 1, tag$
         end if
         tag$ = ""
         x% = x% + 1
      loop until not found246
      
      CS.GetField "260", 1, tag260$
      if instr(tag260$, "cop. ") then
         tag260$ = replace(tag260$, "cop. ", "c")
         tag260$ = replace(tag260$, "] s.", "] pages")
         CS.DeleteField "260", 1
         CS.AddField 1, tag260$
      end if
      
      CS.GetField "300", 1, tag300$
      tag300$ = replace(tag300$, "ilustracje", "illustrations") 
      tag300$ = replace(tag300$, " il. ", " illustrations ") 
      tag300$ = replace(tag300$, " kolor. ", " color ") 
      tag300$ = replace(tag300$, "kolorowe", "color") 
      tag300$ = replace(tag300$, "strony", "pages") 
      tag300$ = replace(tag300$, "strona", "pages") 
      tag300$ = replace(tag300$, "stron", "pages") 
      tag300$ = replace(tag300$, " s. ", " pages ") 
      CS.DeleteField "300", 1
      CS.AddField 1, tag300$

      CS.ReplaceTextAll ". " & chr(223) & "e Ilustrator", chr(223) & "e illustrator",0
      CS.ReplaceTextAll ", " & chr(223) & "e Ilustrator", chr(223) & "e illustrator",0
      CS.ReplaceTextAll chr(223) & "b illustrations color", chr(223) & "b color illustrations",0
      CS.ReplaceTextAll chr(223) & "e Autor", chr(223) & "e author",0
      CS.ReplaceTextAll ". " & chr(223) & "e author", ", " & chr(223) & "e author",0
      CS.ReplaceTextAll chr(223) & "l (pol.)", chr(223) & "l Polish",0

         
      if recType = "s" then                                 'serial
         deleteTags("030")                                    'even when 03X is checked, CODEN is retained
         deleteTags("210")
         deleteTags("222")
         deleteTags("263")
         deleteTags("510")
         deleteTags("515")
         deleteTags("580")
         deleteTags("780")
          
         'invalidate ISSN
         found022 = CS.GetField ("022", 1, ISSN)
         if found022 then
            ISSN = left(ISSN, 3) + "  " + chr(223) + "y " + mid(ISSN, 6)
            substring2 = instr(ISSN, chr(223) & "2")
            if substring2 > 0 then ISSN = left(ISSN, substring2 - 1)
            CS.DeleteField "022", 1
            CS.AddField 1, ISSN
         end if
         
         'move old 265 to 037
         found265 = CS.GetField ("265", 1, tag265)
         if found265 then
            tag265 = "037  " + subfieldB + mid(tag265, 6)
            CS.DeleteField "265", 1
            CS.AddField 1, tag265
         end if
     
         'add 082 (required for new CONSER records)
         'unless 082 is brought over in derive command
         found082 = CS.GetField ("082", 1, temp)
         if not found082 then
            if tag082 <> "" then
               tag082 = "08204" + mid(tag082, 6)
               if instr(tag082, subfield2) = 0 then tag082 = tag082 + subfield2 + DDC
               CS.AddField 1, tag082
            end if
         end if

         'move 785 to 130
         found785 = CS.GetField ("785", 1, tag785)
         if found785 then
            subpos = -1
            do while subpos <> 0     'remove control numbers
               subpos = instr(tag785, subfieldX)
               if subpos <> 0 then tag785 = mid(tag785, 1, subpos - 1)      
               subpos = instr(tag785, subfieldW)
               if subpos <> 0 then tag785 = mid(tag785, 1, subpos - 1)
            loop
      
            tag785 = "1300 " + mid(tag785, 8)
            deleteTags("785")
            CS.AddField 1, tag785
         end if
     
         'delete DBO and LIC notes
         foundbad500 = CS.FindText ("Latest issue consulted", FALSE)
         if foundbad500 then
            CS.DeleteCurrentField
            foundbad500 = FALSE
         end if  
     
         foundbad500 = CS.FindText ("Description based on", FALSE)
         if foundbad500 then CS.DeleteCurrentField

         'add 043 if not present
         found043 = CS.GetField ("043", 1, temp)
         if not found043 then CS.RunMacro "OCLC!Add043"
   
         'add link to old record
         CS.AddField 1, "78000"
         CS.CursorColumn = 99
         CS.Paste
         CS.SendKeys "%ei{ENTER}", 1      'insert from cited record
      
      end if    
      
   end if    

   'fix 082
   found082 = CS.GetField ("082", 1, temp)
   if instr(temp, "08200") then 
      temp = replace(temp, "08200", "08204")
      CS.DeleteField "082", 1
      CS.AddField 1, temp
   end if

   'add RDA
   CS.GetField "040", 1, temp
   if instr(temp, "e rda") then
      'do nothing
   else
      temp = temp & " " & chr(223) & "e rda"
      CS.SetField 1, temp
   end if 
   CS.SetFixedField "ELvl", "i"
   CS.SetFixedField "Srce", "d"
   CS.SetFixedField "Desc", "i"

   '260 to 264
   CS.GetField "260", 1, tag260$
   CS.DeleteField "260", 1
   CS.GetField "264", 1, tag264$
   if tag264$ > "" then
      'do nothing
   else
      tag260$ = "264 1" & mid(tag260$, 5)
      CS.SetField 1, tag260$
   end if
   
   '246 to 240
   CS.GetField "246", 1, tag246$
   if instr(tag246$, "orygina") then
      pos% = instr(tag246$, chr(223) & "a")
      tag246$ = mid(tag246$, pos%) & ". " & chr(223) & "l Polish"
      tag246$ = "24010" & tag246$
      CS.DeleteField "246", 1
      CS.SetField 1, tag246$
   end if

   '040 $b
   CS.GetField "040", 1, tag040
   if instr(tag040, chr(223) & "b") then
      'do nothing
   else
      tag040 = tag040 & " " & chr(223) & "b eng"
      CS.SetField 1, tag040
   end if
    
 end sub