Solved: VBA MS Access: Runtime error "Object variable not declared or with block variable not set" when using a check box

flavo

try

If rs("ALS") = -1 Then

flavo

sorry

If recrd("ALS") = -1 Then

jbotts

ASKER

Dave,
I tried and it didn't work.
Thanks,
Jim

flavo

I cant seem to replicate the error.... Even if i added some nulls to make things interesting...

Can you post the rest of the code, it maybe something there??

Also, did you declare your recrd like this

Dim recrd as dao.recordset maybe its confusing it with a ADO one??? maybe....

jbotts

ASKER

I have declared the recorset as Dim recrd As dao.Recordset.
The whole Sub is used to write a report to MS Word:

Private Sub cmdbCreateReport_Click()
On Error GoTo Err_cmdbCreateReport_Click

'Declare variables
Dim dbsCurr As dao.Database
Dim recqn As dao.Recordset
Dim recrd As dao.Recordset
Dim recqf As dao.Recordset
Dim recqALS As Recordset
Dim recqPD As dao.Recordset
Dim lname As String
Dim strSQL As String
Dim DateToday As String
Dim file_path As String
Dim file_name As String

'Initialize dbsCurr to the Current Database
Set dbsCurr = CurrentDb()

'Declare and initialize date of this report
DateToday = Date

'Declare the variable for the Word Application.
Dim objWD As Word.Application
Dim WordDoc As Document

'Set the variable (runs new instance of Word.)
Set objWD = CreateObject("Word.Application")

'To speed the document creation
objWD.ScreenUpdating = False

'Add a new document.
objWD.Documents.Add

With objWD.ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(1.25)
.RightMargin = InchesToPoints(0.75)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = True
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With

With objWD.Selection
'Set font attributes
.Font.Name = "Tahoma"
.Font.Size = 16
.Font.Bold = True
.ParagraphFormat.Alignment = wdAlignParagraphCenter
'Header text
.TypeText "Eligibility Evaluation" & vbLf
'Align the text to the left and change font size to 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Size = 10
'Set Date and Patient's Name and Address
.Font.Bold = True
.TypeText vbLf + "Patient Name: "
.Font.Bold = False
.TypeText Me.LastName + ", " + Me.FirstName + " " + Me.MiddleName + vbLf
'Set Date of Birth and Age and Gender
.Font.Bold = True
.TypeText "Date of Birth: "
.Font.Bold = False
.TypeText Me.tbDateOfBirth
.Font.Bold = True
.TypeText " Age: "
.Font.Bold = False
.TypeText Me.tbAge
.Font.Bold = True
.TypeText vbTab + "Gender: "
.Font.Bold = False
.TypeText Me.comboGender
'Set today's date
.Font.Bold = True
.TypeText vbLf + "Date: "
.Font.Bold = False
.TypeText DateToday
.Font.Bold = True
'Set admission date and LOS
.TypeText " Admission Date: "
.Font.Bold = False
.TypeText Me.tbAdmitDate
.Font.Bold = True
.TypeText " Length of Stay: "
.Font.Bold = False
.TypeText Me.tbLOS
.TypeText " days"
'Set Address... street, city, state, ZIP and Phone number
.Font.Bold = True
.TypeText vbLf + "Address: "
.Font.Bold = False
.TypeText Me.Address1
End With

If (Me.Address2.Value <> " ") Then
objWD.Selection.TypeText vbLf + " " + Me.Address2.Value
End If

With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "City: "
.Font.Bold = False
.TypeText " " + Me.City
.Font.Bold = True
.TypeText vbLf + "State/ZIP: "
.Font.Bold = False
.TypeText Me.State + " " + Me.ZIP + vbLf
.Font.Bold = True
.TypeText "Phone: "
.Font.Bold = False
.TypeText Me.CaregiverPhone + vbLf
'Set caregiver information
.Font.Bold = True
.TypeText vbLf + "Caregiver Name: "
.Font.Bold = False
.TypeText Me.CaregiverName
.Font.Bold = True
.TypeText vbLf + "Caregiver Relationship: "
.Font.Bold = False
.TypeText Me.Relationship + vbLf
.Font.Bold = True
.TypeText "Caregiver Phone: "
.Font.Bold = False
.TypeText Me.CaregiverPhone + vbLf + vbLf + vbLf
End With
''***************************************** Nutritional Impairments Monitor ***********************************

'Construct SQL statement for qryNutr (Nutritional Impairments Monitor Query
strSQL = "SELECT LastName, FirstName, tblNutritionalImpairmentsMonitor.* " + _
" FROM tblPatientInformation, tblNutritionalImpairmentsMonitor" + _
" WHERE (tblNutritionalImpairmentsMonitor.PatientID = tblPatientInformation.PatientID) AND (tblNutritionalImpairmentsMonitor.PatientID = "
strSQL = strSQL + "'" + Me.PatientID + "'" + ") "
strSQL = strSQL + " ORDER BY tblNutritionalImpairmentsMonitor.EvaluationID;"

Set recqn = dbsCurr.OpenRecordset(strSQL)

With objWD.Selection
'Nutritional Impairments Monitor header
.Font.Bold = True
.Font.Size = 12
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TypeText "Nutritional Impairments Monitor Data" + vbLf + vbLf
'Information from qryNutr of the Nutritional Impairments Monitor
.Font.Size = 10
.Font.Bold = True
.ParagraphFormat.Alignment = wdAlignParagraphLeft
'Weight History header
.Font.Underline = wdUnderlineSingle
.TypeText "Weight History"
.Font.Underline = wdUnderlineNone
.TypeText vbLf + "The following weight changes have been voluntary: "
.Font.Bold = False
.TypeText recqn("Wgt_Change_Intended")
'Weight History data weight on admission
.Font.Bold = True
.TypeText vbLf + "Weight on Admission: "
.Font.Bold = False
End With
'*******
If (recqn("WeightCurrent") > 0) Then
objWD.Selection.TypeText recqn("WeightCurrent")
Else
objWD.Selection.TypeText "not done"
End If
objWD.Selection.TypeText " lbs." + vbLf

With objWD.Selection
'Weight 3 months prior to admission
.Font.Bold = True
.TypeText "Weight 3 Months Prior to Admission: "
.Font.Bold = False
End With

If recqn("Weight3MosAgo") > 0 Then
objWD.Selection.TypeText recqn("Weight3MosAgo")
Else
objWD.Selection.TypeText "not done"
End If
objWD.Selection.TypeText " lbs." + vbLf

With objWD.Selection
'Weight 6 months prior to admission
.Font.Bold = True
.TypeText "Weight 6 Months Prior to Admission: "
.Font.Bold = False
End With

If recqn("Weight3MosAgo") > 0 Then
With objWD.Selection
.TypeText recqn("Weight6MosAgo")
.TypeText " lbs." + vbLf + vbLf
End With
Else
objWD.Selection.TypeText "not done" + vbLf + vbLf
End If

With objWD.Selection
'Column headers
.Font.Bold = True
.TypeText "Date" + vbTab + vbTab + "Weight" + vbTab + _
"%Loss 3 Mos." + vbTab + vbTab + "%Loss 6 Mos." + vbTab + vbTab + "BMI" + _
vbTab + "MAC"
End With

recqn.Sort = "CurrentDate"
recqn.MoveFirst

'Put data in Weight History table
Do While recqn.EOF = False
With objWD.Selection
.TypeText vbLf
.Font.Bold = False
.TypeText recqn("CurrentDate")
.TypeText vbTab
End With

If recqn("WeightCurrent") > 0 Then
objWD.Selection.TypeText recqn("WeightCurrent")
Else
objWD.Selection.TypeText "Not Done"
End If

With objWD.Selection
.TypeText vbTab + vbTab
.TypeText recqn("Wgt_Loss_3_Mos") * 100
.TypeText "%"
.TypeText vbTab + vbTab + vbTab
.TypeText recqn("Wgt_Loss_6_Mos") * 100
.TypeText "%" + vbTab + vbTab + vbTab
End With

If recqn("WeightCurrent") > 0 Then
objWD.Selection.TypeText recqn("BMI")
Else
objWD.Selection.TypeText "?"
End If

With objWD.Selection
.TypeText vbTab
.TypeText recqn("MidArmCirc")
End With
recqn.MoveNext
Loop
'***************
'Move to first record to get albumin data
recqn.MoveFirst

With objWD.Selection
'Albumin History header
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.TypeText vbLf + vbLf + "Serum Albumin History"

'Data on past albumin level
.Font.Underline = wdUnderlineNone
.TypeText vbLf + "Date of Past Serum Albumin: "
.Font.Bold = False
.TypeText recqn("DateOfPastAlbumin")
.Font.Bold = True
.TypeText vbTab + "Result: "
.Font.Bold = False
.TypeText recqn("SerumAlbumin")
.TypeText " gm/dl"

'Column headers for albumin
.Font.Bold = True
.TypeText vbLf + vbLf + "Date" + vbTab + vbTab + "Albumin"
End With

'Write albumin values to table
Do While recqn.EOF = False
With objWD.Selection
.TypeText vbLf
.Font.Bold = False
.TypeText recqn("CurrentDate")
.TypeText vbTab
End With

If recqn("SerumAlbumin") > 0 Then
With objWD.Selection
.TypeText recqn("SerumAlbumin")
.TypeText " gm/dl"
End With
Else
objWD.Selection.TypeText "N/A"
End If
recqn.MoveNext
Loop

'Move to first record to get oral intake data
recqn.MoveFirst

'Oral Intake History
With objWD.Selection
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.TypeText vbLf + vbLf + "Oral Intake History"

'Write Oral Intake Data
.Font.Bold = False
.Font.Underline = wdUnderlineNone
End With

Do While recqn.EOF = False
With objWD.Selection
.TypeText vbLf
.TypeText recqn("CurrentDate")
.TypeText " - " + recqn("OralIntakeInadequate")
End With
recqn.MoveNext
Loop

'Return to First Record
recqn.MoveFirst

'Comments Header
With objWD.Selection
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.TypeText vbLf + vbLf + "Additional Comments Concerning Nutritional Status"
.Font.Bold = False
.Font.Underline = wdUnderlineNone
End With

Do While recqn.EOF = False
With objWD.Selection
.TypeText vbLf
.TypeText recqn("CurrentDate")
End With
If recqn("Comments") <> " " Then
objWD.Selection.TypeText " - " + recqn("Comments")
Else
objWD.Selection.TypeText " - " + "No comments entered"
End If
recqn.MoveNext
Loop

'Return to First Record
recqn.MoveFirst

