jiancha.frm

小型医院管理

End Sub

Private Sub cmdSave_Click()
 
End Sub

Private Sub Command1_Click()

Dim sql As String
sql = "select * from 检查结果 where 姓名 like '%" & Trim(v_name.Text) & "%' and  卡号 like '%" & Trim(v_car.Text) & "%' order by -id"
Dim rs As New ADODB.Recordset
rs.Open sql, db



Adodc1.CommandType = adCmdText
Adodc1.ConnectionString = db
Adodc1.RecordSource = sql
Set DataGrid1.DataSource = Adodc1
Adodc1.Refresh
End Sub

Private Sub Command10_Click()



If txtFilePath1.Text = "" Then
b1 = MsgBox("警告，请浏览一个图片地址！", vbQuestion, "系统提示！")
Exit Sub
End If


'---------------生成一个文件，以时间没名字

        c = Now
        c = Replace(c, "-", "")
        c = Replace(c, ":", "")
        c = Replace(c, " ", "")

a = txtFilePath1.Text
b = "\\qyt-001\pic_up\" & c & ".jpg"     '存放安装目录下的data_bak下
'b = "\\PC-200805311221\pic_up\" & c & ".jpg"     '存放安装目录下的data_bak下




FileCopy a, b







Dim sql As String
sql = "update 检查结果 set 图片1='" & Trim(b) & "' where id=" & Trim(v_id.Caption)


Dim rs As New ADODB.Recordset
rs.Open sql, db


b1 = MsgBox("提示，诊图片绑定完成！", vbQuestion, "系统提示！")












End Sub

Private Sub Command11_Click()





If txtFilePath2.Text = "" Then
b1 = MsgBox("警告，请浏览一个图片地址！", vbQuestion, "系统提示！")
Exit Sub
End If


'---------------生成一个文件，以时间没名字

        c = Now
        c = Replace(c, "-", "")
        c = Replace(c, ":", "")
        c = Replace(c, " ", "")

a = txtFilePath2.Text
b = "\\qyt-001\pic_up\" & c & ".jpg"     '存放安装目录下的data_bak下
'b = "\\PC-200805311221\pic_up\" & c & ".jpg"     '存放安装目录下的data_bak下




FileCopy a, b







Dim sql As String
sql = "update 检查结果 set 图片2='" & Trim(b) & "' where id=" & Trim(v_id.Caption)


Dim rs As New ADODB.Recordset
rs.Open sql, db


b1 = MsgBox("提示，诊图片绑定完成！", vbQuestion, "系统提示！")







End Sub

Private Sub Command12_Click()






If txtFilePath3.Text = "" Then
b1 = MsgBox("警告，请浏览一个图片地址！", vbQuestion, "系统提示！")
Exit Sub
End If


'---------------生成一个文件，以时间没名字

        c = Now
        c = Replace(c, "-", "")
        c = Replace(c, ":", "")
        c = Replace(c, " ", "")

a = txtFilePath3.Text
b = "\\qyt-001\pic_up\" & c & ".jpg"     '存放安装目录下的data_bak下
'b = "\\PC-200805311221\pic_up\" & c & ".jpg"     '存放安装目录下的data_bak下




FileCopy a, b


Dim sql As String
sql = "update 检查结果 set 图片3='" & Trim(b) & "' where id=" & Trim(v_id.Caption)


Dim rs As New ADODB.Recordset
rs.Open sql, db


b1 = MsgBox("提示，诊图片绑定完成！", vbQuestion, "系统提示！")









End Sub

Private Sub Command13_Click()


Dim rs As New ADODB.Recordset
Dim sql As String
sql = "select * from 患者信息 where 卡号='" + Trim(CStr(v_car.Text)) + "'"
rs.Open sql, db
If Not rs.EOF Then

v_name.Text = rs("姓名")
v_old.Text = rs("年龄")
Call Command1_Click


Else
b1 = MsgBox("警告，此卡号不存在！", vbQuestion, "系统提示！")
v_car.SetFocus
End If


End Sub

Private Sub Command14_Click()






