Option Explicit

   Global Const CharacterSet_MARC8$ = "M"   
   Global Const CharacterSet_OCLC$ = "O"
   Global Const CharacterSet_UTF8$ = "U"
   Global Const CharacterSet_Voyager$ = "V"

   ' ***********************************
   ' change the following constants as desired
   ' ***********************************    

   ' add $5 DLC to 642,644-646 fields which don't have it?
   Global Const Add5DLC% = True

   ' categorically remove certain bibliographic fields from imported records?
   Global Const BibTagsToDiscard$ = "012 016 029 035 049 073 098 099 263 360 890"

   ' what is the current edition of Dewey?
   Global Const DeweyEdition$ = "22"
        
   ' delete the input file when done (if successful)?
   Global Const FileDelete% = True

   ' what is the complete name of the file containing an incoming authority record?
   Global Const InAutFileName$ = "c:\oclcapps\import.aut"

   ' what is the complete name of the file containing an incoming bibliographic record?
   Global Const InBibFileName$ = "c:\oclcapps\import.bib"
    
   ' keep 4xx and 5xx fields marked with local NUC code in subfield $5?
   Global Const IncludeAuth4xx5xxWith5% = False

   ' replace uploaded authority records?
   ' there shouldn't be any need to use this macro unless you're
   '   overwriting the existing record
   Global Const LockAuthority% = True

   ' replace uploaded bibliographic records?
   Global Const LockBibliographic% = True ' False
   
   ' what is your NUC code?
   Global Const LocalNUC$ = "HU"

   ' should the 001 field be moved to 035 (prefixed with NUC code)?
   Global Const Move001to035% = True

   ' move bibliographic 035(DNLM) fields to 069?
   Global Const Move035DNLM% = False ' True
        
   ' Move 533 subfield 7 to 539 field?
   Global Const Move5337to539% = True

   ' what character set is used by the OCLC system? (see the CharacterSet constants above)
   Global Const OclcCharacterSetCode$ = CharacterSet_OCLC$
  
   ' what is your OCLC symbol?
   Global Const OCLCSymbol$ = "HUH"

   ' remove 4xx if $w nnnn9? (probably relevant for Northwestern only; but harmless for others)
   Global Const Removewnnn9% = True

   ' move 082 without $2 to 092?
   Global Const Shift082% = False ' True

   ' move 050 etc. with 2nd indicator '4' to 090, etc.?    
   Global Const ShiftCallNumbers% = False

   ' shift personal name first indicators from '2' to '1'?
   Global Const ShiftPersonalIndicators% = True

   ' what character set is used in the records we're going to
   '   be importing? (see the CharacterSet constants above)
   Global Const SourceSystemCharacterSetCode$ = CharacterSet_Voyager$

   ' ***********************************
   ' end of constants you should concern yourself with
   ' ***********************************       

   Global Const TransferFileResultsName$ = "c:\oclccomm.txt"

   Global Const gblsCaption$ = "Export an OCLC record"

   ' the String2 variables are replacements for superscripts, 3 greeks and
   '   subscripts
   Global Const sBString2$ = "1234567890(+-)"
   Global Const sGString2$ = "abc"
   Global Const sPString2$ = "1234567890(+-)"

   Global CS As Object, MARC As Object

   Global WorkFormType$, OclcDelim$, MarcDelim$, OclcFill$, OclcScriptL$, sGString$
   Global sBString$, sPString$, sNull$, sAsciiMaximum$, sDiacriticsAboveHere$
   Global OclcAyn$, MarcAyn$, DiacriticsAbove$, DiacriticsOther$, sDialogAnswer$
   Global sMarcFormatCode$, VoyagerGreeksEtc$, OclcGreeksEtc$

   Global iDebug%

   Global bDebug As Integer
      
   ' forward declarations of routines with parameters go here
   Declare Function Fix007(sField$) As String
   Declare Function GetTickCount Lib "kernel32" () As Long
   Declare Function Marc2Oclc(sInFileName$) As Integer
   Declare Function Marc2OclcScreenFont(sField$) As String
   Declare Function RecallAndWipe(sType$, sOCLC$) As Integer
   Declare Function UserDialogFunction(id$, action%, suppvalue&)
   Declare Sub Put008(sLabel$, iStart%, iLength%)
   Declare Sub PutLeader(sLabel$, iStart%)
   Declare Sub WriteLeaderAnd008()
   

