Listing Apotik

Diposting oleh endah-chieky.blogspot.com komentar (0)
Tadi kita sudah membuat form-form'a sekarang kita akan membuat listing'a

Private Sub bersih()
txtid.Text = ""
txtnm.Text = ""
txttlp.Text = ""
txtalmt.Text = ""
End Sub

Private Sub nonaktif()
txtid.Enabled = False
txtnm.Enabled = False
txttlp.Enabled = False
txtalmt.Enabled = False
End Sub

Private Sub aktif()
txtid.Enabled = True
txtnm.Enabled = True
txttlp.Enabled = True
txtalmt.Enabled = True
End Sub

Private Sub tampil()
On Error Resume Next
txtid.Text = Data1.Recordset!id_apoteker
txtnm.Text = Data1.Recordset!nm_apoteker
txtalmt.Text = Data1.Recordset!alamat
txttlp.Text = Data1.Recordset!phone
End Sub

Private Sub nomor()
Dim ltanggal As String
Dim urutan As String * 9
Dim hitung As Byte
ltanggal = Format(Date, "ddmmyy")

With Data2
.DatabaseName = "C:\folder endah\simulasi ukk\rs.mdb"
.RecordsetType = 2
.RecordSource = "select id_nota from pembayaran where left(id_nota,6)='" & ltanggal & "'"
.Refresh
If .Recordset.RecordCount = 0 Then
urutan = ltanggal & "001"
Else
.Recordset.MoveLast
hitung = Val(Right(.Recordset!id_nota, 3)) + 1
urutan = ltanggal & Right("000" & hitung, 3)
End If
txtidnota.Text = urutan
End With
End Sub

Private Sub total_harga()
On Error Resume Next
DBGrid1.Col = 4
total = 0
sementara.Recordset.MoveFirst
Do While Not sementara.Recordset.EOF
sementara.Recordset!jmlhbyr = DBGrid1.SelText
total = total + DBGrid1.SelText
sementara.Recordset.MoveNext
Loop
txttot.Text = total
On Error GoTo 0
End Sub

Private Sub form_activate()
Call nonaktif
Call bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = False
End Sub

Private Sub DBCombo1_Click(Area As Integer)
If Len(Trim(DBCombo1.Text)) > 5 Then
Exit Sub
End If
'CARI KODE APOTEKER
cost.Recordset.Index = "id_cos"
cost.Recordset.Seek "=", DBCombo1.Text
If cost.Recordset.NoMatch Then
MsgBox "ID Costomer Tidak Ada", vbOKOnly, "..::Konfirmasi::.."
Text4.Text = ""
DBCombo1.SetFocus
Exit Sub
End If
Text4.Text = cost.Recordset!nama_cos
DBCombo2.SetFocus
End Sub


Private Sub cmdadd_Click()
Call nomor
Call aktif
txtid.Enabled = False
txtnm.SetFocus
cmdadd.Enabled = False
cmdedit.Enabled = False
cmdsave.Enabled = True
cmdcancel.Enabled = True
End Sub


Private Sub cmdcancel_Click()
Call bersih
Call nonaktif
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdadd.Enabled = True
cmdedit.Enabled = True
End Sub


Private Sub cmddelete_Click()
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", UCase(txtid.Text)
If Not Data1.Recordset.NoMatch Then
Data1.Recordset.Delete
Call nonaktif
Call bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdadd.Enabled = True
cmdedit.Enabled = True
End If
End Sub

Private Sub cmdedit_Click()
Dim x As String
x = InputBox("Masukkan ID Apoteker Yang Akan Anda Edit", "EDIT")
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", UCase(x)
If Not Data1.Recordset.NoMatch Then
Call tampil
Call aktif
txtid.Enabled = False
cmdsave.Enabled = True
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdadd.Enabled = False
cmdedit.Enabled = False
txtnm.SetFocus
Else
MsgBox "ID Apoteker Tidak Ada", vbOKOnly, "EDIT"
Call bersih
Call nonaktif
End If
End Sub


Private Sub cmdcari_Click()
Dim x As String
x = InputBox("Masukkan ID Apoteker Yang Anda Cari", "SEARCH")
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", UCase(x)
If Not Data1.Recordset.NoMatch Then
Call tampil
Call nonaktif
Else
MsgBox "ID Apoteker Tidak Ada", vbOKOnly, "SEARCH"
Call bersih
Call nonaktif
End If
cmdcancel.Enabled = True
End Sub


Private Sub cmdsave_Click()
If txtnm.Text = "" Or txttlp.Text = "" Or txtalmt.Text = "" Then
MsgBox "Data Masih Ada Yang Kosong", vbOKOnly, "Data Belum Lengkap"
Else
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", txtid.Text
If Not Data1.Recordset.NoMatch Then
Data1.Recordset.Edit
Data1.Recordset!id_apoteker = txtid.Text
Data1.Recordset!nm_apoteker = txtnm.Text
Data1.Recordset!alamat = txtalmt.Text
Data1.Recordset!phone = txttlp.Text
Data1.Recordset.Update
Else
Data1.Recordset.AddNew
Data1.Recordset!id_apoteker = txtid.Text
Data1.Recordset!nm_apoteker = txtnm.Text
Data1.Recordset!alamat = txtalmt.Text
Data1.Recordset!phone = txttlp.Text
Data1.Recordset.Update
End If
Call nonaktif
Call bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = True
cmdadd.Enabled = True
End If
End Sub


Private Sub Cmdshow_Click()
Frame1.Visible = True
Frame2.Visible = True
cmdadd.Visible = True
cmdedit.Visible = True
cmdsave.Visible = True
cmddelete.Visible = True
cmdcari.Visible = True
cmdexit.Visible = True
cmdcancel.Visible = True
Command1.Visible = False
End Sub

ni listing yang combo'a da 2

Private Sub Combo1_Click()
Text1.Text = Mid(Combo1.Text, 7, 100)
Text2.Text = Left(Combo1.Text, 5)
End Sub

bis di tulis listing nie masukin juga listing di form load

Private Sub form_activate()
Data2.Recordset.MoveFirst
Do While Not Data2.Recordset.EOF
Combo1.AddItem Data2.Recordset!id_jenis & " " & Data2.Recordset!jns_obat
Data2.Recordset.MoveNext
Loop
Call nonaktif
Call bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = False
End Sub

nie listing u untuk harga + laba otomatis

Private Sub txtharga_Change()
If txtharga.Text = "" Or Val(txtharga.Text) <>
Exit Sub
Else
Dim x As String
x = Val(txtharga.Text) / Val(txtisi.Text) * 20 / 100
txthrgsat.Text = x
End If
End Sub


nie listing wat form login

Private Sub Form_Load()
teks = Me.Caption
End Sub

Private Sub form_activate()
txtUserName.MaxLength = 5
End Sub

Private Sub cmdcancel_Click()
End
End Sub

Private Sub cmdOK_Click()
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", txtPassword.Text
If Data1.Recordset.NoMatch Then
MsgBox "Invalid ID Apoteker?", vbOKOnly, "Informasi"
txtUserName.SetFocus
ElseIf Data1.Recordset!id_apoteker <> txtPassword.Text Then
MsgBox "Invalid Password?", vbOKOnly, "Informasi"
txtPassword.SetFocus
Else
MDIForm1.Show
kode = txtUserName.Text
Unload Me
Me.Hide
End If
End Sub

nie wat listing form pembayaran + resep

