Tải bản đầy đủ (.doc) (141 trang)

Code SQL.doc

Bạn đang xem bản rút gọn của tài liệu. Xem và tải ngay bản đầy đủ của tài liệu tại đây (230.39 KB, 141 trang )

Option Explicit
Dim MaBenhNhan$, MaBenhNhanLst$, MaCoQuanlst$
Dim CoLuu$
Private Sub chkCoQuan_Click()
Dim MaCoQuan$, TenCoQuan$, DienThoai$, Fax$
If chkCoQuan.Value = 1 Then ' Nut duoc chon
frmDanhSachCoQuan.Show 1
frmDanhSachCoQuan.clCoQuan.TTcoQuanRa MaCoQuan,
TenCoQuan, _
DienThoai, Fax
If MaCoQuan <> "" Then
txtMaCoQuan.Text = Trim(MaCoQuan)
txtTenCoQuan.Text = TenCoQuan
txtDienThoaiCoQuan.Text = DienThoai
txtFaxCoQuan.Text = MaCoQuan
Else
chkCoQuan.Value = 0
End If
Else
frmDanhSachCoQuan.clCoQuan.SetNull
End If
End Sub
Private Sub cmdLuu_Click()
Dim NgayBatDau$, NgayKetThuc$
Dim SQL$, SoTheBaoHiem$, SQLBenhNhan$
Dim PhanTram As Currency
Dim MaCoQuan$, TenCoQuan$, DienThoai$, Fax$
Dim CoLuuCoQuan As Boolean
'-------------------------------------------
NgayBatDau = SuLiNgay(marNgayBatDau.Text)
NgayKetThuc = SuLiNgay(marNgayKetThuc.Text)


'------------------------------------------------------------
frmDanhSachCoQuan.clCoQuan.TTcoQuanRa MaCoQuan, TenCoQuan,
_
DienThoai, Fax
frmDanhSachCoQuan.clCoQuan.SetNull ' Lay thong tin xong set null bien
'---------------------------
CoLuuCoQuan = False
If Trim(MaCoQuan) <> "" Then
CoLuuCoQuan = True
End If
'------------------------------------------------------------
If Trim(txtPhanTram.Text <> "") Then
PhanTram = Trim(txtPhanTram.Text)
Else
PhanTram = 0
End If
'------------------------------------------------------
If CoLuu = "Moi" Then 'Che do Tao Moi
SoTheBaoHiem = Trim(txtSoTheBaoHiem.Text)
If SoTheBaoHiem = "" Then 'Kiem tra so the
MsgBox "Ban chua nhap so the bao hiem", vbInformation
Exit Sub
Else
SQL = "Select SoTheBHYT From tblBaoHiemYTe Where
SoTheBHYT=" & _
SoTheBaoHiem
If Kt_Text(SQL) = False Then ' So the da co
MsgBox "Ban vui long sua lai so the bao hiem, so nay da co trong
CSDL", vbCritical
Exit Sub

Else ' So the Da duoc chap nhan
SQLBenhNhan = "Select SoTheBHYT From tblBaoHiemYTe
Where MaBenhNhan=" & _
MaBenhNhan
If Kt_Text(SQLBenhNhan) = False Then 'Xem benh nhan da luu
the chua
MsgBox "Benh nhan nay da luu the bao hiem roi", vbCritical
Exit Sub
Else ' Benh nhan chua luu bao hiem y te
'---------- Kiem tra ngay thang ------------------------------
If (NgayBatDau = "NotOK") Or (NgayKetThuc = "NotOK")
Then
MsgBox "Ban vui long kiem tra lai ngay thang vua nhap" &
Chr(13) & Chr(10) & _
"Ngay bat dau hoac ngay ket thuc khong hop le",
vbCritical
Exit Sub
Else
If (Date - DateValue(NgayBatDau) < 0) Or (Date -
DateValue(NgayBatDau) > 1600) Then
MsgBox " Ngay bat dau khong hop le, ngay nay sau ngay
hien tai" & Chr(13) & Chr(10) _
& "hoac truoc ngay hien tai lau qua roi",
vbCritical
Exit Sub
End If
If (DateValue(NgayKetThuc) - DateValue(NgayBatDau) < 0)
Or (DateValue(NgayKetThuc) - Date > 400) Then
MsgBox "Ngay bat dau sau ngay ket thuc hoac ngay ket
thuc qua xa(sau ngay hien tai lau qua roi)", vbCritical

Exit Sub
End If ' Ngay ket thuc co truoc ngay bat dau?
End If ' Kiem tra ngay bat dau, ket thuc
'---------- Ket thuc kiem tra ngay thang -----------
End If ' benh nhan da luu the chua
'-------- kiem tra phan tram --------------
If PhanTram < 1 Then
MsgBox "Phan tram bao hiem < 0", vbCritical
Exit Sub
Else
If PhanTram > 99 Then
MsgBox "Phan tram khong duoc lon hon 100"
Exit Sub
End If
End If 'Kiem tra phan tram
End If ' End If so the da co
DE.sp_NhapBaoHiem MaBenhNhan, SoTheBaoHiem, _
Format(NgayBatDau, "dd/mm/yyyy"), _
Format(NgayKetThuc, "dd/mm/yyyy"), PhanTram
'----- 'Benh nhan co the bao hiem y te thuoc co quan
If CoLuuCoQuan = True Then
DE.sp_NhapCanBo MaBenhNhan, MaCoQuan
End If
DisPlayListBaoHiem
SetNull
End If
Else ' Colu= Sua
'----- Sua ban tin ----------
If CoLuu = "Sua" Then 'Sua ban tin
'---------- Kiem tra ngay thang ------------------------------

SoTheBaoHiem = Trim(txtSoTheBaoHiem.Text)
If (NgayBatDau = "NotOK") Or (NgayKetThuc = "NotOK") Then
MsgBox "Ban vui long kiem tra lai ngay thang vua nhap" &
Chr(13) & Chr(10) & _
"Ngay bat dau hoac ngay ket thuc khong hop le",
vbCritical
Exit Sub
Else
If (Date - DateValue(NgayBatDau) < 0) Or (Date -
DateValue(NgayBatDau) > 1600) Then
MsgBox " Ngay bat dau khong hop le, ngay nay sau ngay hien
tai" & Chr(13) & Chr(10) _
& "hoac truoc ngay hien tai lau qua roi", vbCritical
Exit Sub
End If
If (DateValue(NgayKetThuc) - DateValue(NgayBatDau) < 0) Or
(DateValue(NgayKetThuc) - Date > 400) Then
MsgBox "Ngay bat dau sau ngay ket thuc hoac ngay ket thuc
qua xa(sau ngay hien tai lau qua roi)", vbCritical
Exit Sub
End If ' Ngay ket thuc co truoc ngay bat dau?
End If ' Kiem tra ngay bat dau, ket thuc
'---------- Ket thuc kiem tra ngay thang -----------
If Trim(MaBenhNhan = "") Then MaBenhNhan = MaBenhNhanLst
'If Trim(MaCoQuan = "") Then MaCoQuan = MaCoQuanlst
If PhanTram < 1 Then
MsgBox "Phan tram bao hiem < 0", vbCritical
Exit Sub
Else
If PhanTram > 99 Then

MsgBox "Phan tram khong duoc lon hon 100"
Exit Sub
End If
End If 'Kiem tra phan tram
DE.sp_SuaBaoHiem MaBenhNhan, SoTheBaoHiem, _
Format(NgayBatDau, "dd/mm/yyyy"), _
Format(NgayKetThuc, "dd/mm/yyyy"), PhanTram
'----- Sua Ma co quan sau do sua MaBenhNhan trong tblCanBo
' Truong hop truoc do benh nhan chua thuoc co quan nao ca
If (Trim(MaCoQuan) <> "") And (Trim(MaCoQuanlst) = "") Then
DE.sp_NhapCanBo MaBenhNhan, MaCoQuan
Else
' Truong hop truoc do benh nhan da tuoc mot co quan
If (Trim(MaCoQuan) <> "") And (MaCoQuanlst <> "") Then
' De phong truong hop nguoi dung khong sua co quan
If Trim(MaCoQuan) <> Trim(MaCoQuanlst) Then
DE.sp_SuaCanBo MaCoQuan, MaBenhNhan
End If
End If
End If
'DE.sp_SuaCanBo MaCoQuan, MaBenhNhan
DisPlayListBaoHiem
End If
End If ' Tao moi
End Sub
Private Sub cmdMoi_Click()
txtHoTenBenhNhan.Enabled = True
txtPhanTram.Enabled = True
txtSoTheBaoHiem.Enabled = True
marNgayBatDau.Enabled = True

marNgayKetThuc.Enabled = True
cmdLuu.Enabled = True
CoLuu = "Moi"
SetNullCoQuan
SetNull
chkCoQuan.Value = 0
chkCoQuan.Enabled = True
End Sub
Private Sub cmdSua_Click()
txtHoTenBenhNhan.Enabled = True
txtPhanTram.Enabled = True
marNgayBatDau.Enabled = True
marNgayKetThuc.Enabled = True
cmdLuu.Enabled = True
chkCoQuan.Enabled = True
CoLuu = "Sua"
End Sub
Private Sub cmdThoat_Click()
Unload Me
End Sub
Private Sub DisPlayListBaoHiem()
Dim SQL$
Dim mItem As ListItem
Dim rs As ADODB.Recordset
'----------------------------------
SQL = "Select * From vwBaoHiemYte Order by SoTheBHYT"
Set rs = cn.Execute(SQL)
lstBaoHiem.ListItems.Clear
If rs.EOF = False Then
Do While rs.EOF = False

Set mItem = lstBaoHiem.ListItems.Add(, , Trim(rs!SoTheBHYT))
mItem.SubItems(1) = rs!NgayBatDau
mItem.SubItems(2) = rs!NgayKetThuc
mItem.SubItems(3) = rs!PhanTram
mItem.SubItems(4) = Trim(rs!HoBenhNhan) & " " & Trim(rs!
TenBenhNhan)
mItem.SubItems(5) = Trim(rs!MaBenhNhan)
rs.MoveNext
Loop
End If
End Sub
Private Sub cmdXoa_Click()
Dim Msg As Long, SoTheBaoHiem$
SoTheBaoHiem = Trim(txtSoTheBaoHiem.Text)
Msg = MsgBox("Ban co chac chan xo so bao hiem nay khong",
vbQuestion + vbYesNo)
If Msg = vbYes Then
DE.sp_XoaBaoHiem SoTheBaoHiem
DisPlayListBaoHiem
SetNull
End If
End Sub
Private Sub Form_Load()
txtHoTenBenhNhan.Enabled = False
txtSoTheBaoHiem.Enabled = False
marNgayBatDau.Enabled = False
marNgayKetThuc.Enabled = False
txtPhanTram.Enabled = False
cmdLuu.Enabled = False
txtMaCoQuan.Enabled = False

