sk_hj03.frm

小型医院管理

'-----------------------------------
'床费

Dim v_ke11, v_zhaoxiang As String

v_ke11 = "床费"

Dim rk As New ADODB.Recordset
Dim sqlk As String
sqlk = "select * from [消耗表] where 科别='" & Trim(v_ke11) & "' and  操作员='" + Trim(v_denglu.v_name1) + "'"
rk.Open sqlk, db

If Not rk.EOF Then


Dim rk1 As New ADODB.Recordset
Dim sqlk1 As String
sqlk1 = "select sum(价格) as 床费 from [消耗表] where 科别='" & Trim(v_ke11) & "' and  操作员='" + Trim(v_denglu.v_name1) + "'"
rk1.Open sqlk1, db
v_chuangfei = rk1("床费")
Else
v_chuangfei = 0
End If




'-----------------------------------
'体检费
Dim v_ke12, v_bc As String

v_ke12 = "体检费"

Dim rm As New ADODB.Recordset
Dim sqlm As String
sqlm = "select * from [消耗表] where 科别='" & Trim(v_ke12) & "' and  操作员='" + Trim(v_denglu.v_name1) + "'"
rm.Open sqlm, db

If Not rm.EOF Then


Dim rm1 As New ADODB.Recordset
Dim sqlm1 As String
sqlm1 = "select sum(价格) as 体检费 from [消耗表] where 科别='" & Trim(v_ke12) & "' and  操作员='" + Trim(v_denglu.v_name1) + "'"
rm1.Open sqlm1, db
v_tijianfei = rm1("体检费")
Else
v_tijianfei = 0
End If

'MsgBox (v_bc)



'---------------------------------


'装换大小写
 Dim txtJE As Double
 txtJE = v_count.Caption
 
 
'Call Num2Chi(txtJE)
 
 Call strUCaseMoney(txtJE)
 
 
v_zt = "0"
Dim rs8 As New ADODB.Recordset
Dim sql8 As String
sql8 = "insert into 收费表 (编码,姓名,性别,医生,科别,日期,金额,西药费,中成药,中草药,检查费,电诊费,化验费,照透费,治疗费,处置费,手术费,床费,体检费,操作员,状态,大写金额) values ('" + Trim(v_car.Text) + "','" + Trim(v_name.Text) + "','" + Trim(v_sex.Text) + "','" + Trim(v_ys.Text) + "','" + Trim(v_bumen.Text) + "','" + Trim(v_sj.Value) + "','" + Trim(v_count.Caption) + "','" + Trim(v_xiyao) + "','" + Trim(v_zhongcheng) + "','" + Trim(v_zhongcao) + "','" + Trim(v_jianchafei) + "','" + Trim(v_dianzhenfei) + "','" + Trim(v_huayanfei) + "','" + Trim(v_zhaotoufei) + "','" + Trim(v_zhiliaofei) + "','" + Trim(v_chuzhifei) + "','" + Trim(v_shoushufei) + "','" + Trim(v_chuangfei) + "','" + Trim(v_tijianfei) + "','" + Trim(v_denglu.v_name1) + "','" + Trim(v_zt) + "','" + CStr(v_daxie.Caption) + "')"
rs8.Open sql8, db



'清空临时表数据

Dim rs0 As New ADODB.Recordset
Dim sql0 As String
sql0 = "delete 临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "' "
rs0.Open sql0, db


'把消耗表里是化验的数据写入收费明细表


Dim rs001 As New ADODB.Recordset
Dim sql001 As String
sql001 = "select * from 消耗表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "'"
rs001.Open sql001, db

bb001 = 0
Do While Not rs001.EOF


    If Trim(rs001("flag")) = 1 Then

        Dim sqlu As String
        Dim rsu As New ADODB.Recordset
        sqlu = "insert into 药品销售表 (卡号,药品名称,单价,数量,金额,操作员,日期) values ('" + Trim(rs001("卡号")) + "','" + Trim(rs001("项目")) + "','" + Trim(rs001("价格")) + "','" + Trim(rs001("数量")) + "','" + Trim(rs001("价格") * rs001("数量")) + "','" + CStr(v_denglu.v_name1) + "','" + CStr(v_sj.Value) + "')"
        rsu.Open sqlu, db
        Set rsu = Nothing
        
    End If
    
    
    
        Dim rs002 As New ADODB.Recordset
        Dim sql0002 As String
        v_bm = "0"
        sql002 = "insert into 收费明细表 (卡号,项目,价格,科别,医生,时间,部门,数量,患者名称,flag) values ('" + Trim(rs001("卡号")) + "','" + rs001("项目") + "','" + CStr(rs001("价格")) + "','" + rs001("科别") + "','" + v_ys.Text + "','" + CStr(Date) + "','" + CStr(v_bm) + "','" + CStr(rs001("数量")) + "','" + CStr(rs001("患者名称")) + "','" + rs001("flag") + "')"
        rs002.Open sql002, db
        Set rs002 = Nothing
    

rs001.MoveNext
bb001 = bb001 + 1
Loop




'清空消耗表数据

Dim rs01 As New ADODB.Recordset
Dim sql01 As String
sql01 = "delete 消耗表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "' "
rs01.Open sql01, db




'清空药品临时表







Dim rs0a As New ADODB.Recordset
Dim sql0a As String
sql0a = "delete 药品临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "' "
rs0a.Open sql0a, db

'-----------------------------------------------
c = MsgBox("是否打印发票？", vbOKCancel, "系统提示")

If c = 1 Then

sk_hj04.Show
Unload Me

Else

b1 = MsgBox("提示，收款完毕！", vbQuestion, "系统提示！")
End If
Exit Sub


End If

End Sub

Private Sub Command5_Click()

b1 = MsgBox("是否清空数据？", vbOKCancel, "系统提示！")
If b1 = 1 Then

'清空药品临时表数据

'Dim rs1 As New ADODB.Recordset
'Dim sql1 As String
'sql1 = "delete 药品临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "'"
'rs1.Open sql1, db



'清空临时表数据

Dim rs0 As New ADODB.Recordset
Dim sql0 As String
sql0 = "delete 临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "'"
rs0.Open sql0, db

Dim sql As String
sql = "select * from 临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "'"
Dim rs As New ADODB.Recordset
rs.Open sql, db

If Not rs.EOF Then
Set DataGrid1.DataSource = rs
End If


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

Private Sub Command6_Click()
Dim sql1 As String
If Option1.Value = True Then
sql1 = "select * from 儿保信息 where 姓名='" + Trim(s_ma.Text) + "'order by -id"
End If

If Option2.Value = True Then
sql1 = "select * from 儿保信息 where 母亲姓名='" + Trim(s_ma.Text) + "'order by -id"
End If

If Option3.Value = True Then
sql1 = "select * from 儿保信息 where 编码='" + Trim(s_ma.Text) + "'order by -id"
End If

Dim rs1 As New ADODB.Recordset
rs1.Open sql1, db
If Not rs1.EOF Then

v_bianma = Trim(rs1("编码"))
v_name = Trim(rs1("姓名"))
v_sex = Trim(rs1("性别"))
v_mama = Trim(rs1("母亲姓名"))
v_mama = Trim(rs1("母亲姓名"))
v_xingbie = Trim(rs1("性别"))
v_hk = Trim(rs1("户口"))
v_danwei = Trim(rs1("工作单位"))
v_souce = Trim(rs1("保健手册"))
v_tel = Trim(rs1("联系电话"))



Else
b1 = MsgBox("警告，没有查到数据！", vbQuestion, "系统提示！")
v_name.Text = ""
s_ma.SetFocus

Exit Sub

End If
End Sub

Private Sub Command7_Click()
sk_danshou.Show
End Sub

Private Sub Command8_Click()
b1 = MsgBox("是否放弃？", vbOKCancel, "系统提示！")
If b1 = 1 Then


'清空药品临时表数据