Dim sql As String
sql = "update 检查结果 set 主诉='" & Trim(v_zhushu.Text) & "' ,现病史='" & Trim(v_xianbs.Text) & "',既往史='" & Trim(v_jws.Text) & "',检查结果='" & Trim(v_tol.Text) & "',建议='" & Trim(v_jianyi.Text) & "',治疗手段='" & Trim(v_shouduan.Text) & "',诊断='" & Trim(v_zhenduan.Text) & "' where id=" & Trim(v_id.Caption)
Dim rs As New ADODB.Recordset
rs.Open sql, db


b1 = MsgBox("提示，诊断完成！", vbQuestion, "系统提示！")




End Sub

Private Sub Command2_Click()









If v_car.Text = "" Then
b1 = MsgBox("警告，卡号不能为空！", vbQuestion, "系统提示！")
v_car.SetFocus
Exit Sub
End If


If v_name.Text = "" Then
b1 = MsgBox("警告，姓名不能为空！", vbQuestion, "系统提示！")
v_name.SetFocus
Exit Sub
End If


If v_zhushu.Text = "" Then
b1 = MsgBox("警告，主诉不能为空！", vbQuestion, "系统提示！")
v_zhushu.SetFocus
Exit Sub
End If

If v_xianbs.Text = "" Then
b1 = MsgBox("警告，现病史不能为空！", vbQuestion, "系统提示！")
v_xianbs.SetFocus
Exit Sub
End If


If v_jws.Text = "" Then
b1 = MsgBox("警告，既往史不能为空！", vbQuestion, "系统提示！")
v_jws.SetFocus
Exit Sub
End If





'If v_jianyi.Text = "" Then
'b1 = MsgBox("警告，诊断建议不能为空！", vbQuestion, "系统提示！")
'v_jianyi.SetFocus
'Exit Sub
'End If






Dim sql1 As String
sql1 = "select * from 检查结果 where 卡号='" & Trim(v_car.Text) & "' and 日期='" & Trim(Now) & "'"
Dim rs1 As New ADODB.Recordset
rs1.Open sql1, db

If Not rs1.EOF Then

b1 = MsgBox("警告：1天只能检查1次！", vbQuestion, "系统提示！")

Else



Dim sql As String
sql = "insert into 检查结果 (卡号,姓名,主诉,现病史,既往史,检查结果,建议,治疗手段,诊断,日期) values ('" & Trim(v_car.Text) & "','" & Trim(v_name.Text) & "','" & Trim(v_zhushu.Text) & "','" & Trim(v_xianbs.Text) & "','" & Trim(v_jws.Text) & "','" & Trim(v_tol.Text) & "','" & Trim(v_jianyi.Text) & "','" & Trim(v_shouduan.Text) & "','" & Trim(v_zhenduan.Text) & "','" & Trim(Date) & "')"
Dim rs As New ADODB.Recordset
rs.Open sql, db


b1 = MsgBox("提示，诊断完成！", vbQuestion, "系统提示！")

End If

End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Command4_Click()


t_jianyi = v_jianyi.Text
t_car = v_car.Text






jianyishu.Show 1
End Sub

Private Sub Command5_Click()
   '选择 JPG OR Bmp 文件
    On Error Resume Next
    With cmdlFilePath
        .Filter = "JPG Files|*.JPG|Bitmaps|*.BMP|gif Files|*.gif"
        .ShowOpen
        txtFilePath1.Text = .FileName
    End With
    
    
    

If txtFilePath1.Text = "" Then
Picture2.Picture = LoadPicture(test.v_path & "load_pic.jpg")
Else
Picture2.Picture = LoadPicture(txtFilePath1.Text)
End If
    
End Sub

Private Sub Command6_Click()
   '选择 JPG OR Bmp 文件
    On Error Resume Next
    With cmdlFilePath
        .Filter = "JPG Files|*.JPG|Bitmaps|*.BMP|gif Files|*.gif"
        .ShowOpen
        txtFilePath3.Text = .FileName
    End With
    
    
    

If txtFilePath3.Text = "" Then
Picture4.Picture = LoadPicture(test.v_path & "load_pic.jpg")
Else
Picture4.Picture = LoadPicture(txtFilePath3.Text)
End If
    