txtTenCoQuan.Enabled = False
txtDienThoaiCoQuan.Enabled = False
txtFaxCoQuan.Enabled = False
chkCoQuan.Enabled = False
'-------------------------------------------
cmdMoi.Enabled = Flag
cmdSua.Enabled = Flag
cmdXoa.Enabled = Flag
'------------------------------------
DisPlayListBaoHiem
End Sub
Private Sub lstBaoHiem_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim SQL$
Dim rs As ADODB.Recordset
'------------------------------------------
txtSoTheBaoHiem.Enabled = False
txtSoTheBaoHiem.Text = Item.Text
marNgayBatDau.Text = Item.SubItems(1)
marNgayKetThuc.Text = Item.SubItems(2)
txtPhanTram.Text = Item.SubItems(3)
txtHoTenBenhNhan.Text = Item.SubItems(4)
MaBenhNhanLst = Item.SubItems(5)
chkCoQuan.Value = 0
'-----------------------------------------------
If CoLuu = "Moi" Then
chkCoQuan.Enabled = False
txtHoTenBenhNhan.Enabled = False
marNgayBatDau.Enabled = False
marNgayKetThuc.Enabled = False
txtPhanTram.Enabled = False

CoLuu = "" 'Set lai coluu
End If
'---------------------------------------------
SQL = "Select * From tblCoQuan Where MaCoQuan=(" & _
"Select MaCoQuan From tblCanBo Where MaBenhNhan=" & _
MaBenhNhanLst & ")"
Set rs = cn.Execute(SQL)
If rs.EOF = False Then
txtMaCoQuan.Text = Trim(rs.Fields("MaCoQuan"))
txtTenCoQuan.Text = Trim(rs.Fields("TenCoQuan"))
txtDienThoaiCoQuan.Text = Trim(rs.Fields("DienThoaiCoQuan"))
txtFaxCoQuan.Text = Trim(rs.Fields("faxCoQuan"))
'----------------------------------------------------------------
MaCoQuanlst = Trim(txtMaCoQuan.Text)
Else
SetNullCoQuan
MaCoQuanlst = ""
End If
End Sub
Private Sub txtHoTenBenhNhan_Click()
Dim HoTenBenhNhan$, NgaySinh$, GioiTinh As Boolean
frmDanhSachBenhNhan.Show 1
frmDanhSachBenhNhan.clThongTinBenhNhan.TraThongTinVeTuDanhS
achBenhNhan _
MaBenhNhan, HoTenBenhNhan, NgaySinh, GioiTinh
txtHoTenBenhNhan.Text = HoTenBenhNhan
End Sub
Private Sub SetNull()
txtHoTenBenhNhan.Text = ""
txtSoTheBaoHiem.Text = ""

txtPhanTram.Text = ""
marNgayBatDau.Text = "__/__/____"
marNgayKetThuc.Text = "__/__/____"
End Sub
Private Sub SetNullCoQuan()
txtMaCoQuan.Text = ""
txtTenCoQuan.Text = ""
txtDienThoaiCoQuan.Text = ""
txtFaxCoQuan.Text = ""
End Sub
‘------------------------------
Option Explicit
Private Sub cmdLuu_Click()
Dim MaBenh As String
Dim TenBenh As String
Dim SQL As String
Dim Msg As Integer
MaBenh = Trim(txtMaBenh)
TenBenh = Trim(txtTenBenh)
SQL = "Select * From tblBenh Where MaBenh= " & MaBenh
If txtMaBenh.Enabled = True And txtTenBenh.Enabled = True Then
If Len(MaBenh) = 5 Then
If TenBenh <> "" Then
If Kt_Text(SQL) = True Then
DE.sp_Nhapbenh MaBenh, TenBenh
txtMaBenh.Text = ""
txtTenBenh.Text = ""
disPlayListView
Else
MsgBox "Benh nay da co trong co so du lieu", vbCritical

End If
Else
MsgBox "Ban chua nhap ten benh", vbInformation
End If
Else
MsgBox "Ma benh tuong khong hop le", vbInformation
End If
End If
If (txtMaBenh.Enabled = False) And (txtTenBenh.Enabled = True) Then
If TenBenh <> "" Then
Msg = MsgBox("Ban co chac chan sua ten benh nay khong",
vbQuestion + vbYesNo)
If Msg = vbYes Then
DE.sp_Suabenh MaBenh, TenBenh
disPlayListView
End If
Else
MsgBox "Ban chua nhap ten benh", vbInformation
End If
End If
End Sub
Private Sub cmdMoi_Click()
txtMaBenh.Enabled = True
txtTenBenh.Enabled = True
cmdLuu.Enabled = True
txtMaBenh.Text = ""
txtTenBenh.Text = ""
End Sub
Private Sub cmdSua_Click()
cmdLuu.Enabled = True

txtMaBenh.Enabled = False
txtTenBenh.Enabled = True
End Sub
Private Sub cmdThoat_Click()
Unload Me
End Sub
Private Sub cmdXoa_Click()
Dim MaBenh As String
Dim TenBenh As String
Dim Msg As Integer
MaBenh = Trim(txtMaBenh)
TenBenh = Trim(txtTenBenh)
Msg = MsgBox("Ban co chac chan xo benh nay khong", vbQuestion +
vbYesNo)
If Msg = vbYes Then
DE.sp_Xoabenh MaBenh, TenBenh
disPlayListView
End If
End Sub
Private Sub Form_Load()
cmdLuu.Enabled = False
txtMaBenh.Enabled = False
txtTenBenh.Enabled = False
'---------------------------------------
cmdMoi.Enabled = Flag
cmdSua.Enabled = Flag
cmdXoa.Enabled = Flag
disPlayListView
End Sub
Private Sub disPlayListView()

Dim rs As ADODB.Recordset
Dim SQL As String
Dim mItem As ListItem
lstBenh.ListItems.Clear
SQL = "Select * From tblBenh Order by MaBenh"
Set rs = cn.Execute(SQL)
If rs.EOF = False Then
Do While rs.EOF = False
Set mItem = lstBenh.ListItems.Add(, , Trim(rs!MaBenh))
mItem.SubItems(1) = rs!TenBenh
rs.MoveNext
Loop
End If
End Sub
Private Sub lstBenh_ItemClick(ByVal Item As MSComctlLib.ListItem)
txtMaBenh.Enabled = False
txtMaBenh.Text = Item.Text
txtTenBenh.Text = Item.SubItems(1)
End Sub
Private Sub txtMaBenh_KeyPress(KeyAscii As Integer)
KiemTraText KeyAscii, False
End Sub
Option Explicit
Dim MaBenhNhanLst$, MaNhanVienlst$, CoLuu$, MaNoiDieuTrilst$
Dim MaNhanVien$, MaBenhNhan$, MaBenh$, MaBenhlst$
Dim MaNoiDieuTri$
Private Sub cmdLuu_Click()
Dim MaBenhAn$, SQL$, SQLBenhNhan$
Dim NgayVao$, NgayRa$
'------------------------

MaBenhAn = Trim(txtMaBenhAn.Text)
NgayVao = SuLiNgay(marNgayVao.Text)
NgayRa = marNgayRa.Text
'-----------------------------------------
If CoLuu = "Moi" Then
If MaBenhAn = "" Then 'KiemTra ma benh an
MsgBox "Ban chua nhap ma benh an", vbInformation
Exit Sub
Else
SQL = "Select MaBenhAn from tblBenhAn Where MaBenhAn=" &
MaBenhAn
If Kt_Text(SQL) = False Then ' kiem tra ma co trong CSDL chua
MsgBox "Ban vui long nhap lai ma benh an, ma nay da co trong
CSDL", vbCritical
Exit Sub
End If ' kiem tra xem ma da co trong CSDL chua
End If ' End if mabenh an=""
'------------------------------------------
If MaBenhNhan = "" Then 'Kiem tra co benh nhan chua
MsgBox "Ban chua chon benh nhan can lap benh an"
Exit Sub
Else 'Ma benh nhan <>""
SQLBenhNhan = "Select MaBenhan From tblBenhAn Where
MaBenhNhan=" & _
MaBenhNhan
If Kt_Text(SQLBenhNhan) = False Then 'Kiem tra xem benh nhan
co benh an chua
MsgBox "Benh nhan nay da co benh an roi", vbCritical
Exit Sub
End If

End If
'----------------------
If MaNhanVien = "" Then 'kiem tra nhan vien
MsgBox "Ban chua nhap nhan vien viet benh an", vbInformation
Exit Sub
End If
'----------------------------
If MaBenh = "" Then
MsgBox "Ban chua nhap benh cua benh nhan", vbInformation
Exit Sub
End If
'-----------------------------
If MaNoiDieuTri = "" Then
MsgBox "Ban chua nhap noi dieu tri", vbInformation
Exit Sub
End If
'--- kiem tra ngay thang
If NgayVao = "NotOK" Then
MsgBox "Ngay vao vien cua benh nhan khong hop le", vbCritical
Exit Sub
Else 'Ngay vao vien da dung
'------------------------------------
If Date - DateValue(NgayVao) < 0 Then
MsgBox "Ngay vao sau ngay hien tai", vbCritical
Exit Sub
Else ' Ngay vao da truoc ngay hien tai
'-----------------------------------------
If NgayRa <> "__/__/____" Then ' Xem ngay ra co dung khong
NgayRa = SuLiNgay(NgayRa)
If NgayRa = "NotOK" Then 'Ngay ra co hop le

MsgBox "Ngay ra nay khong hop le", vbCritical
Exit Sub
Else
If Date - DateValue(NgayRa) < 0 Then
MsgBox "Ngay ra sau ngay hien tai", vbCritical
Exit Sub
End If
'-- kiem tra ngay vao co truoc ngay ra khong
-------------------------
If DateValue(NgayRa) - DateValue(NgayVao) < 0 Then
MsgBox "ban vui long kiem tra lai ngay thang, ngay vao
sau ngay ra", vbCritical
Exit Sub
End If 'End if kiem tra ngay vao co truoc ngay ra
'------------------------------------
End If ' Ngay ra co hop le
Else
NgayRa = ""
End If 'Ngay ra=""
End If ' End if kiem tra ngay vao co sau ngay hien tai khong
'-----------------
End If 'Kiem tra ngay thang
DE.sp_NhapBenhAn MaBenhAn, MaBenhNhan, MaNhanVien,
MaBenh, _
MaNoiDieuTri, NgayVao, Trim(NgayRa)
disPlayListBenhAn
SetNull
Else
If CoLuu = "Sua" Then 'Sua ban tin
If Trim(MaBenhAn) = "" Then

