📄 frmfeeslist.frm
字号:
Width = 840
End
End
Begin VB.Frame fraCtl
Height = 615
Left = 30
TabIndex = 4
Top = 6870
Width = 11835
Begin VB.CheckBox chkfylb
Caption = "费用类别"
Height = 300
Left = 9360
TabIndex = 30
Top = 270
Width = 1095
End
Begin VB.CheckBox chkPrintGrid
Caption = "打印网格"
Height = 300
Left = 8280
TabIndex = 29
ToolTipText = "綦江脑血管医院首次提出!"
Top = 270
Width = 1020
End
Begin VB.CheckBox chkGg
Caption = "规格"
Height = 300
Left = 7500
TabIndex = 28
Top = 270
Width = 660
End
Begin VB.CommandButton cmdReturn
Caption = "返回(&R)"
Height = 350
Left = 6120
TabIndex = 10
Top = 180
Width = 1200
End
Begin VB.CommandButton cmdPrint
Caption = "打印(&P)"
Height = 350
Left = 2502
TabIndex = 9
Top = 180
Width = 1200
End
Begin VB.CommandButton cmdQuery
Caption = "查询(&F)"
Height = 350
Left = 90
TabIndex = 8
Top = 180
Width = 1200
End
Begin VB.CommandButton cmdFyLb
Caption = "类别合计(&L)"
Height = 350
Left = 1296
TabIndex = 7
Top = 180
Width = 1200
End
Begin VB.CommandButton cmdFbDy
Caption = "费别打印(&V)"
Height = 350
Left = 3708
TabIndex = 6
Top = 180
Width = 1200
End
Begin VB.CommandButton cmdKsPrint
Caption = "科室打印(&K)"
Height = 350
Left = 4914
TabIndex = 5
Top = 180
Width = 1200
End
End
Begin VB.Frame fraSub
Height = 2775
Left = 30
TabIndex = 2
Top = 4050
Width = 11835
Begin FPSpread.vaSpread vasfbhj
Height = 2460
Left = 90
TabIndex = 3
Top = 210
Width = 11775
_Version = 196608
_ExtentX = 20770
_ExtentY = 4339
_StockProps = 64
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MaxCols = 4
MaxRows = 1
OperationMode = 1
SpreadDesigner = "frmFeesList.frx":0511
End
End
Begin VB.ComboBox cmbCyRq
Height = 300
Left = 8970
TabIndex = 1
Top = 2310
Visible = 0 'False
Width = 1455
End
Begin VB.ComboBox cmbInDate
Height = 300
Left = 8970
TabIndex = 0
Top = 1980
Visible = 0 'False
Width = 1455
End
End
Attribute VB_Name = "frmFeesList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmbDepart_Click()
Dim rstData As New ADODB.Recordset
Dim strSQL As String
Select Case cmbPatiStatus.Text
Case "在院"
strSQL = "Select Blh,HzXm,RyRq,CyRq From Zy_BlSy Where (CyKs='" & cmbDepart.Text & "' or ryks='" & cmbDepart.Text & "') And (PatiStatus In (1,3)) Order By Blh "
Case "出院"
strSQL = "Select Blh,HzXm,RyRq,CyRq From Zy_BlSy Where (CyKs='" & cmbDepart.Text & "' or ryks='" & cmbDepart.Text & "') And PatiStatus='2' Order By Blh "
End Select
rstData.Open strSQL, gcnnDatabase, adOpenStatic, adLockReadOnly
cmbPatiNoList.Clear
cmbPatiNameList.Clear
cmbInDate.Clear
cmbCyRq.Clear
If rstData.EOF Then
rstData.Close
Set rstData = Nothing
Exit Sub
End If
rstData.MoveFirst
While Not rstData.EOF
cmbPatiNoList.AddItem Trim(rstData!Blh)
cmbPatiNameList.AddItem Trim(rstData!HZXM & "")
cmbInDate.AddItem Format(rstData!Ryrq, "yyyy-MM-dd HH:mm:ss")
cmbCyRq.AddItem Format(rstData!Cyrq, "yyyy-MM-dd HH:mm:ss")
rstData.MoveNext
Wend
rstData.Close
Set rstData = Nothing
End Sub
Private Sub cmbPatiNameList_Click()
If cmbPatiNameList.ListIndex <> -1 Then
cmbPatiNoList.ListIndex = cmbPatiNameList.ListIndex
cmbInDate.ListIndex = cmbPatiNameList.ListIndex
cmbCyRq.ListIndex = cmbPatiNameList.ListIndex
dtpBegin.value = Format(cmbInDate.Text, "yyyy-MM-dd 00:00:00")
End If
If cmbPatiStatus.Text = "出院" Or cmbPatiStatus.Text = "结算" Then
dtpEnd.value = Format(cmbCyRq.Text, "yyyy-MM-dd HH:mm:ss")
Else
dtpEnd.value = Format(Date, "yyyy-MM-dd 23:59:59")
End If
End Sub
Private Sub cmbPatiNoList_Click()
If cmbPatiNameList.ListCount > 0 Then
cmbPatiNameList.ListIndex = cmbPatiNoList.ListIndex
cmbInDate.ListIndex = cmbPatiNoList.ListIndex
cmbCyRq.ListIndex = cmbInDate.ListIndex
dtpBegin.value = Format(cmbInDate.Text, "yyyy-MM-dd HH:mm:ss")
End If
If cmbPatiStatus.Text = "出院" Or cmbPatiStatus.Text = "结算" Then
dtpEnd.value = Format(cmbCyRq.Text, "yyyy-MM-dd HH:mm:ss")
Else
dtpEnd.value = Format(Date, "yyyy-MM-dd 23:59:59")
End If
End Sub
Private Sub cmbPatiNoList_KeyPress(KeyAscii As Integer)
Dim strSQL As String
Dim rs As New ADODB.Recordset
Dim strBlh As String
Dim strPatiStatus As String
If KeyAscii = vbKeyReturn And cmbPatiNoList.Text <> "" Then
If cmbPatiStatus.Text = "" Then
MsgBox "提示:请选择状态.", vbInformation + vbOKOnly
Exit Sub
End If
If cmbDepart.Text = "" Then
MsgBox "提示:请选择科室.", vbInformation + vbOKOnly
Exit Sub
End If
VaSpPati.MaxRows = 0
strBlh = Format(cmbPatiNoList, "000000")
strSQL = "Select HzXm,RyRq,CyRq,PatiStatus From Zy_BlSy Where Blh='" & strBlh & "' And CyKs='" & cmbDepart.Text & "' "
If cmbPatiStatus.Text = "在院" Then
strSQL = strSQL & " And PatiStatus In(1,3) "
Else
strSQL = strSQL & " And PatiStatus=2 "
End If
rs.Open strSQL, gcnnDatabase, adOpenForwardOnly, adLockReadOnly
If rs.RecordCount > 0 Then
cmbPatiNameList.Text = rs!HZXM
dtpBegin.value = Format(rs!Ryrq, "yyyy-MM-dd HH:mm:ss")
If rs!PatiStatus = 2 Then
dtpEnd.value = Format(rs!Cyrq, "yyyy-MM-dd HH:mm:ss")
Else
dtpEnd.value = Format(jdFunction.jdGetServerTime(), "yyyy-MM-dd HH:mm:ss")
End If
End If
rs.Close
End If
End Sub
Private Sub cmbPatiStatus_Click()
Call cmbDepart_Click
End Sub
Private Sub cmdfbdy_Click()
vasfbhj.PrintAbortMsg = "正在打印.... - 单击[取消]退出"
vasfbhj.PrintJobName = "费别清单信息打印"
vasfbhj.PrintHeader = "/n/l/fn""宋体""/fz""7""/fb1费别清单信息打印 " & cmbDepart.Text & _
"(" & cmbPatiNoList.Text & ")" & cmbPatiNameList.Text & "从" & Format(dtpBegin.value, "yyyy-MM-dd") & "至" & _
Format(dtpEnd.value, "yyyy-MM-dd") & "/n"
vasfbhj.PrintFooter = "/n/c/fn""宋体""/fz""7""/fb1" & "第 /p 页/n/n/n"
vasfbhj.GridShowHoriz = True
vasfbhj.PrintBorder = True
vasfbhj.PrintColHeaders = True
vasfbhj.PrintColor = True
vasfbhj.PrintGrid = IIf(Me.chkPrintGrid.value = 1, True, False)
vasfbhj.FontSize = 10
vasfbhj.PrintMarginTop = 0
vasfbhj.PrintMarginBottom = 0
vasfbhj.PrintMarginLeft = 0
vasfbhj.PrintMarginRight = 0
vasfbhj.PrintType = 0
vasfbhj.PrintType = SS_PRINT_ALL
vasfbhj.PrintRowHeaders = True
vasfbhj.PrintShadows = False
vasfbhj.PrintUseDataMax = True
' Perform the printing action
vasfbhj.Action = SS_ACTION_PRINT
vasfbhj.SetFocus
End Sub
Private Sub cmdfylb_Click()
vasfbhj.MaxRows = 0
Dim strSQL As String
Dim rstData As New ADODB.Recordset
If cmbPatiNoList.Text <> "" And IsDate(dtpBegin.value) And IsDate(dtpEnd.value) Then
'查询单个人
strSQL = "Select Top 1 RyRq,CyRq,HzXm From Zy_BlSy Where Blh='" & cmbPatiNoList.Text & "' Order By RyRq Desc"
rstData.Open strSQL, gcnnDatabase, adOpenForwardOnly, adLockReadOnly, adCmdText
Else
MsgBox "请填写病历号", vbInformation + vbOKOnly
Exit Sub
End If
If Not rstData.EOF Then
Call FndRen(cmbPatiNoList.Text, dtpBegin.value, dtpEnd.value)
Exit Sub
Else
MsgBox "没有该病历号患者的入院信息", vbInformation + vbOKOnly
End If
rstData.Close
Set rstData = Nothing
End Sub
Private Sub cmdKsPrint_Click()
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim sql As String
Dim g As Integer
Dim n As Integer
Dim m As Integer
Dim curYj As Currency
Dim curFy As Currency
If Trim(cmbDepart.Text) = "" Then
MsgBox "请选择科室.", vbInformation + vbOKOnly
Exit Sub
End If
sql = "Select Blh,HzXm From Zy_BlSy Where PatiStatus=1 And CyKs='" & cmbDepart.Text & "' "
rs1.Open sql, gcnnDatabase, adOpenForwardOnly, adLockReadOnly
For m = 1 To rs1.RecordCount
VaSpPati.MaxRows = 0
sql = " Select Bill.Info,Bill.Dj,Bill.Sl,Bill.Dw,Bill.FyRq,Bill.Hjje,BfZd1.FeesLevel From Bill,BfZd1" & _
" Where Bill.Blh='" & rs1!Blh & "' And Bill.FyRq<='" & Format(dtpEnd.value, "yyyy-MM-dd 23:59:59") & "' And Bill.FyRq>='" & Format(dtpBegin.value, "yyyy-MM-dd 00:00:00") & "' And (Bill.JfBz=3 or Bill.JfBz=4) And Bill.th in(0,2,3) And Bill.ypid=BfZd1.bfzd01 Order By Bill.FyRq"
rs.Open sql, gcnnDatabase, adOpenStatic, adLockReadOnly
If rs.RecordCount > 0 Then
g = rs.RecordCount Mod 2
If g <> 0 Then
VaSpPati.MaxRows = Fix(rs.RecordCount / 2) + 2
Else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -