Siêu thị PDFTải ngay đi em, trời tối mất

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
MIỄN PHÍ
Số trang
141
Kích thước
212.8 KB
Định dạng
PDF
Lượt xem
1025

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 = ""

Tải ngay đi em, còn do dự, trời tối mất!