Listing Rekam Medis

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