End Sub

Private Sub Command7_Click()
   '选择 JPG OR Bmp 文件
    On Error Resume Next
    With cmdlFilePath
        .Filter = "JPG Files|*.JPG|Bitmaps|*.BMP|gif Files|*.gif"
        .ShowOpen
        txtFilePath2.Text = .FileName
    End With
    
    
    

If txtFilePath2.Text = "" Then
Picture3.Picture = LoadPicture(test.v_path & "load_pic.jpg")
Else
Picture3.Picture = LoadPicture(txtFilePath2.Text)
End If
    
End Sub

Private Sub Command8_Click()


t_car = v_car.Text
bingzhi.Show 1
End Sub

Private Sub Command9_Click()









If txtFilePath.Text = "" Then
b1 = MsgBox("警告，请浏览一个图片地址！", vbQuestion, "系统提示！")
Exit Sub
End If



'---------------生成一个文件，以时间没名字

        c = Now
        c = Replace(c, "-", "")
        c = Replace(c, ":", "")
        c = Replace(c, " ", "")

a = txtFilePath.Text
b = "\\qyt-001\pic_up\" & c & ".jpg"     '存放安装目录下的data_bak下
'b = "\\PC-200805311221\pic_up\" & c & ".jpg"     '存放安装目录下的data_bak下




FileCopy a, b



    



Dim sql As String
sql = "update 检查结果 set 图片='" & Trim(b) & "' where id=" & Trim(v_id.Caption)



Dim rs As New ADODB.Recordset
rs.Open sql, db


b1 = MsgBox("提示，诊图片绑定完成！", vbQuestion, "系统提示！")







End Sub

Private Sub DataGrid1_Click()

On Error Resume Next


v_id.Caption = CStr(Adodc1.Recordset.Fields("id"))
v_name.Text = CStr(Adodc1.Recordset.Fields("姓名"))
v_car.Text = CStr(Adodc1.Recordset.Fields("卡号"))

t_id = v_id.Caption




     Dim sql1 As String
    sql1 = "select * from 检查结果 where id=" & Trim(v_id.Caption)
    Dim rs1 As New ADODB.Recordset
    rs1.Open sql1, db

    If Not rs1.EOF Then
    
    v_tol.Text = Trim(rs1("检查结果"))
    v_jianyi.Text = Trim(rs1("建议"))
    v_shouduan.Text = Trim(rs1("治疗手段"))
    
    
    v_zhushu.Text = Trim(rs1("主诉"))
    v_xianbs.Text = Trim(rs1("现病史"))
    v_jws.Text = Trim(rs1("既往史"))
    
    v_zhenduan.Text = Trim(rs1("诊断"))
    
    Picture1.Picture = LoadPicture(Trim(rs1("图片")))
    
    Picture2.Picture = LoadPicture(Trim(rs1("图片1")))
    
    Picture3.Picture = LoadPicture(Trim(rs1("图片2")))
    
    Picture4.Picture = LoadPicture(Trim(rs1("图片3")))
    
Command2.Enabled = False
Command14.Enabled = True
    
    Else
    
    v_tol.Text = ""
    v_jianyi.Text = ""
    
      
    End If
    Set rs1 = Nothing









End Sub

Private Sub Picture1_Click()


t_pic = "1"
pic_big.Show 1

End Sub

Private Sub Picture2_Click()

t_pic = "2"
pic_big.Show 1

End Sub

Private Sub Picture3_Click()

t_pic = "3"
pic_big.Show 1

End Sub

Private Sub Picture4_Click()

t_pic = "4"
pic_big.Show 1

End Sub

Private Sub v_jianyi_DblClick()
s_jielun.Show 1
End Sub

Private Sub v_jws_DblClick()
s_jielun2.Show 1
End Sub

Private Sub v_shouduan_DblClick()
s_jielun4.Show 1
End Sub

Private Sub v_tol_DblClick()
s_jielun1.Show 1
End Sub

Private Sub v_xianbs_DblClick()
s_jielun3.Show 1
End Sub

Private Sub v_zhenduan_DblClick()
s_jielun5.Show 1
End Sub