'MacroName:505to700
'MacroDescription:creates 700s from 505r
'written by John Lavalie, July 3, 2006

option explicit
option compare text

'--------------------   
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
'-------------------
function Make710(heading as string, needsQualifier as string) as string
   dim temp$
   heading = replace(heading, "&", "")
   heading = trim(heading)
   
   if right(heading, 10) = "production" then heading = trim(replace(heading, "production", ""))
   if instr(heading, "presented by") > 0 then heading = trim(replace(heading, "presented by", ""))
   
   if left(heading, 2) = "a " then heading = mid(heading, 3)
   if left(heading, 3) = "an " then heading = mid(heading, 4)
   if left(heading, 4) = "the " then heading = mid(heading, 5)
   
   temp$ = "7102 " & trim(heading)
   if needsQualifier = "TRUE" then 
      temp$ = temp$ & " (Musical group)"
   else
      temp$ = temp$ & "."
   end if
   
   Make710 = temp$
end function
'-------------------
function Make700(heading as string) as string
   dim split, x as integer
   dim firstName, lastName as string
   heading = trim(heading)
   
   x = len(heading)
   do
      if mid(heading, x, 1) = " " then split = x
      x = x - 1
   loop until x = 1 or split <> 0
    
   if split <> 0 then 
      firstName = trim(left(heading, split))
      lastName = trim(mid(heading, split))
   else
      firstName = heading
      lastName = ""
   end if
      
   'two first initials
   if right(firstName, 4) like "[A-Z].[A-Z]." then 
      firstName = left(firstName, len(firstName) - 2) & " " & right(firstName, 2)
   end if
   
   'put back suffix
   if instr(lastName, "~Jr.") > 0 then
      firstName = firstName & ", " & chr(223) & "c Jr"
      lastName = replace(lastName, "~Jr.", "")
   elseif instr(lastName, "~Sr.") > 0 then
      firstName = firstName & ", " & chr(223) & "c Sr"
      lastName = replace(lastName, "~Sr.", "")
   end if
      
   if lastName = "" then
      heading = "7001 " & firstName
   else
      heading = "7001 " & lastName & ", " & firstName 
   end if
   if right(heading, 1) <> "." then heading = heading & "."
   Make700 = heading 
end function
'---------------------
function CountBlanks(str as string) as integer
   dim i%, count%
   for i% = 1 to len(str)  
      if mid(str, i%, 1) = " " then count% = count% + 1
   next
   CountBlanks = count%
end function
'---------------------
function firstInitial(heading as string) as integer
   dim x as integer
   firstInitial = 0
   for x = 1 to len(heading) - 4
      if mid(heading, x, 4) like " [A-Z]. " then firstInitial = x
   next
end function
'---------------------
function isGroup(heading as string) as integer
   dim groups$(50), x%
   isGroup = FALSE

   groups$(0) = "orchestra" : groups$(1) = "chorus"    : groups$(2) = "group"
   groups$(3) = "duo"       : groups$(4) = "trio"      : groups$(5) = "quartet"
   groups$(6) = "quintet"   : groups$(7) = "septet"    : groups$(8) = "sextet"
   groups$(9) = "octet"     : groups$(10) = "nonet"    : groups$(11) = "grupo"
   groups$(12) = "band"     : groups$(13) = "brothers" : groups$(14) = "sisters"
   groups$(15) = "girls"    : groups$(16) = "girlz"    : groups$(17) = "boys"
   groups$(18) = "boyz"     : groups$(19) = "singers"  : groups$(20) = "musical"
   groups$(21) = "banda"    : groups$(22) = "choir"    : groups$(23) = "corporation"
   groups$(24) = "project"  : groups$(25) = "organization"
   groups$(26) = "ensemble"

   x% = 0   
   do while groups$(x%) <> "" 
      if instr(heading, groups$(x%)) then isGroup = TRUE
      x% = x% + 1
   loop
   
   if right(heading, 1) like "[0-9]" then isGroup = TRUE
   
end function
'---------------------
Sub Main 

