• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 335
  • Last Modified:

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

I have a dao record set, recrd, with a field ALS which is a True/False variable.  A form has a checkbox with the record source as recrd("ALS"). using the following If statement:

If recrd("ALS").Value = True Then
      do stuff....
End If

When the checkbox on the form is checked, the If statement executes properly.  If the checkbox is not checked I get the error "Object variable not declared or with block variable not set." It seems the If statement works as it should when the value is true, but not if it is false. I have debugged using Debug.Print recrd("ALS") and the values return as they should, true when the checkbox is checked and false when the checkbox is false.
0
jbotts
Asked:
jbotts
1 Solution
 
flavoCommented:
try

 If rs("ALS") = -1 Then
0
 
flavoCommented:
sorry

If recrd("ALS") = -1 Then
0
 
jbottsAuthor Commented:
Dave,
   I tried and it didn't work.
Thanks,
Jim
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
flavoCommented:
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....
0
 
jbottsAuthor Commented:
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
0
 
jbottsAuthor Commented:
Sorry for the massive code.
It is getting late here in New Mexico.
Thanks David.
0
 
flavoCommented:
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
0
 
stevbeCommented:
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?
0
 
pique_techCommented:
'''****************************************** A L S *********************************************************************
    'Write Hospice Relevant Diagnoses for ALS to file
   

    If recrd("ALS") = -1 Then


If this is the line you referred to in your question, then where is the .Value ?  Is there simply a typo, or do you not have the .Value property referenced in your code?  I don't know if it's relevant or not.

Also, this seems to be about recordset value comparisons.  How could a form value influence the outcome of this particular code snippet?

Are you sure that the field ALS in the underlying datasource has type boolean?  And is the checkbox where you originally set the value NOT triple-state (capable of saving Null)?  If it were, you might get unexpected results if the user left it blank when the record was created/saved and thus left a Null in the ALS field.
0
 
jbottsAuthor Commented:
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
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now