Code4Lib talk:Community Portal

Revision as of 22:42, 20 April 2009 by Wickr (Talk | contribs) (Protected "Code4Lib talk:Community Portal" [edit=autoconfirmed:move=autoconfirmed])

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Revision as of 22:42, 20 April 2009 by Wickr (Talk | contribs) (Protected "Code4Lib talk:Community Portal" [edit=autoconfirmed:move=autoconfirmed])

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

part 2 of OCLC Connexion cataloging macro.

========================

' *************************************************************************** ' ***************************************************************************

' CHANGE 049 LINE TO REFLECT BRANCH (NHMM, NHMR, NHMC, ETC) ' Remove existing 049, then put a new one in with the correct ending letter.

  bool% = CS.GetField("049", 1, wholeline$)  
  if bool% = TRUE then
     bool% = CS.DeleteField ("049", 1)
     if bool% = False then
        msgbox "PROBLEM: program couldn't remove old 049 tag.  Program ending."
        goto Done
     Else
        bool% = CS.AddField( 1, st49$)
        if bool% = False then
           msgbox "PROBLEM: program couldn't add new 049 tag.  Program ending."
           goto Done
        End If
     End If         
  else
     msgbox("Program error.  Can't find 049 Tag.  Program ending.")
     goto Done
  end if         
  
 

' *************************************************************************** ' ***************************************************************************

'                   FASTCATTERS: CHECK FOR DLC DLC, IF CALL # = 050.  If not found call CheckPcc
if fastCatter% = TRUE then 
    call CheckDlc (dlc%)    
    if dlc% = FALSE then
         call CheckPcc (pcc%)      
         if pcc% = FALSE then
            msgbox "This is neither a DLC DLC nor a PCC record."
            answer% = Dialog (YesNo)          
            if answer% = 2 then goto Done      'IE END PROGRAM, IF USER CHOOSES.
         end if                                            ' ON if pcc% = FALSE      
    end if                                                 ' ON if dlc% = FALSE     
 end if 
 

' *************************************************************************** ' ***************************************************************************

' CHECK FOR SERIES TAGS, CHECK SERIES PUNCTUATION

    Call CheckSeries
 

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'                    GOTO GOTO GOTO GOTO GOTO GOTO GOTO GOTO GOTO 
'                    PROGRAM JUMPS AHEAD, IF ANALYTIC IS CHOSEN
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

 '               SKIP CALL # STUFF, ITEM LINE STUFF, IF ANALYTIC  
 if analytic% = TRUE then goto Addlines
 
 

' *************************************************************************** ' ***************************************************************************

' ADD DELIMITER FOR RETROCON (INSERT |r 2 IN ITEM LINE)

  if mydialog.checkRet = 1 then item1$ =  " 949 1ßr 2 ßg 1 ßc "
  SaveItem1$ = item1$
 

' *************************************************************************** ' ***************************************************************************

 '                FIND CALL NUMBER, BASED ON WHERE USER SAID TO LOOK
                                            
     Call GetCallNo(callTag$, TagSubstitute%, GotIt%)
    
     if GotIt% = FALSE then
          if mydialog.checkLevel < 2 then
             msgbox "Program either couldn't find " + callTag$ + " or couldn't find a call# there.  Program Ending."
             goto Done
          else
             msgbox "Program either couldn't find " + callTag$ + " or couldn't find a call# there."
             Dialog YesNo
             if YesNo.BG1 = 1 then goto Done                              'TOPCATTER CHOOSES TO END PROGRAM
          end if
     end if 
                                                                                    
 

' *************************************************************************** ' ***************************************************************************

  '             FIND CALL # DATE, 260 DATE, COMPARE TO FIXED FIELD DATE
  
  call CheckDates(dateFF1$, dateProblem%) 
  
  If dateProblem% = TRUE then                        'Change on 11/22/4
     Dialog YesNo
     if YesNo.BG1 = 1 then goto Done                        'USER CHOOSES TO ABORT PROGRAM
  End If
 

