LISTING PROGRAM For X = 0 To UBound(MenuStr1)

Me.ImgCheck(X).Visible = False
1. Menu Utama If MenuStr1(X) = "Master User" Then
Me.lblMenu(X).Enabled = False
Public Awal As Byte Me.ImgCheck(X).Visible = False
Private X1 As Integer, Y1 As Integer ElseIf MenuStr1(X) <> "Simpan" And
Private X11 As Integer, Y11 As Integer MenuStr1(X) <> "Batal" Then
Private BrsAktif As Integer Me.lblMenu(X).Enabled = True
Private Shadow As clsShadow Me.ImgCheck(X).Visible = chkMenu(Awal + X)
Private Sub Form_Deactivate() End If
For X = 0 To UBound(MenuStr1) If LenMax < TextWidth(MenuStr1(X)) + 350 Then
Me.Image1(X).Visible = False LenMax = TextWidth(MenuStr1(X)) + 350
Next End If
End Sub If InStr(MenuStr1(X), "~") > 0 Then
Me.lblMenu(X).Caption = Mid(MenuStr1(X), 2)
Private Sub Form_KeyDown(KeyCode As Integer, Shift Me.lblMenu(X).Enabled = False
As Integer) Else
Dim Button As Integer Me.lblMenu(X).Caption = MenuStr1(X)
Select Case KeyCode End If
Case 37 Me.lblMenu(X).Top = Me.Image1(X).Top + 100
SendKeys "{LEFT}" Me.lblMenu(X).Left = Me.Image1(X).Left + 200
Me.Hide Me.lblMenu(X).ZOrder
Case 39 Me.Image1(X).Visible = False
SendKeys "{RIGHT}" Next
Me.Hide Me.Width = LenMax
Case 38 Me.Height = Me.Image1(0).Height *
If lblMenu(BrsAktif - 1).Caption = "Master (UBound(MenuStr1) + 1) + 150
User" Then For X = 0 To UBound(MenuStr1)
BrsAktif = UBound(MenuStr1) Me.Image1(X).Width = Me.Width - 140
Else Next
BrsAktif = BrsAktif - 1 Me.lblMenu(9).Enabled = True
If BrsAktif = -1 Then Me.lblMenu(10).Enabled = True
BrsAktif = UBound(MenuStr1) For X = 0 To UBound(MenuStr)
End If If lblMenu(X).Enabled = True Then Exit For
End If Next
lblMenu_MouseMove BrsAktif, Button, Shift, BrsAktif = X
lblMenu(BrsAktif).Left, _ ShowBar (X)
lblMenu(BrsAktif).Top End Sub
Case 40 Private Sub Form_Activate()
BrsAktif = BrsAktif + 1 FormActivate
If BrsAktif = UBound(MenuStr1) + 1 Then End Sub
BrsAktif = 0 Private Sub ShowBar(Indeks)
If lblMenu(BrsAktif).Caption = "Master User" For X = 0 To UBound(MenuStr1)
Then Me.Image1(X).Visible = False
BrsAktif = 1 Next
End If Me.Image1(Indeks).Visible = True
End If End Sub
lblMenu_MouseMove BrsAktif, Button, Shift, Private Sub Form_Load()
lblMenu(BrsAktif).Left, _ Bayangan Shadow, Me
lblMenu(BrsAktif).Top
End Select Me.Visible = False
End Sub Transparent Me, 220
Private Sub Form_KeyPress(KeyAscii As Integer) Me.Visible = False
If KeyAscii = 27 Then End Sub
Me.Hide Private Sub Image1_Click(Index As Integer)
ElseIf KeyAscii = 13 Then If lblMenu(Index).Enabled = True Then
lblMenu_Click BrsAktif lblMenu_Click Index
End If End If
End Sub End Sub
Public Sub FormActivate() Private Sub Image1_MouseDown(Index As Integer,
Dim LenMax As Long Button As Integer, Shift As Integer, X As Single, Y As
LenMax = TextWidth(MenuStr1(0)) + 350 Single)
 If lblMenu(Index).Enabled = True Then Private Sub lblMenu_MouseDown(Index As Integer,
lblMenu_MouseDown Index, Button, Shift, X, Y Button As Integer, Shift As Integer, X As Single, Y As
End If Single)
End Sub X1 = Image1(Index).Left
Private Sub Image1_MouseUp(Index As Integer, Button Y1 = Image1(Index).Top
As Integer, Shift As Integer, X As Single, Y As Single) Image1(Index).Move X1 + 25, Y1 + 25
If lblMenu(Index).Enabled = True Then X11 = lblMenu(Index).Left
lblMenu_MouseUp Index, Button, Shift, X, Y Y11 = lblMenu(Index).Top
End If lblMenu(Index).Move X11 + 25, Y11 + 25
End Sub End Sub

Private Sub SimpanBatasanMenu() Private Sub lblMenu_MouseMove(Index As Integer,

SQLSave = "Update UserList set " Button As Integer, Shift As Integer, X As Single, Y As
For X = 1 To 52 Single)
SQLSave = SQLSave & "Menu" & X & "=" & ShowBar Index
IIf(chkMenu(X) = True, 1, 0) BrsAktif = Index
If X <> 52 Then SQLSave = SQLSave & ", " End Sub
Next

SQLSave = SQLSave & " Where NamaUser='" & Private Sub lblMenu_MouseUp(Index As Integer,
FrmMastUser1.UserName & "'" Button As Integer, Shift As Integer, X As Single, Y As
Single)
'MsgBox SQLSave Image1(Index).Move X1, Y1
lblMenu(Index).Move X11, Y11
ConRumahSakit.Execute (SQLSave) End Sub

If NamaUser = FrmMastUser1.UserName Then 2. form Register

Set rsBantu = Nothing
rsBantu.Open "Select * From UserList where Public NO_REGISTER As String
NamaUser='" & NamaUser & "'", _
ConRumahSakit, adOpenStatic, Private rsRegister As New ADODB.Recordset
adLockOptimistic Private rsRekamMedis1 As New ADODB.Recordset
For X = 1 To 52 Private rsBantu As New ADODB.Recordset
If rsBantu.Fields("Menu" & X) = 0 Or _
rsBantu.Fields("Menu" & X) = -1 Then Private Sub FirstShow()
MenuCek(X) = False Me.lblNoRegister.Enabled = False
Else Me.txtNoBPJS.Enabled = False
MenuCek(X) = True Me.cboCaraTerima.Enabled = False
End If Me.cboCaraMasuk.Enabled = False
Next Me.dtpTglMasuk.Enabled = False
MenuCek(0) = IIf(LevelUser = 0, True, False) Me.dtpTglKeluar.Enabled = False
End If Me.mebJamMasuk.Enabled = False
Me.mebJamKeluar.Enabled = False
Unload Me Me.lblLamaDirawat.Enabled = False
End Sub Me.txtPenanggungJawab.Enabled = False
Me.txtTelpHP_PnggJawab.Enabled = False
Me.dcboSpesialisasi.Enabled = False
Private Sub lblMenu_Click(Index As Integer) Me.lblNoRuangan.Enabled = False
If Me.lblMenu(Index) = "Simpan" Then Me.lblKelasRuangan.Enabled = False
SimpanBatasanMenu Me.lblNamaDokter.Enabled = False
FrmMenu1.tmrExit.Enabled = True Me.cboKeadaanKeluar.Enabled = False
ElseIf Me.lblMenu(Index) = "Batal" Then Me.cboCaraKeluar.Enabled = False
FrmMenu1.tmrExit.Enabled = True Me.txtDirujukKe.Enabled = False
Unload Me
Else Me.lblNoRM.Enabled = False
Me.ImgCheck(Index).Visible = Not Me.lblNIK.Enabled = False
Me.ImgCheck(Index).Visible Me.lblNamaPasien_Ibu.Enabled = False
chkMenu(Awal + Index) = Not chkMenu(Awal + Me.lblNoTelpHPPasien.Enabled = False
Index) Me.lblTglLahir.Enabled = False
End If Me.dcboPekerjaan.Enabled = False
End Sub Me.cboJenkel.Enabled = False
 Me.cboStatusNikah.Enabled = False Me.lblAlamat.Enabled = False
