CODING FORM REKAM MEDIS

Private Sub CMDADD_Click()

Dim DBREKAMMEDIS As Object

Set DBREKAMMEDIS = Sheet5.Range("B100000").End(xlUp)

If Me.TXTNORM.Value = "" _

Or Me.TXTPASIEN.Value = "" _

Or Me.TXTJENISKELAMIN.Value = "" _

Or Me.TXTSTATUS.Value = "" _

Or Me.TXTTANGGALCEK.Value = "" _

Or Me.CBPOLI.Value = "" _

Or Me.TXTKODE.Value = "" _

Or Me.CBDOKTER.Value = "" _

Or Me.TXTANAMNESA.Value = "" _

Or Me.TXTDIAGNOSA.Value = "" _

Or Me.TXTTERAPI.Value = "" Then

Call MsgBox("Data Rekam Medis harus lengkap", vbInformation, "Data Rekam Medis")

Else

DBREKAMMEDIS.Offset(1, 0).Value = Me.TXTNORM.Value

DBREKAMMEDIS.Offset(1, 1).Value = Me.TXTPASIEN.Value

DBREKAMMEDIS.Offset(1, 2).Value = Me.TXTJENISKELAMIN.Value

DBREKAMMEDIS.Offset(1, 3).Value = Me.TXTSTATUS.Value

DBREKAMMEDIS.Offset(1, 4).Value = Format(Me.TXTTANGGALCEK.Value, "DD/MM/YYYY")

DBREKAMMEDIS.Offset(1, 5).Value = Me.CBPOLI.Value

DBREKAMMEDIS.Offset(1, 6).Value = Me.TXTKODE.Value

DBREKAMMEDIS.Offset(1, 8).Value = Me.TXTANAMNESA.Value

DBREKAMMEDIS.Offset(1, 9).Value = Me.TXTDIAGNOSA.Value

DBREKAMMEDIS.Offset(1, 10).Value = Me.TXTTERAPI.Value

Call RefreshTabelRM

Call AutoNumberRM

Call CariRM

Call MsgBox("Data Rekam Medis berhasil ditambah", vbInformation, "Data Rekam Medis")

Me.TXTNORM.Value = ""

Me.TXTPASIEN.Value = ""

Me.TXTJENISKELAMIN.Value = ""

Me.TXTSTATUS.Value = ""

Me.TXTTANGGALCEK.Value = ""

Me.CBPOLI.Value = ""

Me.TXTKODE.Value = ""

Me.CBDOKTER.Value = ""

Me.TXTANAMNESA.Value = ""

Me.TXTDIAGNOSA.Value = ""

Me.TXTTERAPI.Value = ""

End If

End Sub

Private Sub CMDCLEAR_Click()

Me.TXTNORM.Value = ""

Me.TXTPASIEN.Value = ""

Me.TXTJENISKELAMIN.Value = ""

Me.TXTSTATUS.Value = ""

Me.TXTTANGGALCEK.Value = ""
Me.CBPOLI.Value = ""

Me.TXTKODE.Value = ""

Me.CBDOKTER.Value = ""

Me.TXTANAMNESA.Value = ""

Me.TXTDIAGNOSA.Value = ""

Me.TXTTERAPI.Value = ""

Me.TABELDATA.RowSource = ""

End Sub

Private Sub CMDDELETE_Click()

If Me.NOMORDELETE.Value = "" Then

Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")

Else

'Membuat pesan konfirmasi hapus data

