Difference between revisions of "Posts"

From Code4Lib
Jump to: navigation, search
(Removing all content from page)
 
(One intermediate revision by the same user not shown)
Line 1: Line 1:
<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! 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.
 

Latest revision as of 15:06, 15 October 2008