Private Sub DBGrid1_DblClick()
If sementara.Recordset.RecordCount = 0 Then
MsgBox "Tidak Ada yang Bisa Dihapus Lagi!", vbOKOnly + vbCritical, "Konfirmasi"
Exit Sub
End If
x = MsgBox("Yakin Data Mau Dihapus", vbYesNo + 32, "Konfirmasi")
If x = vbYes Then
On Error Resume Next
obat.Recordset.Index = "id_obat"
obat.Recordset.Seek "=", sementara.Recordset!kode_obat
If Not obat.Recordset.NoMatch Then
obat.Recordset.Edit
obat.Recordset!jumlah = va(obat.Recordset!jumlah) + Val(sementara.Recordset!qty)
obat.Recordset.Update
obat.Refresh
End If
If sementara.Recordset.RecordCount > 0 Then
sementara.Recordset.Delete
End If
Call total_harga
Else
Exit Sub
End If
End Sub


Private Sub cmdadd_Click()
If txtqty = "" Then
MsgBox "Data Masih Ada yang Kosong Tuchh, Silakan di Isi dulu", vbInformation, "Iformation"
txtqty.SetFocus
Else
sementara.Recordset.AddNew
sementara.Recordset!kode_obat = DBCombo2.Text
sementara.Recordset!nama_obat = txtnm.Text
sementara.Recordset!hargasat = txthrg.Text
sementara.Recordset!qty = txtqty.Text
sementara.Recordset!jmlhbyr = txtjmlbyr.Text
sementara.Recordset.Update
Call total_harga
With obat.Recordset
.Edit
!jumlah = Val(!jumlah) - Val(txtqty.Text)
.Update
End With
DBCombo2.Text = "Obat"
txtnm.Text = ""
txthrg.Text = ""
txtqty.Text = ""
txtjmlbyr.Text = ""
DBCombo2.SetFocus
End If
End sub


Private Sub cmdcancel_Click()
If sementara.Recordset.RecordCount = 0 Then
MsgBox "Tidak ada yang bisa dihapus lagi!", vbOKOnly + vbCritical, "Konfirmasi"
Exit Sub
End If
x = InputBox("Masukkan ID Obat yang Akan Dibatalkan", "Konfirmasi")
On Error Resume Next
sementara.Recordset.Index = "kode_obat"
sementara.Recordset.Seek "=", UCase(x)
If Not sementara.Recordset.NoMatch Then
sementara.Recordset.Delete
End If
Call total_harga
End Sub


Private Sub cmdsave_Click()
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim e As String
Dim f As String
Dim g As String
Load printer
printer.Show
printer.FontName = "arial"
printer.CurrentX = 0
printer.CurrentY = 0
printer.FontSize = 12
printer.FontBold = False
printer.Print
printer.Print Tab(3); "Apotek Segera Sembuh"
printer.Print Tab(3); "Jl. Kompleks PLN P3B"
printer.Print
printer.FontSize = 8
printer.FontUnderline = False
printer.Print Tab(3); "Struk Obat"
printer.Print
printer.FontSize = 8
printer.FontUnderline = False
printer.Print Tab(3); "No. nota :"; Tab(35); txtidnota.Text
printer.Print Tab(3); "Tanggal :"; Tab(35); txttgl.Text
printer.Print Tab(3); "ID Apoteker :"; Tab(35); Text3.Text
printer.Print
printer.FontBold = False
printer.Print String(80, "=")
printer.FontBold = False
printer.Print Tab(3); "Kode Obat"; Tab(15); "Nama Obat"; Tab(27); "Jumlah"; Tab(39); "Harga"; Tab(51); "Bayar";
printer.FontBold = False
With sementara.Recordset
.MoveFirst
n = 1
While Not .EOF
a = sementara.Recordset!kode_obat
e = sementara.Recordset!nama_obat
f = sementara.Recordset!qty
g = sementara.Recordset!hargasat
h = sementara.Recordset!jmlhbyr
i = sementara.Recordset!jmlhbyr + i
If Not sementara.Recordset!kode_obat = Space(15) Then
nota.Recordset.AddNew
nota.Recordset!id_nota = txtidnota.Text
nota.Recordset!tgl_nota = txttgl.Text
nota.Recordset!jml_beli = sementara.Recordset!qty
nota.Recordset!harga = sementara.Recordset!hargasat
nota.Recordset!total_bayar = txttot.Text
nota.Recordset!id_cost = DBCombo1.Text
nota.Recordset!id_apteker = Text3.Text
nota.Recordset!id_obt = DBCombo2.Text
nota.Recordset.Update

