Difference between revisions of "Posts"

Revision as of 14:58, 15 October 2008

I'm not into learning curves absolutely everywhere I go! 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.