'''*********************************** Functional Impairments Monitor ************************************************

'Construct SQL statement for qryFunc (Functional Impairments Monitor Query
strSQL = "SELECT LastName, FirstName, tblFunctionalImpairmentsMonitor.* " & _
" FROM tblPatientInformation, tblFunctionalImpairmentsMonitor" & _
" WHERE (tblFunctionalImpairmentsMonitor.PatientID = tblPatientInformation.PatientID) AND (tblFunctionalImpairmentsMonitor.PatientID = "
strSQL = strSQL + "'" + Me.PatientID + "'" + ") "
strSQL = strSQL + " ORDER BY tblFunctionalImpairmentsMonitor.EvaluationID;"

'Create recordset for above SQL
Set recqf = dbsCurr.OpenRecordset(strSQL)

With objWD.Selection
.InsertBreak Type:=wdPageBreak

'Functional Impairments Monitor header
.Font.Bold = True
.Font.Size = 12
.TypeText vbLf + vbLf + vbLf
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TypeText "Functional Impairments Monitor Data" + vbLf + vbLf

'Indices of Functional Decline - Header
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeText "Indices of Functional Impairment" + vbLf

'Indices of Functional Decline - Column Headers and Data
.Font.Underline = wdUnderlineNone
.TypeText "PPS 3 months prior to admission: "
.Font.Bold = False
.TypeText recqf("PPS_PTA") + "%"
.Font.Bold = True
.TypeText vbLf + "FAST 3 months prior to admission: "
.Font.Bold = False
.TypeText recqf("FAST_PTA")
.Font.Bold = True
.TypeText vbLf + "Abbreviations..."
.Font.Bold = True
.TypeText vbLf + vbTab + "PPS = "
.Font.Bold = False
.TypeText "PPS"
.Font.Bold = True
.TypeText vbTab + vbTab + vbTab + "PPS 3m = "
.Font.Bold = False
.TypeText "PPS 3 months ago"
.Font.Bold = True
.TypeText vbLf + vbTab + "FAST = "
.Font.Bold = False
.TypeText "FAST"
.Font.Bold = True
.TypeText vbTab + vbTab + vbTab + "FAST 3m = "
.Font.Bold = False
.TypeText "FAST 3 months ago"
.Font.Bold = True
.TypeText vbLf + vbLf + "Date" + vbTab + vbTab + "PPS" + vbTab + vbTab + "PPS 3m" + vbTab _
+ "FAST" + vbTab + vbTab + "FAST 3m"
End With
'**********
'Write data for indecies of Functional Impairments to document
Do While recqf.EOF = False
With objWD.Selection
.TypeText vbLf
.Font.Bold = False
.TypeText recqf("Evaluation_Date")
.TypeText vbTab
End With

If recqf("PPS") > 0 Then
objWD.Selection.TypeText recqf("PPS") + "%"
Else
objWD.Selection.TypeText "N/A"
End If
objWD.Selection.TypeText vbTab + vbTab

If recqf("PPS_PTA") > 0 Then
objWD.Selection.TypeText recqf("PPS_PTA") + "%"
Else
objWD.Selection.TypeText "N/A"
End If
objWD.Selection.TypeText vbTab + vbTab

If recqf("FAST") > 0 Then
objWD.Selection.TypeText recqf("FAST")
Else
objWD.Selection.TypeText "N/A"
End If
objWD.Selection.TypeText vbTab + vbTab

If recqf("FAST_PTA") > 0 Then
objWD.Selection.TypeText recqf("FAST_PTA")
Else
objWD.Selection.TypeText "N/A"
End If
recqf.MoveNext
Loop
'******************
'Return to the first record
recqf.MoveFirst
With objWD.Selection
'Cardio-Respiratory Manifestations of Functional Impairment - Header
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeText vbLf + vbLf + "Cardio-Respiratory Manifestations of Functional Impairment" + vbLf

'Legend for Cardio-Pulmonary Manifestations of Functional Impairment
.Font.Underline = wdUnderlineNone
.TypeText "Abbreviations..." + vbLf
.TypeText vbTab + "DAR = "
.Font.Bold = False
.TypeText "Dyspnea at Rest"
.Font.Bold = True
.TypeText vbTab + vbTab + "DOME = "
.Font.Bold = False
.TypeText "Dyspnea on Mild Exertion" + vbLf
.Font.Bold = True
.TypeText vbTab + "ON = "
.Font.Bold = False
.TypeText "Oxygen Needed"
.Font.Bold = True
.TypeText vbTab + vbTab + "OF = "
.Font.Bold = False
.TypeText "Oxygen Flow"
.Font.Bold = True
.TypeText vbLf + vbTab + "OSat = "
.Font.Bold = False
.TypeText "Oxygen Saturation on Room Air"
.Font.Bold = True
.TypeText vbLf + vbTab + "NYHA = "
.Font.Bold = False
.TypeText "New York Heart Association Functional Class"

'Column headings for Cardio-Pulmonary Manifestations of Functional Impairment
.Font.Bold = True
.TypeText vbLf + vbLf + "Date" + vbTab + vbTab + "DAR" + vbTab + vbTab + "DOME" + vbTab + vbTab + "ON" + vbTab + vbTab + "OF" _
+ vbTab + vbTab + "OSat" + vbTab + vbTab + "NYHA"

'Write Data - Cardio-Pulmonary Manifestations of Functional Impairment
.Font.Bold = False
End With
'****************
Do While recqf.EOF = False
With objWD.Selection
.TypeText vbLf
.Font.Bold = False
.TypeText recqf("Evaluation_Date")
.TypeText vbTab + recqf("Dyspnea_At_Rest")
.TypeText vbTab + vbTab + recqf("Dyspnea_On_Min_Exertion")
.TypeText vbTab + vbTab + recqf("Requires_O2")
.TypeText vbTab + vbTab + recqf("Oxygen_Flow")
.TypeText "L/min"
.TypeText vbTab + vbTab + recqf("O2_Sat_RA")
.TypeText "%"
.TypeText vbTab + vbTab + recqf("NYHA_Class")
End With
recqf.MoveNext
Loop

'Return to the first record
recqf.MoveFirst
'**********
'
'Neuro-Muscular Manifestations of Functional Impairment - Header
With objWD.Selection
.TypeText vbLf + vbLf
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeText vbLf + "Neuro-Muscular Manifestations of Functional Impairment" + vbLf

'Legend for Neuro-Muscular Manifestations of Functional Impairment
.Font.Underline = wdUnderlineNone
.TypeText "Abbreviations..." + vbLf
.TypeText vbTab + "SQual = "
.Font.Bold = False
.TypeText "Speech Quality"
.Font.Bold = True
.TypeText vbTab + "SQuan = "
.Font.Bold = False
.TypeText "Speech Quantity"
.Font.Bold = True
.TypeText vbLf + vbTab + "Dysph = "
.Font.Bold = False
.TypeText "Dysphagia"
.Font.Bold = True
.TypeText vbTab + vbTab + "Choke = "
.Font.Bold = False
.TypeText "Choking While Eating"

'Column headings for Neuro-Muscular Manifestations of Functional Impairment
.Font.Bold = True
.TypeText vbLf + vbLf + "Date" + vbTab + vbTab + "SQual" + vbTab + vbTab + "SQuan" _
+ vbTab + vbTab + "Dysph" + vbTab + vbTab + "Choke"

'Write Data - Neuro-Muscular Manifestations of Functional Impairment
.Font.Bold = False
End With
'*****************

Do While recqf.EOF = False
With objWD.Selection
.TypeText vbLf
.Font.Bold = False
.TypeText recqf("Evaluation_Date")
.TypeText vbTab + recqf("Speech_Quality")
End With

If recqf("Speech_Quality") = "Dysarthria" Or recqf("Speech_Quality") = "Un-intelligible" Then
objWD.Selection.TypeText vbTab + recqf("Speech_Quantity")
Else
objWD.Selection.TypeText vbTab + vbTab + recqf("Speech_Quantity")
End If
objWD.Selection.TypeText vbTab + vbTab + recqf("Dysphagia")
If recqf("Dysphagia") = "All foods" Then
objWD.Selection.TypeText vbTab + recqf("Choking_While_Eating")
Else
objWD.Selection.TypeText vbTab + vbTab + recqf("Choking_While_Eating")
End If

recqf.MoveNext
Loop

'Return to the first record
recqf.MoveFirst
'********************

'Ambulation - Manifestations of Functional Impairment - Header
With objWD.Selection
.TypeText vbLf + vbLf
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeText vbLf + "Ambulation - Manifestations of Functional Impairment" + vbLf

'Legend for Ambulation - Manifestations of Functional Impairment
.Font.Underline = wdUnderlineNone
.TypeText "Abbreviations..." + vbLf
.TypeText vbTab + "AmbU = "
.Font.Bold = False
.TypeText "Ambulation Unassisted"
.Font.Bold = True
.TypeText vbTab + "AssiDevi = "
.Font.Bold = False
.TypeText "Assistive Device"
.Font.Bold = True
.TypeText vbLf + vbTab + "PAssist = "
.Font.Bold = False
.TypeText "Person Assist"
.Font.Bold = True
.TypeText vbTab + vbTab + "NA w/a = "
.Font.Bold = False
.TypeText "Non-ambulatory with Assist"

'Column headings for Ambulation - Manifestations of Functional Impairment
.Font.Bold = True
.TypeText vbLf + vbLf + "Date" + vbTab + vbTab + "AmbU" + vbTab + vbTab + "AssiDevi" _
+ vbTab + "PAssist" + vbTab + "NA w/a"
'Write Data - Neuro-Muscular Manifestations of Functional Impairment
.Font.Bold = False
End With
'************
Do While recqf.EOF = False
With objWD.Selection
.TypeText vbLf
.Font.Bold = False
.TypeText recqf("Evaluation_Date")
.TypeText vbTab + recqf("Ambulation_Unassisted")
.TypeText vbTab + vbTab + recqf("Assistive_Device")
End With

If recqf("Assistive_Device") = "Wheelchair" Then
objWD.Selection.TypeText vbTab + recqf("Person_Ambulation_Assist")
Else
objWD.Selection.TypeText vbTab + vbTab + recqf("Person_Ambulation_Assist")
End If
objWD.Selection.TypeText vbTab + vbTab + recqf("Not_Ambulatory_With_Assist")
recqf.MoveNext
Loop

'Return to the first record
recqf.MoveFirst
'**********************

' 'Complications of Functional Impairments - Header
With objWD.Selection
.TypeText vbLf + vbLf
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeText vbLf + "Complications of Functional Impairments" + vbLf

'Legend for Complications of Functional Impairments I
.Font.Underline = wdUnderlineNone
.TypeText "Abbreviations..." + vbLf
.TypeText vbTab + "AspP = "
.Font.Bold = False
.TypeText "Aspiration Pneumonia"
.Font.Bold = True
.TypeText vbTab + vbTab + "DateAP = "
.Font.Bold = False
.TypeText "Date of Aspiration Pneumonia"
.Font.Bold = True
.TypeText vbLf + vbTab + "SuspAsp = "
.Font.Bold = False
.TypeText "Suspected Aspiration"
.Font.Bold = True
.TypeText vbTab + "Sepsis = "
.Font.Bold = False
.TypeText "Sepsis"
.Font.Bold = True
.TypeText vbLf + vbTab + "DateSepsis = "
.Font.Bold = False
.TypeText "Date of Sepsis"

'Column headings for Complications of Functional Impairments I
.Font.Bold = True
.TypeText vbLf + vbLf + "Date" + vbTab + vbTab + "AspP" + vbTab + vbTab + "DateAP" _
+ vbTab + vbTab + "SuspAsp" + vbTab + "Sepsis" + vbTab + vbTab + "DateSepsis"

'Write Data - Complications of Functional Impairments I
.Font.Bold = False
End With
'************

Do While recqf.EOF = False
With objWD.Selection
.TypeText vbLf
.Font.Bold = False
.TypeText recqf("Evaluation_Date")
.TypeText vbTab + recqf("Aspiration_Pneumonia")
.TypeText vbTab + vbTab
End With

If recqf("Aspiration_Pneumonia") = "yes" Then
objWD.Selection.TypeText recqf("Date_Of_Aspiration_Pneumonia")
Else
objWD.Selection.TypeText "N/A" + vbTab
End If
With objWD.Selection
.TypeText vbTab + vbTab + recqf("Suspected_Aspiration")
.TypeText vbTab + vbTab + recqf("History_Of_Sepsis")
End With

If recqf("History_Of_Sepsis") = "yes" Then
With objWD.Selection
.TypeText vbTab + vbTab
.TypeText recqf("Sepsis_Date")
End With
Else
objWD.Selection.TypeText vbTab + vbTab + "N/A"
End If
recqf.MoveNext
Loop

'Return to the first record
recqf.MoveFirst
'*************************************
With objWD.Selection
'Legend for Complications of Functional Impairments II
.Font.Underline = wdUnderlineNone
.Font.Bold = True
.TypeText vbLf + vbLf + "Abbreviations..." + vbLf
.TypeText vbTab + "HxUUTI = "
.Font.Bold = False
.TypeText "History of UUTI"
.Font.Bold = True
.TypeText vbTab + "DateUUTI = "
.Font.Bold = False
.TypeText "Date of UTI"
.Font.Bold = True
.TypeText vbLf + vbTab + "PAF = "
.Font.Bold = False
.TypeText "Post Antibiotic Fever"
.Font.Bold = True
.TypeText vbTab + "DatePAF = "
.Font.Bold = False
.TypeText "Date of Post Antibiotic Fever"
.Font.Bold = True
.TypeText vbLf + vbTab + "PU = "
.Font.Bold = False
.TypeText "Pressure Ulcers"
.Font.Bold = True
.TypeText vbTab + vbTab + "PUS = "
.Font.Bold = False
.TypeText "Pressure Ulcer Stage"

'Column headings for Complications of Functional Impairments II
.Font.Bold = True
.TypeText vbLf + vbLf + "Date" + vbTab + vbTab + "HxUUTI" + vbTab + "DateUUTI" _
+ vbTab + vbTab + "PAF" + vbTab + "DatePAF" + vbTab + vbTab + "PU" + vbTab + "PUS"

'Write Data - Complications of Functional Impairments II
.Font.Bold = False
End With
'************************

Do While recqf.EOF = False
With objWD.Selection
.TypeText vbLf
.Font.Bold = False
.TypeText recqf("Evaluation_Date")
.TypeText vbTab + recqf("HistoryOfUpperUTI")
.TypeText vbTab + vbTab
End With

If recqf("HistoryOfUpperUTI") = "YES" Then
objWD.Selection.TypeText recqf("Date_Of_Upper_UTI")
Else
objWD.Selection.TypeText "N/A" + vbTab
End If

With objWD.Selection
.TypeText vbTab + vbTab
.TypeText recqf("Fever_After_Antibiotic")
End With

If recqf("Fever_After_Antibiotic") = "YES" Then
With objWD.Selection
.TypeText vbTab
.TypeText recqf("Date_Of_Post_Antibiotic_Fever")
End With
Else
objWD.Selection.TypeText vbTab + "N/A" + vbTab + vbTab
End If
With objWD.Selection
.TypeText vbTab + recqf("Pressure_Ulcers")
.TypeText vbTab + recqf("Pressure_Ulcer_Stage")
End With
recqf.MoveNext
Loop

'Move back to first record
recqf.MoveFirst
'*************
'Comments About Functional Impairments - Header
With objWD.Selection
.TypeText vbLf + vbLf
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeText vbLf + "Comments About Functional Impairments" + vbLf

'Enter Comments About Functional Impairments
.Font.Underline = wdUnderlineNone
.Font.Bold = False
End With
'****************

Do While recqf.EOF = False
With objWD.Selection
.TypeText recqf("Evaluation_Date")
.TypeText " - " + recqf("Comments") + vbLf
End With
recqf.MoveNext
Loop

recqf.MoveFirst

'''**************************************** Relevant Diagnoses ******************************************************