End If
printer.Print Tab(3); Format(a, "###"); Tab(15); Format(e, "###"); Tab(27); Format(f, "###"); Tab(39); Format(g, "###"); Tab(51); Format(h, "###");
.MoveNext
n = n + 1
Wend
End With
printer.FontBold = False
printer.Print Tab(1); String(80, "=")
printer.FontBold = False
printer.Print Tab(51); "Total bayar:"; Tab(65); Format(i, "###,###,###")
printer.Print Tab(51); "Uang Bayar:"; Tab(65); Format(txtbyr.Text, "###,###,###")
b = Val(txtbyr.Text) - i
If b = 0 Then
b = "0"
End If
printer.Print Tab(51); "Uang Kembali:"; Tab(65); Format(b, "###,###,###")
printer.Print Tab(1); String(80, "=")
printer.Print Tab(3); "Terima kasih"
'printer.EndDoc
Z = MsgBox("Cetak Print?", vbYesNo, "Informasi")
If Z = vbYes Then
End If
If sementara.Recordset.RecordCount > 0 Then
sementara.Recordset.MoveFirst
Do While Not sementara.Recordset.EOF
sementara.Recordset.Delete
sementara.Recordset.MoveNext
Loop
End If
Call bersih
End Sub



Private Sub form_activate()
DBCombo2.SetFocus
Call Timer1_Timer
Call nomor
txtidnota.Enabled = False
txttgl.Enabled = False
Text3.Enabled = False
Text3.Text = apoteker.Recordset!id_apoteker
txttot.Text = ""
txtbyr.Text = ""
txtkmbl.Text = ""
End Sub
Private Sub Timer1_Timer()
txttgl.Text = Date
txtjam.Text = Time
End Sub

Private Sub txtbyr_Change()
txtkmbl.Text = Val(txtbyr.Text) - Val(txttot.Text)
End Sub

Private Sub txtqty_Change()
If Val(obat.Recordset!jumlah) = 0 Then
MsgBox "Maaf Stok Obat Kosong", vbInformation, "Informasi"
Exit Sub
End If
If Val(txtqty.Text) > Val(obat.Recordset!jumlah) Then
MsgBox "Maaf Stok Obat Tidak Mencukupi", vbInformation, "Informasi"
txtqty.Text = ""
Exit Sub
End If
txtjmlbyr.Text = Val(txtqty.Text) * Val(txthrg.Text)
End Sub

Private Sub txtqty_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then KeyAscii = 0
End Sub


 

Apotik

Diposting oleh endah-chieky.blogspot.com komentar (0)

nie form STRUK RESEP


nie form STRUK PEMBAYARAN


nie form RESEP


nie form PEMBAYARAN


nie form OBAT


nie form JENIS OBAT



nie form LOGIN


nie form MDI



ckarang kita akan membuat form apotik
yang di atas tuh form-form yang kita butuhkan

 

Listing Rekam Medis

Diposting oleh endah-chieky.blogspot.com komentar (1)

nah ckarang kita akan membuat listing form rekam medis oce.....

yang di atas tuh form'a...
jelas kan...

yang ini listing-listing'a

nie listing bersih
Private Sub aktif()
txtnmrrkm.Enabled = True
txttgl.Enabled = True
txtjam.Enabled = True
DBCombo2.Enabled = True
txtnmdkt.Enabled = True
DBCombo1.Enabled = True
txtnmpsn.Enabled = True
txtdiag.Enabled = True
txtket.Enabled = True
txtkdksr.Enabled = True
DBCombo3.Enabled = True
txtnmobt.Enabled = True
txtjns.Enabled = True
txtjml.Enabled = True
DBGrid1.Enabled = True
End Sub