Sub Main

   Dim iIn%, iHaveBib%

   dim sRecord$, sInFileName$, sBuffer$


   Begin Dialog UserDialog1 1, 10, 167, 46, "Select import record type", .UserDialogFunction
      CancelButton  112, 24, 39, 14, .CANCEL
      Text  10, 11, 150, 12, "Import a bibliographic or an authority record?"
      PushButton  63, 24, 41, 14, "&Authority", .AUTH
      PushButton  7, 24, 49, 14, "&Bibliographic", .BIB
   End Dialog


   'bDebug = False
   
   Set CS = CreateObject("Connex.Client")

   If Not CS.IsOnline Then
      MsgBox "Log on to OCLC before running this macro.", 0, gblsCaption$
      Exit Sub
   End If

   If Len(InBibFileName$)>0 Then
      If Len(InAutFileName$) = 0 Then ' only bib is defined
         sInFileName = InBibFileName$
      ElseIf InBibFileName$ = InAutFileName$ Then ' both defined, but same
         sInFileName = InBibFileName$
      Else
         ' both file names are defined
         ' next question: do both file names exist?
         On Error GoTo gfsNoBibFile
         sBuffer = Dir(InBibFileName$)
         On Error GoTo 0
         If len(sBuffer$) > 0 Then
            iHaveBib% = True
         End If
gfsNoBibFile:
         On Error GoTo gfsNoAutFile
         sBuffer$ = Dir(InAutFileName$)
         On Error GoTo 0
         If len(sBuffer$)>0 Then
            If iHaveBib% = True Then
               ' both defined and both exist
               Dim uTwoFiles as UserDialog1
               On Error Resume Next
               Dialog uTwoFiles
               On Error GoTo 0
               Select Case sDialogAnswer$
                  Case "AUTH", ".AUTH"
                     sInFileName$ = InAutFileName$
                  Case "BIB", ".BIB"
                     sInFileName$ = InBibFileName$
                  Case Else
                     Exit Sub
               End Select
            Else
               ' only authority file exists
               sInFileName$ = InAutFileName$
            End If
         Else
gfsNoAutFile:         
           ' we hope the bib file exists (not necessarily tested)
           sInFileName$ = InBibFileName$
         End If         
      End If
   Else
     ' no bib file defined
     If Len(InAutFileName$) = 0 then
        MsgBox "This macro does not appear to be set up correctly", 0, "Upload a record"
        Exit Sub
     End If
     ' only authority file is defined (not actually tested)
     sInFileName$ = InAutFileName$
   End If

   Set MARC = CreateObject("MarcRecordDLL.Utf8MarcRecordDLL")

   ' NOTE that we're translating the incoming record into the 'Voyager'
   '   character set. this is done intentionally, mostly because this gives us
   '   a single-character representation for the superscripts, subscripts and
   '   3 greek characters, making the final translation into the OCLC screen
   '   character set even simpler
   ' this will doubtless change when OCLC moves to Unicode
   Marc.CharacterSetIn = SourceSystemCharacterSetCode$
   Marc.CharacterSetOut = CharacterSet_Voyager$

   MarcDelim$ = MARC.MarcDelimiter
   OclcDelim$ = Chr(223) ' the character used by OCLC for the MARC 'delimiter' character
   ' these 2 strings--which have the same length exactly--convert
   '   characters in the Voyager character set into the OCLC screen display
   '   set (see note above about the MARC record object's CharacterSetOut property)
   '                alpha      beta       gamma      super 1    super 2    super 3    super 4    super 5    super 6    super 7    super 8    super 9    super 0    super +    super -    super (    super )    sub 1      sub 2      sub 3      sub 4      sub 5      sub 6      sub 7      sub 8      sub 9      sub 0      sub +      sub -      sub (      sub )      script-l   delim      fill       ayn
   OclcGreeksEtc$ = Chr(193) + Chr(194) + Chr(196) + Chr(145) + Chr(146) + Chr(147) + Chr(148) + Chr(149) + Chr(150) + Chr(151) + Chr(152) + Chr(153) + Chr(144) + Chr(157) + Chr(156) + Chr(154) + Chr(155) + Chr(129) + Chr(130) + Chr(131) + Chr(132) + Chr(133) + Chr(134) + Chr(135) + Chr(136) + Chr(137) + Chr(128) + Chr(140) + Chr(141) + Chr(138) + Chr(139) + Chr(190) + Chr(223) + Chr(252) + Chr(187)
   '                   alpha      beta       gamma      super 1    super 2    super 3    super 4    super 5    super 6    super 7    super 8    super 9    super 0    super +    super -    super (    super )    sub 1      sub 2      sub 3      sub 4      sub 5      sub 6      sub 7      sub 8      sub 9      sub 0      sub +      sub -      sub (      sub )      script-l   delim                fill            ayn
   VoyagerGreeksEtc$ = Chr(175) + Chr(190) + Chr(191) + Chr(193) + Chr(194) + Chr(195) + Chr(196) + Chr(197) + Chr(198) + Chr(199) + Chr(200) + Chr(201) + Chr(192) + Chr(202) + Chr(203) + Chr(204) + Chr(205) + Chr(209) + Chr(210) + Chr(211) + Chr(212) + Chr(213) + Chr(214) + Chr(215) + Chr(216) + Chr(217) + Chr(208) + Chr(218) + Chr(219) + Chr(220) + Chr(221) + Chr(160) + MARC.MarcDelimiter + Marc.MarcFill + MARC.MarcAyn

   sDiacriticsAboveHere$ = Chr(223)
   sAsciiMaximum$ = Chr(128) ' in this macro, standard characters are "below" this
   
   DiacriticsAbove$ = MARC.MarcAcute + MARC.MarcAcuteDouble + MARC.MarcAngstrom + MARC.MarcBreve + MARC.MarcCandrabindu + MARC.MarcCircumflex + MARC.MarcCommaHighCentered + MARC.MarcCommaHighOffCenter + MARC.MarcDotAbove + MARC.MarcGrave + MARC.MarcHacek + MARC.MarcLigatureLeft + MARC.MarcLigatureRight + MARC.MarcMacron + MARC.MarcQuestionPseudo + MARC.MarcTilde + MARC.MarcTildeDoubleLeft + MARC.MarcTildeDoubleRight + MARC.MarcUmlaut
   DiacriticsOther$ = MARC.MarcCedilla + MARC.MarcCedillaRight + MARC.MarcCircleBelow + MARC.MarcDotBelow + MARC.MarcDotBelowDouble + MARC.MarcHookLeft + MARC.MarcHookRight + MARC.MarcUnderscore + MARC.MarcUnderscoreDouble + MARC.MarcUpadhmaniya   

   ' if the file doesn't exist, we're going to end up with no
   '   record, and we'll "trap" the error in that manner
   On Error Resume Next
   Marc.FileOpen sInFileName$   
   Marc.FileReadNextRecord sRecord$
   Marc.FileClose

   If Marc2Oclc(sRecord$) = True Then
      If FileDelete = True Then
         On Error Resume Next
         Kill sInFileName$
         On Error GoTo 0
      End If
   End If