' *************************************************************************** ' *************************************************************************** ' CHECK FOR MORE THAN ONE CALL NUMBER IN LINE THAT HOLDS CALL NUMBER. IF FASTCATTING, END PROGRAM. ' OTHERWISE, WARN & ADVISE USER.

 if instr(fCallno$, "ßa") > 0 then  
    if fastCatter% = True then
       msgbox "PROBLEM: 2 call numbers in call# tag - Program Ending."
       goto Done
    else
       msgbox "PROBLEM: 2 call numbers in call# tag" & _
              chr$(13) & _
              "Correct call number should be put in 090 field."
       Dialog YesNo
       if YesNo.BG1 = 1 then goto Done    'USER CHOOSES TO END PROGRAM
    end if
 end if 
 

' *************************************************************************** ' *************************************************************************** 'CHECK FOR A CALL NUMBER STARTING WITH Z, AND A FOLLOWING NUMBER >= 1200

 Call CheckCallZ(badZ%)
 
 if badZ% = TRUE then
    if fastCatter% = True then
       msgbox "PROBLEM: Z call number above 1199  - Program Ending."
       goto Done
    else 
       msgbox "PROBLEM: Z call number above 1199"
       Dialog YesNo
       if YesNo.BG1 = 1 then goto Done    'USER CHOOSES TO END PROGRAM
    end if
 end if
 
 

' *************************************************************************** ' ***************************************************************************

 '            CHANGE ITEM LOCATION, IF CALL # 1ST LETTER < M AND >= A, AND BRANCH = MAIN
 '            ALSO, GET 1ST TWO LETTERS FOR PZ CHECK (PZ INDICATES JUVENILE BOOK)
 '            ALSO ALSO: IF CALL # STARTS WITH M9 (9 = ANY NUMBER), FORCE OVERSIZE
 '                          NOTE: MAKE THIS A SUB PROGRAM
  
  Firstlet$ = mid(fCallno$, 1, 1)                              'GET 1ST LETTER FOR LOCATION CHANGE (MLS, MLS1)
  twolet$ = mid(fCallno$, 1, 2)                                                'GETS 1ST TWO LETTERS OF CALL #
  let2$ = mid(fCallno$, 2, 1)                                        'ISOLATE 2ND LETTER FOR M9 OVERSIZE CHECK

  if mydialog.branch = 0 then                                                                   'BRANCH = MAIN     
      if Firstlet$ < "M" and Firstlet$ >= "A" then
          locate$ = locate$ + "1"                                                         'IE mls BECOMES mls1
      end if
      if LCase(twolet$) = "pz" then chksize%  = FALSE                        'NO SIZE CHECK FOR JUVENILE BOOKS
  end if                              ' [mydialog.branch = 0]
    
    '                    MINIATURE SCORE CALL#s MUST BEGIN WITH 'MS'
  if paperBrnch$ = "[]" then                                                               'IE MINIATURE SCORE
      if lcase(twolet$) <> "ms" then
          msgbox "For Miniatures Scores, 1st two letters of call number, in 099 tag, " _
                 & " MUST be 'MS'.  Program ending."
          goto Done
      end if
  Else                                                                 'I DON'T THINK THIS else EVER GETS USED
      if lcase(twolet$) = "ms" then
          msgbox "If 1st two letters of call number, in 099 tag, are MS, then branch/location should be " & _
                 "Miniatures Scores.  Program ending."
          goto Done
      End If
     
  End If
  
  '                  NOTE: if call # starts with pz1 - pz4, needs reclassing
  '                        if call # starts with pz5 - pz10, Audn: needs juvenile indication
  '                        if call # starts with > pz10, it should be brought to a professional
 

' *************************************************************************** ' ***************************************************************************

 '                  CHECK 300 TAG FIELD FOR BOOK SIZE.                                       
 if chksize% = TRUE then call SizeCheck(ovNote$, locate$, endnote$, stnote$, over%, ovmsg$, _
                                        let2$, Firstlet$, paperBrnch$)          'debug
 labelsize$ = ovnote$                 'LABELSIZE$ USED FOR "OVERSIZE" IN SLB LABEL PRINTOUT
                                      '           PROCESS
    
 

' *************************************************************************** ' *************************************************************************** ' GET NUMBER OF VOLUMES, IF MORE THAN 1

  if mydialog.checkVol = 1  then
        msgtext$="Enter number of volumes, 1 to 40: "
        Do
            again% = FALSE
            volumeNumber$ = InputBox$(msgtext)
            if IsNumber(volumeNumber$) = 1 then
                numVol% = Val(volumeNumber$)                                           
                if numVol% < 1 OR numVol% > 40 then
                    msgbox "Please enter a number between 1 and 40"
                    again% = TRUE
                end if
            else
                msgbox "Please enter a NUMBER between 1 and 40"
                again% = TRUE
            end if 
        Loop While again% = TRUE       
  end if                                              'FOR if mydialog.checkVol = 1
  
 

' *************************************************************************** ' ***************************************************************************

  '             MATERIALS FOR SPECIAL COLLECTIONS GET NO BARCODE, SO
  '                           MAKE bcodestrt$ NULL. 
  '             END OF BARCODE (bCode$) INITIALIZED HERE
  bCode$ = ""   
  If doBarcode% = FALSE Then bcodestrt$ = ""
  

' *************************************************************************** ' *************************************************************************** ' GET PRICE FROM USER

     Call GetPrice(money$)
     If money$ <> "" then price$ = price$ & money$ & " "


' *************************************************************************** ' ***************************************************************************


'              BUILD AND ADD ITEM LINES TO RECORD, FOR MULTI AND SINGLE VOLUMES
'                             NOTE: MAKE THIS A SUB PROGRAM
         
  if numVol% > 1 then                                   ' MAKE AN ITEM LINE FOR EACH VOLUME
        
      for j% = 1 to numVol%             
           item1$ = item1$ & ("v." & Cstr(j%) & " ")  'CHANGE PART OF ITEM LINE FOR EACH VOLUME
          
           '             THIS PUTS THE TIEM LINE COMPONENTS TOGETHER AND ADDS 
           '             IT TO THE RECORD, ONCE FOR EACH VOLUME.   
           bool% = cs.addfield (j%, (item1$ & circ$ & _   
                   stnote$ & ovnote$ & price$ & locate$ & status$ & bcodeStrt$ & _
                   item2$ & fCallno$))
                                     
           item1$ = SaveItem1$             'RESET START OF ITEM LINE, SO FOR NEXT VOLUME
      next j%                                                'LOOP BACK TO PROCESS NEXT VOLUME 
                  
  else                                                                   'MAKE ONLY 1 ITEM LINE
  
       '                 GET END OF BARCODE (OR ALL OF BARCODE, 
       '                 IF BARCODE READER BOX IS CHECKED)
       '   THERE HAS BEEN A SPORADIC PROBLEM OF BARCODE NOT BEING WRITTEM TO
       '   RECORD? OR NOT BEING DOWNLOADED FROM OCLC, WITH THE REST OF THE RECORD.
       '   SUSPECT THIS MIGHT BE DUE TO ALTERNATING BETWEEN USING A
       '   BARCODE READER AND NOT USING IT, AND/OR DOING A MULTI-VOLUME SET.
       '   SO HERE, THE WHOLE BARCODE IS CHECKED FOR LENGTH AND NUMBER
       '   CONTENT, JUST BEFORE IT IS WRITTEN TO THE RECORD.
       '   ALSO, SPECIAL COLLECTIONS MATERIALS GET NO BARCODE, SO IT WOULD BE
       '   SET TO NULL, AND NULL WOULD BE WRITTEN TO MEMORYER.TXT.  NEXT TIME
       '   PROGRAM RUNS, THERE WILL BE NO BARCODE READ FROM THAT FILE.
              
       If doBarcode% = TRUE Then 
           Call GetBCEnd(bcode$, notMain%, reader%, bcodestrt$)                
           completeBarCode$ = BCodeStrt$ & bcode$
           if len(completeBarCode$) <> 14 then
              Msgbox "PROBLEM: Barcode isn't 14 characters long.  STOP: tell Mike or Kathryn."
           End If
           if IsNumber(completeBarCode$) <> 1 then
              Msgbox "PROBLEM: Barcode isn't only numbers.  STOP: tell Mike or Kathryn."
           End If
       End If    
       '                   CONSTRUCT AND ADD SINGLE ITEM LINE TO RECORD   
       bool% = cs.addfield (1, (item1$ & circ$ & _    
               stnote$ & ovnote$ & price$ & locate$ & status$ & completeBarCode$ & _
               item2$ & fCallno$))
               
  end if                                         'ON [numVol > 1]
  
 

' *************************************************************************** ' ***************************************************************************

   '                    REMIND USER ABOUT REQUIREMENTS FOR MULTI VOLUMES 
   if numVol% > 1 AND doBarcode% = TRUE then            
       msgtitle$ = "Multivolume Reminder"
       msgtext$ =  "Each volume needs a barcode label." 
       if mydialog.checkReader = 0 then                        'IE NO BARCODE READER USED       
           msgtext$ = msgtext$ & chr$(13) & "Barcode in each item line needs last 4 numbers."
       else
           msgtext$ = msgtext$ & chr$(13) & "Each item line needs whole barcode number."
       end if                                
       msgbox msgtext$, , msgtitle$                       'THIS PUTS MESSAGEBOX ON SCREEN      
   end if

' *************************************************************************** ' ***************************************************************************

   '                       ADD DISC/FLOPPY INFORMATION 
   '                       *IF* THERE IS ONLY ONE VOLUME
   if mydialog.CheckDis = 1 then
       if mydialog.checkVol = 1 AND numVol% > 1 then
           diskItem$ = "0"
           msgbox "This program doesn't add disk information to item records " _
                  & "for more than 1 volume." & vbcrlf & vbcrlf _
                  & "REMEMBER:  add e.g. > " & chr$(135) & "c & 1 disc " & chr$(135) _
                  & "u d < to each 949/item record for which the volume has a disk, or disc." 
       else
           diskItem$ = "1"
       end if
       '            SEND FLAG (via diskFile) FOR MACRO NEW!DISC_FLOPPY
       open diskFile for output as #2
       print #2, diskItem$
       close #2
       '            RUN MACRO NEW!DISC_FLOPPY
       bool = cs.RunMacro ("New!Disc_floppy")
       '            'GET DISK INFO  (via diskFile) FOR PRINTED LABEL FROM NEW!DISC_FLOPPY
       open diskFile$ for input as #2
       line input #2, labelEnd$
       close #2
   end if
   

' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ' GOTO HERE GOTO HERE GOTO HERE PROGRAM SKIPS TO HERE FOR ANALYTICS ' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

Addlines:

   '                 PUT 910 (SHORT INITIALS) LINE TOGETHER, 
   '                 DEPENDING ON ANALYTIC/RETROCON STATUS
       
   If analytic% then 
       nineten$  =  "910  "  & "analytic " & init910$
   Elseif retro% = 1 then          'RETROCON        
       nineten$  =  "910  "  & "retro " & init910$
   Else
       nineten$  =  "910  " & init910$
   End If
 

' *************************************************************************** ' ***************************************************************************


   '                 PUT RECSBIN LINE TOGETHER
   recsbin$  =  "949  *recs=b;ins=" & initrec$ & ";ov=." & fBnumber & ";"    
 

' *************************************************************************** ' ***************************************************************************

   '                 ADD 910 LINE TO RECORD
   
   If init910$ = "" then
     Msgbox "PROBLEM: Initials for 910 line are blank. STOP; tell Mike or Kathryn."
   End If
           
   bool% = cs.addfield (1, nineten$)
   
 

' *************************************************************************** ' ***************************************************************************

   '                 ADD RECSBIN LINE TO RECORD
   If initrec$ = "" then
     Msgbox "PROBLEM: Initials for recs-bin line are blank. STOP; tell Mike or Kathryn."
   End If
   
   bool% = cs.addfield (10, recsbin$)
 

' *************************************************************************** ' ***************************************************************************

   '                  REMIND USER ABOUT PUTTING CALL # IN 090,
   '                  IF BRANCH ANALYTIC
   if analytic AND mydialog.branch <> 0 then
       msgbox("REMEMBER: write call # in 090 tag" & vbcrlf$ _
               & "(For Shelf List card for branch library)")
   end if
 

' *************************************************************************** ' ***************************************************************************

 '                    CALL UP SLB SCREEN AND PRINT LABEL
     call PrintLabel(endnote$, labelSize$, numVol%, branch%, st49$, row049%, _
                     labelEnd$, space$, paperBrnch$)
 

' *************************************************************************** ' ***************************************************************************


 doSpellCheck% = TRUE   '  Don't do the spellcheck if the program skips to Done, because
                        '   that means there was probably some problem.  Only check spelling
                        '   if this program runs without hitch.  Change on 9/10/4
 

Done:


' WRITE CHOICES BACK TO FILE FOR NEXT RUN 'This creates a new file, effectively removing the old choices by replacing 'them with the new file, and the (maybe) new choices.

  open filename$ for output as #4      
  print #4, init910$                                         '910 INITIALS
  print #4, initrec$                                     'RECSBIN INITIALS
  print #4, bcodestrt$                                   'START OF BARCODE
  print #4, mydialog.checkLevel         'FASTCAT, MONOGRAPH, TOPCAT CHOICE
  print #4, mydialog.Tag                                  'BRANCH LOCATION
  print #4, mydialog.checkRet                             'RETROCON CHOICE
  print #4, mydialog.checkReader                   'BARCODER READER CHOICE      
  close #4      
                  'WRITE "OTHER" CHOICE TO FILE AS NEW DEFAULT%
  open choice2File$ for output as #4
  print #4, choice2%
  close #4 
  
 
  msgbox "Program complete" 
  Clipboard.Clear                              'DON'T LET A .B# GET USED > ONCE.  Change on 5/21/4 & 11/22/4                    
 
 

' *************************************************************************** ' ***************************************************************************


  'CALL UP SPELL CHECKER                          'Change on 9/10/4  NO SPELL CHECKER IN CONNEXION TO DATE 2/17/5
  'If doSpellCheck% = TRUE then
  '   cmd$ = "%tp" 
  '   sendkeys cmd$, 1
  'End If
   

end sub



' *************************************************************************** ' *************************************************************************** ' *************************************************************************** ' *************************************************************************** ' END OF MAIN PROGRAM ' FUNCTIONS AND SUB PROGRAMS START HERE ' *************************************************************************** ' *************************************************************************** ' *************************************************************************** ' ***************************************************************************


Sub Checkcall (callno$, callgood%) ' FUNCTION JUDGES CALL # GOOD IF IT HAS > 6 CHARACTERS ' & STARTS WITH A LETTER ' NOTE: callgood% IS SET TRUE BEFORE THIS SUB IS CALLED ' NOTE: THIS FUNCTION DOESN'T WORK WITH DEWEY CALL NUMBERS.

 dim Firstlet$
 
 Firstlet$ = trim(mid$(callno$, 1, 1))
 
 if len(callno$) < 7 OR _
    Firstlet$ > "Z" OR _
    Firstlet$ < "A" then callgood% = FALSE

end Sub


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

function Checkdlc (dlc%) ' LOOK FOR "DLC |b DLC" in 040 tag, if fastcat

  dim cs as object
  dim wholeline$, bool% 
  Set CS = CreateObject("Connex.Client")
 
  bool% = CS.GetField("040", 1, wholeline$)
  if bool% = TRUE then                                  'FOUND 040 LINE
     if instr(wholeline$, "DLC ßc DLC") > 0 then dlc% = TRUE
  end if  
 

end function


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

function CheckPcc (pcc%) ' LOOK FOR PCC in 042 tag, if fastcat, and "DLC |b DLC" isn't found in 040 tag.

  dim cs as object
  dim wholeline$, bool% 
  Set CS = CreateObject("Connex.Client")
 
  bool% = CS.GetField("042", 1, wholeline$)
  if bool% = TRUE then                                   'FOUND 042 LINE
     if instr(wholeline$, "pcc") > 0 then pcc% = TRUE        
  end if  
 

end function


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@


Sub WriteBCode(bcodestrt$) ' THIS SUB PROGRAM ASKS USER FOR DIGITS 7-10 OF ' BARCODE, AND ADDS THEM TO THE USUAL 346000, ' TO FORM THE FIRST PART OF THE BARCODE.

  dim newBCode$, msgtext$, badInput%, j%, i$, vbcrlf$ 
  vbcrlf$ = chr$(13)  
  msgtext$ = "Enter digits 7-10 of new barcode (exclude initial 3 4600 0):"
    
  Do 
      badInput% = FALSE    
      newBCode$ = InputBox$ (msgtext$)    
   
      '                 LEAVE SUB PROGRAM IF CANCEL BUTTON CLICKED, OR NOTHING ENTERED
      if newBCode$ = "" then Exit Sub
   
      '                 MAKE SURE INPUT IS 4 CHARACTERS
      if len(newBCode$) <> 4 then
          badInput% = TRUE 
          msgbox "Number of digits entered is not 4" _ 
                 & vbcrlf$ & "Please enter exactly 4 digits"
      end if    
   
      '                  MAKE SURE ALL CHARACTERS ENTERED ARE NUMBERS    
      if IsNumber(newBCode$) = 0 then
          badInput% = TRUE           
          msgbox "Non-numeric characters entered" _ 
               & vbcrlf$ & "Please enter numbers only."
      end if  
 
   Loop while badInput% = TRUE 
   
   bcodestrt$ = "346000" & newBCode$ 

  

end sub ' Sub WriteBCode


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@


Sub ChngeInit(init910$, initrec$) ' GETS INITIALS FOR 910 LINE AND RECS/BIN LINE

   dim msgtext$
     
   msgtext$ = "Enter (short) initials for 910 field:"

Get910:

   init910$ = InputBox$(msgtext$)    
   if Init910$ = "" then 
      msgbox "Initials are required for this field."
      goto Get910
   end if
   

' ******************************************************************************* ' *******************************************************************************

   msgtext$ = "Enter (long) initials for 949 field:"    
    

Getrecsbin:

   initrec$ = InputBox$ (msgtext$)    
   if initrec$ = "" then 
      msgbox "Initials are required for this field."
      goto Getrecsbin
   end if 
  

end sub ' Sub ChngeInit


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

sub GetBCEnd(bcode$, notMain%, reader%, bcodestrt$) ' GETS LAST PART OF BARCODE, MAKES SURE IT HAS EXACT NUMBER ' OF DIGITS, IF BARCODE READER CHECKBOX IS CHECKED, OR START ' OF BARCODE WAS NOT READ FROM MEMORYER.TXT, 14 DIGITS ARE ' REQUIRED. OTHERWISE, 4 DIGITS ARE REQUIRED.

dim msgtext$, i$, j%, badInput%, vbcrlf$, bcodeSize%

 vbcrlf$ = chr$(13)
 
 If reader% = 0 AND bcodestrt$ <> "" Then        'USER DID NOT CHECK BARCODE READER BOX
     msgtext$="Enter last 4 digits of barcode: "  & vbcrlf  & vbcrlf & _
              "Barcode goes on COVER!!"
     bcodeSize%= 4
 Else                                                 'BARCODE READER BOX WAS CHECKED
     msgtext$="Enter whole barcode - 14 digits:"  & vbcrlf  & vbcrlf & _
              "Barcode goes on COVER!!"
     bcodeSize%= 14
     bcodestrt$ = ""
 End If
       
 Do
     badInput% = FALSE  
     bCode$ = InputBox$ (msgtext$)
   
     '                   MAKE SURE REQUIRED NUMBER OF DIGITS ARE ENTERED
     if len(bCode$) <> bcodeSize% then
         badInput% = TRUE
         msgbox "Number of digits entered is not " &  cstr(bcodeSize%) _ 
                & vbcrlf$ & "Please enter exactly " &  cstr(bcodeSize%) & " digits"
     end if
 
     '                   MAKE SURE ALL CHARACTERS ENTERED ARE NUMBERS
     If IsNumber(bCode$) = 0 then 
         badInput% = TRUE
         msgbox "Non-numeric characters entered." _ 
                & vbcrlf$ & "Please enter numbers only."
     end if
     
 Loop While badInput% = TRUE
 

End sub ' sub GetBCEnd


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@