nie listing wat nonaktif
Private Sub nonaktif()
txtnmrrkm.Enabled = False
txttgl.Enabled = False
txtjam.Enabled = False
DBCombo2.Enabled = False
txtnmdkt.Enabled = False
DBCombo1.Enabled = False
txtnmpsn.Enabled = False
txtdiag.Enabled = False
txtket.Enabled = False
txtkdksr.Enabled = False
DBCombo3.Enabled = False
txtnmobt.Enabled = False
txtjns.Enabled = False
txtjml.Enabled = False
DBGrid1.Enabled = False
End Sub

nie listing wat bersih
Private Sub bersih()
txtnmrrkm.Text = ""
txttgl.Text = ""
txtjam.Text = ""
DBCombo2.Text = ""
txtnmdkt.Text = ""
DBCombo1.Text = ""
txtnmpsn.Text = ""
txtdiag.Text = ""
txtket.Text = ""
txtkdksr.Text = ""
DBCombo3.Text = ""
txtnmobt.Text = ""
txtjns.Text = ""
txtjml.Text = ""
DBGrid1.Text = ""
End Sub

nie listing wat bikin no otomatis
Private Sub nomor()
Dim no As String
With Data4
If .Recordset.RecordCount <> 0 Then
.Recordset.MoveLast
no = Val(Right(.Recordset!nomorrkm, 4)) + 1
If Len(Trim(no)) = 1 Then
txtnmrrkm.Text = "R" + "000" + no
End If
If Len(Trim(no)) = 2 Then
txtnmrrkm.Text = "R" + "00" + no
End If
If Len(Trim(no)) = 3 Then
txtnmrrkm.Text = "R" + "0" + no
End If
If Len(Trim(no)) = 4 Then
txtnmrrkm.Text = "R" + no
End If
Else
txtnmrrkm.Text = "R0001"
End If
End With
End Sub

nie listing wat button add
Private Sub Command1_Click()
If txtjml = "" Then
MsgBox "Data Masih Ada yang Kosong Tuchh, Silakan di Isi dulu", vbInformation, "Iformation"
txtjml.SetFocus
Else
Data7.Recordset.AddNew
Data7.Recordset!kdobt = DBCombo3.Text
Data7.Recordset!nmobt = txtnmobt.Text
Data7.Recordset!jnsobt = txtjns.Text
Data7.Recordset!jumlah = txtjml.Text
Data7.Recordset.Update
With Data2.Recordset
.Edit
!jumlahstok = Val(!jumlahstok) - Val(txtjml.Text)
.Update
End With
DBCombo3.Text = "obat"
txtnmobt.Text = ""
txtjns.Text = ""
txtjml.Text = ""
DBCombo3.SetFocus
End If
End Sub

nie listing wat button save
Private Sub Command2_Click()
Call nomor
On Error Resume Next
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim e As String
Dim f As String
Dim g As String
Load printer1
printer1.Show
printer1.FontName = "arial"
printer1.CurrentX = 0
printer1.CurrentY = 0
printer1.FontSize = 11
printer1.FontBold = False
printer1.Print
printer1.Print Tab(15); "Apotek Segera Sembuh"
printer1.Print Tab(15); "Jl. Kompleks PLN P3B"
printer1.Print
printer1.FontSize = 8
printer1.FontUnderline = False
printer1.Print Tab(15); "Resep Obat"
printer1.Print
printer1.FontSize = 8
printer1.FontUnderline = False
printer1.Print Tab(3); "Nomor Rekam :"; Tab(35); txtnmrrkm.Text
printer1.Print Tab(3); "Tanggal :"; Tab(35); txttgl.Text
printer1.Print
printer1.FontBold = False
printer1.Print String(40, "=")
printer1.FontBold = False
printer1.Print Tab(3); "Kode obat"; Tab(17); "Nama obat"; Tab(33); "Jumlah";
printer1.FontBold = False
With Data7.Recordset
.MoveFirst
n = 1
While Not .EOF
a = Data7.Recordset!kdobt
e = Data7.Recordset!nmobt
f = Data7.Recordset!jumlah
'g = DtSementara.Recordset!diagnosis
If Not Data7.Recordset!kdobt = Space(17) Then
Data4.Recordset.AddNew
Data4.Recordset!nomorrkm = txtnmrrkm.Text
Data4.Recordset!tglperiksa = txttgl.Text
Data4.Recordset!kodepsn = DBCombo2.Text
Data4.Recordset!kodedkt = DBCombo1.Text
Data4.Recordset!diagnosa = txtdiag.Text
Data4.Recordset!keterangan = txtket.Text
Data4.Recordset!kdksr = txtkdksr.Text
Data4.Recordset.Update

