Trinh Nguon.doc

Trinh Nguon

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

Private Sub cmdLuu_Click()

Dim NgayBatDau$, NgayKetThuc$

Dim SQL$, SoTheBaoHiem$, SQLBenhNhan$ Dim PhanTram As Currency

Dim MaCoQuan$, TenCoQuan$, DienThoai$, Fax$ Dim CoLuuCoQuan As Boolean

If SoTheBaoHiem = "" Then 'Kiem tra so the

MsgBox "Ban chua nhap so the bao hiem", vbInformation

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

Else ' Benh nhan chua luu bao hiem y te

' - Kiem tra ngay thang

If (NgayBatDau = "NotOK") Or (NgayKetThuc = "NotOK")

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

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

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

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

If rs.EOF = False Then Do While rs.EOF = False

Set mItem = lstBaoHiem.ListItems.Add(, , Trim(rs!SoTheBHYT))

Private Sub cmdXoa_Click()

Dim Msg As Long, SoTheBaoHiem$

SQL = "Select * From tblCoQuan Where MaCoQuan=(" & _

"Select MaCoQuan From tblCanBo Where MaBenhNhan=" & _ MaBenhNhanLst & ")"

Private Sub txtHoTenBenhNhan_Click()

Dim HoTenBenhNhan$, NgaySinh$, GioiTinh As Boolean

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

Private Sub cmdXoa_Click() Dim MaBenh As String Dim TenBenh As String

Private Sub disPlayListView()

If rs.EOF = False Then Do While rs.EOF = False

Set mItem = lstBenh.ListItems.Add(, , Trim(rs!MaBenh))

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$ 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

If MaNhanVien = "" Then 'kiem tra nhan vien

MsgBox "Ban chua nhap nhan vien viet benh an", vbInformation

' - 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

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 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,

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

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

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

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))

Private Sub txtmaBenhAn_KeyPress(KeyAscii As Integer) KiemTraText KeyAscii, False

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

Private Sub SetNull()

Dim CoLuu As String

'Dim CoBaoHiem As Boolean 'Dim CoBenhAn As Boolean Private Sub cbhuyen_Click()

Private Sub cmdChiTietBenhAn_Click()

Dim MaBenhNhan$, HoTenBenhNhan$, NgaySinh$, GioiTinh As Boolean

MaBenhNhan = Trim(txtMaBenhNhan.Text) HoTenBenhNhan = txtHoTenBenhNhan.Text

Private Sub cmdLapBenhAn_Click()

Dim MaBenhNhan$, HoTenBenhNhan$, NgaySinh$, GioiTinh As Boolean

Dim MaBenhAn$, MaNhanVien$, MaBenh$, NgayVao$, NgayRa$ Dim MaNoiDieuTri As String

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

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

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,

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

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

DE.sp_SuaBenhNhan MaBenhNhan, HoBenhNhan, TenBenhNhan, _ Format(NgaySinh, "dd/mm/yyyy"), GioiTinh, _

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

Private Sub cmdXemBaoHiem_Click()

Dim MaBenhNhan$, HoTen$, NgaySinh$, GioiTinh As Boolean

Private Sub cmdXoa_Click()

Dim MaBenhNhan$, Msg As Long

Private Sub disPlayListView() Dim Item As ListItem

If rs.EOF = False Then Do While rs.EOF = False

Set Item = lstBenhNhan.ListItems.Add(, , Trim(rs!MaBenhNhan)) Item.SubItems(1) = Trim(rs!HoBenhNhan) & " " & Trim(rs! TenBenhNhan)

Item.SubItems(2) = rs!NgaySinhBenhNhan

Private Sub lstBenhNhan_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim MaBenhNhan$, SQLBaoHiem$, SQLBenhAn$

Dim rsBaoHiem As ADODB.Recordset Dim rsBenhAn As ADODB.Recordset

Set rsBaoHiem = cn.Execute(SQLBaoHiem) If rsBaoHiem.EOF = False Then

Set rsBenhAn = cn.Execute(SQLBenhAn) If rsBenhAn.EOF = False Then If rs.EOF = False Then Do While rs.EOF = False

cbTinh.AddItem Trim(rs.Fields("TenTinh")) rs.MoveNext

Loop End If

End Sub

