program aplikasi rekam medis rumah sakit vb 6

Aplikasi Rawat Jalan VB 6.0

Program ini digunakan untuk melakukan pengolahan data rekam medis (rawat jalan) pada sebuah klinik atau rumah sakit.

Proses yang terjadi dalam program ini adalah sebagai berikut:

1. Pasien datang melakukan pendaftaran, baik pasien baru maupun pasien lama dengan biaya sesuai kode poli.

2. Pasien mendapatkan nomor antrian, kemudian dipanggil oleh dokter untuk diagnosa, setelah itu dokter memberikan resep kepada pasien.

3. Resep diberikan kepada apoteker oleh pasien dan apoteker meracik obat sesuai isi resep.

4. Pasien membayar biaya resep (obat).

5. Pembuatan laporan.

1.1 Merancang Database Dan Relasi Tabel

Langkah awal yang harus dilakukan adalah membuat database dengan nama DBRAWATJALAN.mdb, kemudian membuat beberapa tabel yang diperlukan antara lain Tabel Pemakai (User), Tabel Dokter, Tabel Obat, Tabel Pasien, Tabel Poli, Tabel Pendaftaran, Tabel Resep, Tabel Detail, Tabel Pembayaran, Tabel Temporer (tabel ini tidak pernah berisi data kecuali nomor urut).

Bentuk relasi tabel pada program kredit bank ini terlihat pada gambar di bawah ini :

Dari bentuk relasi tabel di atas (3NF one to many) diharapkan anda dapat membuat normalisasinya dari mulai unnormal hingga normal kedua.

1.2 Membuat Modul

Tahap awal pembuatan aplikasi ini dimulai dengan membuat module setelah merancang desain database. Tujuan dibuat modul adalah agar koneksi ke database dan pembacaan tabel-tabel dapat dilakukan dengan efektif dan efisien.

Cara membuat Modul :

1. Buka VB

2. Klik menu Project

3. Pilih Add Module

4. Klik Open

5. Tulis koding di bawah ini kemudian simpan

Public Conn As New ADODB.Connection

Public RSObat As ADODB.Recordset

Public RSADM As ADODB.Recordset

Public RSApoteker As ADODB.Recordset

Public RSPendaftaran As ADODB.Recordset

Public RSPembayaran As ADODB.Recordset

Public RSPemakai As ADODB.Recordset

Public RSPoli As ADODB.Recordset

Public RSDokter As ADODB.Recordset

Public RSResep As ADODB.Recordset

Public RSPasien As ADODB.Recordset

Public RSDetail As ADODB.Recordset

Public Sub Koneksi()

Set Conn = New ADODB.Connection

Set RSObat = New ADODB.Recordset

Set RSADM = New ADODB.Recordset

Set RSApoteker = New ADODB.Recordset

Set RSPendaftaran = New ADODB.Recordset

Set RSPembayaran = New ADODB.Recordset

Set RSPemakai = New ADODB.Recordset

Set RSPoli = New ADODB.Recordset

Set RSDokter = New ADODB.Recordset

Set RSResep = New ADODB.Recordset

Set RSPasien = New ADODB.Recordset

Set RSDetail = New ADODB.Recordset

Conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DBrawatjalan.mdb"

End Sub

1.3 Pengolahan Data Master

Seperti yang telah dijelaskan pada bab desain database, maka sekarang akan dibahas tentang pengolahan tabel-tabel master yang terdiri dari Tabel Pasien, Tabel Pemakai, Tabel Dokter, Tabel Obat, dan Tabel Poli

Skenario program :

1. Jika command input dijalankan maka status harus dipilih lebih awal. Jika statusnya ADM maka program akan mencari kode ADM paling akhir, jika data tidak ditemukan maka akan dibuat kode adm baru dengan struktur ADM01, jika data ditemukan maka kode adm terakhir akan ditambah 1. jika kode adm terakhir adalah ADM03, maka kode adm baru adalah ADM04. hal yang sama berlalu untuk status apoteker dan daministrator

2. Jika command Edit atau Hapus di klik, maka pencarian data dapat dilakukan dengan mengetik kodenya atau dengan memilih data dalam grid kemudian tekan enter.

Skenario program :

