|
The
code was modified anyway. Thanks for letting me know
though!
Thought I was
sending it to someone directly, rookie
mistake!
Jason,
You
may want to change this user and password for your system now. Unless
you changed that prior to this send.
Tom
Dwyer
Dim strText As
String
On Error GoTo
exit_meditech
If Not Active Then Connect "C:\Program
Files\Meditech\Workstation3.x\T.exe", stMeditech,
"connect_2"
'**********************************************
' Login to MEDITECH
'**********************************************
Pause "<Return> to
continue"
Enter
Pause "User
ID"
Key
"hisjps"
Enter
Pause
"Password"
Key
"nissan"
Enter
Pause "Application
Databases"
Key
"2"
Enter
strText = Now & " -
Successful login to MEDITECH" &
vbCrLf
write_to_file
(strText)
'**********************************************
'Login completed - Process MIDAS ADT
Download
'**********************************************
Pause "MEDICAL CITY DALLAS
**LIVE**"
Wait
3
Pause "MEDICAL CITY
DALLAS"
Key
"30"
Enter
Wait
0.5
Enter
Wait
0.5
Enter
Wait
0.5
Pause "Print
on:"
Key
"DOWNLOAD"
Enter
Enter
Wait
4
Connect "Save As",
stWindows 'sometimes does not
connect here ??
Wait
5
SendKeys
("I:\Upload\ADTDOWN.asc")
SendKeys ("%S") 'Sends Alt S to the Save As screen saving the
file name
Wait
2
Connect "connect_2",
stStream
Pause "End of
report."
Enter
strText = Now & " -
Successful save of ADT" &
vbCrLf
write_to_file
(strText)
'**********************************************
' Go back to menu
'**********************************************
Pause "MEDICAL CITY DALLAS"
Key "40"
Enter
Wait
0.5
'**********************************************
' MIDAS ADT download complete - Process MIDAS DAB
download
'**********************************************
Pause "MIS Spooling Menu"
Key
"50"
Enter
Wait
0.5
Key
"54"
Enter
Wait
1
Key
"t"
Enter
Wait
0.5
Key
"t"
Enter
Wait
1
Key
"{F10}"
Wait
0.5
Key
"H.QMDABST"
Enter
Wait
0.5
Enter
Pause "Print
on:"
Key
"VIEW"
Enter
Wait
20
t$ = View(Row:=6, col:=1,
length:=17) 'No records found.
If t$ = "No records found."
Then
'Need to exit
meditech
strText = Now & " - Error: No records found in DAB - Exiting MEDITECH"
&
vbCrLf
write_to_file
(strText)
Close_Meditech
Enter
Exit Sub
Else
t$ = View(Row:=15, col:=36,
length:=5)
End
If
Key
"{F11}"
Pause
"Exit?"
Key
"Y"
Enter
Key
"{F11}"
Pause "MIS Spooling
Menu"
Key
"19"
'TRANSMIT
Enter
Wait
1
Key
t$
Wait
1
Enter
'needs error
checking
Wait
1
If At("Use Position 1 For
Printer Control?")
Then
Enter
Key
"V"
Enter
Wait
0.5
Enter
Wait
0.5
Key
"Y"
Wait
0.5
Enter
Wait
0.5
Enter
Wait
0.5
Enter
Pause "Download to your
PC?"
Key
"Y"
Wait
0.5
Enter
Wait 4
Connect "Save As",
stWindows
Wait 5
SendKeys
("I:\Upload\DABDOWN.asc")
SendKeys ("%S") 'Sends Alt S to the Save As screen saving the
file
name
Wait 2
Connect "connect_2",
stStream
Pause
"Completed."
Enter
strText = Now & " - Successful download of DAB" &
vbCrLf
write_to_file
(strText)
'**********************************************
' MIDAS DAB download complete - Close
MEDITECH
'**********************************************
Close_Meditech
'COMPLETED
Else
strText = Now & " - Error: Download of DAB Not completed - Spool
file unavailable." &
vbCrLf
write_to_file
(strText)
Close_Meditech
End
If
Shutdown =
True
Exit
Sub
exit_meditech:
Close_Meditech
End Sub
|
