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

Global CS As Object

'---------------------
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 = "22"                                             '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("263")
   deleteTags("856")  
        
   'modify new record
   if instr(tag040, subfieldB) and recType <> "s" then    'parallel record
       
      'CS.ReplaceTextAll "Incluye iŽndice.", "Includes index.", TRUE
            
      CS.AddField 1, "936  PR "
      CS.CursorColumn = 999
      CS.Paste 
      
      '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
      
   else  
   
      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
     
      CS.SetCursorFixedField "Alph"
      CS.InsertText "a"     
      
   end if    

   CS.SetCursorFixedField "ELvl"
   CS.InsertText "i"
   CS.SetCursorFixedField "Srce"
   CS.InsertText "d"
   CS.SetCursorFixedField "Desc"
   CS.InsertText "a"
   CS.Reformat
 
 end sub