End Sub

Function Marc2Oclc(sRecord$) As Integer

   ' we arrive here with a MARC record supplied from the
   '   outside
   ' at this point we know nothing about the record

   ' the OCLC connection and the MARC record object are already
   '   initialized and connected


   Dim sFormat$, sMyOclc$, sTag$, sField$, sIndicators$, s009$, sWriteResultsFileName$

   Dim iCtr%, iLine%, iOut%

   Dim bExistingRecord As Integer, bWriteResults As Integer


   ' assume badness
   Marc2Oclc = False

   On Error GoTo 0
   If Len(sRecord$) = 0 Then
      Exit Function
   End If
   Marc.MarcRecordIn = sRecord$
   If Len(MARC.MarcRecordOut) = 0 Then
      Exit Function
   End If


   ' we use the 009 field for communication with other macros that may be
   '   calling this one
   If Marc.FldFindFirst("009") Then
      s009$ = Marc.FldText
      Marc.FldDelete
      ' here we figure out what it is that the external program has in mind
      ' the 009 field contains one or more segments
      ' each segment begins with a label optionally followed by a colon and
      '   some additional stuff
      ' we'll add stuff here as need demands
      ' the "WRES" label means: "write results to the output file whose name
      '   is defined by TransferFileResultsName$"
      iCtr% = Instr(s009$, "WRES")
      If iCtr% > 0 Then
         sWriteResultsFileName$ = TransferFileResultsName$
         bWriteResults = True
         ' assume: bad results
         on error resume next
         Kill sWriteResultsFileName$
         iCtr% = FreeFile
         Open sWriteResultsFileName$ For Output As #iCtr%
         Print #iCtr%, "[UploadResults]"
         Close #iCtr%
         DoEvents
      End If
   End If
   
   
   Begin Dialog UserDialog2 0, 0, 163, 42, "Ready to upload record", .UserDialogFunction
      CancelButton  51, 22, 39, 14, .CANCEL
      Text  10, 11, 150, 12, "Ready to complete upload"
      PushButton  6, 22, 41, 14, "&OK", .OK
   End Dialog


   sMarcFormatCode$ = MARC.MarcRecordFormat
   
   ' is this an overlay of an existing  record?
   If sMarcFormatCode$ = "A" Then
      ' if the authority record contains an LC 010, call up
      '   the record and prepare it for replacement
      If MARC.FldFindFirst("010") Then
         If MARC.SfdFindFirst("a") Then
            sMyOclc$ = Trim(MARC.SfdText)
         End If
         If Not RecallAndWipe("A", sMyOclc$) Then
            CS.Reformat
            Exit Function
         End If
         bExistingRecord = True
      End If
   Else ' one of the bibliographic formats
      MARC.FldMoveTop
      ' if the authority record contains an OCLC number, call up
      '   the record and prepare it for replacement
      Do While MARC.FldFindNext("035")
         sMyOclc$ = Mid(MARC.FldText, 3)
         If Mid(UCase(sMyOclc$), 1, 7) = "(OCOLC)" Then
            sMyOclc$ = Trim(Mid(sMyOclc$, 8))
            If Mid(sMyOclc$, 1, 1) = "o" Then
               sMyOclc$ = Mid(sMyOclc$, 4)
            End If
            MARC.FldDelete ' remove the OCLC number from the incoming record
            If Not RecallAndWipe("B", sMyOclc$) Then
               CS.Reformat
               Exit Function
            End If
            bExistingRecord = True
            Exit Do
         End If
      Loop
   End If


   ' if the incoming record doesn't represent something that's already
   '   in OCLC, then call up a blank workform
   If bExistingRecord = False Then
      Select Case sMarcFormatCode$
         Case "A"
            sFormat$ = "abl" ' authority blank workform
            ' exclude incoming records that are obviously
            '   topical subjects
            If Not MARC.FldFindFirst("1") Then ' authority records must have a 1XX!
               Exit Function
            End If
            If MARC.FldTag = "150" Or Mid(Marc.FldTag, 1, 2) = "18" Then
               MsgBox "Cannot upload this authority record to OCLC.  Consider a SACO proposal."
               Exit Function
            End If
            Marc.SfdMoveLast
            If Instr("vxyz", MARC.SfdCode) > 0 Then
               MsgBox "Cannot upload this authority record to OCLC.  Consider a SACO proposal."
               Exit Function
            End If
         Case "B"
            sFormat$ = "bks"
         Case "D"
            sFormat$ = "com"
         Case "F"
            sFormat$ = "vis"
         Case "M"
            If Instr("cd", MARC.GetLeaderValue(6, 1)) > 0 Then
               sFormat$ = "sco"
            Else
               sFormat$ = "rec"
            End If
         Case "P"
            sFormat$ = "map"
         Case "S"
            sFormat$ = "ser"
         Case "U"
            sFormat$ = "mix"
         Case Else
            Exit Function
      End Select         
      ' open a blank workform in OCLC
      If CS.OpenWorkform(sFormat$) = False Then
         Exit Function
      End If
   End If


   ' if we get here, we've either recalled an existing record and it's
   '   ready to be written on; or we've called up a blank workform
   '   and it's ready to be written on, too
   ' so all we have to do is write the record to Voyager
   
   ' deal with the 'fixed fields'
   WriteLeaderAnd008


   CS.Reformat


   iLine% = 0
   Do While CS.GetFieldLine(iLine%+1, sField$)
      'msgbox str(iline%+1)+" "+sfield$
      ' we're really just incrementing the counter so we
      '   know what the first program-added field is going to be
      iLine% = iLine% + 1
   Loop

   ' Dan Whitney: This is where we insert the delay
   
   If 3=3 Then
      Dim uTwoFiles2 as UserDialog2
      On Error Resume Next
      Dialog uTwoFiles2
      On Error GoTo 0
      If sDialogAnswer$ = "OK" Or sDialogAnswer$ = ".OK" Then
         ' do nothing
      Else
         If bExistingRecord = True Then
            CS.ReleaseRecordLock
            DoEvents
            CS.CloseRecord
            DoEvents
         End If
         Exit Function
      End If
   Else
      msgbox "OK?"
   End If


   MARC.FldMoveTop
   Do While MARC.FldMoveNext
      If Not MARC.FldDeleted Then
         MARC.FldLoadInfo sTag$, sIndicators$, sField$
         Select Case sTag$
            Case "001"
               If Move001to035% = True Then
                  If Len(LocalNUC$) > 0 Then
                     iLine% = iLine% + 1
                     'msgbox "Ready to add 035 at "+str(iline%)
                     CS.AddFieldLine iLine%, "035  (" + LocalNUC$ + ")" + sField$                     
                  End If
               End If
            Case "003", "004", "005", "008", "009", "040", "049", "938", "948", "949"
               ' do nothing more with these fields, no matter what (we've done the 008 already)
            Case "010"
               If sMarcFormatCode$ <> "A" Then
                  iLine% = iLine% + 1
                  On Error Resume Next
                  sField$ = MARC.Marc2OclcScreenFont(sField$)
                  on error goto 0
                  CS.AddFieldLine iLine%, sTag$ + sIndicators$ + sField$
               End If
            Case "035"
               If Instr(sField$, ")") > 0 Then
                  iLine% = iLine% + 1
                  On Error Resume Next
                  sField$ = MARC.Marc2OclcScreenFont(sField$)
                  on error goto 0
                  CS.AddFieldLine iLine%, sTag$ + sIndicators$ + sField$
               End If
            Case "006"
               iLine% = iLine% + 1
               sField$ = "[" + sField$ + "]"
               sField$ = MARC.Marc2OclcScreenFont(sField$)
               CS.AddFieldLine iLine%, "006  " + sField$                     
            Case "007"
               sField$ = MARC.Marc2OclcScreenFont(sField$)
               sField$ = Fix007(sField$)
               iLine% = iLine% + 1
               CS.AddFieldLine iLine%, "006  " + sField$                     
            Case "533"
               ' todo: break off $7 if necessary and input as separate field
            Case Else
               ' adjust indicators as necessary
               If ShiftPersonalIndicators% = True Then
                  If sMarcFormatCode$ = "A" Then
                     If Instr("100 400 500 700", sTag$) > 0 Then
                        If Mid(sIndicators$, 1, 1) = "2" Then
                           sIndicators$ = "1" + Mid(sIndicators$, 2, 1)
                        End If
                     End If
                  Else
                     If Instr("100 400 600 700 800", sTag$) > 0 Then
                        If Mid(sIndicators$, 1, 1) = "2" Then
                           sIndicators$ = "1" + Mid(sIndicators$, 2, 1)
                        End If
                     End If
                  End If
               End If               
               iLine% = iLine% + 1
               on error resume next
               sField$ = MARC.Marc2OclcScreenFont(sField$)
               on error goto 0
               CS.AddFieldLine iLine%, sTag$ + sIndicators$ + sField$
         End Select
      End If
      On Error GoTo 0
   Loop

   Marc2Oclc = True


   CS.Reformat


   If bWriteResults = True Then
      On Error Resume Next
      iCtr% = FreeFile
      Open sWriteResultsFileName$ For Append Access Write As #iCtr%
      Print #iCtr%, "Success=Y"
      If bExistingRecord = True Then
         Print #iCtr%, "New=N" ' it's an overlay
         Print #iCtr%, "OCLC=" + sMyOclc$ ' probably not going to be used ...
      Else
         Print #iCtr%, "New=Y"
      End If
      Close #iCtr%
      DoEvents
   End If

   
   Exit Function
         