MsgBox "Ban chua chon benh an can sua", vbInformation
Exit Sub
End If
'------------------------------------------
If Trim(MaBenhNhan) = "" Then MaBenhNhan = MaBenhNhanLst
If Trim(MaNhanVien) = "" Then MaNhanVien = MaNhanVienlst
If Trim(MaBenh) = "" Then MaBenh = MaBenhlst
If Trim(MaNoiDieuTri) = "" Then MaNoiDieuTri = MaNoiDieuTrilst
'-----------------------------------------------
If NgayVao = "NotOK" Then
MsgBox "Ngay vao vien cua benh nhan khong hop le", vbCritical
Exit Sub
Else 'Ngay vao vien da dung
'------------------------------------
If Date - DateValue(NgayVao) < 0 Then
MsgBox "Ngay vao sau ngay hien tai", vbCritical
Exit Sub
Else ' Ngay vao da truoc ngay hien tai
'-----------------------------------------
If NgayRa <> "__/__/____" Then ' Xem ngay ra co dung khong
NgayRa = SuLiNgay(NgayRa)
If NgayRa = "NotOK" Then 'Ngay ra co hop le
MsgBox "Ngay ra nay khong hop le", vbCritical
Exit Sub
Else
If Date - DateValue(NgayRa) < 0 Then
MsgBox "Ngay ra sau ngay hien tai", vbCritical
Exit Sub
End If
'-- kiem tra ngay vao co truoc ngay ra khong

-------------------------
If DateValue(NgayRa) - DateValue(NgayVao) < 0 Then
MsgBox "ban vui long kiem tra lai ngay thang, ngay vao
sau ngay ra", vbCritical
Exit Sub
End If 'End if kiem tra ngay vao co truoc ngay ra
'------------------------------------
End If ' Ngay ra co hop le
Else
NgayRa = ""
End If 'Ngay ra=""
End If ' End if kiem tra ngay vao co sau ngay hien tai khong
'-----------------
End If 'Kiem tra ngay thang
DE.sp_SuaBenhAn MaBenhAn, MaBenhNhan, MaNhanVien,
MaBenh, _
MaNoiDieuTri, Format(NgayVao, "dd/mm/yyyy"), NgayRa
disPlayListBenhAn
End If ' Sua ban tin
End If 'Coluu= Moi
End Sub
Private Sub cmdMoi_Click()
txtMaBenhAn.Enabled = True
txtTenBenhNhan.Enabled = True
txtTenNhanVien.Enabled = True
marNgayVao.Enabled = True
marNgayRa.Enabled = True
cmdLuu.Enabled = True
txtTenBenh.Enabled = True
txtNoiDieuTri.Enabled = True

CoLuu = "Moi"
SetNull
End Sub
Private Sub cmdSua_Click()
txtMaBenhAn.Enabled = False
txtTenBenhNhan.Enabled = True
txtTenNhanVien.Enabled = True
txtTenBenh.Enabled = True
txtNoiDieuTri.Enabled = True
marNgayVao.Enabled = True
marNgayRa.Enabled = True
cmdLuu.Enabled = True
CoLuu = "Sua"
End Sub
Private Sub cmdThoat_Click()
Unload Me
End Sub
Private Sub disPlayListBenhAn()
Dim SQL$, mItem As ListItem
Dim rs As ADODB.Recordset
lstBenhAn.ListItems.Clear
SQL = "Select * From vwBenhAn Order By MaBenhAn"
Set rs = cn.Execute(SQL)
If rs.EOF = False Then
Do While rs.EOF = False
Set mItem = lstBenhAn.ListItems.Add(, , Trim(rs!MaBenhAn))
mItem.SubItems(1) = rs!NgayVao
mItem.SubItems(2) = rs!NgayRa
mItem.SubItems(4) = rs!HoTenNhanVien
mItem.SubItems(3) = Trim(rs!HoBenhNhan) & " " & Trim(rs!

TenBenhNhan)
mItem.SubItems(5) = Trim(rs!MaNhanVien)
mItem.SubItems(6) = Trim(rs!MaBenhNhan)
mItem.SubItems(7) = Trim(rs!TenBenh)
mItem.SubItems(8) = Trim(rs!MaBenh)
mItem.SubItems(9) = Trim(rs!TenNoiDieuTri)
mItem.SubItems(10) = Trim(rs!MaNoiDieuTri)
rs.MoveNext
Loop
End If
End Sub
Private Sub cmdXoa_Click()
Dim Msg As Long
Dim MaBenhAn$
MaBenhAn = Trim(txtMaBenhAn.Text)
Msg = MsgBox("Ban co chac chan xoa benh an nay khong ?", vbQuestion
+ vbYesNo)
If Msg = vbYes Then
DE.sp_XoaBenhAn MaBenhAn
disPlayListBenhAn
SetNull
End If
End Sub
Private Sub Form_Load()
txtMaBenhAn.Enabled = False
txtTenNhanVien.Enabled = False
txtTenBenhNhan.Enabled = False
marNgayVao.Enabled = False
marNgayRa.Enabled = False
cmdLuu.Enabled = False