1. Jika command input dijalankan makakode poli harus dipilih lebih awal. Jika poli GIGI maka program akan mencari kode dokter paling akhir di poli gigi, jika data tidak ditemukan maka akan dibuat kode dokter baru dengan struktur GIG01, jika data ditemukan maka kode dokter terakhir akan ditambah 1. jika kode dokter terakhir adalah ADM03, maka kode adm baru adalah GIG04. Hal yang sama berlalu untuk kode poli lainnya

2. Jika command Edit atau Hapus di klik, maka pencarian data dapat dilakukan dengan mengetik kodenya atau dengan memilih data dalam grid kemudian tekan enter.

1.4 Pendaftaran Pasien

Proses awal transaksi dalam aplikasi ini adalah pendaftaran pasien, baik pasien baru maupun pasien yang telah terdaftar. Untuk itu buatlah form seperti gambar di bawah ini.

Skenario program :

1. Pasien yang mendaftar ditanya oleh bagian pendaftaran akan menuju ke poli apa atau si pasien sendiri yang menyebutkannya

2. bagian administrasi menginformasikan dokter yang ada pada saat itu, dan nomor atrian masing-masing dokter

3. bagian adm menanyakan apakah pasien baru atau telah terdaftar. Jika pasien telah terdaftar maka nomor pasiennya dicari, jika pasien baru maka akan dibuatkan nomor baru

4. masing-masing dokter praktik memiliki tarif tersendiri

Skenario program :

1. Tanggal tampil otomatis

2. Nomor resep diambil dari nomor pendaftaran

3. Pengisian nomor resep boleh diklik atau diketik dalam combo

4. Jika nomor resep ditemukan maka akan tampil data dokter, pasien, poli dan data obat di dalam list sesuai katagori poli atau spesialis dokter

5. Pengisian kode obat dalam grid boleh diketik atau dipilih dari list kemudian menekan enter

6. Jika jumlah dosis melebihi stok obat maka akan tampil pesan bahwa stok obat kurang

7. Jumlah item obat dan total pembayaran akan tampil secara otomatis

8. Jika jumlah pembayaran < dari total harga maka akan tampul pesan bahwa pembayaran kurang. Jika pembayaran >= total maka command simpan menjadi fokus kursor.

9. Setelah pembayaran selesai maka akan tampil resep, jika menekan ESC form akan tertutup, jika menekan enter resep dicetak ke printer. (siapkan printer terlebih dahulu)

Koding :

Private Sub Form_Activate()

Call Koneksi

ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\DBRAWATJALAN.mdb"

ado.RecordSource = "Temporer"

Set dg.DataSource = ado

dg.Refresh

RSPendaftaran.Open "SELECT * FROM PENDAFTARAN where ket='0'", Conn

Combo1.Clear

Do Until RSPendaftaran.EOF

Combo1.AddItem RSPendaftaran!NomorDft

RSPendaftaran.MoveNext

Loop

Call Tabel_Kosong

ado.Recordset.MoveFirst

TANGGAL = Format(Date, "DD-MM-YYYY")

End Sub

Function Tabel_Kosong()

ado.Recordset.MoveFirst

Do While Not ado.Recordset.EOF

ado.Recordset.Delete

ado.Recordset.MoveNext

Loop

For I = 1 To 1

ado.Recordset.AddNew

ado.Recordset!Nomor = I

ado.Recordset.Update

Next I

dg.Col = 1

End Function

Private Sub Combo1_Click()

Call Koneksi

RSPendaftaran.Open "Select * from Pendaftaran where nomordft='" & Combo1 & "'", Conn

RSPendaftaran.Requery

If Not RSPendaftaran.EOF Then

RSDokter.Open "select * from dokter where kodedkt='" & RSPendaftaran!Kodedkt & "'", Conn

If Not RSDokter.EOF Then

Kodedkt = RSDokter!Kodedkt

Namadkt = RSDokter!Namadkt

End If

RSPasien.Open "select * from pasien where kodepsn='" & RSPendaftaran!KodePsn & "'", Conn

If Not RSPasien.EOF Then

KodePsn = RSPasien!KodePsn

NamaPsn = RSPasien!NamaPsn

End If

RSPoli.Open "select * from poli where kodepl='" & RSPendaftaran!Kodepl & "'", Conn

If Not RSPoli.EOF Then

Kodepl = RSPoli!Kodepl