'Construct SQL statement for qryRD (Relevant Diagnoses)
strSQL = "SELECT tblPatientInformation.PatientID, tblRelevantDiagnoses.* " & _
" FROM tblPatientInformation, tblRelevantDiagnoses" & _
" WHERE (tblRelevantDiagnoses.PatientID = tblPatientInformation.PatientID) AND (tblRelevantDiagnoses.PatientID = "
strSQL = strSQL + "'" + Me.PatientID + "'" + ") "
strSQL = strSQL + " ORDER BY tblRelevantDiagnoses.EvaluationID;"

Set recrd = dbsCurr.OpenRecordset(strSQL, dbOpenDynaset)

'Hospice Related Diagnoses - Header
With objWD.Selection
.Font.Bold = True
.Font.Size = 12
.TypeText vbLf + vbLf + vbLf
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TypeText "Hospice Related Diagnoses" + vbLf + vbLf
End With

If recrd.EOF = False Then ' no records found
recrd.MoveLast
End If

'**********
'''****************************************** A L S *********************************************************************
'Write Hospice Relevant Diagnoses for ALS to file

If recrd("ALS") = -1 Then

'Construct SQL statement for qryALS Query
strSQL = "SELECT LastName, FirstName, tblALS.* " & _
" FROM tblPatientInformation, tblALS" & _
" WHERE (tblALS.PatientID = tblPatientInformation.PatientID) AND (tblALS.PatientID = "
strSQL = strSQL + "'" + Me.PatientID + "'" + ") "
strSQL = strSQL + " ORDER BY tblALS.EvaluationID;"

Set recqALS = dbsCurr.OpenRecordset(strSQL, dbOpenDynaset)

'Move to last record
recqALS.MoveLast

'Guidelines Header
With objWD.Selection
.Font.Bold = True
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Underline = wdUnderlineSingle
.TypeText "Amyotrophic Lateral Sclerosis"
.Font.Underline = wdUnderlineNone
.TypeText vbLf + vbTab + "Guidelines - " + vbLf + vbTab + vbTab + "A. The patient meets Criteria #1, or"
.TypeText vbLf + vbTab + vbTab + "B. Criteria #2 + Criteria #3, or"
.TypeText vbLf + vbTab + vbTab + "C. Criteria #2 + Criteria #4, or"
.TypeText vbLf + vbTab + vbTab + "D. Criteria #5, or"
.TypeText vbLf + vbTab + vbTab + "E. Criteria #6" + vbLf
End With

'*********
' 'Evaluate 1
If (recqALS("Dyspnea_At_Rest").Value = True _
And recqALS("VC_Less_Than_30").Value = True _
And recqALS("Supplemental_O2_Required").Value = True _
And recqALS("Declines_Artificial_Ventilation").Value = True) Then
objWD.Selection.TypeText vbLf + vbTab + "Criteria #1 Present..."
Else
objWD.Selection.TypeText vbLf + vbTab + "Criteria #1 Absent..."
End If

With objWD.Selection
.TypeText vbLf + "1. Critically impaired breathing capacity "
.Font.Bold = False
.TypeText " with "
.Font.Bold = True
.TypeText "ALL "
.Font.Bold = False
.TypeText "of the following findings:"
End With
'*************
' 'Evaluate 1A
objWD.Selection.ParagraphFormat.LeftIndent = 72

If (recqALS("Dyspnea_At_Rest").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 1A. Dyspnea at rest - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 1A. Dyspnea at rest - "
End With
End If

'Add Comment if there is one
If recqALS("Dyspnea_At_Rest_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Dyspnea_At_Rest_C").Value
End With
End If
'*********
'Evaluate 1B
If (recqALS("VC_Less_Than_30").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 1B. Vital Capacity Less Than 30% of Predicted - "
.Font.Bold = False
.TypeText vbLf + "Vital Capacity = "
.TypeText recqALS("Vital_Capacity").Value
.TypeText "% of predicted"
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 1B. Vital Capacity Less Than 30% of Predicted - "
.Font.Bold = False
.TypeText vbLf + "Vital Capacity = "
.TypeText recqALS("Vital_Capacity").Value
.TypeText "% of predicted"
End With
End If
'Add Comment if there is one
If recqALS("VC_Less_Than_30_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("VC_Less_Than_30_C").Value
End With
End If
'**************
'Evaluate 1C
If (recqALS("Supplemental_O2_Required").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 1C. Supplemental Oxygen Required - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 1C. Supplemental Oxygen Required - "
End With
End If

'Add Comment if there is one
If recqALS("Supplemental_O2_Required_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Supplemental_O2_Required_C").Value
End With
End If

'Evaluate 1D
If (recqALS("Declines_Artificial_Ventilation").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 1D. Declines Artificial Ventilation - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 1D. Declines Artificial Ventilation - "
End With
End If

'Add Comment if there is one
If recqALS("Declines_Artificial_Ventilation_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Declines_Artificial_Ventilation_C").Value
End With
End If
'**********
'Evaluate 2
If (recqALS("Ambulation_To_WC_o_BB").Value = True _
And recqALS("Normal_To_Unintelligible").Value = True _
And recqALS("Normal_To_Pureed").Value = True _
And recqALS("Some_To_All_ADLs").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #2 Present..."
.ParagraphFormat.LeftIndent = 36
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #2 Absent..."
.ParagraphFormat.LeftIndent = 36
End With
End If

With objWD.Selection
.TypeText vbLf + "2.Rapid Disease Progression "
.Font.Bold = False
.TypeText " as evidenced by "
.Font.Bold = True
.TypeText "ALL "
.Font.Bold = False
.TypeText "of the following in the preceding twelve (12) months:"
.ParagraphFormat.LeftIndent = 72
End With

'Evaluate 2A
If (recqALS("Ambulation_To_WC_o_BB").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 2A. Progression from independent ambulation to wheelchair or bed-bound status - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 2A. Progression from independent ambulation to wheelchair or bed-bound status - "
End With
End If

'Add Comment if there is one
If recqALS("Ambulation_To_WC_o_BB_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Ambulation_To_WC_o_BB_C").Value
End With
End If

'Evaluate 2B
If (recqALS("Normal_To_Unintelligible").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 2B. Progression from normal to barely intelligible or unintelligible speech - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 2B. Progression from normal to barely intelligible or unintelligible speech - "
End With
End If

'Add Comment if there is one
If recqALS("Normal_To_Unintelligible_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Normal_To_Unintelligible_C").Value
End With
End If

'Evaluate 2C
If (recqALS("Normal_To_Pureed").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 2C. Progression from normal to pureed diet - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 2C. Progression from normal to pureed diet - "
End With
End If

'Add Comment if there is one
If recqALS("Normal_To_Pureed_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Normal_To_Pureed_C").Value
End With
End If

'Evaluate 2D
If (recqALS("Some_To_All_ADLs").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 2D. Progression from independence in most or all ADLs to needing major assistance by caretaker in all ADLs - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 2D. Progression from independence in most or all ADLs to needing major assistance by caretaker in all ADLs - "
End With
End If

'Add Comment if there is one
If recqALS("Some_To_All_ADLs_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Some_To_All_ADLs_C").Value
End With
End If

'Evaluate 3
If (recqALS("Critical_Nutritional_Impairment").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #3 Present..."
.ParagraphFormat.LeftIndent = 36
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #3 Absent..."
.ParagraphFormat.LeftIndent = 36
End With
End If

With objWD.Selection
.TypeText vbLf + "3. Critical Nutritional Impairment "
.Font.Bold = False
.TypeText " as demonstrated by "
.Font.Bold = True
.TypeText "ALL "
.Font.Bold = False
.TypeText "of the following in the preceding twelve (12) months:"
.ParagraphFormat.LeftIndent = 72
End With
'**********
'Evaluate 3A
If (recqALS("Insufficient_Intake").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 3A. Oral intake of nutrients and fluids insufficient to sustain life - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 3A. Oral intake of nutrients and fluids insufficient to sustain life - "
End With
End If
'Add Comment if there is one
If recqALS("Insufficient_Intake_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Insufficient_Intake_C").Value
End With
End If

'Evaluate 3B
If (recqALS("Continuing_Weight_Loss").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 3B. Continuing Weight Loss - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 3B. Continuing Weight Loss - "
End With
End If
'Add Comment if there is one
If recqALS("Continuing_Weight_Loss_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Continuing_Weight_Loss_C").Value
End With
End If

'Column headers for serial weights
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbTab + "Date" + vbTab + vbTab + "Weight"
End With

recqn.Sort = "CurrentDate"
recqn.MoveFirst

'Put data in Weight History table
Do While recqn.EOF = False
With objWD.Selection
.TypeText vbLf + vbTab
.Font.Bold = False
.TypeText recqn("CurrentDate")
.TypeText vbTab
End With

If recqn("WeightCurrent") > 0 Then
objWD.Selection.TypeText recqn("WeightCurrent")
Else
objWD.Selection.TypeText "Not Done"
End If
recqn.MoveNext
Loop

'Add Comment if there is one
If recqALS("Continuing_Weight_Loss_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Continuing_Weight_Loss_C").Value
End With
End If
'**********
'Evaluate 3C
If (recqALS("Dehydration_Or_Hypovolemia").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 3C. Dehydration or Hypovolemia - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 3C. Dehydration or Hypovolemia - "
End With
End If
'Add Comment if there is one
If recqALS("Dehydration_Or_Hypovolemia_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Dehydration_Or_Hypovolemia_C").Value
End With
End If

'Evaluate 3D
If (recqALS("No_Artificial_Feedings").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 3D. Absence of Artificial Feeding Methods - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 3D. Absence of Artificial Feeding Methods - "
End With
End If
'Add Comment if there is one
If recqALS("No_Artificial_Feedings_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("No_Artificial_Feedings_C").Value
End With
End If

'***
'Evaluate 4
If (recqALS("Life_Threatening_Complications").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #4 Present..."
.ParagraphFormat.LeftIndent = 36
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #4 Absent..."
.ParagraphFormat.LeftIndent = 36
End With
End If

With objWD.Selection
.TypeText vbLf + "4. Life-Threatening Complications "
.Font.Bold = False
.TypeText " as demonstrated by "
.Font.Bold = True
.TypeText "ONE "
.Font.Bold = False
.TypeText "of the following in the preceding twelve (12) months:"
.ParagraphFormat.LeftIndent = 72
End With

'*****
'Evaluate4A
If (recqALS("Recurrent_Aspiration_Pneumonia").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 4A. Recurrent Aspiration Pneumonia (with or without tube feedings) - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 4A. Recurrent Aspiration Pneumonia (with or without tube feedings) - "
End With
End If
'Add Comment if there is one
If recqALS("Recurrent_Aspiration_Pneumonia_C").Value <> "Comment: Date -" Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Recurrent_Aspiration_Pneumonia_C").Value
End With
End If

'Evaluate 4B
If (recqALS("Upper_UTI").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 4B. Upper Urinary Tract Infections (e.g., pyelonephritis) - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 4B. Upper Urinary Tract Infections (e.g., pyelonephritis) - "
End With
End If
'Add Comment if there is one
If recqALS("Upper_UTI_C").Value <> "Comment: Date -" Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Upper_UTI_C").Value
End With
End If

'Evaluate 4C
If (recqALS("Sepsis").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 4C. Sepsis - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 4C. Sepsis - "
End With
End If
'Add Comment if there is one
If recqALS("Sepsis_C").Value <> "Comment: Date -" Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Sepsis_C").Value
End With
End If

'Evaluate 4D
If (recqALS("Recurrent_Fever_After_Antibiotics").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "True 4D. Recurrent Fever After Antibiotics - "
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + "False 4D. Recurrent Fever After Antibiotics - "
End With
End If
'Add Comment if there is one
If recqALS("Recurrent_Fever_After_Antibiotics_C").Value <> "Comment: Date -" Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Recurrent_Fever_After_Antibiotics_C").Value
End With
End If
'********
'Evaluate 5
If (recqALS("Eligible_Due_To_Comorbids").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #5 Present..."
.ParagraphFormat.LeftIndent = 36
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #5 Absent..."
.ParagraphFormat.LeftIndent = 36
End With
End If

With objWD.Selection
.TypeText vbLf + "5. Eligible on the Basis of Comorbid Conditions - "
.ParagraphFormat.LeftIndent = 72
End With

'Add Comment if there is one
If recqALS("Eligible_Due_To_Comorbids_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqALS("Eligible_Due_To_Comorbids_C").Value
End With
End If

'Evaluate 6
If (recqALS("Eligible_Due_To_Rapid_Decline").Value = True) Then
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #6 Present..."
.ParagraphFormat.LeftIndent = 36
End With
Else
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Criteria #6 Absent..."
.ParagraphFormat.LeftIndent = 36
End With
End If

With objWD.Selection
.TypeText vbLf + "6. Eligible on the Basis of Rapid Decline - "
.ParagraphFormat.LeftIndent = 72
.TypeText vbLf
End With

'Add Comment if there is one
If recqALS("Eligible_Due_To_Rapid_Decline_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText recqALS("Eligible_Due_To_Rapid_Decline_C").Value
End With
End If
'****
'Summary - Analyisis of ALS Information Header
With objWD.Selection
.Font.Bold = True
.TypeText vbLf + vbLf + "Summary of ALS Data and Eligibility:"
.ParagraphFormat.LeftIndent = 36
.TypeText vbLf
End With

If (recqALS("Critically_Impaired_Breathing") = True) Or _
((recqALS("Rapid_Disease_Progression") = True) And _
(recqALS("Critical_Nutritional_Impairment") = True)) Or _
((recqALS("Rapid_Disease_Progression") = True) And _
(recqALS("Life_Threatening_Complications") = True)) Or _
(recqALS("Eligible_Due_To_Rapid_Decline") = True) Or _
(recqALS("Eligible_Due_To_Comorbids") = True) Then
objWD.Selection.ParagraphFormat.LeftIndent = 72
With objWD.Selection
.TypeText "This patient is eligible for the hospice benefit with the diagnosis of ALS based upon the presence of:" + vbLf
End With
If (recqALS("Critically_Impaired_Breathing") = True) Then
objWD.Selection.TypeText vbTab + "Criteria #1" + vbLf
End If
If ((recqALS("Rapid_Disease_Progression") = True) And _
(recqALS("Critical_Nutritional_Impairment") = True)) Then
objWD.Selection.TypeText vbTab + "Criteria #2 with Criteria #3" + vbLf
End If
If ((recqALS("Rapid_Disease_Progression") = True) And _
(recqALS("Life_Threatening_Complications") = True)) Then
objWD.Selection.TypeText vbTab + "Criteria #2 with Criteria #4" + vbLf
End If
If recqALS("Eligible_Due_To_Comorbids") = True Then
objWD.Selection.TypeText vbTab + "Criteria #5" + vbLf
End If
If (recqALS("Eligible_Due_To_Rapid_Decline") = True) Then
objWD.Selection.TypeText vbTab + "Criteria #6" + vbLf
End If
With objWD.Selection
.Font.Bold = True
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TypeText vbLf + "********************************"
.TypeText vbLf + vbLf
End With
End If
End If

' '******************************************* Pulmonary Disease ******************************************************
'******

If recrd("Pulmonary_Disease") = -1 Then

'Construct SQL string for qryPD
strSQL = " SELECT PD.*, PI.PatientID, PI.LastName, FIM.EvaluationID, FIM.O2_Sat_RA, NIM.EvaluationID, NIM.WeightCurrent, NIM.Weight6MosAgo," & _
" NIM.Wgt_Loss_6_Mos, NIM.Wgt_Change_Intended" & _
" FROM tblPulmonary PD, tblPatientInformation PI, tblFunctionalImpairmentsMonitor FIM, tblNutritionalImpairmentsMonitor NIM" & _
" WHERE (PD.PatientID = PI.PatientID) And (PD.EvaluationID = FIM.EvaluationID) And (PD.EvaluationID = NIM.EvaluationID) And" & _
" (PD.PatientID = '" & Me.tbPatientID.Value & "') ORDER BY PD.EvaluationID"

Set recqPD = dbsCurr.OpenRecordset(strSQL, dbOpenDynaset)

'Move to last record
recqPD.MoveLast

'Guidelines Header
With objWD.Selection
.Font.Bold = True
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.ParagraphFormat.LeftIndent = 0
.Font.Underline = wdUnderlineSingle
.TypeText "Pulmonary Disease"
.Font.Underline = wdUnderlineNone
.TypeText vbLf + vbTab + "Guidelines - " + vbLf + vbTab + vbTab + "A. The patient meets Criteria #1 + Criteria #2 + Criteria #3, or"
.TypeText vbLf + vbTab + vbTab + "B. Criteria #1 + Criteria #2 + Criteria #4, or"
.TypeText vbLf + vbTab + vbTab + "C. Criteria #5, or"
.TypeText vbLf + vbTab + vbTab + "D. Criteria #6" + vbLf
End With

'Evaluate Criteria #1
If recqPD("Severe_COPD").Value = True Then
objWD.Selection.TypeText vbLf + vbTab + "Criteria #1 Present..."
Else
objWD.Selection.TypeText vbLf + vbTab + "Criteria #1 Absent..."
End If

With objWD.Selection
.TypeText vbLf + vbTab + vbTab + "1. Severe chronic lung disease "
.Font.Bold = False
.TypeText "as evidenced by"
.Font.Bold = True
.TypeText " 1a, 1b, and 1c: "
End With
'********
'Evaluate 1A
If recqPD("Disabling_Dyspnea_At_Rest") = True Then
objWD.Selection.TypeText vbLf + "True"
Else
objWD.Selection.TypeText vbLf + "False"
End If
objWD.Selection.TypeText " 1A. Disabling dyspnea at rest - "
If recqPD("Disabling_Dyspnea_At_Rest_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.ParagraphFormat.LeftIndent = 72
.TypeText vbLf + recqPD("Disabling_Dyspnea_At_Rest_C").Value
.Font.Bold = True
End With
End If

'Evaluate 1B
If recqPD("Poor_Response_To_Bronchodilators") = True Then
objWD.Selection.TypeText vbLf + "True"
Else
obWD.Selection.TypeText vbLf + "False"
End If
objWD.Selection.TypeText " 1B. Poor response to bronchodilators - "
If recqPD("Poor_Response_To_Bronchodilators_C").Value <> "Comment:" Then
With objWD.Selection
.Font.Bold = False
.ParagraphFormat.LeftIndent = 72
.TypeText vbLf + recqPD("Poor_Response_To_Bronchodilators_C").Value
.Font.Bold = True
End With
End If

'Evaluate 1C
If recqPD("Decreased_Functional_Capacity") = True Then
objWD.Selection.TypeText vbLf + "True"
Else
objWD.Selection.TypeText vbLf + "False"
End If
With objWD.Selection
.TypeText " 1C. Decreased Functional Capacity - "
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With

'Evaluate 1C-a
If recqPD("Bed_To_Chair_Existence") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-a. Bed to chair existence - "

If recqPD("Bed_To_Chair_Existence_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Bed_To_Chair_Existence_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If

'Evaluate 1C-b
If recqPD("Fatigue_Due_To_Dyspnea") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-b. Fatigue due to dyspnea - "

If recqPD("Fatigue_Due_To_Dyspnea_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Fatigue_Due_To_Dyspnea_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If

'Evaluate 1C-c
If recqPD("Decreased_Endurance_Due_To_Dyspnea") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-c. Decreased endurance due to dyspnea - "
If recqPD("Decreased_Endurance_Due_To_Dyspnea_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Decreased_Endurance_Due_To_Dyspnea_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If
'**********
'Evaluate 1C-d

If recqPD("Increased_Coughing") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-d. Increased coughing - "
If recqPD("Increased_Coughing_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Increased_Coughing_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If

'Evaluate 1C-e
If recqPD("Increased_Assistance_With_ADLs") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-e. Increased assistance with ADLs - "
If recqPD("Increased_Assistance_With_ADLs_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Increased_Assistance_With_ADLs_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If

'Evaluate 1C-f
If recqPD("Decreased_Ambulation") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-f. Decreased ambulation - "
If recqPD("Decreased_Ambulation_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Decreased_Ambulation_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If

'Evaluate 1C-g
If recqPD("Increased_Time_In_Bed") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-g. Increased time in bed - "
If recqPD("Increased_Time_In_Bed_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Increased_Time_In_Bed_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If

'Evaluate 1C-h
If recqPD("Change_In_Level_Of_Consciousness") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-h. Change in level of consciousness - "
If recqPD("Change_In_Level_Of_Consciousness_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Change_In_Level_Of_Consciousness_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If

'Evaluate 1C-i
If recqPD("Increased_Use_Of_Oxygen") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-i. Increased use of oxygen - "

If recqPD("Increased_Use_Of_Oxygen_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Increased_Use_Of_Oxygen_C").Value
.TypeText vbLf
.Font.Bold = True
.ParagraphFormat.LeftIndent = 98
End With
End If

'Evaluate 1C-j
If recqPD("Increased_Recovery_Time_After_Exertion") = True Then
objWD.Selection.TypeText "True"
Else
objWD.Selection.TypeText "False"
End If
objWD.Selection.TypeText " 1C-j. Increased recovery time after exertion - "
If recqPD("Increased_Use_Of_Oxygen_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + recqPD("Increased_Recovery_Time_After_Exertion_C").Value
.TypeText vbLf
End With
End If
'********
'Evaluate Criteria #2
With objWD.Selection
.ParagraphFormat.LeftIndent = 18
.Font.Bold = True
End With

If recqPD("Progression_Of_End_Stage_Pulmonary_Disease").Value = True Then
objWD.Selection.TypeText vbLf + vbTab + "Criteria #2 Present..."
Else
objWD.Selection.TypeText vbLf + vbTab + "Criteria #2 Absent..."
End If

With objWD.Selection
.TypeText vbLf + vbTab + vbTab + "2. Progression of end stage pulmonary disease "
.Font.Bold = False
.TypeText "as evidenced by the following: "
.Font.Bold = True
End With

'Evaluate 2A
If recqPD("Increased_ER_Visits") = True Then
objWD.Selection.TypeText vbLf + "True"
Else
objWD.Selection.TypeText vbLf + "False"
End If
objWD.Selection.TypeText " 2A. Increased ER visits related to pulmonary problems - "
If recqPD("Increased_ER_Visits_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.ParagraphFormat.LeftIndent = 72
.TypeText vbLf + recqPD("Increased_ER_Visits_C").Value
.Font.Bold = True
End With
End If

'Evaluate 2B
If recqPD("Increased_Hospitalizations") = True Then
objWD.Selection.TypeText vbLf + "True"
Else
objWD.Selection.TypeText vbLf + "False"
End If
objWD.Selection.TypeText " 2B. Increased hospitalizations related to pulmonary problems - "
If recqPD("Increased_Hospitalizations_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.ParagraphFormat.LeftIndent = 72
.TypeText vbLf + recqPD("Increased_Hospitalizations_C").Value
.Font.Bold = True
End With
End If

'Evaluate 2C
If recqPD("Increased_Physician_Visits") = True Then
objWD.Selection.TypeText vbLf + "True"
Else
objWD.Selection.TypeText vbLf + "False"
End If
objWD.Selection.TypeText " 2C. Increased physician visits related to pulmonary problems - "
If recqPD("Increased_Hospitalizations_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.ParagraphFormat.LeftIndent = 72
.TypeText vbLf + recqPD("Increased_Physician_Visits_C").Value
.Font.Bold = True
End With
End If

'Evaluate 2D
If recqPD("Increased_Home_Nurse_Visits") = True Then
objWD.Selection.TypeText vbLf + "True"
Else
objWD.Selection.TypeText vbLf + "False"
End If
objWD.Selection.TypeText " 2D. Increased home nurse visits related to pulmonary problems - "
If recqPD("Increased_Hospitalizations_C").Value <> "Comment: " Then
With objWD.Selection
.Font.Bold = False
.ParagraphFormat.LeftIndent = 72
.TypeText vbLf + recqPD("Increased_Home_Nurse_Visits_C").Value
.Font.Bold = True
End With
End If

'Evaluate Criteria #3
With objWD.Selection
.TypeText vbLf
.ParagraphFormat.LeftIndent = 18
.Font.Bold = True
End With

If recqPD("Hypoxemia_At_Rest").Value = True Then
objWD.Selection.TypeText vbLf + vbTab + "Criteria #3 Present..."
Else
objWD.Selection.TypeText vbLf + vbTab + "Criteria #3 Absent..."
End If

With objWD.Selection
.TypeText vbLf + vbTab + vbTab + "3. Hypoxemia at rest on room air "
.Font.Bold = False
.TypeText "as evidenced by the following: "
.Font.Bold = True
End With

'Evaluate 3A
If recqPD("Arterial_pO2_Less_Than_55") = True Then
objWD.Selection.TypeText vbLf + vbTab + vbTab + "True"
Else
objWD.Selection.TypeText vbLf + vbTab + vbTab + "False"
End If

With objWD.Selection
.TypeText " 3A. Arterial oxygen (within the past 3 months) of < 55 - "
.Font.Bold = True
.TypeText vbLf + vbLf + vbTab + vbTab + vbTab + "Date of ABGs" + vbTab + "po2" + vbTab + "pC02"
End With

If recqPD.BOF <> True Then
recqPD.MoveFirst
End If

Do While recqPD.EOF = False
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + vbTab + vbTab + vbTab
.TypeText recqPD("Date_Of_ABG")
.TypeText vbTab
.TypeText recqPD("Arterial_pO2_On_Room_Air").Value
.TypeText vbTab
.TypeText recqPD("Arterial_pCO2").Value
End With
recqPD.MoveNext
Loop

recqPD.MoveFirst

If recqPD.EOF <> True Then
recqPD.MoveLast
End If

'Evaluate 3B
objWD.Selection.Font.Bold = True
If recqPD("Oxygen_Saturation_Less_Than_89") = True Then
objWD.Selection.TypeText vbLf + vbLf + vbTab + vbTab + "True"
Else
objWD.Selection.TypeText vbLf + vbLf + vbTab + vbTab + "False"
End If

With objWD.Selection
.TypeText " 3B. Oxygen saturation less than 89% - "
.TypeText vbLf + vbLf + vbTab + vbTab + vbTab + "Date of O2 Sat" + vbTab + "O2 Sat"
End With

If recqf.BOF <> True Then
recqf.MoveFirst
End If

Do While recqf.EOF = False
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + vbTab + vbTab + vbTab
.TypeText recqf("Evaluation_Date")
.TypeText vbTab + vbTab
.TypeText recqf("O2_Sat_RA").Value
.TypeText "%"
End With
recqf.MoveNext
Loop
'**********
'Evaluate 4
With objWD.Selection
.TypeText vbLf
.ParagraphFormat.LeftIndent = 18
.Font.Bold = True
End With

If recqPD("Hypercapnea_Of_Greater_Than_50").Value = True Then
objWD.Selection.TypeText vbLf + vbTab + "Criteria #4 Present..."
Else
objWD.Selection.TypeText vbLf + vbTab + "Criteria #4 Absent..."
End If

With objWD.Selection
.TypeText vbLf + vbTab + vbTab + "4. Arterial pCO2 of > 49 "
.Font.Bold = False
.TypeText "- (See ABG results above)"
.TypeText vbLf + vbTab + " Current pCO2 = "
.TypeText recqPD("Arterial_pCO2")
End With

'Supporting Diagnostic Tests / Documentation Header
With objWD.Selection
.Font.Bold = True
.ParagraphFormat.LeftIndent = 36
.TypeText vbLf + vbLf + "SUPPORTING DIAGNOSTIC TESTS / DOCUMENTATION"
End With

'Evaluate SDT/D 1
If recqPD("FEV_1_Post_Bronchodilator_Less_Than_30") = True Then
objWD.Selection.TypeText vbLf + vbTab + "True "
Else
objWD.Selection.TypeText vbLf + vbTab + "False "
End If

With objWD.Selection
.TypeText "1. Forced Expiratory Volume(FEV1)% of predicted is < 30%"
.TypeText vbLf + vbLf + vbTab + "Date of FEV-1" + vbTab + vbTab + "FEV-1% of Predicted"
End With

If recqPD.BOF <> True Then
recqPD.MoveFirst
End If

Do While recqPD.EOF <> True
With objWD.Selection
.Font.Bold = False
.TypeText vbLf + vbTab
.TypeText recqPD("Date_Of_FEV_1")
.TypeText vbTab + vbTab
.TypeText recqPD("FEV_1_Post_Bronchodilator_percent")
' .TypeText "%"
End With
recqPD.MoveNext
Loop
End If

'******

'********************************************* Send to MS Word *****************************************
'Construct report file path and name
recqn.MoveFirst
recqn.MoveLast
file_name = recqn("EvaluationID")
file_path = "C:\Eligibility Evaluation DB\" + file_name + ".doc"

'Save the report to Word document.
objWD.ActiveDocument.SaveAs FileName:=file_path

'Quit Word application and clear the variable from memory.
objWD.Quit
Set objWD = Nothing

'Close all the open recordsets
recqn.Close
recrd.Close
recqf.Close
recqALS.Close
recqPD.Close

'Close dbsCurr
Set dbsCurr = Nothing

'Set the variable (runs new instance of Word.)
Dim objWD2 As Word.Application
Set objWD2 = CreateObject("Word.Application")
objWD2.Documents.Open (file_path)

'Create footer with file name, created on date and time, page #
If objWD2.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
objWD2.ActiveWindow.Panes(2).Close
End If
If objWD2.ActiveWindow.ActivePane.View.Type = wdNormalView Or objWD2.ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
objWD2.ActiveWindow.ActivePane.View.Type = wdPrintView
End If
objWD2.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If objWD2.Selection.HeaderFooter.IsHeader = True Then
objWD2.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
objWD2.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
objWD2.NormalTemplate.AutoTextEntries("Filename").Insert Where:=objWD2.Selection.Range, _
RichText:=True
objWD2.Selection.TypeText Text:=vbTab
objWD2.NormalTemplate.AutoTextEntries("Created on").Insert Where:=objWD2.Selection.Range _
, RichText:=True
objWD2.NormalTemplate.AutoTextEntries("- PAGE -").Insert Where:=objWD2.Selection.Range, _
RichText:=True
objWD2.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

objWD2.Visible = True
Set objWD2 = Nothing

Exit_cmdbCreateReport_Click:
Exit Sub

Err_cmdbCreateReport_Click:
MsgBox Err.Description
Resume Exit_cmdbCreateReport_Click

End Sub

jbotts

ASKER

Sorry for the massive code.
It is getting late here in New Mexico.
Thanks David.

flavo

hmm looking at your decalreations >> dao.Database

It didnt capitalise the dao..

Have you set a refrence to MS DAO Obj Lib?

In VBA window Tools - Refrences and tick it (if not already) from the list

Dave

stevbe

perhaps just the part that shows the checkbox reference and the If part ...

You should always explicitly obtain / set properties with checkboxes in Access, this was a known bug ...

chkMyCheck.Value

can you tell us which exact line is throwing the error?

jbotts

ASKER

The problem is fixed. I had not closed the recordsets inside the If statements and so if I did not check ALS, for instance, the code would try to close recqALS which had not been created. I so much appreciate all the time you guys take to help. Difficult to determine who to give the points to since I didn't give you good information on the problem. Despite that, you all taught me something. Thanks, Jim Botts

VBA MS Access: Runtime error &quot;Object variable not declared or with block variable not set&quot; when using a check box

VBA MS Access: Runtime error "Object variable not declared or with block variable not set" when using a check box