<% '======================================================================================================================= ' BUSINESS REPOSITORY ' Data access for businesses and their logged contacts (interactions). Everything is bound as ADODB parameters ' through the Db_* helpers (app/lib/lib.Db.asp). ' ' List filters (Scripting.Dictionary, all optional): ' q free text: every whitespace-separated term must match name, contact, email, city or phone ' industry "" = any, "0" = no industry, otherwise an industries.id ' status "active" (default, hides removed), "all", or new | contacted | follow_up | removed ' show "" = everyone, "prospects", "customers" ' contacted "never" = only businesses with no contact yet ' phone "1" = only businesses with a phone number ' sort name | city | industry | status | last_contacted | next_action | added (default name) ' dir asc | desc '======================================================================================================================= Class BusinessRepository_Class Private m_where Private m_params ' Dictionary index -> Array(adoType, value), in the order of the ? markers in m_where '--------------------------------------------------------------------------------------------------------------------- ' Lists '--------------------------------------------------------------------------------------------------------------------- ' One page of the filtered list. Returns Dictionary("rows" -> Dictionary of row Dictionaries, "total" -> count). Public Function Search(f, page, perPage) Dim result, rows, total, rs, i, skip, sql BuildWhere f Set rs = Run("SELECT COUNT(*) AS n FROM businesses b WHERE " & m_where) total = CLng(rs("n")) rs.Close If page < 1 Then page = 1 skip = (page - 1) * perPage ' Access has no OFFSET: read TOP (skip + perPage) rows and step past the first `skip` of them. sql = "SELECT TOP " & CLng(skip + perPage) & " b.id, b.name, b.contact_name, b.phone, b.email, b.website, " & _ "b.city, b.state, b.status, b.is_customer, b.last_contacted_at, b.next_action_date, i.name AS industry_name " & _ "FROM businesses b LEFT JOIN industries i ON i.id = b.industry_id " & _ "WHERE " & m_where & " ORDER BY " & OrderByClause(f) Set rs = Run(sql) For i = 1 To skip If rs.EOF Then Exit For rs.MoveNext Next Set rows = ReadRows(rs) rs.Close Set result = CreateObject("Scripting.Dictionary") Set result("rows") = rows result("total") = total Set Search = result End Function ' Every business matching the filters (no paging), as a forward-only recordset for streaming to CSV. Public Function ExportRows(f) BuildWhere f Set ExportRows = Run("SELECT b.name, b.contact_name, i.name AS industry_name, b.phone, b.email, b.website, " & _ "b.address1, b.city, b.state, b.zip, b.status, b.is_customer, b.last_contacted_at, b.next_action_date " & _ "FROM businesses b LEFT JOIN industries i ON i.id = b.industry_id " & _ "WHERE " & m_where & " ORDER BY " & OrderByClause(f)) End Function ' Businesses with a next-contact date on or before throughDate (removed ones excluded), oldest first, ' each with the details of its most recent logged contact. Public Function DueThrough(throughDate) Dim list, rs, i, ids, notesById, k, sql sql = "SELECT TOP 500 b.id, b.name, b.contact_name, b.phone, b.email, b.city, b.state, b.is_customer, " & _ "b.next_action_date, b.last_contacted_at, i.name AS industry_name, " & _ "(SELECT TOP 1 x.method FROM interactions x WHERE x.business_id = b.id ORDER BY x.contacted_at DESC, x.id DESC) AS last_method, " & _ "(SELECT TOP 1 x.outcome FROM interactions x WHERE x.business_id = b.id ORDER BY x.contacted_at DESC, x.id DESC) AS last_outcome, " & _ "(SELECT TOP 1 x.id FROM interactions x WHERE x.business_id = b.id ORDER BY x.contacted_at DESC, x.id DESC) AS last_interaction_id " & _ "FROM businesses b LEFT JOIN industries i ON i.id = b.industry_id " & _ "WHERE b.next_action_date IS NOT NULL AND b.next_action_date <= ? AND b.status <> 'removed' " & _ "ORDER BY b.next_action_date ASC, b.name ASC" Set rs = Db_Query(sql, Array(Db_PD(throughDate))) Set list = ReadRows(rs) rs.Close ' Notes are a memo field, which Access won't return from a TOP 1 subquery, so fetch them by interaction id. ids = "" For i = 0 To list.Count - 1 If Not IsNull(list(i)("last_interaction_id")) Then If Len(ids) > 0 Then ids = ids & "," ids = ids & CLng(list(i)("last_interaction_id")) End If Next Set notesById = CreateObject("Scripting.Dictionary") If Len(ids) > 0 Then Set rs = Db_Query("SELECT id, notes FROM interactions WHERE id IN (" & ids & ")", Array()) Do While Not rs.EOF notesById(CStr(rs(0))) = rs(1) & "" rs.MoveNext Loop rs.Close End If For i = 0 To list.Count - 1 list(i)("last_notes") = "" If Not IsNull(list(i)("last_interaction_id")) Then k = CStr(list(i)("last_interaction_id")) If notesById.Exists(k) Then list(i)("last_notes") = notesById(k) End If Next Set DueThrough = list End Function ' id -> name, for dropdowns Public Function Industries() Dim list, rs Set list = CreateObject("Scripting.Dictionary") Set rs = Db_Query("SELECT id, name FROM industries ORDER BY name", Array()) Do While Not rs.EOF list.Add CStr(rs(0)), rs(1) & "" rs.MoveNext Loop rs.Close Set Industries = list End Function '--------------------------------------------------------------------------------------------------------------------- ' One business and its history '--------------------------------------------------------------------------------------------------------------------- ' All columns plus industry_name, or Nothing. Public Function Find(id) Dim rs, rows Set rs = Db_Query("SELECT b.*, i.name AS industry_name FROM businesses b LEFT JOIN industries i ON i.id = b.industry_id WHERE b.id = ?", Array(Db_PI(id))) Set rows = ReadRows(rs) rs.Close If rows.Count = 0 Then Set Find = Nothing Else Set Find = rows(0) End Function ' Logged contacts for a business, newest first. Public Function Interactions(businessId) Dim rs Set rs = Db_Query("SELECT id, method, outcome, notes, contacted_at, follow_up_date FROM interactions WHERE business_id = ? ORDER BY contacted_at DESC, id DESC", Array(Db_PI(businessId))) Set Interactions = ReadRows(rs) rs.Close End Function ' Another business (not excludeId) with the same phone digits or the same email, or Nothing. ' Returns Dictionary(id, name, matched) where matched is "phone" or "email". Public Function FindDuplicate(excludeId, phoneDigits, email) Dim d Set FindDuplicate = Nothing If Len(phoneDigits) > 0 Then Set d = FirstMatch("SELECT TOP 1 id, name FROM businesses WHERE id <> ? AND phone_digits = ?", Array(Db_PI(excludeId), Db_PS(phoneDigits)), "phone") If Not d Is Nothing Then Set FindDuplicate = d Exit Function End If End If If Len(email) > 0 Then Set FindDuplicate = FirstMatch("SELECT TOP 1 id, name FROM businesses WHERE id <> ? AND email = ?", Array(Db_PI(excludeId), Db_PS(email)), "email") End If End Function ' Returns the industry id for a name, creating the industry when it does not exist. Null for a blank name. Public Function FindOrCreateIndustry(name) Dim rs name = Left(Trim(name), 100) If Len(name) = 0 Then FindOrCreateIndustry = Null Exit Function End If Set rs = Db_Query("SELECT id FROM industries WHERE name = ?", Array(Db_PS(name))) If Not rs.EOF Then FindOrCreateIndustry = CLng(rs(0)) rs.Close Exit Function End If rs.Close Db_Exec "INSERT INTO industries (name) VALUES (?)", Array(Db_PS(name)) Set rs = Db_Query("SELECT @@IDENTITY", Array()) FindOrCreateIndustry = CLng(rs(0)) rs.Close End Function '--------------------------------------------------------------------------------------------------------------------- ' Changes '--------------------------------------------------------------------------------------------------------------------- Public Sub Update(id, d) Db_Exec "UPDATE businesses SET name = ?, contact_name = ?, industry_id = ?, phone = ?, phone_digits = ?, email = ?, " & _ "website = ?, address1 = ?, city = ?, state = ?, zip = ?, notes = ?, is_customer = ?, first_order_date = ? WHERE id = ?", _ Array(Db_PS(d("name")), Db_PS(d("contact_name")), Db_PI(d("industry_id")), Db_PS(d("phone")), Db_PS(d("phone_digits")), Db_PS(d("email")), _ Db_PS(d("website")), Db_PS(d("address1")), Db_PS(d("city")), Db_PS(d("state")), Db_PS(d("zip")), Db_PS(d("notes")), _ Db_PI(d("is_customer")), Db_PD(d("first_order_date")), Db_PI(id)) End Sub ' Logs a touch and updates the business in one transaction: ' removing -> status removed, no next action ' follow-up date -> status follow_up, next_action_date = follow-up date ' otherwise -> status contacted, next_action_date cleared Public Sub LogInteraction(id, method, outcome, notes, contactedAt, followUp, removing, removeReason) Dim conn, b, status, nextAction, lastContacted, remReason, remAt, msg Set conn = DAL().Connection Set b = Find(id) lastContacted = contactedAt If Not IsNull(b("last_contacted_at")) Then If CDate(b("last_contacted_at")) > contactedAt Then lastContacted = CDate(b("last_contacted_at")) End If remReason = Null : remAt = Null : nextAction = Null If removing Then status = "removed" remReason = removeReason remAt = Now() ElseIf Not IsNull(followUp) Then status = "follow_up" nextAction = followUp Else status = "contacted" End If conn.BeginTrans On Error Resume Next Db_Exec "INSERT INTO interactions (business_id, method, outcome, notes, contacted_at, follow_up_date, created_at) VALUES (?,?,?,?,?,?,Now())", _ Array(Db_PI(id), Db_PS(method), Db_PS(outcome), Db_PS(notes), Db_PD(contactedAt), Db_PD(followUp)) If Err.Number = 0 Then Db_Exec "UPDATE businesses SET last_contacted_at = ?, status = ?, next_action_date = ?, removed_reason = ?, removed_at = ? WHERE id = ?", _ Array(Db_PD(lastContacted), Db_PS(status), Db_PD(nextAction), Db_PS(remReason), Db_PD(remAt), Db_PI(id)) End If If Err.Number <> 0 Then msg = Err.Description Err.Clear conn.RollbackTrans On Error GoTo 0 Err.Raise 5, "BusinessRepository.LogInteraction", msg End If conn.CommitTrans On Error GoTo 0 End Sub Public Sub Remove(id, reason) Db_Exec "UPDATE businesses SET status = 'removed', next_action_date = NULL, removed_reason = ?, removed_at = Now() WHERE id = ?", _ Array(Db_PS(reason), Db_PI(id)) End Sub Public Sub Restore(id) Db_Exec "UPDATE businesses SET status = IIf(last_contacted_at IS NULL, 'new', 'contacted'), removed_reason = NULL, removed_at = NULL WHERE id = ?", _ Array(Db_PI(id)) End Sub '--------------------------------------------------------------------------------------------------------------------- ' Internals '--------------------------------------------------------------------------------------------------------------------- ' Reads every remaining row of the recordset into a Dictionary (0-based index -> Dictionary of column -> value). Private Function ReadRows(rs) Dim list, d, i Set list = CreateObject("Scripting.Dictionary") Do While Not rs.EOF Set d = CreateObject("Scripting.Dictionary") For i = 0 To rs.Fields.Count - 1 d(rs.Fields(i).Name) = rs.Fields(i).Value Next list.Add list.Count, d rs.MoveNext Loop Set ReadRows = list End Function ' Runs a query expected to return (id, name) and wraps the first row as Dictionary(id, name, matched), or Nothing. Private Function FirstMatch(sql, params, matched) Dim rs, d Set FirstMatch = Nothing Set rs = Db_Query(sql, params) If Not rs.EOF Then Set d = CreateObject("Scripting.Dictionary") d("id") = CLng(rs(0)) : d("name") = rs(1) & "" : d("matched") = matched Set FirstMatch = d End If rs.Close End Function ' Executes sql with the parameters collected by BuildWhere. Private Function Run(sql) Dim params(), i If m_params.Count = 0 Then Set Run = Db_Query(sql, Array()) Exit Function End If ReDim params(m_params.Count - 1) For i = 0 To m_params.Count - 1 params(i) = m_params(i) Next Set Run = Db_Query(sql, params) End Function Private Sub AddParam(typ, v) m_params.Add m_params.Count, Array(typ, v) End Sub Private Sub BuildWhere(f) Dim terms, t, d, q, n, frag, ind, st m_where = "1=1" Set m_params = CreateObject("Scripting.Dictionary") q = Trim(Val_(f, "q")) If Len(q) > 0 Then terms = Split(q, " ") n = 0 For Each t In terms If Len(t) > 0 And n < 5 Then n = n + 1 t = Left(t, 50) d = ImportFile_PhoneDigitsLoose(t) frag = "(b.name LIKE ? OR b.contact_name LIKE ? OR b.email LIKE ? OR b.city LIKE ?" AddParam 202, "%" & Like_(t) & "%" AddParam 202, "%" & Like_(t) & "%" AddParam 202, "%" & Like_(t) & "%" AddParam 202, "%" & Like_(t) & "%" If Len(d) >= 3 Then frag = frag & " OR b.phone_digits LIKE ?" AddParam 202, "%" & d & "%" End If m_where = m_where & " AND " & frag & ")" End If Next End If ind = Val_(f, "industry") If ind = "0" Then m_where = m_where & " AND b.industry_id IS NULL" ElseIf Valid_Id(ind) Then m_where = m_where & " AND b.industry_id = ?" AddParam 3, CLng(ind) End If st = Val_(f, "status") Select Case st Case "all" Case "new", "contacted", "follow_up", "removed" m_where = m_where & " AND b.status = ?" AddParam 202, st Case Else m_where = m_where & " AND b.status <> 'removed'" End Select Select Case Val_(f, "show") Case "prospects" m_where = m_where & " AND (b.is_customer = 0 OR b.is_customer IS NULL)" Case "customers" m_where = m_where & " AND b.is_customer = 1" End Select If Val_(f, "contacted") = "never" Then m_where = m_where & " AND b.last_contacted_at IS NULL" If Val_(f, "phone") = "1" Then m_where = m_where & " AND b.phone_digits IS NOT NULL" End Sub Private Function OrderByClause(f) Dim col, dirSql Select Case Val_(f, "sort") Case "city": col = "b.city" Case "industry": col = "i.name" Case "status": col = "b.status" Case "last_contacted": col = "b.last_contacted_at" Case "next_action": col = "b.next_action_date" Case "added": col = "b.created_at" Case Else: col = "b.name" End Select If LCase(Val_(f, "dir")) = "desc" Then dirSql = "DESC" Else dirSql = "ASC" OrderByClause = col & " " & dirSql & ", b.id " & dirSql End Function Private Function Val_(f, key) If f.Exists(key) Then Val_ = CStr(f(key)) Else Val_ = "" End Function ' Escape LIKE wildcards so user input is matched literally. Private Function Like_(s) s = Replace(s, "[", "[[]") s = Replace(s, "%", "[%]") s = Replace(s, "_", "[_]") s = Replace(s, "*", "[*]") s = Replace(s, "?", "[?]") Like_ = s End Function End Class Dim BusinessRepository_Class__Singleton Function BusinessRepository() If IsEmpty(BusinessRepository_Class__Singleton) Then Set BusinessRepository_Class__Singleton = New BusinessRepository_Class End If Set BusinessRepository = BusinessRepository_Class__Singleton End Function %>