'MacroName:GenerateAuthoritySupplNLat 'MacroDescription:GenerateAuthoritySupplNonLatin 'Macro Created by:Hideyuki Morimoto 'Macro Modified by: Joel Hahn, Niles Public Library District ' to uninvert non-CJK names in 670 $b, fix some coding bugs, ' add some minor functionality for series, etc. 'Macro Last Updated on: 24 October 2013 ' ============================================================ ' This macro supplements OCLC-supplied macro for NARs and SARs ' generation, which is invoked inside this supplementary macro. ' Supplementary processing adds non-Latin script data in field ' 4xx and field 670. It assumes that a non-Latin counterpart ' to a roman heading to be established is placed immediately ' above the roman heading field where a cursor is placed inside ' a bibliographic record. The non-Latin script usage data to ' be added in field 670 is based on a non-Latin x-ref. to be ' placed in authority field 4xx, with punctuation and spacing ' modification and omission of superfluous subfield data ' irrelevant to usage. This approach of using a non-Latin ' x-ref. as a basis for usage data is applicable, without much ' modification, to East Asian NARs and SARs, even in the case ' of personal names, as most East Asian personal name usage ' agrees with the order of name elements in headings, rarely, ' if any, with a forename followed by a surname. This macro ' tries to prepare citation data in field 670 in the format as ' specified in LC's document "670 (Source Data Found) Citations ' for Name Authority Records with Non-Latin Script Data" (rev., ' 10 July 2008). Nonetheless, automatically-generated field ' 670 data should carefully be reviewed and adjusted, when ' necessary, even when this macro is used for East Asian ' NARs/SARs generation. ' ' Following the interim measure of June 2008-Jan. 2009, this ' macro also sets value "b" in 008/29 (Ref status) and adds ' "667 Non-Latin script reference not evaluated", which will ' need to be inactivated, when non-Latin x-ref. formulation is ' officially settled. Also, when (an) additional non-Latin ' x-ref(s). is/are manually placed in the authority record, "s" ' should be added to "reference" in field 667, during the interim ' period. ' ' This macro also routinely supplies "t.p." as a location of ' information found under field 670. It is understood that ' East Asian imprints rarely carry "ser. t.p." even when series ' statements are present. Necessary adjustments should manually ' be made, after a macro-prepared draft authority record is ' displayed on the screen. ' ' This macro also deletes superfluous pronoun "His " or "Its "at ' the beginning of field 670-|a when a title proper consists ' only of one word. ' ============================================================ 'Option Explicit Sub Main 'Dim bool 'Dim shLineNum 'Dim sOrigTag 'Dim sNonLatinCrossRef 'Dim sNonLatinSerSt 'Dim sTagConv, sCategory 'Dim h$, nlrti$ 'Dim sV, nV, sData, sNonLatinSt, sNonLatin670 'Dim sI, nB, nP, nR, sB, seg1, seg2, nIL, z, sE, nE, s4, n4, sEb, nEb, s4b, n4b Dim CS As Object On Error Resume Next Set CS = GetObject(,"Connex.Client") On Error GoTo 0 If CS Is Nothing Then Set CS = CreateObject("Connex.Client") End If BOOL = CS.GetFieldLine(CS.CursorRow, sFieldTest) If sFieldTest = "Data contains non-latin script" Then CS.CursorRow = CS.CursorRow + 1 End If shLineNum = CS.CursorRow -1 If shLineNum = 0 Then shLineNum = 1 BOOL = CS.GetFieldLineUnicode(shLineNum, sNonLatinCrossRef) sCategory = Mid(sNonLatinCrossRef, 2, 2) If Right(sNonLatinCrossRef, 1) = "." Then sNonLatinCrossRef = Left(sNonLatinCrossRef, Len(sNonLatinCrossRef) - 1) End If sOrigTag = Left(sNonLatinCrossRef, 3) If InStr("100,110,111,130,240,440,600,610,611,630,651,700,710,711,730,800,810,811,830", sOrigTag) = 0 Then MsgBox "Valid fields are 100-130, 240, 440, 600-630, 651, 700-730, and 800-830. Exiting...", 0, _ "Invalid Field Specified" Exit Sub End If 'BOOL = CS.GetField("260",1, sPub) 'If sPub = "" Then ' MsgBox "Record does not contain a 260 field, which is required by OCLC's GenerateAuthorityRecord macro. Exiting..." ' Exit Sub 'End If If (sOrigTag = "800") Or (sOrigTag = "810") Or (sOrigTag = "811") Or (sOrigTag = "830") Then BOOL = CS.GetFieldUnicode("490", 1, sNonLatinSerSt) If BOOL = False Then sNonLatinSerSt = sNonLatinCrossRef Else sNonLatinSerCrossRef = Trim(Left(sNonLatinCrossRef, InStr(sNonLatinCrossRef, "ǂt") + 9)) & " " & Mid(sNonLatinSerSt, 6) sNonLatinSerCrossRef = "4" & Mid(sNonLatinSerCrossRef, 2) If InStr(sNonLatinSerCrossRef, " ; ǂv") Then sNonLatinSerCrossRef = Left(sNOnLatinSerCrossRef, InStr(sNonLatinSerCrossRef, " ; ǂv")) End If End If End If BOOL = CS.RunMacro("OCLC!GenerateAuthorityRecord") If sOrigTag = "800" Then BOOL = CS.GetField("100", 1, sSerHeading) BOOL = CS.GetField("400", 1, sSerCross) If Mid(sSerCross, 2) = Mid(sSerHeading, 2) Then BOOL = CS.DeleteField("400", 1) End If End If sTagConv = "1" & sCategory If sTagConv = "140" Then sTagConv = "130" End If BOOL = CS.GetField(sTagConv, 1, h$) nlrti$ = "4" + Mid(h$, 2, 4) sNonLatinCrossRef = nlrti$ + Right(sNonLatinCrossRef, Len(sNonLatinCrossRef) - 5) sV = " ; ǂv" nV = InStr(sNonLatinCrossRef, sV) If nV > 0 Then sNonLatinCrossRef = Left(sNonLatinCrossRef, nV - 1) End If sE = ", ǂe" nE = InStr(sNonLatinCrossRef, sE) If nE > 0 Then sNonLatinCrossRef = Left(sNonLatinCrossRef, nE - 1) End If sEb = " ǂe" nEb = InStr(sNonLatinCrossRef, sEb) If nEb > 0 Then sNonLatinCrossRef = Left(sNonLatinCrossRef, nEb - 1) End If s4 = ", ǂ4" n4 = InStr(sNonLatinCrossRef, s4) If n4 > 0 Then sNonLatinCrossRef = Left(sNonLatinCrossRef, n4 - 1) End If s4b = " ǂ4" n4b = InStr(sNonLatinCrossRef, s4b) If n4b > 0 Then sNonLatinCrossRef = Left(sNonLatinCrossRef, n4b - 1) End If BOOL = CS.AddField(999, sNonLatinCrossRef) If sTagConv = "100" And InStr(sNonLatinCrossRef, "ǂt") Then sSeriesCrossRef = "430 0" & Trim(Mid(sNonLatinCrossRef, InStr(sNonLatinCrossRef, "ǂt") + 9)) If InStr(Mid(sNonLatinCrossRef, InStr(sNonLatinCrossRef, "ǂt") + 9), "&#x") > 0 Then 'Only add a 430 if a non-Latin name/title has a non-Latin title portion BOOL = CS.AddField(999, sSeriesCrossRef) End If If sNonLatinSerCrossRef <> "" Then BOOL = CS.AddField(999, sNonLatinSerCrossRef) End If End If BOOL = CS.GetField("670", 1, sData) sI = Left(sData, 9) nIL = Len(sData) If sI = "670 His " Or sI = "670 Its " Then sData = Left(sData, 5) + Right(sData, (nIL - 9)) End If sB = Chr(223) + "b" nB = Instr(sData, sB) If nB > 0 Then nP = Instr(nB, sData, "(") If nP > 0 Then If Left(sNonLatinSerSt, 4) = "4901" Then sV = " ; ǂv" nV = Instr(sNonLatinSerSt, sV) sNonLatinSt = Mid(sNonLatinSerSt, 6, nV - 5) Else nR = Instr(sNonLatinCrossRef, "ǂ") If nR > 0 and Mid(sNonLatinCrossRef, nR + 8, 1) <> "b" Then sNonLatinSt = Mid(sNonLatinCrossRef, 6, nR - 7) If Right(sNonLatinSt, 1) = "." or Right(sNonLatinSt, 1) = "," or (Right(sNonLatinSt, 1) = ";" And Not Right(sNonLatinSt, 8) Like "[&][#][x]????[;]") Then sNonLatinSt = RTrim(Left(sNonLatinSt, Len(sNonLatinSt) - 1)) End If ElseIf nR > 3 Then If Mid(sNonLatinCrossRef, nR - 2, 11) = ". ǂb" Then sNonLatinSt = Mid(sNonLatinCrossRef, 6, nR - 8) + Right(sNonLatinCrossRef, Len(sNonLatinCrossRef) - nR - 9) End If Else sNonLatinSt = Right(sNonLatinCrossRef, Len(sNonLatinCrossRef) - 5) End If End If If Mid(sNonLatinSt, 3, 3) Like "x0[3-9A-E]" and Mid(h$, 2, 2) = "00" Then 'non CJK personal name; un-invert the name order If InStr(sNonLatinSt, "ǂ") = 0 Then seg1 = sNonLatinSt Else seg1 = Left$(sNonLatinSt, InStr(sNonLatinSt, "ǂ") - 1) If Mid$(seg1, Len(seg1), 1) = "," Then seg1 = Mid$(seg1, 1, Len(seg1) - 1) End If End If If InStr(seg1, ",") <> 0 Then seg2 = Mid$(seg1, InStr(seg1, ",") + 2, Len(seg1) - InStr(seg1, ",") + 2) seg1 = Mid$(seg1, 1, InStr(seg1, ",") - 1) Else seg2 = "" End If If InStr(seg1, ".") <> 0 Then z = 11 Do While z <= Len(seg1) If Mid$(seg1, z, 1) = "." And Mid$(seg1, z - 10, 2) = ". " Then seg1 = Mid$(seg1, 1, z - 10) + Mid$(seg1, z - 8, Len(seg1)) End If z = z + 1 Loop End If If seg2 <> "" Then If Right(seg2, 9) Like " [&][#][x]????[;]" Then seg2 = seg2 & "." End If If InStr(seg2, ".") <> 0 Then z = 11 Do While z <= Len(seg2) If Mid$(seg2, z, 1) = "." And Mid$(seg2, z - 10, 2) = ". " Then seg2 = Mid$(seg2, 1, z - 10) + Mid$(seg2, z - 8, Len(seg2)) End If z = z + 1 Loop End If If InStr(sNonLatinSt, seg2 + " " + seg1) <> 0 Then z = InStr(sNonLatinSt, seg2 + " " + seg1) sNonLatinSt = Mid$(sNonLatinSt, z, Len(seg2 + " " + seg1)) ElseIf InStr(sNonLatinSt, seg1 + " " + seg2) <> 0 Then z = InStr(sNonLatinSt, seg1 + " " + seg2) sNonLatinSt = Mid$(sNonLatinSt, z, Len(seg1 + " " + seg2)) Else sNonLatinSt = seg2 + " " + seg1 End If Else sNonLatinSt = seg1 End If End If sNonLatin670 = Left(sData, nB + 1) + "t.p. (" + sNonLatinSt + " = " + Right(sData, Len(sData) - nP) BOOL = CS.SetField(1, sNonLatin670) End If End If BOOL = CS.GetField("040", 1, sSource) BOOL = CS.GetFixedField("Rules", sRules) If InStr(sSource, Chr(223) & "e rda") And sRules <> "z" Then BOOL = CS.SetFixedField("Rules", "z") End If BOOL = CS.SetFixedField("Ref status", "b") If sSeriesCrossRef <> "" Then BOOL = CS.SetField(1, "667 Non-Latin script references not evaluated.") Else BOOL = CS.SetField(1, "667 Non-Latin script reference not evaluated.") End If bool = CS.Reformat End Sub