dim bool, Dup
dim tag505$, delim$
dim pos%, pipe%, nr505s%, i%, j%
dim nrNames%, nrHeadings%, nrBlanks%
dim Names$(100), Headings$(100)

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

   CS.Reformat
   delim$ = chr(223)  
   nr505s% = 1
   bool = CS.GetField ("505", nr505s%, tag505$)
   
   do until bool = FALSE
      if mid(tag505$, 5, 1) <> "0" then 
         CS.RunMacro "NikAdds!Joels505"
         'MsgBox "Contents note is not enhanced.", 0, "Error"
         'exit sub
      end if
      
      tag505$ = mid(tag505$, 8)
      tag505$ = replace(tag505$, ", Jr.", "~Jr.")
      tag505$ = replace(tag505$, ", Sr.", "~Sr.")
      tag505$ = replace(tag505$, delim$ & "t", "|")
      tag505$ = replace(tag505$, delim$ & "g", "|")
      tag505$ = replace(tag505$, " -- ", "")
      tag505$ = replace(tag505$, " ; ", "")

      if right(tag505$, 1) = "." then tag505$ = left(tag505$, len(tag505$) - 1)
      tag505$ = tag505$ & "|"
   
      pos% = instr(tag505$, delim$ & "r")
      do until pos% = 0
         pipe% = instr(pos%, tag505$, "|")
         Names$(nrNames%) = mid(tag505$, pos% + 2, pipe% - pos% - 2)
         nrNames% = nrNames% + 1
         pos% = instr(pipe%, tag505$, delim$ & "r")
      loop
      nrNames% = nrNames% - 1

      'first split   
      for i% = 0 to nrNames%
         Names$(i%) = trim(Names$(i%))
         Names$(i%) = replace(Names$(i%), "featuring", "|")
         Names$(i%) = replace(Names$(i%), "feat.", "|")
         Names$(i%) = replace(Names$(i%), " with ", "|")
         Names$(i%) = replace(Names$(i%), "(with ", "|")
         Names$(i%) = replace(Names$(i%), "con ", "|")
         Names$(i%) = replace(Names$(i%), "(con ", "")
         Names$(i%) = replace(Names$(i%), " y ", "|")
         Names$(i%) = replace(Names$(i%), "(y ", "")
         Names$(i%) = replace(Names$(i%), delim$ & "r with ", "")
         Names$(i%) = replace(Names$(i%), delim$ & "r con ", "")
         Names$(i%) = replace(Names$(i%), " and his orchestra", "")
         Names$(i%) = replace(Names$(i%), " and his ", "|")
         Names$(i%) = replace(Names$(i%), " and friends ", "")
         Names$(i%) = replace(Names$(i%), " & friends ", "")
         Names$(i%) = replace(Names$(i%), " and ", "|")
         Names$(i%) = replace(Names$(i%), " & ", "|")
         Names$(i%) = replace(Names$(i%), ", ", "|")
         Names$(i%) = replace(Names$(i%), " + ", "|")
         Names$(i%) = replace(Names$(i%), "a du" & chr(180) & " o con ", "")
         
         if left(Names$(i%), 1) = "(" then Names$(i%) = mid(Names$(i%), 2)
         if right(Names$(i%), 1) = ")" then Names$(i%) = left(Names$(i%), len(Names$(i%)) - 1)
      next
   
      'second split
      for i% = 0 to nrNames%
         pos% = instr(Names$(i%), "|")
         do
            if pos% > 0 then
               Headings$(nrHeadings%) = trim(left(Names$(i%), pos% - 1))      
               nrHeadings% = nrHeadings% + 1
               Names$(i%) = trim(mid(Names$(i%), pos% + 1))
            else
               Headings$(nrHeadings%) = trim(Names$(i%))      
               nrHeadings% = nrHeadings% + 1
               Names$(i%) = ""
            end if     
            pos% = instr(Names$(i%), "|")
         loop until pos% = 0 and Names$(i%) = ""
      next

      nrHeadings% = nrHeadings% + 1
      nrNames% = 0

      'check for dups
      for i% = 0 to nrHeadings%
         Dup = FALSE
         for j% = 0 to nrNames%
            if Names$(j%) = Headings$(i%) then Dup = TRUE
         next j%
      
         if Dup = FALSE then 
            Names$(nrNames%) = Headings$(i%)
            nrNames% = nrNames% + 1
         end if
      next i%
      nrHeadings% = 0
      nrNames% = nrNames% - 1  
      nr505s% = nr505s% + 1   
      bool = CS.GetField ("505", nr505s%, tag505$)
   loop
   
   '700 or 710?
   for i% = 0 to nrNames%
       if isGroup(Names$(i%)) then
         Names$(i%) = Make710(Names$(i%), "FALSE")
       else
          nrBlanks% = CountBlanks(Names$(i%))  'more than one blank *probably* means 710
          if nrBlanks% = 2 then                
            pos = firstInitial(Names$(i%))
            if pos > 0 then                    'except for single middle initial
               Names$(i%) = Make700(Names$(i%))
            else
               Names$(i%) = Make710(Names$(i%), "TRUE")
            end if  
          else
            if left(Names$(i%), 2) = "a " or left(Names$(i%), 3) = "an " or left(Names$(i%), 4) = "the " or nrBlanks% > 1 then
               Names$(i%) = Make710(Names$(i%), "TRUE")
            elseif left (Names$(i%), 3) = "DJ " or left (Names$(i%), 3) = "MC " then 
               Names$(i%) = "7000 " & Names$(i%) & "."
               Names$(i%) = replace(Names$(i%), "..", ".")
            else
               Names$(i%) = Make700(Names$(i%))
            end if
          end if
        end if
       Names$(i%) = replace(Names$(i%), ".", "")
       CS.AddFieldLine 99, Names$(i%) & ", " & delim$ & "e performer"       
   next
end sub