'MacroName:490-830
'MacroDescription:4XX --> 8XX
'written by John Lavalie, Oct. 24, 2008

'--------------------   
function replace(strString as string, strOld as string, strNew as string) as string
   dim pos as integer
   pos = instr(strString, strOld)
   do while pos > 0
      strString = left(strString, pos - 1) & strNew & mid(strString, pos + len(strOld))
      pos = instr(strString, strOld)
   loop
   replace = strString   
end function
'-------------------
Sub Main

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

   CS.GetFieldLine CS.CursorRow, series4XX$
   series4XX$ = trim(series4XX$)

   if left(series4XX$, 3) = "490" then   
      tag$ = left(series4XX$, 3)
      if left(tag$, 1) <> "4" then exit sub
      ind = mid(series4XX$, 5, 1) : if ind = " " then ind = 0
      series4XX$ = mid(series4XX$, 6)   
   
      'remove his & hers   
      if left(series4XX$, 4) = "His " then series4XX$ = mid(series4XX$, 5)
      if left(series4XX$, 5) = "Hers " then series4XX$ = mid(series4XX$, 6)   

      series8XX$ = series4XX$
   
      'remove ISSN from 8XX
      ISSN% = instr(series8XX$, chr(223) & "x")
      if ISSN% > 0 then series8XX$ = left(series8XX$, ISSN% - 3)
   
      'remove $n and $p from 4XX
      series4XX$ = replace(series4XX$, chr(223) & "n ", "")
      series4XX$ = replace(series4XX$, chr(223) & "p ", "")      

      'remove initial article from 8XX
      if ind > 0 then 
         series8XX$ = mid(series8XX$, ind + 1)
         series8XX$ = ucase(left(series8XX$, 1)) & mid(series8XX$, 2)
      end if
   
      'add trailing punctuation
      if right(series8XX$, 1) like "[A-Z,a-z,0-9]" then series8XX$ = series8XX$ & "."
   
      'remove initial English articles
      if left(series8XX$, 2) = "A " then
         series8XX$ = mid(series8XX$, 3)
      elseif left(series8XX$, 3) = "An " then
         series8XX$ = mid(series8XX$, 4)
      elseif left(series8XX$, 4) = "The " then
         series8XX$ = mid(series8XX$, 5)
      end if

      CS.DeleteFieldLine CS.CursorRow
      CS.AddFieldLine CS.CursorRow, "4901 " & series4XX$      
      CS.AddField 99, "830 0" & series8XX$
   
   else
      tag$ = mid(series4XX$, 6)
      CS.GetField "100", 1, tag100$
      tag100$ = "8" & mid(tag100$, 2)
      pos% = instr(tag100$, chr(223) & "e")
      if pos% > 0 then tag100$ = trim(left(tag100$, pos% - 1))
      if right(tag100$, 1) = "," then tag100$ = left(tag100$, len(tag100$) - 1) & "."
      tag$ = tag100$ & " " & chr(223) & "t " & tag$
      CS.DeleteFieldLine CS.CursorRow
      CS.AddField 1, tag$
      
   end if
      
End Sub