frmserappoinmnetcharges.frm

国外的医院管理系统。基于水晶报表。Crystal Hospital Management System

      TabIndex        =   26
      Top             =   1830
      Width           =   1245
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Patient Code :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   1320
      TabIndex        =   25
      Top             =   1815
      Width           =   1350
   End
   Begin VB.Label lblManTitle 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00000080&
      BackStyle       =   0  'Transparent
      Caption         =   "OUT PATIENT MEDICAL SERVICE APPOINTMENTS BILL PAYMENTS"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   435
      Left            =   240
      TabIndex        =   24
      Top             =   360
      Width           =   13275
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Bill Date :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   9720
      TabIndex        =   23
      Top             =   1215
      Width           =   930
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Service Charges :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   2400
      TabIndex        =   22
      Top             =   2880
      Width           =   1710
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Hospital Charges : "
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   9180
      TabIndex        =   21
      Top             =   2880
      Width           =   1830
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Net Value :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   9960
      TabIndex        =   20
      Top             =   3420
      Width           =   1050
   End
End
Attribute VB_Name = "frmSerAppoinmnetCharges"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Public Function setFormData()
    
    dtpPayDate.Value = Now
    dtpDDDate.Value = Now
    txtBillDate = Format(Date, "MM/DD/YYYY")
    txtPatientID.Text = BillPatientID
    txtBillNo.Text = AppBillID
    txtDorS_Amount.Text = strAmount
    txtHospitalCharges.Text = HospitalCharge
    txtDiscount.Text = Discount
    
    txtBillAmt = GrandTotal
    txtNetValue = Val(txtBillAmt) - Val(txtDiscount)
    
    
    txtDDNo.Text = ""
    txtDDNo.Locked = True
    cmbBank.Locked = True
    dtpDDDate.Enabled = False
    
End Function

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdsave_click()
Dim str As String
Dim BillPayID As String
Dim RowNo As Integer
Dim rsAddBill As New Recordset


RowNo = 1

If txtPayingAmt.Text = "" Then
    MsgBox "Paying Amount Not Found...", vbCritical + vbOKOnly
    txtPayingAmt.SetFocus
    Exit Sub
End If

If optCash.Value = True Then
    str = "CASH"
ElseIf optDD.Value = True Then
    str = "DD"
ElseIf optCheque.Value = True Then
    str = "Cheque"
Else
    str = "Others"
End If


    Set rsAddBill = New ADODB.Recordset
    BillPayID = Functions.UID(6, "PayID_")

    rsAddBill.Open "Select * from Service_Appointment_Bill_Payment", cnPatients, adOpenKeyset, adLockPessimistic
      
    While rsAddBill.EOF = False
        If rsAddBill(0) = BillPayID Then
            BillPayID = Functions.UID(6, "PayID_")
           rsAddBill.MoveFirst
        Else
            
        End If
     
    rsAddBill.MoveNext
    
    Wend




If MsgBox("Confirm To Save Bill Information ?", vbQuestion + vbYesNo) = vbYes Then
      
    If optCash.Value = True Then
        cnPatients.Execute ("Insert into Service_Appointment_Bill_Payment values('" & BillPayID & "','" & txtBillNo & "'," & Val(txtPayingAmt.Text) & ",'" & Format(dtpPayDate.Value, "mm/dd/yy") & "','" & str & "',Null,Null,Null)")
        MFG.TextMatrix(RowNo, 0) = RowNo
        MFG.TextMatrix(RowNo, 1) = Val(txtPayingAmt.Text)
        MFG.TextMatrix(RowNo, 2) = Format(dtpPayDate.Value, "dd-MMM-yyyy")
        MFG.TextMatrix(RowNo, 3) = str
        RowNo = RowNo + 1
        MFG.Rows = MFG.Rows + 1
        cmdSave.Enabled = False
        cmdPrint.Enabled = True
    Else
        If txtDDNo.Text = "" Or cmbBank.Text = "" Then
            MsgBox "DD Number or Bank Name Not Found...", vbCritical + vbOKOnly
            txtDDNo.SetFocus
            Exit Sub
        End If
        con.Execute ("Insert into Service_Appointment_Bill_Payment values(" & BillPayID & "," & txtBillNo & "," & Val(txtPayingAmt.Text) & ",'" & Format(dtpPayDate.Value, "mm/dd/yy") & "','" & str & "','" & txtDDNo.Text & "','" & Format(dtpDDDate.Value, "mm/dd/yy") & "','" & cmbBank.Text & "')")
        MFG.TextMatrix(RowNo, 0) = RowNo
        MFG.TextMatrix(RowNo, 1) = Val(txtPayingAmt.Text)
        MFG.TextMatrix(RowNo, 2) = Format(dtpPayDate.Value, "dd-MMM-yyyy")
        MFG.TextMatrix(RowNo, 3) = str
        MFG.TextMatrix(RowNo, 4) = txtDDNo.Text
        MFG.TextMatrix(RowNo, 5) = Format(dtpDDDate.Value, "dd-MMM-yyyy")
        MFG.TextMatrix(RowNo, 6) = cmbBank.Text
        RowNo = RowNo + 1
        MFG.Rows = MFG.Rows + 1
        cmdSave.Enabled = False
        cmdPrint.Enabled = True
    End If
  


End If



End Sub

Private Sub Command1_Click()
Dim strReport As String
Dim strTXT As String
strTXT = cmbBillNo.Text
strReport = App.Path & "\Reports\OPSInvoice.rpt"

SerInvoice.ReportFileName = App.Path & "\Reports\OPSInvoice.rpt"
SerInvoice.DiscardSavedData = True
SerInvoice.ReplaceSelectionFormula ("{Service_Appointment_Bill_Payment.Appointment_Bill_ID} = '" & strTXT & "'")

SerInvoice.WindowState = crptMaximized
SerInvoice.Action = 1
End Sub

Private Sub Form_Load()
Call Functions.DisableMenu
Me.WindowState = vbMaximized
Call setFormData
Call Refresh_Data
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 22 Then KeyAscii = 0: Exit Sub
    KeyAscii = DataEntryValidation(KeyAscii, ActiveControl.Tag)
End Sub


Private Sub Refresh_Data()


Dim i As Integer
i = 0

MFG.clear
MFG.ColWidth(0) = 1000
MFG.ColAlignment(0) = 4
For i = 1 To 6 Step 1
    MFG.ColWidth(i) = 2000
    MFG.ColAlignment(i) = 4
Next i
MFG.TextMatrix(0, 0) = "REC NO"
MFG.TextMatrix(0, 1) = "AMOUNT PAID"
MFG.TextMatrix(0, 2) = "PAID DATE"
MFG.TextMatrix(0, 3) = "PAY TYPE"
MFG.TextMatrix(0, 4) = "DD/CHEQUE NO"
MFG.TextMatrix(0, 5) = "DD DATE"
MFG.TextMatrix(0, 6) = "BANK"





End Sub

Private Sub Label12_Click()

End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Functions.EnableMenu
End Sub

Private Sub optCash_Click()
If optCash.Value = True Then
    txtDDNo.Text = ""
    txtDDNo.Locked = True
    cmbBank.Locked = True
    dtpDDDate.Enabled = False
Else
    txtDDNo.Locked = False
    cmbBank.Locked = False
    dtpDDDate.Enabled = True
End If
End Sub

Private Sub optCheque_Click()
If optCheque.Value = True Then
    txtDDNo.Locked = False
    cmbBank.Locked = False
    dtpDDDate.Enabled = True
Else
    txtDDNo.Text = ""
    txtDDNo.Locked = True
    cmbBank.Locked = True
    dtpDDDate.Enabled = False
End If
End Sub

Private Sub optDD_Click()
If optDD.Value = True Then
    txtDDNo.Locked = False
    cmbBank.Locked = False
    dtpDDDate.Enabled = True
Else
    txtDDNo.Text = ""
    txtDDNo.Locked = True
    cmbBank.Locked = True
    dtpDDDate.Enabled = False
End If
End Sub

Private Sub optOthers_Click()
If optOthers.Value = True Then
    txtDDNo.Locked = False
    cmbBank.Locked = False
    dtpDDDate.Enabled = True
Else
    txtDDNo.Text = ""
    txtDDNo.Locked = True
    cmbBank.Locked = True
    dtpDDDate.Enabled = False
End If
End Sub

Private Sub txtCustomerAdv_Change()

End Sub

Private Sub txtPaidAmt_Change()

End Sub

Private Sub txtPayingAmt_KeyPress(KeyAscii As Integer)
Dim str As String
str = "0123456789."
If KeyAscii = 13 And txtPayingAmt.Text <> "" Then
    cmdSave.SetFocus
End If
If InStr(str, Chr(KeyAscii)) = 0 And KeyAscii <> 8 Then
    KeyAscii = 0
End If
End Sub

Private Sub txtPayingAmt_LostFocus()
If txtPayingAmt.Text <> "" Then
    If Val(txtPayingAmt.Text) = 0 Then
        MsgBox "Paying Amount Cannot Be Zero...", vbInformation + vbOKOnly
        txtPayingAmt.SetFocus
        Exit Sub
    End If
    If Val(txtPayingAmt.Text) > Val(txtNetValue.Text) Then
        MsgBox "Paying Amount Cannot Be Greater Than Total Amount...", vbCritical + vbOKOnly
        txtPayingAmt.Text = ""
        txtPayingAmt.SetFocus
        Exit Sub
    End If
     txtBalAmt.Text = Round((Val(txtNetValue.Text) - Val(txtPayingAmt.Text)), 2)
     
    If Val(txtBalAmt.Text) = 0 Then
    txtBillStatus.Text = "Paid"
        Else
    txtBillStatus.Text = "Un-Paid"
    End If
End If
End Sub