<I'm not into learning curves absolutely everywhere I go! When wiki formatting is on, it gets screwed up. When it's off, it gets screwed up. There's a @#$%^&* pattern, here! Am I the only one who's HAD it with all the "help" available?! I just want to share this code with anybody who might have use for it. It's source code for an OCLC Connexion macro that we use to help us catalog our books at our university library. I wrote it.
So, you'd have to copy & paste it into a macro. And, you'd most likely have to modify it extensively. Use it if you can.
I suggest putting it into a macro. Then, create a test directory to download records to. Create a folder on your C drive, called Catlabel. Then open a test record up & run this record.
============================================
'NOTE1: IsNumeric doesn't seem to work as advertised. I made a function, IsNumber
' that does.
' MODIFICATIONS/VERSIONS (Better late than never.)
'===================================================
' 5/21/4 - When this program runs, users have already copied the .b# from III,
' and they paste it into the CatME record after CatER ends. CatER
' copies the .b# from the clipboard, puts it into fBNumber, puts it
' into the recs/bin 949 line, and then clears the clipboard.
' 6/2/4 - Changed label printing, to go through View menu. It's a shorter,
' command. Also, if there's no holding library entered for a branch,
' this method makes that clear. With the old method, the label simply
' wouldn't print, if there were not a holding library for that branch.
' 6/18/4 - Fixed infinite loop bug in Sub SixFifties; also set that sub up to warn users
' if there are no 650 0 (2nd indicator = 0) or 650 1 (2nd indicator = 1) in
' a juvenile record
' 6/21/4 - Went back to old label printing method because, for some people, the sendkeys
' timing didn't work, and they had a print dialog box they had to close manually.
' 8/24/4 - Put in a check to make sure fBnumber$, which is read from the clipboard, actually
' holds a bibliographic record number. It has to be about the right length, start
' with a 'b', contain numbers etc. Otherwise it's set to NULL. So now, nobody
' will wind up pasting whatever the last thing they cut & pasted during that day,
' into the recs/bin line. ALSO: a messagebox tells user there's no bib rec number.
' 9/9/4 - This program deletes C:\CatLabel\records.txt, then creates a new version to hold
' the new record. It creates a new file by printing the record to that file. In
' Tools > Options > Record Print, the checkbox that indicates it should go to that
' file MUST be checked. If it's not, the record is printed to the default printer
' instead, and the new file is never created. The change is to verify that that
' file exists, after the new record is printed. If not, user is informed, and
' program ends.
' 9/10/4 - Made doSpellCheck% boolean variable, that starts out FALSE, and is set
' TRUE just before Done: label. Then, spellchecking is called only if
' doSpellCheck% is set TRUE. So spellchecking should only happen if this
' program runs correctly, instead of also running when it doesn't run
' correctly.
' 10/1/4 - In sub SizeCheck, changed the automatic designation of monographs w/ call#
' beginning with M9, where 9 is any number, as oversize, ONLY FOR SPECIAL
' COLLECTIONS. Size of book must be checked for oversize & folio. For all
' other locations, M9 still makes it automatically oversize.
' 10/25/4 - Changed Faculty Publications choice, under OTHER, and as requested by Christina
' to put Archives at top of call number label, instead of Faculty Publications.
' 11/8/4 - Stop NACR from being printed at the bottom of labels, when Other > Special
' Storage is chosen, for location/branch
' 11/19/4 - A message to user, sent when a multivolume set included discs, was in error.
' "|n & 1 disc |u d" becomes "|c & 1 disc |u d"
' 11/22/4 - Installed inputbox at point where user is informed there's no .b# in the
' the clipboard, to put into the record for overlaying. That lets user quit
' program right there if s/he wants to.
' - RELATED: Program only clears the clipboard if program runs normally.
' - Made program read MemoryER.txt right off, so that it would have that information
' in case some problem ends the program, so that it could be written back to
' MemoryER.txt. That write happens after the Done: label
' - Made program provide an option to quit the program, if ff, call#, and 260 dates
' don't match.
' 2/5 - Adapted this program for Connexion
' 2/28/5 - Barcodes now added to Special Collections Materials
' ****************************************************************************
' FUNCTION/SUB PROGRAM DECLARATIONS
' ****************************************************************************
declare Sub Checkcall (callno$, callgood%) 'PERFORMS (MINIMAL) CHECK ON CALL NUMBER
declare Sub WriteBCode(bcodestrt$) 'CHANGE 1ST PART OF BARCODE
declare Sub ChngeInit(init910$, initrec$) 'CHANGE 910 AND RECS/BIN INITIALS
declare Sub GetBCEnd(bcode$, notMain%, reader%, bcodestrt$) 'GETS LAST PART OF BARCODE
declare Sub CheckSeries 'LOOK FOR SERIES TAGS & CHECK PUNCTUATION
declare function CheckDlc (dlc%)
declare function CheckPcc (pcc%)
declare Sub GetFxdFlds 'BREAKS OUT FIXED FIELDS
declare Sub CheckDates(dateFF1$, dateProblem%) 'COMPARES DATES IN RECORD
declare function GetDate (targetLine$) 'EXTRACTS DATES FROM REST OF LINE
declare Sub Chk245 (bad245%) 'CHECK, FIX 245 2ND INDICATOR
'GET DETAILS OF "OTHER" BRANCH/LOCATION
declare Sub Other(st49$, item2$, chksize%, circ$, locate$, endnote$, quit%, paperBrnch$, _
callTag$, doBarcode%, status$, choice2%, labelEnd$)
'PRINT LABEL INFORMATION
declare Sub PrintLabel(endnote$, labelSize$, numVol%, branch%, st49$, row049%, _
labelEnd$, space$, paperBrnch$)
'READS 300 FIELD FOR BOOK SIZE
declare Sub SizeCheck(ovNote$, locate$, endnote$, stnote$, over%, ovmsg$, let2$, Firstlet$, _
paperBrnch$) 'debug
'CHECK FOR DIALOG BOX CHOICES THAT CONFLICT WITH FASTCATTING
Declare Sub CrossCheck(fastCatter%, chooseAgain%, tag%, branch%, retro%, disk%)
Declare Sub CrossJuv(chooseAgain%, tag%, branch%, audn$) 'CHECK JUV CHOICE CONFLICTS
Declare Sub CrossDocs(chooseAgain%, branch%, tag%) 'CHECK DOCS CHOICE CONFLICTS
Declare Function IsNumber(someNumber$) 'RETURNS 1 IF PASSED VALUE IS NUMERIC
Declare Sub SixFifties
Declare Sub CheckPrevious
Declare Sub CheckCallZ(badZ%) 'Check for call number that starts with Z, and with
' the following number > 1199
Declare Sub GetPrice(money$) 'Get price of material, for item record
Declare Sub GetCallNo(callTag$, TagSubstitute%, GotIt%) 'Gets call#
' ****************************************************************************
' ****************************************************************************
option explicit 'MEANS ALL VARIABLES MUST APPEAR IN A 'DIM' STATEMENT - so if I misspell one,
'as I use it in the program, this line means program won't recognize it, so
'an error message will be put on screen. So this insures that I always use
'the same spelling. Numbers and text strings always get put in the correct
'variable - or at least one with the right spelling.
' ****************************************************************************
' GLOBAL VARIABLES
' ****************************************************************************
'FOLLOWING GLOBAL VARIABLES DIDN'T WORK, PASSED AS SUB PROGRAM PARAMETERS, SO...
Global dtst$, dateFF1$, dateFF2$, ctry$, ills$, cont$, conf$, fest$, indx$, fict$, lang$
Global srce$, audn$, gpub$, biog$, desc$, blvl$, typee$, elvl$, form$, mrec$, TEST%
Global fBnumber$, fCallno$
' ****************************************************************************
' START MAIN PROGRAM
' ****************************************************************************
sub main
'This macro asks the user what tag field has the desired call number,
'and which branch the book is to be cataloged for. It also queries for
'whether the book is an analytic. It then edits the record accordingly.
'Because CatMe can be flakey about storing macros, there is a text copy
'of this program in c:\oclcapps\catme\catERSave.txt That can be cut and
'pasted into a new macro, and works fine
dim cs as object
Set CS = CreateObject("Connex.Client")
' ****************************************************************************
' SET UP STRINGS AND VARIABLES
' ****************************************************************************
'TELL PROGRAM THE NAMES OF ALL THE VARIABLES THAT WILL BE USED
dim continue%, found%, do049%, callgood%, callnum$, money$, otherDone%
dim wholeline$, msgtext$, itemplate1$, itemplate2$, bad245%, price$, GotHoldings%
dim itemplate3$, recsbin$, itemline$, nineten$, Firstlet$, do090%, completeBarCode$
dim item1$, end49$, ovnote$, stnote$, locate$, item2$, dlc%, serTag$
dim locatermd%, locatemsg$, circ$ , st49$, endnote$, pcc%, volPref$, doSpellCheck%
dim chksize%, ovmsg$, over%, BCodeEnd$, numVol%, answer%, cmd$, GotIt%
dim bcode$, init910$, initrec$, analytic%, callnum1$, find49$, fileff$
dim callnum2$, i%, text$, size$, bool%, linelen%, twolet$, msgtitle$, vbcrlf$
dim bcodestrt$, filename$, chooseAgain%, fastCatter%, msgtxt$, diskMacro$, foundSize%
dim lineLdr$, line008$, recFile$, recLine$, lccn$, char3$, oldlccn$, newlccn$
dim row049%, branch%, labelsize$, labelEnd$, space$, diskFile$, j%, callTag$
dim notMain%, BranchLst$, CheckLst$, CallTagLst$, someNumber$, reader%, badZ%
dim quit%, paperBrnch$, Let2$, retro%, disk%, tag%, level%, doBarcode%, hasA%
Dim SaveItem1$, diskItem$, volumeNumber$, again%, status$, choice2%, choice2File$
Dim msgDefault$, inputAnswer$, dateProblem%, found050%, TagSubstitute%, found090%
' ****************************************************************************
' GENERAL INITIALIZATIONS
' ****************************************************************************
chooseAgain% = TRUE 'USED TO SIGNAL INCOMPATIBLE USER CHOICES, EG FASTCAT WITH DOCS
linelen% = 0 'HOLDS LENGTH OF A LINE OF TEXT
numVol% = 1 'MOSTLY, THERE'LL BE 1 VOLUME PER BIBLIOGRAPHIC RECORD
analytic% = FALSE 'FLAG SET TO TRUE IF 090 ANALYTIC SELECTED
locatemsg$ = " should precede Call # on T.p. verso(s)" 'LAST PART OF REMINDER MSG
locatermd% = TRUE 'OUTPUT REMINDER MESSAGE IF BRANCH ISN'T MAIN
chksize% = TRUE ' SIGNALS TO CHECK BOOK SIZE IF NOT REF, PAM, OR PZ (JUVENILE)
over% = FALSE 'ASSUME BOOK ISN'T OVERSIZE, TO START
filename$ = "C:\CATLABEL\MEMORYER.TXT" 'HOLDS INFO STORED AFTER PROGRAM STOPS
diskMacro$ = "New!Disc_floppy" '= MACRO THAT DOES SOME DISK/C PROCESSING
foundSize% = FALSE 'IF THIS REMAINS FALSE, MSGBOX TELLS USER SIZE WASN'T FOUND
vbcrlf$ = chr$(13) ' linefeed character
RecFile$ = "c:\CatLabel\records.txt" 'Holds record info, for holdings information
labelEnd$ = " " 'Variable that Holds note to add to bottom of printed label
space$ = " " 'Printed label spacing
diskFile$ = "c:\Catlabel\disk.txt" 'File that holds disk info for label
notMain% = FALSE
doBarcode% = TRUE 'Default to getting barcode from user
choice2File$ = "C:\CatLabel\Choice2.txt"
TEST% = 0 'Debugging, set to 1 by sub or section being tested
doSpellCheck% = FALSE
' ****************************************************************************
' ITEM LINE COMPONENT INITIALIZATIONS
' ****************************************************************************
'These are pieces of the item line. The pieces get changed and added to, depending
'on user choices, and what the program finds in the record.
stnote$ = " ßn" 'HOLDS NOTE INFO EG REF, PAM, CHEM ETC.
endnote$ = "" 'HOLDS BRANCH LOCATION IN NOTE COMPONENT OF ITEM LINE
ovnote$ = "" 'HOLDS OVERSIZE PORTION OF NOTE
price$ = " ßp "
locate$ = "ßl " 'WILL HOLD ITEM LOCATION EG MLS, BES, MRS, ETC.
circ$ = "ßt 0" 'CIRCULATION - CHANGES TO 1 FOR REF & Special
st49$ = "049 NHM" 'HOLDS 049 LINE INFO, CHANGES WITH BRANCH
item1$ = "949 1ßg 1 ßc " 'HOLDS 1ST PART OF ITEM LINE
item2$ = " ßz 090 ßa " 'HOLDS ITEM INFO PRECEDING CALL NUMBER
callnum$ = ""
status$ = " ßs p ßi "
' ****************************************************************************
' SET UP DIALOG BOXES
' ****************************************************************************
' -- MAIN DIALOG BOX --
'This is like a form for the main dialog box, which gets user choices - so it's
'like a model for the actual dialog box. The model, in this program, is named
'userdialog. An actual instance, based on this model, gets defined right after
'the model (aka class) is defined. Object Oriented Programming stuff.
'In this program, the actual instance is named mydialog.
' -- SET CONTENTS OF DROPLISTBOXES --
BranchLst$ = "Main" & Chr$(9) & "Ref" & Chr$(9) & "Math" & Chr$(9) & "Physics" & _
Chr$(9) & "BioSci" & Chr$(9) & "Chem" & Chr$(9) & "Eng" & Chr$(9) & _
"Call" & Chr$(9) & "Pam" & Chr$(9) & "Docs" & Chr$(9) & "Juv" _
& Chr$(9) & "Other"
CheckLst$ = "FastCat" & Chr$(9) & "Monograph" & Chr$(9) & "TopCat"
CallTagLst$ = "050" & Chr$(9) & "090" & Chr$(9) & "090 Analytic" & Chr$(9) & "086"
' *******************************************
' -- MAIN DIALOG BOX CLASS --
Begin Dialog UserDialog 200, 20, 100, 270, " Options"
CheckBox 5, 106, 65, 14, "Disks?", .checkdis
CheckBox 5, 126, 75, 14, "Multi Volumes?", .checkVol
CheckBox 5, 146, 75, 14, "Retrocon?", .checkRet 'REMEMBERED
CheckBox 5, 166, 80, 14, "Change initials?", .checkInit
CheckBox 5, 186, 80, 14, "Change barcode?", .checkBar
CheckBox 5, 206, 80, 14, "Barcode Reader?", .checkReader 'REMEMBERED
Text 5, 3, 64, 7, " Check Level"
droplistbox 5, 11, 64, 45, CheckLst$, .checkLevel
Text 5, 34, 64, 7, " Call # Tag"
droplistbox 5, 42, 60, 65, CallTagLst$, .Tag
Text 4, 65, 69, 10, "Branch/Location"
droplistbox 5, 73, 50, 130, BranchLst$, .branch
OKButton 28, 230, 35, 14
CancelButton 28, 250, 35, 14
Text 70, 254, 30, 10, "2/28/5" 'DATE - FOR VERSION CONTROL
End Dialog
Dim mydialog as UserDialog 'MYDIALOG IS AN instance OF CLASS = USERDIALOG
' ***************************************************************************
' ***************************************************************************
' -- QUERY DIALOG BOX --
' AS ABOVE, FIRST THE CLASS, THEN THE OBJECT IS CREATED
Begin Dialog YesNodial 130, 80, "CONTINUE?"
ButtonGroup.BG1
pushbutton 16, 22, 67, 12, "Yes (ENTER)", .opt1
pushbutton 16, 60, 67, 12, "No", .opt2
End Dialog
Dim YesNo as YesNodial 'YESNO IS A DIALOG BOX, BASED ON THE MODEL YESNODIAL
' ***************************************************************************
' ***************************************************************************
' START PROCESSING
' ***************************************************************************
' ***************************************************************************
'doSpellCheck% = FALSE 'NO SPELL CHECK IN CONNEXION 2/17/5
' GET PREVIOUS CHOICES FROM MEMORY FILES
'This program saves some user choices to a separate file. C:\OCLCAPPS\CATME\MEMORYER.TXT
'So here, the program is reading
'that file to get those choices, so that the user doesn't have to input them everytime, unless
'there is a change. The first time this program runs, there is no file holding user choices,
'so messages that indicate that are put in the 910 and item lines.
'There is now a second dialog box to make choices. If user chooses location "Other" in
'1st dialog box, a second one pops up, to find which other branch is desired. Now, that
'will be remembered in C:\CATLABEL\CHOICE2.TXT
On Error Resume Next
open filename$ for input as #4
if Err=53 then 'ERROR 53 MEANS NO FILE FOUND
mydialog.checkRet = 0
mydialog.Tag = 0
mydialog.checkLevel = 0
mydialog.checkReader = 0
init910$ = "NEED 910 INITIALS"
initrec$ = "NEED RECS/BIN INITIALS"
bcodestrt$ = "????"
msgbox("Program couldn't find file holding previous choices." & vbcrlf _
& "ADVICE: click on CHANGE INITIALS and CHANGE BARCODE in main " & vbcrlf _
& "dialog box, and fill in those fields as requested.")
else
input #4, init910$, initrec$, bcodestrt$, mydialog.checkLevel, _
mydialog.Tag, mydialog.checkRet, mydialog.checkReader
if init910$ = "" OR initrec$ = "" then
msgbox "Problem reading 910 and/or recs-bin initials from file." & vbcrlf _
& "ADVICE: click on CHANGE INITIALS in main " & vbcrlf _
& "dialog box, and fill in those fields as requested."
End If
If mydialog.checkReader = 0 AND bcodestrt$ = "" then
msgbox "Program found no part of BARCODE in file." & vbcrlf _
& "That will be a problem, unless you are using" & vbcrlf _
& "a barcode reader. If not, you may want to check on" & vbcrlf _
& "Change Barcode, in main dialog box, and enter 1st part of barcode."
End If
close #4 'DONE WITH THAT FILE, SO CLOSE IT
End If
'GET LAST USER CHOICE OF "OTHER" LOCATION/BRANCH
On Error Resume Next
open choice2File$ for input as #4
if Err=53 then 'ERROR 53 MEANS NO FILE FOUND
choice2% = 0
else
input #4, choice2%
close #4 'DONE WITH THAT FILE, SO CLOSE IT
End If
' ***************************************************************************
' ***************************************************************************
' SET DEFAULT TAG CHOICE
'NOTE: This program looks for an 050 tag. If there is one, it will check for
' the usual (minimal) indications that there is actually a call number there. If there
' is, then mydialog.Tag, in the Options dialog box, will default to show 050.
' If none of this is true, then the
' same thing will happen with the 090 tag. If that doesn't work, only then will the
' choice made the previous time the program was run, found in MEMORYER.TXT, appear
' as the tag choice in the Options dialog box
fCallno$ = ""
callTag$ = "050"
Call GetCallNo(callTag$, TagSubstitute%, GotIt%)
if GotIt% = True then
if TagSubstitute% <> 50 then mydialog.Tag = TagSubstitute%
else
callTag$ = "090"
Call GetCallNo(callTag$, TagSubstitute%, GotIt%)
if GotIt% = True then if TagSubstitute% <> 50 then mydialog.Tag = TagSubstitute%
End If
' ***************************************************************************
' ***************************************************************************
' Check clipboard for .b# (eg .b12345432) change on 8/24/4
' change on 11/22/4
' if fBnumber$ doesn't start with a b, OR it's more than 10 characters long.
' OR the 3rd & 7 characters aren't numbers, then it's something else the user
' cut and pasted, and it should be set to NULL, before it's pasted into the
' recs/bin line. Inform user, provide opportunity to quit program.
msgtext$ = "If you want this program to enter the overlay " _
& "Bib. number into the record, then quit here and copy that number " _
& "into the clipboard. Then run this program again." & chr$(13) _
& " Q - - - - - Quit program" & chr$(13) _
& " C - - - - - Continue program"
msgtitle$ = "Quit or Continue?"
msgDefault$ = "C"
inputAnswer$ = "ZZZ"
fBnumber$ = lcase(Clipboard.GetText()) ' change on 5/21/4
if mid$(fBnumber$, 1, 1) <> "b" OR _
len(fBnumber$) <> 9 OR _
mid$(fBnumber$, 3, 1) > "9" OR _
mid$(fBnumber$, 3, 1) < "0" OR _
mid$(fBnumber$, 7, 1) > "9" OR _
mid$(fBnumber$, 7, 1) < "0" then
fBnumber$ = ""
Do while inputAnswer$ <> "Q" AND inputAnswer$ <> "C" AND inputAnswer$ <> ""
inputAnswer$ = UCase(InputBox$ (msgtext$, msgTitle$, MsgDefault$))
Loop
If inputAnswer$ = "Q" Or inputAnswer$ = "" Then Goto Done
End If
' ===========================================================================
' ===========================================================================
' PRINT RECORD TO FILE, THIS IS DONE TO USE VB TO LOOK FOR HOLDINGS
' INDICATIONS.
on error resume next 'IF THERE IS NO FILE TO DELETE, THEN GO ON TO NEXT STATEMENT
kill RecFile$ 'DELETE FILE HOLDING OLD RECORD INFORMATION
CS.GetActiveRecord 'VERIFIES THAT WINDOW CONTAINS AN ACTIVE RECORD
bool = CS.Print 'PRINT RECORD INFO TO C:\CatLabel\records.txt
'This requires a CatMe option/setting, set in
' Tools - Options - Record Print
'that printing goes to a file, and NOT a printer.
' Change on 9/9/4
' At this point, C:\CatLabel\records.txt should exist again, if the option to
' print to a file instead of to a printer (described above) is checked. If not
' then C:\CatLabel\records.txt wasn't created anew, so it doesn't exist. Tell the
' user & end the program.
if Dir$(RecFile$) = "" then
msgbox "PROBLEM: Connexion may not be set (Tools > Options > Printing) to print " _
& " records to C:\CatLabel\records.txt. Program ending."
Goto Done
End If
' ***************************************************************************
' ***************************************************************************
' -- GET FIXED FIELD INFO --
'For unknown reasons the sendKeys command doesn't work when this program is run from
'shortcut keys ( eg ctrl+shift+F4), but runs fine when run from a "user tool" in the tool bar.
'It also runs if I go find the macro/program from the tools menu and run it from there.
' Very strange.
Call GetFxdFlds 'IE, FIND OUT WHAT'S IN THE FIXED FIELDS
' ***************************************************************************
' ***************************************************************************
' END PROGRAM IF JUV BOOK WITH 'd'
if audn$ = "d" then
msgbox "Audn: = d - indicates JUV book -- UNUSED at UNH. Please give book to Kathryn"
goto Done
end if
' ***************************************************************************
' ***************************************************************************
'REMOVE PREVIOUS 949-ITEM, 910-INITIALS, 949-RECSBIN LINES, IF ANY
Call CheckPrevious
' ***************************************************************************
' ***************************************************************************
' ***************************************************************************
' ***************************************************************************
' PUT OUT MAIN DIALOG BOX AND GET CURRENT CHOICES
do while chooseAgain% = TRUE 'LOOP UNTIL NO CONFLICTS IN CHOICES
On Error Resume Next
Dialog mydialog 'THIS PUTS THE MAIN DIALOG BOX ON THE SCREEN
If Err=102 then ' ERROR 102 MEANS CANCEL BUTTON WAS SELECTED
goto Done
End If
level% = mydialog.checklevel 'DON'T KNOW HOW TO PASS THESE OBJECT
branch% = mydialog.branch ' PROPERTIES TO A SUB PROGRAM, SO
retro% = mydialog.checkRet ' PUT THEM IN VARIABLES THAT I CAN
disk% = mydialog.checkdis ' PASS.
tag% = mydialog.Tag
reader% = mydialog.checkReader
chooseAgain% = FALSE
if mydialog.checkLevel = 0 then fastCatter% = TRUE 'FASTCAT
' CHECK FOR CHOICE CONFLICTS
If mydialog.checkRet = 1 AND mydialog.Tag = 2 then 'BOTH ANALYTIC AND RETRO CHOSEN
msgbox "Monographs must be handled as either analytic OR retrocon." & _
chr$(13) & _
"If both are true, then it should be treated as retrocon."
tag% = 1
chooseAgain% = True
end if
Call CrossCheck(level%, chooseAgain%, tag%, branch%, retro%, disk%)
Call CrossDocs(chooseAgain%, branch%, tag%)
Call CrossJuv(chooseAgain%, tag%, branch%, audn$)
mydialog.branch = branch%
mydialog.checkRet = retro%
mydialog.checkdis = disk%
mydialog.Tag = tag%
loop 'ON while chooseAgain% = TRUE
' ***************************************************************************
' ***************************************************************************
' CHANGE BARCODE IF REQUESTED
'This subprogram call allows user to change the beginning of the barcode. The actual
'code appears below this main program section, so this invokes it, causing it to run.
'NOTE: If the user has the Barcode Reader checkbox checked, then the program will later
' ask for thw whole barcode to be entered. IF not, it is assumed that the user will
' be entering the barcode without a barcode reader. To minimize typing, the program
' attempts to keep track of all but the last 4 digits of the barcode. For each
' sheet of barcodes, only the last 4 digits of each barcode vary. The idea is, only
' those last 4 digits need to be entered. As the sheet changes, the user can enter
' the part of the barcode that changes with a new sheet, which is digits 7-10. So the
' user doesn't need to enter those digits for EVERY book.
if mydialog.checkBar = 1 then
call WriteBCode(bcodestrt$) 'CALL TO FUNCTION
end if
' ***************************************************************************
' ***************************************************************************
' CHANGE INITIALS IF REQUESTED
if mydialog.checkInit = 1 then
call ChngeInit(init910$, initrec$)
end if
' ***************************************************************************
' ***************************************************************************
'HOLDINGS - The way to check holdings is to print the record to a file. To print to a file,
' a checkbox in Tools-Options-Record Print, entitled "Output to text file:" must be checked,
' and a filename entered in the corresponding space. So this program will kill the previous
' file, which would be for a previous record, and then cause the record to print. Then the
' file that the record is printed to is checked for "Held by NHM". if that's NOT
' present, then the record is chcked for the obverse, "No holdings in NHM". If neither one
'of those phrases is found in the record, then the program can't determine the holdings status.
'NOTE: Both CatME and Connexion have built-in functions that check holdings, but only if the
' user is online to OCLC. This method checks holdings whether or not the user is online.
GotHoldings% = FALSE
open recFile$ for input as #3
do while Not EOF(3)
Line Input #3, recLIne$
recLIne$ = lcase(recLIne$)
if instr(recLine$, "held by nhm") > 0 then
if mydialog.checkLevel < 2 then 'IE MONOGRAPH OR FASTCAT CHECKS
msgbox("HELD BY NHM - Program ending")
close #3
goto Done
else
msgbox "This record is HELD BY NHM" 'TOPCATTERS GET TO DECIDE ABOUT QUITTING
Dialog YesNo
if YesNo.BG1 = 1 then 'USER CHOOSES TO ABORT PROGRAM
close #3
goto Done
end if
end if
GotHoldings% = TRUE
Exit Do
End If
if instr(recLine$, "no holdings in nhm") > 0 then
GotHoldings% = TRUE
Exit Do
End if
loop
close #3
if GotHoldings% = FALSE then
msgbox("Program can't determine if book/record is already held." & vbcrlf _
& "Please check holdings visually.")
end if
' ***************************************************************************
' ***************************************************************************
' IF FASTCAT, CHECK FOR CONTINUATION
If fastCatter% = True then 'FASTCATTER
If lcase(dtst$) = "m" Then
msgbox "Fixed Field, DtSt: = m" & chr$(13) & _
"This book is most likely a continuation, and should be bumped."
Goto Done
End If
If dateFF2$ = "9999" Then
msgbox "Fixed Field, second date in Dates: = 9999" & chr$(13) & _
"This book is most likely a continuation, and should be bumped."
Goto Done
End If
End If
' ***************************************************************************
' ***************************************************************************
' CHECK 245 2ND INDICATOR (WARNING OR END PROGRAM IF NO 245 TAG FOUND)
call Chk245 (bad245%)
if bad245% = TRUE then ' PROGRAM COULDN'T FIND 245 TAG
if mydialog.checkLevel < 2 then
msgbox ("Program couldn't find 245 line. Program ending")
goto Done
else
msgbox ("Program couldn't find 245 line.")
Dialog YesNo
if YesNo.BG1 = 1 then goto Done 'TOPCAATTER CHOOSES TO END PROGRAM
end if 'ON if mydialog.checks < 2
end if 'ON if bad245% = TRUE
' ***************************************************************************
' ***************************************************************************
' ENCODING LEVEL CHECK - Fixed field ELvl: must be ether blank or 4,
' for fastcatters
if fastCatter% = TRUE then
if elvl$ <> " " AND elvl$ <> "4" then
msgbox ("Ecoding Level (Elvl:) is neither blank nor 4" _
& vbcrlf _
& vbcrlf _
& " Program ending")
goto Done
end if
end if 'ON if fastCatter% = TRUE
' ***************************************************************************
' ***************************************************************************
' CHECK BLvl: WARN USER OR END PROGRAM, DEPENDING ON WHO USER IS
if blvl$ <> "m" then
if mydialog.checklevel < 2 then
msgbox "BLvl does NOT = m ??? This is NOT a monograph? " _
& chr$(13) _
& "Please see Kathryn or Christina."
goto Done
else
if blvl$ = "s" then
msgbox ("BLvl does NOT = m ??? This is NOT a monograph? ")
Dialog YesNo
if YesNo.BG1 = 1 then goto Done 'TOPCATTER CHOOSES TO ABORT PROGRAM
else
msgbox ("Program can find neither s nor m in Blvl field. " _
& vbcrlf _
& "Please check visually")
Dialog YesNo
if YesNo.BG1 = 1 then goto Done 'TOPCATTER CHOOSES TO ABORT PROGRAM
end if
end if
end if
' ***************************************************************************
' ***************************************************************************
' ACT ON TAG SELECTION
select case mydialog.tag 'MYDIALOG.TAG HOLDS CALL # TAG SELECTION
case 0
callTag$ = "050" 'IE LOOK FOR CALL # IN 050 TAG
case 1
callTag$ = "090" 'IE LOOK FOR CALL # IN 090 TAG
do090% = TRUE
case 2
analytic% = TRUE 'DON'T CARE WHERE CALL # IS, FOR ANALYTICS
case 3
callTag$ = "086" 'IE LOOK FOR CALL # IN 086 TAG
end select
' ***************************************************************************
' ***************************************************************************
'CHANGE VARIOUS FIELDS, DEPENDING ON WHICH BRANCH IS CHOSEN
select case mydialog.branch
case 0 'MAIN BRANCH
st49$ = st49$ & "M" 'WILL BE USED TO ADD M TO NHM IN 049 FIELD
locate$ = locate$ + "mls" 'ITEM RECORD LOCATION
locatermd% = FALSE 'NO T.P. REMINDER MSG
case 1 'REFERENCE
st49$ = st49$ & "R"
endnote = " Ref"
locate$ = locate$ + "mrs"
circ$ = "ßt 1" 'REF BOOKS DON'T CIRCULATE
chksize% = FALSE 'DON'T CHECK BOOK SIZE - NO OVERSIZE IN REF
case 2
st49$ = st49$ & "." 'MATH
endnote = " Math"
locate$ = locate$ + "bes"
notMain% = TRUE 'DO PUT OUT VERSO REMINDERS, ETC
case 3 '
st49$ = st49$ & "P"
endnote = " Physics" 'PHYSICS
locate$ = locate$ + "bps"
notMain% = TRUE
case 4 'BIOLOGICAL SCIENCES
st49$ = st49$ & "B"
endnote = " BioSci"
locate$ = locate$ + "bbs"
notMain% = TRUE
case 5 'CHEMISTRY
st49$ = st49$ & "C"
endnote = " Chem"
locate$ = locate$ + "bcs"
notMain% = TRUE
case 6 'ENGINEERING
st49$ = st49$ & "E"
endnote = " Eng"
locate$ = locate$ + "bes"
notMain% = TRUE
case 7 'CALL
st49$ = st49$ & "6"
endnote = " Call"
locate$ = locate$ + "mlcs"
case 8 'PAM (DOES THIS STILL EXIST??)
st49$ = st49$ & "Z"
endnote = " Pam"
locate$ = locate$ + "mlhs"
chksize% = FALSE 'NO OVERSIZE IN PAM
case 9 'GOV DOCS
st49$ = st49$ & "D"
locate$ = locate$ + "mdus"
item2$ = " ßz 086 ßa " 'USE 086 INSTEAD OF 090 IN ITEM LINE
chksize% = FALSE ' ??????? NO OVERSIZE IN DOCS 'debug
case 10 'JUVENILE
st49$ = st49$ & "M"
endnote$ = " Juv"
locate$ = locate$ & "mlsk"
chksize% = FALSE 'NO OVERSIZE IN JUV 'NO OVERSIZE IN JUV
case 11 '
call Other(st49$, item2$, chksize%, circ$, locate$, endnote$, quit%, _
paperBrnch$, callTag$, doBarcode%, status$, choice2%, labelEnd$)
If quit% = True then
msgbox "User ending program."
goto Done
End If
end select
' ***************************************************************************
' ***************************************************************************
locatemsg$ = endnote$ + locatemsg$ 'THIS MESSAGE IS COMPLETE NOW. IT REMINDS USER
'WHICH BRANCH, IF ANY, SHOULD PRECEDE CALL # ON VERSO
' ALLOW FOR DOCS, WHICH, HAVING NO LABEL, HAS NO endnote$
' (OR ANY NOTE COMP0NENT.)
if mydialog.branch = 9 then locatemsg$ = "Docs" + locatemsg$
stnote$ = stnote$ + endnote$
' ***************************************************************************
' ***************************************************************************
' 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
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub Chk245 (bad245%)
'IF FIXED FIELD LANGUAGE IS ENGLISH, CHECK TITLE ARTICLES, COMPARE TO 245
'2ND INDICATOR
dim cs as object
Set CS = CreateObject("Connex.Client")
dim current2Ind$, wholeline$, bool%, titlestart$, ind2$
'
' INITIALIZE
bad245% = FALSE
ind2$ = "0"
' fIND 245 TAG
bool% = CS.GetField ("245", 1, wholeline$)
if bool% = TRUE then
current2Ind$ = mid$(wholeline$, 5, 1) 'GET CURRENT 2ND INDICATOR
else
bad245% = TRUE
exit sub
end if
'IF FIXED FIELD LANGUAGE IS ENGLISH (Lang: eng) THEN CHECK 245 2ND INDICATOR, MAKE SURE
' TITLE ARTICLES MATCH. ELSE, PUT OUT WARNING.
if lang$ <> "eng" then
msgbox "Fixed Field Lang: isn't 'eng' (??): please check 245 2nd indicator"
goto LeaveSub
end if
' CHECK TITLE START FOR "the "
titlestart$ = Lcase(mid$(wholeline$, 6, 4))
if titlestart$ = "the " then ind2$ = "4"
' CHECK TITLE START FOR "an "
titlestart$ = Lcase(mid$(wholeline$, 6, 3))
if titlestart$ = "an " then ind2$ = "3"
' CHECK TITLE START for "a "
titlestart$ = Lcase(mid$(wholeline$, 6, 2))
if titlestart$ = "a " then ind2$ = "2"
' COMPARE AND WARN, IF NECESSARY
if current2Ind$ <> ind2$ then
msgbox ("245 2nd indicator doesn't match title article (??)")
end if
LeaveSub:
end sub ' Sub Chk245
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub PrintLabel(endnote$, labelSize$, numVol%, branch%, st49$, row049%, _
labelEnd$, space$, paperBrnch$)
' CREATE A PAPER LABEL PRINTOUT FOR COMPARISON WITH ACTUAL
' LABEL - USED IN PROCESSING TO MAKE SURE BOOKS GET THE CORRECT
' LABEL. SO,
' 1. SAVE CURRENT 049 FIELD
' 2. (MAYBE) CHANGE 049 FIELD
' IF 049 CHANGED
' 3. DELETE OLD 049,
' 4. ADD NEW 049,
' 5. PRINT LABEL
' 6. DELETE 049 FIELD
' 7. ADD OLD 049 BACK TO RECORD
' ELSE
' 3. PRINT LABEL
dim cs as object
Set CS = CreateObject("Connex.Client")
dim new049Field$, tag$, bool%, change049%
dim wholeline$, batchStarted%, old049$
change049% = False 'I DON'T NEED TO RE-WRITE THE 049 FIELD UNLESS IT CHANGES
bool% = CS.GetField("049", 1, wholeline$)
old049$ = wholeline$ 'SAVE 049 AS IT WAS AT START
new049Field$ = mid$(wholeline$, 6, len(wholeline$)) 'EXTRACT FIELD PART FROM WHOLE 049 LINE
' *************************************************************************
' *************************************************************************
' CHANGE 049 FOR FOLIO/OVERSIZE
if labelSize$ <> "" then 'LABELSIZE$ = "OVERSIZE" OR "FOLIO"
labelSize$ = trim(labelSize$)
new049Field$ = "[" & labelSize$ & "]" & new049Field$
change049% = True
end if
' *************************************************************************
' *************************************************************************
' CHANGE 049 FOR BRANCH
if branch% > 0 AND branch% <> 9 then 'IF NOT MAIN OR DOCS, BRANCH IS PART OF LABEL
if branch% <> 11 then '11 = MULTI-MEDIA; ENDNOTE$ TOO LONG IN PAPER LABEL
endnote$ = trim(endnote$)
new049Field$ = "[" & endnote$ & "]" & new049Field$
change049% = True
else
new049Field$ = paperBrnch$ & new049Field$ '????
change049% = True
end if
end if
' *************************************************************************
' *************************************************************************
' CHANGE 049 FOR MULTIPLE VOLUMES
if numVol% > 1 then
new049Field$ = new049Field$ & "[VOLUMES!]"
change049% = True
End If
' *************************************************************************
' *************************************************************************
' PUT CHANGED 049 LINE IN PLACE (IF IT'S CHANGED)
If change049% = True then
new049Field$ = "049 " & new049Field$
bool% = CS.DeleteField ("049", 1) 'DELETE OLD 049 FIELD
bool% = CS.AddField (1, new049Field$) 'WRITE NEW 049 FIELD
batchStarted% = CS.StartLabelBatch ' CS.PrintLabel requires this batch stuff
If batchStarted% = True TheN
CS.PrintLabel "NHMM", 1, "", "", "", "" ' YES, all the empty strings are necessary
CS.EndLabelBatch
End If ' CS.PrintLabel requires this batch stuff
bool% = CS.DeleteField ("049", 1) 'DELETE NEW 049 FIELD
bool% = CS.AddField (1, old049$) 'WRITE OLD 049 FIELD BACK IN
End If
End sub 'Sub PrintLabel
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub SizeCheck(ovNote$, locate$, endnote$, stnote$, over%, ovmsg$, let2$, Firstlet$, _
paperBrnch$) 'debug
' CHECK SIZE OF BOOK, AS FOUND IN 300 FIELD. ADJUST LABEL
' AND ITEM LOCATION, IF OVERSIZE OR FOLIO.
' NOTE: REFERENCE, PAM AND MULTI-MEDIA AREN'T
' CHECKED FOR SIZE - ALSO CALL#s STARTING WITH PZ
dim wholeline$, linelen%, i%, text$, foundsize%
dim size$, position%, specialM$, bool%
dim cs as object
Set CS = CreateObject("Connex.Client")
' *************************************************************************
' *************************************************************************
' INITIALIZE
linelen% = 0
text$ = ""
size$ = ""
specialM$ = ""
foundsize% = FALSE
' *************************************************************************
' *************************************************************************
' LOOK FOR 300 TAG
bool% = CS.GetField("300", 1, wholeline$)
' *************************************************************************
' *************************************************************************
' LOOK FOR BOOK SIZE AT END OF 300 FIELD
'(Find " cm ", then make sure there are 2, and only 2, numbers preceding that)
if bool% = TRUE then
position% = instr(wholeline$, " cm")
if position% > 0 then 'FOUND " cm."
position% = position% - 2 'SHOULD BE START OF BOOK SIZE
if IsNumber(mid$(wholeline$, position%, 2)) AND _
IsNumber(mid$(wholeline$, position%-2, 2))=0 then
size$ = mid$(wholeline$, position%, 2)
foundsize% = TRUE
end if
end if
else
msgbox("Program couldn't 300 tag. Please check book size visually.")
exit sub
end if
' *************************************************************************
' *************************************************************************
' FOUNDSIZE% SHOULD BE TRUE, IF A VALID BOOK SIZE WAS FOUND=
if foundsize% = FALSE then
msgbox("Program couldn't find book size. Please check visually.")
exit sub
end if
' *************************************************************************
' *************************************************************************
' It has been the case that if 1st letter of call# is M, and next character
' = 1, that the monograph was to be automatically categorized as oversized,
' whether or not it actually was over 28 cm. Now, if it's Special collections,
' it's categorized as oversized only if it actual size warrants it. All others
' are automatically oversize. New variable, specialM$ gets set from null to
' "OK" if conditios are met, and that setting becomes a condition for the boolean
' variable, over% being set. Change on 10/1/4
If Firstlet$ = "M" AND IsNumber(Let2$) = 1 then
If paperBrnch$ <> "[Special]" then specialM$ = "OK"
End IF
' CHECK SIZE$ FOR NORMAL, OVERSIZE, M9, OR FOLIO
'if val(size$) > 28 OR (Firstlet$ = "M" AND _
' IsNumber(Let2$) = 1) then
' CHECK SIZE$ FOR NORMAL, OVERSIZE, M9, OR FOLIO
If val(size$) > 28 OR specialM$ = "OK" then 'IT'S OVERSIZED
over% = TRUE 'SET FLAG TO INDICATE OVERSIZE MESSAGE SHOULD APPEAR
if val(size$) > 37 then
ovnote$ = " folio" ' "folio" NOW INCLUDED IN OVERSIZE MESSAGE
locate$ = locate$ & "f" 'ADD f TO ITEM LOCATION
ovmsg$ = "folio should precede T.p. call #" 'REMINDER NOTE
else
ovnote$ = " oversize"
locate$ = locate$ & "o"
ovmsg$ = "oversize should precede T.p. call #"
end if ' (val(size$) > 37)
else
if endnote$ = "" then
stnote$ = ""
end if
end if ' [val(size$) > 28]
end sub ' Sub SizeCheck(ovNote$...
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub Other(st49$, item2$, chksize%, circ$, locate$, endnote$, quit%, paperBrnch$, _
callTag$, doBarcode%, status$, choice2%, labelEnd$)
' This sub sets up a class for a dialog box - ClsOther
' It then creates an object of that class - objOther
' The user picks 1 of 14 multi-media and special collections branches.
' Based on that choice,
' circ$ (Itype - circulating vs. non, among other uses)
' st49$ (Add last letter of 049, eg 'M' in NHMM)
' item2$ (Sets |z field, in item record = call # source)
' locate$ (item location, eg mls1)
' endnote$ (eg Eng, in item note field, and label printout)
' callTag$ (Tells program where to look for call # - tag )
' doBarcode% (Process barcode, or not - eg special collections)
' status$ (Set to 0 for archives only; else it stays p)
' may be changed.
'NOTE: For Special Collections locations, the paper label will have e.g. Special Storage
' at the top of the label, but there will be no note |n in the 949 item created to
' cause "Special Storage" to appear in labels that get affixed to the book. That is
' by design - NOT AN ERROR. A label of sorts is hand typed, from the paper label, for
' reasons that I really don't need to care about.
' 2/28/5 Barcodes now added to Special Collections Materials
dim OtherLst$, ltr49$, bool%
dim CS as object
Set CS = CreateObject("Connex.Client")
quit% = FALSE
circ$ = "ßt 1" 'SET A DEFAULT; CHANGE IF NEEDED
ltr49$ = "M" 'LAST CHARACTER OF TAG 049; DEFAULT AS 'M'
' *************************************************************************
' *************************************************************************
' SET UP DIALOG BOX TO GET OTHER BRANCH/LOCATION
OtherLst$ = "Media Video" & Chr$(9) & "Media Compdisc" & Chr$(9) & _
"Media CD-ROM" & Chr$(9) & "Media Audio-book" & Chr$(9) & _
"Media DVD" & Chr$(9) & "Media Cassette" & Chr$(9) & _
"Media" & Chr$(9) & "Media Record" & Chr$(9) & _
"Media Laser"& Chr$(9) & _
"Special" & Chr$(9) & _
"Special Stark" & Chr$(9) & "NHamp" & Chr$(9) & _
"Faculty Publications" & Chr$(9) & _
"Archives" & Chr$(9) & "Miniature Score" & _
Chr$(9) & "Special Storage"
Begin Dialog ClsOther 125, 120, 160, 165, _
" Make choice, click OK."
Text 5, 1, 64, 7, " Other Location"
droplistbox 5, 8, 90, 162, OtherLst$, .type
OKButton 115, 9, 35, 14
CancelButton 115, 30, 35, 14
End Dialog
Dim objOther as ClsOther
' *************************************************************************
' *************************************************************************
' PUT DIALOG BOX ON SCREEN, GET USER CHOICE
objOther.Type = choice2% 'MAKE PREVIOUS CHOICE THE DEFAULT
On Error Resume Next
Dialog objOther 'THIS PUTS THE MEDIA TYPE DIALOG BOX ON SCREEN
If Err=102 then ' ERROR 102 MEANS CANCEL BUTTON WAS SELECTED
quit% = TRUE 'SEND THIS BACK TO MAIN SUB TO END PROGRAM
exit sub
End If
' *************************************************************************
' *************************************************************************
' SET VALUES, BASED ON USER CHOICE
select case objOther.Type ' HOLDS OTHER BRANCH/LOCATION
case 0 'Media Video
chksize% = FALSE
circ$ = "ßt 7"
locate$ = locate$ & "mllv"
endnote$ = " Media Video"
paperBrnch$ = "[Media][Video]"
case 1 'Media Compdisc
chksize% = FALSE
circ$ = "ßt 8"
locate$ = locate$ & "mllcd"
endnote$ = " Media Compdisc"
paperBrnch$ = "[Media][Compdisc]"
case 2 'Media CD-ROM
chksize% = FALSE
circ$ = "ßt 8"
locate$ = locate$ & "mllcr"
endnote$ = " Media CD-ROM"
paperBrnch$ = "[Media][CD-ROM]"
case 3 'Media Audio-book
chksize% = FALSE
circ$ = "ßt 25"
locate$ = locate$ & "mllab"
endnote$ = " Media Audio-book"
paperBrnch$ = "[Media][Audio-][book]"
case 4 'Media DVD
chksize% = FALSE
circ$ = "ßt 7"
locate$ = locate$ & "mllvd"
endnote$ = " Media DVD"
paperBrnch$ = "[Media][DVD]"
case 5 'Media Cassette
chksize% = FALSE
circ$ = "ßt 6"
locate$ = locate$ & "mllca"
endnote$ = " Media Cassette"
paperBrnch$ = "[Media][Cassette]"
case 6 'Media
chksize% = FALSE
circ$ = "ßt 0"
locate$ = locate$ & "mllme"
endnote$ = " Media"
paperBrnch$ = "[Media]"
case 7 'Media Record
chksize% = FALSE
circ$ = "ßt 6"
locate$ = locate$ & "mllr"
endnote$ = " Media Record"
paperBrnch$ = "[Media][Record]"
case 8 'Media Laser
chksize% = FALSE
circ$ = "ßt 7"
locate$ = locate$ & "mllla"
endnote$ = " Media Laser"
paperBrnch$ = "[Media][Laser]"
case 9 'Special
' doBarcode% = FALSE 'NO BARCODE ON ANY SPECIAL COLLECTIONS MATERIALS - REVERSED ON 2/28/5
ltr49$ = "*"
locate$ = locate$ & "mss"
paperBrnch$ = "[Special]"
case 10 'Special Stark
' doBarcode% = FALSE
chksize% = FALSE 'NO OVERSIZE IN SPECIAL STARK
ltr49$ = "*"
locate$ = locate$ & "msxs"
paperBrnch$ = "[Special][Stark]"
item2$ = " ßz 099 ßa "
callTag$ = "099" 'USE LOCALLY ASSIGNED CALL #
msgbox "Program will look for call # in 099 tag."
case 11 'NHamp
'doBarcode% = FALSE
ltr49$ = "N"
locate$ = locate$ & "mns"
paperBrnch$ = "[NHamp]"
case 12 'Faculty Publications
'doBarcode% = FALSE
circ$ = "ßt 1"
ltr49$ = "U"
locate$ = locate$ & "mau"
' paperBrnch$ = "[Faculty][Publications]" 'NO LABEL PRINTOUT FOR ARCHIVES - CHANGED 10/25/4
paperBrnch$ = "[Archives]"
bool% = cs.RunMacro ("New!Faculty_Notes") 'ADD 590 NOTE
case 13 'Archives
' doBarcode% = FALSE
circ$ = "ßt 1"
ltr49$ = "U"
locate$ = locate$ & "mau"
paperBrnch$ = "[Archives]" 'NO LABEL PRINTOUT FOR ARCHIVES
' callTag$ = "090" 'Changed 8/6/4 per Christina
case 14 'MINIATURE SCORES
chksize% = FALSE
circ$ = "ßt 0"
item2$ = " ßz 099 ßa "
ltr49$ = "M"
locate$ = locate$ & "mllms"
paperBrnch$ = "[]" '
callTag$ = "099" 'USE LOCALLY ASSIGNED DEWEY CALL #
msgbox "Program will look for call # in 099 tag."
case 15 'SPECIAL STORAGE
'doBarcode% = FALSE
chksize% = TRUE
circ$ = "ßt 1"
ltr49$ = "*"
status$ = " ßs v ßi "
locate$ = locate$ & "msb"
'endnote$ = " Special Storage"
paperBrnch$ = "[Special][Storage]"
callTag$ = "090"
'labelEnd$ = "NACR" 'CHANGED 11/8/4
end select
st49$ = st49$ & ltr49$ 'ADD LAST LETTER TO 049 TAG
choice2% = objOther.Type 'LATER,THIS WILL GET SAVED TO FILE = C:\CATLABEL\CHOICE2.TXT
end sub ' Sub Other
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub CrossCheck(level%, chooseAgain%, tag%, branch%, retro%, disk%)
' THIS SUB LOOKS FOR INCOMPATIBLE FASTCAT CHOICES. A FASTCATTER
' SHOULDN'T CHOOSE EG THE DOCS TAG, OR OTHER LOCATION. A
' MSGBOX WARNING IS GIVEN, AND CHOOSEAGAIN% IS SET TO CAUSE THE
' MAIN DIALOG BOX TO BE PRESENTED AGAIN.
if level% = 0 then
' DISALLOW 090 AND 086 TAG CHOICES (ALLOW 090 ANALYTIC)
if tag% = 1 OR tag% = 3 OR tag% = 4 then
msgbox "FastCatting precludes 090, 086, and 099 Call # tags. " _
& "Please choose again."
chooseAgain% = TRUE
tag% = 0
end if
' DISALLOW DOCS BRANCH CHOICE
if branch% = 9 then
msgbox "FastCatting precludes destination = Docs. Please choose again."
chooseAgain% = TRUE
branch% = 0
end if
' DISALLOW OTHER BRANCH CHOICE
if branch% = 11 then
msgbox "FastCatting precludes location = Other." _
& " Please choose again."
chooseAgain% = TRUE
branch% = 0
end if
' DISALLOW RETROCON CHOICE
if retro% = 1 then
msgbox "FastCatting precludes retrocon. Please choose again."
chooseAgain% = TRUE
retro% = 0
end if
' DISALLOW DISK CHOICE
if disk% = 1 then
msgbox "FastCatting precludes disc/floppy cataloging. Please choose again."
chooseAgain% = TRUE
disk% = 0
end if
End If 'ON if level% = 0
End Sub 'Sub CrossCheck
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub CrossDocs(chooseAgain%, branch%, tag%)
' THIS SUB LOOKS FOR CHOICE CONFLICTS AROUND THE DOCS TAG.
' WARNINGS ARE ISSUED, AND CHOOSEAGAIN% IS SET TO SHOW
' THE MAIN DIALOG BOX AGAIN.
' DISALLOW DOCS & ANALYTIC CHOICE
if branch% = 9 and tag% = 2 then
msgbox "Docs has no analytics. Please choose again."
chooseAgain% = TRUE
tag% = 3
end if
' REQUIRE DOCS FOR 086 TAG
if tag% = 3 and branch% <> 9 then
msgbox "Tag 086 requires DOCS branch"
chooseAgain% = TRUE
tag% = 3
branch% = 9
end if
End Sub
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub CrossJuv(chooseAgain%, tag%, branch%, audn$)
' THIS SUB LOOKS FOR BAD CHOICES AROUND JUVENILE
' BOOKS. WARNINGS ARE ISSUED, AND CHOOSEAGAIN%
' IS SET TO RE-SHOW THE MAIN DIALOG BOX
dim vbcrlf$
vbcrlf$ = chr$(13)
if branch% = 10 then
' DISALLOW 090 ANALYTICS AND 086 GOV DOCS CHOICES
if tag% = 2 OR tag% = 3 then
chooseAgain% = TRUE
tag% = 0 'SET TO 050 TAG
msgbox "Analytics and Gov Docs books can't be juvenile." _
& vbcrlf$ _
& "Please choose again, or click Cancel in main" _
& vbcrlf$ _
& "dialog box to leave program."
End If
' MAKE SURE Audn: HAS JUVENILE INDICATOR
if Audn$ <> "a" AND _
Audn$ <> "b" AND _
Audn$ <> "c" AND _
Audn$ <> "j" then
chooseAgain% = TRUE
branch% = 0 'SET TO MAIN BRANCH
msgbox "Fixed Field, Audn: should have juvenile indication" _
& vbcrlf$ _
& " a, b, c, or j" _
& vbcrlf$ _
& "or juvenile branch should not be selected."
End If 'ON if Audn$ <> "a"...
If Audn$ = "a" Or _
Audn$ = "b" Or _
Audn$ = "c" Or _
Audn$ = "j" then
call SixFifties 'CHECK FOR 650 1, & 650 0
end if
End If 'ON if branch% = 10
' *************************************************************************
' *************************************************************************
' IF AUDN$ IS JUVENILE, THEN BRANCH SHOULD BE ALSO (10)
if branch% <> 10 then
if Audn$ = "a" OR _
Audn$ = "b" OR _
Audn$ = "c" OR _
Audn$ = "j" then
chooseAgain% = TRUE
branch% = 10 'SET TO JUVENILE "BRANCH"
msgbox "Fixed Field, Audn: has juvenile indication" _
& vbcrlf$ _
& " a, b, c, or j." _
& vbcrlf$ _
& "Juvenile branch should be selected. (??)"
end if ' ON if Audn$ = "a" OR...
End If 'ON if branch% <> 10
End Sub
'Sub CrossJuv(...
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub SixFifties
'This sub is called by Sub CrossJuv, if the user selects a juvenile "branch", and the
'Audn: fixed field has a juvenile indicator. It warns the user if the record doesn't
'have any 650 0 (2nd indicator = 0) fields, and also warns the user if there aren't any
'650 1 (2nd indicator = 1) fields.
dim cs as object
dim wholeline$, JuvOne%, bool%, JuvZero%, J%
Set CS = CreateObject("Connex.Client")
CS.CursorRow = 1
CS.CursorColumn = 1
JuvOne% = False
JuvZero% = False
J% = 1
Do
wholeline$ = ""
bool% = CS.GetField ("650", J%, wholeline$)
if instr(wholeline$, "650 0") then JuvZero% = True 'CHANGED, 6/18/4
if instr(wholeline$, "650 1") then JuvOne% = True
J% = J% + 1
Loop while bool% = True
if JuvOne% = false then msgbox "PROBLEM: Juvenile book with no 650 1 tag"
if JuvZero% = false then msgbox "PROBLEM: Juvenile book with no 650 0 tag"
End Sub
' end of Sub SixFifties
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub CheckPrevious
'Remove 949-Item, 949-RecsBin, 910-Initials from any previous run.
'NOTE: There's probably a much easier way to do this, but it took me 6 hours to get this
' to work, so...
' 1. Find all the lines with a 910, 949, or 590 tag. Keep track of those line numbers in
' an array.
' 2. Delete all the line #s in the array, starting with the last one, working back to the 1st.
' Working backwards doesn't change line numbers those remaining to be deleted. For 590
' tags, make sure it's a Faculty Publications note before deleting it.
'===================================================================================
dim bool%, J%, K%, WholeLine$, Count%
dim cs as object
dim Lines(1 to 10) as Long
Set CS = CreateObject("Connex.Client")
'====================================================================================
Count% = 0
J% = 1
' FIND ALL THE LINES WITH 949 TAGS OR 910 TAGS. FIND 590 FACULTY PUBLICATIONS NOTE.
Do
WholeLine$ = ""
bool% = CS.GetFieldLine(j, WholeLine$)
if bool% = False then Exit Do 'THIS SHOULD HAPPEN AFTER THE LAST LINE IN THE RECORD, SO QUIT
if mid$(WholeLine$, 1, 4) = "949 " Or _
mid$(WholeLine$, 1, 4) = "910 " then
Count% = Count% + 1
Lines(Count%) = J%
End If
if mid$(WholeLine$, 1, 4) = "590 " then
if instr$(wholeline$, "New Hampshire faculty publications") > 0 then
Count% = Count% + 1
Lines(Count%) = J%
End If
End If
J% = J% + 1
Loop
'====================================================================================
'DELETE ALL 590, 949, & 910 LINES. DELETING AN EARLIER LINE CHANGES LINE#s THAT FOLLOW, SO START FROM
'THE LAST ONE & WORK BACK
Do
if Count% <> 0 then
bool% = CS.DeleteFieldLine(Lines(Count%))
Count% = Count% - 1
Else
Exit Do
End If
Loop
End Sub ' end of Sub CheckPrevious
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub CheckCallZ(badZ%)
'Check for call number classification > Z1199
dim position%, temp$, dummy%
badZ% = FALSE
temp$ = fCallno$
temp$ = trim(lcase(temp$))
if mid$(temp$, 1, 1) <> "z" then exit sub 'FORGET THE WHOLE THING, IF 1ST CHARACTER <> Z
temp$ = mid$(temp$, 2, 4) 'EXTRACT THE NEXT 4 CHARACTERS
If IsNumeric(temp$) <> -1 then exit sub
dummy% = clng(temp$) 'CONVERT THOSE 4 CHARACTERS TO A LONG NUMBER
if dummy% > 1199 then badZ% = TRUE
End Sub
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub GetPrice(money$)
dim prompt$, title$
prompt$ = "Enter price of book, (if there is one)."
title$ = "Highest price on book or paperwork."
money$ = inputbox(prompt$, title$)
End Sub
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub GetCallNo(callTag$, TagSubstitute%, GotIt%)
'Get the call#. At program start, this callTag$ is set to "050", & this sub is called, to see
'if call # tag, in Main/OPtions dialog box can be set to 050. If not, then the same check is done
'with 090.
'BUT, this sub is also used to extract the call# from whatever tag the user selects. So the program
'could get a good call# from 050 tag, but the user later selects another tag (eg 090, 092, 099). This
'sub gets called again & call# is extracted again. A certain amount of duplication of effort occurs.
'start here
Dim bool%, wholeLine$, callno$, callgood%
dim cs as object
Set CS = CreateObject("Connex.Client")
GotIt% = False
TagSubstitute% = 50 'AN INITIALIZATION VALUE. REASONABLE VALUES ARE 0-3
callgood% = True
bool% = CS.GetField (callTag$, 1, wholeLine$)
If bool% = True then 'TAG WAS FOUND
callno$ = Trim(mid$(wholeLine$, 6, len(wholeLine$)))
if callTag$ <> "092" and callTag$ <> "099" then Call Checkcall (callno$, callgood%)
if callgood% = True then 'SOME SORT OF CALL# WAS FOUND
if callTag$ = "050" then TagSubstitute% = 0 'THIS PUTS 050 IN OPTIONS DIALOG BOX
if callTag$ = "090" then TagSubstitute% = 1 'THIS PUTS 090 IN OPTIONS DIALOG BOX
GotIt% = True
fCallno$ = callno$
End If
End If
End Sub
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Function IsNumber(someNumber$)
' RETURNS 1 IF VALUE PASSED IS NUMERIC, 0 IF ANY PART IS NOT NUMERIC
' NOTE: DOESN'T HANDLE DECIMAL NUMBERS, BUT THIS PROGRAM DOESN'T REQUIRE THAT.
dim k%, letter$, size%
IsNumber = 1
size% = len(someNumber$)
for k = 1 to size%
letter$ = mid$(someNumber$, k, 1)
if letter$ < "0" OR letter$ > "9" then
IsNumber = 0
exit function
end if
next k
End Function
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'P: tell Mike or Kathryn.