Home contoh program vb 6 program aplikasi rekam medis rumah sakit vb 6

Saturday, March 18, 2017

program aplikasi rekam medis rumah sakit vb 6

Diterbitkan
Tags


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
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
    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 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 If
    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
    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
        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
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
Layar.Print
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

Artikel Terkait

uus rusmawan

Next Post
Previous Post

6 comments

avatar
Balas
Unknown delete May 12, 2017 at 6:44 AM

thanks banyak pak,,ini sangat membantu sy di dunia IT

avatar
Balas
Unknown delete March 21, 2019 at 5:23 AM

Bang minta aplikasi reka mediknya... email anwar.dinkes.koltim@gmail.com

avatar
Balas
Unknown delete October 6, 2019 at 4:32 AM

Bang bs minta cosingan yang formnya..

avatar
Balas
Unknown delete February 4, 2022 at 6:44 PM

maaf Pak bisa minta aplikasi reka medisnya

avatar
Balas
Anonymous delete March 5, 2023 at 11:23 PM

halo pak boleh minta filenya 🙏🏻


EmoticonEmoticon

Subscribe to: Post Comments (Atom)