📄 frmappoinmnetcharges.frm
字号:
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 = 720
TabIndex = 19
Top = 1560
Width = 1350
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00C96C59&
BackStyle = 0 'Transparent
Caption = "Bill Number :"
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 = 8880
TabIndex = 18
Top = 1590
Width = 1245
End
Begin VB.Line Line1
BorderColor = &H00C0FFFF&
BorderWidth = 2
X1 = 510
X2 = 12120
Y1 = 1965
Y2 = 1950
End
Begin VB.Line Line2
BorderColor = &H00C0FFFF&
BorderWidth = 2
X1 = 510
X2 = 12120
Y1 = 1380
Y2 = 1380
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H00C96C59&
BackStyle = 0 'Transparent
Caption = "Discount :"
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 = 6120
TabIndex = 17
Top = 3180
Width = 960
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H00C96C59&
BackStyle = 0 'Transparent
Caption = "Bill Amount :"
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 = 2280
TabIndex = 16
Top = 3180
Width = 1230
End
Begin VB.Shape Shape1
BackColor = &H00FFFFFF&
BorderColor = &H00C0FFFF&
BorderWidth = 2
Height = 1305
Left = 600
Shape = 4 'Rounded Rectangle
Top = 2400
Width = 11565
End
Begin VB.Label Label11
AutoSize = -1 'True
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "BILL PAYMENT DETAILS :"
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 = 720
TabIndex = 15
Top = 3900
Width = 2385
End
Begin VB.Line Line3
BorderColor = &H00C0FFFF&
BorderWidth = 2
X1 = 480
X2 = 12120
Y1 = 6375
Y2 = 6360
End
End
Attribute VB_Name = "frmAppoinmnetCharges"
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 cmdPrint_Click()
Dim strReport As String
Dim strTXT As String
strTXT = txtBillNo.Text
strReport = App.Path & "\Reports\OPDocInvoice.rpt"
DocInvoice.ReportFileName = App.Path & "\Reports\OPDocInvoice.rpt"
DocInvoice.DiscardSavedData = True
DocInvoice.ReplaceSelectionFormula ("{Appointment_Bill_Payment.Appointment_Bill_ID} = '" & strTXT & "'")
DocInvoice.WindowState = crptMaximized
DocInvoice.Action = 1
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 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 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 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 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -