Visual Basic for Applications - UserForms for Microsoft Word templates

__________________________________________________________________________

The code below is Visual Basic for Applications designed by The Microsoft Corporation to program in the Microsoft Office suite. It is the code that produces the UserForm (the dialog box that users enter data into, which is then transferred into the template).

There are custom mathematical functions to calculate age from dates, etc.
__________________________________________________________________________

Dim strName As Variant





Private Sub CommandButton1_Click()


End Sub

Private Sub lbl_airboneright_Click()

End Sub

End Sub

Private Sub CheckBox1_Click()
If CheckBox1 = True Then
Frame1.Visible = True
Else: Frame1.Visible = False
End If


End Sub

Private Sub CheckBox2_Click()
If CheckBox2 = True Then
Frame2.Visible = True
Else: Frame2.Visible = False
End If


End Sub



Private Sub UserForm_Initialize()
With cboPatientGender
.AddItem "male"
.AddItem "female"
End With
With cbo_Degr
.AddItem ", M.D."
.AddItem ", D.O."
.AddItem ", Ph.D."
.AddItem ", AuD"
.AddItem ""
End With
With cboRtypehearloss
.AddItem "sensorineural"
.AddItem "conductive"
.AddItem "mixed"
End With
With cboLtypehearloss
.AddItem "sensorineural"
.AddItem "conductive"
.AddItem "mixed"
End With

End Sub

Public Sub btn_pt_hist_status_Click()
Dim strName As String
strName = InputBox(Prompt:="Please enter patient history/status.")

End Sub


Private Sub cmdClear_Click()
txtPatientName.Value = Null
txtDOSmm.Value = Null
txtDOSdd.Value = Null
txtDOSyyyy.Value = Null
txtReferringDoctor.Value = Null
txtDOByyyy.Value = Null
cboPatientGender.Value = Null
txtEVALmm.Value = Null
txtEVALdd.Value = Null
txtEVALyyyy.Value = Null
txt_r_db_lower.Value = Null
txt_r_db_upper.Value = Null
txt_l_db_lower.Value = Null
txt_l_db_upper.Value = Null
End Sub

Private Sub cmdCancel_Click()
Unload Me
ActiveDocument.Close SaveChanges:=False
End Sub

Private Sub cmdEnter_Click()
Dim current As Date
current = DateTime.Now()
Dim xr_2, xr_4, xr_6, xr_8, lx_2, lx_4, lx_6, lx_8 As Variant
xr_2 = r_2
xr_4 = r_4
xr_6 = r_6
xr_8 = r_8
lx_2 = l_2
lx_4 = l_4
lx_6 = l_6
lx_8 = l_8
If xr_2 = "" Then
xr_2 = 0
End If
If xr_4 = "" Then
xr_4 = 0
End If
If xr_6 = "" Then
xr_6 = 0
End If
If xr_8 = "" Then
xr_8 = 0
End If
If lx_2 = "" Then
lx_2 = 0
End If
If lx_4 = "" Then
lx_4 = 0
End If
If lx_6 = "" Then
lx_6 = 0
End If
If lx_8 = "" Then
lx_8 = 0
End If

With ActiveDocument
.Bookmarks("date").Range.Text = current
.Bookmarks("patient_name").Range.Text = txtPatientName.Value & " " & txtPatientLname.Value
.Bookmarks("dos").Range.Text = DateValue(txtDOS.Value)
.Bookmarks("ref_doc").Range.Text = txtReferringDoctor.Value + cbo_Degr
.Bookmarks("ref_doc1").Range.Text = txtReferringDoctor.Value + cbo_Degr
.Bookmarks("patient_name1").Range.Text = txtPatientName.Value
.Bookmarks("age").Range.Text = AgeCalc(txtDOBmm.Value, txtDOBdd.Value, txtDOByyyy.Value)
.Bookmarks("evaldate").Range.Text = DateValue(txtDOS.Value)
.Bookmarks("gender").Range.Text = cboPatientGender
.Bookmarks("ptstatus").Range.Text = txt_pthistory
.Bookmarks("r_lower_limit").Range.Text = txt_r_db_lower.Value
.Bookmarks("r_upper_limit").Range.Text = txt_r_db_upper.Value
.Bookmarks("r_air_bone").Range.Text = airbone(xr_2, xr_4, xr_6, xr_8)
.Bookmarks("l_lower_limit").Range.Text = txt_l_db_lower.Value
.Bookmarks("l_upper_limit").Range.Text = txt_l_db_upper.Value
.Bookmarks("l_air_bone").Range.Text = airbone(lx_2, lx_4, lx_6, lx_8)
.Bookmarks("impression_r").Range.Text = "Right " + lossinwords(txt_r_db_lower.Value) + " to"
.Bookmarks("impression_r_u").Range.Text = lossinwords(txt_l_db_upper.Value)
.Bookmarks("r_type_loss").Range.Text = cboRtypehearloss
.Bookmarks("impression_l").Range.Text = "Left " + lossinwords(txt_l_db_lower.Value) + " to"
.Bookmarks("impression_l_u").Range.Text = lossinwords(txt_l_db_upper.Value)
.Bookmarks("l_type_loss").Range.Text = cboLtypehearloss
.Bookmarks("return_ref_doc").Range.Text = txtReferringDoctor.Value + cbo_Degr
End With
Application.ScreenUpdating = True
Unload Me
End Sub

Function AgeCalc(pmonth As Integer, pday As Integer, pyear As Integer)
Dim Age As Integer
Dim LValue As String
LValue = Format(Date, "yyyy/mm/dd")
nyear = Left(LValue, 4)
nday = Right(LValue, 2)
nmonth = Mid(LValue, 6, 2)
If pmonth <= nmonth Then
AgeCalc = (nyear - pyear)
ElseIf (pmonth > nmonth) Then
AgeCalc = ((nyear - pyear) - 1)
End If
End Function

Function lossinwords(x As Integer)
If x >= 0 And x <= 20 Then
lossinwords = "normal"
ElseIf x <= 40 And x > 20 Then
lossinwords = "mild"
ElseIf x <= 55 And x > 40 Then
lossinwords = "moderate"
ElseIf x <= 70 And x > 55 Then
lossinwords = "moderately severe"
ElseIf x <= 90 And x > 70 Then
lossinwords = "severe"
ElseIf x > 90 Then
lossinwords = "profound"
End If
End Function

Function airbone(a, b, c, d)
If a = 0 And b = 0 And c = 0 And d = 0 Then
airbone = "There was no air-bone gap"
Else
airbone = "There was an air-bone gap of " & a & "dB" & " to " & b & "dB" & " at the frequency range of " & c & " to " & d
End If

End Function