Sub GetFxdFlds ' THIS SUB BREAKS OUT INDIVIDUAL FIXED FIELDS, USING THE BUILT IN ' CS.GetFixedField FUNCTION/METHOD. I DON'T NEED ALL OF THEM ' EXTRACTED.

  Dim WholeLine$, BOOL%         
  Dim CS as Object 
  Set CS = CreateObject("Connex.Client")   
  CS.GetFixedField "Type", typee$    
  CS.GetFixedField "BLvl", blvl$    
  CS.GetFixedField "Desc", desc$   
  CS.GetFixedField "ELvl", elvl$   
  CS.GetFixedField "Form", form$   
  CS.GetFixedField "Cont", cont$   
  CS.GetFixedField "Ills", ills$
  CS.GetFixedField "Srce", srce$
  CS.GetFixedField "Conf", conf$
  CS.GetFixedField "GPub", gpub$
  CS.GetFixedField "Fest", fest$   
  CS.GetFixedField "Audn", audn$   
  CS.GetFixedField "Biog", biog$
  CS.GetFixedField "LitF", fict$
     'CS.GetFixedField "Ctrl",       'I'VE NOT USED THESE, SO DON'T EXTRACT THEM
     'CS.GetFixedField "MRec", 
  CS.GetFixedField "Indx", indx$
  CS.GetFixedField "Lang", lang$
  CS.GetFixedField "Ctry", ctry$   
  CS.GetFixedField "dtst", dtst$
  CS.GetFixedField "Dates", dateFF1$
  CS.GetFixedField ",", dateFF2$            'THIS IS HOW TO GET THE 2ND DATE !!!

End sub ' Sub GetFxdFlds


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@2


Sub CheckSeries ' THIS SUB LOOKS FOR SERIES TAGS & CHECKS PUNCTUATION THEREIN

' PUNCTUATION: There should NOT be ", ßv"; it should be "; ßv" (semicolon vs comma). This ' subfield is for volume information. Aside from being incorrect, and having ' (to me) unknown repercussions, it makes it impossible for series checking ' software to correctly extract the series title from the volume information, and ' thus makes it necessary to check all such titles manually, instead of with ' that software.

  dim cs as object
  Set CS = CreateObject("Connex.Client")    
  
  dim seriesTag$ (9)             ' AN ARRAY!
  dim wholeline$, i%, informed%, bool%
 
  seriesTag$ (0) = "400"
  seriesTag$ (1) = "410"
  seriesTag$ (2) = "411"
  seriesTag$ (3) = "440"
  seriesTag$ (4) = "490"
  seriesTag$ (5) = "800"
  seriesTag$ (6) = "810"
  seriesTag$ (7) = "811"
  seriesTag$ (8) = "830"
  informed% = FALSE
   

' ******************************************************************************* ' *******************************************************************************

  for i% = 0 to 9 
      bool% = CS.GetField(seriesTag(i%), 1, wholeline$)             
      if bool% = TRUE then
      
                  'TELL USER ABOUT FIRST SERIES TAG ONLY
          if informed% = FALSE then
              msgbox "Record has series title tag(s). > " &  seriesTag(i%) & " < Series titles should be " & _
                     "checked against book."
              informed% = TRUE
          end if
          
                 'CHECK PUNCTUATION OF SERIES LINE, WARN USER
          if instr(wholeline$, ", ßv") > 0 then
              msgbox seriestag$(i%) & "  has  , |v " & chr$(13) & _   
                     "; |v  is correct" & chr$(13) & _
                     "   (semicolon instead of comma)."
          end if
          
      end if         ' On if bool% = TRUE
           
   next i%

end sub ' sub CheckSeries


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@


Sub CheckDates(dateFF1$, dateProblem%)

 '                  FIND CALL NUMBER DATE AND 260 DATE, COMPARE TO FIXED FIELD DATE  
 '                  THIS CALLS ANOTHER FUNCTION (GetDate) TO PULL THE DATES OUT OF THE CALL 
 '                  NUMBER, AND ALSO FROM THE END OF THE 260 LINE, BECAUSE THE STEPS
 '                  INVOLVED ARE THE SAME.
 
 dim cs as object
 Set CS = CreateObject("Connex.Client")
 dim wholeline$, date260Line$, date260$, targetLine$, callDate$
 dim vbcrlf$, bool%
 
 vbcrlf$ = chr$(13)
 dateProblem% = FALSE
 
 '================================================================================
 '          CHECK ON FIXED FIELD DATE (FIRST DATE ONLY)
 '================================================================================
 dateFF1$ = trim(dateFF1$)
 If dateFF1$ = "" then
     msgbox "Program couldn't find Fixed Field date(s) for date checking." _ 
            & vbcrlf$ & vbcrlf$ _ 
            & "Please check dates visually."
     dateProblem% = TRUE
     goto Done
 End If
 
 
 '================================================================================
 '                      GET CALL NUMBER DATE 
 '================================================================================ 
 
 
 
 if fCallno$ = "" then
     msgbox "Program couldn't find call number tag for date checking." _ 
            & vbcrlf$ & vbcrlf$ _ 
            & "Please check dates visually."
     goto Done
 Else
     targetLine$ = fCallno$
 End If
                 
 callDate$ = GetDate(targetLine$)
 
 if callDate$ = "" then
     msgbox "Program couldn't find Call Number Date." _ 
            & vbcrlf$ & vbcrlf$ _ 
            & "Please check dates visually."
     
     dateProblem% = TRUE
     goto Done
 end if            
 

 
 '================================================================================
 '                              FIND 260 DATE 
 '================================================================================  
  
 bool% = CS.GetField("260", 1, wholeline$)
 if bool% = FALSE then
     msgbox "Program couldn't find 260 tag for date checking." _ 
            & vbcrlf$ & vbcrlf$ _ 
            & "Please check dates visually."
            
     dateProblem% = TRUE
     goto Done
 end if 
 targetLine$ = wholeline$ 
 
 date260$ = GetDate(targetLine$)                       'EXTRACT DATE FROM LINE OF TEXT 
 
 if Date260$ = "" then
    msgbox "Program couldn't find 260 Date." _ 
            & vbcrlf$ & vbcrlf$ _ 
            & "Please check dates visually."
    
    dateProblem% = TRUE
    goto Done
 end if
 