End If
If Not Data7.Recordset!kdobt = Space(17) Then
Data6.Recordset.AddNew
Data6.Recordset!nmrrkm = txtnmrrkm.Text
Data6.Recordset!kodeobat = Data7.Recordset!kdobt
Data6.Recordset!dosis = Data7.Recordset!jumlah
Data6.Recordset.Update

End If
printer1.Print Tab(3); Format(a, "###"); Tab(17); Format(e, "###"); Tab(33); Format(f, "###");
.MoveNext
Wend
End With
printer1.Print Tab(1); String(40, "=")
printer1.Print Tab(15); "Terima kasih"
z = MsgBox("Cetak Print?", vbYesNo, "Informasi")
If z = vbYes Then
'Call cetakprint
End If
If Data7.Recordset.RecordCount > 0 Then
Data7.Recordset.MoveFirst
Do While Not Data7.Recordset.EOF
Data7.Recordset.Delete
Data7.Recordset.MoveNext
Loop
End If
Call bersih
End Sub

nie listing wat button batal
Private Sub Command4_Click()
Dim x As String
x = InputBox("Masukkan kode obat yang akan dibatalkan", "Konfirmasi")
Data7.Recordset.Index = "kdobt"
Data7.Recordset.Seek "=", UCase(x)
If Not Data7.Recordset.NoMatch Then
Data7.Recordset.Delete
MsgBox "obat telah dibatalkan", vbInformation, "informasi"
'Else
'MsgBox "Maaf", vbInformation, "info"
End If
Form5.Refresh
End Sub

nie listing wat dbcombo
Private Sub DBCombo1_Click(Area As Integer)
If Len(Trim(DBCombo1.Text)) > 5 Then
Exit Sub
End If
'CARI KODE DOKTER
Data3.Recordset.Index = "kodedkt"
Data3.Recordset.Seek "=", DBCombo1.Text
If Data3.Recordset.NoMatch Then
MsgBox "Kode Dokter Tidak Ada", vbOKOnly, "..::Konfirmasi::.."
txtnmdkt.Text = ""
DBCombo1.SetFocus
Exit Sub
End If
txtnmdkt.Text = Data3.Recordset!namadkt
DBCombo2.SetFocus
End Sub

Private Sub DBCombo2_Click(Area As Integer)
If Len(Trim(DBCombo2.Text)) > 5 Then
Exit Sub
End If
'CARI KODE PASIEN
Data1.Recordset.Index = "kodepsn"
Data1.Recordset.Seek "=", DBCombo2.Text
If Data1.Recordset.NoMatch Then
MsgBox "Kode Pasien Tidak Ada", vbOKOnly, "..::Konfirmasi::.."
txtnmpsn.Text = ""
DBCombo2.SetFocus
Exit Sub
End If
txtnmpsn.Text = Data1.Recordset!namapsn
txtdiag.SetFocus
End Sub