End Function

Function UserDialogFunction(id$, action%, suppvalue&)

   ' the built-in dialog box function comes here when the operator
   '   clicks a button on our dialog box; we simply transfer the
   '   button's identifier to our own storage so we can examine
   '   the result
   sDialogAnswer$ = id$
   
End Function

Sub WriteLeaderAnd008()

   If sMarcFormatCode$ = "A" Then
      ' just write all of the stuff here
      PutLeader "Enc lvl", 17
      Put008 "Geo subd", 6, 1
      Put008 "Roman", 7, 1
      ' 8, language of catalog, not displayed by OCLC
      Put008 "Auth/ref", 9, 1
      Put008 "Rules", 10, 1
      Put008 "Subj", 11, 1
      Put008 "Series", 12, 1
      Put008 "Ser num", 13, 1
      Put008 "Name use", 14, 1
      Put008 "Subj use", 15, 1
      Put008 "Ser use", 16, 1
      Put008 "Subdiv tp", 17, 1
      ' 18-27 undefined
      Put008 "Govt agn", 28, 1
      Put008 "Ref status", 29, 1
      ' 30 undefined
      Put008 "Upd status", 31, 1
      Put008 "Name", 32, 1
      Put008 "Auth status", 33, 1
      ' 34-37 undefined
      Put008 "Mod rec", 38, 1
      Put008 "Source", 39, 1
   Else
      ' these are the parts of the fixed fields that are common
      '   to all of the bibliographic formats
      PutLeader "Desc", 18
      PutLeader "ELvl", 17
      PutLeader "Ctrl", 8
      Put008 "DtSt", 6, 1
      Put008 "Dates", 7, 4 ' this is just date 1
      Put008 ",", 11, 4 ' this is date 2
      Put008 "Ctry", 15, 3
      Put008 "Lang", 35, 3
      Put008 "MRec", 38, 1
      Put008 "Srce", 39, 1
   
      ' the central part of the 008 is different for each
      '   of the bibligraphic formats
      Select Case sMarcFormatCode$
         Case "B"
            Put008 "Ills", 18, 4
            Put008 "Audn", 22, 1
            Put008 "Form", 23, 1
            Put008 "Cont", 24, 4
            Put008 "GPub", 28, 1
            Put008 "Conf", 29, 1
            Put008 "Fest", 30, 1
            Put008 "Indx", 31, 1
            ' 32 undefined
            Put008 "Litf", 33, 1
         Case "D"
            ' 18-21 undefined
            Put008 "Audn", 22, 1
            ' 23-25 undefined
            Put008 "File", 26, 1
            ' 27 undefined
            Put008 "GPub", 28, 1
            ' 29-34 undefined
         Case "F"
            Put008 "Time", 18, 3
            ' 21 undefined
            Put008 "Audn", 22, 1
            ' 23-27 undefined
            Put008 "GPub", 28, 1
            Put008 "Form", 29, 1
            ' 30-32 undefined
            Put008 "TMat", 33, 1
            Put008 "Tech", 34, 1
         Case "M"
            Put008 "Comp", 18, 2
            Put008 "FMus", 20, 1
            'Put008 "", 21, 1 ' PARTS ??????????
            Put008 "Audn", 22, 1
            Put008 "Form", 23, 1
            Put008 "AccM", 24, 6
            Put008 "LTxt", 31, 2
            ' 32 undefined
            'Put008 "", 33, 1  ' TRANSPOSITION AND ARRANGEMENT ???????
            ' 34 undefined  
         Case "P"
            Put008 "Relf", 21, 4
            Put008 "Proj", 22, 2
            ' 24 undefined
            Put008 "CrTp", 25, 1
            ' 26-27 undefined
            Put008 "GPub", 28, 1
            Put008 "Form", 29, 1
            ' 30 undefined
            Put008 "Indx", 31, 1
            ' 32 undefined
            Put008 "SpFm", 33, 2   
         Case "S"
            Put008 "Freq", 18, 1
            Put008 "Regl", 19, 1
            Put008 "ISSN", 20, 1
            Put008 "SrTp", 21, 1
            Put008 "Orig", 22, 1
            Put008 "Form", 23, 1
            Put008 "EntW", 24, 1
            Put008 "Cont", 25, 3
            Put008 "GPub", 28, 1
            Put008 "Conf", 29, 1
            ' 30-32 are undefined
            Put008 "Alph", 33, 1
            Put008 "S/L", 34, 1
         Case "U"
            ' 18-22 undefined   
            Put008 "Form", 23, 1
            ' 24-34 undefined   
      End Select               
   End If
   
