Results 1 to 6 of 6
  1. 08-31-2018, 09:11 AM #1
    Ekhart
    Ekhart is offline Advanced Beginner
    Windows 10 Access 2016
    Join Date
    Jun 2016
    Posts
    80

    Code skipping inputbox

    I have the below code in, there is a section (Bold/Italic below) that is supposed to prompt for an inputbox, however it skips this and just move on with the code. How can I get this to stop there so I can input something and then have it continue after this? I know the code is going through this point because if I place a break in there it stops, and then if I go step by step it prompts just fine.




    Code:
    Public Function AddToConsults() As Boolean
AddToConsults = True
Dim RSSetName As String
Dim RSSetUser As String
Dim RSSetAccess As String
Dim RSSetVerify As String
Dim RSSetSave As String
Dim RSReceiveName As Recordset
Set RSReceiveName = CurrentDb.OpenRecordset("SELECT VHALogin, Fname, Lname, VistaAccess, VistaVerify, SaveVistaLogin FROM tblEmployees WHERE (tblEmployees.[VHALogin]) = '" & GetUserName & "'")
        RSSetName = RSReceiveName!Fname & " " & RSReceiveName!Lname
        RSSetUser = RSReceiveName!VHALogin
        RSSetSave = RSReceiveName!SaveVistaLogin
    If Not IsNull(RSReceiveName!VistaAccess) Then
        RSSetAccess = RSReceiveName!VistaAccess
        RSSetVerify = RSReceiveName!VistaVerify
        
    End If
Dim sendName As Variant
Dim AddComment As String
Dim dbs As Database, rsConsults As Recordset
Dim Reflection As Object
Dim Rst As Recordset
Dim strSQL, tempCheck As String
Dim tempChkNeum, tempDelNuem, tmPause As Integer
Dim blnMove, blncheck, blnStopped As Boolean
Set dbs = CurrentDb
Dim FromForm As String
FromForm = Forms!frmToChart.Form!CN
Set rsConsults = dbs.OpenRecordset("SELECT Scheduler_Sheet.ConsultNumber, Scheduler_Sheet.LastName, Scheduler_Sheet.FirstName, Scheduler_Sheet.SSN, Scheduler_Sheet.Clinic, Scheduler_Sheet.ConsultTitle, Scheduler_Sheet.Program FROM Scheduler_Sheet WHERE (Scheduler_Sheet.[ConsultNumber]) = " & FromForm & "")
On Error GoTo Nosession
Set Reflection = GetObject("R2WIN")
rsConsults.MoveFirst
'Do Until rsConsults.EOF
On Error GoTo 0
With Reflection
If InStr(Reflection.GetText(0, 0, 2, 29), Format(Forms!frmToChart.Form!SSN, "000-00-0000")) > 0 Then
.transmit "cv"
.transmit Chr(13)
Pause (0.2)
.transmit "ss"
.transmit Chr(13)
Pause (0.2)
Else
If InStr(Reflection.GetText(0, 0, 23, 80), "Select: Quit//") > 0 Then
.transmit "SP"
.transmit Chr(13)
Pause (0.2)
ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "Select Patient:") > 0 Then
Else
Call LogInToVista
End If
    If InStr(Reflection.GetText(0, 0, 23, 80), "Select Non VA Care Authorization Main Menu Option:") > 0 Then
    .transmit "^Consult Service Tracking"
    .transmit Chr(13)
    Pause (0.45)
    ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "Select Fee Basis Main Menu Option:") > 0 Then
    .transmit "^Consult Service Tracking"
    .transmit Chr(13)
    Pause (0.45)
    ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "Select Consult User Menu Option:") > 0 Then
    .transmit "^Consult Service Tracking"
    .transmit Chr(13)
    Pause (0.45)

End If
       If InStr(Reflection.GetText(0, 0, 23, 80), "Select Patient:") > 0 Then
            .transmit rsConsults!SSN 'ssn
            .transmit Chr(13)
            Pause (2.5)
            If InStr(Reflection.GetText(0, 0, 23, 80), "... press RETURN to continue ...") > 0 Then
            .transmit Chr(13)
            Pause (0.4)
            End If
       Else
            If InStr(Reflection.GetText(0, 0, 22, 80), "Select Patient:") > 0 Then
            .transmit rsConsults!SSN 'ssn
            .transmit Chr(13)
            Pause (0.45)
            Else
            AddToConsults = False
            MsgBox "I did not land on the SSN screen, please help fix me!"
            .Connected = False
            Exit Function
            End If
       End If
       '******FLAGS
       
       If InStr(Reflection.GetText(0, 0, 23, 80), "Are you sure you wish to continue (Y/N)?") > 0 Then
        .transmit "y"
        .transmit Chr(13)
        Pause (2.1)
    End If
        If InStr(Reflection.GetText(0, 0, 23, 80), "Do you want to continue processing this patient record? No//") > 0 Then
            .transmit "y"
            .transmit Chr(13)
            Pause (2#)
        End If
            If InStr(Reflection.GetText(0, 0, 23, 80), "Do you wish to view active patient record flag details? Yes//") > 0 Then
                .transmit "n"
                .transmit Chr(13)
                Pause (2.1)
            End If
            
            If InStr(Reflection.GetText(0, 0, 23, 80), "... press RETURN to continue ...") > 0 Then
                .transmit Chr(13)
                Pause (2#)
            End If
      
    
    
    
    
    
       If InStr(Reflection.GetText(0, 0, 23, 80), "Select Service/Specialty: ALL SERVICES//") > 0 Then
       ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "Select Patient:") > 0 Then
        Dim WrongSSN As String
        MsgBox "WTF"
       ' WrongSSN = InputBox("Please double check the SSN, it cannot be found in Vista")
        If WrongSSN = vbNullString Then
        On Error Resume Next
        AddToConsults = False
        
        Exit Function
        Else
        Forms!frmToChart.Form!SSN = WrongSSN
        .transmit WrongSSN
        .transmit Chr(13)
        Pause (0.45)
        End If
        End If
    
'ADD MORE FLAGS HERE TO KEEP MOVING
    End If
                
                If InStr(strSQL, "...OK? Yes//") > 0 Then
                            .transmit Chr(13)
                            Pause (2#)
                End If
                    If InStr(Reflection.GetText(0, 0, 23, 80), "Select Service/Specialty: ALL SERVICES//") > 0 Then
                    .transmit Forms!frmToChart.Form!ConsultTitle
                    .transmit Chr(13)
                    Pause (0.4)
                    
                    Else
                    AddToConsults = False
                        MsgBox "Something Went Wrong"
                        Exit Function
                    End If
                    
                    If InStr(Reflection.GetText(0, 0, 23, 80), "List From Starting Date: ALL DATES//") > 0 Then
                        .transmit Chr(13)
                        Pause (1.45)
                    End If
                        If InStr(Reflection.GetText(0, 0, 23, 80), "Select: Quit//") > 0 Then
                        'Call FindCorrectConsult
                        If FindCorrectConsult = False Then
                        MsgBox "There do not seem to be any consults for this Veteran with this information, or this consult is an old title."
                        AddToConsults = False
                        Exit Function
                        End If
                    End If
 '******INSERT CONSULT GRAB HERE!!!
 
 
 
    Select Case Forms!frmToChart.OptionCase
    Case 1 'ADD COMMENT
        .transmit "CM"
        .transmit Chr(13)
        .transmit Forms!frmToChart.Form!ConsultAddComment.Value
        .transmit Chr(5)
        .transmit "y"
        .transmit Chr(13)
        Pause (0.45)
        Call AddSigners
        
        
    Case 2 'RECEIVE
        .transmit "RC"
        .transmit Chr(13)
            If InStr(Reflection.GetText(0, 0, 23, 80), "Who received it?:") > 0 Then
            MsgBox RSSetName
                .transmit RSSetName
                .transmit Chr(13)
                Pause (0.45)
                If InStr(Reflection.GetText(0, 0, 23, 80), "Date/Time Actually Received NOW//") > 0 Then
                .transmit Chr(13)
                Pause (0.45)
                .transmit Forms!frmToChart.Form!ConsultAddComment
                .transmit Chr(5)
                .transmit "y"
                .transmit Chr(13)
                Pause (0.45)
                End If
            Else
            If InStr(Reflection.GetText(0, 0, 22, 80), "RC is not a valid selection.") > 0 Then
            Else
                If InStr(Reflection.GetText(0, 0, 22, 80), "This consult has already been Cancelled.") > 0 Then
                MsgBox "This consult cannot be received."
                Else
                MsgBox "Something happened, I cannot finish the process."
                End If
            End If
            End If
    Case 3 'COMPLETE
        .transmit "ct"
        .transmit Chr(13)
        'FindCorrectConsult
        Pause (0.3)
            If InStr(Reflection.GetText(0, 0, 23, 80), "Administratively complete this request?") > 0 Then
            Pause (0.2)
            .transmit "y"
            .transmit Chr(13)
            Pause (0.3)
            Else
            MsgBox "I ran into an error processing this, I don't think this consult can be completed, please try again."
            .transmit "^"
            .transmit Chr(13)
            Exit Function
            End If
                If InStr(Reflection.GetText(0, 0, 23, 80), "Responsible Clinician:") > 0 Then
                .transmit RSSetName
                .transmit Chr(13)
                Pause (0.45)
                Else
                MsgBox "I ran in to an error adding resposible party"
                End If
                    If InStr(Reflection.GetText(0, 0, 23, 80), "Actual Date/Time of Activity:") > 0 Then
                    .transmit Chr(13)
                    Pause (0.2)
                    If InStr(Reflection.GetText(0, 0, 23, 80), "Are there significant findings? (Y/N/U):") > 0 Then
                    .transmit "U"
                    .transmit Chr(13)
                    Pause (0.5)
                    .transmit Forms!frmToChart.Form!ConsultAddComment
                    .transmit Chr(5)
                    .transmit "y"
                    .transmit Chr(13)
                    Pause (0.45)
                    End If
                    End If
    
    Case 4 'DC
    On Error GoTo DCERROR
    Forms!frmToChart.AddAlert = True
        .transmit "DC"
        .transmit Chr(13)
        Pause (0.3)
                If InStr(Reflection.GetText(0, 0, 23, 80), "Responsible Clinician:") > 0 Then
                .transmit RSSetName
                .transmit Chr(13)
                Pause (0.85)
                Else
                FindCorrectConsult
                Pause (0.85)
                .transmit RSSetName
                .transmit Chr(13)
                Pause (0.85)
                'MsgBox "I ran in to an error adding resposible party"
                'Exit Function
                End If
                    If InStr(Reflection.GetText(0, 0, 23, 80), "Actual Date/Time of Activity:") > 0 Then
                    .transmit Chr(13)
                    Pause (0.5)
                    .transmit Forms!frmToChart.Form!ConsultAddComment
                    .transmit Chr(5)
                    .transmit "y"
                    .transmit Chr(13)
                    Pause (0.45)
        Forms!frmToChart.AddAlert = True
        .transmit "CM"
        .transmit Chr(13)
        .transmit "Please ensure authorization is cancelled"
        .transmit Chr(5)
        .transmit "y"
        .transmit Chr(13)
        Pause (0.45)
'        Call AddSigners
                    Dim AlertName As String
     Dim NameSelect As String
If InStr(Reflection.GetText(0, 0, 23, 80), "Additional alert recipients:") > 0 Then
        If Forms!frmToChart.Form!AddAlert = True Then
        AlertName = InputBox("Please enter a name for the alert.  Format Lastname,FirstName")
            If AlertName = "" Then
            .transmit Chr(13)
            Else
            .transmit AlertName
            .transmit Chr(13)
            Pause (0.45)
            End If
                Do While Forms!frmToChart.Form!AddAlert = True
                    If InStr(Reflection.GetText(0, 0, 23, 80), "And Additional alert recipients:") > 0 Then
                        AlertName = InputBox("Please enter an additional name for the alert.  Click OK if no additional alerts required!!!")
                        If AlertName = "" Then
                        .transmit Chr(13)
                        Forms!frmToChart.Form!AddAlert = False
                        Exit Do
                        Else
                        .transmit AlertName
                        .transmit Chr(13)
                        End If
                    
                    
                    ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "CHOOSE") > 0 Then
                        NameSelect = InputBox("Please select which name you wish to add from Vista.")
                        If NameSelect = "" Then
                        MsgBox "You must select one"
                        Exit Function
                        Else
                        .transmit NameSelect
                        .transmit Chr(13)
                        End If
                    Else
                    Forms!frmToChart.Form!AddAlert = False
                    Exit Do
                    End If
                Loop
           End If
        Else
        .transmit Chr(13)
    End If
'TEST ENDS HERE
            Else
            MsgBox "Something happened, I cannot finish the process."
            Exit Function
            End If
    
    End Select
End With
Exit Function
DCERROR: MsgBox "DC ERROR"
Exit Function
Nosession: MsgBox "You need an active session of Vista open"
End Function
    Reply With Quote Reply With Quote
  2. 08-31-2018, 10:01 AM #2
    ranman256's Avatar
    ranman256
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,525
    this is commented out: 'WrongSSN = InputBox(...

    the alerts: AlertName = InputBox(...
    have conditions....did you check to see if they were true? (stop points)
    Reply With Quote Reply With Quote
  3. 08-31-2018, 10:56 AM #3
    Ekhart
    Ekhart is offline Advanced Beginner
    Windows 10 Access 2016
    Join Date
    Jun 2016
    Posts
    80
    It is meant to be commented out. The Alertname is true (I currently have it automatically setting it to true in the code for testing).
    Reply With Quote Reply With Quote
  4. 08-31-2018, 11:03 AM #4
    ranman256's Avatar
    ranman256
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,525
    did you put break points on the IF above the InputBox to test?
    when the code hits the inputbox, does it ask?
    Reply With Quote Reply With Quote
  5. 08-31-2018, 11:09 AM #5
    Ekhart
    Ekhart is offline Advanced Beginner
    Windows 10 Access 2016
    Join Date
    Jun 2016
    Posts
    80
    Yes if I use break points and step by step it will pop up as it should.
    Reply With Quote Reply With Quote
  6. 08-31-2018, 08:27 PM #6
    ssanfu
    ssanfu is offline Master of Nothing
    Windows 7 32bit Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Don't see anything obvious. Maybe it is a timing issue. You say HOW (the code) you are doing something, but not WHAT you are trying to do.

    Can't test anything because there are missing routines (Pause, LogInToVista, FindCorrectConsult and AddSigners)

    What is "Reflection"??


    There are many lines like
    Code:
    If InStr(Reflection.GetText(0, 0, 23, 80), "Actual Date/Time of Activity:") > 0 Then
    Why don't you create a variable, say "ReflectionGetText", then use it something like
    Code:
        Dim ReflectionGetText As String
    .
 
    ReflectionGetText = Reflection.GetText(0, 0, 23, 80)
    If InStr(ReflectionGetText, "Additional alert recipients:") > 0 Then

    End If
    If InStr(ReflectionGetText, "Administratively complete this request?") > 0 Then

    End If
    If InStr(ReflectionGetText, "Select Service/Specialty: ALL SERVICES//") > 0 Then

    End If
    Might save lots of time.....


    -----------------------------------------------------
    Some errors:
    Code:
    Dim blnMove, blncheck, blnStopped As Boolean
    In this line, "blnMove" and "blncheck" are declared as Variants and only "blnStopped" is declared as a Boolean.
    In VBA, variables MUST be explicitly declared, otherwise they are Variant by default.


    Code:
                    If InStr(strSQL, "...OK? Yes//") > 0 Then
    Here, "strSQL" is never set to any value; it is a Null String.


    When you populate a record set, you should ALWAYS check to see if there are records returned before continuing on. (I learned that the hard way! )


    Another problem is that you never close the record sets and never destroy the objects.


    Code:
    Option Compare Database
Option Explicit
    Do you have these two lines at the top of EVERY module?? (you should!)


    The only time you should use the "GOTO" command is for error handlers.


    I re-arranged you code (in my style ) and added a couple of comments.
    Code:
    Option Compare Database
Option Explicit

Public Function AddToConsults() As Boolean
    Dim dbs As DAO.Database
    Dim rsConsults As DAO.Recordset
    Dim RSReceiveName As DAO.Recordset
    ' Dim Rst As DAO.Recordset   '<<--- variable not used
    Dim Reflection As Object

    Dim AddComment As String
    Dim AlertName As String
    Dim FromForm As String
    Dim NameSelect As String
    Dim RSSetName As String
    Dim RSSetUser As String
    Dim RSSetAccess As String
    Dim RSSetVerify As String
    Dim RSSetSave As String
    Dim strSQL As String
    Dim tempCheck As String
    Dim WrongSSN As String

    Dim blnMove As Boolean
    Dim blncheck As Boolean
    Dim blnStopped As Boolean
    Dim tempChkNeum As Integer
    Dim tempDelNuem As Integer
    Dim tmPause As Integer

    Dim GetUserName   '<<-- ??? by default, this is a Variant
    Dim sendName As Variant

    Set dbs = CurrentDb

    AddToConsults = True

    strSQL = "SELECT VHALogin, Fname, Lname, VistaAccess, VistaVerify, SaveVistaLogin"
    strSQL = strSQL & " FROM tblEmployees"
    strSQL = strSQL & " WHERE (tblEmployees.[VHALogin]) = '" & GetUserName & "'"
    '    Debug.Print strSQL
    Set RSReceiveName = CurrentDb.OpenRecordset(strSQL)
    '****
    ' !!! need to check if the recordset has records
    '****

    RSSetName = RSReceiveName!Fname & " " & RSReceiveName!Lname
    RSSetUser = RSReceiveName!VHALogin
    RSSetSave = RSReceiveName!SaveVistaLogin
    If Not IsNull(RSReceiveName!VistaAccess) Then
        RSSetAccess = RSReceiveName!VistaAccess
        RSSetVerify = RSReceiveName!VistaVerify
    End If

    FromForm = Forms!frmToChart.Form!CN

    strSQL = "SELECT Scheduler_Sheet.ConsultNumber, Scheduler_Sheet.LastName,"
    strSQL = strSQL & " Scheduler_Sheet.FirstName, Scheduler_Sheet.SSN, Scheduler_Sheet.Clinic,"
    strSQL = strSQL & " Scheduler_Sheet.ConsultTitle, Scheduler_Sheet.Program"
    strSQL = strSQL & " FROM Scheduler_Sheet"
    strSQL = strSQL & " WHERE(Scheduler_Sheet.[ConsultNumber]) = '" & FromForm & "'"
    '    Debug.Print strSQL
    Set rsConsults = dbs.OpenRecordset(strSQL)
    '****
    ' !!! need to check if the recordset has records
    '****

    strSQL = vbNullString   'clear the variable

    On Error GoTo Nosession
    Set Reflection = GetObject("R2WIN")

    rsConsults.MoveFirst
    'Do Until rsConsults.EOF

    On Error GoTo 0

    With Reflection
        If InStr(Reflection.GetText(0, 0, 2, 29), Format(Forms!frmToChart.Form!SSN, "000-00-0000")) > 0 Then
            .transmit "cv"
            .transmit Chr(13)
            Pause (0.2)
            .transmit "ss"
            .transmit Chr(13)
            Pause (0.2)
        Else
            If InStr(Reflection.GetText(0, 0, 23, 80), "Select: Quit//") > 0 Then
                .transmit "SP"
                .transmit Chr(13)
                Pause (0.2)
            ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "Select Patient:") > 0 Then

            Else
                Call LogInToVista
            End If

            If InStr(Reflection.GetText(0, 0, 23, 80), "Select Non VA Care Authorization Main Menu Option:") > 0 Then
                .transmit "^Consult Service Tracking"
                .transmit Chr(13)
                Pause (0.45)
            ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "Select Fee Basis Main Menu Option:") > 0 Then
                .transmit "^Consult Service Tracking"
                .transmit Chr(13)
                Pause (0.45)
            ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "Select Consult User Menu Option:") > 0 Then
                .transmit "^Consult Service Tracking"
                .transmit Chr(13)
                Pause (0.45)
            End If

            If InStr(Reflection.GetText(0, 0, 23, 80), "Select Patient:") > 0 Then
                .transmit rsConsults!SSN    'ssn
                .transmit Chr(13)
                Pause (2.5)
                If InStr(Reflection.GetText(0, 0, 23, 80), "... press RETURN to continue ...") > 0 Then
                    .transmit Chr(13)
                    Pause (0.4)
                End If
            Else
                If InStr(Reflection.GetText(0, 0, 22, 80), "Select Patient:") > 0 Then
                    .transmit rsConsults!SSN    'ssn
                    .transmit Chr(13)
                    Pause (0.45)
                Else
                    AddToConsults = False
                    MsgBox "I did not land on the SSN screen, please help fix me!"
                    .Connected = False
                    Exit Function
                End If
            End If
            '******FLAGS

            If InStr(Reflection.GetText(0, 0, 23, 80), "Are you sure you wish to continue (Y/N)?") > 0 Then
                .transmit "y"
                .transmit Chr(13)
                Pause (2.1)
            End If
            If InStr(Reflection.GetText(0, 0, 23, 80), "Do you want to continue processing this patient record? No//") > 0 Then
                .transmit "y"
                .transmit Chr(13)
                Pause (2#)
            End If
            If InStr(Reflection.GetText(0, 0, 23, 80), "Do you wish to view active patient record flag details? Yes//") > 0 Then
                .transmit "n"
                .transmit Chr(13)
                Pause (2.1)
            End If

            If InStr(Reflection.GetText(0, 0, 23, 80), "... press RETURN to continue ...") > 0 Then
                .transmit Chr(13)
                Pause (2#)
            End If

            If InStr(Reflection.GetText(0, 0, 23, 80), "Select Service/Specialty: ALL SERVICES//") > 0 Then
                'do nothing
            ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "Select Patient:") > 0 Then
                MsgBox "WTF"
                ' WrongSSN = InputBox("Please double check the SSN, it cannot be found in Vista")
                If WrongSSN = vbNullString Then
                    On Error Resume Next
                    AddToConsults = False
                    '****
                    'need to clean up before exiting
                    '****
                    Exit Function
                Else
                    Forms!frmToChart.Form!SSN = WrongSSN
                    .transmit WrongSSN
                    .transmit Chr(13)
                    Pause (0.45)
                End If
            End If

            'ADD MORE FLAGS HERE TO KEEP MOVING
        End If

        If InStr(strSQL, "...OK? Yes//") > 0 Then   '<<-- "strSQL" never set to a value!!
            .transmit Chr(13)
            Pause (2#)
        End If
        If InStr(Reflection.GetText(0, 0, 23, 80), "Select Service/Specialty: ALL SERVICES//") > 0 Then
            .transmit Forms!frmToChart.Form!ConsultTitle
            .transmit Chr(13)
            Pause (0.4)
        Else
            AddToConsults = False
            MsgBox "Something Went Wrong"
            '****
            'need to clean up before exiting
            '****
            Exit Function
        End If

        If InStr(Reflection.GetText(0, 0, 23, 80), "List From Starting Date: ALL DATES//") > 0 Then
            .transmit Chr(13)
            Pause (1.45)
        End If
        If InStr(Reflection.GetText(0, 0, 23, 80), "Select: Quit//") > 0 Then
            'Call FindCorrectConsult
            If FindCorrectConsult = False Then
                MsgBox "There do not seem to be any consults for this Veteran with this information, or this consult is an old title."
                AddToConsults = False
                '****
                'need to clean up before exiting
                '****
                Exit Function
            End If
        End If
        '******INSERT CONSULT GRAB HERE!!!

        Select Case Forms!frmToChart.OptionCase
            Case 1    'ADD COMMENT
                .transmit "CM"
                .transmit Chr(13)
                .transmit Forms!frmToChart.Form!ConsultAddComment.Value
                .transmit Chr(5)
                .transmit "y"
                .transmit Chr(13)
                Pause (0.45)
                Call AddSigners

            Case 2    'RECEIVE
                .transmit "RC"
                .transmit Chr(13)
                If InStr(Reflection.GetText(0, 0, 23, 80), "Who received it?:") > 0 Then
                    MsgBox RSSetName
                    .transmit RSSetName
                    .transmit Chr(13)
                    Pause (0.45)
                    If InStr(Reflection.GetText(0, 0, 23, 80), "Date/Time Actually Received NOW//") > 0 Then
                        .transmit Chr(13)
                        Pause (0.45)
                        .transmit Forms!frmToChart.Form!ConsultAddComment
                        .transmit Chr(5)
                        .transmit "y"
                        .transmit Chr(13)
                        Pause (0.45)
                    End If
                Else
                    If InStr(Reflection.GetText(0, 0, 22, 80), "RC is not a valid selection.") > 0 Then
                    Else
                        If InStr(Reflection.GetText(0, 0, 22, 80), "This consult has already been Cancelled.") > 0 Then
                            MsgBox "This consult cannot be received."
                        Else
                            MsgBox "Something happened, I cannot finish the process."
                        End If
                    End If
                End If

            Case 3    'COMPLETE
                .transmit "ct"
                .transmit Chr(13)
                'FindCorrectConsult
                Pause (0.3)
                If InStr(Reflection.GetText(0, 0, 23, 80), "Administratively complete this request?") > 0 Then
                    Pause (0.2)
                    .transmit "y"
                    .transmit Chr(13)
                    Pause (0.3)
                Else
                    MsgBox "I ran into an error processing this, I don't think this consult can be completed, please try again."
                    .transmit "^"
                    .transmit Chr(13)
                    Exit Function
                End If
                If InStr(Reflection.GetText(0, 0, 23, 80), "Responsible Clinician:") > 0 Then
                    .transmit RSSetName
                    .transmit Chr(13)
                    Pause (0.45)
                Else
                    MsgBox "I ran in to an error adding resposible party"
                End If
                If InStr(Reflection.GetText(0, 0, 23, 80), "Actual Date/Time of Activity:") > 0 Then
                    .transmit Chr(13)
                    Pause (0.2)
                    If InStr(Reflection.GetText(0, 0, 23, 80), "Are there significant findings? (Y/N/U):") > 0 Then
                        .transmit "U"
                        .transmit Chr(13)
                        Pause (0.5)
                        .transmit Forms!frmToChart.Form!ConsultAddComment
                        .transmit Chr(5)
                        .transmit "y"
                        .transmit Chr(13)
                        Pause (0.45)
                    End If
                End If

            Case 4    'DC
                On Error GoTo DCERROR
                Forms!frmToChart.AddAlert = True
                .transmit "DC"
                .transmit Chr(13)
                Pause (0.3)
                If InStr(Reflection.GetText(0, 0, 23, 80), "Responsible Clinician:") > 0 Then
                    .transmit RSSetName
                    .transmit Chr(13)
                    Pause (0.85)
                Else
                    FindCorrectConsult
                    Pause (0.85)
                    .transmit RSSetName
                    .transmit Chr(13)
                    Pause (0.85)
                    'MsgBox "I ran in to an error adding resposible party"
                    'Exit Function
                End If
                If InStr(Reflection.GetText(0, 0, 23, 80), "Actual Date/Time of Activity:") > 0 Then
                    .transmit Chr(13)
                    Pause (0.5)
                    .transmit Forms!frmToChart.Form!ConsultAddComment
                    .transmit Chr(5)
                    .transmit "y"
                    .transmit Chr(13)
                    Pause (0.45)
                    Forms!frmToChart.AddAlert = True
                    .transmit "CM"
                    .transmit Chr(13)
                    .transmit "Please ensure authorization is cancelled"
                    .transmit Chr(5)
                    .transmit "y"
                    .transmit Chr(13)
                    Pause (0.45)
                    '        Call AddSigners


'error here??
' Maybe try adding some delays

                    If InStr(Reflection.GetText(0, 0, 23, 80), "Additional alert recipients:") > 0 Then
                        If Forms!frmToChart.Form!AddAlert = True Then
                            AlertName = InputBox("Please enter a name for the alert.  Format Lastname,FirstName")
                            If AlertName = "" Then
                                .transmit Chr(13)
                            Else
                                .transmit AlertName
                                .transmit Chr(13)
                                Pause (0.45)
                            End If
                            Do While Forms!frmToChart.Form!AddAlert = True
                                If InStr(Reflection.GetText(0, 0, 23, 80), "And Additional alert recipients:") > 0 Then
                                    AlertName = InputBox("Please enter an additional name for the alert.  Click OK if no additional alerts required!!!")
                                    If AlertName = "" Then
                                        .transmit Chr(13)
                                        Forms!frmToChart.Form!AddAlert = False
                                        Exit Do
                                    Else
                                        .transmit AlertName
                                        .transmit Chr(13)
                                    End If
                                ElseIf InStr(Reflection.GetText(0, 0, 23, 80), "CHOOSE") > 0 Then
                                    NameSelect = InputBox("Please select which name you wish to add from Vista.")
                                    If NameSelect = "" Then
                                        MsgBox "You must select one"
                                        '****
                                        'need to clean up before exiting
                                        '****
                                        Exit Function
                                    Else
                                        .transmit NameSelect
                                        .transmit Chr(13)
                                    End If
                                Else
                                    Forms!frmToChart.Form!AddAlert = False
                                    Exit Do
                                End If
                            Loop
                        End If
                    Else
                        .transmit Chr(13)
                    End If
                    'TEST ENDS HERE
                Else
                    MsgBox "Something happened, I cannot finish the process."
                    Exit Function
                End If

        End Select
    End With

CleanUp:       'ADDED
    On Error Resume Next
    'close
    Reflection.Close
    rsConsults.Close
    RSReceiveName.Close

    'destroy
    Set Reflection = Nothing
    Set rsConsults = Nothing
    Set RSReceiveName = Nothing
    Set dbs = Nothing

    Exit Function

DCERROR:
    MsgBox "DC ERROR"
    Resume CleanUp

Nosession:
    MsgBox "You need an active session of Vista open"
    Resume CleanUp
End Function
    Reply With Quote Reply With Quote
Please reply to this thread with any new information or opinions.
« Previous Thread | Next Thread »

Similar Threads

  1. Populating Inputbox
    By DMT Dave in forum Programming
    Replies: 6
    Last Post: 06-07-2018, 04:37 AM
  2. *** mask password in inputbox
    By Kvracing in forum Modules
    Replies: 13
    Last Post: 11-21-2014, 07:22 AM
  3. Inputbox
    By mladen273 in forum Programming
    Replies: 8
    Last Post: 12-29-2012, 05:32 AM
  4. Inputbox on programming? :(
    By radicrains in forum Programming
    Replies: 7
    Last Post: 11-05-2010, 10:58 PM
  5. Query & InputBox
    By RemusRigo in forum Queries
    Replies: 1
    Last Post: 03-25-2009, 08:21 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Forum Rules

Other Forums: Microsoft Office Forums