' ******************************************************************************** ' ******************************************************************************** ' COMPARE 260 DATE TO CALL # DATE AND FIXED FIELDS DATE

 if date260$ = dateFF1$ AND callDate$ = dateFF1$ then  
    msgbox "Dates match" _ 
           & vbcrlf$ & vbcrlf$ _
           & "    Fixed Fields Date:   - " & dateFF1$  _ 
           & vbcrlf$ _ 
           & "    Call Number Date:  - " & callDate$ _ 
           & vbcrlf$ _  
           & "    260 date:                - " & Date260$
           
 else
    msgbox "Dates do NOT match!" _ 
           & vbcrlf$ & vbcrlf$ _
           & "    Fixed Fields Date:   - " & dateFF1$  _ 
           & vbcrlf$ _ 
           & "    Call Number Date:  - " & callDate$ _ 
           & vbcrlf$ _  
           & "    260 date:                - " & Date260$ _ 
           & vbcrlf$ & vbcrlf$ _ 
           & "Please check dates visually."
    
     dateProblem% = TRUE
                   
 end if    

Done:

end sub ' Sub CheckDates


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@


Function GetDate (targetLine$) ' PULLS DATES OUT FROM REST OF LINE ' - CALLED BY CHECKDATES SUB PROGRAM

   dim i%, lineLength%, start%, dateLength%, one$, extDate$
   GetDate = ""
   lineLength% = len(targetLine$) 
   

' ************************************************************************* ' *************************************************************************

   '                  FIND SPACE PRECEDING DATE 
   '                  ALSO, LOOK FOR 'c' PRECEDING DATE, IN 260 LINE (INDICATES
   '                  COPYRIGHT DATE)
   for i% = (lineLength%-2) to (lineLength% - 8) step -1
      one$ = Mid(targetLine$, i%, 1)
      if one$ = " " OR _ 
         one$ = "c" then
            start% = i% + 1 
            dateLength% = lineLength% - i%
            exit for
      end if
   next i%  
  

' ************************************************************************* ' *************************************************************************

 '                        EXTRACT DATE FROM LINE
 extDate$ = Mid(targetLine$, start%, dateLength%)  
  

' ************************************************************************* ' *************************************************************************

 '                        NAKE SURE IT STARTS WITH A NUMBER
 one$ = mid$(extDate$, 1, 1)
 if IsNumber(one$) = 0 then Exit Function
  

' ************************************************************************* ' *************************************************************************

 '                        REMOVE LAST CHARACTER FROM DATE, IF NOT A NUMBER
 if len(ExtDate$) > 4 then              
    one$ = Mid(ExtDate$, len(ExtDate$), 1)
    if IsNumber(one$) = 0 then ExtDate$ = Mid(ExtDate$, 1, (len(ExtDate$)-1))     
 end if
    

' ************************************************************************* ' *************************************************************************

 GetDate = ExtDate$

end function 'Function GetDate

Return to the project page "Community Portal".