Me.cboAgama.Enabled = False
Me.lblAlamat.Enabled = False Me.cmdReg.Enabled = Not Edit
Me.cmdUbah.Enabled = True
Me.lblDiagAwal.Enabled = False Me.cmdHapus.Enabled = True
Me.lblDiagUtama.Enabled = False Me.cmdRM1.Enabled = Not Edit
Me.lblDiagKomplikasi.Enabled = False Me.cmdCari.Enabled = Not Edit
Me.txtSebabLuarCedera.Enabled = False Me.CmdKeluar.Enabled = Not Edit
Me.cboGolOperasi.Enabled = False
Me.lblOperasi.Enabled = False If Edit = True Then
Me.dtpTglOperasi.Enabled = False Me.cmdUbah.Caption = "&Simpan"
Me.cboAnastesi.Enabled = False Me.cmdHapus.Caption = "&Batal"
Me.txtInfeksiNosokomial.Enabled = False Else
Me.txtSebab_Infeksi.Enabled = False Me.cmdUbah.Caption = "&Ubah"
Me.txtRadioTerapiNuklir.Enabled = False Me.cmdHapus.Caption = "&Hapus"
Me.txtTransfusiDarah.Enabled = False End If
End Sub
For X = 0 To 5
Me.chkImmun1(X).Enabled = False Private Sub DisEnableButtonsRM(Edit As Boolean)
Me.chkImmun2(X).Enabled = False Me.lblDiagAwal.Enabled = Edit
Next Me.lblDiagUtama.Enabled = Edit
Me.lblDiagKomplikasi.Enabled = Edit
Me.cmdReg.Enabled = True Me.txtSebabLuarCedera.Enabled = Edit
Me.cmdUbah.Enabled = False Me.cboGolOperasi.Enabled = Edit
Me.cmdHapus.Enabled = False Me.lblOperasi.Enabled = Edit
Me.cmdRM1.Enabled = False Me.dtpTglOperasi.Enabled = Edit
Me.cmdCari.Enabled = False Me.cboAnastesi.Enabled = Edit
Me.CmdKeluar.Enabled = True Me.txtInfeksiNosokomial.Enabled = Edit
Me.txtSebab_Infeksi.Enabled = Edit
Me.cmdUbah.Caption = "&Ubah" Me.txtRadioTerapiNuklir.Enabled = Edit
Me.cmdHapus.Caption = "&Hapus" Me.txtTransfusiDarah.Enabled = Edit
End Sub
For X = 0 To 5
Private Sub DisEnableButtonsReg(Edit As Boolean) Me.chkImmun1(X).Enabled = Edit
Me.lblNoRegister.Enabled = False Me.chkImmun2(X).Enabled = Edit
Me.txtNoBPJS.Enabled = Edit Next
Me.cboCaraTerima.Enabled = Edit
Me.cboCaraMasuk.Enabled = Edit Me.cmdReg.Enabled = Not Edit
Me.dtpTglMasuk.Enabled = Edit Me.cmdUbah.Enabled = Not Edit
Me.dtpTglKeluar.Enabled = Edit Me.cmdHapus.Enabled = Not Edit
Me.mebJamMasuk.Enabled = Edit Me.cmdRM1.Enabled = True
Me.mebJamKeluar.Enabled = Edit Me.cmdCari.Enabled = True
Me.lblLamaDirawat.Enabled = Edit Me.CmdKeluar.Enabled = Not Edit
Me.txtPenanggungJawab.Enabled = Edit
Me.txtTelpHP_PnggJawab.Enabled = Edit If Edit = True Then
Me.dcboSpesialisasi.Enabled = Edit Me.cmdRM1.Caption = "Si&mpan"
Me.lblNoRuangan.Enabled = Edit Me.cmdCari.Caption = "Ba&tal"
Me.lblKelasRuangan.Enabled = Edit Else
Me.lblNamaDokter.Enabled = Edit Me.cmdRM1.Caption = "&R.M.1."
Me.cboKeadaanKeluar.Enabled = Edit Me.cmdCari.Caption = "&Cari"
Me.cboCaraKeluar.Enabled = Edit End If
Me.txtDirujukKe.Enabled = Edit End Sub

Me.lblNoRM.Enabled = Edit Private Sub SelectRegister()

Me.lblNIK.Enabled = False Set rsRegister = Nothing
Me.lblNamaPasien_Ibu.Enabled = False rsRegister.Open "Select * from Register order by
Me.lblNoTelpHPPasien.Enabled = False NO_Register", _
Me.lblTglLahir.Enabled = False strCon, adOpenStatic, adLockOptimistic
Me.dcboPekerjaan.Enabled = False End Sub
Me.cboJenkel.Enabled = False
Me.cboStatusNikah.Enabled = False Private Sub SelectRegister1()
Me.cboAgama.Enabled = False Set rsRegister = Nothing
 SQLSelect = "Select a.No_Register, a.No_BPJS, Me.lblTglLahir.Caption = "" & rsBantu!Tgl_Lahir
a.No_RM, b.NIK, " & _ Me.dcboPekerjaan.Text = "" & rsBantu!Pekerjaan
"concat(b.NamaPasien,'-',b.NamaIbu) as Me.cboJenkel.ListIndex = rsBantu!JenKel
NamaPasienIbu, " & _ Me.cboStatusNikah.ListIndex = rsBantu!StatusNikah
"b.No_Telp_HP, date_format(b.TglLahir,'%d-%m- Me.cboAgama.ListIndex = rsBantu!Agama
%Y') as Tgl_Lahir, " & _ Me.lblAlamat.Caption = "" & rsBantu!Alamat
"Concat(LPAD(b.ID_Pekerjaan,2,'0'),'- End Sub
',f.NamaPekerjaan) as Pekerjaan, " & _
"b.JenKel, b.StatusNikah, b.Agama, b.Alamat, Private Sub SelectRekamMedis()
a.CaraTerima, " & _ Set rsRekamMedis1 = Nothing
"a.CaraMasuk, a.TglMasuk, a.TglKeluar, SQLSelect = "Select
a.LamaDirawat, a.PenanggungJawab, " & _ Concat(LPAD(a.ID_PENYDIAGMASUK,4,'0'),'-
"a.TelpHP_PnggJawab, ',b.DIAGNOSA,' (',b.KODE_ICD_X,')') as DiagMasuk,
concat(LPAD(a.ID_Spesialisasi,2,'0' ),'-',c.Spesialisasi) "&_
as Spesialisasi, " & _
"a.No_Ruangan, g.NamaType as KelasRuangan, "Concat(LPAD(a.ID_PENYDIAGKLUAR_UTM,4,'0'),'
concat(a.ID_Dokter,'-',e.NamaDokter) as NamaDokter, " -',c.DIAGNOSA,' (',c.KODE_ICD_X,')') as DiagUtama,
&_ "&_
"a.KeadaanKeluar , a.CaraKeluar,
a.CK_Dirujuk_Ke " & _ "Concat(LPAD(a.ID_PENYDIAGKLUAR_KOM,4,'0'),'
"from (((((Register a left join Pasien b on -',d.DIAGNOSA,' (',d.KODE_ICD_X,')') as
a.No_RM = b.No_RM) " & _ DiagKomplikasi, " & _
"left join Spesialisasi c on a.ID_Spesialisasi = "a.SebabCedera_Krcunan, a.GOL_OPERASI,
c.ID_Spesialisasi) " & _ Concat(LPAD(a.ID_OPERASI,2,'0'),'-
"left join Ruangan d on a.NO_Ruangan = ',e.NAMAOPERASI) as Operasi, " & _
d.No_Ruangan) " & _ "a.Tgl_Operasi as TglOperasi, a.ID_ANASTESI,
"left join TypeRuangan g on d.ID_Type = a.ID_IMMUNISASI1, a.ID_IMMUNISASI2, " & _
g.ID_Type) " & _ "a.INFEKSI_NOSOKOMIAL , a.SEBAB_INFEKSI,
"left join Dokter e on a.ID_Dokter = e.ID_Dokter) a.RADIOTERAPIDOKNULIR, a.TRANSFUSIDARAH
"&_ "&_
"left join Pekerjaan f on b.ID_Pekerjaan = "From (((RekamMedis1 a left join Diagnosa b on
f.ID_Pekerjaan " & _ a.ID_PENYDIAGMASUK=b.ID_DIAGNOSA) " & _
"Where NO_Register='" & NO_REGISTER & "'" " left join Diagnosa c on
a.ID_PENYDIAGKLUAR_UTM=c.ID_DIAGNOSA) "
rsRegister.Open SQLSelect, strCon, adOpenStatic, &_
adLockOptimistic " left join Diagnosa d on
End Sub a.ID_PENYDIAGKLUAR_KOM=d.ID_DIAGNOSA) "
&_
Private Sub CariPasien(ByVal NO_RM As String) " left join Operasi e on
Set rsBantu = Nothing a.ID_OPERASI=e.ID_OPERASI " & _
SQLSelect = "Select b.No_RM, b.NIK, " & _ " Where NO_Register='" & NO_REGISTER & "'"
"concat(b.NamaPasien,'-',b.NamaIbu) as
NamaPasienIbu, " & _ Debug.Print SQLSelect
"b.No_Telp_HP, date_format(b.TglLahir,'%d-%m- rsRekamMedis1.Open SQLSelect, strCon,
%Y') as Tgl_Lahir, " & _ adOpenStatic, adLockOptimistic
"Concat(LPAD(b.ID_Pekerjaan,2,'0'),'- End Sub
',f.NamaPekerjaan) as Pekerjaan, " & _
"b.JenKel, b.StatusNikah, b.Agama, b.Alamat " & Private Sub KosongPasien()
_ NO_RM = ""
"from Pasien b left join Pekerjaan f on Me.lblNoRM.Caption = ""
b.ID_Pekerjaan = f.ID_Pekerjaan " & _ Me.lblNIK.Caption = ""
"Where NO_RM='" & NO_RM & "'" Me.lblNamaPasien_Ibu.Caption = ""
Me.lblNoTelpHPPasien.Caption = ""
rsBantu.Open SQLSelect, strCon, adOpenStatic, Me.lblTglLahir.Caption = ""
adLockOptimistic Me.dcboPekerjaan.Text = ""
Me.cboJenkel.ListIndex = 0
Me.lblNoRM.Caption = "" & rsBantu!NO_RM Me.cboStatusNikah.ListIndex = 0
Me.lblNIK.Caption = "" & rsBantu!NIK Me.cboAgama.ListIndex = 0
Me.lblNamaPasien_Ibu.Caption = "" & Me.lblAlamat.Caption = ""
rsBantu!NamaPasienIbu End Sub
Me.lblNoTelpHPPasien.Caption = "" &
rsBantu!NO_TELP_HP Private Sub BacaDataReg()
 If rsRegister.EOF Then KosongPasien
Me.lblNoRegister.Caption = "" Else
Me.txtNoBPJS.Text = "" Me.lblNoRM.Caption = "" &
Me.cboCaraTerima.ListIndex = 0 rsRegister!NO_RM
Me.cboCaraMasuk.ListIndex = 0 Me.lblNIK.Caption = "" & rsRegister!NIK
Me.dtpTglMasuk.Value = Date Me.lblNamaPasien_Ibu.Caption = "" &
Me.dtpTglKeluar.Value = Date rsRegister!NamaPasienIbu
Me.mebJamMasuk = "00:00:00" Me.lblNoTelpHPPasien.Caption = "" &
Me.mebJamKeluar = "00:00:00" rsRegister!NO_TELP_HP
Me.lblLamaDirawat.Caption = "" Me.lblTglLahir.Caption = "" &
Me.txtPenanggungJawab.Text = "" rsRegister!Tgl_Lahir
Me.txtTelpHP_PnggJawab.Text = "" Me.dcboPekerjaan.Text = "" &
Me.dcboSpesialisasi.Text = "" rsRegister!Pekerjaan
Me.lblNoRuangan.Caption = "" Me.cboJenkel.ListIndex = rsRegister!JenKel
Me.lblKelasRuangan.Caption = "" Me.cboStatusNikah.ListIndex =
Me.lblNamaDokter.Caption = "" rsRegister!StatusNikah
Me.cboKeadaanKeluar.ListIndex = 0 Me.cboAgama.ListIndex = rsRegister!Agama
Me.cboCaraKeluar.ListIndex = 0 Me.lblAlamat.Caption = "" & rsRegister!Alamat
Me.txtDirujukKe.Text = "" End If
End If
KosongPasien End Sub
Else
Me.lblNoRegister.Caption = "" & Private Sub BacaDataRekamMedis()
rsRegister!NO_REGISTER If rsRekamMedis1.EOF Then
Me.txtNoBPJS.Text = "" & rsRegister!No_BPJS Me.lblDiagAwal.Caption = ""
Me.cboCaraTerima.ListIndex = Me.lblDiagUtama.Caption = ""
rsRegister!CaraTerima Me.lblDiagKomplikasi.Caption = ""
Me.cboCaraMasuk.ListIndex = Me.txtSebabLuarCedera.Text = ""
rsRegister!CaraMasuk Me.cboGolOperasi.ListIndex = 0
Me.dtpTglMasuk.Value = "" & Me.lblOperasi.Caption = ""
Format(rsRegister!TglMasuk, "dd-mm-yyyy") Me.dtpTglOperasi.Value = ""
Me.dtpTglKeluar.Value = "" & Me.cboAnastesi.ListIndex = 0
Format(rsRegister!TglKeluar, "dd-mm-yyyy") Me.txtInfeksiNosokomial.Text = ""
Me.mebJamMasuk = Me.txtSebab_Infeksi.Text = ""
IIf(IsNull(rsRegister!TglMasuk), "00:00:00",
Format(rsRegister!TglMasuk, "hh:mm:ss")) For X = 0 To 5
Me.mebJamKeluar = Me.chkImmun1(X).Value = vbUnchecked
IIf(IsNull(rsRegister!TglKeluar), "00:00:00", Me.chkImmun2(X).Value = vbUnchecked
Format(rsRegister!TglKeluar, "hh:mm:ss")) Next
Me.lblLamaDirawat.Caption = "" &
rsRegister!LamaDirawat Me.txtRadioTerapiNuklir.Text = ""
Me.txtPenanggungJawab.Text = "" & Me.txtTransfusiDarah.Text = ""
rsRegister!PenanggungJawab Else
Me.txtTelpHP_PnggJawab.Text = "" & sImmun1 = rsRekamMedis1!ID_IMMUNISASI1
rsRegister!TelpHP_PnggJawab sImmun2 = rsRekamMedis1!ID_IMMUNISASI2
Me.dcboSpesialisasi.Text = "" &
rsRegister!Spesialisasi asImmun1 = Split(sImmun1, ",")
Me.lblNoRuangan.Caption = "" & asImmun2 = Split(sImmun2, ",")
rsRegister!NO_RUANGAN
Me.lblKelasRuangan.Caption = "" & For X = 0 To 5
rsRegister!KelasRuangan If asImmun1(X) = "1" Then
Me.lblNamaDokter.Caption = "" & Me.chkImmun1(X).Value = vbChecked
rsRegister!NamaDokter Else
Me.cboKeadaanKeluar.ListIndex = Me.chkImmun1(X).Value = vbUnchecked
rsRegister!KeadaanKeluar End If
Me.cboCaraKeluar.ListIndex = If asImmun2(X) = "1" Then
rsRegister!CaraKeluar Me.chkImmun2(X).Value = vbChecked
Me.txtDirujukKe.Text = "" & Else
rsRegister!CK_Dirujuk_Ke Me.chkImmun2(X).Value = vbUnchecked
End If
NO_RM = "" & rsRegister!NO_RM Next
If NO_RM = "" Then
 Me.lblDiagAwal.Caption = "" & Set rsBantu = Nothing
rsRekamMedis1!DiagMasuk rsBantu.Open SQLSelect, ConRumahSakit,
Me.lblDiagUtama.Caption = "" & adOpenStatic, adLockReadOnly
rsRekamMedis1!DiagUtama If rsBantu.EOF Then
Me.lblDiagKomplikasi.Caption = "" & NO_REGISTER = DOCID & "01"
rsRekamMedis1!DiagKomplikasi Else
Me.txtSebabLuarCedera.Text = "" & rsBantu.MoveLast
rsRekamMedis1!SEBABCEDERA_KRCUNAN NoSeri =
Me.cboGolOperasi.ListIndex = CInt(Right(rsBantu.Fields("NO_REGISTER"), 2)) + 1
rsRekamMedis1!GOL_OPERASI NO_REGISTER = DOCID & Format(NoSeri, "00")
Me.lblOperasi.Caption = "" & End If
rsRekamMedis1!Operasi
Me.dtpTglOperasi.Value = "" & Me.lblNoRegister = NO_REGISTER
Format(rsRekamMedis1!TglOperasi, "dd-mm-yyyy")
Me.cboAnastesi.ListIndex = SQLInsert = "INSERT INTO Register
rsRekamMedis1!ID_ANASTESI (NO_REGISTER,TGLMASUK) values " & _
Me.txtInfeksiNosokomial.Text = "" & "('" & Me.lblNoRegister & "','" & Format(TglTrans,
rsRekamMedis1!INFEKSI_NOSOKOMIAL "yyyy-mm-dd hh:mm:ss") & "')"
Me.txtSebab_Infeksi.Text = "" &
rsRekamMedis1!SEBAB_INFEKSI ConRumahSakit.Execute SQLInsert
Me.txtRadioTerapiNuklir.Text = "" &
rsRekamMedis1!RADIOTERAPIDOKNULIR SelectRegister
Me.txtTransfusiDarah.Text = "" & RecordTerakhir
rsRekamMedis1!TRANSFUSIDARAH cmdUbah_Click
End If End Sub
End Sub
Private Sub cmdRM1_Click()
Private Sub cboCaraKeluar_Click() If Me.cmdRM1.Caption = "&R.M.1." Then
If cboCaraKeluar.ListIndex = 3 Then DisEnableButtonsRM True
Me.txtDirujukKe.Enabled = True Me.cboGolOperasi.SetFocus
Me.txtDirujukKe.SetFocus Else
Else SelectRekamMedis
Me.txtDirujukKe.Text = "" If rsRekamMedis1.EOF Then
Me.txtDirujukKe.Enabled = False SQLInsert = "Insert into RekamMedis1
End If (No_Register) " & _
End Sub "values ('" & NO_REGISTER & "')"

Private Sub cmdCari_Click() ConRumahSakit.Execute SQLInsert

If Me.cmdCari.Caption = "&Cari" Then End If
FrmCariRegister.Show vbModal
If FrmCariRegister.Dipilih = True Then sImmun1 = "": sImmun2 = ""
NO_REGISTER = For X = 0 To 5
FrmCariRegister.sNO_REGISTER If X > 0 Then sImmun1 = sImmun1 & ","
BacaRegisterRM1 If Me.chkImmun1(X).Value = vbChecked Then
End If sImmun1 = sImmun1 & "1"
Else Else
SelectRekamMedis sImmun1 = sImmun1 & "0"
BacaDataRekamMedis End If
DisEnableButtonsRM False
End If If X > 0 Then sImmun2 = sImmun2 & ","
End Sub If Me.chkImmun2(X).Value = vbChecked Then
sImmun2 = sImmun2 & "1"
Private Sub CmdKeluar_Click() Else
Unload Me sImmun2 = sImmun2 & "0"
End Sub End If
Next
Private Sub cmdReg_Click()
SQLSave = "Update RekamMedis1 set " & _
DOCID = "RG" & Format(TglTrans, "yymmdd") "ID_PENYDIAGMASUK='" &
SQLSelect = "Select * from Register where Left(Me.lblDiagAwal, 4) & "', " & _
LEFT(No_Register,8)='" & DOCID & "' order by "ID_PENYDIAGKLUAR_UTM='" &
No_Register" Left(Me.lblDiagUtama, 4) & "', " & _
 "ID_PENYDIAGKLUAR_KOM='" & "CaraKeluar='" & Me.cboCaraKeluar.ListIndex &
Left(Me.lblDiagKomplikasi, 4) & "', " & _ "', " & _
"SEBABCEDERA_KRCUNAN='" & "CK_Dirujuk_Ke='" & Me.txtDirujukKe & "' " & _
txtSebabLuarCedera & "', " & _ "Where No_Register ='" & Me.lblNoRegister & "'"
"ID_OPERASI='" & Left(Me.lblOperasi, 2) & "', "
&_ ConRumahSakit.Execute SQLSave
"GOL_OPERASI='" &
Me.cboGolOperasi.ListIndex & "', " & _ SelectRegister1
"ID_ANASTESI='" & Me.cboAnastesi.ListIndex & BacaDataReg
"', " & _ DisEnableButtonsReg False
"TGL_OPERASI='" & Format(Me.dtpTglOperasi, End If
"yyyy-mm-dd") & "', " & _ End Sub
"INFEKSI_NOSOKOMIAL='" &
Me.txtInfeksiNosokomial & "', " & _ Private Sub dtpTglMasuk_Click()
"SEBAB_INFEKSI='" & Me.txtSebab_Infeksi & If Me.dtpTglKeluar.CheckBox = True Then
"', " & _ BerapaLamaDirawat
"TRANSFUSIDARAH='" & Me.txtTransfusiDarah End If
& "', " & _ End Sub
"ID_IMMUNISASI1='" & sImmun1 & "', " & _
"ID_IMMUNISASI2='" & sImmun2 & "', " & _ Private Sub dtpTglKeluar_Click()
"RADIOTERAPIDOKNULIR='" & BerapaLamaDirawat
Me.txtRadioTerapiNuklir & "' " & _ End Sub
"Where No_Register ='" & Me.lblNoRegister & "'"
Private Sub BerapaLamaDirawat()
ConRumahSakit.Execute SQLSave SQLSelect = "Select Datediff('" &
Format(dtpTglKeluar, "yyyy-mm-dd") & "','" & _
SelectRekamMedis Format(dtpTglMasuk, "yyyy-mm-dd") & "') as
BacaDataRekamMedis LamaDirawat"
DisEnableButtonsRM False
End If Set rsBantu = Nothing
End Sub rsBantu.Open SQLSelect, ConRumahSakit,
adOpenStatic, adLockReadOnly
Private Sub cmdUbah_Click() Me.lblLamaDirawat = "" &
If Me.cmdUbah.Caption = "&Ubah" Then rsBantu.Fields("LamaDirawat")
DisEnableButtonsReg True End Sub
Me.txtNoBPJS.SetFocus
Else Private Sub Form_Load()
SQLSave = "Update Register set " & _ Me.cboAgama.AddItem "--Agama--"
"No_RM='" & Me.lblNoRM & "', " & _ Me.cboAgama.AddItem "1-Islam"
"No_BPJS='" & Me.txtNoBPJS & "', " & _ Me.cboAgama.AddItem "2-Katholik"
"CaraTerima='" & Me.cboCaraTerima.ListIndex & Me.cboAgama.AddItem "3-Protestan"
"', " & _ Me.cboAgama.AddItem "4-Hindu"
"CaraMasuk='" & Me.cboCaraMasuk.ListIndex & Me.cboAgama.AddItem "5-Budha"
"', " & _ Me.cboAgama.AddItem "6-Kong Hu Chu"
"TglMasuk='" & Format(Me.dtpTglMasuk, "yyyy-
mm-dd") & " " & Me.mebJamMasuk & "', " & _ Me.cboJenkel.AddItem "--Jenis Kelamin--"
"TglKeluar='" & Format(Me.dtpTglKeluar, "yyyy- Me.cboJenkel.AddItem "1-Laki-laki"
mm-dd") & " " & Me.mebJamKeluar & "', " & _ Me.cboJenkel.AddItem "2-Perempuan"
"LamaDirawat='" & Me.lblLamaDirawat & "', " &
_ Me.cboStatusNikah.AddItem "--Pernikahan--"
"PenanggungJawab='" & Me.txtPenanggungJawab Me.cboStatusNikah.AddItem "1-Belum Menikah"
& "', " & _ Me.cboStatusNikah.AddItem "2-Sudah Menikah"
"TelpHP_PnggJawab='" & Me.cboStatusNikah.AddItem "3-Cerai Hidup"
Me.txtTelpHP_PnggJawab & "', " & _ Me.cboStatusNikah.AddItem "4-Cerai Mati"
"ID_Spesialisasi='" & Left(Me.dcboSpesialisasi, 2)
& "', " & _ Me.cboCaraTerima.AddItem "--Cara Penerimaan--"
"No_Ruangan='" & lblNoRuangan & "', " & _ Me.cboCaraTerima.AddItem "1-Poliklinik"
"ID_Dokter='" & Left(Me.lblNamaDokter, 6) & "', Me.cboCaraTerima.AddItem "2-Unit Gawat Darurat"
"&_ Me.cboCaraTerima.AddItem "3-Langsung TP2RI"
"KeadaanKeluar='" & Me.cboCaraTerima.AddItem "4-Langsung Ruang
Me.cboKeadaanKeluar.ListIndex & "', " & _ Gawat"
 Me.cboCaraMasuk.AddItem "--Cara Masuk--" Jawab = DialogBox("Yakin ingin menghapus
Me.cboCaraMasuk.AddItem "1-Dokter" Register Pasien dengan " & vbCrLf & _
Me.cboCaraMasuk.AddItem "2-Puskesmas" "No. Register " & Me.lblNoRegister & "...?",
Me.cboCaraMasuk.AddItem "3-RS Lain" "Hapus Register Pasien ...")
Me.cboCaraMasuk.AddItem "4-Instansi Lain" If Jawab = vbNo Then Exit Sub
Me.cboCaraMasuk.AddItem "5-Kasus Polisi"
Me.cboCaraMasuk.AddItem "6-Datang Sendiri" sqldel = "Delete from Register where No_Register
='" & Me.lblNoRegister & "'"
Me.cboGolOperasi.AddItem "--Gol. Operasi--"
Me.cboGolOperasi.AddItem "1-Kecil" ConRumahSakit.Execute sqldel
Me.cboGolOperasi.AddItem "2-Menengah"
Me.cboGolOperasi.AddItem "3-Besar" sqldel = "Delete from RekamMedis1 where
No_Register ='" & Me.lblNoRegister & "'"
Me.cboAnastesi.AddItem "--Anastesi--"
Me.cboAnastesi.AddItem "1-Lokal" ConRumahSakit.Execute sqldel
Me.cboAnastesi.AddItem "2-Regional"
Me.cboAnastesi.AddItem "3-Umum" SelectRegister
If rsRegister.EOF Then
Me.cboKeadaanKeluar.AddItem "--Keadaan Keluar-- DisEnableButtonsReg True
" BacaDataReg
Me.cboKeadaanKeluar.AddItem "1-Sembuh" BacaDataRekamMedis
Me.cboKeadaanKeluar.AddItem "2-Membaik" FirstShow
Me.cboKeadaanKeluar.AddItem "3-Belum Sembuh" Else
Me.cboKeadaanKeluar.AddItem "4-Meninggal < 48 RecordTerakhir
Jam" End If
Me.cboKeadaanKeluar.AddItem "5-Meninggal > 48 Else
Jam" BacaDataReg
DisEnableButtonsReg False
Me.cboCaraKeluar.AddItem "--Cara Keluar--" End If
Me.cboCaraKeluar.AddItem "1-Diizinkan Pulang" End Sub
Me.cboCaraKeluar.AddItem "2-Atas Permintaan
Sendiri" Private Sub lblDiagAwal_Click()
Me.cboCaraKeluar.AddItem "3-Dirujuk ke" FrmMastDiagnosa.nTag = 1
Me.cboCaraKeluar.AddItem "4-Melarikan Diri" FrmMastDiagnosa.Show vbModal
Me.cboCaraKeluar.AddItem "5-Pindah ke RS Lain" If FrmMastDiagnosa.Dipilih = True Then
sID_DIAGNOSA =
SelectRegister FrmMastDiagnosa.sID_DIAGNOSA
If rsRegister.EOF Then sDIAGNOSA = FrmMastDiagnosa.sDIAGNOSA
FirstShow sKODE_ICD_X =
Else FrmMastDiagnosa.sKODE_ICD_X
RecordTerakhir Me.lblDiagAwal = LPAD(sID_DIAGNOSA, 4,
End If "0") & "-" & sDIAGNOSA & " (" & sKODE_ICD_X &
End Sub ")"
End If
Private Sub RecordTerakhir() Unload FrmMastDiagnosa
rsRegister.MoveLast End Sub
NO_REGISTER = rsRegister!NO_REGISTER
BacaRegisterRM1 Private Sub lblDiagKomplikasi_Click()
End Sub FrmMastDiagnosa.nTag = 1
FrmMastDiagnosa.Show vbModal
Private Sub BacaRegisterRM1() If FrmMastDiagnosa.Dipilih = True Then
SelectRegister1 sID_DIAGNOSA =
BacaDataReg FrmMastDiagnosa.sID_DIAGNOSA
DisEnableButtonsReg False sDIAGNOSA = FrmMastDiagnosa.sDIAGNOSA
SelectRekamMedis sKODE_ICD_X =
BacaDataRekamMedis FrmMastDiagnosa.sKODE_ICD_X
DisEnableButtonsRM False Me.lblDiagKomplikasi = LPAD(sID_DIAGNOSA,
End Sub 4, "0") & "-" & sDIAGNOSA & " (" & sKODE_ICD_X
& ")"
Private Sub cmdHapus_Click() End If
If cmdHapus.Caption = "&Hapus" Then Unload FrmMastDiagnosa
End Sub
Private Sub lblDiagUtama_Click() Private Shadow As clsShadow
FrmMastDiagnosa.nTag = 1 Private TekanAlt As Boolean
FrmMastDiagnosa.Show vbModal
If FrmMastDiagnosa.Dipilih = True Then Private Sub Form_KeyDown(KeyCode As Integer, Shift
sID_DIAGNOSA = As Integer)
FrmMastDiagnosa.sID_DIAGNOSA Select Case KeyCode
sDIAGNOSA = FrmMastDiagnosa.sDIAGNOSA Case 18
sKODE_ICD_X = TekanAlt = True
FrmMastDiagnosa.sKODE_ICD_X Case KeyCodeConstants.vbKeyS
Me.lblDiagUtama = LPAD(sID_DIAGNOSA, 4, If TekanAlt = True Then
"0") & "-" & sDIAGNOSA & " (" & sKODE_ICD_X & lblPilih_Click
")" End If
End If Case KeyCodeConstants.vbKeyB
Unload FrmMastDiagnosa If TekanAlt = True Then
End Sub lblBatal_Click
End If
Private Sub lblNamaDokter_Click() End Select
FrmMastDokter.nTag = 1 End Sub
FrmMastDokter.Show vbModal
If FrmMastDokter.Dipilih = True Then Private Sub Form_KeyUp(KeyCode As Integer, Shift As
Me.lblNamaDokter = FrmMastDokter.sKode Integer)
End If Select Case KeyCode
Unload FrmMastDokter Case 18
End Sub TekanAlt = False
End Select
Private Sub lblNoRM_Click() End Sub
FrmMastPasien.nTag = 1
If Me.lblNoRM <> "" Then Private Sub Form_Activate()
FrmMastPasien.NO_RM = Me.lblNoRM Static Sudah As Boolean
End If
FrmMastPasien.Show vbModal If Sudah = False Then
If FrmMastPasien.Dipilih = True Then Sudah = True
NO_RM = FrmMastPasien.NO_RM StandardRegionalSetting
CariPasien NO_RM
End If Me.lblTglAktif.Caption = TglAktif
Unload FrmMastPasien
End Sub Set rsBantu = Nothing
rsBantu.Open "Select OPRDATE from setup",
Private Sub lblNoRuangan_Click() ConSetup, adOpenStatic, adLockReadOnly
FrmMastRuangan.nTag = 1 Me.dtpTglTrans.Value =
FrmMastRuangan.Show vbModal IIf(IsNull(rsBantu.Fields("OPRDATE")), Date,
If FrmMastRuangan.Dipilih = True Then rsBantu.Fields("OPRDATE"))
Me.lblNoRuangan = Left(FrmMastRuangan.sKode, End If
3) End Sub
Me.lblKelasRuangan =
Mid(FrmMastRuangan.sKode, 7) Private Sub Form_Load()
End If Bayangan Shadow, Me
Unload FrmMastRuangan CenterWindow Me
End Sub
Me.Visible = False
Private Sub lblOperasi_Click() Transparent Me, 220
FrmMastOperasi.nTag = 1 Me.Visible = False
FrmMastOperasi.Show vbModal End Sub
If FrmMastOperasi.Dipilih = True Then
Me.lblOperasi = FrmMastOperasi.sKode Private Function CekTanggal(ByVal TglTrans As Date,
End If _
Unload FrmMastOperasi TglAktif As Date) As Boolean
End Sub If (TglTrans < TglAwal Or TglTrans >
CDate(TglAktif)) Then
3. form Tgl Transaksi WarningBox "Tanggal Transaksi yang dipilih (" &
Public Dipilih As Boolean TglTrans & ") " & _
 "di luar batas yang diperkenankan (" & TglAwal & ConRumahSakit.Execute "Commit"
" s.d. " & TglAktif & ") ...", 0
CekTanggal = False FrmMastPasien.NO_RM = Me.lblNoRM
Else Disimpan = True
CekTanggal = True Me.Hide
End If End Sub
End Function
Private Sub CmdKeluar_Click()
Private Sub lblBatal_Click() Disimpan = False
Me.Hide Me.Hide
End Sub End Sub

Private Sub lblPilih_Click() Private Sub CmdSave_KeyPress(KeyAscii As Integer)

If CekTanggal(Me.dtpTglTrans, TglAktif) = False If KeyAscii = 27 Then
Then Exit Sub Unload Me
End If
SQLUpdate = "Update Setup set OPRDATE='" & End Sub
Format(TglTrans, "yyyy-mm-dd") & "'"
3Private Sub CmdKeluar_KeyPress(KeyAscii As
ConSetup.Execute SQLUpdate Integer)
If KeyAscii = 27 Then
Me.Hide Unload Me
End Sub End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Private Sub Form_KeyPress(KeyAscii As Integer)
lblPilih_Click If KeyAscii = 27 Then
ElseIf KeyAscii = 27 Then Unload Me
lblBatal_Click End If
End If End Sub
End Sub
Private Sub FormActivate()
4. form pasien CenterWindow Me

Public rsPasien As New ADODB.Recordset SQLSelect = "Select b.No_RM, b.NIK, " & _
Public rsBantu As New ADODB.Recordset "b.NamaPasien, b.NamaIbu, " & _
Public Disimpan As Boolean "b.No_Telp_HP, date_format(b.TglLahir,'%d-%m-
Public NO_RM As String %Y') as Tgl_Lahir, " & _
Private Shadow As clsShadow "Concat(LPAD(b.ID_Pekerjaan,2,'0'),'-
',f.NamaPekerjaan) as Pekerjaan, " & _
Private Sub CmdSave_Click() "b.JenKel, b.StatusNikah, b.Agama, b.Alamat " &
SQLSave = "Update Pasien Set " & _ _
"NIK='" & Me.txtNIK.Text & "', " & _ "from Pasien b left join Pekerjaan f on
"NamaPasien='" & Me.txtNamaPasien.Text & "', " & b.ID_Pekerjaan = f.ID_Pekerjaan " & _
_ "Where NO_RM='" & NO_RM & "'"
"NamaIbu='" & Me.txtNamaIbu.Text & "', " & _
"No_Telp_HP='" & Me.txtNoTelpHPPasien.Text & Debug.Print SQLSelect
"', " & _ Set rsPasien = Nothing
"ID_Pekerjaan='" & Left(Me.lblPekerjaan, 2) & "', " rsPasien.Open SQLSelect, ConRumahSakit,
&_ adOpenStatic, adLockOptimistic
"TglLahir='" & Format(Me.dtpTglLahir, "yyyy-mm-
dd") & "', " & _ Me.lblNoRM.Caption = "" & rsPasien!NO_RM
"JenKel='" & cboJenkel.ListIndex & "', " & _ Me.txtNIK.Text = "" & rsPasien!NIK
"StatusNikah='" & cboStatusNikah.ListIndex & "', " Me.txtNamaPasien.Text = "" & rsPasien!NamaPasien
&_ Me.txtNamaIbu.Text = "" & rsPasien!NamaIbu
"Agama='" & cboAgama.ListIndex & "', " & _ Me.txtNoTelpHPPasien.Text = "" &
"Alamat='" & Me.txtAlamat & "' " & _ rsPasien!NO_TELP_HP
" Where NO_RM='" & Me.lblNoRM & "'" Me.dtpTglLahir.Value = "" & rsPasien!Tgl_Lahir
Me.lblPekerjaan.Caption = "" & rsPasien!Pekerjaan
'MsgBox SQLSave Me.cboJenkel.ListIndex = rsPasien!JenKel
Me.cboStatusNikah.ListIndex = rsPasien!StatusNikah
ConRumahSakit.Execute (SQLSave) Me.cboAgama.ListIndex = rsPasien!Agama
 Me.txtAlamat.Text = "" & rsPasien!Alamat
Private Sub SelectRecord(Optional ByVal sCriteria As
Me.txtNamaPasien.SetFocus String)
End Sub SQLSelect = "Select ID_TYPE as `ID. TYPE`,
NAMATYPE as `TYPE RUANGAN`, " & _
Public Sub Form_Load()
Me.cboAgama.AddItem "--Agama--" "Replace(Replace(Replace(Format(TARIFPERHARI,2),
Me.cboAgama.AddItem "1-Islam" ',',' '),'.',','),' ','.') AS `TARIF/HARI` " & _
Me.cboAgama.AddItem "2-Katholik" "from TYPERUANGAN " & sCriteria & " Order by
Me.cboAgama.AddItem "3-Protestan" `ID_TYPE`"
Me.cboAgama.AddItem "4-Hindu" Set rsTypeRuangan = Nothing
Me.cboAgama.AddItem "5-Budha" rsTypeRuangan.Open SQLSelect, ConRumahSakit,
Me.cboAgama.AddItem "6-Kong Hu Chu" adOpenStatic, adLockReadOnly
If rsTypeRuangan.EOF Then
Me.cboJenkel.AddItem "--Jenis Kelamin--" SQLSelect = "Select '' as `ID. TYPE`, '' as `TYPE
Me.cboJenkel.AddItem "1-Laki-laki" RUANGAN`, '' as `TARIF/HARI`"
Me.cboJenkel.AddItem "2-Perempuan" Set rsTypeRuangan = Nothing
rsTypeRuangan.Open SQLSelect, ConRumahSakit,
Me.cboStatusNikah.AddItem "--Pernikahan--" adOpenStatic, adLockReadOnly
Me.cboStatusNikah.AddItem "1-Belum Menikah" End If
Me.cboStatusNikah.AddItem "2-Sudah Menikah"
Me.cboStatusNikah.AddItem "3-Cerai Hidup" flxFloat.MousePointer = vbHourglass
Me.cboStatusNikah.AddItem "4-Cerai Mati"
rsTypeRuangan.Requery
Bayangan Shadow, Me Set Me.flxFloat.DataSource = rsTypeRuangan
Me.flxFloat.Refresh
Me.Visible = False FlxFloatFormat
Transparent Me, 220 flxFloat.MousePointer = vbDefault
Me.Visible = False End Sub

AturWarna Me Private Sub flxFloat_Click()

End Sub If flxFloat.Rows = 1 Or flxFloat.MouseRow = 0 Then
Exit Sub
Private Sub txtPlafond_GotFocus() If nTag = 0 Then
SendKeys "^{Home}+{End}", 50 UpdMaster
End Sub Else
Dipilih = True
Private Sub lblPekerjaan_Click() sKode = Me.flxFloat.TextMatrix(Me.flxFloat.Row,
FrmMastKerja.nTag = 1 0) & "-" & _
FrmMastKerja.Show vbModal Me.flxFloat.TextMatrix(Me.flxFloat.Row, 1)
If FrmMastKerja.Dipilih = True Then Me.Hide
Me.lblPekerjaan = FrmMastKerja.sKode End If
End If End Sub
Unload FrmMastKerja
End Sub Private Sub UpdMaster()
If flxFloat.TextMatrix(flxFloat.Row, 0) = "" _
Private Sub Timer1_Timer() Or Me.flxFloat.Col = 0 Then Exit Sub
Timer1.Enabled = False
FormActivate If flxFloat.Col = 1 Then
End Sub Me.txtEdit.Alignment = 0
Else
5. form type ruangan Me.txtEdit.Alignment = 1
End If
Public sKode As String, nTag As Byte, Dipilih As flxFloat.Enabled = False
Boolean txtEdit = flxFloat
Private Shadow As clsShadow 'txtEdit.SelStart = 1000
Private rsTypeRuangan As New ADODB.Recordset ' Show Edt at the right place.
txtEdit.Move flxFloat.Left + flxFloat.CellLeft,
Private Sub IncrSearch() flxFloat.CellTop + flxFloat.Top, _
SelectRecord "Where `NAMATYPE` Like '" & flxFloat.CellWidth, flxFloat.CellHeight
sKode & "%' "
End Sub txtEdit.Visible = True
 ' And let it work. Me.lblCari = Left(Me.lblCari,
txtEdit.SetFocus Len(Me.lblCari) - 1)
'SendKeys ("^{HOME}+{END}"), 50 sKode = Me.lblCari
End Sub IncrSearch
End If
Private Sub txtEdit_KeyDown(KeyCode As Integer, Case 13 'Enter
Shift As Integer) If nTag = 0 Then
UpdMaster
' Standard edit control processing. Else
Select Case KeyCode Dipilih = True
sKode =
Case 27 ' ESC: hide, return focus to flxFloat. Me.flxFloat.TextMatrix(Me.flxFloat.Row, 0) & "-" & _
txtEdit.Visible = False Me.flxFloat.TextMatrix(Me.flxFloat.Row, 1)
Me.flxFloat.Enabled = True Me.lblCari = ""
Me.flxFloat.SetFocus Me.Hide
End If
Case 13 ' ENTER return focus to flxFloat. Case 14 'Ctrl+N
ID_TYPE = Me.flxFloat.TextMatrix(flxFloat.Row, NewTypeRuangan
0) Case 24 'Ctrl+X
sKode = ""
If Me.flxFloat.Col = 1 Then Me.lblCari = ""
SQLUpdate = "Update TYPERUANGAN set Case 26 'Ctrl+Z
NAMATYPE='" & Me.txtEdit & "' " & _ sKode = ""
"where ID_TYPE='" & ID_TYPE & "'" Me.lblCari = ""
Me.flxFloat.TextMatrix(flxFloat.Row, 1) = SelectRecord
Me.txtEdit Case 27
Else Dipilih = False
SQLUpdate = "Update TYPERUANGAN set Me.Hide
TARIFPERHARI='" & Me.txtEdit & "' " & _ Case 0 To 31
"where ID_TYPE='" & ID_TYPE & "'" 'Me.Label3 = KeyAscii
Me.flxFloat.TextMatrix(flxFloat.Row, 2) = Case Else
Format(Me.txtEdit, "#,###.00") sKode = sKode & Chr(KeyAscii)
End If Me.lblCari = sKode
IncrSearch
ConRumahSakit.Execute SQLUpdate End Select
End Sub
Me.txtEdit.Visible = False
Me.flxFloat.Enabled = True Private Sub DelTypeRuangan()
Me.flxFloat.SetFocus If Me.flxFloat.Rows = 0 Then Exit Sub
ID_TYPE = flxFloat.TextMatrix(flxFloat.Row, 0)
sKode = "" sTypeRuangan = flxFloat.TextMatrix(flxFloat.Row,
Me.lblCari.Caption = "" 1)
End Select
End Sub SQLSelect = "Select ID_TYPE from RUANGAN
where ID_TYPE='" & ID_TYPE & "'"
Private Sub flxFloat_KeyDown(KeyCode As Integer, Set rsBantu = Nothing
Shift As Integer) rsBantu.Open SQLSelect, ConRumahSakit,
Select Case KeyCode adOpenStatic, adLockReadOnly
'Case 38, 40 If Not rsBantu.EOF Then
' Me.flxFloat.RowSel = Me.flxFloat.Row WarningBox "Type Ruangan belum bisa dihapus
Case 46 karena sudah dipakai pada file Ruangan", 0
DelTypeRuangan Exit Sub
Case Else End If
'sFiltGrup = KeyCode
End Select Jawab = DialogBox("Yakin ingin menghapus Type
End Sub Ruangan : " & vbCrLf & _
ID_TYPE & "-" & sTypeRuangan)
Private Sub flxfloat_KeyPress(KeyAscii As Integer) If Jawab = vbNo Then Exit Sub
Select Case KeyAscii
Case 8 'Ctrl+H SQLDelete = "Delete from TypeRuangan where
If Len(Me.lblCari) > 0 Then ID_TYPE='" & ID_TYPE & "'"
 ConRumahSakit.Execute (SQLDelete) Case 27
Dipilih = False
SQLSelect = "Select ID_TYPE from Me.Hide
TYPERUANGAN order by ID_TYPE" End Select
Set rsBantu = Nothing End Sub
rsBantu.Open SQLSelect, ConRumahSakit,
adOpenStatic, adLockReadOnly Private Sub FlxFloatFormat()
If rsBantu.EOF Then With flxFloat
SQLUpdate = "ALTER table TYPERUANGAN '.Left = 0
auto_increment=1" '.Top = 0
Else '.Width = Me.Width - 100
rsBantu.MoveLast If .Rows > 1 Then
SQLUpdate = "ALTER table TYPERUANGAN .Row = 1
auto_increment=" & rsBantu.Fields("ID_TYPE") + 1 .RowSel = 1
End If End If
.ColWidth(0, 0) = TextWidth("ID. TYPE") * 1.2
ConRumahSakit.Execute (SQLUpdate) .ColWidth(1, 0) = TextWidth("NAMA TYPE") *
1.75
If flxFloat.Row = flxFloat.Rows - 1 Then .ColWidth(2, 0) = TextWidth("TARIF/HARI") *
sKode = flxFloat.TextMatrix(flxFloat.Row - 1, 0) 1.3
ElseIf flxFloat.Row + 1 <= flxFloat.Rows - 1 Then
sKode = flxFloat.TextMatrix(flxFloat.Row + 1, 0) .ColAlignment(0) = flexAlignCenterCenter
Else .ColAlignment(2) = flexAlignRightCenter
sKode = "" End With
End If End Sub
SelectRecord
cariBrsAktif flxFloat, 0, sKode, "{RIGHT}{LEFT}" Private Sub Form_Load()
End Sub Me.adoBrowser.ConnectionString = strCon
If IsNull(sKode) Then sKode = ""
Private Sub NewTypeRuangan()
SQLInsert = "Insert into TypeRuangan Values (0,'','')" Me.txtEdit.ZOrder

ConRumahSakit.Execute (SQLInsert) SelectRecord

Set rsBantu = Nothing CenterWindow Me

rsBantu.Open "Select ID_TYPE from Bayangan Shadow, Me
TYPERUANGAN order by ID_TYPE",
ConRumahSakit, adOpenStatic, adLockReadOnly Me.Visible = False
rsBantu.MoveLast Transparent Me, 220
ID_TYPE = rsBantu.Fields("ID_TYPE") Me.Visible = False
SelectRecord "Where `ID_TYPE`=" & ID_TYPE
UpdMaster AturWarna Me
End Sub Me.BackColor = LatarGrid
End Sub
Private Sub flxFloat_LeaveCell()
With flxFloat Private Sub tblDelete_Click()
.BackColor = LatarGrid flxFloat_KeyDown 46, 0
.ForeColor = HurufGrid End Sub
End With
End Sub Private Sub tblEdit_Click()
UpdMaster
Private Sub Form_Activate() End Sub
If sKode <> "" And flxFloat.Enabled = True Then
SelectRecord Private Sub tblNew_Click()
cariBrsAktif flxFloat, 1, sKode, flxfloat_KeyPress 14
"{RIGHT}{LEFT}" End Sub
sKode = ""
End If 6. form spesialisasi
End Sub
Public sKode As String, nTag As Byte, Dipilih As
Private Sub Form_KeyPress(KeyAscii As Integer) Boolean
Select Case KeyAscii Private Shadow As clsShadow
Private rsSpesialisasi As New ADODB.Recordset Private Sub flxFloat_KeyDown(KeyCode As Integer,
Shift As Integer)
Private Sub IncrSearch() Select Case KeyCode
SelectRecord "Where SPESIALISASI Like '%" & 'Case 38, 40
sKode & "%' " ' Me.flxFloat.RowSel = Me.flxFloat.Row
End Sub Case 46
DelSpesialis
Private Sub SelectRecord(Optional ByVal sCriteria As Case Else
String) 'sFiltGrup = KeyCode
On Error Resume Next End Select
SQLSelect = "Select LPAD(ID_SPESIALISASI, 2, '0' End Sub
) AS `ID. `, " & _
"SPESIALISASI from SPESIALISASI " & sCriteria Private Sub flxfloat_KeyPress(KeyAscii As Integer)
& " Order by ID_SPESIALISASI" Select Case KeyAscii
Set rsSpesialisasi = Nothing Case 8 'Ctrl+H
rsSpesialisasi.Open SQLSelect, ConRumahSakit, If Len(Me.lblCari) > 0 Then
adOpenStatic, adLockReadOnly Me.lblCari = Left(Me.lblCari,
If rsSpesialisasi.EOF Then Len(Me.lblCari) - 1)
SQLSelect = "Select '' as `ID. SPESIALISASI`, '' as sKode = Me.lblCari
`SPESIALISASI`" IncrSearch
Set rsSpesialisasi = Nothing End If
rsSpesialisasi.Open SQLSelect, ConRumahSakit, Case 13 'Enter
adOpenStatic, adLockReadOnly If nTag = 0 Then
End If UpdMaster
Else
flxFloat.MousePointer = vbHourglass Dipilih = True
sKode =
rsSpesialisasi.Requery Me.flxFloat.TextMatrix(Me.flxFloat.Row, 0) & "-" & _
Set Me.flxFloat.DataSource = rsSpesialisasi Me.flxFloat.TextMatrix(Me.flxFloat.Row, 1)
Me.flxFloat.Refresh Me.lblCari = ""
FlxFloatFormat Me.Hide
flxFloat.MousePointer = vbDefault End If
End Sub Case 14 'Ctrl+N
NewSpesialis
Private Sub flxFloat_Click() Case 24 'Ctrl+X
If flxFloat.Rows = 1 Then Exit Sub sKode = ""
If nTag = 1 Then Me.lblCari = ""
Dipilih = True Case 26 'Ctrl+Z
sKode = Me.flxFloat.TextMatrix(Me.flxFloat.Row, sKode = ""
0) & "-" & _ Me.lblCari = ""
Me.flxFloat.TextMatrix(Me.flxFloat.Row, 1) SelectRecord
Me.Hide Case 27
End If Dipilih = False
End Sub Me.Hide
Case 0 To 31
Private Sub UpdMaster() 'Me.Label3 = KeyAscii
flxFloat.Col = 1 Case Else
txtEdit = flxFloat sKode = sKode & Chr(KeyAscii)
flxFloat.Enabled = False Me.lblCari = sKode
txtEdit.SelStart = 1000 IncrSearch
' Show Edt at the right place. End Select
txtEdit.Move flxFloat.Left + flxFloat.CellLeft, End Sub
flxFloat.CellTop + flxFloat.Top, _
flxFloat.CellWidth, flxFloat.CellHeight Private Sub DelSpesialis()
If Me.flxFloat.Rows = 0 Then Exit Sub
txtEdit.Visible = True sID_SPESIALISASI =
txtEdit.Alignment = vbLeftJustify flxFloat.TextMatrix(flxFloat.Row, 0)
' And let it work. sSpesialisasi = flxFloat.TextMatrix(flxFloat.Row, 1)
txtEdit.SetFocus
SendKeys ("^{HOME}+{END}"), 50 SQLSelect = "Select ID_SPESIALISASI from
End Sub register where ID_SPESIALISASI='" &
sID_SPESIALISASI & "'"
 Set rsBantu = Nothing sID_SPESIALISASI =
rsBantu.Open SQLSelect, ConRumahSakit, rsBantu.Fields("ID_SPESIALISASI")
adOpenStatic, adLockReadOnly SelectRecord "WHERE ID_SPESIALISASI=" &
If Not rsBantu.EOF Then sID_SPESIALISASI
WarningBox "Spesialisasi belum bisa dihapus UpdMaster
karena sudah dipakai pada file Register", 0 Me.lblCari = ""
Exit Sub End Sub
End If
Private Sub flxFloat_LeaveCell()
Jawab = DialogBox("Yakin ingin menghapus With flxFloat
Spesialisasi : " & vbCrLf & _ .BackColor = LatarGrid
sID_SPESIALISASI & "-" & sSpesialisasi) .ForeColor = HurufGrid
If Jawab = vbNo Then Exit Sub End With
End Sub
SQLDelete = "Delete from Spesialisasi where
ID_SPESIALISASI='" & sID_SPESIALISASI & "'" Private Sub Form_Activate()
If sKode <> "" And flxFloat.Enabled = True Then
ConRumahSakit.Execute (SQLDelete) SelectRecord
cariBrsAktif flxFloat, 1, sKode,
SQLSelect = "Select ID_SPESIALISASI from "{RIGHT}{LEFT}"
SPESIALISASI order by ID_SPESIALISASI" sKode = ""
Set rsBantu = Nothing End If
rsBantu.Open SQLSelect, ConRumahSakit, End Sub
adOpenStatic, adLockReadOnly
If rsBantu.EOF Then Private Sub Form_KeyPress(KeyAscii As Integer)
SQLUpdate = "ALTER table SPESIALISASI Select Case KeyAscii
auto_increment=1" Case 27
Else Dipilih = False
rsBantu.MoveLast Me.Hide
SQLUpdate = "ALTER table SPESIALISASI End Select
auto_increment=" & End Sub
rsBantu.Fields("ID_SPESIALISASI") + 1
End If Private Sub FlxFloatFormat()
With flxFloat
ConRumahSakit.Execute (SQLUpdate) '.Left = 0
'.Top = 0
If flxFloat.Row = flxFloat.Rows - 1 Then .Width = Me.Width - 100
sKode = flxFloat.TextMatrix(flxFloat.Row - 1, 0) If .Rows > 1 Then
ElseIf flxFloat.Row + 1 <= flxFloat.Rows - 1 Then .Row = 1
sKode = flxFloat.TextMatrix(flxFloat.Row + 1, 0) .RowSel = 1
Else End If
sKode = "" .ColAlignmentFixed(0) = flexAlignCenterCenter
End If .ColAlignment(0) = flexAlignCenterCenter
SelectRecord .ColWidth(0, 0) = 1650
cariBrsAktif flxFloat, 0, sKode, "{RIGHT}{LEFT}" .ColWidth(1, 0) = 5000
End Sub End With
End Sub
Private Sub NewSpesialis()
Jawab = DialogBox("Yakin ingin membuat Private Sub Form_Load()
Spesialisasi Baru ?") Me.adoBrowser.ConnectionString = strCon
If Jawab = vbNo Then Exit Sub If IsNull(sKode) Then sKode = ""

SQLInsert = "Insert into SPESIALISASI Values SelectRecord

(0,'')"
CenterWindow Me
ConRumahSakit.Execute (SQLInsert) Bayangan Shadow, Me

Set rsBantu = Nothing Me.Visible = False

rsBantu.Open "Select ID_SPESIALISASI from Transparent Me, 220
SPESIALISASI order by ID_SPESIALISASI", Me.Visible = False
ConRumahSakit, adOpenStatic, adLockReadOnly
rsBantu.MoveLast AturWarna Me
 Me.BackColor = LatarGrid Else
End Sub sCriteria = "Where NIK Like '" & sKode & "%'"
End If
Private Sub txtEdit_KeyDown(KeyCode As Integer, SelectRecord sCriteria
Shift As Integer) End Sub

' Standard edit control processing. Private Sub SelectRecord(Optional ByVal sCriteria As
Select Case KeyCode String)
Dim rsPasien As New ADODB.Recordset
Case 27 ' ESC: hide, return focus to flxFloat.
txtEdit.Visible = False SQLSelect = "SELECT a.NO_RM as `NO. RM`,
Me.flxFloat.Enabled = True a.NAMAPASIEN AS `NAMA PASIEN`, a.NIK, " &
Me.flxFloat.SetFocus vbCrLf & _
"CASE WHEN a.JENKEL=1 then 'L' " & vbCrLf & _
Case 13 ' ENTER return focus to flxFloat. " WHEN a.JENKEL=2 then 'P' " & vbCrLf & _
Me.flxFloat.Col = 0 " Else '-' " & vbCrLf & _
sID_SPESIALISASI = flxFloat "END as `JENKEL`,
SQLSave = "Update SPESIALISASI set DATE_FORMAT(a.TGLLAHIR,'%d-%m-%Y') as
SPESIALISASI='" & Me.txtEdit & _ `TGL. LAHIR`, " & vbCrLf & _
"' Where ID_SPESIALISASI='" & "a.ALAMAT,
sID_SPESIALISASI & "'" Concat(LPAD(a.ID_PEKERJAAN,2,'0'),'-
',b.NAMAPEKERJAAN) as `PEKERJAAN`," &
ConRumahSakit.Execute (SQLSave) vbCrLf & _
"CASE WHEN a.STATUSNIKAH=1 THEN
flxFloat.TextMatrix(flxFloat.Row, 1) = Me.txtEdit 'BELUM MENIKAH' " & vbCrLf & _
" WHEN a.STATUSNIKAH=2 THEN 'SUDAH
Me.txtEdit.Visible = False MENIKAH' " & vbCrLf & _
Me.flxFloat.Enabled = True " WHEN a.STATUSNIKAH=3 THEN 'CERAI
Me.flxFloat.SetFocus HIDUP' " & vbCrLf & _
Me.flxFloat.Col = 1 " WHEN a.STATUSNIKAH=4 THEN 'CERAI
End Select MATI' " & vbCrLf & _
End Sub " Else '-' " & vbCrLf & _
"END AS `STATUS NIKAH`, " & vbCrLf & _
Private Sub tblDelete_Click() "CASE WHEN a.AGAMA=1 THEN 'ISLAM' " &
flxFloat_KeyDown 46, 0 vbCrLf & _
End Sub " WHEN a.AGAMA=2 THEN 'KATHOLIK' " &
vbCrLf & _
Private Sub tblEdit_Click() " WHEN a.AGAMA=3 THEN 'PROTESTAN' " &
UpdMaster vbCrLf & _
End Sub " WHEN a.AGAMA=4 THEN 'HINDU' " & vbCrLf
&_
Private Sub tblNew_Click() " WHEN a.AGAMA=5 THEN 'BUDHA' " &
flxfloat_KeyPress 14 vbCrLf & _
End Sub " WHEN a.AGAMA=6 THEN 'KONG HU CHU' "
& vbCrLf & _
7. form Data Pasien " Else '-' " & _
Public sKode As String, sField As String, Dipilih As "END AS `AGAMA`, a.NO_TELP_HP as `NO.
Boolean TELP/HP` , a.NAMAIBU as `NAMA IBU`, " & vbCrLf
Public nTag As Byte, NO_RM As String, Pasien As &_
String "a.ENTRYDATE, a.OPERATOR1,
Private sCriteria As String a.LASTUPDATE, a.OPERATOR2 " & vbCrLf & _
Private Shadow As clsShadow "FROM Pasien a LEFT JOIN Pekerjaan b ON
Private aFieldName() As String a.ID_PEKERJAAN=b.ID_PEKERJAAN " & sCriteria
Private aValue() As String, JmlField As Byte &_
" Order by " & sField
Private Sub IncrSearch()
If sField = "NO_RM" Then Debug.Print SQLSelect
sCriteria = "Where NO_RM Like '" & sKode & Set rsPasien = Nothing
"%'" rsPasien.Open SQLSelect, ConRumahSakit,
ElseIf sField = "NAMAPASIEN" Then adOpenStatic, adLockReadOnly
sCriteria = "Where NAMAPASIEN Like '%" & If rsPasien.EOF Then
sKode & "%'" SQLSelect = "SELECT '' AS `NO. RM`, " & _