FORM MENU Private Sub Command1_Click() frmpasien.Show Unload Me End Sub Private Sub Command2_Click() frmpembayaran.Show Unload Me End Sub Private Sub Command3_Click() frmberobat.Show Unload Me End Sub Private Sub Command4_Click() frmobat.Show Unload Me End Sub Private Sub Command5_Click() frmlaporan.Show Unload Me End Sub Private Sub Command6_Click() End End Sub Private Sub Label3_Click() End End Sub Private Sub Label4_Click() MsgBox "Program ini dibuat oleh Diana" & Chr(13) & "Untuk mengikuti Sidang Sarjana", vbInformation, "Pesan" End Sub
FORM DATA PASIEN Private Enum Aksi flNone = 0 flAdd = 1 flEdit = 2 End Enum Dim Flag As Aksi Private Sub kunci(x) Text1.Locked = x Text2.Locked = x Text3.Locked = x Text4.Locked = x Text5.Locked = x Text6.Locked = x End Sub Private Sub AturTombol(add, edit, delete, update, cancel) cmdadd.Enabled = add cmdedit.Enabled = edit cmddelete.Enabled = delete cmdupdate.Enabled = update
cmdcancel.Enabled = cancel End Sub Private Sub cmdadd_Click() Flag = flAdd Data1.Recordset.MoveLast a = Data1.Recordset.Fields(0).Value b = Format$(Val(a) + 1, "000") Data1.Recordset.AddNew Text1.Text = b Call kunci(False) Call AturTombol(False, False, False, True, True) Text2.SetFocus End Sub Private Sub cmddelete_Click() On Error GoTo ErrCmdDelete_Click x = MsgBox("Yakin akan dihapus...", vbYesNo + vbQuestion, "Konfirmasi...") If x = vbYes Then Data1.Recordset.delete Data1.Recordset.MoveNext End If If Data1.Recordset.EOF Then Data1.Recordset.MoveLast End If Exit Sub ErrCmdDelete_Click: Select Case Err.Number Case 3021 MsgBox "Data telah kosong", vbOKOnly + vbInformation, "Peringatan..." End Select End Sub Private Sub cmdedit_Click() Flag = flEdit Data1.Recordset.edit Call kunci(False) Call AturTombol(False, False, False, True, True) End Sub Private Sub cmdexit_Click() frmmenu.Show Unload Me End Sub Private Sub cmdupdate_Click() On Error GoTo ErrUpdate_click If Text1.Text = "" Then MsgBox "No Pasien idak boleh kosong", vbCritical, "Peringatan" Exit Sub End If If Text2.Text = "" Then MsgBox "Nama Pasien tidak boleh kosong", vbCritical, "Peringatan" Exit Sub End If If Text3.Text = "" Then MsgBox "Jenis Kelamin tidak boleh kosong", vbCritical, "Peringatan" Exit Sub End If If Text4.Text = "" Then MsgBox "Umur tidak boleh kosong", vbCritical, "Peringatan"
Exit Sub End If If Text5.Text = "" Then MsgBox "Golongan Darah tidak boleh kosong", vbCritical, "Peringatan" Exit Sub End If If Text6.Text = "" Then MsgBox "Alamat tidak boleh kosong", vbCritical, "Peringatan" Exit Sub End If Data1.Recordset.update MsgBox "Data Pasien tersimpan", vbInformation, "Informasi" Flag = flNone Call kunci(True) Call AturTombol(True, True, True, False, False) Data1.Recordset.Bookmark = Data1.Recordset.LastModified Exit Sub ErrUpdate_click: Select Case Err.Number Case 3022 MsgBox "Telah terjadi duplikasi pada No Pasien", vbOKOnly + vbInformation, "Peringatan" Case Else MsgBox Err.Number & vbCrLf & Err.Description End Select End Sub Private Sub cmdcancel_Click() Data1.Recordset.CancelUpdate Call kunci(True) Flag = flNone Call AturTombol(True, True, True, False, False) End Sub Private Sub Command1_Click() On Error GoTo salah frmcetak.Show frmcetak.Font = "Courier New" frmcetak.FontSize = "12" mgrs = String(80, "-") frmcetak.Print frmcetak.Print Tab(29); "BALAI PENGOBATAN" frmcetak.Print Tab(28); "PAMULANG PERMAI II" frmcetak.Print Tab(25); "BLOK C 29 No.17 Telp 7493743" frmcetak.Print mgrs frmcetak.Print frmcetak.Print Tab(31); "KARTU BEROBAT" frmcetak.Print mgrs frmcetak.Print frmcetak.Print Tab(10); "No Pasien : " & Text1.Text; frmcetak.Print Tab(10); "Nama Pasien : " & Text2.Text; frmcetak.Print Tab(10); "Jenis Kelamin : " & Text3.Text; frmcetak.Print Tab(10); "Umur : " & Text4.Text & " Tahun"; frmcetak.Print Tab(10); "Golongan Darah : " & Text5.Text; frmcetak.Print Tab(10); "Alamat : " & Text6.Text frmcetak.Print mgrs Unload Me Exit Sub salah: Select Case Err.Number
Case 482 MsgBox "Printer Error...", vbCritical, "Peringatan..." Unload frmcetak frmberobat.Show Case Else MsgBox Err.Number & vbCrLf & Err.Description End Select End Sub Private Sub Form_Load() Data1.DatabaseName = App.Path & "\diana1.mdb" Data1.RecordSource = "pasien" Call AturTombol(True, True, True, False, False) Call kunci(True) End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = 13) Then KeyAscii = 0 End If If KeyAscii = 13 Then Text2.SetFocus End If End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Text3.SetFocus End If End Sub Private Sub Text3_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Text4.SetFocus End If End Sub Private Sub Text4_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Text5.SetFocus End If End Sub Private Sub Text5_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Text6.SetFocus End If End Sub Private Sub Text6_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cmdupdate.SetFocus End If End Sub
FORM DATA OBAT Private Enum Aksi flNone = 0 flAdd = 1 flEdit = 2 End Enum Dim Flag As Aksi Private Sub kunci(x) Text1.Locked = x Text2.Locked = x Text3.Locked = x Text4.Locked = x Text5.Locked = x End Sub Private Sub AturTombol(add, edit, delete, update, cancel) cmdadd.Enabled = add cmdedit.Enabled = edit cmddelete.Enabled = delete cmdupdate.Enabled = update cmdcancel.Enabled = cancel End Sub Private Sub cmdadd_Click() Flag = flAdd Data1.Recordset.MoveLast a = Data1.Recordset.Fields(0).Value b = Format$(Val(a) + 1, "000") Data1.Recordset.AddNew Text1.Text = b Call kunci(False) Call AturTombol(False, False, False, True, True) Text2.SetFocus End Sub Private Sub cmddelete_Click() On Error GoTo ErrCmdDelete_Click x = MsgBox("Yakin akan dihapus...", vbYesNo + vbQuestion, "Konfirmasi...") If x = vbYes Then Data1.Recordset.delete Data1.Recordset.MoveNext End If If Data1.Recordset.EOF Then Data1.Recordset.MoveLast End If Exit Sub ErrCmdDelete_Click: Select Case Err.Number Case 3021 MsgBox "Data telah kosong", vbOKOnly + vbInformation, "Peringatan..." End Select End Sub Private Sub cmdedit_Click() Flag = flEdit Data1.Recordset.edit Call kunci(False) Call AturTombol(False, False, False, True, True) End Sub
Private Sub cmdexit_Click() frmmenu.Show Unload Me End Sub Private Sub cmdupdate_Click() On Error GoTo ErrUpdate_click If Text1.Text = "" Then MsgBox "Kode Obat idak boleh kosong", vbCritical, "Peringatan" Exit Sub End If If Text2.Text = "" Then MsgBox "Nama Obat tidak boleh kosong", vbCritical, "Peringatan" Exit Sub End If If Text3.Text = "" Then MsgBox "Persediaan tidak boleh kosong", vbCritical, "Peringatan" Exit Sub End If If Text5.Text = "" Then MsgBox "harga Obat tidak boleh kosong", vbCritical, "Peringatan" Exit Sub End If Data1.Recordset.update MsgBox "Data Obat tersimpan", vbInformation, "Informasi" Flag = flNone Call kunci(True) Call AturTombol(True, True, True, False, False) Data1.Recordset.Bookmark = Data1.Recordset.LastModified Exit Sub ErrUpdate_click: Select Case Err.Number Case 3022 MsgBox "Telah terjadi duplikasi pada No Pasien", vbOKOnly + vbInformation, "Peringatan" Case Else MsgBox Err.Number & vbCrLf & Err.Description End Select End Sub Private Sub cmdcancel_Click() Data1.Recordset.CancelUpdate Call kunci(True) Flag = flNone Call AturTombol(True, True, True, False, False) End Sub Private Sub Form_Load() Data1.DatabaseName = App.Path & "\diana1.mdb" Data1.RecordSource = "Data_Obat" Call AturTombol(True, True, True, False, False) Call kunci(True) End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = 13) Then KeyAscii = 0 End If If KeyAscii = 13 Then Text2.SetFocus End If End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Text3.SetFocus End If End Sub Private Sub Text3_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Text4.Text = Text3.Text Text5.SetFocus End If End Sub Private Sub Text5_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cmdupdate.SetFocus End If End Sub Private Sub Text6_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cmdupdate.SetFocus End If End Sub
FORM BEROBAT PASIEN Sub tombol(trans, add, update, cancel, ok) cmdtrans.Enabled = trans cmdadd.Enabled = add cmdupdate.Enabled = update cmdcancel.Enabled = cancel Command1.Enabled = ok End Sub Sub kunci(x) End Sub Private Sub cmdadd_Click() Call tombol(0, 0, 0, 0, 0) Data1.Recordset.AddNew Combo2.SetFocus End Sub Private Sub cmdcancel_Click() Data1.Recordset.CancelUpdate Call tombol(0, 1, 0, 0, 0) End Sub Private Sub cmdexit_Click() frmmenu.Show Unload Me End Sub Private Sub cmdok_Click() On Error GoTo salah Dbobat.Recordset.MoveFirst Do If Dbobat.Recordset.Fields("sisa_stok").Value < Val(Text12.Text) Then MsgBox "Transaksi Melebihi Stok", vbInformation, "Pesan" Text12.SetFocus
Exit Sub End If Dbobat.Recordset.MoveNext Loop Until Dbobat.Recordset.EOF If M.TextMatrix(1, 0) = "" Then M.TextMatrix(1, 0) = Combo1.Text M.TextMatrix(1, 1) = Text10.Text M.TextMatrix(1, 2) = Text7.Text M.TextMatrix(1, 3) = Text12.Text M.TextMatrix(1, 4) = Text13.Text M.TextMatrix(1, 5) = Text8.Text M.TextMatrix(1, 6) = Text9.Text Else M.AddItem Combo2.Text & vbTab & Text10.Text & vbTab & Text7.Text & vbTab & Text12.Text & vbTab & Text13.Text & vbTab & Text8.Text & vbTab & Text9.Text End If total = 0 harga = 0 For x = 1 To M.Rows - 1 total = total + Val(M.TextMatrix(x, 4)) Next x Label19.Caption = total Call tombol(0, 0, 1, 1, 0) cmdupdate.SetFocus Exit Sub salah: Select Case Err.Number Case 3021: MsgBox "Duplicate", vbInformation, "Pesan" End Select End Sub Private Sub cmdtrans_Click() Call tombol(0, 0, 0, 1, 0) Text1.SetFocus If Not (Dbberobat.Recordset.EOF And Dbberobat.Recordset.BOF) Then 'jika Dbberobat.Recordset.MoveLast a = Dbberobat.Recordset.Fields(0).Value Else a=0 End If b = Format$(Val(a) + 1, "000") Text1.SetFocus Text1.Text = b Dbberobat.Recordset.AddNew End Sub Private Sub cmdupdate_Click() tmp = Combo2.List(Combo2.ListIndex) Dbobat.Recordset.MoveFirst Do If Dbobat.Recordset.Fields("Kode_Obat").Value = tmp Then Dbobat.Recordset.edit Dbobat.Recordset.Fields("sisa_stok").Value = Dbobat.Recordset.Fields("sisa_stok").Value Val(Text12.Text)
Dbobat.Recordset.Fields("stok").Value = Dbobat.Recordset.Fields("sisa_stok").Value Dbobat.Recordset.update End If Dbobat.Recordset.MoveNext Loop Until Dbobat.Recordset.EOF Dbobat.Refresh Data1.Recordset.Fields("kode_obat").Value = Combo2.Text Data1.Recordset.Fields("nama_obat").Value = Text10.Text Data1.Recordset.Fields("harga_satuan").Value = Text7.Text Data1.Recordset.Fields("banyaknya").Value = Text12.Text Data1.Recordset.Fields("biaya_obat").Value = Text13.Text Data1.Recordset.Fields("keluhan").Value = Text8.Text Data1.Recordset.Fields("diagnosa").Value = Text9.Text Data1.Recordset.Fields("Tgl_Pesan").Value = Label22.Caption Data1.Recordset.update MsgBox "Tersimpan", vbInformation, "Pesan" Data1.Refresh M.Refresh Call tombol(0, 1, 0, 1, 1) cmdadd.SetFocus End Sub Private Sub Combo1_KeyPress(KeyAscii As Integer) tmp = Combo1.List(Combo1.ListIndex) If KeyAscii = 13 Then Dbpasien.Recordset.MoveFirst Do If Dbpasien.Recordset.Fields("No_Pasien").Value = tmp Then Text2.Text = Dbpasien.Recordset.Fields("Nama").Value Text3.Text = Dbpasien.Recordset.Fields("Jenis_Kelamin").Value Text4.Text = Dbpasien.Recordset.Fields("Umur").Value Text5.Text = Dbpasien.Recordset.Fields("Gol_Darah").Value Text6.Text = Dbpasien.Recordset.Fields("Alamat").Value End If Dbpasien.Recordset.MoveNext Loop Until Dbpasien.Recordset.EOF Call tombol(0, 1, 0, 0, 0) cmdadd.SetFocus End If End Sub Private Sub Combo2_KeyPress(KeyAscii As Integer) tmp = Combo2.List(Combo2.ListIndex) If KeyAscii = 13 Then Dbobat.Recordset.MoveFirst Do If tmp = Dbobat.Recordset.Fields("Kode_Obat").Value Then Text10.Text = Dbobat.Recordset.Fields("Nama_Obat").Value Text7.Text = Dbobat.Recordset.Fields("Harga_Satuan").Value End If Dbobat.Recordset.MoveNext Loop Until Dbobat.Recordset.EOF Text12.Text = ""
Text8.Text = "" Text9.Text = "" Text12.SetFocus End If End Sub Private Sub Command1_Click() Call tombol(0, 0, 0, 0, 0) Dbberobat.Recordset.Fields("No_Pendaftaran") = Text1.Text Dbberobat.Recordset.Fields("No_Pasien") = Combo1.Text Dbberobat.Recordset.Fields("Tgl_Berobat") = Format(Label22.Caption, "short date") Dbberobat.Recordset.Fields("Nama").Value = Text2.Text Dbberobat.Recordset.Fields("Biaya_Obat") = Label19.Caption Dbberobat.Recordset.update Dbberobat.Refresh frmcetak.Show frmcetak.Font = "Courier New" frmcetak.FontSize = "10" Data1.Recordset.MoveFirst mtotal = 0 mno = 0 mhal = 0 Do While Not Data1.Recordset.EOF mhal = mhal + 1 frmcetak.Print frmcetak.Print Tab(2); "DATA PASIEN BEROBAT" frmcetak.Print Tab(2); "Balai Pengobatan Pamulang Permai" frmcetak.Print Tab(2); "BLOK C 29 NO 17 Tlp 7493743" frmcetak.Print frmcetak.Print Tab(2); "No Pendaftaran = " & Text1.Text; frmcetak.Print Tab(50); "Tanggal Berobat= " & Label22.Caption frmcetak.Print Tab(2); "No Pasien = " & Combo1.Text; frmcetak.Print Tab(50); "Nama = " & Text2.Text frmcetak.Print Tab(50); "No Telp = " & Text6.Text frmcetak.Print frmcetak.Print frmcetak.Print Tab(30); "DAFTAR PEMESANAN OBAT" mgrs = String(100, "-") frmcetak.Print mgrs frmcetak.Print Tab(3); "No"; frmcetak.Print Tab(8); "Kode Obat"; frmcetak.Print Tab(18); "Nama"; frmcetak.Print Tab(30); "Harga"; frmcetak.Print Tab(40); "Item"; frmcetak.Print Tab(46); "Biaya"; frmcetak.Print Tab(52); "Keluhan"; frmcetak.Print Tab(75); "Diagnosa" frmcetak.Print mgrs msubtotal = 0 mbaris = 0 Do While Not Data1.Recordset.EOF And mbaris <= 55 mno = mno + 1 frmcetak.Print Tab(3); mno; frmcetak.Print Tab(8); Data1.Recordset.Fields(0); frmcetak.Print Tab(18); Data1.Recordset.Fields(1); frmcetak.Print Tab(30); Data1.Recordset.Fields(2);
frmcetak.Print Tab(40); Data1.Recordset.Fields(3); frmcetak.Print Tab(46); Data1.Recordset.Fields(4); frmcetak.Print Tab(52); Data1.Recordset.Fields(5); frmcetak.Print Tab(75); Data1.Recordset.Fields(6); mbaris = mbaris + 1 Data1.Recordset.MoveNext Loop frmcetak.Print frmcetak.Print mgrs Loop frmcetak.Print frmcetak.Print Tab(10); "Jumlah Total"; frmcetak.Print Tab(46); "" & Format(Label19.Caption, "Rp #,###,###"); Unload Me End Sub Private Sub Form_Activate() Call tombol(1, 0, 0, 0, 0) Label22.Caption = Format(Date, "short date") Dbpasien.Recordset.MoveFirst Do Combo1.AddItem Dbpasien.Recordset.Fields(0).Value Dbpasien.Recordset.MoveNext Loop Until Dbpasien.Recordset.EOF Dbobat.Recordset.MoveFirst Do Combo2.AddItem Dbobat.Recordset.Fields(0).Value Dbobat.Recordset.MoveNext Loop Until Dbobat.Recordset.EOF M.ColWidth(0) = 700 M.ColWidth(1) = 1500 M.ColWidth(2) = 1000 M.ColWidth(3) = 1000 M.ColWidth(4) = 1000 M.ColWidth(5) = 2000 M.ColWidth(6) = 2000 Data1.DatabaseName = App.Path & "\diana1.mdb" Data1.RecordSource = Text1.Text Data1.Refresh End Sub Private Sub Form_Load() Dbpasien.DatabaseName = App.Path & "\diana1.mdb" Dbpasien.RecordSource = "pasien" Dbberobat.DatabaseName = App.Path & "\diana1.mdb" Dbberobat.RecordSource = "berobat" Data1.DatabaseName = App.Path & "\diana1.mdb" Dbobat.DatabaseName = App.Path & "\diana1.mdb" Dbobat.RecordSource = "data_obat" Call tombol(1, 0, 0, 0, 0) End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) On Error GoTo salah If KeyAscii = 13 And Text1.Text <> "" Then mysqlstring = "CREATE TABLE " & Text1.Text & "" _ & "([Kode_Obat] TEXT (6),[Nama_Obat] TEXT (30), " _ & "[Harga_Satuan] TEXT (10),[Banyaknya] INTEGER,[biaya_obat] CURRENCY, " _ & "[Keluhan] TEXT (50),[Diagnosa] TEXT (50),Tgl_Pesan Date);" Data1.Database.Execute mysqlstring
Data1.DatabaseName = App.Path & "\diana1.mdb" Data1.RecordSource = Text1.Text Data1.Refresh Combo1.SetFocus End If Exit Sub salah: Select Case Err.Number Case 3010: MsgBox "No Kwitansi sudah ada", vbInformation, "Pesan" Text1.Text = "" Text1.SetFocus End Select End Sub Private Sub Text12_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = 13) Then KeyAscii = 0 End If If KeyAscii = 13 Then Dbobat.Recordset.MoveFirst Do If Dbobat.Recordset.Fields("sisa_stok").Value < Val(Text12.Text) Then MsgBox "Data Obat Melebihi Stok", vbInformation, "Pesan" Text12.SetFocus Exit Sub End If Dbobat.Recordset.MoveNext Loop Until Dbobat.Recordset.EOF Text13.Text = Val(Text7.Text) * Val(Text12.Text) Text8.SetFocus End If End Sub
FORM PEMBAYARAN Sub tombol(add, update, cancel, cetak) cmdadd.Enabled = add cmdupdate.Enabled = update cmdcancel.Enabled = cancel cmdcetak.Enabled = cetak End Sub Sub kunci(x) End Sub Private Sub cmdadd_Click() Call kunci(0) Call tombol(0, 1, 1, 0) If Not (Dbbayar.Recordset.EOF And Dbbayar.Recordset.BOF) Then Dbbayar.Recordset.MoveLast a = Dbbayar.Recordset.Fields(0).Value Else a=0 End If b = Format$(Val(a) + 1, "000") Combo1.SetFocus
Dbbayar.Recordset.AddNew Label28.Caption = b End Sub Private Sub cmdcetak_Click() On Error GoTo salah Call kunci(1) Call tombol(1, 0, 0, 0) Data1.RecordSource = "select kode_obat,nama_obat,harga_satuan,banyaknya,biaya_obat,keluhan,diagnosa from " & Combo1.Text Data1.Refresh 'tanya joko frmcetak.Show frmcetak.Font = "Courier New" frmcetak.FontSize = "10" frmcetak.Print frmcetak.Print Tab(2); "KWITANSI PEMBAYARAN" frmcetak.Print Tab(2); "PAMULANG PERMAI II C 29 NO 17 TLP 7493743" frmcetak.Print Tab(2); "TANGERANG BANTEN" frmcetak.Print frmcetak.Print Tab(2); "No Kwitansi = " & Label28.Caption frmcetak.Print Tab(2); "Tgl Sekarang = " & Label8.Caption; frmcetak.Print Tab(50); "Tgl Berobat = " & Label27.Caption frmcetak.Print frmcetak.Print Tab(30); "DAFTAR PEMESANAN OBAT" mgrs = String(100, "-") frmcetak.Print mgrs frmcetak.Print Tab(3); "No"; frmcetak.Print Tab(8); "Kode Obat"; frmcetak.Print Tab(18); "Nama"; frmcetak.Print Tab(30); "Harga"; frmcetak.Print Tab(40); "Item"; frmcetak.Print Tab(46); "Biaya"; frmcetak.Print Tab(52); "Keluhan"; frmcetak.Print Tab(75); "Diagnosa" frmcetak.Print mgrs msubtotal = 0 mbaris = 0 Do While Not Data1.Recordset.EOF And mbaris <= 55 mno = mno + 1 frmcetak.Print Tab(3); mno; frmcetak.Print Tab(8); Data1.Recordset.Fields(0); frmcetak.Print Tab(18); Data1.Recordset.Fields(1); frmcetak.Print Tab(30); Data1.Recordset.Fields(2); frmcetak.Print Tab(40); Data1.Recordset.Fields(3); frmcetak.Print Tab(46); Data1.Recordset.Fields(4); frmcetak.Print Tab(52); Data1.Recordset.Fields(5); frmcetak.Print Tab(75); Data1.Recordset.Fields(6); mbaris = mbaris + 1 Data1.Recordset.MoveNext Loop frmcetak.Print frmcetak.Print mgrs frmcetak.Print Tab(2); "Total = " & Format(Label29.Caption, "###,###,###") frmcetak.Print Tab(2); "Pembayaran = " & Format(Label32.Caption, "###,###,###") frmcetak.Print Tab(2); "Kembali = " & Format(Label30.Caption, "###,###,###") frmcetak.Print mgrs = String(80, "-")
frmcetak.Print mgrs frmcetak.Print Tab(70); "Kasir" frmcetak.Print frmcetak.Print frmcetak.Print Tab(70); "Diana" Unload Me Exit Sub salah: Select Case Err.Number Case 482 MsgBox "Printer Error...", vbCritical, "Peringatan..." Unload frmcetak frmberobat.Show Case Else MsgBox Err.Number & vbCrLf & Err.Description End Select End Sub Private Sub cmdexit_Click() frmmenu.Show Unload Me End Sub Private Sub cmdupdate_Click() Dbbayar.Recordset.Fields("No_Kwitansi").Value = Label28.Caption Dbbayar.Recordset.Fields("No_Pendaftaran").Value = Combo1.Text Dbbayar.Recordset.Fields("No_Pasien").Value = Label13.Caption Dbbayar.Recordset.Fields("Tgl").Value = Label8.Caption Dbbayar.Recordset.Fields("Biaya_Obat").Value = Label26.Caption Dbbayar.Recordset.Fields("Biaya_Pemeriksaan").Value = Label31.Caption Dbbayar.Recordset.Fields("Total").Value = Label29.Caption Dbbayar.Recordset.update MsgBox "Data Tersimpan...", vbOKOnly + vbInformation, "Pesan..." Dbbayar.Refresh Call kunci(1) Call tombol(1, 0, 0, 1) cmdadd.SetFocus Exit Sub End Sub Private Sub Combo1_KeyPress(KeyAscii As Integer) tmp = Combo1.List(Combo1.ListIndex) If KeyAscii = 13 Then Dbberobat.Recordset.MoveFirst Do If Dbberobat.Recordset.Fields("No_Pendaftaran").Value = tmp Then Label13.Caption = Dbberobat.Recordset.Fields("No_Pasien").Value c = Label13.Caption Label27.Caption = Dbberobat.Recordset.Fields("Tgl_berobat").Value Label26.Caption = Dbberobat.Recordset.Fields("Biaya_Obat").Value Do If Dbpasien.Recordset.Fields(0).Value = c Then Label16.Caption = Dbpasien.Recordset.Fields("nama").Value Label17.Caption = Dbpasien.Recordset.Fields("jenis_kelamin").Value Label23.Caption = Dbpasien.Recordset.Fields("umur").Value Label24.Caption = Dbpasien.Recordset.Fields("Gol_darah").Value Label25.Caption = Dbpasien.Recordset.Fields("alamat").Value End If Dbpasien.Recordset.MoveNext
Loop Until Dbpasien.Recordset.EOF End If Dbberobat.Recordset.MoveNext Loop Until Dbberobat.Recordset.EOF Data1.DatabaseName = App.Path & "\diana1.mdb" Data1.RecordSource = "select kode_obat,nama_obat,harga_satuan,banyaknya,biaya_obat,keluhan,diagnosa from " & Combo1.Text Data1.Refresh 'tanya joko M.Refresh Text7.SetFocus End If End Sub Private Sub Form_Activate() On Error GoTo salah Label8.Caption = Format(Date, shortdate) Dbberobat.Recordset.MoveFirst Do Combo1.AddItem Dbberobat.Recordset.Fields("No_Pendaftaran").Value Dbberobat.Recordset.MoveNext Loop Until Dbberobat.Recordset.EOF M.ColWidth(0) = 700 M.ColWidth(1) = 1500 M.ColWidth(2) = 1000 M.ColWidth(3) = 1000 M.ColWidth(4) = 1000 M.ColWidth(5) = 2000 M.ColWidth(6) = 2000 Exit Sub salah: Select Case Err.Number Case 3021: MsgBox "Tidak ada Pasien yang Berobat...", vbOKOnly + vbInformation, "Pesan" frmmenu.Show Unload Me End Select End Sub Private Sub Form_Load() Dbberobat.DatabaseName = App.Path & "\diana1.mdb" Dbberobat.RecordSource = "berobat" Dbbayar.DatabaseName = App.Path & "\diana1.mdb" Dbbayar.RecordSource = "Bayar" Dbobat.DatabaseName = App.Path & "\diana1.mdb" Dbobat.RecordSource = "Data_Obat" Dbpasien.DatabaseName = App.Path & "\diana1.mdb" Dbpasien.RecordSource = "Pasien" Data1.DatabaseName = App.Path & "\diana1.mdb" End Sub Private Sub Text12_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = 13) Then KeyAscii = 0 End If If KeyAscii = 13 Then Combo1.SetFocus End If End Sub
Private Sub Text18_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = 13) Then KeyAscii = 0 End If If KeyAscii = 13 Then Label30.Caption = Val(Text18.Text) - Val(Label29.Caption) If Val(Text18.Text) < Val(Label29.Caption) Then MsgBox "Uang Kurang...", vbOKOnly + vbInformation, "Pesan..." Text18.Text = "" Text18.SetFocus End If Label32.Caption = Text18.Text cmdupdate.SetFocus End If End Sub Private Sub Text7_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = 13) Then KeyAscii = 0 End If If KeyAscii = 13 Then Label29.Caption = Val(Label26.Caption) + Val(Text7.Text) Label31.Caption = Text7.Text Text18.SetFocus End If End Sub
FORM LAPORAN Private Sub Command1_Click() On Error GoTo salah x = Text1.Text Y = Text2.Text If Command1.Caption = "Laporan Pasien Berobat" Then Data1.RecordSource = "select * from berobat where Tgl_Berobat between " & "#" & "" & x & "" & "#" & " And " & "#" & "" & Y & "" & "#" & "" Data1.Refresh Label5.Caption = "DATA PASIEN BEROBAT DARI TANGGAL " & x & " SAMPAI TANGGAL " & Y & "" D.Caption = "DATA PASIEN BEROBAT" Command1.Caption = "Cetak" t=0 Do t = t + Val(Data1.Recordset.Fields("Biaya_Obat").Value) Data1.Recordset.MoveNext Loop Until Data1.Recordset.EOF Label2.Caption = Format(t, "#,###,###") ElseIf Command1.Caption = "Cetak" Then MsgBox "Cetak” frmcetak.Show Data1.RecordSource = "select * from berobat where Tgl_Berobat between " & "#" & "" & x & "" & "#" & " And " & "#" & "" & Y & "" & "#" & "" Data1.Refresh Data1.Recordset.MoveFirst frmcetak.Font = "Courier New"
frmcetak.FontSize = 8 mno = 0 mhal = 0 mbaris = 0 Do While Not Data1.Recordset.EOF mhal = mhal + 1 frmcetak.Print frmcetak.Print Tab(2); "LAPORAN PASIEN BEROBAT" frmcetak.Print Tab(2); "PAMULAMG PERMAI II C29 NO 17 TELP 7493743" frmcetak.Print Tab(2); "TANGERANG BANTEN" frmcetak.Print frmcetak.Print Tab(45); "LAPORAN PASIEN BEROBAT" frmcetak.Print Tab(32); "DATA PASIEN DARI TANGGAL " & x & " SAMPAI TANGGAL " & Y & "" frmcetak.Print Tab(105); "Hal : "; Format(mhal, "###") mgrs = String$(114, "=") frmcetak.Print Tab(1); mgrs frmcetak.Print Tab(2); "No"; frmcetak.Print Tab(5); "No Pendaftaran"; frmcetak.Print Tab(21); "No Pasien"; frmcetak.Print Tab(32); "Nama Pasien"; frmcetak.Print Tab(45); "Tgl Berobat"; frmcetak.Print Tab(57); "Biaya Obat" frmcetak.Print Tab(1); mgrs msubtotal = 0 mbaris = 0 Do While Not Data1.Recordset.EOF And mbaris <= 55 mno = mno + 1 frmcetak.Print Tab(2); Format(mno, "###"); frmcetak.Print Tab(6); Data1.Recordset.Fields("No_Pendaftaran"); frmcetak.Print Tab(22); Data1.Recordset.Fields("No_Pasien"); frmcetak.Print Tab(33); Data1.Recordset.Fields("Nama"); frmcetak.Print Tab(46); Data1.Recordset.Fields("Tgl_berobat"); frmcetak.Print Tab(58); Format(Data1.Recordset.Fields("Biaya_Obat"), "###,####,###") mbaris = mbaris + 1 Data1.Recordset.MoveNext Loop mtotal = mtotal + msubtotal frmcetak.Print Tab(1); mgrs frmcetak.Print Tab(2); "JUMLAH TOTAL" frmcetak.Print Tab(106); "" & Format(Label2.Caption, "###,####,###") Loop Command1.Caption = "Laporan Pasien Berobat" Unload Me End If Exit Sub salah: Select Case Err.Number Case 3075: MsgBox "Isi Tanggal Dulu", vbInformation, "Pesan" Text1.SetFocus End Select End Sub Private Sub Command2_Click() If Command2.Caption = "Laporan Data Obat" Then Data1.RecordSource = "Data_Obat" Data1.Refresh
D.Caption = "DATA OBAT" Command2.Caption = "Cetak" ElseIf Command2.Caption = "Cetak" Then MsgBox "Cetak" frmcetak.Show Data1.RecordSource = "Data_Obat" Data1.Refresh Data1.Recordset.MoveFirst frmcetak.Font = "Courier New" frmcetak.FontSize = 10 mno = 0 mhal = 0 mbaris = 0 Do While Not Data1.Recordset.EOF mhal = mhal + 1 frmcetak.Print frmcetak.Print Tab(2); "LAPORAN DATA OBAT" frmcetak.Print Tab(2); "PAMULAMG PERMAI II C29 NO 17 TELP 7493743" frmcetak.Print Tab(2); "TANGERANG BANTEN" frmcetak.Print frmcetak.Print Tab(40); "LAPORAN DATA OBAT" frmcetak.Print Tab(90); "Hal : "; Format(mhal, "###") mgrs = String$(100, "=") frmcetak.Print Tab(1); mgrs frmcetak.Print Tab(2); "No"; frmcetak.Print Tab(5); "Kode Obat"; frmcetak.Print Tab(17); "Nama Obat"; frmcetak.Print Tab(33); "Stok"; frmcetak.Print Tab(41); "Sisa Stok"; frmcetak.Print Tab(53); "Harga Satuan" frmcetak.Print Tab(1); mgrs msubtotal = 0 mbaris = 0 Do While Not Data1.Recordset.EOF And mbaris <= 55 mno = mno + 1 frmcetak.Print Tab(2); Format(mno, "###"); frmcetak.Print Tab(6); Data1.Recordset.Fields("Kode_Obat"); frmcetak.Print Tab(18); Data1.Recordset.Fields("Nama_Obat"); frmcetak.Print Tab(34); Data1.Recordset.Fields("Stok"); frmcetak.Print Tab(44); Data1.Recordset.Fields("Sisa_stok"); frmcetak.Print Tab(56); Format(Data1.Recordset.Fields("Harga_Satuan"), "###,###") mbaris = mbaris + 1 Data1.Recordset.MoveNext Loop mtotal = mtotal + msubtotal frmcetak.Print Tab(1); mgrs Loop Command2.Caption = "Laporan Data Obat" Unload Me End If End Sub Private Sub Command3_Click() On Error GoTo salah x = Text1.Text Y = Text2.Text
If Command3.Caption = "Laporan Pembayaran" Then Data1.RecordSource = "select * from bayar where Tgl between " & "#" & "" & x & "" & "#" & " And " & "#" & "" & Y & "" & "#" & "" Data1.Refresh D.Caption = "DATA PEMBAYARAN" Label5.Caption = "DATA PEMBAYARAN DARI TANGGAL " & x & " SAMPAI TANGGAL " & Y & "" Command3.Caption = "Cetak" t=0 Do t = t + Val(Data1.Recordset.Fields("total").Value) Data1.Recordset.MoveNext Loop Until Data1.Recordset.EOF Label2.Caption = Format(t, "#,###,###") ElseIf Command3.Caption = "Cetak" Then MsgBox "Cetak" frmcetak.Show Data1.RecordSource = "Bayar" Data1.Refresh Data1.Recordset.MoveFirst frmcetak.Font = "Courier New" frmcetak.FontSize = 10 mno = 0 mhal = 0 mbaris = 0 Do While Not Data1.Recordset.EOF mhal = mhal + 1 frmcetak.Print frmcetak.Print Tab(2); "LAPORAN DATA PEMBAYARAN" frmcetak.Print Tab(2); "PAMULAMG PERMAI II C29 NO 17 TELP 7493743" frmcetak.Print Tab(2); "TANGERANG BANTEN" frmcetak.Print frmcetak.Print Tab(42); "LAPORAN DATA PEMBAYARAN" frmcetak.Print Tab(28); "DATA PEMBAYARAN DARI TANGGAL " & x & " SAMPAI TANGGAL " & Y & "" frmcetak.Print Tab(105); "Hal : "; Format(mhal, "###") mgrs = String$(114, "=") frmcetak.Print Tab(1); mgrs frmcetak.Print Tab(2); "No"; frmcetak.Print Tab(5); "No Kwitansi"; frmcetak.Print Tab(18); "No Pendaftaran"; frmcetak.Print Tab(35); "No Pasien"; frmcetak.Print Tab(45); "Tgl Bayar"; frmcetak.Print Tab(56); "Biaya Obat"; frmcetak.Print Tab(67); "Biaya Periksa"; frmcetak.Print Tab(83); "Total" frmcetak.Print Tab(1); mgrs msubtotal = 0 mbaris = 0 Do While Not Data1.Recordset.EOF And mbaris <= 55 mno = mno + 1 frmcetak.Print Tab(2); Format(mno, "###"); frmcetak.Print Tab(6); Data1.Recordset.Fields("No_Kwitansi"); frmcetak.Print Tab(19); Data1.Recordset.Fields("No_Pendaftaran"); frmcetak.Print Tab(36); Data1.Recordset.Fields("No_Pasien"); frmcetak.Print Tab(46); Data1.Recordset.Fields("Tgl"); frmcetak.Print Tab(57); Format(Data1.Recordset.Fields("Biaya_Obat"), "##,###,###"); frmcetak.Print Tab(69); Format(Data1.Recordset.Fields("Biaya_Pemeriksaan"), "##,###,###");
frmcetak.Print Tab(84); Format(Data1.Recordset.Fields("Total"), "###,####,###") mbaris = mbaris + 1 Data1.Recordset.MoveNext Loop mtotal = mtotal + msubtotal frmcetak.Print Tab(1); mgrs frmcetak.Print Tab(2); "JUMLAH TOTAL" frmcetak.Print Tab(85); "" & Format(Label2.Caption, "###,####,###") Loop Command3.Caption = "Laporan Pembayaran" Unload Me End If Exit Sub salah: Select Case Err.Number Case 3075: MsgBox "Isi Tanggal Dulu", vbInformation, "Pesan" Text1.SetFocus End Select End Sub Private Sub Command4_Click() frmmenu.Show Unload Me End Sub Private Sub Form_Load() Data1.DatabaseName = App.Path & "\diana1.mdb" Data1.RecordSource = "" End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Text2.SetFocus End If End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Command1.SetFocus End If End Sub
FORM CETAK Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Unload Me frmmenu.Show End If End Sub
Form Menu Utama
Input Data Pasien
Input Data Obat
Input Data Berobat
Input Data Pembayaran
Output Data Obat
Output Pasien Berobat
Output Data Pembayaran
Kartu Berobat
Kwitansi Pembayaran
BALAI PENGOBATAN PAMULANG PERMAI II BLOK C29 No.17 Telp. 7493743
FORMULIR No_Pasien
:
Nama
:
Umur
:
Jenis_Kelamin
:
Golongan Darah
:
Alamat
:
BALAI PENGOBATAN PAMULANG PERMAI II BLOK C 29 No. 17 Telp. 7493743 KARTU STATUS No. Pasien
:
Nama
:
Umur
:
Jenis Kelamin
:
Alamat
:
Tanggal Berobat
Keluhan
Diagnosa
