Environment: Windows Server, Access/VBA, Microsoft SQL Server, Innovative
Description: This code does the library patron maintenance: add, update and de-activate. The library system, Innovative, accepts a ascii file, pre-formatted: MARC format.
Features:
- Patron can use their ID card magnetic strip to check out books
- Patron access is synchronized with exit policy
- Patron privileges are determined by this coding
Code:
Public Sub CreateInnovative(bolOnLine As Boolean, intStatus2 As Integer, dblCount As Double)
' Create Innovative patron MARC record file
'
' 04-JUL-2001 Robert Lawson Creation Date
' Innovative, INNOPAC User Manual, "Load PATRON recors from tape or IFTS"
' r 2000, 6/28/2001
' 08-OCT-2001 Robert Lawson Added yyyyymmdd logic
' 12-AUG-2002 Robert Lawson Chngd PCODE1 update per library (RS), added PCODE2 & PCODE3
' 15-Jul-2003 Robert Lawson If coded MakeUserInnovative = False, then set to inactive
' 17-Jul-2003 Robert Lawson Updated to Release 2002, Phase 2 specs (added PCODE4)
' 05-Aug-2003 Robert Lawson Update header record for library code and block code
' mblock inactive from from i to b, library from MCIRC to mcirc
' 07-Aug-2003 Robert Lawson Removed PCODE4, added proper codes for PCODE1, PCOD2, Message Code
' 02-Mar-2004 Robert Lawson Changed default PCODE2 from 'c' to '-' per Devin Castel
' 08-Apr-2004 Robert Lawson Add suffix to last name, the "JR" fix
' 04-Jan-2005 Robert Lawson Added DoDataLog call when user setup
' 12-Apr-2006 Robert Lawson Changed Active/Disable logic to use date, as Block Code in IIS no worky
' 05-May-2007 Robert Lawson Added SWC logic
' 27-Dec-2007 Robert Lawson Updated for ADO
' 08-Jan-2008 Robert Lawson Removed "access pending" logic
' Name Description
' IntStatus2 Returned Status, 0=OK, <>0 you are not OK
' dblCount Returned Number of records processed
' Questions
' 3. How do you know max length for each field?
' 4. User type ?
' 6. How do I know field max length size?
' 7. Required other fields by application (john & vendor): patron type, home library,
' 8. deletion code: what is letter for '070', have more than 'd'elete status? Open, inactive?
' Notes
' 1. Using "Format3: Text File Image."
strName = "CreateInnovative"
On Error GoTo ErrorBegin
' System
Dim intStatus As Integer
Dim objRS As ADODB.Recordset, objRS2 As ADODB.Recordset
Dim strFile As String
' Local
Dim bolUpdate As Boolean, bolPatronActive As Boolean, bolEmailEventLog As Boolean
Dim Kount As Double
Dim strRec As String, strStatus As String, strPatron As String, strID As String
Dim strPCODE1 As String, strPCODE2 As String, strPCODE3 As String, strFieldCode As String
Dim strMessageCode As String, strNameTemp As String, strDateStatus As String
Const conHomeLibrary = "mcirc"
Const conDateActive = "04-11-27" ' A new beginning
Const conDateDisable = "04-11-00" ' When I expire
intStatus2 = 0 ' I'm OK
Call DoEventLog("PRO", strName, 0, "Begin", False, bolOnLine)
strMessage = conNoMessage
Call LoadSysDbconn(intStatus)
If intStatus <> 0 Then
strMessage = "Error calling LoadSysDbconn."
Err.Raise (vbObjectError + 10), , strMessage
GoTo ErrorBegin
End If
' ============================================
Debug.Print "01. Get file information"
Step_01:
' ============================================
strSQL = "SELECT FileInnovative from SysInfo"
Debug.Print strSQL
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open strSQL, conDbOneCard, adOpenDynamic, adLockReadOnly ' read access
With objRS
If (.BOF Or .EOF) Then
strMessage = "Unable to get SysInfo record"
intStatus2 = -1
GoTo ErrorBegin
ElseIf Nz(RTrim(!FileInnovative), "") = "" Then
strMessage = strName & ": SysInfo record for FileName is null"
intStatus2 = -2
GoTo ErrorBegin
End If
strFile = !FileInnovative
strFile = Replace(strFile, "yyyymmdd", Format(Date, "yyyymmdd"))
' strFile = "C:\TEMP\InnovativeExport.txt" ' *********** DEBUG ****************
If FileExists(strFile) Then
Debug.Print strFile
strMessage = strName & ": Export file already exists: " & strFile
intStatus2 = -3
GoTo ErrorBegin
End If
End With
Set objRS = Nothing
' ============================================
Debug.Print "02. Main loop"
Step_02:
' ============================================
strSQL = "SELECT * FROM OneCardMaster WHERE NeedUpdateInnovative = 1" ' 1=True
Debug.Print strSQL
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open strSQL, conDbOneCard, adOpenStatic, adLockPessimistic ' write access
With objRS
' Get record count (.RecordCount property don't work)
Do Until .EOF
Kount = Kount + 1
.MoveNext
Loop
Debug.Print "Kount = " & Kount
If Kount = 0 Then
' 07-July-2004 FIX Write blank files, lets user know there are no records
strMessage = strName & ": Warning. Zero records to process."
If bolOnLine Then MsgBox strMessage
Call DoEventLog("PRO", strName, 10, strMessage, False, bolOnLine)
GoTo ExitBegin
End If
.MoveFirst ' You moved BOF when doing Kount
' Create file if there are records or not (leaves trail of what ya did)
Close ' Close anything else open
Open strFile For Output As #1 ' Purge old file 1st
' Zero Field record layout, from Innovative on 23-AUG-2001
'Field code 1 char.(a zero)
'Patron type 3 digits (000 to 255), e.g. "003"
'Patron code 1 1 char. e.g. "a"
'Patron code 2 1 char. e.g. "b"
'Patron code 3 3 digits (000255), e.g. "002"
'Patron's home library code 5 chars. e.g. "art "
'Patron message code 1 char. e.g. " " (blank space)
'Patron block code 1 char. e.g. " "
'Patron exp. date 8 chars. (mmddyy), e.g. "02-15-90"
' Detail: code of what is, followed by value itself. Each value is variable length
Do Until .EOF
strID = !ID
' status (block code), must be 1
If !MakeUserInnovative = False Or (IsDate(!ExpirationDate) And !ExpirationDate <= Date) Then
bolPatronActive = False
strDateStatus = conDateDisable
Else
bolPatronActive = True
strDateStatus = conDateActive
End If
' Patron Type (ties to cirulation rule), must be 3
strFieldCode = "0" ' Plug value
strPCODE1 = "-" ' Unclassified
strPCODE2 = "-" ' Not community (public)
strPCODE3 = "000"
strMessageCode = "-" ' Default
strStatus = "-" ' Hard code to "valid" Patron Block Code, as doesn't work
If !UserType = "SOKASTUDENT" Then
strPatron = "007"
Select Case !AcadLevel
Case "FRSH"
strPCODE1 = "1"
Case "SOPH"
strPCODE1 = "2"
Case "JUNR"
strPCODE1 = "3"
Case "SENR"
strPCODE1 = "4"
Case "POST"
strPCODE1 = "g"
Case "GRAD"
strPCODE1 = "g"
Case Else
strPCODE1 = "-" ' No idea
End Select
ElseIf !UserType = "STAFF-FACULTY" Then
strPatron = "006"
strPCODE1 = "s" ' Staff
If !EmpType = "PROF" Then strPCODE1 = "f" ' Faculty
ElseIf !UserType = "CONTRACTOR" Then
strPatron = "006"
strPCODE1 = "s" ' 07-Aug-2003, lump with staff
strMessageCode = "a" ' 07-Aug-2003, check address flag
ElseIf !UserType = "GUEST" Then
strPatron = "018"
strMessageCode = "a" ' 07-Aug-2003, check address flag
ElseIf !UserType = "PUBLIC" Then
strPatron = "003"
strMessageCode = "a" ' 07-Aug-2003, check address flag
ElseIf Left(!UserType, 3) = "SWC" Or Left(!UserType, 4) = "UBPX" Then
strMessageCode = "a"
strPatron = "010" ' SWC
strPCODE1 = "w" ' SWC
strDateStatus = Format(!NetExpirationDate, "mm-dd-yy") ' SWC, you know expiration date
Else
strPatron = "003"
End If
' "Zero" field record. Need one of these bad boys for each patron (4-11-27 is when I'm 80)
strRec = strFieldCode & strPatron & strPCODE1 & strPCODE2 & strPCODE3 & _
conHomeLibrary & strMessageCode & strStatus & strDateStatus
Print #1, strRec
' u=Institution-assigned ID number
strRec = "u" & !ID
Print #1, strRec
' b=Barcode number (badge+revision)
strRec = "b" & BadgeNumber(!IDBadge, !IDBadgeRev)
Print #1, strRec
' n=name
If Len(RTrim(!NameSuffix)) = 0 Then
strNameTemp = Trim(Nz(!NameLast, ""))
Else
strNameTemp = RTrim(Nz(!NameLast, "")) & " " & Trim(Nz(!NameSuffix, ""))
End If
strRec = "n" & Left(strNameTemp & ", " & Trim(Nz(!NameFirst, "")) & " " & Trim(Nz(!NameMiddle, "")), 32)
Print #1, strRec
' a=address line 1 and 2, $ seperator (a1 & a2$city & state & zip)
' t=telephone
If Len(Nz(!CampusRoom, "")) > 0 Then ' Assume local if room is specified
strRec = "a" & !CampusBuilding & !CampusRoom
Print #1, strRec
strRec = "t" & !CampusPhone
Print #1, strRec
Else
If Len(Nz(!Address1, "")) > 0 Then
strRec = "a" & !Address1 & "$" & !City & !State & !Postal
Print #1, strRec
strRec = "t" & !Phone
Print #1, strRec
End If
End If
' 07-July-2004 Fix Pass home address & phone plug (for library)
' sample: h802 Dev St.$Cambridge, MA 77721
' sample: p800-222-2222
' z=campus email NETEMail
If Len(Nz(!NETEMail, "")) > 0 Then
strRec = "z" & !NETEMail
Print #1, strRec
End If
!SubSystemUpdate = Now()
!LastUpdatedInnovative = Now()
!NeedUpdateInnovative = False
.Update
Call DoDataLog("CreateInnovative", "IN", "SUB-USER", "Innovative User", "", strID, strID, bolOnLine)
.MoveNext
Loop ' Main loop
End With
Set objRS = Nothing
Close #1 ' Closes data file
dblCount = Kount ' Successfully updated
ExitBegin:
Call DoEventLog("PRO", strName, 0, "Exit", False, bolOnLine)
Exit Sub
ErrorBegin:
If intStatus2 = 0 Then ' General message
strMessage = "Error in " & strName & " " & Err.Number & " " & Err.Description & " for strID = " & Nz(strID, "")
intStatus2 = -11 ' I'm NOT OK
Else
If strMessage = conNoMessage Then strMessage = "Error = " & Err.Number & " " & Err.Description
End If
If bolOnLine Then MsgBox strMessage
bolEmailEventLog = (intStatus2 <> -3) ' Export file already exists
Call DoEventLog("ERR", strName, 500, strMessage, bolEmailEventLog, bolOnLine)
GoTo ExitBegin
End Sub
No comments:
Post a Comment