txtTenBenh.Enabled = False
txtNoiDieuTri.Enabled = False
'----------------------------------------
cmdMoi.Enabled = Flag
cmdSua.Enabled = Flag
cmdXoa.Enabled = Flag
disPlayListBenhAn
End Sub
Private Sub lstBenhAn_ItemClick(ByVal Item As MSComctlLib.ListItem)
txtMaBenhAn.Enabled = False
txtMaBenhAn.Text = Item.Text
marNgayVao.Text = Item.SubItems(1)
If Trim(Item.SubItems(2)) <> "" Then
marNgayRa.Text = Item.SubItems(2)
Else
marNgayRa.Text = "__/__/____"
End If
txtTenBenhNhan.Text = Item.SubItems(3)
txtTenNhanVien.Text = Item.SubItems(4)
MaNhanVienlst = Item.SubItems(5)
MaBenhNhanLst = Item.SubItems(6)
MaBenhlst = Item.SubItems(8)
txtTenBenh.Text = Item.SubItems(7)
txtNoiDieuTri.Text = Item.SubItems(9)
MaNoiDieuTrilst = Item.SubItems(10)
End Sub
Private Sub txtmaBenhAn_KeyPress(KeyAscii As Integer)
KiemTraText KeyAscii, False
End Sub
Private Sub txtNoiDieuTri_Click()

Dim TenNoiDieuTri$
frmDanhSachNoiDieuTri.Show 1
frmDanhSachNoiDieuTri.clNoiDieuTri.TraTTNoiDT MaNoiDieuTri,
TenNoiDieuTri
txtNoiDieuTri.Text = Trim(TenNoiDieuTri)
End Sub
Private Sub txtTenBenh_Click()
Dim TenBenh$
frmDanhSachBenh.Show 1
frmDanhSachBenh.clBenh.ThongTTRa MaBenh, TenBenh
txtTenBenh.Text = TenBenh
End Sub
Private Sub txtTenBenhNhan_Click()
Dim HoTenBenhNhan$, NgaySinh$, GioiTinh As Boolean
frmDanhSachBenhNhan.Show 1
frmDanhSachBenhNhan.clThongTinBenhNhan.TraThongTinVeTuDanhS
achBenhNhan _
MaBenhNhan, HoTenBenhNhan, NgaySinh, GioiTinh
If CoLuu = "Sua" Then
If Trim(MaBenhNhan) <> "" Then
MaBenhNhanLst = MaBenhNhan
End If
End If
If Trim(HoTenBenhNhan) <> "" Then
txtTenBenhNhan = HoTenBenhNhan
End If
End Sub
Private Sub txtTenNhanVien_Click()
Dim HoTenNhanVien$
frmDanhSachNhanVien.Show 1

frmDanhSachNhanVien.clNhanVien.TraTTNhanVien MaNhanVien, _
HoTenNhanVien
If CoLuu = "Sua" Then
If Trim(MaNhanVien) <> "" Then
MaNhanVienlst = MaNhanVien
End If
End If
If Trim(MaNhanVien) <> "" Then
txtTenNhanVien.Text = HoTenNhanVien
End If
End Sub
Private Sub SetNull()
txtNoiDieuTri.Text = ""
txtMaBenhAn.Text = ""
txtTenBenhNhan.Text = ""
txtTenNhanVien.Text = ""
txtTenBenh.Text = ""
marNgayVao.Text = "__/__/____"
marNgayRa.Text = "__/__/____"
End Sub
Option Explicit
Public clBenhNhan As New clBenhNhan
Dim MaBenhNhancls$
Dim CoLuu As String
'Dim CoBaoHiem As Boolean
'Dim CoBenhAn As Boolean
Private Sub cbhuyen_Click()
txtHuyen.Text = cbHuyen.Text
cbHuyen.Visible = False
txtHuyen.Visible = True

disPlaycbXa
End Sub
Private Sub cbTinh_Click()
txtTinh.Text = cbTinh.Text
txtTinh.Visible = True
cbTinh.Visible = False
disPlayCbHuyen
End Sub
Private Sub cbXa_Click()
txtXa.Text = cbXa.Text
txtXa.Visible = True
cbXa.Visible = False
End Sub
Private Sub cmdChiTietBenhAn_Click()
Dim MaBenhNhan$, HoTenBenhNhan$, NgaySinh$, GioiTinh As
Boolean
MaBenhNhan = Trim(txtMaBenhNhan.Text)
HoTenBenhNhan = txtHoTenBenhNhan.Text
NgaySinh = marNgaySinhBenhNhan.Text
GioiTinh = OpNam
clBenhNhan.LayThongTinTuDanhSachBenhNhan MaBenhNhan, _
HoTenBenhNhan, NgaySinh, GioiTinh
frmThemXemBenhAn.Co = "Xem"
frmThemXemBenhAn.Show 1
End Sub
Private Sub cmdLapBenhAn_Click()
Dim MaBenhNhan$, HoTenBenhNhan$, NgaySinh$, GioiTinh As
Boolean
Dim MaBenhAn$, MaNhanVien$, MaBenh$, NgayVao$, NgayRa$
Dim MaNoiDieuTri As String