Dim rs As New ADODB.Recordset
Dim sql As String
sql = "delete 药品临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "'"
rs.Open sql, db



'清空临时表数据

Dim rs0 As New ADODB.Recordset
Dim sql0 As String
sql0 = "delete 临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "'"
rs0.Open sql0, db

Unload Me
End If
End Sub

Private Sub Command9_Click()

If v_name.Text = "" Then
a = MsgBox("先输入姓名才能生成编码？", vbInformation, "系统提示！")
v_name.SetFocus

Else

Dim v_bianma1, v_name1, v_sex1, v_nian1, v_ys1, v_bumen1, v_hk1, v_sj1

v_bianma1 = Trim(v_bianma.Text)
v_name1 = Trim(v_name.Text)
v_sex1 = Trim(v_sex.Text)
v_sj1 = Trim(v_sj.Value)
v_hk1 = Trim(v_hk.Text)
v_bumen1 = Trim(v_bumen.Text)
v_ys1 = Trim(v_ys.Text)



'#####################################################生成编码号


v_nian1 = "200419"


'获得出始数，然后递增1

Dim sql1 As String
sql1 = "select * from 儿保信息 where 户口编码='" + CStr(v_hkma) + "'order by -id"
Dim rs1 As New ADODB.Recordset
rs1.Open sql1, db
If Not rs1.EOF Then
v_chu = rs1("开始数")
v_chu = v_chu + 1
Else
v_chu = 1000
End If

v_bianma = Trim(v_nian1 & v_chu)
v_bianma.Text = v_bianma



Dim sql As String
sql = "insert into 儿保信息(编码,开始数,姓名,出生日期,户口,母亲姓名,联系电话,工作单位,保尝,保健手册,高危儿,医生,性别,时间,年龄,户口编码) values ('" & v_bianma & "','" & v_chu & "','" & v_name1 & "','" & v_sj & "','" & v_hk & "','" & v_ma & "','" & v_tel & "','" & v_address & "','" & v_bc & "','" & v_sc & "','" & v_gw & "','" & v_ys & "','" & v_sex1 & "','" & CStr(Date) & "','" & v_old & "','" & v_hkma & "')"
Dim rs As New ADODB.Recordset
rs.Open sql, db

v_hk.Text = "其它"
MsgBox ("自动生成编码为：" + v_bianma)
End If
End Sub

Private Sub Form_Load()
v_sj.Value = Date

'获的医生姓名


Dim v_bumen As String
v_bumen = "儿保"
v_bumen1 = "妇保"

Dim rs48 As New ADODB.Recordset
Dim sql48 As String

sql48 = "select distinct(姓名) from 人名 where 部门='" + Trim(v_bumen) + "' or 部门='" + Trim(v_bumen1) + "'"
rs48.Open sql48, db

While Not rs48.EOF
v_ys.AddItem IIf(IsNull(rs48!姓名), "", rs48!姓名)
rs48.MoveNext
Wend


End Sub

Private Sub Timer1_Timer()

Dim sql As String
sql = "select 项目名称,价格  from 临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "'"
Dim rs As New ADODB.Recordset
rs.Open sql, db

If Not rs.EOF Then
Set DataGrid1.DataSource = rs
End If


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


'获得金额

Dim rs1 As New ADODB.Recordset
Dim sql1 As String
sql1 = "select sum(价格) as 金额 from 临时表 where 操作员='" + Trim(CStr(v_denglu.v_name1)) + "'"
rs1.Open sql1, db
If Not rs.EOF Then
v_count = rs1("金额")
Else
v_count = 0
End If

v_count.Caption = v_count

End Sub

Private Sub v_ys_Click()

Dim sql1 As String
sql1 = "select distinct(部门) from 人名 where 姓名='" & Trim(v_ys.Text) & "' "
Dim rs1 As New ADODB.Recordset
rs1.Open sql1, db
If Not rs1.EOF Then

v_bumen = rs1("部门")

Else

v_bumen = "无"

End If
End Sub