Select Case MsgBox("Anda akan menghapus data" _

& vbCrLf & "Apakah anda yakin?" _

, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")

Case vbNo

Exit Sub

Case vbYes

End Select

'Menentukan tempat hapus data, menghapus data dan membersihkan form

Set Hapusdata = Sheet5.Range("A5:A500000").Find(WHAT:=Me.NOMORDELETE.Value,

Hapusdata.Offset(0, 0).ClearContents

Hapusdata.Offset(0, 1).ClearContents

Hapusdata.Offset(0, 2).ClearContents

Hapusdata.Offset(0, 3).ClearContents

Hapusdata.Offset(0, 4).ClearContents
Hapusdata.Offset(0, 5).ClearContents

Hapusdata.Offset(0, 6).ClearContents

Hapusdata.Offset(0, 7).ClearContents

Hapusdata.Offset(0, 8).ClearContents

Hapusdata.Offset(0, 9).ClearContents

Hapusdata.Offset(0, 10).ClearContents

Hapusdata.Offset(0, 11).ClearContents

Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")

Me.TXTTANGGALCEK.Value = ""

Me.CBPOLI.Value = ""

Me.TXTKODE.Value = ""

Me.CBDOKTER.Value = ""

Me.TXTANAMNESA.Value = ""

Me.TXTDIAGNOSA.Value = ""

Me.TXTTERAPI.Value = ""

Call UrutRM

Call AutoNumberRM

End If

Call CariRM

End Sub

Private Sub CMDPRINTRM_Click()

Application.ScreenUpdating = False

If Me.TXTNORM.Value = "" Then

Call MsgBox("Tidak ada Rekam Medis yang dicetak, silahkan pilih rekam medis terlebih dahulu",
vbInformation, "Rekam Medis")

Else
Select Case MsgBox("Anda akan menghapus data" _

& vbCrLf & "Apakah anda yakin?" _

, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")

Case vbNo

Exit Sub

Case vbYes

End Select

Sheet2.Range("D5").Value = Me.TXTNORM.Value

Unload Me

Sheet2.PrintPreview

Sheet1.Select

FORMREKAMMEDIS.Show

End If

End Sub

Private Sub CMDRESET_Click()

Me.TXTCARI.Value = ""

iRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row

If iRow > 1 Then

Me.TABELCARI.RowSource = "DATAPASIEN!B5:E" & iRow

End If

End Sub

Private Sub CMDUPDATE_Click()

Application.ScreenUpdating = False

Dim BARIS As String

Call MsgBox("Pilih data terlebih dahulu", vbInformation, "Pilih Data")

Else

Sheet5.Select

BARIS = ActiveCell.Row

Cells(BARIS, 6) = Me.TXTTANGGALCEK.Value

Cells(BARIS, 7) = Me.CBPOLI.Value

Cells(BARIS, 8) = Me.TXTKODE.Value

Cells(BARIS, 9) = Me.CBDOKTER.Value

Cells(BARIS, 10) = Me.TXTANAMNESA.Value

Cells(BARIS, 11) = Me.TXTDIAGNOSA.Value

Cells(BARIS, 12) = Me.TXTTERAPI.Value

Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")

Me.TXTTANGGALCEK.Value = ""

Me.CBPOLI.Value = ""

Me.TXTKODE.Value = ""

Me.CBDOKTER.Value = ""

Me.TXTANAMNESA.Value = ""

Me.TXTDIAGNOSA.Value = ""

Me.TXTTERAPI.Value = ""

End If

Sheet1.Select

Call CariRM

End Sub
Private Sub TABELCARI_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

On Error GoTo EXCELVBA

Me.TXTNORM.Value = Me.TABELCARI.Value

Me.TXTPASIEN.Value = Me.TABELCARI.Column(1)

Me.TXTJENISKELAMIN.Value = Me.TABELCARI.Column(2)

Me.TXTSTATUS.Value = Me.TABELCARI.Column(3)

Call CariRM

Me.TXTNORM.Enabled = False

Me.TXTPASIEN.Enabled = False

Me.TXTJENISKELAMIN.Enabled = False

Me.TXTSTATUS.Enabled = False

Me.TXTTANGGALCEK.Value = ""

Me.CBPOLI.Value = ""

Me.TXTKODE.Value = ""

Me.CBDOKTER.Value = ""

Me.TXTANAMNESA.Value = ""

Me.TXTDIAGNOSA.Value = ""

Me.TXTTERAPI.Value = ""

Exit Sub

EXCELVBA:

Call MsgBox("Pasien ini belum memiliki rekam medis", vbInformation, "Rekam Medis")

End Sub

Private Sub TABELDATA_Click()

End Sub

Private Sub TABELDATA_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Application.ScreenUpdating = False

On Error GoTo EXCELVBA

Me.TXTTANGGALCEK.Value = Format(Me.TABELDATA.Column(5), "DD/MM/YYYY")

Me.CBPOLI.Value = Me.TABELDATA.Column(6)

Me.TXTKODE.Value = Me.TABELDATA.Column(7)

Me.CBDOKTER.Value = Me.TABELDATA.Column(8)

Me.TXTANAMNESA.Value = Me.TABELDATA.Column(9)

Me.TXTDIAGNOSA.Value = Me.TABELDATA.Column(10)

Me.TXTTERAPI.Value = Me.TABELDATA.Column(11)

Sheet5.Select

SUMBERUBAH = Sheets("REKAMMEDIS").Cells(Rows.Count, "A").End(xlUp).Row

Sheets("REKAMMEDIS").Range("A5:A" & SUMBERUBAH).Find(WHAT:=Me.NOMORDELETE.Value,

CELLAKTIF = ActiveCell.Row

Sheets("REKAMMEDIS").Range("A" & CELLAKTIF & ":L" & CELLAKTIF).Select

Sheet1.Select

Exit Sub

EXCELVBA:

Call MsgBox("Maaf, Data rekam medis tidak dapat diakses", vbInformation, "Rekam Medis")

End Sub

Private Sub TXTCARI_Change()

On Error GoTo Salah

Dim iRow As Long

Set Cari_Data = Sheet3

Sheet7.Range("O1").Value = "Nama Pasien"

Sheet7.Range("O2").Value = "*" & Me.TXTCARI.Value & "*"

Cari_Data.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _

iRow = Sheet7.Range("A" & Rows.Count).End(xlUp).Row

If iRow > 1 Then

Me.TABELCARI.RowSource = "CARIPASIEN!B2:E" & iRow

Else

Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")

End If

Exit Sub

Salah:

Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")

End Sub

Private Sub CariRM()

On Error GoTo Salah

Dim iRow As Long

Set Cari_Data = Sheet5

Sheet9.Range("N2").Value = Me.TXTNORM.Value

Cari_Data.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _

Sheet9.Range("N1:N2"), CopyToRange:=Sheet9.Range("A1:L1"), Unique:=False

iRow = Sheet9.Range("A" & Rows.Count).End(xlUp).Row

If iRow > 1 Then

Me.TABELDATA.RowSource = "REKAPRM!A2:L" & iRow

Else

Call MsgBox("Pasien ini belum memiliki rekam medis", vbInformation, "Rekam Medis")

End If

Exit Sub

Salah:

Call MsgBox("Pasien ini belum memiliki rekam medis", vbInformation, "Rekam Medis")
End Sub

Private Sub UserForm_Initialize()

With CBPOLI

.AddItem "Umum"

.AddItem "Gigi"

.AddItem "Kandungan"

.AddItem "Jantung"

.AddItem "THT"

End With

Call RefreshTabelCari

Call IsiDokter

End Sub

Private Sub RefreshTabelCari()

Dim iRow As Long

iRow = Sheet3.Range("B" & Rows.Count).End(xlUp).Row

If iRow > 1 Then

Me.TABELCARI.RowSource = "DATAPASIEN!B5:E" & iRow

End If

End Sub

Private Sub RefreshTabelRM()

Dim iRow As Long

iRow = Sheet5.Range("B" & Rows.Count).End(xlUp).Row

If iRow > 1 Then

Me.TABELDATA.RowSource = "REKAMMEDIS!A5:L" & iRow

Else

Me.TABELDATA.RowSource = ""
End If

End Sub

Private Sub IsiDokter()

Dim iRow As Long

iRow = Sheet4.Range("B" & Rows.Count).End(xlUp).Row

If iRow > 1 Then

Me.CBDOKTER.RowSource = "DATADOKTER!B5:B" & iRow

End If

End Sub