随着医院的发展,服务理念的提升,如何方便病人, 想病人所想成为医院服务的一大关注焦点。为此医院展开了多项改进措施,其中一项:位于挂号收费与药房之间的LED显示屏, 显示内容需进行调整。该显示屏位于医院正门大厅,是病人进入医院后的第一个迎宾大使。除了常规的告知病人开诊信息﹑公开医院收费信息发布公告外等一些变化相对较慢的信息外.还要增加一个新的任务:是在病人完成收费后,告诉病人在哪个窗口取药。
　　问题的提出:如果固定平均的分配病人的所属发药窗口,那么发药药剂师发药速度的不同或有事暂缓等原因,会造成个别窗口病人堆积,而有的窗口却空荡荡。这样势必造成资源浪费﹑病人满意度下降。只有利用网络和HIS系统连结,动态的把病人安排到排队人数最少的窗口,问题才能圆满解决。
　　问题的解决方案: 联系公司HIS相关开发人员,了解到现有的HIS系统已经做了这样人性化的处理.那么问题简化了.我所要做的事情就是在控制大屏的电脑上制作一软件,使其定时访问HIS的数据库,读取病人排队取药的信息数据,然后丢到本地产生大屏显示软件能识别的CSV文件。最后在大屏控制机本地,编辑并显示这个CSV文件。
　　软件运行要求:windows xp 或WINDOWS2000环境,256M以上内存,OFFICE 2000,VB60环境
　　制作步骤:
　　1.装完VB60后,创建本地目录 “d:\大屏\cx\” 供程序执行时从服务器读取数据并生成CSV文件。该CSV文件内容需要定时更新,以取得实时的病人排队取药信息。更新方法为删除原来CSV内容,重新写入.但如果此时大屏软件在同时读取,会造成更新失败,所以需另外 创建目录“d:\大屏\cx\英伍用文件\” ,以供大屏软件运行时,读取数据。
　　2.在上述两个目录中分别用EXCEL创建 mingdan.csv文件.
　　3.用VB设计Form,创建原代码
　　Form:
　　源码:
　　 If (i Mod 5) = 1 Then
　　str = str & vbCrLf
　　 End If
　　 str = str & vbCrLf & Trim(Rs.rdoColumns(0)) & "," & Trim(Rs.rdoColumns(1)) & "号窗口取药"
　　 Rs.MoveNext
　　 i = i + 1
　　 Wend
　　 Rs.Close
　　 'Cnmz.Close
　　'-------------------------------------
　　err:
　　Cnmz.Close
　　Set En = rdoEngine.rdoEnvironments(0) '定义数据库
　　Set Cnmz = En.OpenConnection("fgmz", rdDriverNoPrompt, False, "UID=ff;PWD=fg;")
　　End Sub
　　Private Sub Command2_Click()
　　Cnmz.Close
　　Unload Me
　　End Sub
　　Private Sub Form_Load()
　　 Set En = rdoEngine.rdoEnvironments(0) '定義数据库
　　'Set Cnmz = En.OpenConnection("fgmz", rdDriverNoPrompt, False, "UID=ff;PWD=fg;")
　　 Set Cnmz = En.OpenConnection("fgmz", rdDriverNoPrompt, False, "UID=ff;PWD=fg;")
　　 Form1.WindowState = 1
　　End Sub
　　Private Sub Timer1_Timer()
　　sql = "select getdate()"
　　Set Rs = Cnmz.OpenResultset(sql, 3, rdConcurReadOnly)
　　日期.Caption = Rs(0)
　　Rs.Close
　　End Sub
　　 Private Sub Command3_Click()
　　 Dim result As Long
　　 Dim lenFileop As Long
　　 Dim foBuf() As Byte
　　 Dim fileop As SHFILEOPSTRUCT
　　 lenFileop = LenB(fileop) ' double word alignment increase
　　 ReDim foBuf(1 To lenFileop) ' the size of the structure.
　　 With fileop
　　 .hwnd = Me.hwnd
　　 wFunc = FO_COPY
　　 .fFlags = FOF_NOCONFIRMATION
　　 ' The files to copy separated by Nulls and terminated by two
　　 ' nulls
　　.pFrom = "d:\大屏\cx\mingdan.csv" & vbNullChar & vbNullChar
　　.pTo = "d:\大屏\cx\英伍用文件\mingdan.csv" & vbNullChar & vbNullChar
　　 End With
　　 ' Now we need to copy the structure into a byte array
　　 Call CopyMemory(foBuf(1), fileop, lenFileop)
　　 ' Next we move the last 12 bytes by 2 to byte align the data
　　 Call CopyMemory(foBuf(19), foBuf(21), 12)
　　 result = SHFileOperation(foBuf(1))
　　 If result <> 0 Then ' Operation failed
　　 MsgBox err.LastDllError 'Show the error returned from
　　 'the API.
　　 Else
　　 If fileop.fAnyOperationsAborted <> 0 Then
　　 MsgBox "Operation Failed"
　　 End If
　　 End If
　　 End Sub
　　 Private Sub Timer2_Timer()
　　Command1_Click
　　Command3_Click
　　End Sub