Last active
January 19, 2018 17:14
-
-
Save DrLulz/1e740d882a7b2e38c6b1a65083bb5419 to your computer and use it in GitHub Desktop.
SignOut
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub add() | |
| Dim a() | |
| a = memory() | |
| Dim n As Integer | |
| n = ActiveDocument.Bookmarks.Count | |
| If n = 0 Then | |
| n = 1 | |
| ReDim a(1) | |
| Else | |
| n = n + 1 | |
| ReDim Preserve a(1 To n) | |
| End If | |
| Set a(n) = CreateObject("Scripting.Dictionary") | |
| a(n).add "bmk", ufAddPatient.cboResident.Text & "_" & ufAddPatient.txtRoom.Text | |
| a(n).add "room", ufAddPatient.txtRoom.Text | |
| a(n).add "first", ufAddPatient.txtFirst.Text | |
| a(n).add "last", ufAddPatient.txtLast.Text | |
| If ufAddPatient.optMale.Value Then | |
| a(n).add "gender", "M" | |
| Else | |
| a(n).add "gender", "F" | |
| End If | |
| a(n).add "dob", ufAddPatient.txtDOB.Text | |
| a(n).add "admit", ufAddPatient.txtAdmit.Text | |
| a(n).add "resident", ufAddPatient.cboResident.Text | |
| a(n).add "code", ufAddPatient.cboCode.Text | |
| a(n).add "mrn", ufAddPatient.txtMRN.Text | |
| a(n).add "meds", ufAddPatient.txtMeds.Text | |
| a(n).add "hpi", ufAddPatient.txtHPI.Text | |
| a(n).add "fu", ufAddPatient.txtFU.Text | |
| a(n).add "allergies", ufAddPatient.txtAllergies.Text | |
| a(n).add "ddx", ufAddPatient.txtDDx.Text | |
| a(n).add "pain", ufAddPatient.txtPain.Text | |
| a(n).add "ppx", ufAddPatient.txtPPx.Text | |
| a(n).add "labs", ufAddPatient.txtLabs.Text | |
| a(n).add "anticoag", ufAddPatient.chkAnticoag.Value | |
| a(n).add "insulin", ufAddPatient.chkInsulin.Value | |
| a(n).add "imaging", ufAddPatient.txtImaging.Text | |
| a(n).add "procedures", ufAddPatient.txtProcedures.Text | |
| a(n).add "dispo", ufAddPatient.txtDispo.Text | |
| a(n).add "timestamp", Now() | |
| 'Unload ufAddPatient | |
| Call reDraw(a, False) | |
| End Sub |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub del(usrSel As String) | |
| 'On Error GoTo ErrorHandler | |
| Dim a() | |
| a = memory() | |
| Dim n_bmks As Integer | |
| n_bmks = ActiveDocument.Bookmarks.Count | |
| Dim result() | |
| If n_bmks = 1 Then | |
| ReDim result(0) | |
| Else | |
| ReDim result(1 To (UBound(a) - 1)) | |
| n = 1 | |
| For i = 1 To UBound(a) | |
| If a(i).Item("bmk") <> usrSel Then | |
| Set result(n) = CreateObject("Scripting.Dictionary") | |
| For Each k In a(i).keys | |
| result(n).add k, a(i)(k) | |
| Next | |
| n = n + 1 | |
| End If | |
| Next i | |
| End If | |
| Call reDraw(result, False) | |
| 'ErrorHandler: | |
| ' ActiveDocument.Unprotect | |
| ' ActiveDocument.StoryRanges(wdMainTextStory).Delete | |
| ' ActiveDocument.Protect wdAllowOnlyReading | |
| ' Exit Sub | |
| End Sub |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Public dict As Object | |
| Public modBmk As String | |
| Public vTimestamp As String | |
| Public Function residentArray() | |
| Dim residents As Variant | |
| Dim x As Long, y As Long | |
| Dim TempTxt1 As String | |
| Dim TempTxt2 As String | |
| residents = Array("PGuilford", "TGuilford", "White", "Buckner", "Carlson", "Nguyen", "Varbanoff", "Beavers", "Dockery", "Kirk", "Smith", "Bowling", "Edwards", "Facelo", "McGee") | |
| For x = LBound(residents) To UBound(residents) | |
| For y = x To UBound(residents) | |
| If UCase(residents(y)) < UCase(residents(x)) Then | |
| TempTxt1 = residents(x) | |
| TempTxt2 = residents(y) | |
| residents(x) = TempTxt2 | |
| residents(y) = TempTxt1 | |
| End If | |
| Next y | |
| Next x | |
| residentArray = residents | |
| End Function | |
| Public Function codeArray() | |
| codeArray = Array("Full Code", "DNR/DNI", "DNR", "DNI") | |
| End Function |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Function memory() As Variant() | |
| Dim oDoc As Document | |
| Set oDoc = ActiveDocument | |
| Dim n_bmks As Integer | |
| n_bmks = oDoc.Bookmarks.Count | |
| Dim dArray() | |
| If n_bmks = 0 Then | |
| ReDim dArray(1) | |
| Else | |
| ReDim dArray(1 To n_bmks) | |
| End If | |
| 'https://www.experts-exchange.com/questions/23673265/Creating-an-Array-of-Dictionary-Objects.html | |
| For n = 1 To n_bmks | |
| bmk = oDoc.Bookmarks(n).Name | |
| Set dArray(n) = CreateObject("Scripting.Dictionary") | |
| dArray(n).add "bmk", bmk | |
| Set oTable = oDoc.Bookmarks(bmk).Range.Tables(1) | |
| dArray(n).add "room", Split(oTable.Cell(1, 1).Range.Text, vbCr)(0) | |
| nameDOB = Split(oTable.Cell(1, 2).Range.Text, vbCr)(0) | |
| dArray(n).add "first", Split(nameDOB, ",")(0) | |
| lastGenderDOB = Split(nameDOB, ",")(1) | |
| dArray(n).add "last", Split(lastGenderDOB, " ")(1) | |
| dArray(n).add "gender", Split(lastGenderDOB, " ")(3) | |
| dArray(n).add "dob", Replace(Left(Split(lastGenderDOB, " ")(5), 10), ")", "") | |
| dArray(n).add "mrn", Replace(Left(Split(lastGenderDOB, " ")(7), 10), ")", "") | |
| dArray(n).add "admit", Split(oTable.Cell(1, 3).Range.Text, " ")(1) | |
| dArray(n).add "resident", Split(oTable.Cell(2, 2).Range.Text, vbCr)(0) | |
| dArray(n).add "code", Split(oTable.Cell(2, 3).Range.Text, vbCr)(0) | |
| dArray(n).add "meds", Replace(Split(oTable.Cell(3, 1).Range.Text, vbCr)(0), "Rx: ", "") | |
| dArray(n).add "hpi", Split(oTable.Cell(3, 2).Range.Text, vbCr)(0) | |
| dArray(n).add "fu", Replace(Split(oTable.Cell(3, 3).Range.Text, vbCr)(0), "F/U: ", "") | |
| dArray(n).add "allergies", Replace(Split(oTable.Cell(4, 1).Range.Text, vbCr)(0), "Allergies: ", "") | |
| dArray(n).add "ddx", Replace(Split(oTable.Cell(4, 2).Range.Text, vbCr)(0), "DDx: ", "") | |
| dArray(n).add "pain", Replace(Split(oTable.Cell(4, 3).Range.Text, vbCr)(0), "Pain: ", "") | |
| dArray(n).add "ppx", Replace(Split(oTable.Cell(5, 1).Range.Text, vbCr)(0), "PPx: ", "") | |
| With oTable | |
| For r = 5 To .Rows.Count | |
| For c = 1 To .Columns.Count | |
| On Error Resume Next | |
| If InStrRev(.Cell(r, c).Range.Text, "Labs: ") = 1 Then | |
| dArray(n).add "labs", Replace(Split(.Cell(r, c).Range.Text, vbCr)(0), "Labs: ", "") | |
| End If | |
| If InStrRev(.Cell(r, c).Range.Text, "Imaging: ") = 1 Then | |
| dArray(n).add "imaging", Replace(Split(.Cell(r, c).Range.Text, vbCr)(0), "Imaging: ", "") | |
| End If | |
| If InStrRev(.Cell(r, c).Range.Text, "Procedures: ") = 1 Then | |
| dArray(n).add "procedures", Replace(Split(.Cell(r, c).Range.Text, vbCr)(0), "Procedures: ", "") | |
| End If | |
| Next c | |
| Next r | |
| End With | |
| chkmks = UBound(Split(oTable.Cell(5, 3).Range.Text, ChrW(&H2611))) | |
| If chkmks = 2 Then | |
| dArray(n).add "anticoag", True | |
| dArray(n).add "insulin", True | |
| ElseIf chkmks = 1 Then | |
| chk = Replace(Split(oTable.Cell(5, 3).Range.Text, vbCr)(0), ChrW(&H2611) & " ", "") | |
| If chk = "Anticoagulated" Then | |
| dArray(n).add "anticoag", True | |
| dArray(n).add "insulin", False | |
| Else | |
| dArray(n).add "anticoag", False | |
| dArray(n).add "insulin", True | |
| End If | |
| Else | |
| dArray(n).add "anticoag", False | |
| dArray(n).add "insulin", False | |
| End If | |
| dArray(n).add "dispo", Replace(Split(oTable.Cell(oTable.Rows.Count, 1).Range.Text, vbCr)(0), "Dispo: ", "") | |
| dArray(n).add "timestamp", Split(oTable.Cell(oTable.Rows.Count, 2).Range.Text, vbCr)(0) | |
| Next n | |
| 'For i = 1 To UBound(dArray) | |
| 'MsgBox dArray(i).Item("bmk"), vbOKOnly, "Bookmark" | |
| 'MsgBox dArray(i).Item("room"), vbOKOnly, "Room Number" | |
| 'MsgBox dArray(i).Item("first"), vbOKOnly, "First Name" | |
| 'MsgBox dArray(i).Item("last"), vbOKOnly, "Last Name" | |
| 'MsgBox dArray(i).Item("gender"), vbOKOnly, "Gender" | |
| 'MsgBox dArray(i).Item("dob"), vbOKOnly, "DOB" | |
| 'MsgBox dArray(i).Item("admit"), vbOKOnly, "Admit Date" | |
| 'MsgBox dArray(i).Item("resident"), vbOKOnly, "Resident" | |
| 'MsgBox dArray(i).Item("code"), vbOKOnly, "Code Status" | |
| 'MsgBox dArray(i).Item("meds"), vbOKOnly, "Medication" | |
| 'MsgBox dArray(i).Item("hpi"), vbOKOnly, "HPI" | |
| 'MsgBox dArray(i).Item("fu"), vbOKOnly, "Follow Up" | |
| 'MsgBox dArray(i).Item("allergies"), vbOKOnly, "Allergies" | |
| 'MsgBox dArray(i).Item("ddx"), vbOKOnly, "Differential" | |
| 'MsgBox dArray(i).Item("pain"), vbOKOnly, "Pain" | |
| 'MsgBox dArray(i).Item("ppx"), vbOKOnly, "PPx" | |
| 'MsgBox dArray(i).Item("labs"), vbOKOnly, "Labs" | |
| 'MsgBox dArray(i).Item("anticoag"), vbOKOnly, "Anticoagulation" | |
| 'MsgBox dArray(i).Item("insulin"), vbOKOnly, "Insulin" | |
| 'MsgBox dArray(i).Item("imaging"), vbOKOnly, "Imaging" | |
| 'MsgBox dArray(i).Item("procedures"), vbOKOnly, "Procedures" | |
| 'MsgBox dArray(i).Item("dispo"), vbOKOnly, "Disposition" | |
| 'MsgBox dArray(i).Item("timestamp"), vbOKOnly, "Time Stamp" | |
| 'Next | |
| memory = dArray | |
| End Function |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub modify() | |
| Dim a() | |
| a = memory() | |
| For i = 1 To UBound(a) | |
| If a(i).Item("bmk") = modBmk Then | |
| a(i).Item("bmk") = ufModPatient.cboResident.Text & "_" & ufModPatient.txtRoom.Text | |
| a(i).Item("room") = ufModPatient.txtRoom.Text | |
| a(i).Item("first") = ufModPatient.txtFirst.Text | |
| a(i).Item("last") = ufModPatient.txtLast.Text | |
| If ufModPatient.optMale.Value Then | |
| a(i).Item("gender") = "M" | |
| Else | |
| a(i).Item("gender") = "F" | |
| End If | |
| a(i).Item("dob") = ufModPatient.txtDOB.Text | |
| a(i).Item("admit") = ufModPatient.txtAdmit.Text | |
| a(i).Item("resident") = ufModPatient.cboResident.Text | |
| a(i).Item("code") = ufModPatient.cboCode.Text | |
| a(i).Item("mrn") = ufModPatient.txtMRN.Text | |
| a(i).Item("meds") = ufModPatient.txtMeds.Text | |
| a(i).Item("hpi") = ufModPatient.txtHPI.Text | |
| a(i).Item("fu") = ufModPatient.txtFU.Text | |
| a(i).Item("allergies") = ufModPatient.txtAllergies.Text | |
| a(i).Item("ddx") = ufModPatient.txtDDx.Text | |
| a(i).Item("pain") = ufModPatient.txtPain.Text | |
| a(i).Item("ppx") = ufModPatient.txtPPx.Text | |
| a(i).Item("labs") = ufModPatient.txtLabs.Text | |
| a(i).Item("anticoag") = ufModPatient.chkAnticoag.Value | |
| a(i).Item("insulin") = ufModPatient.chkInsulin.Value | |
| a(i).Item("imaging") = ufModPatient.txtImaging.Text | |
| a(i).Item("procedures") = ufModPatient.txtProcedures.Text | |
| a(i).Item("dispo") = ufModPatient.txtDispo.Text | |
| a(i).Item("timestamp") = vTimestamp | |
| End If | |
| Next i | |
| modBmk = vbNullString | |
| vTimestamp = vbNullString | |
| Unload ufModPatient | |
| Call reDraw(a, False) | |
| End Sub | |
| Sub tblDict(usrSel As String) | |
| modBmk = usrSel | |
| Dim oDoc As Document | |
| Set oDoc = ActiveDocument | |
| Set oTable = oDoc.Bookmarks(usrSel).Range.Tables(1) | |
| Set dict = CreateObject("Scripting.Dictionary") | |
| dict.add "room", Split(oTable.Cell(1, 1).Range.Text, vbCr)(0) | |
| nameDOB = Split(oTable.Cell(1, 2).Range.Text, vbCr)(0) | |
| dict.add "first", Split(nameDOB, ",")(0) | |
| lastGenderDOB = Split(nameDOB, ",")(1) | |
| dict.add "last", Split(lastGenderDOB, " ")(1) | |
| dict.add "gender", Split(lastGenderDOB, " ")(3) | |
| dict.add "dob", Replace(Left(Split(lastGenderDOB, " ")(5), 10), ")", "") | |
| dict.add "mrn", Replace(Left(Split(lastGenderDOB, " ")(7), 10), ")", "") | |
| dict.add "admit", Split(oTable.Cell(1, 3).Range.Text, " ")(1) | |
| dict.add "resident", Split(oTable.Cell(2, 2).Range.Text, vbCr)(0) | |
| dict.add "code", Split(oTable.Cell(2, 3).Range.Text, vbCr)(0) | |
| dict.add "meds", Replace(Split(oTable.Cell(3, 1).Range.Text, vbCr)(0), "Rx: ", "") | |
| dict.add "hpi", Split(oTable.Cell(3, 2).Range.Text, vbCr)(0) | |
| dict.add "fu", Replace(Split(oTable.Cell(3, 3).Range.Text, vbCr)(0), "F/U: ", "") | |
| dict.add "allergies", Replace(Split(oTable.Cell(4, 1).Range.Text, vbCr)(0), "Allergies: ", "") | |
| dict.add "ddx", Replace(Split(oTable.Cell(4, 2).Range.Text, vbCr)(0), "DDx: ", "") | |
| dict.add "pain", Replace(Split(oTable.Cell(4, 3).Range.Text, vbCr)(0), "Pain: ", "") | |
| dict.add "ppx", Replace(Split(oTable.Cell(5, 1).Range.Text, vbCr)(0), "PPx: ", "") | |
| With oTable | |
| For r = 5 To .Rows.Count | |
| For c = 1 To .Columns.Count | |
| On Error Resume Next | |
| If InStrRev(.Cell(r, c).Range.Text, "Labs: ") = 1 Then | |
| dict.add "labs", Replace(Split(.Cell(r, c).Range.Text, vbCr)(0), "Labs: ", "") | |
| End If | |
| If InStrRev(.Cell(r, c).Range.Text, "Imaging: ") = 1 Then | |
| dict.add "imaging", Replace(Split(.Cell(r, c).Range.Text, vbCr)(0), "Imaging: ", "") | |
| End If | |
| If InStrRev(.Cell(r, c).Range.Text, "Procedures: ") = 1 Then | |
| dict.add "procedures", Replace(Split(.Cell(r, c).Range.Text, vbCr)(0), "Procedures: ", "") | |
| End If | |
| Next c | |
| Next r | |
| End With | |
| chkmks = UBound(Split(oTable.Cell(5, 3).Range.Text, ChrW(&H2611))) | |
| If chkmks = 2 Then | |
| dict.add "anticoag", True | |
| dict.add "insulin", True | |
| ElseIf chkmks = 1 Then | |
| chk = Replace(Split(oTable.Cell(5, 3).Range.Text, vbCr)(0), ChrW(&H2611) & " ", "") | |
| If chk = "Anticoagulated" Then | |
| dict.add "anticoag", True | |
| dict.add "insulin", False | |
| Else | |
| dict.add "anticoag", False | |
| dict.add "insulin", True | |
| End If | |
| Else | |
| dict.add "anticoag", False | |
| dict.add "insulin", False | |
| End If | |
| dict.add "dispo", Replace(Split(oTable.Cell(oTable.Rows.Count, 1).Range.Text, vbCr)(0), "Dispo: ", "") | |
| dict.add "timestamp", Split(oTable.Cell(oTable.Rows.Count, 2).Range.Text, vbCr)(0) | |
| 'MsgBox dict.Item("room"), vbOKOnly, "Room Number" | |
| 'MsgBox dict.Item("first"), vbOKOnly, "First Name" | |
| 'MsgBox dict.Item("last"), vbOKOnly, "Last Name" | |
| 'MsgBox dict.Item("gender"), vbOKOnly, "Gender" | |
| 'MsgBox dict.Item("dob"), vbOKOnly, "DOB" | |
| 'MsgBox dict.Item("admit"), vbOKOnly, "Admit Date" | |
| 'MsgBox dict.Item("resident"), vbOKOnly, "Resident" | |
| 'MsgBox dict.Item("code"), vbOKOnly, "Code Status" | |
| 'MsgBox dict.Item("meds"), vbOKOnly, "Medication" | |
| 'MsgBox dict.Item("hpi"), vbOKOnly, "HPI" | |
| 'MsgBox dict.Item("fu"), vbOKOnly, "Follow Up" | |
| 'MsgBox dict.Item("allergies"), vbOKOnly, "Allergies" | |
| 'MsgBox dict.Item("ddx"), vbOKOnly, "Differential" | |
| 'MsgBox dict.Item("pain"), vbOKOnly, "Pain" | |
| 'MsgBox dict.Item("ppx"), vbOKOnly, "PPx" | |
| 'MsgBox dict.Item("labs"), vbOKOnly, "Labs" | |
| 'MsgBox dict.Item("anticoag"), vbOKOnly, "Anticoagulation" | |
| 'MsgBox dict.Item("insulin"), vbOKOnly, "Insulin" | |
| 'MsgBox dict.Item("imaging"), vbOKOnly, "Imaging" | |
| 'MsgBox dict.Item("procedures"), vbOKOnly, "Procedures" | |
| 'MsgBox dict.Item("dispo"), vbOKOnly, "Disposition" | |
| 'MsgBox dict.Item("timestamp"), vbOKOnly, "Time Stamp" | |
| ufModPatient.Show | |
| End Sub |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub reDraw(a, res) | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' OBTAIN CURRENT ENTRIES | |
| If ActiveDocument.Bookmarks.Count <> 0 Then | |
| If res Then | |
| residentSort (a) | |
| Else | |
| roomSort (a) | |
| End If | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' TURN ON READ ONLY & SCREEN UPDATING | |
| If ActiveDocument.ProtectionType <> wdNoProtection Then | |
| ActiveDocument.Unprotect | |
| End If | |
| Application.ScreenUpdating = False | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' DELETE PRIOR ENTRIES | |
| Dim oBookmark As Bookmark | |
| For Each oBookmark In ActiveDocument.Bookmarks | |
| oBookmark.Range.Tables(1).Delete | |
| Next | |
| ActiveDocument.StoryRanges(wdMainTextStory).Delete | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' INSERT ENTRIES | |
| For i = 1 To UBound(a) | |
| Set d = a(i) | |
| reInsert d | |
| Next | |
| SaveToRelativePath | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' TURN OFF READ ONLY | |
| ActiveDocument.Protect wdAllowOnlyReading | |
| End Sub | |
| Sub reInsert(d) | |
| Set oTable = ActiveDocument.Tables.add(Range:=Selection.Range, NumRows:=6, NumColumns:=1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed) | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' BOOKMARKS | |
| oTable.Range.Bookmarks.add d.Item("bmk") | |
| With oTable | |
| .Range.Font.Name = "Courier New" | |
| .Range.Font.Size = 8 | |
| .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 = 12 | |
| '''''''''''''''''''''''''''''''''''''' | |
| ' 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("first") & ", " & d.Item("last") & " " & 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 | |
| .Rows(3).Cells(1).Range.Text = "Rx: " & d.Item("meds") | |
| .Rows(3).Cells(2).Range.Text = d.Item("hpi") | |
| .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 | |
| .Rows(4).Cells(1).Range.Text = "Allergies: " & d.Item("allergies") | |
| .Rows(4).Cells(2).Range.Text = "DDx: " & d.Item("ddx") | |
| .Rows(4).Cells(3).Range.Text = "Pain: " & d.Item("pain") | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' 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 | |
| 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") | |
| 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 | |
| .Range.Cells(13).Range.Text = "PPx: " & d.Item("ppx") | |
| 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) * 6 | |
| .Range.Cells(tCell + 1).Width = (w / 10) * 4 | |
| .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") | |
| '''''''''''''''''''''''''''''''''''''' | |
| ' SPACING | |
| .Range.Cells(tCell + 1).Select | |
| Selection.MoveDown Unit:=wdLine, Count:=1 | |
| Selection.InsertParagraph | |
| Selection.EndKey Unit:=wdStory | |
| End With | |
| End Sub | |
| Function roomSort(a) | |
| First = LBound(a) | |
| Last = UBound(a) | |
| For i = First To Last | |
| For j = i + 1 To Last | |
| If a(i).Item("room") > a(j).Item("room") Then | |
| Dim temp | |
| Set temp = CreateObject("Scripting.Dictionary") | |
| For Each k In a(j).keys | |
| temp.add k, a(j)(k) | |
| Next | |
| For Each k In a(i).keys | |
| a(j).Item(k) = a(i)(k) | |
| Next | |
| For Each k In temp.keys | |
| a(i).Item(k) = temp(k) | |
| Next | |
| End If | |
| Next j | |
| Next i | |
| roomSort = a | |
| End Function | |
| Function residentSort(a) | |
| First = LBound(a) | |
| Last = UBound(a) | |
| For i = First To Last | |
| For j = i + 1 To Last | |
| If UCase(a(i).Item("resident")) > UCase(a(j).Item("resident")) Then | |
| Dim temp | |
| Set temp = CreateObject("Scripting.Dictionary") | |
| For Each k In a(j).keys | |
| temp.add k, a(j)(k) | |
| Next | |
| For Each k In a(i).keys | |
| a(j).Item(k) = a(i)(k) | |
| Next | |
| For Each k In temp.keys | |
| a(i).Item(k) = temp(k) | |
| Next | |
| End If | |
| Next j | |
| Next i | |
| residentSort = a | |
| End Function |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub SaveToRelativePath() | |
| Dim rPath As String | |
| 'epoch = DateDiff("S", "1/1/1970", Now()) | |
| 'dateNow = Format(Now(), "yyyy-MM-dd-hhmmss") | |
| dateNow = Format(Now(), "yyyy-MM-dd") | |
| pathName = ActiveDocument.FullName | |
| onlyName = Mid(pathName, InStrRev(pathName, "\") + 1, InStrRev(pathName, "--") - InStrRev(pathName, "\") - 1) | |
| ext = Right(pathName, Len(pathName) - InStrRev(pathName, ".")) | |
| rPath = ThisDocument.Path & "\" & onlyName & "--" & dateNow & "." & ext | |
| ActiveDocument.SaveAs FileName:=rPath | |
| 'compName = Mid(pathName, InStrRev(pathName, "\") + 1, InStrRev(pathName, ".") - InStrRev(pathName, "\") - 1) | |
| 'fileDate = Right(compName, Len(compName) - InStrRev(compName, "--") - 1) | |
| 'If fileDate = dateNow Then | |
| 'MsgBox "Same Date" | |
| 'Application.DisplayAlerts = False | |
| ' rPath = ThisDocument.Path & "\" & onlyName & "--" & dateNow & "." & ext | |
| ' ActiveDocument.SaveAs FileName:=rPath | |
| 'Application.DisplayAlerts = True | |
| 'Else | |
| 'MsgBox "Different Date" | |
| ' rPath = ThisDocument.Path & "\" & onlyName & "--" & dateNow & "." & ext | |
| ' ActiveDocument.SaveAs FileName:=rPath | |
| 'End If | |
| End Sub |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Public Sub AutoOpen() | |
| ThisDocument.Application.ActiveWindow.View.Zoom.PageColumns = 1 | |
| 'ThisDocument.Application.ActiveWindow.View.Zoom.Percentage = 100 | |
| ThisDocument.Application.ActiveWindow.View.Zoom.PageFit = wdPageFitBestFit | |
| ThisDocument.Application.ActiveWindow.View.Type = wdPrintView | |
| With ActiveDocument.Styles(wdStyleNormal).Font | |
| .Size = 1 | |
| End With | |
| ActiveDocument.ActiveWindow.View.ReadingLayout = False | |
| 'MsgBox ThisDocument.Application.UsableWidth | |
| SaveToRelativePath | |
| End Sub | |
| Sub RunFormAddPatient() | |
| Dim frm As New ufAddPatient | |
| frm.Show | |
| End Sub | |
| Sub RunFormSelectPatient() | |
| Dim frm As New ufSelectPatient | |
| frm.Show | |
| End Sub | |
| Sub RunFormDeletePatient() | |
| Dim frm As New ufDeletePatient | |
| frm.Show | |
| End Sub | |
| Sub sortNumbers() | |
| Dim a() | |
| a = memory() | |
| Call reDraw(a, False) | |
| End Sub | |
| Sub sortNames() | |
| Dim a() | |
| a = memory() | |
| Call reDraw(a, True) | |
| End Sub | |
| Sub ShowPrintDialog() | |
| Dialogs(wdDialogFilePrint).Show | |
| End Sub | |
| Sub resetZoom() | |
| ActiveDocument.ActiveWindow.View.Zoom.Percentage = 100 | |
| End Sub | |
| Sub fitZoom() | |
| ActiveDocument.ActiveWindow.View.Zoom.PageFit = wdPageFitBestFit | |
| End Sub | |
| Private Sub Document_Close() | |
| ActiveDocument.Save | |
| Me.Saved = True | |
| End Sub |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Private Sub UserForm_Initialize() | |
| 'Me.txtRoom.Value = "1234" | |
| 'Me.txtFirst.Value = "First" | |
| 'Me.txtLast.Value = "Last" | |
| 'Me.txtDOB.Value = "12/25/2017" | |
| 'Me.cboCode.Value = "Full Code" | |
| 'Me.txtMRN.Value = "123456" | |
| 'Me.cboResident.Value = "PGuilford" | |
| 'Me.txtMeds.Value = "meds" | |
| 'Me.txtHPI.Value = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." | |
| 'Me.txtFU.Value = "f/u this" | |
| Me.txtAdmit.Value = Format(Date, "mm/dd/yyyy") | |
| Me.cboCode.List = codeArray() | |
| Me.cboResident.List = residentArray() | |
| End Sub | |
| Private Sub cmdCommit_Click() | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' ROOM | |
| If Len(txtRoom) <> 4 Then | |
| MsgBox "A four-digit room number is required.", vbOKOnly, "Room Error" | |
| txtRoom.SetFocus | |
| Exit Sub | |
| ElseIf IsNumeric(txtRoom) = False Then | |
| MsgBox "Your room number contains alpha characters.", vbOKOnly, "Room Error" | |
| txtRoom.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' NAME | |
| If Len(txtLast) = 0 Or Len(txtFirst) = 0 Then | |
| MsgBox "Both first and last names are required.", vbOKOnly, "Name Error" | |
| If Len(txtLast) = 0 Then | |
| txtLast.SetFocus | |
| Else | |
| txtFirst.SetFocus | |
| End If | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' DATE OF BIRTH | |
| If IsDate(txtDOB) Then | |
| If Not dateCheckDOB(txtDOB) Then | |
| MsgBox "Please enter date as MM/DD/YYYY.", vbOKOnly, "DOB Error" | |
| txtDOB.SetFocus | |
| Exit Sub | |
| Else | |
| 'MsgBox "This is a date.", vbOKOnly, "DOB Error" | |
| End If | |
| Else | |
| If Len(txtDOB) = 0 Then | |
| MsgBox "Date of Birth is required.", vbOKOnly, "DOB Error" | |
| Else | |
| MsgBox "Please check date of birth.", vbOKOnly, "DOB Error" | |
| End If | |
| txtDOB.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' GENDER | |
| If optMale = False And optFemale = False Then | |
| MsgBox "Please select gender.", vbOKOnly, "Gender Error" | |
| optMale.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' ADMIT DATE | |
| If IsDate(txtAdmit) Then | |
| If Not dateCheckAdmit(txtAdmit) Then | |
| MsgBox "Please enter date as MM/DD/YYYY.", vbOKOnly, "Admission Date Error" | |
| txtAdmit.SetFocus | |
| Exit Sub | |
| End If | |
| Else | |
| If Len(txtAdmit) = 0 Then | |
| MsgBox "Admission date is required.", vbOKOnly, "Admission Date Error" | |
| Else | |
| MsgBox "Please check admission date.", vbOKOnly, "Admission Date Error" | |
| End If | |
| txtAdmit.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' CODE STATUS | |
| If Len(cboCode) = 0 Then | |
| MsgBox "Please select a code status.", vbOKOnly, "Code Status Error" | |
| cboCode.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' MRN | |
| If Len(txtMRN) <> 6 Then | |
| MsgBox "MRN is six digits.", vbOKOnly, "MRN Error" | |
| txtMRN.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' RESIDENT | |
| If Len(cboResident) = 0 Then | |
| MsgBox "Please select a resident.", vbOKOnly, "Resident Error" | |
| cboResident.SetFocus | |
| Exit Sub | |
| End If | |
| ufAddPatient.txtRoom.Text = Me.txtRoom.Value | |
| ufAddPatient.txtFirst.Text = Me.txtFirst.Value | |
| ufAddPatient.txtLast.Text = Me.txtLast.Value | |
| ufAddPatient.txtDOB.Text = Me.txtDOB.Value | |
| ufAddPatient.optMale.Value = Me.optMale.Value | |
| ufAddPatient.optFemale.Value = Me.optFemale.Value | |
| ufAddPatient.txtAdmit.Text = Me.txtAdmit.Value | |
| ufAddPatient.cboCode.Value = Me.cboCode.Value | |
| ufAddPatient.txtMRN.Value = Me.txtMRN.Value | |
| ufAddPatient.txtMeds.Text = Me.txtMeds.Value | |
| ufAddPatient.txtHPI.Text = Me.txtHPI.Value | |
| ufAddPatient.txtFU.Text = Me.txtFU.Value | |
| ufAddPatient.txtAllergies.Text = Me.txtAllergies.Value | |
| ufAddPatient.txtPPx.Text = Me.txtPPx.Value | |
| ufAddPatient.txtDDx.Text = Me.txtDDx.Value | |
| ufAddPatient.txtPain.Text = Me.txtPain.Value | |
| ufAddPatient.txtLabs.Text = Me.txtLabs.Value | |
| ufAddPatient.txtImaging.Text = Me.txtImaging.Value | |
| ufAddPatient.txtProcedures.Text = Me.txtProcedures.Value | |
| ufAddPatient.chkAnticoag.Value = Me.chkAnticoag.Value | |
| ufAddPatient.chkInsulin.Value = Me.chkInsulin.Value | |
| ufAddPatient.cboResident.Value = Me.cboResident.Value | |
| ufAddPatient.txtDispo.Text = Me.txtDispo.Value | |
| If Me.chkTime.Value = True Then | |
| vTimestamp = Now() | |
| Else | |
| vTimestamp = dict.Item("timestamp") | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' CHECK IF ROOM EXISTS | |
| Dim n As Integer | |
| n = ActiveDocument.Bookmarks.Count | |
| If n <> 0 Then | |
| Dim roomArray() | |
| ReDim roomArray(1 To n) | |
| For i = 1 To n | |
| roomArray(i) = Split(ActiveDocument.Bookmarks(i).Name, "_")(1) | |
| Next | |
| d = "#" | |
| s = Join(roomArray, d) | |
| s = d & s & d | |
| If InStr(1, s, d & ufAddPatient.txtRoom.Text & d, vbBinaryCompare) Then | |
| MsgBox "Room number is already on cencus.", vbOKOnly, "Room Number Exists" | |
| txtRoom.SetFocus | |
| Exit Sub | |
| End If | |
| End If | |
| Me.Hide | |
| Call add | |
| End Sub | |
| Private Sub cmdCancel_Click() | |
| Unload Me | |
| End | |
| End Sub | |
| Function dateCheckDOB(dateValueDOB As String) As Boolean | |
| If Format(CDate(txtDOB), "mm/dd/yyyy") = dateValueDOB Or Format(CDate(txtDOB), "m/d/yyyy") = dateValueDOB Then | |
| dateCheckDOB = True | |
| End If | |
| End Function | |
| Function dateCheckAdmit(dateValueAdmit As String) As Boolean | |
| If Format(CDate(txtAdmit), "mm/dd/yyyy") = dateValueAdmit Or Format(CDate(txtAdmit), "m/d/yyyy") = dateValueAdmit Then | |
| dateCheckAdmit = True | |
| End If | |
| End Function |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Private Sub UserForm_Initialize() | |
| 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(1) & vbTab & vbTab & nameSplit(0) | |
| Next | |
| x = LBound(bmkArray) | |
| y = UBound(bmkArray) | |
| For i = x To y - 1 | |
| For j = i + 1 To y | |
| If bmkArray(i) > bmkArray(j) Then | |
| temp = bmkArray(i) | |
| bmkArray(i) = bmkArray(j) | |
| bmkArray(j) = temp | |
| End If | |
| Next j | |
| Next i | |
| listPts.List = bmkArray | |
| End Sub | |
| Private Sub cmdSelect_Click() | |
| usrSel = Split(Me.listPts.Value, vbTab & vbTab) | |
| usrSelection = usrSel(1) & "_" & usrSel(0) | |
| strPrompt = "Remove from census?" | |
| strTitle = "Delete" | |
| If MsgBox(strPrompt, vbYesNo, strTitle) = vbNo Then | |
| listPts.SetFocus | |
| Exit Sub | |
| End If | |
| Me.Hide | |
| del (usrSelection) | |
| End Sub |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Private Sub UserForm_Initialize() | |
| 'dict.Item("room") | |
| 'dict.Item("first") | |
| 'dict.Item("last") | |
| 'dict.Item("gender") | |
| 'dict.Item("dob") | |
| 'dict.Item("admit") | |
| 'dict.Item("resident") | |
| 'dict.Item("code") | |
| 'dict.Item("meds") | |
| 'dict.Item("hpi") | |
| 'dict.Item("fu") | |
| 'dict.Item("allergies") | |
| 'dict.Item("ddx") | |
| 'dict.Item("pain") | |
| 'dict.Item("ppx") | |
| 'dict.Item("labs") | |
| 'dict.Item("anticoag") | |
| 'dict.Item("insulin") | |
| 'dict.Item("imaging") | |
| 'dict.Item("procedures") | |
| 'dict.Item("dispo") | |
| 'dict.Item("timestamp") | |
| Me.txtRoom.Value = dict.Item("room") | |
| Me.txtFirst.Value = dict.Item("first") | |
| Me.txtLast.Value = dict.Item("last") | |
| Me.txtDOB.Value = dict.Item("dob") | |
| If dict.Item("gender") = "M" Then | |
| Me.optMale.Value = True | |
| Else | |
| Me.optFemale.Value = True | |
| End If | |
| Me.txtAdmit.Value = dict.Item("admit") | |
| Me.cboCode.Value = dict.Item("code") | |
| Me.txtMRN.Value = dict.Item("mrn") | |
| Me.txtMeds.Value = dict.Item("meds") | |
| Me.txtHPI.Value = dict.Item("hpi") | |
| Me.txtFU.Value = dict.Item("fu") | |
| Me.txtAllergies.Value = dict.Item("allergies") | |
| Me.txtDDx.Value = dict.Item("ddx") | |
| Me.txtPain.Value = dict.Item("pain") | |
| Me.txtLabs.Value = dict.Item("labs") | |
| Me.txtImaging.Value = dict.Item("imaging") | |
| Me.txtProcedures.Value = dict.Item("procedures") | |
| Me.txtDispo.Value = dict.Item("dispo") | |
| Me.txtPPx.Value = dict.Item("ppx") | |
| Me.cboResident.Value = dict.Item("resident") | |
| Me.chkAnticoag.Value = dict.Item("anticoag") | |
| Me.chkInsulin.Value = dict.Item("insulin") | |
| Me.cboCode.List = codeArray() | |
| Me.cboResident.List = residentArray() | |
| End Sub | |
| Private Sub cmdCommit_Click() | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' ROOM | |
| If Len(txtRoom) <> 4 Then | |
| MsgBox "A four-digit room number is required.", vbOKOnly, "Room Error" | |
| txtRoom.SetFocus | |
| Exit Sub | |
| ElseIf IsNumeric(txtRoom) = False Then | |
| MsgBox "Your room number contains alpha characters.", vbOKOnly, "Room Error" | |
| txtRoom.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' NAME | |
| If Len(txtLast) = 0 Or Len(txtFirst) = 0 Then | |
| MsgBox "Both first and last names are required.", vbOKOnly, "Name Error" | |
| If Len(txtLast) = 0 Then | |
| txtLast.SetFocus | |
| Else | |
| txtFirst.SetFocus | |
| End If | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' DATE OF BIRTH | |
| If IsDate(txtDOB) Then | |
| If Not dateCheckDOB(txtDOB) Then | |
| MsgBox "Please enter date as MM/DD/YYYY.", vbOKOnly, "DOB Error" | |
| txtDOB.SetFocus | |
| Exit Sub | |
| Else | |
| 'MsgBox "This is a date.", vbOKOnly, "DOB Error" | |
| End If | |
| Else | |
| If Len(txtDOB) = 0 Then | |
| MsgBox "Date of Birth is required.", vbOKOnly, "DOB Error" | |
| Else | |
| MsgBox "Please check date of birth.", vbOKOnly, "DOB Error" | |
| End If | |
| txtDOB.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' GENDER | |
| If optMale = False And optFemale = False Then | |
| MsgBox "Please select gender.", vbOKOnly, "Gender Error" | |
| optMale.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' ADMIT DATE | |
| If IsDate(txtAdmit) Then | |
| If Not dateCheckAdmit(txtAdmit) Then | |
| MsgBox "Please enter date as MM/DD/YYYY.", vbOKOnly, "Admission Date Error" | |
| txtAdmit.SetFocus | |
| Exit Sub | |
| End If | |
| Else | |
| If Len(txtAdmit) = 0 Then | |
| MsgBox "Admission date is required.", vbOKOnly, "Admission Date Error" | |
| Else | |
| MsgBox "Please check admission date.", vbOKOnly, "Admission Date Error" | |
| End If | |
| txtAdmit.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' CODE STATUS | |
| If Len(cboCode) = 0 Then | |
| MsgBox "Please select a code status.", vbOKOnly, "Code Status Error" | |
| cboCode.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' MRN | |
| If Len(txtMRN) <> 6 Then | |
| MsgBox "MRN is six digits.", vbOKOnly, "MRN Error" | |
| txtMRN.SetFocus | |
| Exit Sub | |
| End If | |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' | |
| ' RESIDENT | |
| If Len(cboResident) = 0 Then | |
| MsgBox "Please select a resident.", vbOKOnly, "Resident Error" | |
| cboResident.SetFocus | |
| Exit Sub | |
| End If | |
| ufModPatient.txtRoom.Text = Me.txtRoom.Value | |
| ufModPatient.txtFirst.Text = Me.txtFirst.Value | |
| ufModPatient.txtLast.Text = Me.txtLast.Value | |
| ufModPatient.txtDOB.Text = Me.txtDOB.Value | |
| ufModPatient.optMale.Value = Me.optMale.Value | |
| ufModPatient.optFemale.Value = Me.optFemale.Value | |
| ufModPatient.txtAdmit.Text = Me.txtAdmit.Value | |
| ufModPatient.cboCode.Value = Me.cboCode.Value | |
| ufModPatient.txtMRN.Value = Me.txtMRN.Value | |
| ufModPatient.txtMeds.Text = Me.txtMeds.Value | |
| ufModPatient.txtHPI.Text = Me.txtHPI.Value | |
| ufModPatient.txtFU.Text = Me.txtFU.Value | |
| ufModPatient.txtAllergies.Text = Me.txtAllergies.Value | |
| ufModPatient.txtPPx.Text = Me.txtPPx.Value | |
| ufModPatient.txtDDx.Text = Me.txtDDx.Value | |
| ufModPatient.txtPain.Text = Me.txtPain.Value | |
| ufModPatient.txtLabs.Text = Me.txtLabs.Value | |
| ufModPatient.txtImaging.Text = Me.txtImaging.Value | |
| ufModPatient.txtProcedures.Text = Me.txtProcedures.Value | |
| ufModPatient.chkAnticoag.Value = Me.chkAnticoag.Value | |
| ufModPatient.chkInsulin.Value = Me.chkInsulin.Value | |
| ufModPatient.cboResident.Value = Me.cboResident.Value | |
| ufModPatient.txtDispo.Text = Me.txtDispo.Value | |
| If Me.chkTime.Value = True Then | |
| vTimestamp = Now() | |
| Else | |
| vTimestamp = dict.Item("timestamp") | |
| End If | |
| If ufModPatient.txtRoom.Text <> dict.Item("room") Then | |
| strPrompt = "Change room number?" | |
| strTitle = "Room Number Check" | |
| userResponse = MsgBox(strPrompt, vbYesNo, strTitle) | |
| If userResponse = vbNo Then | |
| txtRoom.SetFocus | |
| Exit Sub | |
| Else | |
| Dim n As Integer | |
| n = ActiveDocument.Bookmarks.Count | |
| Dim roomArray() | |
| ReDim roomArray(1 To n) | |
| For i = 1 To n | |
| roomArray(i) = Split(ActiveDocument.Bookmarks(i).Name, "_")(1) | |
| Next | |
| d = "#" | |
| s = Join(roomArray, d) | |
| s = d & s | |
| If InStr(1, s, d & ufAddPatient.txtRoom.Text & d, vbBinaryCompare) Then | |
| MsgBox "Room number is already on cencus.", vbOKOnly, "Room Number Exists" | |
| txtRoom.SetFocus | |
| Exit Sub | |
| End If | |
| End If | |
| End If | |
| If ufModPatient.cboResident.Value <> dict.Item("resident") Then | |
| strPrompt = "Change resident assignment?" | |
| strTitle = "Resident" | |
| If MsgBox(strPrompt, vbYesNo, strTitle) = vbNo Then | |
| cboResident.SetFocus | |
| Exit Sub | |
| End If | |
| End If | |
| Call modify | |
| dict.RemoveAll | |
| End Sub | |
| Private Sub cmdCancel_Click() | |
| Unload Me | |
| End | |
| End Sub | |
| Function dateCheckDOB(dateValueDOB As String) As Boolean | |
| If Format(CDate(txtDOB), "mm/dd/yyyy") = dateValueDOB Or Format(CDate(txtDOB), "m/d/yyyy") = dateValueDOB Then | |
| dateCheckDOB = True | |
| End If | |
| End Function | |
| Function dateCheckAdmit(dateValueAdmit As String) As Boolean | |
| If Format(CDate(txtAdmit), "mm/dd/yyyy") = dateValueAdmit Or Format(CDate(txtAdmit), "m/d/yyyy") = dateValueAdmit Then | |
| dateCheckAdmit = True | |
| End If | |
| End Function |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Private Sub UserForm_Initialize() | |
| 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(1) & vbTab & vbTab & nameSplit(0) | |
| Next | |
| x = LBound(bmkArray) | |
| y = UBound(bmkArray) | |
| For i = x To y - 1 | |
| For j = i + 1 To y | |
| If bmkArray(i) > bmkArray(j) Then | |
| temp = bmkArray(i) | |
| bmkArray(i) = bmkArray(j) | |
| bmkArray(j) = temp | |
| End If | |
| Next j | |
| Next i | |
| listPts.List = bmkArray | |
| End Sub | |
| Private Sub cmdSelect_Click() | |
| usrSel = Split(Me.listPts.Value, vbTab & vbTab) | |
| usrSelection = usrSel(1) & "_" & usrSel(0) | |
| Me.Hide | |
| tblDict (usrSelection) | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment