Kode Pencarian (Arsip)

Dim AdoDB As Workspace
Dim AdoRm As Database
Dim AdoNo As Recordset
Dim AdoUnit As Recordset

Sub conectDB()
On Error GoTo KelProg
Set AdoDB = DBEngine.Workspaces(0)
Set AdoRm = AdoDB.OpenDatabase(App.Path & "\Rekam MEDIS.MDB")
Set AdoUnit = AdoRm.OpenRecordset("Unit")

KelProg:
If Err.Number = 3024 Then
MsgBox "File Rekam Medis tdk ada,.....!!", vbInformation, "EDP INF"
End
End If
End Sub

Private Sub CmdEdit_Click()
FRUBAH.cUnit.Text = Form1.cUnit.Text
FRUBAH.Caccess.Text = Form1.Caccess.Text
FRUBAH.Cuser.Text = Form1.Cuser.Text
Unload Me
FRUBAH.Show
End Sub

Private Sub CmdExit_Click()
End
End Sub

Private Sub CmdInput_Click()
fEdit.cUnit.Text = Form1.cUnit.Text
fEdit.Caccess.Text = Form1.Caccess.Text
fEdit.Cuser.Text = Form1.Cuser.Text
RunApp
fEdit.Show
Unload Me
End Sub

Private Sub Command1_Click()
On Error GoTo salahFrt
DtGrid.Clear
DtGrid.Rows = 1
GetDt
TxTData.SetFocus
DtGrid.Col = 2
DtGrid.Sort = 1

salahFrt:
If Err.Number = 3075 Then
MsgBox "Format Tanggal DD/MM/YYYY"
End If
End Sub

Private Sub DtGrid_DblClick()
FRUBAH.cUnit.Text = Form1.cUnit.Text
FRUBAH.Show
DtGrid.Col = 1
FRUBAH.nNoRM.Text = DtGrid.Text
End Sub

Private Sub Form_Load()
DtGrid.ColWidth(0) = 300
DtGrid.ColWidth(1) = 750
DtGrid.ColWidth(2) = 2500
DtGrid.ColWidth(3) = 6000
DtGrid.ColWidth(4) = 500
DtGrid.ColWidth(5) = 1000
Label1.Caption = "0"
End Sub

Private Sub Option1_Click()
TxTData.SetFocus
End Sub

Private Sub Option2_Click()
TxTData.SetFocus
End Sub

Private Sub Option3_Click()
TxTData.SetFocus
End Sub

Private Sub Option4_Click()
TxTData.SetFocus
End Sub

Private Sub Timer1_Timer()
Label4.Caption = Now
End Sub

Private Sub TxTData_GotFocus()
Select Case Form1.Caccess
Case Is = "I"
Form1.CmdInput.Enabled = True
Case Is = "E"
Form1.CmdEdit.Enabled = True
Case Is = "S"
Form1.CmdInput.Enabled = True
Form1.CmdEdit.Enabled = True
End Select
Command1.Default = True
End Sub

Sub cariRM()
Dim DtCari As String
Dim Dt As String
Dim dtTgl As String
DtCari = TxTData.Text
dtTgl = Format(TxTData.Text, "mm/dd/yyyy")
conectDB

If Option1.Value = True Then
Dt = "'" & DtCari & "*'"
Set AdoNo = AdoRm.OpenRecordset("Select * from [Rekam Medis] where [Nama Pasien] like" & Dt)
ElseIf Option2.Value = True Then
Dt = "'*" & DtCari & "*'"
Set AdoNo = AdoRm.OpenRecordset("Select * from [Rekam Medis] where [Nama Pasien] like" & Dt)
ElseIf Option3.Value = True Then
Dt = "#" & dtTgl & "#"
Set AdoNo = AdoRm.OpenRecordset("Select * from [Rekam Medis] where [Tanggal Lahir] like" & Dt)
ElseIf Option4.Value = True Then
Dt = "'*" & DtCari & "*'"
Set AdoNo = AdoRm.OpenRecordset("Select * from [Rekam Medis] where [Alamat] like" & Dt)
End If
End Sub

Sub GetDt()
Judul
Dim Cnt As Long
baris = 0
cariRM

Bar1.Visible = True
Bar1.Min = 1
Bar1.Value = 1

If AdoNo.EOF Then
MsgBox "Data tidak ada", vbExclamation, "Golek maning son !..."
Else
Do While Not AdoNo.EOF
DtGrid.Rows = DtGrid.Rows + 1
baris = baris + 1
If AdoNo("Kode Unit") <> "" Then
DtGrid.TextMatrix(baris, 0) = AdoNo("Kode Unit")
End If
If AdoNo("No Rekam Medis") <> "" Then
DtGrid.TextMatrix(baris, 1) = Format(AdoNo("No Rekam Medis"), "000000")
End If
If AdoNo("Nama Pasien") <> "" Then
DtGrid.TextMatrix(baris, 2) = AdoNo("Nama Pasien")
End If
If AdoNo("Alamat") <> "" Then
DtGrid.TextMatrix(baris, 3) = AdoNo("Alamat")
End If
If AdoNo("Wilayah") <> "" Then
DtGrid.TextMatrix(baris, 4) = AdoNo("Wilayah")
End If
If AdoNo("Tanggal Lahir") <> "" Then
DtGrid.TextMatrix(baris, 5) = AdoNo("Tanggal Lahir")
End If
Bar1.Max = AdoNo.RecordCount + 1
Bar1.Value = baris
Label1.Caption = baris
AdoNo.MoveNext
'If baris = 100 Then
'Bar1.Visible = False
'MsgBox "Masukan data Pencarian...!...", vbExclamation, "Silahkan"
'Exit Sub
'End If
Loop
End If
Bar1.Visible = False
End Sub

Sub Judul()
Dim Judul
Judul = Array("KD", "No RM", "Nama Pasien", "Alamat", "Wil", "Tgl Lahir")
For i = 0 To UBound(Judul)
DtGrid.TextMatrix(0, i) = Judul(i)
Next i
End Sub

Sub RunApp()
conectDB
AdoUnit.Index = "Kd"
AdoUnit.Seek "=", cUnit.Text
If AdoUnit.NoMatch = False Then
fEdit.lblKD.Caption = AdoUnit!Kd
fEdit.lblUnit.Caption = AdoUnit!Unit
End If
AdoUnit.Close
End Sub