'------------------------------------------------
MaBenhNhan = Trim(txtMaBenhNhan.Text)
HoTenBenhNhan = txtHoTenBenhNhan.Text
NgaySinh = marNgaySinhBenhNhan.Text
GioiTinh = OpNam
clBenhNhan.LayThongTinTuDanhSachBenhNhan MaBenhNhan, _
HoTenBenhNhan, NgaySinh, GioiTinh
frmThemXemBenhAn.Co = "Moi"
frmThemXemBenhAn.Show 1
frmThemXemBenhAn.clBenhAn.TTBenhAnRa MaBenhAn, _
MaNhanVien, MaBenh, MaNoiDieuTri, NgayVao, NgayRa
If Trim(MaBenhAn) = "" Then
opCoBenhAn = False
opKhongCoBenhAn = True
End If
End Sub
Private Sub cmdLuu_Click()
'---- Bien Benh an
Dim MaBenhAn$, NgayVao$, NgayRa$, MaBenh$
Dim CoLuuBenhAn As Boolean, MaNhanVien$
'--- Bien bao hiem
Dim SoTheBaoHiem$, NgayBatDau$, PhanTram As Currency
Dim MaCoQuan$, CoLuuBaoHiem As Boolean, NgayKetThuc$
Dim CoLuuCanBo As Boolean
'------ Bien benh nhan
Dim MaBenhNhan$, HoBenhNhan$, TenBenhNhan$, NgaySinh$
Dim SoNha$, MaXa$, MaHuyen$, MaTinh$, GioiTinh As Boolean
Dim TenXa$, TenHuyen$, TenTinh$, Msg As Long
Dim SQL$, HoTenBenhNhan$, Tes As Long, MaNoiDieuTri$
'------------------------------------------------------------------

CoLuuBaoHiem = False
CoLuuBenhAn = False
'------------------------------------------------------------
If CoLuu = "Moi" Then 'Truong hop them mot benh nhan moi
'------ kiem tra ma benh nhan co hop lie khong -------------------
MaBenhNhan = Trim(txtMaBenhNhan.Text)
If MaBenhNhan = "" Then 'Mabenh nhan =""
MsgBox "Ban chua nhap ma benh nhan ", vbInformation
Exit Sub
Else 'Ma benh nhan <> ""
SQL = "Select * From tblBenhNhan Where MaBenhNhan=" & _
MaBenhNhan
If Kt_Text(SQL) = False Then
MsgBox "Ban vui long nhap lai ma benh nhan ma nay da co " & _
"trong CSDL", vbCritical
Exit Sub
End If 'Kiem tra xem ma benh nhan da co trong co so du lieu chua
End If 'Kiem tra ma benh nhan
'--------- Ket thuc kiem tra mabenh nhan --------------------

'------- Tach lay ho ten benh nhan rieng ---------------------
HoTenBenhNhan = SuLiChuoi(Trim(txtHoTenBenhNhan.Text))
If HoTenBenhNhan <> "" Then
TachHoTen HoTenBenhNhan, HoBenhNhan, TenBenhNhan
Else ' Truong hop chua nhap ho ten benh nhan
MsgBox "Ban chua nhap ho ten benh nhan", vbInformation
Exit Sub
End If 'Kiem tra ho ten benh nhan
'---- Ket thuc viec kiem tra ho ten ben nhan ----


'--- Kiem tra ngay sinh benh nhan
NgaySinh = SuLiNgaySinh(marNgaySinhBenhNhan.Text,
"BenhNhan")
If NgaySinh = "NotOK" Then
MsgBox " Ngay sinh benh nhan khong hop le", vbCritical
Exit Sub
End If
'------Ket thuc kiem tra ngay ----------------
'----- Xac dinh dia chi benh nhan
TenTinh = Trim(txtTinh.Text)
TenHuyen = Trim(txtHuyen.Text)
TenXa = Trim(txtXa.Text)
SoNha = Trim(txtSoNha.Text)
If SoNha = "" Then SoNha = "Chua co"
If TenTinh = "" Then
MsgBox "Ban chua chon tinh ma benh nhan song", vbInformation
Exit Sub
Else 'TenTinh<>""
If TenHuyen = "" Then
MsgBox "Ban chua chon ten huyen ma benh nhan song",
vbInformation
Exit Sub
Else 'TenHuyen<>""
If TenXa = "" Then
MsgBox "Ban chua chon ten xa", vbInformation
Exit Sub
End If
End If
End If
'------------------------------

Tes = DE.Sp_LayMaTinh(TenTinh, MaTinh)
Tes = DE.Sp_LayMaHuyen(TenHuyen, MaTinh, MaHuyen)
Tes = DE.sp_LayMaXa(TenXa, MaHuyen, MaXa)
' End xac dinh ma tinh
'-----------------
GioiTinh = OpNam
'----------------------
frmThemXemBaoHiemYTe.clBaoHiem.TTBaoHiemRa _
SoTheBaoHiem, NgayBatDau, NgayKetThuc, _
PhanTram, MaCoQuan
frmThemXemBaoHiemYTe.clBaoHiem.SetNull
If Trim(SoTheBaoHiem) <> "" Then CoLuuBaoHiem = True
If Trim(MaCoQuan) <> "" Then CoLuuCanBo = True
'-------------------------------------------------------------------------
frmThemXemBenhAn.clBenhAn.TTBenhAnRa MaBenhAn, _
MaNhanVien, MaBenh, MaNoiDieuTri, NgayVao, NgayRa
frmThemXemBenhAn.clBenhAn.SetNull
If Trim(MaBenhAn) <> "" Then CoLuuBenhAn = True
DE.sp_NhapBenhNhan MaBenhNhan, HoBenhNhan, TenBenhNhan, _
DateValue(NgaySinh), GioiTinh, SoNha, MaXa
'----- truong hop benh nhan co bao hiem
' Luu bao hiem
If CoLuuBaoHiem = True Then
DE.sp_NhapBaoHiem MaBenhNhan, SoTheBaoHiem, _
Format(NgayBatDau, "dd/mm/yyyy"), _
Format(NgayKetThuc, "dd/mm/yyyy"), PhanTram
' Benh nhan co bao hiem la can bo
If CoLuuCanBo = True Then
DE.sp_NhapCanBo MaBenhNhan, MaCoQuan
End If

