Public Function RDA_02_00_Phase3B(ByVal sSavedMarcDirectoryMinusBlocking667s$, ByVal b667HeadingCannotBeUsedNonAACR2AlreadyPresent As Boolean, ByVal b667HeadingCannotBeUsedAACR2AlreadyPresent As Boolean, ByVal b667HeadingCannotBeUsedAtAllAlreadyPresent As Boolean, ByVal b667HeadingCannotBeUsedUndifferentiated As Boolean) As Boolean Const PHASE_3B_TAG_LIST$ = "001 046 100 110 111 130 150 151" Dim bAccessField As Boolean, bAlreadyPresent As Boolean, bNotSuppressed As Boolean Dim sOriginal1xxRaw$, sOriginal1xxTag$, sOriginal1xxIndicators$, sSaved1xxForFinalComparison$ Dim sOriginalRaw$, sOriginal1xxNacoNorm$, sNew1xxNacoNorm$, sTag$, sNacoNormGroup$, sTagRoot$ Dim sTrueTag$, s667ToAdd$, sW$, sOldHeadingRaw$, sOldHeadingNormNaco$, sText$ Dim sIndicators$, sField$, sInvalidMessage$, sModified4XXsToReAdd$, sAdditionalBibleReferences$ Dim sCompleteOriginal1xxRaw$, sCompleteOriginal1xxChanged$, sLineToWrite$, sInvalid046Subfields$ Dim s1xxForReport$ Dim lPtr As Long, lArrayPointer As Long, lInstance As Long, lFldPointer As Long Dim cTickEnd As Currency Dim bSaveDone As Boolean, bRecodeRecordAsRdaBecauseOf7XX As Boolean, bFound As Boolean Dim bUnsuppressedOldHeading4xx As Boolean, bCreate4xxFromOriginal1xx As Boolean Dim bWant667NotRdaEvenWithChange As Boolean, bWant667AACR2RequiresChange As Boolean Dim bRecordKnownToBeWanted As Boolean, bWriteChangesToFile As Boolean Dim bChanged1XX As Boolean, bChanged4XX As Boolean, bChanged5XX As Boolean Dim bChangedNotCounting7xxFields As Boolean ' ************************************* ' ************************************* ' * the primary action of this phase is to ' * re-code most AACR2 authority records as RDA ' * however, in order to do this (because conditions ' * have changed) we must also re-consider all evaluations ' * made in previous phases; and we must also implement ' * additional changes whose value has become evident ' * since the completion of Phase 2 in (approx.) March 2013 ' * as is always the case, whenever any record is changed we ' * consider the addition of derivitive fields (such as ' * the 046) ' ************************************* ' ************************************* RDA_02_00_Phase3B = False #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "**************************************" Debug.Print "Entry into Phase 3B; changed? " + str(m_bMarcRecordChanged) Debug.Print "667 values: " + str(b667HeadingCannotBeUsedNonAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAtAllAlreadyPresent) + " " + str(b667HeadingCannotBeUsedUndifferentiated) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) Debug.Print "**************************************" #End If ' 20120616: for gblbCountChangesPlease, see comments to orange phase 1 gblbCountChangesPlease = True gblbWriteChangesToFile = True ' 20120306: if we have a topical record that requires no tests, ' then we have nothing that needs to be done; no labeleing with 667, nothing If m_lStatisticsRecordSubtype = AUTHORITYSUBTYPE_TopicalNoNameTests Then GoTo RDA0200AP3B_NoChange End If ' if we get here we have these kinds of things: ' * pre-AACR2 (should be marked with 667) ' * AACR2-compatible (should be marked with 667) ' * AACR2 (as yet undifferentiated as to type) ' * RDA ' 20120222 re-added ' * unknown/not valid (should be marked with 667) ' * topical subjects with name-like stuff to be checked ' obviously, we only have topical subjects if we've been supplied them intentionally; they ' won't be in the LC/NACO file RDA_02_33_DetectUndifferentiatedNameRecord #If False Then ' 20150528: this isn't something we want in 3B! ' 20141024: if this is an undifferentiated name record that contained the wrong ' 667 field, then we're going to mark the record as "changed" from the top, ' so that we add the correct 667 field at the end If gblbUndifferentiatedPersonalName Then If Not b667HeadingCannotBeUsedUndifferentiated Then m_bMarcRecordChanged = True End If End If #End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "****************************** 3B enters" Debug.Print "Undif? Present? Changed? " + str(gblbUndifferentiatedPersonalName) + " " + str(b667HeadingCannotBeUsedUndifferentiated) + " " + str(m_bMarcRecordChanged) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If RDA_02_37_FixedFieldChanges #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After 02.37 FFD changes: " + str(m_bMarcRecordChanged) #End If ' 20150414: switch added as a time-saver during testing; obviously ' we wouldn't turn this off during production If Not m_bSkipIsniAssignment Then RDA_02_38_AssignISNI End If ' save the 1xx field for final comparison For lArrayPointer = 1 To gbllFieldLast If Mid(gblaField(lArrayPointer).FldTag, 1, 1) = "1" Then sSaved1xxForFinalComparison$ = gblaField(lArrayPointer).FldTag + gblaField(lArrayPointer).FldInd + gblaField(lArrayPointer).FldText End If Next ' larraypointer ' ************************************* ' * ' * we are somewhere within phase 3 ' * ' ************************************* For lArrayPointer = 1 To gbllFieldLast ' field-level initializations gblsFieldChanges$ = "" bUnsuppressedOldHeading4xx = False sOriginalRaw$ = gblaField(lArrayPointer).FldText bAccessField = False gblbCommaAddedToBibleHeading = False gblbSubfieldNAddedToBibleHeading = False #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "At: " + gblaField(lArrayPointer).FldTag + " " + gblaField(lArrayPointer).FldText + " " + str(m_bMarcRecordChanged) #End If ' sTrueTag is the "real" tag of the field, regardless of what the ' actual tag may be ' 880 fields should not appear in LC/NACO authority records, but they ' may well appear in other kinds of authority records; doesn't hurt to ' allow for them ' we need this several times so we'll do it once for all sTagRoot$ = Mid(gblaField(lArrayPointer).FldTagTrue, 1, 1) ' preliminary tag-related things for authority records: ' * save the 1xx field ' * skip suppressed 4XX fields ' * save information about not-suppressed "old heading" 4XX fields Select Case sTagRoot$ Case "1" ' preserve the original 1XX field in case we need it as a 4XX later on sOriginal1xxTag$ = gblaField(lArrayPointer).FldTag sOriginal1xxIndicators$ = gblaField(lArrayPointer).FldInd sOriginal1xxRaw$ = gblaField(lArrayPointer).FldText sOriginal1xxNacoNorm$ = gblaField(lArrayPointer).FldNormNaco(True, MyMarcRecord) ' 20121102: sCompleteOriginal1xxRaw$ added sCompleteOriginal1xxRaw$ = gblaField(lArrayPointer).FldTag + gblaField(lArrayPointer).FldInd + sOriginal1xxRaw$ Case "4" ' skip 4XX fields that represent a suppressed "old heading" If gblaField(lArrayPointer).SfdFindFirst("w") Then sW$ = gblaField(lArrayPointer).SfdNorm(MyMarcRecord) + "NNNN" 'If Mid(sW$, 1, 1) = "D" Then If Mid(sW$, 3, 1) <> "N" Then ' this is an "old heading" 4XX field If Mid(sW$, 4, 1) <> "N" Then ' this is a "suppressed old heading" 4XX field; it's ' utterly uninteresting for the work we're performing here GoTo RDA0200AP3B_NextFieldOrange2 Else ' we have an un-suppressed 4XX field for an old heading ' we're going to proceed; but save the ' field for later ' if it turns out that this field requires some change ' to make it RDA-acceptable, then we're going to ' create a new 4XX field, and suppress this one sOldHeadingRaw$ = gblaField(lArrayPointer).FldText sOldHeadingNormNaco$ = gblaField(lArrayPointer).FldNormNaco(True, MyMarcRecord) bUnsuppressedOldHeading4xx = True End If End If End If 'Case "5" ' no special preparation is needed End Select ' standard tag-based stuff is in this common package ' this routine simply bounces back if it's not a field of interest; and it sets bAccessField too RDA_02_18_CommonAuthorityFieldCode "145", gblaField(lArrayPointer), bAccessField, MyMarcRecord #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Access field? " + str(bAccessField) + " " + str(m_bMarcRecordChanged) #End If #If ConvertBibleKoranDebug = -1 Then Debug.Print " Comma added? " + str(gblbCommaAddedToBibleHeading) + " " + str(m_bMarcRecordChanged) #End If If bAccessField Then #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "About to handle Arr, Acc, Unacc" #End If RDA_02_10_Handle_ArrAccUnacc gblaField(lArrayPointer) #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "About to handle Selections" #End If RDA_02_13_Handle_Selections gblaField(lArrayPointer) #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "About to handle Bible and Koran" #End If RDA_02_05_Handle_BibleAndKoran gblaField(lArrayPointer), sAdditionalBibleReferences$ #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "About to handle Cello " + str(m_bMarcRecordChanged) #End If RDA_02_06_Handle_Cello gblaField(lArrayPointer) #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "About to handle Music medium " + str(m_bMarcRecordChanged) #End If RDA_02_27_MusicMedium gblaField(lArrayPointer), MyMarcRecord #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "About to handle relator terms " + str(m_bMarcRecordChanged) #End If RDA_02_29_RelatorTerms gblaField(lArrayPointer) RDA_02_35_UnnecessarySubfieldW gblaField(lArrayPointer) #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "About to handle Indicators and terminal punctuation " + str(m_bMarcRecordChanged) #End If 'RDA_02_32_ObsoleteIndicators gblaField(lArrayPointer), INDICATOR_CHANGE_MODE_4xx5xxOnly RDA_02_32_ObsoleteIndicators gblaField(lArrayPointer), INDICATOR_CHANGE_MODE_DoAll RDA_02_36_TerminalPunctuation gblaField(lArrayPointer) #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "All done with access field handling " + str(m_bMarcRecordChanged) #End If End If ' if we changed this field ... If sOriginalRaw$ <> gblaField(lArrayPointer).FldText Then #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "We changed the field""" Debug.Print vbTab + ">" + sOriginalRaw$ + "<" Debug.Print vbTab + ">" + gblaField(lArrayPointer).FldText + "<" #End If ' field changed in some standard way ' 20121102: write changed 1XX fields to an output file, using the same ' format as the RDA 7XX file ' 20130120: changed from simple "if" to find 1XX, to a case, so ' we can also find 5XX Select Case Mid(gblaField(lArrayPointer).FldTag, 1, 1) Case "1" 'sCompleteOriginal1xxRaw$ = gblaField(larraypinter).FldTag + gblaField(larraypinter).FldInd + sOriginal1xxRaw$ 'sCompleteOriginal1xxChanged$ ' todo: NOT ENTIRELY SURE IF THIS IS THE RIGHT ORDER; should the changed field come first????? (wants to be ' logically same as the RDA 7XX file) sLineToWrite$ = m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab sLineToWrite$ = sLineToWrite$ + Mid(sCompleteOriginal1xxRaw, 1, 3) + vbTab + RDA_7XX_99_06_FakeSpaces(Mid(sCompleteOriginal1xxRaw$, 4, 2)) + vbTab + Mid(sCompleteOriginal1xxRaw$, 6) + vbTab sLineToWrite$ = sLineToWrite$ + gblaField(lArrayPointer).FldTag + vbTab + RDA_7XX_99_06_FakeSpaces(gblaField(lArrayPointer).FldInd) + vbTab + gblaField(lArrayPointer).FldText RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_1xxChanged, FILENAME_1xxChanged$, sLineToWrite$, "", "", "", "", "" ' 20130207: add second output file for series alone If InStr("abcz", Mid(gblsMarc008$, 13, 1)) > 0 Then RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_Series1XXChanged, FILENAME_Series1XXChanged$, sLineToWrite$, "", "", "", "", "" End If Case "5" bChanged5XX = True End Select If bUnsuppressedOldHeading4xx Then ' phase 3 ' if we "changed" an unsuppressed 4XX for a former heading, then ' save the revised 4XX for later re-adding as a new 4XX If Len(sModified4XXsToReAdd$) = 0 Then sModified4XXsToReAdd$ = gblaField(lArrayPointer).FldTag + gblaField(lArrayPointer).FldInd + gblaField(lArrayPointer).FldText Else sModified4XXsToReAdd$ = gblaField(lArrayPointer).FldTag + gblaField(lArrayPointer).FldInd + gblaField(lArrayPointer).FldText End If ' restore the original 4XX, and suppress it gblaField(lArrayPointer).FldText = sOriginalRaw$ ' restore the field's original text ' mark the 4XX as suppressed gblaField(lArrayPointer).SfdFindFirst "w" gblaField(lArrayPointer).SfdText = Mid(gblaField(lArrayPointer).SfdText, 1, 3) + "a" ' yes, we changed something in this authority record m_bMarcRecordChanged = True ' record the fact that we suppressed a 4XX field for a former heading RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_4xxSuppressed, FILENAME_4xxSuppressed$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(lArrayPointer).FldTag + " " + gblaField(lArrayPointer).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(lArrayPointer).FldText), "", "", "", "", "" RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_4xxForOldHeadingNowSuppressed ' by definition this is not the 1XX field, so we don't ' need to worry with creating a 4XX for the former 1XX ' note that bedause of the foregoing, some of the details are no longer relevant: ' for example, if we added a comma to an "old heading" ' for a book of the bible with chapter and verse we have now erased that comma, so there's nothing ' to count or report; the way things work, we will also NOT create a 430 based on a mushing of the ' 430 into RDA-like form, and it'll all be left up to the operator Else ' 20121005: if we added a comma to a bible heading, count it and report it If gblbCommaAddedToBibleHeading Then RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_CommaAddedToBibleBook RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_CommaAddedToBible, FILENAME_CommaAddedToBible$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(lArrayPointer).FldTag + " " + gblaField(lArrayPointer).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(lArrayPointer).FldText) + vbTab + gblaField(lArrayPointer).FldNorm(MyMarcRecord), "", "", "", "", "" End If If gblbSubfieldNAddedToBibleHeading Then RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_SubfieldNAddedToBible, FILENAME_SubfieldNAddedToBible$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(lArrayPointer).FldTag + " " + gblaField(lArrayPointer).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(lArrayPointer).FldText) + vbTab + gblaField(lArrayPointer).FldNorm(MyMarcRecord), "", "", "", "", "" End If ' some field OTHER THAN an UNsuppressed old-heading 4XX field ' since the changed field is already in the array of headings in the ' shape we want it to have, then all we have to bother with here ' is the setting of miscellaneous flags for later inspection ' we've changed this recorrd m_bMarcRecordChanged = True If lArrayPointer = 1 Then ' if we've changed the 1XX field, remember this so we can add a ' 4XX for the former 1XX at the end bCreate4xxFromOriginal1xx = True End If End If ' preserve information about the changes made here RDA_99_96_WriteTransaction gblsFieldChanges$, gblaField(lArrayPointer).FldTag, gblaField(lArrayPointer).FldInd, sOriginalRaw$, gblaField(lArrayPointer).FldText #If ConvertSingleAuthorityRecordDebug = -1 Then Else ' we made no change to this one field; so there's nothing to be done Debug.Print "We did NOT change the " + gblaField(lArrayPointer).FldTag + " field" Debug.Print vbTab + ">" + sOriginalRaw$ + "<" Debug.Print vbTab + ">" + gblaField(lArrayPointer).FldText + "<" #End If End If ' was the current field changed during this work? ("Yes" first, "No" second) #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After other stuff: " + gblaField(lArrayPointer).FldText Debug.Print "Final field: " + gblaField(gbllFieldLast).FldText #End If RDA0200AP3B_NextFieldOrange2: 'Debug.Print "Advancing pointer from " + str(lArrayPointer) + " towards " + str(gbllFieldLast) Next ' for each access field in the record #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After access fields: " + str(m_bMarcRecordChanged) Debug.Print "Add hyphens? " + str(m_bAddHyphensToAuthority046Fields) #End If If m_bAddHyphensToAuthority046Fields Then RdaField046_AddHyphens True, MyMarcRecord, gblsMarcDirectory$, gblsMarcFields$, m_bMarcRecordChanged, sInvalid046Subfields$ If Len(sInvalid046Subfields$) > 0 Then RDA_99_89_OpenOutputFileCountAndWrite OUTPUTFILE_046Invalid, FILENAME_046Invalid$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + " " + sInvalid046Subfields$ End If End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After 046: " + str(m_bMarcRecordChanged) #End If ' 20130208: also deal here with a single 781 field, which should *probably* be the last one but we're not certain ... For lArrayPointer = 1 To gbllFieldLast If gblaField(lArrayPointer).FldTag = "781" Then RDA_02_18_CommonAuthorityFieldCode "7", gblaField(lArrayPointer), bAccessField, MyMarcRecord End If Next ' larraypointer #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After 781: " + str(m_bMarcRecordChanged) #End If RdaCorporateInitials MyMarcRecord, m_bAddQualifierTo410ForInitialsUseDefaultOrganization ' for production work, it might be necessarily only to report ' the 410 fields for which initials could NOT be produced, like this ... #If False Then For lArrayPointer = 1 To gbllUnexpandedInitialsLast lFldPointer = gblaUnexpandedInitials(lArrayPointer).FldPointer RDA_99_89_OpenOutputFileCountAndWrite OUTPUTFILE_410InitialsNotExpanded, FILENAME_410InitialsNotExpanded$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(lFldPointer).FldTag + " " + gblaField(lFldPointer).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(lFldPointer).FldText) Next ' larraypointer ' and these For lPtr = 1 To gbllInitialIrregularitiesLast RDA_99_89_OpenOutputFileCountAndWrite OUTPUTFILE_410InitialIrregularities, FILENAME_410InitialIrregularities$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaInitialIrregularities(lPtr).MessageText + vbTab + RDA_99_86_ProcessFieldForOutput(gblaInitialIrregularities(lPtr).FldText) Next ' lptr #Else ' ... but for debugging, let's report both the found and the not-found For lPtr = 1 To gbllInitialsFoundInCorporate410sLast For lInstance = 1 To gblaInitialsFoundInCorporate410s(lPtr).InstancesLast lFldPointer = gblaInitialsFoundInCorporate410s(lPtr).Instances(lInstance).FldPointer 'Debug.Print "Instance " + str(lInstance) + " qual: >" + gblaInitialsFoundInCorporate410s(lPtr).Instances(lInstance).FldQualifier + "<" If Len(gblaInitialsFoundInCorporate410s(lPtr).Instances(lInstance).FldQualifier) = 0 Then ' 20150528: if we requested the default, then the only thing we should see here are ' really, really oddball things RDA_99_89_OpenOutputFileCountAndWrite OUTPUTFILE_410InitialsNotExpanded, FILENAME_410InitialsNotExpanded$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(lFldPointer).FldTag + " " + gblaField(lFldPointer).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(lFldPointer).FldText) ElseIf gblaInitialsFoundInCorporate410s(lPtr).Instances(lInstance).FldQualifier = "(Organization)" Then ' 20150528: if we've supplied the default qualifier, then ' we're going to use a slightly different file name, and ' we're going to include the 1XX in the output file s1xxForReport$ = "" For lArrayPointer = 1 To gbllFieldLast If Mid(gblaField(lArrayPointer).FldTag, 1, 1) = "1" Then s1xxForReport$ = gblaField(lArrayPointer).FldText Exit For End If Next ' larraypointer RDA_99_89_OpenOutputFileCountAndWrite OUTPUTFILE_InitialsExpandedWithDefault, FILENAME_410InitialsExpandedWithDefault$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + RDA_99_86_ProcessFieldForOutput(s1xxForReport$) + vbTab + gblaField(lFldPointer).FldTag + " " + gblaField(lFldPointer).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(lFldPointer).FldText) Else RDA_99_89_OpenOutputFileCountAndWrite OUTPUTFILE_410InitialsExpanded, FILENAME_410InitialsExpanded$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaInitialsFoundInCorporate410s(lPtr).Instances(lInstance).MatchCategory + vbTab + gblaField(lFldPointer).FldTag + " " + gblaField(lFldPointer).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(lFldPointer).FldText) End If Next ' linstance Next ' l For lPtr = 1 To gbllInitialIrregularitiesLast RDA_99_89_OpenOutputFileCountAndWrite OUTPUTFILE_410InitialIrregularities, FILENAME_410InitialIrregularities$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaInitialIrregularities(lPtr).MessageText + vbTab + RDA_99_86_ProcessFieldForOutput(gblaInitialIrregularities(lPtr).FldText) Next ' lptr #End If #If MusicMediumDebug = -1 Or ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Before Music Endgame " + str(m_bMarcRecordChanged) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If ' in phase 3B this applies to ALL fields: RDA_02_27_MusicMedium_Endgame ' add the 382 field if available #If MusicMediumDebug = -1 Then Debug.Print "Return from music medium endgame with >" + gblsAuthorityField382ToAdd$ + "<" Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After field review; changed? " + str(m_bMarcRecordChanged) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If ' ************************************* ' * ' * we are somewhere within phase 3 ' * ' ************************************* ' 20121218: save the state of m_bmarcrecordchanged BEFORE we ' do any "cleanup", most notably the removal of 7XX fields bChangedNotCounting7xxFields = m_bMarcRecordChanged ' TODO: THIS SHOULD BE UNNECESSARY IN PHASE 3... RDA_02_21_ReportRda7xxFields REPORT_RDA_7XX_FIELDS_RemoveRda7xxFields ' 20121218: if m_bMarcRecordChanged is True but bChangedNotCounting7xxFields is ' False, then the only change we made involves the removal of 7XX fields: IN THIS ' CASE WE SHOULD DO NO RE-CODING FOR NON-AACR2 records #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Phase 3B; Changed after removal of 7XX fields? " + str(m_bMarcRecordChanged) + " >" + gblsField678ToMove$ + "< " + str(gbllSubfieldCExtensionThisRecordLast) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If If Len(gblsField678ToMove$) > 0 Then ' just fake it! m_bMarcRecordChanged = True #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Marked 'changed' because of 678 field" #End If End If If MyMarcRecord.MarcRecordIn <> m_sMarcRecordIn$ Then MyMarcRecord.MarcRecordIn = m_sMarcRecordIn$ End If If gbllSubfieldCExtensionThisRecordLast > 0 Then RDA_02_30_Extensions_Test MyMarcRecord If gbllSubfieldCExtensionThisRecordLast > 0 Then m_bMarcRecordChanged = True ' it WILL BE! End If End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After extensions: " + str(m_bMarcRecordChanged) #End If ' 20150317: in this last pass through the file, do this stuff whether the record was changed, ' or not! ' since we have otherwise changed this record, attempt to add ' 046 and 378 fields to it m_bMarcRecordChanged = m_bMarcRecordChanged Or RDA_02_08_WhenRecordOtherwiseChanged(MyMarcRecord) #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "AFTER WROC A: " + str(m_bMarcRecordChanged) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "FOR THE LAST TIME: was this record changed? " + str(m_bMarcRecordChanged) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If #If MusicMediumDebug = -1 Then Debug.Print "Record changed? " + str(m_bMarcRecordChanged) + " >" + gblsAuthorityField382ToAdd$ + "<" #End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Before things get mysterious: " + str(m_bMarcRecordChanged) 'Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, "001 010 046 100 374 670") #End If RDA0200P3_UndifferentiatedLandsHere: #If TrackRichardsDamnProblem = -1 Then Debug.Print "Record changed at start of big If: " + str(m_bMarcRecordChanged) + " subtype: " + str(m_lStatisticsRecordSubtype) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced) #End If If m_bMarcRecordChanged Then For lPtr = 1 To gbllFieldLast If Mid(gblaField(lPtr).FldTag, 1, 1) = "1" Then If gblaField(lPtr).FldTag <> sOriginal1xxTag$ Then RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_AnyKindOf1xxChange ElseIf gblaField(lPtr).FldInd <> sOriginal1xxIndicators$ Then RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_AnyKindOf1xxChange ElseIf gblaField(lPtr).FldText <> sOriginal1xxRaw$ Then RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_AnyKindOf1xxChange End If End If Next ' lptr RDA0200P3_ChangedBecauseUndifferentiated: ' we changed *something* in this record ' if we changed the record and if the 1XX matches the 7XX, we want to force the record to RDA, ignoring any ' "non-RDA" qualities the 1XX may otherwise possess ' NOTE that we're in phase 2 and during phase 2 we delete the 7XX fields; so if the record contained ' 7XX fields when it arrived, it's going to be coming down the "record changed" branch, not the ' "record not changed" branch--we will ALWAYS be here if we have 7XX fields ' set a boolean to tell us whether the 1XX--as it may have been changed--is now ' identical with a now-deleted 7XX field For lPtr = 1 To gbllRda7xxLast ' gbllRda7xxLast may of course be zero If gblaRda7xx(lPtr).FieldText = gblaField(1).FldText Then bRecodeRecordAsRdaBecauseOf7XX = True Exit For End If Next ' if we changed the 1XX field (which caused us to set bCreate4xxFromOriginal1xx to True), then ' create a suppressed 4XX field for the former 1XX If bCreate4xxFromOriginal1xx Then RDA_99_92_GetNextFieldArrayElement With gblaField(gbllFieldLast) .FldTag = "4" + Mid(gblaField(1).FldTag, 2, 2) .FldInd = gblaField(1).FldInd .FldText = MyMarcRecord.MarcDelimiter + "wnnea" + sOriginal1xxRaw$ .FldReason = "Old" .OriginalFieldText = "" ' 20121217: added End With ' 20120309: does the new 4XX for the former 1XX have the same comparison form as the ' new 1XX (example: we added parens around $c and uppercased the first letter)? If gblaField(gbllFieldLast).FldNormNaco(True, MyMarcRecord) = gblaField(1).FldNormNaco(True, MyMarcRecord) Then ' yes: meaning that the 4XX we just added for the former 1XX is actually redundant, and would be ' removed during the end-game ' because this is a kind of curious/interesting thing, let's also ' preserve this just in case someone cares RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_4xxNotAddedBecauseRedundant, FILENAME_4xxNotAddedBecauseRedundant$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(gbllFieldLast).FldTag + " " + gblaField(gbllFieldLast).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(gbllFieldLast).FldText) + " [former 1XX]", "", "", "", "", "" ' hide the 4XX in this manner: gbllFieldLast = gbllFieldLast - 1 Else ' no, the new 4XX for the former 1XX does not compare same as the modified 1XX; so ' report this separately in case someone is interested RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_4xxAdded, FILENAME_4xxAdded$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(gbllFieldLast).FldTag + " " + gblaField(gbllFieldLast).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(gbllFieldLast).FldText) + " [former 1XX]", "", "", "", "", "" RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_4xxAddedForFormer1XX If m_lStatisticsRecordSubtype = AUTHORITYSUBTYPE_TopicalNameTestsNeeded Then lPtr = FindTag("681", gblsMarcDirectory$) If lPtr > 0 Then ExtractField lPtr, gblsMarcDirectory$, gblsMarcFields$, sTag$, sIndicators$, sField$ RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_Lcsh1xxChangedWith681, FILENAME_1xxChangedWith681$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(gbllFieldLast).FldTag + " " + gblaField(gbllFieldLast).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(gbllFieldLast).FldText) + " [former 1XX]" + vbTab + RDA_99_86_ProcessFieldForOutput(sField$), "", "", "", "", "" End If End If End If End If ' generate non-suppressed versions of now-suppressed 4XX fields for former headings that ' received some change ' we are going to consider it too troublesome to check each of these for redundancy; we'll ' allow this to be taken care of by the standard routine called elsewhere ' recall that in any case we have suppressed the old-heading reference, so ' the record is "changed" no matter what we do here ' 20120313: however, we ARE going to test this for reasonableness Do While Len(sModified4XXsToReAdd$) > 0 GetNextPiece sModified4XXsToReAdd$, sField$, vbLf RDA_99_92_GetNextFieldArrayElement With gblaField(gbllFieldLast) .FldTag = Mid(sField$, 1, 3) .FldInd = Mid(sField$, 4, 2) .FldText = Mid(sField$, 6) .FldReason = "4XX" .OriginalFieldText = "" ' 20121217: added If .SfdFindFirst("w") Then .SfdDelete .FldText = .FldText End If If RDA_99_83_IsThisNew4xxReasonable() Then RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_4xxCreatedFromOldHeading4xx, FILENAME_4xxFromOldHeading4XX$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(gbllFieldLast).FldTag + " " + gblaField(gbllFieldLast).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(gbllFieldLast).FldText) + " [former 4XX]", "", "", "", "", "" Else RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_4xxCreatedFromOldHeading4xxNOT, FILENAME_4xxFromOldHeading4XXNot$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(gbllFieldLast).FldTag + " " + gblaField(gbllFieldLast).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(gbllFieldLast).FldText) + " [former 4XX]", "", "", "", "", "" ' remove this 4XX from this record gbllFieldLast = gbllFieldLast - 1 End If End With Loop ' 20121222: same thing for any additional Bible references Do While Len(sAdditionalBibleReferences$) > 0 GetNextPiece sAdditionalBibleReferences$, sField$, vbLf RDA_99_92_GetNextFieldArrayElement With gblaField(gbllFieldLast) .FldTag = Mid(sField$, 1, 3) .FldInd = Mid(sField$, 4, 2) .FldText = Mid(sField$, 6) .FldReason = "4XX" .OriginalFieldText = "" ' 20121217: added If .SfdFindFirst("w") Then .SfdDelete .FldText = .FldText End If #If False Then If RDA_99_83_IsThisNew4xxReasonable() Then RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_4xxCreatedFromOldHeading4xx, FILENAME_4xxFromOldHeading4XX$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(gbllFieldLast).FldTag + " " + gblaField(gbllFieldLast).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(gbllFieldLast).FldText) + " [former 4XX]", "", "", "", "", "" Else RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_4xxCreatedFromOldHeading4xxNOT, FILENAME_4xxFromOldHeading4XXNot$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(gbllFieldLast).FldTag + " " + gblaField(gbllFieldLast).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(gbllFieldLast).FldText) + " [former 4XX]", "", "", "", "", "" ' remove this 4XX from this record gbllFieldLast = gbllFieldLast - 1 End If #End If End With Loop #If ConvertSingleAuthorityRecordDebug = -1 Or WhenRecordOtherwiseChangedDebug = -1 Then Debug.Print "Before copying array in 99.93:" Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If ' stuff the array elements back into the MARC record object with which we started RDA_99_93_CopyArrayToFields MyMarcRecord #If WhenRecordOtherwiseChangedDebug = -1 Then Debug.Print "BEFORE WROC B: " + str(m_bMarcRecordChanged) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If m_bMarcRecordChanged = m_bMarcRecordChanged Or RDA_02_08_WhenRecordOtherwiseChanged(MyMarcRecord, True) #If WhenRecordOtherwiseChangedDebug = -1 Then Debug.Print "AFTER WROC B: " + str(m_bMarcRecordChanged) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After copying array" Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If RDA_02_28_Reformulate678Fields MyMarcRecord #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After 678 fields" Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced, PHASE_3B_TAG_LIST$) #End If ' 20150208: I don't think this belongs in 3B #If False Then #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Is this undifferentiated? " + str(gblbUndifferentiatedPersonalName) + " subtype: " + str(gblbUndifferentiatedPersonalName) + " " + str(m_lStatisticsRecordSubtype) + " changed? " + str(m_bMarcRecordChanged) #End If If gblbUndifferentiatedPersonalName Then RDA_02_34_ReformulateUndifferentiatedNameRecord #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print vbTab + "Changed after: " + str(m_bMarcRecordChanged) #End If End If #End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Fields stuffed back into record:" Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced) ' we want to see 'em all, here #End If #If MusicMediumDebug = -1 Then Debug.Print "After stuffing fields back into record: " + str(m_bMarcRecordChanged) + " >" + gblsAuthorityField382ToAdd$ + "<" #End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "After otherwise changed: " + str(m_bMarcRecordChanged) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced) ' we want to see 'em all, here #End If ' 20130120: if we changed any 5XX fields and if the record contains ' a 663 or 665 field, report it for later review (we've decided not ' to attempt to change things, beyond the clearly-good "dept." change ' we made elsewhere) If bChanged5XX Then ' 20130208: but only if there is actually a 663 or 665!!! If MyMarcRecord.FldFindFirst("663") Or MyMarcRecord.FldFindFirst("665") Then RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_663or665NeedsReview, FILENAME_663or665NeedsReview$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + gblaField(1).FldTag + " " + gblaField(1).FldInd + " " + RDA_99_86_ProcessFieldForOutput(gblaField(1).FldText), "", "", "", "", "" End If End If ' ************************************* ' * ' * we are somewhere within phase 3 ' * we made some change to the record during inspection ' * ' ************************************* ' 20120711: deal with the reference evaluation byte (008/29) If InStr("ab", gblsInitialReferenceEvaluationByte$) > 0 Then ' the incoming record allegedly has at least one 4XX or 5XX field If Not MyMarcRecord.FldFindFirst("4") Then If Not MyMarcRecord.FldFindFirst("5") Then ' the finished record has no 4XX or 5XX fields: so no references to evaluate MyMarcRecord.Change008Value 29, "n" End If End If Else ' allegedly, the initial record had no 4XX or 5XX fields ' 20120718: we initially considered the possibility of using ' "a" if all the 4XX and 5XX are suppressed, on the theory that ' the suppressed one is one that we added ourselves, but we've ' decided against that #If True Then ' 20121028: even fancier: if the 4XX are all suppressed, then ' yes, they have been evaluated If MyMarcRecord.FldFindFirst("5") Then 'MyMarcRecord.Change008Value 29, "b" MyMarcRecord.Change008Value 29, "a" ' 20130118 Else If MyMarcRecord.FldFindFirst("4") Then ' assume that the references have been avaluabed MyMarcRecord.Change008Value 29, "a" MyMarcRecord.FldMoveTop Do While MyMarcRecord.FldFindNext("4") If Not MyMarcRecord.FldIsSuppressedReference Then ' we have found an unsuppressed reference ' assume then that things have not been evaluated MyMarcRecord.Change008Value 29, "a" ' 20130118 'MyMarcRecord.Change008Value 29, "b" Exit Do End If Loop Else ' neither 4XX nor 5XX: make certain we've got an "n" MyMarcRecord.Change008Value 29, "n" End If End If #Else If MyMarcRecord.FldFindFirst("4") Then MyMarcRecord.Change008Value 29, "a" ' 20130118 'MyMarcRecord.Change008Value 29, "b" ElseIf MyMarcRecord.FldFindFirst("5") Then 'MyMarcRecord.Change008Value 29, "b" MyMarcRecord.Change008Value 29, "a" ' 20130118 End If #End If End If ' ************************************* ' * ' * we are somewhere within phase 3 ' * we made some change to the record during inspection ' * ' ************************************* #If ConvertSingleAuthorityRecordDebug = -1 Or TrackRichardsDamnProblem = -1 Then Debug.Print "At the major decision point for subtype " + str(m_lStatisticsRecordSubtype) + " with " + str(b667HeadingCannotBeUsedAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedNonAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAtAllAlreadyPresent) + " " + str(b667HeadingCannotBeUsedUndifferentiated) #End If ' the final handling is based, again, on the kind of record Select Case m_lStatisticsRecordSubtype Case AUTHORITYSUBTYPE_Rda ' if we get here, this means that we have made some kind of change to an RDA record ' not the normal case but hardly impossible (fixed something in a 4XX? cello?) ' make sure that you don't have any of "our" 667 fields (better not be necessary!) ' NOTE MOST CAREFULLY that we do NOT allow here for the handling of the "undifferentiated" ' 667 field, because such a record cannot be re-coded as RDA If b667HeadingCannotBeUsedAACR2AlreadyPresent Or b667HeadingCannotBeUsedNonAACR2AlreadyPresent Or b667HeadingCannotBeUsedAtAllAlreadyPresent Then MyMarcRecord.FldMoveTop Do While MyMarcRecord.FldFindNext("667") If InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedNonAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedUndifferentiated$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, sField$, "DCM Z1 008/32", vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With End If Loop End If #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Branching to TransferCountersOrange2" #End If ' explicit branch makes for self-documentation ' we have ALREADY called 02.08 GoTo RDA0200AP3B_TransferCountersOrange2 Case AUTHORITYSUBTYPE_Aacr2Compatible, AUTHORITYSUBTYPE_PreAacr2, AUTHORITYSUBTYPE_Undetermined, AUTHORITYSUBTYPE_NotAValidHeading ' phase 3 #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Acceptable point B" #End If If Not bChangedNotCounting7xxFields Then ' the record was ONLY changed because of the removal of 7XX fields bRecodeRecordAsRdaBecauseOf7XX = False End If ' 20121218: if the only change that we made to such a record is the ' removal of 7XX fields, then we DO NOT want to re-code the record ' as RDA If b667HeadingCannotBeUsedAACR2AlreadyPresent Or b667HeadingCannotBeUsedNonAACR2AlreadyPresent Or b667HeadingCannotBeUsedAtAllAlreadyPresent Or b667HeadingCannotBeUsedUndifferentiated Then If bRecodeRecordAsRdaBecauseOf7XX Then ' 20120929: if a deleted RDA 7XX is in fact same as the 1XX, we ' can in truth remove the 667s and pretend nothing is wrong RDA0200P2_RemoveThe667s: MyMarcRecord.FldMoveTop Do While MyMarcRecord.FldFindNext("667") If InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedNonAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With End If Loop If Not gblbUndifferentiatedPersonalName Then RDA_02_11_RecodeAacr2AsRda MyMarcRecord ' phase 3 End If Else ' the record has *one* of the relevant 667 fields in it, and that's good enough ' 20120713: it should be the case that this did not receive the 667 in phase 1, so ' the fact that it's received the 667 in phase 2 is curious and we'd like to know more ' about this If gblbUndifferentiatedPersonalName Then If Not b667HeadingCannotBeUsedUndifferentiated Then MyMarcRecord.FldMoveTop Do While MyMarcRecord.FldFindNext("667") If InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedNonAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With End If Loop gbls667FieldToAdd$ = MyMarcRecord.MarcDelimiter + "a" + m_sHeadingCannotBeUsedUndifferentiated$ RDA_99_94_Add667ForReal MyMarcRecord RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_667Added, FILENAME_667Added$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + "667 " + RDA_99_86_ProcessFieldForOutput(gbls667FieldToAdd$), "", "", "", "", "" End If End If RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_667AlreadyPresent, FILENAME_667AlreadyPresent$, "**************************************************" + vbCrLf + MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced) + vbCrLf, "", "", "", "", "" End If Else ' this one needs a blocking 667, but it doesn't have one yet ' here's the record sans the 667 field If gblbUndifferentiatedPersonalName Then gbls667FieldToAdd$ = MyMarcRecord.MarcDelimiter + "a" + m_sHeadingCannotBeUsedUndifferentiated$ Else gbls667FieldToAdd$ = MyMarcRecord.MarcDelimiter + "a" + m_sHeadingCannotBeUsedAtAll$ End If RDA_99_94_Add667ForReal MyMarcRecord RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_667Added, FILENAME_667Added$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + "667 " + RDA_99_86_ProcessFieldForOutput(gbls667FieldToAdd$), "", "", "", "", "" RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667NonAACR2 ' phase 3 End If ' explicit branch makes for self-documentation ' we have ALREADY called 02.08 GoTo RDA0200AP3B_TransferCountersOrange2 Case AUTHORITYSUBTYPE_Aacr2Acceptable, AUTHORITYSUBTYPE_TopicalNameTestsNeeded ' phase 3 #If True Then #If ConvertSingleAuthorityRecordDebug = -1 Or TrackRichardsDamnProblem = -1 Then Debug.Print "Acceptable point A with values " + str(b667HeadingCannotBeUsedNonAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAtAllAlreadyPresent) + " " + str(b667HeadingCannotBeUsedUndifferentiated) #End If If (b667HeadingCannotBeUsedAACR2AlreadyPresent Or b667HeadingCannotBeUsedAtAllAlreadyPresent) And Not gblbUndifferentiatedPersonalName Then If Not RDA_02_19_IsTheFieldNowCompatibleWithRDA(gblaField(1)) Then ' phase 3B GoTo RDA0200P3B_ContinueWithExisting667s End If MyMarcRecord.FldMoveTop Do While MyMarcRecord.FldFindNext("667") If InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667FieldRemoved m_bMarcRecordChanged = True ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedNonAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667FieldRemoved m_bMarcRecordChanged = True ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667FieldRemoved m_bMarcRecordChanged = True ElseIf InStr(1, MyMarcRecord.FldText, "DCM Z1 008/32", vbTextCompare) > 0 Then MyMarcRecord.FldDelete RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667FieldRemoved m_bMarcRecordChanged = True End If Loop RDA_02_11_RecodeAacr2AsRda MyMarcRecord m_bMarcRecordChanged = m_bMarcRecordChanged Or RDA_02_08_WhenRecordOtherwiseChanged(MyMarcRecord) ' phase 3, record not changed ElseIf b667HeadingCannotBeUsedNonAACR2AlreadyPresent Or b667HeadingCannotBeUsedUndifferentiated Then RDA0200P3B_ContinueWithExisting667s: ' 20120713: it should be the case that this did not receive the 667 in phase 1, so ' the fact that it's received the 667 in phase 2 is curious and we'd like to know more ' about this RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_667AlreadyPresent, FILENAME_667AlreadyPresent$, "**************************************************" + vbCrLf + MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced) + vbCrLf, "", "", "", "", "" Else ' this record might as well be re-coded as RDA while we're at it ' 20120306: but no recoding for topical subjects If Not gblbUndifferentiatedPersonalName Then ' 20150528: added If m_lStatisticsRecordSubtype <> AUTHORITYSUBTYPE_TopicalNameTestsNeeded Then ' 20120307: new category: if this was formerly a record with ' the 667 "can't be used until changed", then ' count it separately (to keep statics better in parallel with alternate 3, phase 1) ' re-code this happy AACR2 record as RDA RDA_02_11_RecodeAacr2AsRda MyMarcRecord ' phase 3 End If End If ' explicit branch makes for self-documentation ' we have ALREADY called 02.08 GoTo RDA0200AP3B_TransferCountersOrange2 End If ' explicit branch makes for better self-documentation ' recall that we know that the record was already changed, so only one possibility for branching ' we have ALREADY called 02.08 GoTo RDA0200AP3B_TransferCountersOrange2 #Else #If TrackRichardsDamnProblem = -1 Then Debug.Print "Call to 20.19 B" #End If ' is the AACR2 1XX (now, after any manipulation) compatible with use under RDA? If Not RDA_02_19_IsTheFieldNowCompatibleWithRDA(gblaField(1)) Then ' phase 3 #If ConvertSingleAuthorityRecordDebug = -1 Or TrackRichardsDamnProblem = -1 Then Debug.Print "A2 acceptable; NOT COMPATIBLE WITH RDA" #End If ' no, the 1XX field (even after any manipulation) is NOT ' compatible with RDA ' 20120929: if a deleted RDA 7XX is in fact same as the 1XX, we ' can in truth remove the 667 and pretend nothing is wrong If bRecodeRecordAsRdaBecauseOf7XX Then GoTo RDA0200P2_RemoveThe667s End If If b667HeadingCannotBeUsedNonAACR2AlreadyPresent Or b667HeadingCannotBeUsedAACR2AlreadyPresent Or b667HeadingCannotBeUsedAtAllAlreadyPresent Or b667HeadingCannotBeUsedUndifferentiated Then ' 20120713: it should be the case that this did not receive the 667 in phase 1, so ' the fact that it's received the 667 in phase 2 is curious and we'd like to know more ' about this RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_667AlreadyPresent, FILENAME_667AlreadyPresent$, "**************************************************" + vbCrLf + MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced) + vbCrLf, "", "", "", "", "" Else ' record changed, heading not acceptable, 667 not present ' add 667 If gblbUndifferentiatedPersonalName Then gbls667FieldToAdd$ = MyMarcRecord.MarcDelimiter + "a" + m_sHeadingCannotBeUsedUndifferentiated$ Else gbls667FieldToAdd$ = MyMarcRecord.MarcDelimiter + "a" + m_sHeadingCannotBeUsedAtAll$ End If RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667AACR2 ' phase 3 RDA_99_94_Add667ForReal MyMarcRecord RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_667Added, FILENAME_667Added, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + "667 " + RDA_99_86_ProcessFieldForOutput(gbls667FieldToAdd$), "", "", "", "", "" End If m_bMarcRecordChanged = m_bMarcRecordChanged Or RDA_02_08_WhenRecordOtherwiseChanged(MyMarcRecord) ' alternate orange, phase 1, record not changed #If WhenRecordOtherwiseChangedDebug = -1 Then Debug.Print "AFTER WROC C: " + str(m_bMarcRecordChanged) #End If ' explicit branch makes for better self-documentation ' recall that we know that the record was already changed, so only one possibility for branching ' we have ALREADY called 02.08 GoTo RDA0200AP3B_TransferCountersOrange2 Else ' phase 3 #If ConvertSingleAuthorityRecordDebug = -1 Or TrackRichardsDamnProblem = -1 Then Debug.Print "A2 acceptable; YES COMPATIBLE WITH RDA " + str(gblbUndifferentiatedPersonalName) #End If If Not gblbUndifferentiatedPersonalName Then ' yes, the AACR2 1XX is now compatible with RDA ' yes, we had to change something in the record to get it to that state If b667HeadingCannotBeUsedAACR2AlreadyPresent Or b667HeadingCannotBeUsedNonAACR2AlreadyPresent Or b667HeadingCannotBeUsedAtAllAlreadyPresent Then ' has one of the relevant 667 fields in it; remove any and all MyMarcRecord.FldMoveTop Do While MyMarcRecord.FldFindNext("667") If InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedNonAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete m_bMarcRecordChanged = True ' should already be the case With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) = .Counters(SUBTYPECHANGECOUNTER_667FieldRemoved) + 1 End With End If Loop End If Else ' undifferentiated; make sure that the 667 we need is present bFound = False MyMarcRecord.FldMoveTop Do While MyMarcRecord.FldFindNext("667") DoEvents If InStr(MyMarcRecord.FldNorm, "CANNOT BE USED") > 0 Then bFound = True Exit Do End If Loop If Not bFound Then MyMarcRecord.FldAdd "667", " " MyMarcRecord.SfdAdd "a", HEADING_CANNOT_BE_USED_UndifferentiatedB$ End If End If m_bMarcRecordChanged = m_bMarcRecordChanged Or RDA_02_08_WhenRecordOtherwiseChanged(MyMarcRecord) ' alternate orange, phase 1, record not changed #If WhenRecordOtherwiseChangedDebug = -1 Then Debug.Print "AFTER WROC D: " + str(m_bMarcRecordChanged) #End If ' this record might as well be re-coded as RDA while we're at it ' 20120306: but no recoding for topical subjects If Not gblbUndifferentiatedPersonalName Then ' 20150528: added If m_lStatisticsRecordSubtype <> AUTHORITYSUBTYPE_TopicalNameTestsNeeded Then ' 20120307: new category: if this was formerly a record with ' the 667 "can't be used until changed", then ' count it separately (to keep statics better in parallel with alternate 3, phase 1) ' re-code this happy AACR2 record as RDA RDA_02_11_RecodeAacr2AsRda MyMarcRecord ' phase 3 End If End If ' explicit branch makes for self-documentation ' we have ALREADY called 02.08 GoTo RDA0200AP3B_TransferCountersOrange2 End If ' is the 1XX in the changed record not acceptable under RDA? ("No" first, "Yes" second) #End If Case Else ' this includes, at a minimum, topical with no name tests needed, which is ILLOGICAL ' because by definition we could not have changed anything in such a record 'GoTo RDA0200AP3B_TransferCounters2 End Select ' phase 3 RDA0200AP3B_TransferCountersOrange2: #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "At TransferCountersOrange2 label" #End If ' add the temporary counters into the permanent counters For lPtr = 0 To SUBTYPECHANGECOUNTER_Maximum gblaStatistics(m_lStatisticsTypePointer).Subtype(m_lStatisticsRecordSubtype).Counters(lPtr) = gblaStatistics(m_lStatisticsTypePointer).Subtype(m_lStatisticsRecordSubtype).Counters(lPtr) + gblaTemporarySubtype.Counters(lPtr) Next ' lfldpointer #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Branching to _Changed" #End If ' we have ALREADY called 02.08 GoTo RDA0200AP3B_Changed ' ******************************* Else ' record was NOT changed in phase 3 ' ******************************* #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Not changed in 3B; 667 found? " + str(b667HeadingCannotBeUsedNonAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAtAllAlreadyPresent) + " " + str(b667HeadingCannotBeUsedUndifferentiated) + " for subtype: " + str(m_lStatisticsRecordSubtype) #End If ' 20120929: because in phase 2 we deleted RDA 7XX in all cases, we can never be here ' if the incoming record contains an RDA 7XX field; so questions about the coincidence ' of 1XX and 7XX need not be posed in this branch ' for certain record types (those which if at all possible we don't want to ' have to re-issue in alternate 3, phase 3) attempt to add 046 and 378 fields; if we do, then ' the record WAS changed after all ' 20120222: as above, we now INCLUDE un-changed RDA records here, as they may ' also want 047/378 fields ' 20120222: it is actually better if we exclude the things that we do not want ' to do here, rather than include them ' let's not mix the two issues: let's add 667s if lacking, and then let's add 046/378s if lacking Select Case m_lStatisticsRecordSubtype Case AUTHORITYSUBTYPE_Rda ' this shouldn't be necessary in 3B, but if it is then ' we need to do something about it! If gblbUndifferentiatedPersonalName Then ' this results in the re-coding of this record as AACR2 RDA_02_34_ReformulateUndifferentiatedNameRecord GoTo RDA0200P3_ChangedBecauseUndifferentiated End If ' clearly nothing to be done here--do not re-issue the record GoTo RDA0200AP3B_NoChange Case AUTHORITYSUBTYPE_Aacr2Compatible, AUTHORITYSUBTYPE_PreAacr2, AUTHORITYSUBTYPE_Undetermined, AUTHORITYSUBTYPE_NotAValidHeading #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Decision point B3" #End If ' record not changed in phase 3 ' such a record requires a 667 field labeling it as unacceptable under RDA until cleaned up ' this already includes undifferentiated name records if they have one of these codes in 'em ' this record needs a blocking 667 field If b667HeadingCannotBeUsedAACR2AlreadyPresent Or b667HeadingCannotBeUsedNonAACR2AlreadyPresent Or b667HeadingCannotBeUsedAtAllAlreadyPresent Or b667HeadingCannotBeUsedUndifferentiated Then ' record has *one* of the 667 fields in it, and that's good enough GoTo RDA0200AP3B_NoChange Else #If ConvertSingleAuthorityRecordDebug = -1 Then Debug.Print "Want to add a 667 C; values " + str(b667HeadingCannotBeUsedAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedNonAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAtAllAlreadyPresent) #End If ' record not changed; not acceptable under RDA ' record does not have the non-AACR2 667 field in it ' add the pre-AACR2 667 field to the record as we have it gbls667FieldToAdd$ = MyMarcRecord.MarcDelimiter + "a" + m_sHeadingCannotBeUsedAtAll$ MyMarcRecord.MarcRecordIn = m_sMarcRecordIn$ RDA_99_94_Add667ForReal MyMarcRecord m_bMarcRecordChanged = True ' "manually" increment the official counter for the added 667 With gblaStatistics(m_lStatisticsRecordType).Subtype(m_lStatisticsRecordSubtype) .Counters(SUBTYPECHANGECOUNTER_667NonAACR2) = .Counters(SUBTYPECHANGECOUNTER_667NonAACR2) + 1 ' phase 3 End With RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_667Added, FILENAME_667Added$, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + "667 " + RDA_99_86_ProcessFieldForOutput(gbls667FieldToAdd$), "", "", "", "", "" m_bMarcRecordChanged = m_bMarcRecordChanged Or RDA_02_08_WhenRecordOtherwiseChanged(MyMarcRecord) ' phase 3, record not changed #If WhenRecordOtherwiseChangedDebug = -1 Then Debug.Print "AFTER WROC E: " + str(m_bMarcRecordChanged) #End If GoTo RDA0200AP3B_Changed End If ' unacceptable record changed? ("Yes" first, "No" second) Case AUTHORITYSUBTYPE_Aacr2Acceptable #If ConvertSingleAuthorityRecordDebug = -1 Or TrackRichardsDamnProblem = -1 Then Debug.Print "Decision point B4" #End If ' record not changed ' if the 1XX is not valid for use under RDA, then we need to make certain ' that the proper 667 field is present--and remove it if it's present ' but not wanted If gblbUndifferentiatedPersonalName Then ' 20150205: "reformulate" doesn't belong here; we need simply to declare ' this as not compatible GoTo RDA0200AP3B_NoChange 'RDA_02_34_ReformulateUndifferentiatedNameRecord 'GoTo RDA0200P3_ChangedBecauseUndifferentiated End If #If TrackRichardsDamnProblem = -1 Then Debug.Print "Call to 20.19 A" #End If If Not RDA_02_19_IsTheFieldNowCompatibleWithRDA(gblaField(1)) Then ' phase 3 RDA02003B_A2AcceptableNotCompatible: #If ConvertSingleAuthorityRecordDebug = -1 Or TrackRichardsDamnProblem = -1 Then Debug.Print "Not changed; AACR2 and IS NOT acceptable under RDA" #End If 'Debug.Print "A2 acceptable; 1xx is NOT OK ; already present? " + str(b667HeadingCannotBeUsedAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAACR2AlreadyPresent) ' no, the 1XX field is NOT compatible with RDA (and no changes were made) If b667HeadingCannotBeUsedAACR2AlreadyPresent Or b667HeadingCannotBeUsedNonAACR2AlreadyPresent Or b667HeadingCannotBeUsedAtAllAlreadyPresent Then ' happily enough this record has one of our 667 fields in it already, so nothing ' for us to do ' if things are going smoothly, we will end up here most of the time of we make ' multiple passes through the file! GoTo RDA0200AP3B_NoChange End If ' record NOT changed, heading not acceptable, 667 not present ' add 667 'RDA_99_91_WriteMiscellaneousMessage "", "", "", "", "phase 3; 667 not already present A" MyMarcRecord.MarcRecordIn = m_sMarcRecordIn$ gbls667FieldToAdd$ = MyMarcRecord.MarcDelimiter + "a" + m_sHeadingCannotBeUsedAtAll$ RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667AACR2 ' phase 3 RDA_99_94_Add667ForReal MyMarcRecord RDA_99_89_OpenOutputFileCountAndWrite_Bis OUTPUTFILE_667Added, FILENAME_667Added, m_sCurrentRecordNationalNumber$ + vbTab + gblsCurrentRecord001$ + vbTab + "667 " + RDA_99_86_ProcessFieldForOutput(gbls667FieldToAdd$), "", "", "", "", "" m_bMarcRecordChanged = m_bMarcRecordChanged Or RDA_02_08_WhenRecordOtherwiseChanged(MyMarcRecord) ' phase 3, record not changed #If WhenRecordOtherwiseChangedDebug = -1 Then Debug.Print "AFTER WROC G: " + str(m_bMarcRecordChanged) #End If ' explicit branch makes for self-documentation GoTo RDA0200AP3B_TransferCountersOrange2 Else ' phase 3 #If ConvertSingleAuthorityRecordDebug = -1 Or TrackRichardsDamnProblem = -1 Then Debug.Print "Not changed; AACR2 IS acceptable and compatible with RDA" #End If ' AACR2 record not (yet) changed #If True Then ' THIS IS ONLY FOR PHASE 3B!!! MyMarcRecord.MarcRecordIn = m_sMarcRecordIn$ #If TrackRichardsDamnProblem = -1 Then Debug.Print "REcord at this point with values " + str(b667HeadingCannotBeUsedAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedNonAACR2AlreadyPresent) + " " + str(b667HeadingCannotBeUsedAtAllAlreadyPresent) Debug.Print MyMarcRecord.TextFormatted(HexEquivalents, OclcMonospaced) #End If ' the AACR2 1XX is (already) compatible with RDA ' don't do anything for topical records If b667HeadingCannotBeUsedAACR2AlreadyPresent Or b667HeadingCannotBeUsedNonAACR2AlreadyPresent Or b667HeadingCannotBeUsedAtAllAlreadyPresent Then MyMarcRecord.FldMoveTop Do While MyMarcRecord.FldFindNext("667") If InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667FieldRemoved m_bMarcRecordChanged = True ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedNonAACR2$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667FieldRemoved m_bMarcRecordChanged = True ElseIf InStr(1, MyMarcRecord.FldText, m_sHeadingCannotBeUsedAtAll$, vbTextCompare) > 0 Then MyMarcRecord.FldDelete RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667FieldRemoved m_bMarcRecordChanged = True ElseIf InStr(1, MyMarcRecord.FldText, "DCM Z1 008/32", vbTextCompare) > 0 Then MyMarcRecord.FldDelete RDA_99_99_IncrementCounter SUBTYPECHANGECOUNTER_667FieldRemoved m_bMarcRecordChanged = True End If Loop ' 20120307: new category: if this was formerly a record with ' the 667 "can't be used until changed", then ' count it separately (to keep statics better in parallel with alternate 3, phase 1) ' re-code this happy AACR2 record as RDA End If If Not gblbUndifferentiatedPersonalName Then RDA_02_11_RecodeAacr2AsRda MyMarcRecord ' phase 3 End If m_bMarcRecordChanged = m_bMarcRecordChanged Or RDA_02_08_WhenRecordOtherwiseChanged(MyMarcRecord) ' phase 3, record not changed #If WhenRecordOtherwiseChangedDebug = -1 Then Debug.Print "AFTER WROC H: " + str(m_bMarcRecordChanged) #End If GoTo RDA0200AP3B_Changed #End If End If ' is the 1XX in the changed record not acceptable under RDA? ("No" first, "Yes" second) Case AUTHORITYSUBTYPE_TopicalNameTestsNeeded ' phase 3 ' not changed; nothing to be done here GoTo RDA0200AP3B_NoChange Case Else #If False Then If gblbUndifferentiatedPersonalName Then RDA_02_34_ReformulateUndifferentiatedNameRecord GoTo RDA0200P3_ChangedBecauseUndifferentiated End If #End If ' todo: what should happen here? what happens in phase 3? ' is there anything at all that might fit here???? GoTo RDA0200AP3B_NoChange End Select End If RDA0200AP3B_Changed: RDA0200AP3B_NoChange: If m_bMarcRecordChanged Then RDA_02_00_Phase3B = True End If End Function