End Sub

Sub Put008(sLabel$, iStart%, iLength%)

   ' todo? deal with the fill character??
   
   Dim sData$, sDate2$
   
   sData$ = MARC.Get008Value(iStart%, iLength%)
   
   If sLabel$ = "Dates" Then
      sDate2$ = Mid(sData$, 5)
      sData$ = Mid(sData$, 1, 4)   
      CS.SetFixedField sLabel$, sData$
      CS.SetFixedField ",", sDate2$
   Else
      CS.SetFixedField sLabel$, sData$
   End If
   
End Sub

Sub PutLeader(sLabel$, iStart%)

   dim sData$
   
   sData$ = MARC.GetLeaderValue(iStart%, 1)
   
   CS.SetFixedField sLabel$, sData$
   
End Sub

Function Fix007(sField$) As String

   Dim sField2$
   
   sField2 = sField
   sField = mid(sField,1,1) + OclcDelim$ + "b" + mid(sField2, 2, 1)
   ' note that 'o' (kit) 'q' (notated music) 't' (text) and 'z' (unspecified) aren't
   '   needed here in this Select Case because they're only 2 charcters long
   Select Case mid(sField2, 1, 1)
      Case "a" ' maps
         sField = sField + OclcDelim$ + "d" + mid(sField2, 4, 1) + OclcDelim$ + "e" + mid(sField2, 5, 1) + OclcDelim$ + "f" + Mid(sField2, 6, 1) + OclcDelim$ + "g" + Mid(sField2, 7, 1) + OclcDelim$ + "h" + mid(sField2, 8, 1)
      Case "c" ' computer files
         If Len(sField2)>6 Then                        
            sField = sField + OclcDelim$ + "d" + mid(sField2, 4, 1) + OclcDelim$ + "e" + mid(sField2, 5, 1) + OclcDelim$ + "f" + Mid(sField2, 6, 1) + OclcDelim$ + "g" + Mid(sField2, 7, 3) + OclcDelim$ + "h" + Mid(sField2, 10, 1) + OclcDelim$ + "i" + Mid(sField2, 11, 1) + OclcDelim$ + "j" + Mid(sField2, 12, 1) + OclcDelim$ + "k" + Mid(sField2, 13, 1) + OclcDelim$ + "l" + Mid(sField2, 14, 1)
         Else
            sField = sField + OclcDelim$ + "d" + mid(sField2, 4, 1) + OclcDelim$ + "e" + mid(sField2, 5, 1) + OclcDelim$ + "f" + Mid(sField2, 6, 1)
         End If
      Case "d", "k" ' globes, non-projected graphics
         sField = sField + OclcDelim$ + "d" + mid(sField2, 4, 1) + OclcDelim$ + "e" + mid(sField2, 5, 1) + OclcDelim$ + "f" + Mid(sField2, 6, 1)
      Case "f" ' tactile materials
         sField = sField + OclcDelim$ + "d" + Mid(sField2, 4, 2) + OclcDelim$ + "e" + Mid(sField2, 6, 1) + OclcDelim$ + "f" + Mid(sField2, 7, 3) + OclcDelim$ + "g" + Mid(sField2, 10, 1)
      Case "g", "m", "v" ' projected graphics, motion pictures, videos
         sField = sField + OclcDelim$ + "d" + mid(sField2, 4, 1) + OclcDelim$ + "e" + mid(sField2, 5, 1) + OclcDelim$ + "f" + Mid(sField2, 6, 1) + OclcDelim$ + "g" + Mid(sField2, 7, 1) + OclcDelim$ + "h" + mid(sField2, 8, 1) + OclcDelim$ + "i" + mid(sField2, 9, 1)                        
      Case "h" ' microforms
         If len(sField2) > 6 Then                   
            If Instr("0123456789", mid(sField2, 7, 1)) = 0 Then
               If Instr("0123456789", mid(sField2, 8, 1)) = 0 Then
                  If Instr("0123456789", mid(sField2, 9, 1)) = 0 Then
                     sField2 = mid(sField2, 1, 6) + "---" + mid(sField2, 10)
                  End If
               End If
            End If
         End If
         sField = sField + OclcDelim$ + "d" + mid(sField2, 4, 1) + OclcDelim$ + "e" + mid(sField2, 5, 1) + OclcDelim$ + "f" + Mid(sField2, 6, 4) + OclcDelim$ + "g" + Mid(sField2, 10, 1) + OclcDelim$ + "h" + mid(sField2, 11, 1) + OclcDelim$ + "i" +mid(sField2, 12, 1) + OclcDelim$ + "j" + mid(sField2, 13, 1)
      case "r" ' remote-sensing image
         sField = sField + OclcDelim$ + "d" + mid(sField2, 4, 1) + OclcDelim$ + "e" + mid(sField2, 5, 1) + OclcDelim$ + "f" + mid(sField2, 6, 1) + OclcDelim$ + "g" + mid(sField2, 7, 1) + OclcDelim$ + "h" + mid(sField2, 8, 1) + OclcDelim$ + "i" + mid(sField2, 9, 1) + OclcDelim$ + "j" + mid(sField2, 10, 2)
      Case "s" ' sound recordings
         sField = sField + OclcDelim$ + "d" + mid(sField2, 4, 1) + OclcDelim$ + "e" + mid(sField2, 5, 1) + OclcDelim$ + "f" + Mid(sField2, 6, 1) + OclcDelim$ + "g" + Mid(sField2, 7, 1) + OclcDelim$ + "h" + mid(sField2, 8, 1) + OclcDelim$ + "i" + Mid(sField2, 9, 1) + OclcDelim$ + "m" +mid(sField2, 13, 1) + OclcDelim$ + "n" + mid(sField2, 14, 1)                        
   End Select

   Fix007 = sField$
   
End Function

Function RecallAndWipe(sType$, sOCLC$) As Integer

   ' recall the indicated authority or bib record and
   '   wipe as much of it as seems appropriate
   ' remove such stuff as you want to remove
   
   ' return True if everything is ready for replacement of record

   Dim lRecords As Long

   Dim sValue$
   

   ' assume there's a problem
   RecallAndWipe = False
       
   If sType$ = "A" Then
      if 5=3 then
      ' insert a hyphen into the search term [?]
      If Instr(sOCLC$, "-") = 0 Then
         For lRecords = Len(sOCLC$) to 1 step -1
            If Instr("0123456789", Mid(sOCLC$, lRecords, 1)) = 0 Then
               If Len(sOCLC$) - lRecords = 10 Then ' format 2: 4-digit year
                  sOCLC$ = Mid(sOCLC$, 1, lRecords + 4) + "-" + Mid(sOCLC$, lRecords + 5)
               Else ' format 1: 2-digit year
                  sOCLC$ = Mid(sOCLC$, 1, lRecords + 2) + "-" + Mid(sOCLC$, lRecords + 3)
               End If
               Exit For
            End If
         Next
      End If  
      sOCLC$ = MARC.ReplaceCharacters(sOCLC$, " ", "")    
      end if
      lRecords = CS.Search("AF", "ln:" + sOCLC$)
      Select Case lRecords
         Case 0
            MsgBox "Search for " + sOCLC$ + " retrieves no records"
            Exit Function ' with false return value
         Case 1
            ' this is OK
         Case Else
            MsgBox "Search for " + sOCLC$ + " retrieves too many records"
            Exit Function ' with false return value
      End Select
      If LockAuthority% = True Then
         If CS.Lock = False Then
            MsgBox "Unable to lock this record"
            Exit Function ' with false return value
         End If
      End If
   Else ' bibliographic record
      lRecords = CS.Search("WC", "an " + sOCLC$)
      Select Case lRecords
         Case 0
            MsgBox "Search for " + sOCLC$ + " retrieves no records"
            Exit Function ' with false return value
         Case 1
            ' this is OK
         Case Else
            MsgBox "Search for " + sOCLC$ + " retrieves too many records"
            Exit Function ' with false return value
      End Select
      If LockBibliographic% = True Then
         If CS.Lock = False Then
            MsgBox "Unable to lock this record"
            Exit Function ' with false return value
         End If
      End If
      'msgbox "OK?"
   End If

   ' from here on, assume the record is
   '   going to be OK; but we'll flip this back
   '   if there's some field-deletion problem
   RecallAndWipe = True


   ' remove nearly all of the fields frmo the record
   ' because of a quirk in the way delete works, we have to
   '   manipulate the field counter ourselves
   ' namely, when we delete a field, the remaining fields automatically
   '   move "up" one. so if we delete field #5, the former field #6 becomes
   '   the new #5. this means that when we don't delete a field we need to
   '   end up with the pointer at the next number; but if we do delete a field
   '   we need to leave the pointer where it was. we achieve the latter by
   '   decrementing the pointer and immediately re-incrementing it
   lRecords = 1
   On Error GoTo RecallAndWipeError
   Do While CS.GetFieldLine(lRecords, sValue$)
      Select Case Mid(sValue$, 1, 3)
         Case "005", "010", "035"
            If sType$ <> "A" Then
               If CS.DeleteFieldLine(lRecords) = False Then
                  RecallAndWipe = False
                  If LockBibliographic% = True Then
                     CS.ReleaseRecordLock
                  End If
                  Exit Function
               End If
               lRecords = lRecords - 1
            End If
         Case "040", "019", "029", "938" 
            ' do nothing to these: do not delete
         Case Else
            If CS.DeleteFieldLine(lRecords) = False Then
               RecallAndWipe = False
               If LockBibliographic% = True Then
                  CS.ReleaseRecordLock
               End If
               Exit Function
            End If
            lRecords = lRecords - 1
      End Select
RecallAndWipeErrorResume:      
      lRecords = lRecords + 1
   Loop

   
   On Error GoTo 0
   
   Exit Function
   
RecallAndWipeError:

   'Msgbox "Error deleting field "+str(lRecords)+" "+Error(Err)
   Resume RecallAndWipeErrorResume   
   
End Function

Function Marc2OclcScreenFont(sField$) As String
    
    Dim sDiacriticsAbove$, sDiacriticsOther$, sChar$
    
    Dim bDiacritics As Integer, bChanged As Integer
    
    Dim iPtr%
    
    Dim lPtr As Long
    

   'msgbox "Arrived at translation: >"+sfield$+"<"
       
    On Error Resume Next
    
           For lPtr = Len(sField$) To 1 Step -1
              DoEvents
              sChar$ = Mid(sField$, lPtr, 1)
              Select Case Asc(sChar$)
                 Case Is < 128
                    If sChar$ = MarcDelim Then
                       sField$ = MARC.SafeStuff(sField$, lPtr, 1, OclcDelim$)
                    End If
                    If bDiacritics = True Then
                       sField$ = MARC.SafeStuff(sField$, lPtr + 2, 0, sDiacriticsAbove$ + sDiacriticsOther$)
                       bDiacritics = False
                       sDiacriticsAbove$ = ""
                       sDiacriticsOther$ = ""
                    End If
                 Case Is > 223
                    sField$ = MARC.SafeStuff(sField$, lPtr, 1, "")
                    If InStr(DiacriticsAbove$, sChar$) > 0 Then
                       sDiacriticsAbove$ = sDiacriticsAbove$ + sChar$
                    Else
                       sDiacriticsOther$ = sDiacriticsOther$ + sChar$
                    End If
                    bDiacritics = True
                 Case Else ' above Ascii maximum and not a diacritic--must be a special character
                    If bDiacritics = True Then
                       sField$ = MARC.SafeStuff(sField$, lPtr + 2, 0, sDiacriticsAbove$ + sDiacriticsOther$)
                       bDiacritics = False
                       sDiacriticsAbove$ = ""
                       sDiacriticsOther$ = ""
                    End If
                    iPtr% = InStr(VoyagerGreeksEtc$, sChar$)
                    If iPtr% > 0 Then
                       sField$ = MARC.SafeStuff(sField$, lPtr, 1, Mid(OclcGreeksEtc$, iPtr%, 1))
                    End If
              End Select
           Next
        
           If bDiacritics = True Then
              sField$ = sField$ + sDiacriticsAbove$ + sDiacriticsOther$
           End If
    
    Marc2OclcScreenFont = sField$
    
End Function