Private Sub disPlayCbHuyen() Dim MaTinh$, TenTinh$, SQL$ Dim Tes As Long If rs.EOF = False Then Do While rs.EOF = False

Private Sub disPlaycbXa()

Dim MaHuyen$, TenHuyen$, SQL$ Dim Tes As Long, MaTinh$, TenTinh$ Dim rs As ADODB.Recordset

cbXa.Clear

TenTinh = Trim(txtTinh)

TenHuyen = Trim(txtHuyen.Text)

Tes = DE.Sp_LayMaTinh(TenTinh, MaTinh)

Tes = DE.Sp_LayMaHuyen(TenHuyen, MaTinh, MaHuyen) If MaHuyen <> "0" Then

SQL = "Select TenXa From tblXa Where tblXa.MaHuyen=" & MaHuyen

Set rs = cn.Execute(SQL) If rs.EOF = False Then Do While rs.EOF = False

End Sub

Private Sub opCoBaoHiem_Click() If CoLuu = "Moi" Then

cmdThemMoiBaoHiem.Enabled = opCoBaoHiem End If

End Sub

Private Sub opCoBenhAn_Click() If CoLuu = "Moi" Then

cmdLapBenhAn.Enabled = opCoBenhAn End If

End Sub

Private Sub opKhongCoBaoHiem_Click() If CoLuu = "Moi" Then

cmdThemMoiBaoHiem.Enabled = Not opKhongCoBaoHiem End If

End Sub

Private Sub opKhongCoBenhAn_Click() If CoLuu = "Moi" Then

cmdLapBenhAn.Enabled = Not opKhongCoBenhAn

Private Sub txtMaBenhNhan_KeyPress(KeyAscii As Integer) KiemTraText KeyAscii, False

Dim MaChuyenMon As String Dim TenChuyenMon As String Dim Msg As Integer

MaChuyenMon = Trim(txtMaCM.Text) TenChuyenMon = Trim(txtTenCM.Text)

SQL = "Select MaChuyenMon From tblChuyenMon Where MaChuyenMon=" & MaChuyenMon

If txtMaCM.Enabled = True Then

Msg = MsgBox("Ban co dong y sua chuyen mon khong ?",

Dim MaChucVu As String Dim TenChucVu As String

MsgBox "Ban chua nhap ma chuc vu", vbInformation

Dim MaDonVi As String Dim TenDonVi As String Dim Msg As Integer

MaDonVi = Trim(txtMaDV.Text) TenDonVi = Trim(txtTenDV.Text)

SQL = "Select MaDonVi From tblDonVi Where MaDonVi=" & MaDonVi If txtMaDV.Enabled = True Then

Dim MaChuyenMon As String Dim TenChuyenMon As String

MaChuyenMon = Trim(txtMaCM.Text) TenChuyenMon = Trim(txtTenCM.Text)

Msg = MsgBox("Ban co chac chan xoa chuyen mon nay khong", vbQuestion + vbYesNo)

Dim MaChucVu As String Dim TenChucVu As String

Dim MaDonVi As String Dim TenDonVi As String

If rs.EOF = False Then Do While rs.EOF = False

Set mItem = lstCV.ListItems.Add(, , rs!MaChucVu)

If rs.EOF = False Then Do While rs.EOF = False

Set mItem = lstCM.ListItems.Add(, , rs!MaChuyenMon)

If rs.EOF = False Then Do While rs.EOF = False

Set mItem = lstDV.ListItems.Add(, , rs!MaDonVi)

Private Sub txtMaCM_KeyPress(KeyAscii As Integer) KiemTraText KeyAscii, False

End Sub

Private Sub txtMaCV_KeyPress(KeyAscii As Integer) KiemTraText KeyAscii, False

End Sub

Private Sub txtMaDV_KeyPress(KeyAscii As Integer) KiemTraText KeyAscii, False

End Sub

Option Explicit Dim Co$

Private Sub cmdLuu_Click()

Dim TenCoQuan$, MaCoQuan$, DienThoai$, Fax$

If DienThoai = "" Then DienThoai = "Chua Co" If Fax = "" Then Fax = "Chua co"

'=============== If Co = "Insert" Then

If MaCoQuan <> "" Then If TenCoQuan <> "" Then