Code4Lib talk:Community Portal
part 2 of OCLC Connexion cataloging macro.
========================
' *************************************************************************** ' ***************************************************************************
' CHANGE 049 LINE TO REFLECT BRANCH (NHMM, NHMR, NHMC, ETC) ' Remove existing 049, then put a new one in with the correct ending letter.
bool% = CS.GetField("049", 1, wholeline$)
if bool% = TRUE then
bool% = CS.DeleteField ("049", 1)
if bool% = False then
msgbox "PROBLEM: program couldn't remove old 049 tag. Program ending."
goto Done
Else
bool% = CS.AddField( 1, st49$)
if bool% = False then
msgbox "PROBLEM: program couldn't add new 049 tag. Program ending."
goto Done
End If
End If
else
msgbox("Program error. Can't find 049 Tag. Program ending.")
goto Done
end if
' *************************************************************************** ' ***************************************************************************
' FASTCATTERS: CHECK FOR DLC DLC, IF CALL # = 050. If not found call CheckPcc
if fastCatter% = TRUE then
call CheckDlc (dlc%)
if dlc% = FALSE then
call CheckPcc (pcc%)
if pcc% = FALSE then
msgbox "This is neither a DLC DLC nor a PCC record."
answer% = Dialog (YesNo)
if answer% = 2 then goto Done 'IE END PROGRAM, IF USER CHOOSES.
end if ' ON if pcc% = FALSE
end if ' ON if dlc% = FALSE
end if
' *************************************************************************** ' ***************************************************************************
' CHECK FOR SERIES TAGS, CHECK SERIES PUNCTUATION
Call CheckSeries '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' GOTO GOTO GOTO GOTO GOTO GOTO GOTO GOTO GOTO ' PROGRAM JUMPS AHEAD, IF ANALYTIC IS CHOSEN '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' SKIP CALL # STUFF, ITEM LINE STUFF, IF ANALYTIC if analytic% = TRUE then goto Addlines
' *************************************************************************** ' ***************************************************************************
' ADD DELIMITER FOR RETROCON (INSERT |r 2 IN ITEM LINE)
if mydialog.checkRet = 1 then item1$ = " 949 1ßr 2 ßg 1 ßc " SaveItem1$ = item1$
' *************************************************************************** ' ***************************************************************************
' FIND CALL NUMBER, BASED ON WHERE USER SAID TO LOOK
Call GetCallNo(callTag$, TagSubstitute%, GotIt%)
if GotIt% = FALSE then
if mydialog.checkLevel < 2 then
msgbox "Program either couldn't find " + callTag$ + " or couldn't find a call# there. Program Ending."
goto Done
else
msgbox "Program either couldn't find " + callTag$ + " or couldn't find a call# there."
Dialog YesNo
if YesNo.BG1 = 1 then goto Done 'TOPCATTER CHOOSES TO END PROGRAM
end if
end if
' *************************************************************************** ' ***************************************************************************
' FIND CALL # DATE, 260 DATE, COMPARE TO FIXED FIELD DATE
call CheckDates(dateFF1$, dateProblem%)
If dateProblem% = TRUE then 'Change on 11/22/4
Dialog YesNo
if YesNo.BG1 = 1 then goto Done 'USER CHOOSES TO ABORT PROGRAM
End If
' *************************************************************************** ' *************************************************************************** ' CHECK FOR MORE THAN ONE CALL NUMBER IN LINE THAT HOLDS CALL NUMBER. IF FASTCATTING, END PROGRAM. ' OTHERWISE, WARN & ADVISE USER.
if instr(fCallno$, "ßa") > 0 then
if fastCatter% = True then
msgbox "PROBLEM: 2 call numbers in call# tag - Program Ending."
goto Done
else
msgbox "PROBLEM: 2 call numbers in call# tag" & _
chr$(13) & _
"Correct call number should be put in 090 field."
Dialog YesNo
if YesNo.BG1 = 1 then goto Done 'USER CHOOSES TO END PROGRAM
end if
end if
' *************************************************************************** ' *************************************************************************** 'CHECK FOR A CALL NUMBER STARTING WITH Z, AND A FOLLOWING NUMBER >= 1200
Call CheckCallZ(badZ%)
if badZ% = TRUE then
if fastCatter% = True then
msgbox "PROBLEM: Z call number above 1199 - Program Ending."
goto Done
else
msgbox "PROBLEM: Z call number above 1199"
Dialog YesNo
if YesNo.BG1 = 1 then goto Done 'USER CHOOSES TO END PROGRAM
end if
end if
' *************************************************************************** ' ***************************************************************************
' CHANGE ITEM LOCATION, IF CALL # 1ST LETTER < M AND >= A, AND BRANCH = MAIN
' ALSO, GET 1ST TWO LETTERS FOR PZ CHECK (PZ INDICATES JUVENILE BOOK)
' ALSO ALSO: IF CALL # STARTS WITH M9 (9 = ANY NUMBER), FORCE OVERSIZE
' NOTE: MAKE THIS A SUB PROGRAM
Firstlet$ = mid(fCallno$, 1, 1) 'GET 1ST LETTER FOR LOCATION CHANGE (MLS, MLS1)
twolet$ = mid(fCallno$, 1, 2) 'GETS 1ST TWO LETTERS OF CALL #
let2$ = mid(fCallno$, 2, 1) 'ISOLATE 2ND LETTER FOR M9 OVERSIZE CHECK
if mydialog.branch = 0 then 'BRANCH = MAIN
if Firstlet$ < "M" and Firstlet$ >= "A" then
locate$ = locate$ + "1" 'IE mls BECOMES mls1
end if
if LCase(twolet$) = "pz" then chksize% = FALSE 'NO SIZE CHECK FOR JUVENILE BOOKS
end if ' [mydialog.branch = 0]
' MINIATURE SCORE CALL#s MUST BEGIN WITH 'MS'
if paperBrnch$ = "[]" then 'IE MINIATURE SCORE
if lcase(twolet$) <> "ms" then
msgbox "For Miniatures Scores, 1st two letters of call number, in 099 tag, " _
& " MUST be 'MS'. Program ending."
goto Done
end if
Else 'I DON'T THINK THIS else EVER GETS USED
if lcase(twolet$) = "ms" then
msgbox "If 1st two letters of call number, in 099 tag, are MS, then branch/location should be " & _
"Miniatures Scores. Program ending."
goto Done
End If
End If
' NOTE: if call # starts with pz1 - pz4, needs reclassing
' if call # starts with pz5 - pz10, Audn: needs juvenile indication
' if call # starts with > pz10, it should be brought to a professional
' *************************************************************************** ' ***************************************************************************
' CHECK 300 TAG FIELD FOR BOOK SIZE.
if chksize% = TRUE then call SizeCheck(ovNote$, locate$, endnote$, stnote$, over%, ovmsg$, _
let2$, Firstlet$, paperBrnch$) 'debug
labelsize$ = ovnote$ 'LABELSIZE$ USED FOR "OVERSIZE" IN SLB LABEL PRINTOUT
' PROCESS
' *************************************************************************** ' *************************************************************************** ' GET NUMBER OF VOLUMES, IF MORE THAN 1
if mydialog.checkVol = 1 then
msgtext$="Enter number of volumes, 1 to 40: "
Do
again% = FALSE
volumeNumber$ = InputBox$(msgtext)
if IsNumber(volumeNumber$) = 1 then
numVol% = Val(volumeNumber$)
if numVol% < 1 OR numVol% > 40 then
msgbox "Please enter a number between 1 and 40"
again% = TRUE
end if
else
msgbox "Please enter a NUMBER between 1 and 40"
again% = TRUE
end if
Loop While again% = TRUE
end if 'FOR if mydialog.checkVol = 1
' *************************************************************************** ' ***************************************************************************
' MATERIALS FOR SPECIAL COLLECTIONS GET NO BARCODE, SO ' MAKE bcodestrt$ NULL. ' END OF BARCODE (bCode$) INITIALIZED HERE bCode$ = "" If doBarcode% = FALSE Then bcodestrt$ = ""
' *************************************************************************** ' *************************************************************************** ' GET PRICE FROM USER
Call GetPrice(money$)
If money$ <> "" then price$ = price$ & money$ & " "
' ***************************************************************************
' ***************************************************************************
' BUILD AND ADD ITEM LINES TO RECORD, FOR MULTI AND SINGLE VOLUMES
' NOTE: MAKE THIS A SUB PROGRAM
if numVol% > 1 then ' MAKE AN ITEM LINE FOR EACH VOLUME
for j% = 1 to numVol%
item1$ = item1$ & ("v." & Cstr(j%) & " ") 'CHANGE PART OF ITEM LINE FOR EACH VOLUME
' THIS PUTS THE TIEM LINE COMPONENTS TOGETHER AND ADDS
' IT TO THE RECORD, ONCE FOR EACH VOLUME.
bool% = cs.addfield (j%, (item1$ & circ$ & _
stnote$ & ovnote$ & price$ & locate$ & status$ & bcodeStrt$ & _
item2$ & fCallno$))
item1$ = SaveItem1$ 'RESET START OF ITEM LINE, SO FOR NEXT VOLUME
next j% 'LOOP BACK TO PROCESS NEXT VOLUME
else 'MAKE ONLY 1 ITEM LINE
' GET END OF BARCODE (OR ALL OF BARCODE,
' IF BARCODE READER BOX IS CHECKED)
' THERE HAS BEEN A SPORADIC PROBLEM OF BARCODE NOT BEING WRITTEM TO
' RECORD? OR NOT BEING DOWNLOADED FROM OCLC, WITH THE REST OF THE RECORD.
' SUSPECT THIS MIGHT BE DUE TO ALTERNATING BETWEEN USING A
' BARCODE READER AND NOT USING IT, AND/OR DOING A MULTI-VOLUME SET.
' SO HERE, THE WHOLE BARCODE IS CHECKED FOR LENGTH AND NUMBER
' CONTENT, JUST BEFORE IT IS WRITTEN TO THE RECORD.
' ALSO, SPECIAL COLLECTIONS MATERIALS GET NO BARCODE, SO IT WOULD BE
' SET TO NULL, AND NULL WOULD BE WRITTEN TO MEMORYER.TXT. NEXT TIME
' PROGRAM RUNS, THERE WILL BE NO BARCODE READ FROM THAT FILE.
If doBarcode% = TRUE Then
Call GetBCEnd(bcode$, notMain%, reader%, bcodestrt$)
completeBarCode$ = BCodeStrt$ & bcode$
if len(completeBarCode$) <> 14 then
Msgbox "PROBLEM: Barcode isn't 14 characters long. STOP: tell Mike or Kathryn."
End If
if IsNumber(completeBarCode$) <> 1 then
Msgbox "PROBLEM: Barcode isn't only numbers. STOP: tell Mike or Kathryn."
End If
End If
' CONSTRUCT AND ADD SINGLE ITEM LINE TO RECORD
bool% = cs.addfield (1, (item1$ & circ$ & _
stnote$ & ovnote$ & price$ & locate$ & status$ & completeBarCode$ & _
item2$ & fCallno$))
end if 'ON [numVol > 1]
' *************************************************************************** ' ***************************************************************************
' REMIND USER ABOUT REQUIREMENTS FOR MULTI VOLUMES
if numVol% > 1 AND doBarcode% = TRUE then
msgtitle$ = "Multivolume Reminder"
msgtext$ = "Each volume needs a barcode label."
if mydialog.checkReader = 0 then 'IE NO BARCODE READER USED
msgtext$ = msgtext$ & chr$(13) & "Barcode in each item line needs last 4 numbers."
else
msgtext$ = msgtext$ & chr$(13) & "Each item line needs whole barcode number."
end if
msgbox msgtext$, , msgtitle$ 'THIS PUTS MESSAGEBOX ON SCREEN
end if
' *************************************************************************** ' ***************************************************************************
' ADD DISC/FLOPPY INFORMATION
' *IF* THERE IS ONLY ONE VOLUME
if mydialog.CheckDis = 1 then
if mydialog.checkVol = 1 AND numVol% > 1 then
diskItem$ = "0"
msgbox "This program doesn't add disk information to item records " _
& "for more than 1 volume." & vbcrlf & vbcrlf _
& "REMEMBER: add e.g. > " & chr$(135) & "c & 1 disc " & chr$(135) _
& "u d < to each 949/item record for which the volume has a disk, or disc."
else
diskItem$ = "1"
end if
' SEND FLAG (via diskFile) FOR MACRO NEW!DISC_FLOPPY
open diskFile for output as #2
print #2, diskItem$
close #2
' RUN MACRO NEW!DISC_FLOPPY
bool = cs.RunMacro ("New!Disc_floppy")
' 'GET DISK INFO (via diskFile) FOR PRINTED LABEL FROM NEW!DISC_FLOPPY
open diskFile$ for input as #2
line input #2, labelEnd$
close #2
end if
' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ' GOTO HERE GOTO HERE GOTO HERE PROGRAM SKIPS TO HERE FOR ANALYTICS ' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Addlines:
' PUT 910 (SHORT INITIALS) LINE TOGETHER,
' DEPENDING ON ANALYTIC/RETROCON STATUS
If analytic% then
nineten$ = "910 " & "analytic " & init910$
Elseif retro% = 1 then 'RETROCON
nineten$ = "910 " & "retro " & init910$
Else
nineten$ = "910 " & init910$
End If
' *************************************************************************** ' ***************************************************************************
' PUT RECSBIN LINE TOGETHER recsbin$ = "949 *recs=b;ins=" & initrec$ & ";ov=." & fBnumber & ";"
' *************************************************************************** ' ***************************************************************************
' ADD 910 LINE TO RECORD
If init910$ = "" then
Msgbox "PROBLEM: Initials for 910 line are blank. STOP; tell Mike or Kathryn."
End If
bool% = cs.addfield (1, nineten$)
' *************************************************************************** ' ***************************************************************************
' ADD RECSBIN LINE TO RECORD
If initrec$ = "" then
Msgbox "PROBLEM: Initials for recs-bin line are blank. STOP; tell Mike or Kathryn."
End If
bool% = cs.addfield (10, recsbin$)
' *************************************************************************** ' ***************************************************************************
' REMIND USER ABOUT PUTTING CALL # IN 090,
' IF BRANCH ANALYTIC
if analytic AND mydialog.branch <> 0 then
msgbox("REMEMBER: write call # in 090 tag" & vbcrlf$ _
& "(For Shelf List card for branch library)")
end if
' *************************************************************************** ' ***************************************************************************
' CALL UP SLB SCREEN AND PRINT LABEL
call PrintLabel(endnote$, labelSize$, numVol%, branch%, st49$, row049%, _
labelEnd$, space$, paperBrnch$)
' *************************************************************************** ' ***************************************************************************
doSpellCheck% = TRUE ' Don't do the spellcheck if the program skips to Done, because
' that means there was probably some problem. Only check spelling
' if this program runs without hitch. Change on 9/10/4
Done:
' WRITE CHOICES BACK TO FILE FOR NEXT RUN
'This creates a new file, effectively removing the old choices by replacing
'them with the new file, and the (maybe) new choices.
open filename$ for output as #4
print #4, init910$ '910 INITIALS
print #4, initrec$ 'RECSBIN INITIALS
print #4, bcodestrt$ 'START OF BARCODE
print #4, mydialog.checkLevel 'FASTCAT, MONOGRAPH, TOPCAT CHOICE
print #4, mydialog.Tag 'BRANCH LOCATION
print #4, mydialog.checkRet 'RETROCON CHOICE
print #4, mydialog.checkReader 'BARCODER READER CHOICE
close #4
'WRITE "OTHER" CHOICE TO FILE AS NEW DEFAULT%
open choice2File$ for output as #4
print #4, choice2%
close #4
msgbox "Program complete"
Clipboard.Clear 'DON'T LET A .B# GET USED > ONCE. Change on 5/21/4 & 11/22/4
' *************************************************************************** ' ***************************************************************************
'CALL UP SPELL CHECKER 'Change on 9/10/4 NO SPELL CHECKER IN CONNEXION TO DATE 2/17/5 'If doSpellCheck% = TRUE then ' cmd$ = "%tp" ' sendkeys cmd$, 1 'End If
end sub
' *************************************************************************** ' *************************************************************************** ' *************************************************************************** ' *************************************************************************** ' END OF MAIN PROGRAM ' FUNCTIONS AND SUB PROGRAMS START HERE ' *************************************************************************** ' *************************************************************************** ' *************************************************************************** ' ***************************************************************************
Sub Checkcall (callno$, callgood%)
' FUNCTION JUDGES CALL # GOOD IF IT HAS > 6 CHARACTERS
' & STARTS WITH A LETTER
' NOTE: callgood% IS SET TRUE BEFORE THIS SUB IS CALLED
' NOTE: THIS FUNCTION DOESN'T WORK WITH DEWEY CALL NUMBERS.
dim Firstlet$
Firstlet$ = trim(mid$(callno$, 1, 1))
if len(callno$) < 7 OR _
Firstlet$ > "Z" OR _
Firstlet$ < "A" then callgood% = FALSE
end Sub
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
function Checkdlc (dlc%) ' LOOK FOR "DLC |b DLC" in 040 tag, if fastcat
dim cs as object
dim wholeline$, bool%
Set CS = CreateObject("Connex.Client")
bool% = CS.GetField("040", 1, wholeline$)
if bool% = TRUE then 'FOUND 040 LINE
if instr(wholeline$, "DLC ßc DLC") > 0 then dlc% = TRUE
end if
end function
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
function CheckPcc (pcc%) ' LOOK FOR PCC in 042 tag, if fastcat, and "DLC |b DLC" isn't found in 040 tag.
dim cs as object
dim wholeline$, bool%
Set CS = CreateObject("Connex.Client")
bool% = CS.GetField("042", 1, wholeline$)
if bool% = TRUE then 'FOUND 042 LINE
if instr(wholeline$, "pcc") > 0 then pcc% = TRUE
end if
end function
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub WriteBCode(bcodestrt$)
' THIS SUB PROGRAM ASKS USER FOR DIGITS 7-10 OF
' BARCODE, AND ADDS THEM TO THE USUAL 346000,
' TO FORM THE FIRST PART OF THE BARCODE.
dim newBCode$, msgtext$, badInput%, j%, i$, vbcrlf$
vbcrlf$ = chr$(13)
msgtext$ = "Enter digits 7-10 of new barcode (exclude initial 3 4600 0):"
Do
badInput% = FALSE
newBCode$ = InputBox$ (msgtext$)
' LEAVE SUB PROGRAM IF CANCEL BUTTON CLICKED, OR NOTHING ENTERED
if newBCode$ = "" then Exit Sub
' MAKE SURE INPUT IS 4 CHARACTERS
if len(newBCode$) <> 4 then
badInput% = TRUE
msgbox "Number of digits entered is not 4" _
& vbcrlf$ & "Please enter exactly 4 digits"
end if
' MAKE SURE ALL CHARACTERS ENTERED ARE NUMBERS
if IsNumber(newBCode$) = 0 then
badInput% = TRUE
msgbox "Non-numeric characters entered" _
& vbcrlf$ & "Please enter numbers only."
end if
Loop while badInput% = TRUE
bcodestrt$ = "346000" & newBCode$
end sub ' Sub WriteBCode
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub ChngeInit(init910$, initrec$)
' GETS INITIALS FOR 910 LINE AND RECS/BIN LINE
dim msgtext$
msgtext$ = "Enter (short) initials for 910 field:"
Get910:
init910$ = InputBox$(msgtext$)
if Init910$ = "" then
msgbox "Initials are required for this field."
goto Get910
end if
' ******************************************************************************* ' *******************************************************************************
msgtext$ = "Enter (long) initials for 949 field:"
Getrecsbin:
initrec$ = InputBox$ (msgtext$)
if initrec$ = "" then
msgbox "Initials are required for this field."
goto Getrecsbin
end if
end sub ' Sub ChngeInit
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub GetBCEnd(bcode$, notMain%, reader%, bcodestrt$) ' GETS LAST PART OF BARCODE, MAKES SURE IT HAS EXACT NUMBER ' OF DIGITS, IF BARCODE READER CHECKBOX IS CHECKED, OR START ' OF BARCODE WAS NOT READ FROM MEMORYER.TXT, 14 DIGITS ARE ' REQUIRED. OTHERWISE, 4 DIGITS ARE REQUIRED.
dim msgtext$, i$, j%, badInput%, vbcrlf$, bcodeSize%
vbcrlf$ = chr$(13)
If reader% = 0 AND bcodestrt$ <> "" Then 'USER DID NOT CHECK BARCODE READER BOX
msgtext$="Enter last 4 digits of barcode: " & vbcrlf & vbcrlf & _
"Barcode goes on COVER!!"
bcodeSize%= 4
Else 'BARCODE READER BOX WAS CHECKED
msgtext$="Enter whole barcode - 14 digits:" & vbcrlf & vbcrlf & _
"Barcode goes on COVER!!"
bcodeSize%= 14
bcodestrt$ = ""
End If
Do
badInput% = FALSE
bCode$ = InputBox$ (msgtext$)
' MAKE SURE REQUIRED NUMBER OF DIGITS ARE ENTERED
if len(bCode$) <> bcodeSize% then
badInput% = TRUE
msgbox "Number of digits entered is not " & cstr(bcodeSize%) _
& vbcrlf$ & "Please enter exactly " & cstr(bcodeSize%) & " digits"
end if
' MAKE SURE ALL CHARACTERS ENTERED ARE NUMBERS
If IsNumber(bCode$) = 0 then
badInput% = TRUE
msgbox "Non-numeric characters entered." _
& vbcrlf$ & "Please enter numbers only."
end if
Loop While badInput% = TRUE
End sub ' sub GetBCEnd
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub GetFxdFlds
' THIS SUB BREAKS OUT INDIVIDUAL FIXED FIELDS, USING THE BUILT IN
' CS.GetFixedField FUNCTION/METHOD. I DON'T NEED ALL OF THEM
' EXTRACTED.
Dim WholeLine$, BOOL%
Dim CS as Object
Set CS = CreateObject("Connex.Client")
CS.GetFixedField "Type", typee$
CS.GetFixedField "BLvl", blvl$
CS.GetFixedField "Desc", desc$
CS.GetFixedField "ELvl", elvl$
CS.GetFixedField "Form", form$
CS.GetFixedField "Cont", cont$
CS.GetFixedField "Ills", ills$
CS.GetFixedField "Srce", srce$
CS.GetFixedField "Conf", conf$
CS.GetFixedField "GPub", gpub$
CS.GetFixedField "Fest", fest$
CS.GetFixedField "Audn", audn$
CS.GetFixedField "Biog", biog$
CS.GetFixedField "LitF", fict$
'CS.GetFixedField "Ctrl", 'I'VE NOT USED THESE, SO DON'T EXTRACT THEM
'CS.GetFixedField "MRec",
CS.GetFixedField "Indx", indx$
CS.GetFixedField "Lang", lang$
CS.GetFixedField "Ctry", ctry$
CS.GetFixedField "dtst", dtst$
CS.GetFixedField "Dates", dateFF1$
CS.GetFixedField ",", dateFF2$ 'THIS IS HOW TO GET THE 2ND DATE !!!
End sub ' Sub GetFxdFlds
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@2
Sub CheckSeries
' THIS SUB LOOKS FOR SERIES TAGS & CHECKS PUNCTUATION THEREIN
' PUNCTUATION: There should NOT be ", ßv"; it should be "; ßv" (semicolon vs comma). This ' subfield is for volume information. Aside from being incorrect, and having ' (to me) unknown repercussions, it makes it impossible for series checking ' software to correctly extract the series title from the volume information, and ' thus makes it necessary to check all such titles manually, instead of with ' that software.
dim cs as object
Set CS = CreateObject("Connex.Client")
dim seriesTag$ (9) ' AN ARRAY!
dim wholeline$, i%, informed%, bool%
seriesTag$ (0) = "400"
seriesTag$ (1) = "410"
seriesTag$ (2) = "411"
seriesTag$ (3) = "440"
seriesTag$ (4) = "490"
seriesTag$ (5) = "800"
seriesTag$ (6) = "810"
seriesTag$ (7) = "811"
seriesTag$ (8) = "830"
informed% = FALSE
' ******************************************************************************* ' *******************************************************************************
for i% = 0 to 9
bool% = CS.GetField(seriesTag(i%), 1, wholeline$)
if bool% = TRUE then
'TELL USER ABOUT FIRST SERIES TAG ONLY
if informed% = FALSE then
msgbox "Record has series title tag(s). > " & seriesTag(i%) & " < Series titles should be " & _
"checked against book."
informed% = TRUE
end if
'CHECK PUNCTUATION OF SERIES LINE, WARN USER
if instr(wholeline$, ", ßv") > 0 then
msgbox seriestag$(i%) & " has , |v " & chr$(13) & _
"; |v is correct" & chr$(13) & _
" (semicolon instead of comma)."
end if
end if ' On if bool% = TRUE
next i%
end sub ' sub CheckSeries
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub CheckDates(dateFF1$, dateProblem%)
' FIND CALL NUMBER DATE AND 260 DATE, COMPARE TO FIXED FIELD DATE
' THIS CALLS ANOTHER FUNCTION (GetDate) TO PULL THE DATES OUT OF THE CALL
' NUMBER, AND ALSO FROM THE END OF THE 260 LINE, BECAUSE THE STEPS
' INVOLVED ARE THE SAME.
dim cs as object
Set CS = CreateObject("Connex.Client")
dim wholeline$, date260Line$, date260$, targetLine$, callDate$ dim vbcrlf$, bool% vbcrlf$ = chr$(13) dateProblem% = FALSE '================================================================================ ' CHECK ON FIXED FIELD DATE (FIRST DATE ONLY) '================================================================================
dateFF1$ = trim(dateFF1$)
If dateFF1$ = "" then
msgbox "Program couldn't find Fixed Field date(s) for date checking." _
& vbcrlf$ & vbcrlf$ _
& "Please check dates visually."
dateProblem% = TRUE
goto Done
End If
'================================================================================
' GET CALL NUMBER DATE
'================================================================================
if fCallno$ = "" then
msgbox "Program couldn't find call number tag for date checking." _
& vbcrlf$ & vbcrlf$ _
& "Please check dates visually."
goto Done
Else
targetLine$ = fCallno$
End If
callDate$ = GetDate(targetLine$)
if callDate$ = "" then
msgbox "Program couldn't find Call Number Date." _
& vbcrlf$ & vbcrlf$ _
& "Please check dates visually."
dateProblem% = TRUE
goto Done
end if
'================================================================================
' FIND 260 DATE
'================================================================================
bool% = CS.GetField("260", 1, wholeline$)
if bool% = FALSE then
msgbox "Program couldn't find 260 tag for date checking." _
& vbcrlf$ & vbcrlf$ _
& "Please check dates visually."
dateProblem% = TRUE
goto Done
end if
targetLine$ = wholeline$
date260$ = GetDate(targetLine$) 'EXTRACT DATE FROM LINE OF TEXT
if Date260$ = "" then
msgbox "Program couldn't find 260 Date." _
& vbcrlf$ & vbcrlf$ _
& "Please check dates visually."
dateProblem% = TRUE
goto Done
end if
' ********************************************************************************
' ********************************************************************************
' COMPARE 260 DATE TO CALL # DATE AND FIXED FIELDS DATE
if date260$ = dateFF1$ AND callDate$ = dateFF1$ then
msgbox "Dates match" _
& vbcrlf$ & vbcrlf$ _
& " Fixed Fields Date: - " & dateFF1$ _
& vbcrlf$ _
& " Call Number Date: - " & callDate$ _
& vbcrlf$ _
& " 260 date: - " & Date260$
else
msgbox "Dates do NOT match!" _
& vbcrlf$ & vbcrlf$ _
& " Fixed Fields Date: - " & dateFF1$ _
& vbcrlf$ _
& " Call Number Date: - " & callDate$ _
& vbcrlf$ _
& " 260 date: - " & Date260$ _
& vbcrlf$ & vbcrlf$ _
& "Please check dates visually."
dateProblem% = TRUE
end if
Done:
end sub ' Sub CheckDates
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Function GetDate (targetLine$)
' PULLS DATES OUT FROM REST OF LINE
' - CALLED BY CHECKDATES SUB PROGRAM
dim i%, lineLength%, start%, dateLength%, one$, extDate$
GetDate = "" lineLength% = len(targetLine$)
' ************************************************************************* ' *************************************************************************
' FIND SPACE PRECEDING DATE
' ALSO, LOOK FOR 'c' PRECEDING DATE, IN 260 LINE (INDICATES
' COPYRIGHT DATE)
for i% = (lineLength%-2) to (lineLength% - 8) step -1
one$ = Mid(targetLine$, i%, 1)
if one$ = " " OR _
one$ = "c" then
start% = i% + 1
dateLength% = lineLength% - i%
exit for
end if
next i%
' ************************************************************************* ' *************************************************************************
' EXTRACT DATE FROM LINE extDate$ = Mid(targetLine$, start%, dateLength%)
' ************************************************************************* ' *************************************************************************
' NAKE SURE IT STARTS WITH A NUMBER one$ = mid$(extDate$, 1, 1) if IsNumber(one$) = 0 then Exit Function
' ************************************************************************* ' *************************************************************************
' REMOVE LAST CHARACTER FROM DATE, IF NOT A NUMBER
if len(ExtDate$) > 4 then
one$ = Mid(ExtDate$, len(ExtDate$), 1)
if IsNumber(one$) = 0 then ExtDate$ = Mid(ExtDate$, 1, (len(ExtDate$)-1))
end if
' ************************************************************************* ' *************************************************************************
GetDate = ExtDate$
end function 'Function GetDate
kwYcQfveWheaUC
cEErcq <a href="http://atxnntxcokkt.com/">atxnntxcokkt</a>, [url=http://rtjomarkqlrg.com/]rtjomarkqlrg[/url], [link=http://lukqtshjrkjz.com/]lukqtshjrkjz[/link], http://pzwnvyriloet.com/