End If 'Ket thuc luu bao hiem
' Benh nhan co benh an
If CoLuuBenhAn = True Then
DE.sp_NhapBenhAn MaBenhAn, MaBenhNhan, MaNhanVien, _
MaBenh, MaNoiDieuTri, Format(NgayVao,
"dd/mm/yyyy"), Trim(NgayRa)
End If 'Luu benh an
disPlayListView
SetNull
'-----------------------------------------------------------------------
Else 'Coluu=Sua
'Kiem tra ten benh nhan sau khi sua
MaBenhNhan = Trim(txtMaBenhNhan.Text)
HoTenBenhNhan = SuLiChuoi(Trim(txtHoTenBenhNhan.Text))
If HoTenBenhNhan <> "" Then
TachHoTen HoTenBenhNhan, HoBenhNhan, TenBenhNhan
Else ' Truong hop chua nhap ho ten benh nhan
MsgBox "Ban chua nhap ho ten benh nhan", vbInformation
Exit Sub
End If 'Kiem tra ho ten benh nhan
'--- Su li ngay sinh sau khi nhap lai
NgaySinh = SuLiNgaySinh(marNgaySinhBenhNhan.Text,
"BenhNhan")
If NgaySinh = "NotOK" Then
MsgBox " Ngay sinh benh nhan khong hop le", vbCritical
Exit Sub
End If
'------------------------
TenTinh = Trim(txtTinh.Text)
TenHuyen = Trim(txtHuyen.Text)

TenXa = Trim(txtXa.Text)
SoNha = Trim(txtSoNha.Text)
If SoNha = "" Then SoNha = "Chua co"
If TenTinh = "" Then
MsgBox "Ban chua chon tinh ma benh nhan song", vbInformation
Exit Sub
Else 'TenTinh<>""
If TenHuyen = "" Then
MsgBox "Ban chua chon ten huyen ma benh nhan song",
vbInformation
Exit Sub
Else 'TenHuyen<>""
If TenXa = "" Then
MsgBox "Ban chua chon ten xa", vbInformation
Exit Sub
End If
End If
End If
'------------------------------
Tes = DE.Sp_LayMaTinh(TenTinh, MaTinh)
Tes = DE.Sp_LayMaHuyen(TenHuyen, MaTinh, MaHuyen)
Tes = DE.sp_LayMaXa(TenXa, MaHuyen, MaXa)
' End xac dinh ma tinh
GioiTinh = OpNam
'--------------------------
Msg = MsgBox("Ban co chac chan sua benh nhan nay khong",
vbQuestion + vbYesNo)
If Msg = vbYes Then
DE.sp_SuaBenhNhan MaBenhNhan, HoBenhNhan, TenBenhNhan, _
Format(NgaySinh, "dd/mm/yyyy"), GioiTinh, _

SoNha, MaXa
disPlayListView
End If
'----------------------
End If ' CoLuu=Moi
End Sub
Private Sub cmdMoi_Click()
SetNull
txtHoTenBenhNhan.Enabled = True
txtMaBenhNhan.Enabled = True
marNgaySinhBenhNhan.Enabled = True
txtTinh.Enabled = True
txtHuyen.Enabled = True
txtXa.Enabled = True
txtSoNha.Enabled = True
opKhongCoBaoHiem = True
opKhongCoBenhAn = True
'------------------------------------------
frmThemXemBaoHiemYTe.clBaoHiem.SetNull
frmThemXemBenhAn.clBenhAn.SetNull
'--------------------------------------------------------
'If opCoBaoHiem = True Then
'cmdThemMoiBaoHiem.Enabled = True
'End If
cmdXemBaoHiem.Enabled = False
'------------------------------------
cmdLuu.Enabled = True
cmdChiTietBenhAn.Enabled = False
'cmdLapBenhAn.Enabled = True
CoLuu = "Moi"

End Sub
Private Sub cmdSua_Click()
txtMaBenhNhan.Enabled = False
txtHoTenBenhNhan.Enabled = True
marNgaySinhBenhNhan.Enabled = True
txtTinh.Enabled = True
txtXa.Enabled = True
txtHuyen.Enabled = True
txtSoNha.Enabled = True
cmdLuu.Enabled = True
End Sub
Private Sub cmdThemMoiBaoHiem_Click()
Dim MaBenhNhan$, HoTen$, NgaySinh$, GioiTinh As Boolean
Dim SoThe$, NgayBatDau$, NgayKetThuc$
Dim PhanTram As Currency, MaCoQuan$
MaBenhNhan = txtMaBenhNhan.Text
HoTen = txtHoTenBenhNhan.Text
NgaySinh = marNgaySinhBenhNhan.Text
GioiTinh = OpNam

Tài liệu bạn tìm kiếm đã sẵn sàng tải về

Tải bản đầy đủ ngay
×