'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 Set CS = CreateObject("Connex.Client") 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