Namapl = RSPoli!Namapl

End If

RSObat.Open "SELECT * FROM OBAT WHERE KATAGORI= '" & Namapl & "'", Conn

List1.Clear

Do While Not RSObat.EOF

List1.AddItem RSObat!NamaOBT & Space(5) & RSObat!JUMLAHOBT & Space(50) & RSObat!KODEOBT

RSObat.MoveNext

Loop

Else

MsgBox "nomor tidak terdaftar"

Combo1.SetFocus

End If

End Sub

Private Sub combo1_KeyPress(Keyascii As Integer)

If Keyascii = 13 Then

If Combo1 = "" Then

MsgBox "nomor resep harus diisi"

Combo1.SetFocus

Exit Sub

Else

Combo1_Click

End If

If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0

End Sub

Private Sub DG_AfterColEdit(ByVal ColIndex As Integer)

If dg.Col = 1 Then

If Len(ado.Recordset!Kode) < 5 Then

MsgBox "Kode Harus 5 digit"

dg.Col = 1

Exit Sub

End If

Call Koneksi

RSObat.Open "Select * from Obat where KodeObt='" & ado.Recordset!Kode & "'", Conn

If Not RSObat.EOF Then

ado.Recordset!Kode = RSObat!KODEOBT

ado.Recordset!Nama = RSObat!NamaOBT

ado.Recordset!Harga = RSObat!hargaobt

dg.Col = 4

dg.Refresh

Exit Sub

End If

If dg.Col = 4 Then

If ado.Recordset!dosis > RSObat!JUMLAHOBT Then

MsgBox "STOK OBAT KURANG"

Exit Sub

Else

ado.Recordset!dosis = ado.Recordset!dosis

ado.Recordset!subtotal = ado.Recordset!Harga * ado.Recordset!dosis

ado.Recordset.Update

Call Tambah_Baris

ado.Recordset.MoveNext

dg.Col = 1

ado.Recordset.MoveLast

Item = Format(Jumlah, "#,###,###")

Total = Format(Jumlah2, "#,###,###")

End If

End Sub

Private Sub List1_keyPress(Keyascii As Integer)

If Keyascii = 13 Then

If dg.SelText <> Right(List1, 5) Then

dg.SelText = Right(List1, 5)

ado.Recordset.Update

Call Koneksi

RSObat.Open "Select * from Obat where KodeObt='" & Right(List1, 5) & "'", Conn

RSObat.Requery

If Not RSObat.EOF Then

ado.Recordset!Kode = RSObat!KODEOBT

ado.Recordset!Nama = RSObat!NamaOBT

ado.Recordset!Harga = RSObat!hargaobt

ado.Recordset.Update

dg.SetFocus

dg.Col = 4

End If

End Sub

Private Sub Dibayar_KeyPress(Keyascii As Integer)

If Keyascii = 13 Then

If Dibayar = "" Or Val(Dibayar) < (Total) Then

MsgBox "Jumlah Pembayaran Kurang"

Dibayar.SetFocus

Else

Dibayar = Format(Dibayar, "###,###,###")

If Dibayar = Total Then

Kembali = Dibayar - Total

Else

Kembali = Format(Dibayar - Total, "###,###,###")

End If

CmdSimpan.Enabled = True

CmdSimpan.SetFocus

End If

If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0

End Sub

Private Sub Auto()

Function Tambah_Baris()

For I = ado.Recordset.RecordCount To ado.Recordset.RecordCount

ado.Recordset.AddNew

ado.Recordset!Nomor = I + 1

ado.Recordset.Update

Next I

End Function

Private Sub DG_Keypress(Keyascii As Integer)

Keyascii = Asc(UCase(Chr(Keyascii)))

If dg.Col = 4 Then

If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack Or Keyascii = vbKeyReturn) Then Keyascii = 0

End If

End Sub

Private Sub Bersihkan()

Combo1 = ""

Kodedkt = ""

Namadkt = ""

KodePsn = ""

NamaPsn = ""

Kodepl = ""

Namapl = ""

Total = ""

Dibayar = ""

Kembali = ""

Combo1 = ""

Item = ""

List1.Clear

End Sub

Private Sub CmdSimpan_Click()

If Combo1 = "" Or Item = "" Then

MsgBox "Data belum lengkap"

Exit Sub

End If

Call Koneksi

Dim InputResep As String

'simpan ke tabel resep

InputResep = "Insert Into Resep(Nomorrsp,Tanggalrsp,kodedkt,kodepsn,kodepl,kodepmk,TotalHrg,Dibayar,Kembali)" & _

"values('" & Combo1 & "','" & TANGGAL & "','" & Kodedkt & "','" & KodePsn & "','" & Kodepl & "','" & Menu.STBar.Panels(3).Text & "','" & Total & "','" & Dibayar & "','" & Kembali & "')"

Conn.Execute (InputResep)

aaa = "update pendaftaran set ket='1' where nomordft='" & Combo1 & "'"

Conn.Execute aaa

'simpan ke tabel detailresep

ado.Recordset.MoveFirst

Do While Not ado.Recordset.EOF

If ado.Recordset!Kode <> vbNullString Then

Dim InputDetail As String

InputDetail = "Insert Into Detail(Nomorrsp,KodeObt,harga,dosis,subtotal) " & _

"values ('" & Combo1 & "','" & ado.Recordset!Kode & "','" & ado.Recordset!Harga & "','" & ado.Recordset!dosis & "','" & ado.Recordset!subtotal & "')"

Conn.Execute (InputDetail)

End If

ado.Recordset.MoveNext

Loop

'kurangi jumlah obat

ado.Recordset.MoveFirst

Do While Not ado.Recordset.EOF

If ado.Recordset!Kode <> vbNullString Then

Call Koneksi

RSObat.Open "Select * from Obat where KodeObt='" & ado.Recordset!Kode & "'", Conn

If Not RSObat.EOF Then

Dim Kurangi As String

Kurangi = "update Obat set jumlahObt='" & RSObat!JUMLAHOBT - ado.Recordset!dosis & "' where kodeObt='" & ado.Recordset!Kode & "'"

Conn.Execute (Kurangi)

End If

ado.Recordset.MoveNext

Loop

simpanbyr = "insert into pembayaran(nomorbyr,kodepsn,tanggalbyr,jumlahBYR) values ('" & Combo1 & "','" & KodePsn & "','" & TANGGAL & "','" & Total & "')"

Conn.Execute wsimpanbyr

Bersihkan

Form_Activate

Combo1.SetFocus

Call Cetak

End Sub

Private Sub CmdBatal_Click()

Bersihkan

Form_Activate

End Sub

Private Sub CmdTutup_Click()

Unload Me

End Sub

Function Jumlah()

Set TTlHarga = New ADODB.Recordset

TTlHarga.Open "select sum(dosis) as JumTotal from Temporer", Conn

Jumlah = TTlHarga!JumTotal

End Function

Function Jumlah2()

Set TTlHarga = New ADODB.Recordset

TTlHarga.Open "select sum(subtotal) as JumTotal from Temporer", Conn

Jumlah2 = TTlHarga!JumTotal

End Function

Function Cetak()

Call Koneksi

RSResep.Open "select * from Resep Where Nomorrsp In(Select Max(Nomorrsp)From Resep)Order By Nomorrsp Desc", Conn

Layar.Show

Dim MGrs As String

Layar.Font = "Courier New"

Layar.Print

RSPasien.Open "select * From pasien where KODEPSN= '" & RSResep!KodePsn & "'", Conn

RSDokter.Open "select * From Dokter where Kodedkt= '" & RSResep!Kodedkt & "'", Conn

RSPoli.Open "select * From poli where kodepl= '" & RSResep!Kodepl & "'", Conn

Layar.Print Tab(5); "Nomorrsp : "; RSResep!nomorrsp

Layar.Print Tab(5); "Tanggal : "; Format(RSResep!TanggalRsp, "DD-MMM-YY")

Layar.Print Tab(5); "Dokter : "; RSDokter!Namadkt

Layar.Print Tab(5); "Pasien : "; RSPasien!NamaPsn

Layar.Print Tab(5); "Poli : "; RSPoli!Namapl

MGrs = String$(33, "-")

Layar.Print Tab(5); MGrs

RSDetail.Open "select * from Detail Where Nomorrsp='" & RSResep!nomorrsp & "'", Conn

RSDetail.MoveFirst

No = 0

Do While Not RSDetail.EOF

No = No + 1

Set RSObat = New ADODB.Recordset

