Thư viện tri thức trực tuyến
Kho tài liệu với 50,000+ tài liệu học thuật
© 2023 Siêu thị PDF - Kho tài liệu học thuật hàng đầu Việt Nam

Code SQL.doc
Nội dung xem thử
Mô tả chi tiết
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 = ""