Sub main(fx, sort)
    On Error GoTo eh

    Call StopClock
    
    Dim oDoc As Document
    Set oDoc = ActiveDocument
    
    Dim n As Integer
    n = ActiveDocument.Bookmarks.Count

    'Dim coll As New Collection
    Dim coll As Collection
    Set coll = New Collection

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' MEMORY

    For i = 1 To n
        'MsgBox "MEMORY"
        bmk = oDoc.Bookmarks(i).Name
        
        Set d = CreateObject("Scripting.Dictionary")
        
        d.Add "bmk", bmk
        
        
        Set oTable = oDoc.Bookmarks(bmk).Range.Tables(1)
        
        
        d.Add "room", Split(oTable.Cell(1, 1).Range.Text, vbCr)(0)
    
        nameDOB = Split(oTable.Cell(1, 2).Range.Text, vbCr)(0)
        
        yo = InStr(nameDOB, "yo")
    
        'Last, First
        nameBoth = Left(nameDOB, yo - 1)
        d.Add "last", Trim(Split(nameBoth, ",")(0))
        fNameAGE = Trim(Split(nameBoth, ",")(1))
        fNameArray = Split(fNameAGE)
        If UBound(fNameArray) >= 2 Then
            FName = fNameArray(0) & " " & fNameArray(1)
        Else
            FName = fNameArray(0)
        End If
        d.Add "first", FName
    
        'Gender
        d.Add "gender", Mid(nameDOB, yo + 3, 1)
    
        'DOB
        dob = InStr(nameDOB, "DOB") + 5
        mrn = InStr(nameDOB, "MRN") - 3
        d.Add "dob", Mid(nameDOB, dob, mrn - dob)
    
        'MRN
        d.Add "mrn", Mid(nameDOB, mrn + 8, 6)
        
        d.Add "admit", Split(oTable.Cell(1, 3).Range.Text, " ")(1)
        d.Add "resident", Split(oTable.Cell(2, 2).Range.Text, vbCr)(0)
        d.Add "code", Split(oTable.Cell(2, 3).Range.Text, vbCr)(0)

        txtMeds = Replace(Split(oTable.Cell(3, 1).Range.Text, Chr(7))(0), "Rx: ", "")
        If Right$(txtMeds, 1) = Chr(13) Then txtMeds = Left$(txtMeds, Len(txtMeds) - 1)
        d.Add "meds", txtMeds

        txtHPI = Split(oTable.Cell(3, 2).Range.Text, Chr(7))(0)
        If Right$(txtHPI, 1) = Chr(13) Then txtHPI = Left$(txtHPI, Len(txtHPI) - 1)
        d.Add "hpi", txtHPI

        txtFU = Replace(Split(oTable.Cell(3, 3).Range.Text, Chr(7))(0), "F/U: ", "")
        If Right$(txtFU, 1) = Chr(13) Then txtFU = Left$(txtFU, Len(txtFU) - 1)
        d.Add "fu", Replace(txtFU, ChrW(&H2610) & " ", "")
        
        txtAllergies = Replace(Split(oTable.Cell(4, 1).Range.Text, Chr(7))(0), "Allergies: ", "")
        If Right$(txtAllergies, 1) = Chr(13) Then txtAllergies = Left$(txtAllergies, Len(txtAllergies) - 1)
        d.Add "allergies", txtAllergies

        d.Add "ddx", Replace(Split(oTable.Cell(4, 2).Range.Text, vbCr)(0), "DDx: ", "")

        txtPain = Replace(Split(oTable.Cell(4, 3).Range.Text, Chr(7))(0), "Pain: ", "")
        If Right$(txtPain, 1) = Chr(13) Then txtPain = Left$(txtPain, Len(txtPain) - 1)
        d.Add "pain", txtPain

        txtPPx = Replace(Split(oTable.Cell(5, 1).Range.Text, Chr(7))(0), "PPx: ", "")
        If Right$(txtPPx, 1) = Chr(13) Then txtPPx = Left$(txtPPx, Len(txtPPx) - 1)
        d.Add "ppx", txtPPx

        d.Add "labs", Replace(Split(oTable.Cell(5, 2).Range.Text, vbCr)(0), "- ", "")
        d.Add "imaging", Replace(Split(oTable.Cell(6, 2).Range.Text, vbCr)(0), "- ", "")
        d.Add "procedures", Replace(Split(oTable.Cell(7, 2).Range.Text, vbCr)(0), "- ", "")
    
        chkmks = UBound(Split(oTable.Cell(5, 3).Range.Text, ChrW(&H2611)))
        If chkmks = 2 Then
            d.Add "anticoag", True
            d.Add "insulin", True
        ElseIf chkmks = 1 Then
            chk = Replace(Split(oTable.Cell(5, 3).Range.Text, vbCr)(0), ChrW(&H2611) & " ", "")
            If chk = "Anticoagulated" Then
                d.Add "anticoag", True
                d.Add "insulin", False
            Else
                d.Add "anticoag", False
                d.Add "insulin", True
            End If
        Else
            d.Add "anticoag", False
            d.Add "insulin", False
        End If
        
        d.Add "dispo", Replace(Split(oTable.Cell(oTable.Rows.Count, 1).Range.Text, vbCr)(0), "Dispo: ", "")
        
        'd.Add "timestamp", Split(oTable.Cell(oTable.Rows.Count, 2).Range.Text, vbCr)(0)
        'd.Add "username", "   "
        
        raw = Split(oTable.Cell(oTable.Rows.Count, 2).Range.Text, vbCr)(0)
        dt = Mid(raw, 1, InStr(raw, " (") - 1)
        ini = Mid(raw, InStr(raw, " (") + 2, 3)
        d.Add "timestamp", dt
        d.Add "username", ini

        coll.Add d, bmk
        
    Next i


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ADD

    If fx = "ADD" Then
        'MsgBox "ADD"
        bmk = ufAddPatient.cboResident.Text & "_" & ufAddPatient.txtRoom.Text

        Set d = CreateObject("Scripting.Dictionary")
        
        d.Add "bmk", bmk
        d.Add "room", ufAddPatient.txtRoom.Text
        d.Add "first", ufAddPatient.txtFirst.Text
        d.Add "last", ufAddPatient.txtLast.Text
        
        If ufAddPatient.optMale.Value Then
            d.Add "gender", "M"
        Else
            d.Add "gender", "F"
        End If
        
        d.Add "dob", ufAddPatient.txtDOB.Text
        d.Add "admit", ufAddPatient.txtAdmit.Text
        d.Add "resident", ufAddPatient.cboResident.Text
        d.Add "code", ufAddPatient.cboCode.Text
        d.Add "mrn", ufAddPatient.txtMRN.Text
        d.Add "meds", Trim(ufAddPatient.txtMeds.Text)
        d.Add "hpi", ufAddPatient.txtHPI.Text
        d.Add "fu", ufAddPatient.txtFU.Text
        d.Add "allergies", ufAddPatient.txtAllergies.Text
        d.Add "ddx", ufAddPatient.txtDDx.Text
        d.Add "pain", ufAddPatient.txtPain.Text
        d.Add "ppx", ufAddPatient.txtPPx.Text
        d.Add "labs", ufAddPatient.txtLabs.Text
        d.Add "anticoag", ufAddPatient.chkAnticoag.Value
        d.Add "insulin", ufAddPatient.chkInsulin.Value
        d.Add "imaging", ufAddPatient.txtImaging.Text
        d.Add "procedures", ufAddPatient.txtProcedures.Text
        d.Add "dispo", ufAddPatient.txtDispo.Text
        d.Add "timestamp", Now()
        
        usr = Environ$("Username")
        d.Add "username", UCase(Right(usr, 2) & Left(usr, 1))
        

        coll.Add d, bmk
    
        Unload ufAdd
        'Unload ufAddPatient
    End If

    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' MODIFY

    If fx = "MOD" Then
        
        n = n + 1

        ufBmk = ufModPatient.cboResident.Text & "_" & ufModPatient.txtRoom.Text

        If coll(modBmk).Item("bmk") = ufBmk Then

            coll(modBmk).Item("bmk") = ufModPatient.cboResident.Text & "_" & ufModPatient.txtRoom.Text
            coll(modBmk).Item("room") = ufModPatient.txtRoom.Text
            coll(modBmk).Item("first") = ufModPatient.txtFirst.Text
            coll(modBmk).Item("last") = ufModPatient.txtLast.Text
            If ufModPatient.optMale.Value Then
                coll(modBmk).Item("gender") = "M"
            Else
                coll(modBmk).Item("gender") = "F"
            End If
            coll(modBmk).Item("dob") = ufModPatient.txtDOB.Text
            coll(modBmk).Item("admit") = ufModPatient.txtAdmit.Text
            coll(modBmk).Item("resident") = ufModPatient.cboResident.Text
            coll(modBmk).Item("code") = ufModPatient.cboCode.Text
            coll(modBmk).Item("mrn") = ufModPatient.txtMRN.Text
            coll(modBmk).Item("meds") = ufModPatient.txtMeds.Text
            coll(modBmk).Item("hpi") = ufModPatient.txtHPI.Text
            coll(modBmk).Item("fu") = ufModPatient.txtFU.Text
            coll(modBmk).Item("allergies") = ufModPatient.txtAllergies.Text
            coll(modBmk).Item("ddx") = ufModPatient.txtDDx.Text
            coll(modBmk).Item("pain") = ufModPatient.txtPain.Text
            coll(modBmk).Item("ppx") = ufModPatient.txtPPx.Text
            coll(modBmk).Item("labs") = ufModPatient.txtLabs.Text
            coll(modBmk).Item("anticoag") = ufModPatient.chkAnticoag.Value
            coll(modBmk).Item("insulin") = ufModPatient.chkInsulin.Value
            coll(modBmk).Item("imaging") = ufModPatient.txtImaging.Text
            coll(modBmk).Item("procedures") = ufModPatient.txtProcedures.Text
            coll(modBmk).Item("dispo") = ufModPatient.txtDispo.Text
            coll(modBmk).Item("timestamp") = vTimestamp
            
            usr = Environ$("Username")
            coll(modBmk).Item("username") = UCase(Right(usr, 2) & Left(usr, 1))

        Else

            coll.Remove modBmk

            Set d = CreateObject("Scripting.Dictionary")
            
            d.Add "bmk", ufBmk
            d.Add "room", ufModPatient.txtRoom.Text
            d.Add "first", ufModPatient.txtFirst.Text
            d.Add "last", ufModPatient.txtLast.Text
            If ufModPatient.optMale.Value Then
                d.Add "gender", "M"
            Else
                d.Add "gender", "F"
            End If
            d.Add "dob", ufModPatient.txtDOB.Text
            d.Add "admit", ufModPatient.txtAdmit.Text
            d.Add "resident", ufModPatient.cboResident.Text
            d.Add "code", ufModPatient.cboCode.Text
            d.Add "mrn", ufModPatient.txtMRN.Text
            d.Add "meds", ufModPatient.txtMeds.Text
            d.Add "hpi", ufModPatient.txtHPI.Text
            d.Add "fu", ufModPatient.txtFU.Text
            d.Add "allergies", ufModPatient.txtAllergies.Text
            d.Add "ddx", ufModPatient.txtDDx.Text
            d.Add "pain", ufModPatient.txtPain.Text
            d.Add "ppx", ufModPatient.txtPPx.Text
            d.Add "labs", ufModPatient.txtLabs.Text
            d.Add "anticoag", ufModPatient.chkAnticoag.Value
            d.Add "insulin", ufModPatient.chkInsulin.Value
            d.Add "imaging", ufModPatient.txtImaging.Text
            d.Add "procedures", ufModPatient.txtProcedures.Text
            d.Add "dispo", ufModPatient.txtDispo.Text
            d.Add "timestamp", vTimestamp

            usr = Environ$("Username")
            d.Add "username", UCase(Right(usr, 2) & Left(usr, 1))

            coll.Add d, ufBmk

        End If

        modBmk = vbNullString
        vTimestamp = vbNullString

        Unload ufMod

    End If

    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' DELETE

    If fx = "DEL" Then
        coll.Remove sort
        n = n - 1
    End If

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SORT

    If n <> 0 Then
        Dim temp

        If sort = "ROOM" Then
            For i = 1 To coll.Count - 1
                For j = i + 1 To coll.Count
                    
                    If coll(i).Item("room") > coll(j).Item("room") Then
                        Set temp = CreateObject("Scripting.Dictionary")

                        For Each k In coll(j).keys
                            temp.Add k, coll(j)(k)
                        Next

                        For Each k In coll(i).keys
                            coll(j).Item(k) = coll(i)(k)
                        Next
                             
                        For Each k In temp.keys
                            coll(i).Item(k) = temp(k)
                        Next
                        
                    End If
                    
                Next j
            Next i
        
        ElseIf sort = "RESIDENT" Then
    
            For i = 1 To coll.Count - 1
                For j = i + 1 To coll.Count
                
                    If UCase(coll(i).Item("resident")) > UCase(coll(j).Item("resident")) Then
                        Set temp = CreateObject("Scripting.Dictionary")

                        For Each k In coll(j).keys
                            temp.Add k, coll(j)(k)
                        Next

                        For Each k In coll(i).keys
                            coll(j).Item(k) = coll(i)(k)
                        Next
                             
                        For Each k In temp.keys
                            coll(i).Item(k) = temp(k)
                        Next
                    End If
                    
                Next j
            Next i
        
        Else
        
            For i = 1 To coll.Count - 1
                For j = i + 1 To coll.Count
                    
                    If coll(i).Item("room") > coll(j).Item("room") Then
                        Set temp = CreateObject("Scripting.Dictionary")

                        For Each k In coll(j).keys
                            temp.Add k, coll(j)(k)
                        Next

                        For Each k In coll(i).keys
                            coll(j).Item(k) = coll(i)(k)
                        Next
                             
                        For Each k In temp.keys
                            coll(i).Item(k) = temp(k)
                        Next
                        
                    End If
                    
                Next j
            Next i

        End If 'end sort
        
    End If 'end if bmk 0

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' DRAW


    '''''''''''''''''''''''''''''''''''''''
    ' TURN OFF READ ONLY & SCREEN UPDATING
    
    If oDoc.ProtectionType <> wdNoProtection Then
        oDoc.Unprotect
    End If
    Application.ScreenUpdating = False
    ActiveWindow.DisplayVerticalScrollBar = True


    '''''''''''''''''''''''
    ' DELETE PRIOR ENTRIES
    
    'Dim oBookmark As Bookmark
    'For Each oBookmark In oDoc.Bookmarks
    '    oBookmark.Range.Tables(1).Delete
    'Next
    oDoc.StoryRanges(wdMainTextStory).Delete


    '''''''''''''''''
    ' INSERT ENTRIES

    For Each d In coll

        Set oTable = oDoc.Tables.Add(Range:=Selection.Range, NumRows:=6, NumColumns:=1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
        
        oTable.Range.Bookmarks.Add d.Item("bmk")
        
        'MsgBox d.Item("bmk")
        
        With oTable
            .Range.Font.Name = "Courier New"
            .Range.Font.Size = 7
            .Range.Paragraphs.LeftIndent = InchesToPoints(0)
            .Range.Paragraphs.RightIndent = InchesToPoints(0)
            .Range.ParagraphFormat.SpaceAfter = 0
            .Range.ParagraphFormat.SpaceBefore = 0
        
            .Borders.InsideLineStyle = wdLineStyleNone
            .Borders.OutsideLineStyle = wdLineStyleNone
            
            .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
            .Borders(wdBorderBottom).LineWidth = wdLineWidth150pt
            
            .Range.Paragraphs.KeepWithNext = True
            
            
            ''''''''''''''''''''''''''''''''''''''
            ' SET ROW HEIGHT
            
            .Rows.Height = 11
            
            
            ''''''''''''''''''''''''''''''''''''''
            ' SET CELL WIDTH
            
            w = .Rows(1).Cells(1).Width


            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' ROW 1
            
            .Rows(1).Cells(1).Split 1, 3
            .Rows(1).Cells(1).Width = (w / 10) * 1
            .Rows(1).Cells(2).Width = (w / 10) * 5
            .Rows(1).Cells(3).Width = (w / 10) * 4
            
            
            ''''''''''''''''''''''''''''''''''''''
            ' ROOM, PATIENT NAME, ADMIT DATE
            
            .Rows(1).Cells(1).Range.Text = d.Item("room")
            .Rows(1).Cells(2).Range.Text = d.Item("last") & ", " & d.Item("first") & " " & DateDiff("yyyy", d.Item("dob"), Now()) + Int(Format(Now(), "mmdd") < Format(d.Item("dob"), "mmdd")) & "yo " & d.Item("gender") & " (DOB: " & d.Item("dob") & ")" & " (MRN: " & d.Item("mrn") & ")"
            .Rows(1).Cells(3).Range.Text = "Admit: " & d.Item("admit") & " (" & DateDiff("d", d.Item("admit"), Now) & ")"
            
            .Rows(1).Cells(1).Range.Font.Bold = True
            .Rows(1).Cells(3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
            
            
            
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' ROW 2
            
            .Rows(2).Cells(1).Split 1, 3
            .Rows(2).Cells(1).Width = (w / 10) * 1
            .Rows(2).Cells(2).Width = (w / 10) * 5
            .Rows(2).Cells(3).Width = (w / 10) * 4
            
            
            ''''''''''''''''''''''''''''''''''''''
            ' RESIDENT, CODE STATUS
            
            .Rows(2).Cells(2).Range.Text = d.Item("resident")
            .Rows(2).Cells(3).Range.Text = d.Item("code")
            
            .Rows(2).Cells(3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
            
            

            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' ROW 3
            
            .Rows(3).Cells(1).Split 1, 3
            .Rows(3).Cells(1).Width = (w / 10) * 2
            .Rows(3).Cells(2).Width = (w / 10) * 6
            .Rows(3).Cells(3).Width = (w / 10) * 2
            
            ''''''''''''''''''''''''''''''''''''''
            ' MEDICATION, HPI, FOLLOW UP
            
            If d.Item("meds") <> "" Then
                .Rows(3).Cells(1).Range.Text = d.Item("meds")
            Else
                .Rows(3).Cells(1).Range.Text = "Rx: "
            End If
            .Rows(3).Cells(2).Range.Text = d.Item("hpi")

            If d.Item("fu") <> "" Then
                arr = Split(d.Item("fu"), vbCr)
                Dim sArr() As String
                ReDim sArr(UBound(arr))
                For x = 0 To UBound(arr)
                    fuS = Trim(Replace(arr(x), vbLf, ""))
                    If fuS = "" Then
                        sArr(x) = ""
                    Else
                        sArr(x) = ChrW(&H2610) & " " & Trim(Replace(arr(x), vbLf, ""))
                    End If
                    
                Next x
                .Rows(3).Cells(3).Range.Text = Join(sArr, vbCrLf)
            Else
                .Rows(3).Cells(3).Range.Text = "F/U: "
            End If
            '.Rows(3).Cells(3).Range.Text = "F/U: " & d.Item("fu")
            
            
            
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' ROW 4
                
            .Rows(4).Cells(1).Split 1, 3
            .Rows(4).Cells(1).Width = (w / 10) * 2
            .Rows(4).Cells(2).Width = (w / 10) * 6
            .Rows(4).Cells(3).Width = (w / 10) * 2

            If d.Item("allergies") <> "" Then
                .Rows(4).Cells(1).VerticalAlignment = wdCellAlignVerticalCenter
                .Rows(4).Cells(1).Range.Text = "Allergies: " & d.Item("allergies")
            Else
                .Rows(4).Cells(1).Range.Text = ""
            End If

            .Rows(4).Cells(2).Height = 14
            .Rows(4).Cells(2).VerticalAlignment = wdCellAlignVerticalCenter
            .Rows(4).Cells(2).Range.Text = "DDx: " & d.Item("ddx")

            If d.Item("pain") <> "" Then
                .Rows(4).Cells(3).VerticalAlignment = wdCellAlignVerticalCenter
                .Rows(4).Cells(3).Range.Text = "Pain: " & d.Item("pain")
            Else
                .Rows(4).Cells(3).Range.Text = ""
            End If
            
            
            
            
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' ROW 5
            
            .Rows(5).Cells(1).Split 1, 3
            .Rows(5).Cells(1).Width = (w / 10) * 2
            .Rows(5).Cells(2).Width = (w / 10) * 6
            .Rows(5).Cells(3).Width = (w / 10) * 2
            
            
            
            .Rows(5).Cells(2).Split 3, 1

            If d.Item("labs") <> "" Then
                .Range.Cells(14).Height = 14
                .Range.Cells(14).VerticalAlignment = wdCellAlignVerticalCenter
                .Range.Cells(14).Range.Text = "- " & d.Item("labs")
            Else
                .Range.Cells(14).Height = 0
                .Range.Cells(14).Range.Text = ""
            End If

            If d.Item("imaging") <> "" Then
                .Range.Cells(16).Height = 14
                .Range.Cells(16).VerticalAlignment = wdCellAlignVerticalCenter
                .Range.Cells(16).Range.Text = "- " & d.Item("imaging")
            Else
                .Range.Cells(16).Height = 0
                .Range.Cells(16).Range.Text = ""
            End If

            If d.Item("procedures") <> "" Then
                .Range.Cells(17).Height = 14
                .Range.Cells(17).VerticalAlignment = wdCellAlignVerticalCenter
                .Range.Cells(17).Range.Text = "- " & d.Item("procedures")
            Else
                .Range.Cells(17).Height = 0
                .Range.Cells(17).Range.Text = ""
            End If



'            If d.Item("labs") = "" And d.Item("imaging") = "" And d.Item("procedures") = "" Then
'
'            ElseIf d.Item("labs") = "" And d.Item("imaging") = "" Then
'                .Rows(5).Cells(2).Split 1, 1
'                .Range.Cells(14).Range.Text = "Procedures: " & d.Item("procedures")
'
'            ElseIf d.Item("imaging") = "" And d.Item("procedures") = "" Then
'                .Rows(5).Cells(2).Split 1, 1
'                .Range.Cells(14).Range.Text = "Labs: " & d.Item("labs")
'
'                MsgBox d.Item("labs"), vbOKOnly, "INSERT LABS " & d.Item("room")
'
'            ElseIf d.Item("labs") = "" And d.Item("procedures") = "" Then
'                .Rows(5).Cells(2).Split 1, 1
'                .Range.Cells(14).Range.Text = "Imaging: " & d.Item("imaging")
'
'            ElseIf d.Item("labs") = "" Then
'                .Rows(5).Cells(2).Split 2, 1
'                .Range.Cells(14).Range.Text = "Imaging: " & d.Item("imaging")
'                .Range.Cells(16).Range.Text = "Procedures: " & d.Item("procedures")
'
'            ElseIf d.Item("imaging") = "" Then
'                .Rows(5).Cells(2).Split 2, 1
'                .Range.Cells(14).Range.Text = "Labs: " & d.Item("labs")
'                .Range.Cells(16).Range.Text = "Procedures: " & d.Item("procedures")
'
'            ElseIf d.Item("procedures") = "" Then
'                .Rows(5).Cells(2).Split 2, 1
'                .Range.Cells(14).Range.Text = "Labs: " & d.Item("labs")
'                .Range.Cells(16).Range.Text = "Imaging: " & d.Item("imaging")
'
'            Else
'                .Rows(5).Cells(2).Split 3, 1
'                .Range.Cells(14).Range.Text = "Labs: " & d.Item("labs")
'                .Range.Cells(16).Range.Text = "Imaging: " & d.Item("imaging")
'                .Range.Cells(17).Range.Text = "Procedures: " & d.Item("procedures")
'            End If
            
            
            If d.Item("ppx") <> "" Then
                .Range.Cells(13).Range.Text = "PPx: " & d.Item("ppx")
            Else
                .Range.Cells(13).Range.Text = ""
            End If
            
            If d.Item("anticoag") And d.Item("insulin") Then
                .Range.Cells(15).Range.Text = ChrW(&H2611) & " Anticoagulated" & vbCrLf & ChrW(&H2611) & " Insulin"
            ElseIf d.Item("anticoag") Then
                .Range.Cells(15).Range.Text = ChrW(&H2611) & " Anticoagulated"
            ElseIf d.Item("insulin") Then
                .Range.Cells(15).Range.Text = ChrW(&H2611) & " Insulin"
            End If
            
            
            
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' ROW 6
            
            tCell = .Range.Cells.Count
            
            .Range.Cells(tCell).Height = 16
            .Range.Cells(tCell).Split 1, 2
            .Range.Cells(tCell).Width = (w / 10) * 7
            .Range.Cells(tCell + 1).Width = (w / 10) * 3
            
            .Range.Cells(tCell).Range.Text = "Dispo: " & d.Item("dispo")
            
            .Range.Cells(tCell + 1).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
            
            .Range.Cells(tCell + 1).Range.Text = d.Item("timestamp") & " (" & d.Item("username") & ")"
            
            
            ''''''''''''''''''''''''''''''''''''''
            ' SPACING
            
            '.Range.Cells(tCell + 1).Select
            'Selection.MoveDown Unit:=wdLine, Count:=1
            'Selection.InsertParagraph
            'Selection.EndKey Unit:=wdStory
            With Selection
                .MoveDown Unit:=wdLine, Count:=1
                .EndKey Unit:=wdStory
                .Collapse Direction:=wdCollapseStart
                .InsertParagraph
                .Collapse Direction:=wdCollapseEnd
                .EndKey Unit:=wdStory
            End With
            
        End With
    Next d
    Set coll = Nothing

    ActiveDocument.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True
    docHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
    oldHeader = docHeader.Tables(1).Delete

    Set headerTable = ActiveDocument.Tables.Add(Range:=docHeader, NumRows:=1, NumColumns:=1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
    With headerTable
    
        '.Rows.Height = 14
        
        .Borders.InsideLineStyle = wdLineStyleNone
        .Borders.OutsideLineStyle = wdLineStyleNone

        w = .Rows(1).Cells(1).Width
        .Rows(1).Cells(1).Split 1, 2
        .Rows(1).Cells(1).Width = (w / 10) * 8
        .Rows(1).Cells(2).Width = (w / 10) * 2

        .Rows(1).Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
        .Rows(1).Cells(2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight

        .Rows(1).Cells(1).Range.Text = "Total (" & n & "), " & residentTotals()
        .Rows(1).Cells(2).Range.Text = Format(Now, "dddd, mmmm d, yyyy")
    End With
    ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = Format(Now, "dddd, mmmm d, yyyy")

    ''''''''''''''''''''
    ' TURN ON READ ONLY

    Selection.HomeKey Unit:=wdStory
    oDoc.Protect wdAllowOnlyReading
    SaveToRelativePath
    Call StartClock
    
Done:
    Exit Sub
    
eh:
    pathName = ActiveDocument.FullName
    onlyName = Mid(pathName, InStrRev(pathName, "\") + 1, InStrRev(pathName, "--") - InStrRev(pathName, "\") - 1)
    ext = Right(pathName, Len(pathName) - InStrRev(pathName, "."))
    compName = Mid(pathName, InStrRev(pathName, "\") + 1, InStrRev(pathName, ".") - InStrRev(pathName, "\") - 1)
    fileDate = Right(compName, Len(compName) - InStrRev(compName, "--") - 1)
    
    rPath = ThisDocument.Path & "\" & onlyName & "--" & fileDate & "." & ext
    aPath = ThisDocument.Path & "\ARCHIVE\BACKUP\" & onlyName & "--" & fileDate & "." & ext
    
    Dim fso As Object
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    Call fso.CopyFile(rPath, aPath)
    
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Debug.Print "Error " & Err.Number & ": " & Err.Description
    
    procName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    Debug.Print "Error " & Err.Number & ": " & Err.Description & " in module " & VBE.ActiveCodePane.CodeModule & " sub " & procName & "()"
    MsgBox "Error " & Err.Number & ": " & Err.Description & " in module " & VBE.ActiveCodePane.CodeModule & ", sub " & procName & "()", vbOKOnly, "Error"
    
    
End Sub
Public Function residentTotals()
    Dim n As Integer
    n = ActiveDocument.Bookmarks.Count
    Dim bmkArray()
    ReDim bmkArray(1 To n)

    For i = 1 To n
        nameSplit = Split(ActiveDocument.Bookmarks(i).Name, "_")
        bmkArray(i) = nameSplit(0)
    Next

    Dim arr As New Collection, a
    On Error Resume Next
    For Each a In bmkArray
        arr.Add a, a
    Next

    Dim resTotals()
    ReDim resTotals(1 To arr.Count)
    For j = 1 To arr.Count
        cnt = UBound(Filter(bmkArray, arr(j), True, 1)) + 1
        resTotals(j) = arr(j) & " (" & cnt & ")"
    Next

    residentTotals = Join(resTotals, ", ")
End Function