'MacroName:047
'MacroDescription:adds 047 based on existing 650s
'written by John Lavalie, Sept. 21, 2006

option explicit
option compare binary
option base 1
global code$(100)

'-------------
sub loadCodes   

   code$(1) = "an,Antiphons"
   code$(2) = "an,Magnificats"
   code$(3) = "an,Anthems"
   code$(4) = "bd,Ballads"
   code$(5) = "bt,Ballets"
   code$(6) = "bg,Bluegrass"
   code$(7) = "bl,Blues"
   code$(8) = "cn,Canons"
   code$(9) = "cn,Rounds"
   code$(10) = "ct,Cantatas"
   code$(11) = "cz,Canzonas"
   code$(12) = "cr,Carols"
   code$(13) = "ca,Chaconnes"
   code$(14) = "cs,Aleatory"
   code$(15) = "cp,Chanson"
   code$(16) = "cc,Chants."
   code$(17) = "cb,Chants,"
   code$(18) = "cl,Chorale preludes"
   code$(19) = "ch,Chorales"
   code$(20) = "cg,Concerti grossi"
   code$(21) = "co,Concertos"
   code$(22) = "cy,Country music"
   code$(23) = "df,Dance"
   code$(24) = "dv,Divertimentos"
   code$(25) = "dv,Serenades"
   code$(26) = "dv,Cassations"
   code$(27) = "dv,Divertissemets"
   code$(28) = "dv,Notturni"
   code$(29) = "ft,Fantasias"
   code$(30) = "ft,Fancies"
   code$(31) = "ft,Fantasies"
   code$(32) = "fm,Folk music"
   code$(33) = "fg,Fugues"
   code$(34) = "gm,Gospel music"
   code$(35) = "hy,Hymns"
   code$(36) = "jz,Jazz"
   code$(37) = "md,Madrigals"
   code$(38) = "mr,Marches"
   code$(39) = "ms,Masses"
   code$(40) = "mz,Mazurkas"
   code$(41) = "mi,Minuets"
   code$(42) = "mo,Motets"
   code$(43) = "mp,Motion picture music"
   code$(44) = "mc,Musicals"
   code$(45) = "mc,Revues"
   code$(46) = "nc,Nocturnes"
   code$(47) = "op,Operas"
   code$(48) = "or,Oratorios"
   code$(49) = "ov,Overtures"
   code$(50) = "pt,Part-songs"
   code$(51) = "ps,Passacaglias"
   code$(52) = "ps,Ground bass"
   code$(53) = "ps,Ostinato"
   code$(54) = "pm,Passion music"
   code$(55) = "pv,Pavans"
   code$(56) = "po,Polonaises"
   code$(57) = "pp,Popular music"
   code$(58) = "pr,Preludes"
   code$(59) = "pg,Program music"
   code$(60) = "rg,Ragtime music"
   code$(61) = "rq,Requiems"
   code$(62) = "rp,Rhapsodies"
   code$(63) = "ri,Ricercars"
   code$(64) = "rc,Rock music"
   code$(65) = "rd,Rondos"
   code$(66) = "rd,Rondeaux"
   code$(67) = "sn,Sonatas"
   code$(68) = "sg,Songs"
   code$(69) = "sd,Square dance music"
   code$(70) = "st,Etudes"
   code$(71) = "su,Suites"
   code$(72) = "sp,Symphonic poems"
   code$(73) = "sy,Symphonies"
   code$(74) = "tc,Toccatas"
   code$(75) = "ts,Trio-sonatas"
   code$(76) = "vr,Variations"
   code$(77) = "wz,Waltzes"
   code$(78) = "cy,Country rock music"
   code$(79) = "rc,Country rock music"
   code$(80) = "rc,Heavy metal"
   code$(81) = "fm,Folk-rock"
   code$(82) = "rc,Folk-rock"
   code$(83) = "rc,Alternative rock"
   code$(84) = "sg,Children's songs"
   code$(85) = "pp,Rap (Music)"
   code$(86) = "cr,Christmas music"
   
end sub
'-------------------
Sub Main

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

   dim foundSH, dupCode
   dim x%, y%, z%, nrCodes%
   dim MARCtype$, temp$, subj$, tag047$, codestring$(20)
      
   'exit if not sound recording or score
   CS.GetFixedField "Type", MARCtype$
   if MARCtype$ <> "j" and MARCtype$ <> "c" then
      msgbox "Wrong MARC type", 0, "Error"
      exit sub
   end if   

   loadcodes
   
   x% = 1 : nrCodes% = 0 : foundSH = FALSE
   do 
      foundSH = CS.GetField (650, x%, subj$)
      if foundSH then
         subj$ = mid(subj$, 6)
         for y% = 1 to ubound(code$)
            if instr(subj$, mid(code$(y%), 5)) then 
               temp$ = left(code$(y%), 2)
               dupCode = FALSE
               for z% = 1 to ubound(codestring$)
                  if temp$ = codestring$(z) then dupCode = TRUE
               next
               if not dupCode then 
                  nrCodes% = nrCodes% + 1
                  codestring$(nrCodes%) = left(code$(y%), 2)
               end if
            end if
         next
      end if
      x% = x% + 1
   loop until not foundSH
   
   select case nrCodes%
      case 0
         'no codes, do nothing
         
      case 1
         CS.SetFixedField "Comp", codestring$(1)
         
      case else
         for x% = 1 to nrcodes% - 1
           tag047$ = tag047$ & codestring$(x%) & " " & chr(223) & "a "
         next
         tag047$ = "047  " & tag047$ & codestring$(nrCodes%)
         CS.SetField 1, tag047$
         CS.SetFixedField "Comp", "mu"

   end select

   CS.Reformat

End Sub