Prospecting/app/repositories/BusinessRepository.asp

<%
'=======================================================================================================================
' 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
'   area       "" = any, "0" = no area, otherwise an areas.id (businesses linked to that area)
'   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 | area | status | last_contacted | next_action | added   (default name)
'              area sorts by each business's alphabetically first area; businesses with none sort first
'   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 " & ListFrom() & " 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

        ' Each row gets "areas": its area names, comma-separated.
        Dim ids, names, k
        ids = ""
        For i = 0 To rows.Count - 1
            If Len(ids) > 0 Then ids = ids & ","
            ids = ids & CLng(rows(i)("id"))
        Next
        Set names = CreateObject("Scripting.Dictionary")
        If Len(ids) > 0 Then Set names = AreaRepository().NamesByBusiness(ids)
        For i = 0 To rows.Count - 1
            k = CStr(rows(i)("id"))
            If names.Exists(k) Then rows(i)("areas") = names(k) Else rows(i)("areas") = ""
        Next

        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.id, 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 " & ListFrom() & " 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

    ' Businesses whose email equals one of the keys of `emails` (a Dictionary of lowercased addresses).
    ' Returns a Dictionary of row Dictionaries (id, name, contact_name, email, city, state, status, next_action_date).
    Public Function FindByEmails(emails)
        Dim list, rs, k, d, i
        Set list = CreateObject("Scripting.Dictionary")
        For Each k In emails.Keys
            Set rs = Db_Query("SELECT id, name, contact_name, email, city, state, status, next_action_date FROM businesses WHERE email = ? ORDER BY name, id", Array(Db_PS(k)))
            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
            rs.Close
        Next
        Set FindByEmails = list
    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
    '---------------------------------------------------------------------------------------------------------------------

    ' Inserts a business entered by hand (status "new") and returns its id. d holds the same keys as Update.
    Public Function Create(d)
        Dim rs
        Db_Exec "INSERT INTO businesses (name, contact_name, industry_id, phone, phone_digits, email, website, address1, city, state, zip, " & _
                "source, status, is_customer, first_order_date, notes, created_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,Now())", _
                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("Added manually"), Db_PS("new"), Db_PI(d("is_customer")), Db_PD(d("first_order_date")), Db_PS(d("notes")))
        Set rs = Db_Query("SELECT @@IDENTITY", Array())
        Create = CLng(rs(0))
        rs.Close
    End Function

    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, ar, 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

        ar = Val_(f, "area")
        If ar = "0" Then
            m_where = m_where & " AND NOT EXISTS (SELECT ba.area_id FROM business_areas ba WHERE ba.business_id = b.id)"
        ElseIf Valid_Id(ar) Then
            ' Inlined as a validated CLng, not a ? marker: Access binds markers inside a subquery ahead of the outer
            ' ones, so a parameter here would swap values with the search terms before it.
            m_where = m_where & " AND EXISTS (SELECT ba.area_id FROM business_areas ba WHERE ba.business_id = b.id AND ba.area_id = " & CLng(ar) & ")"
        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

    ' FROM clause for the list and export: the business, its industry, and fa.first_area (its alphabetically first
    ' area name) for sorting. Access won't take a subquery in ORDER BY, hence the derived table.
    Private Function ListFrom()
        ListFrom = "(businesses b LEFT JOIN industries i ON i.id = b.industry_id) " & _
                   "LEFT JOIN (SELECT ba.business_id, MIN(a.name) AS first_area FROM business_areas ba " & _
                   "INNER JOIN areas a ON a.id = ba.area_id GROUP BY ba.business_id) AS fa ON fa.business_id = b.id"
    End Function

    Private Function OrderByClause(f)
        Dim col, dirSql
        Select Case Val_(f, "sort")
            Case "city":           col = "b.city"
            Case "industry":       col = "i.name"
            Case "area":           col = "fa.first_area"
            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
%>