RSObat.Open "select * From Obat where KodeObt= '" & RSDetail!KODEOBT & "'", Conn

RSObat.Requery

Layar.Print Tab(5); No; Space(2); RSObat!NamaOBT

Layar.Print Tab(10); RKanan(RSDetail!dosis, "###"); Space(1); "X";

Layar.Print Tab(15); Format(RSObat!hargaobt, "###,###,###");

Layar.Print Tab(25); RKanan(RSDetail!dosis * RSObat!hargaobt, "###,###,###")

RSDetail.MoveNext

Loop

Layar.Print Tab(5); MGrs

Layar.Print Tab(5); "Total :";

Layar.Print Tab(25); RKanan(RSResep!TotalHRG, "###,###,###");

Layar.Print Tab(5); "Dibayar :";

Layar.Print Tab(25); RKanan(RSResep!Dibayar, "###,###,###");

Layar.Print Tab(5); MGrs

Layar.Print Tab(5); "Kembali :";

If RSResep!Dibayar = RSResep!TotalHRG Then

Layar.Print Tab(34); RSResep!Dibayar - RSResep!TotalHRG

Else

Layar.Print Tab(25); RKanan(RSResep!Dibayar - RSResep!TotalHRG, "###,###,###");

End If

Layar.Print Tab(5); MGrs

Layar.Print Tab(5); "Semoga Lekas Sembuh"

Layar.Print

Conn.Close

End Function

Private Function RKanan(NData, CFormat) As String

RKanan = Format(NData, CFormat)

RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan

End Function

1.5.2 Pembayaran

Data pembayaran pada dasarnya menyatu dengan form resep, hanya saja pada saat disimpan data itu dipisahkan tabelnya selain di tabel resep juga menyimpan data pembayarannya. Perhatikan koding di bawah ini.

simpanbyr = "insert into pembayaran(nomorbyr,kodepsn,tanggalbyr,jumlahBYR) values ('" & Combo1 & "','" & KodePsn & "','" & TANGGAL & "','" & Total & "')"

Conn.Execute wsimpanbyr

1.6 Pembuatan Laporan

1.6.1 Laporan Data Master

Pembuatan laporan dibagi menjadi dua bagian besar. Pertama laporan data master berikut laopran data dengan kriteria tertentu dan kedua laporan data transaksi. Inipun dibagi menjadi beberapa bagian yaitu laporan pendaftaran, laporan resep dan laporan pembayaran. Untuk pembuatan laporan data master diawali dengan membuat form seperti gambar di bawah ini.

Koding :

Private Sub Form_Load()

Combo1.AddItem "Dokter"

Combo1.AddItem "Obat"

Combo1.AddItem "Pasien"

Combo1.AddItem "Poli"

Combo1.AddItem "Pemakai"

Combo1.AddItem "Pendaftaran"

Combo7.AddItem "Nomor"

Combo7.AddItem "Tanggal"

Combo7.AddItem "Dokter"

Combo7.AddItem "Pasien"

Combo7.AddItem "Poli"

Call Koneksi

RSDokter.Open "select distinct spesialis from dokter", Conn

Do While Not RSDokter.EOF

Combo2.AddItem RSDokter!spesialis

RSDokter.MoveNext

Loop

RSObat.Open "select distinct jenisobt from obat", Conn

Do While Not RSObat.EOF

Combo3.AddItem RSObat!JenisObt

RSObat.MoveNext

Loop

Conn.Close

Call Koneksi

RSObat.Open "select distinct katagori from obat", Conn

Do While Not RSObat.EOF

Combo4.AddItem RSObat!katagori

RSObat.MoveNext

Loop

Conn.Close

Call Koneksi

RSPasien.Open "select distinct genderpsn from pasien", Conn

Do While Not RSPasien.EOF

Combo5.AddItem RSPasien!genderpsn

RSPasien.MoveNext

Loop

Conn.Close

Call Koneksi

RSPemakai.Open "select distinct statuspmk from pemakai", Conn

Do While Not RSPemakai.EOF

Combo6.AddItem RSPemakai!StatusPMK

RSPemakai.MoveNext

Loop

Conn.Close

End Sub

Private Sub Combo1_Click()

If Combo1 = "Dokter" Then

CR.ReportFileName = App.Path & "\dokter.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End If