Private Sub DBCombo3_Click(Area As Integer)
If Len(Trim(DBCombo3.Text)) > 5 Then
Exit Sub
End If
'CARI KODE OBAT
Data2.Recordset.Index = "kodeobt"
Data2.Recordset.Seek "=", DBCombo3.Text
If Data2.Recordset.NoMatch Then
MsgBox "Kode Obat Tidak Ada", vbOKOnly, "..::Konfirmasi::.."
txtnmobt.Text = ""
txtjns.Text = ""
DBCombo3.SetFocus
Exit Sub
End If
txtnmobt.Text = Data2.Recordset!NamaObt
txtjns.Text = Data2.Recordset!jenisobt
txtjml.SetFocus
End Sub

nie wat listing cetak
Private Sub Cetak()
tampilkan.Show
Dim MGrs As String
tampilkan.Font = "Courier New"
'memilih nomor terakhir di tabel resep
'Data6.RecordSource = "select * from resep Where left(nomorrkm,5) In(Select max(left(nomorrkm,5)) From resep)"
'Data6.Refresh
'memilih nomor terakhir di tabel rekam medis
'Data4.RecordSource = "select * from rekammedis Where nomorrkm In(Select Max(nomorrkm)From rekammedis)Order By nomorrkm Desc" ', Nomor Asc"
'Data4.Refresh
'mencari kode pasien di tabel rekam medis
Data1.Recordset.Index = "kodepsn"
Data1.Recordset.Seek "=", Data4.Recordset!kodepsn
'mencari kode dokter di tabel rekam medis
Data3.Recordset.Index = "kodedkt"
Data3.Recordset.Seek "=", Data4.Recordset!kodedkt
tampilkan.Print
tampilkan.FontBold = True
tampilkan.Print
tampilkan.FontBold = False
tampilkan.Print Tab(5); "Nomor Rekam : "; Data4.Recordset!nomorrkm
tampilkan.Print Tab(5); "Tanggal : "; Format(Date, "DD-MMMM-YYYY")
tampilkan.Print Tab(5); "Dokter : "; Data3.Recordset!namadkt
tampilkan.Print Tab(5); "Pasien : "; Data1.Recordset!namapsn
MGrs = String$(33, "-")
tampilkan.Print Tab(5); MGrs
'menampilkan obat dari tabel resep
Data6.Recordset.MoveFirst
On Error Resume Next
Do While Not Data6.Recordset.EOF
Data2.Recordset.Index = "kodeobt"
Data2.Recordset.Seek "=", Data6.Recordset!kodeobat
tampilkan.Print Tab(5); Mid(Data6.Recordset!nmrrkm, 6, 2);
tampilkan.Print Tab(10); Data2.Recordset!NamaObt;
tampilkan.Print Tab(30); Data6.Recordset!dosis;
Data6.Recordset.MoveNext
Data6.Refresh
Loop
tampilkan.Print Tab(5); MGrs
tampilkan.Print
tampilkan.Print
End Sub

nie listing pendukung laen'a
Private Sub form_activate()
Call Timer1_Timer
Call nomor
Data12.Recordset.Index = "kodeksr"
Data12.Recordset.Seek "=", kode
If Not Data12.Recordset.NoMatch Then
txtkdksr.Text = Data12.Recordset!namaksr
txtdiag.Text = ""
txtket.Text = ""
End If
End Sub
Private Sub Timer1_Timer()
txttgl.Text = Date
txtjam.Text = Time
End Sub

Private Sub txtjml_Change()
If Val(Data2.Recordset!jumlahstok) = 0 Then
MsgBox "Maaf Stok Kosong", vbInformation, "Informasi"
Exit Sub
If Val(txtjml.Text) > Val(Data2.Recordset!jumlahstok) Then
MsgBox "Maaf Stok Barang Tidak Mencukupi", vbInformation, "Informasi"
txtjml.Text = ""
Exit Sub
End If
End If
End Sub

Private Sub txtjml_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then KeyAscii = 0
End Sub