门诊日收入对比查询.frm
来自「这是一个医院管理系统中的院长查询模块」· FRM 代码 · 共 404 行
FRM
404 行
VERSION 5.00
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Object = "{02B5E320-7292-11CF-93D5-0020AF99504A}#1.0#0"; "MSCHART.OCX"
Begin VB.Form frmClinicDayQuery
BackColor = &H00C0C000&
BorderStyle = 0 'None
Caption = "请您输入报表日期"
ClientHeight = 6885
ClientLeft = 1155
ClientTop = 1590
ClientWidth = 9540
BeginProperty Font
Name = "隶书"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Icon = "门诊日收入对比查询.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 6885
ScaleWidth = 9540
ShowInTaskbar = 0 'False
WindowState = 2 'Maximized
Begin VB.Frame Frame1
BackColor = &H00C0C000&
BorderStyle = 0 'None
Height = 615
Left = 975
TabIndex = 2
Top = 7995
Width = 8415
Begin VB.CommandButton Command2
BackColor = &H00C0C0C0&
Cancel = -1 'True
Caption = "返回&Q"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 7110
MaskColor = &H00FFFFFF&
Style = 1 'Graphical
TabIndex = 5
Top = 90
UseMaskColor = -1 'True
Width = 1095
End
Begin VB.CommandButton Command3
BackColor = &H00C0C0C0&
Caption = "刷新图表&S"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 4320
MaskColor = &H00FFFFFF&
Style = 1 'Graphical
TabIndex = 4
Top = 90
UseMaskColor = -1 'True
Width = 1635
End
Begin VB.CommandButton Command1
BackColor = &H00C0C0C0&
Caption = "打印"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5970
MaskColor = &H00FFFFFF&
Style = 1 'Graphical
TabIndex = 3
Top = 90
UseMaskColor = -1 'True
Width = 1095
End
Begin MSMask.MaskEdBox A2
Height = 405
Left = 30
TabIndex = 0
Top = 90
Width = 1845
_ExtentX = 3254
_ExtentY = 714
_Version = 393216
BackColor = 12632319
MaxLength = 10
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mask = "####-##-##"
PromptChar = " "
End
Begin MSMask.MaskEdBox A1
Height = 405
Left = 2310
TabIndex = 6
Top = 90
Width = 1845
_ExtentX = 3254
_ExtentY = 714
_Version = 393216
BackColor = 12632319
MaxLength = 10
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mask = "####-##-##"
PromptChar = " "
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "至"
BeginProperty Font
Name = "隶书"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0C000&
Height = 345
Index = 1
Left = 1950
TabIndex = 7
Top = 120
Width = 465
End
End
Begin VB.TextBox Text1
BackColor = &H00C0C000&
BorderStyle = 0 'None
ForeColor = &H00000000&
Height = 1275
Left = 1080
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 8
Text = "门诊日收入对比查询.frx":030A
Top = 1245
Width = 255
End
Begin MSChartLib.MSChart MSChart1
Height = 8835
Left = -240
OleObjectBlob = "门诊日收入对比查询.frx":031F
TabIndex = 1
TabStop = 0 'False
ToolTipText = "双击鼠标可转变图表类型"
Top = -300
Width = 12240
End
End
Attribute VB_Name = "frmClinicDayQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub A1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
KeyCode = 0
Call Command3_Click
End If
End Sub
Private Sub A2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
KeyCode = 0
A1 = " - - "
A1.SetFocus
End If
End Sub
Private Sub Command1_Click()
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
DoEvents
Me.PrintForm
Command1.Visible = True
Command2.Visible = True
Command3.Visible = True
End Sub
Private Sub Command2_Click()
Form3.Enabled = True
Unload Me
End Sub
Private Sub Command3_Click()
If Not IsDate(A1) Then
A1 = " - - "
A1.SetFocus
Exit Sub
End If
If Not IsDate(A2) Then
A2 = " - - "
A2.SetFocus
Exit Sub
End If
If CDate(A1) < CDate(A2) Then
A1 = " - - "
A2 = " - - "
A2.SetFocus
Exit Sub
End If
If DS = 1 Then
Call KS_TB(CDate(A2), CDate(A1))
End If
If DS = 3 Then
Call MZCZY_TB(CDate(A2), CDate(A1))
End If
If DS = 4 Then
Call ZYKS_TB(CDate(A2), CDate(A1))
End If
If DS = 5 Then
frmClinicDayQuery.MSChart1.TitleText = " 门诊日收入对比查询 "
Call QY_TB(CDate(A2), CDate(A1))
End If
If DS = 6 Then
frmClinicDayQuery.MSChart1.TitleText = " 住院日收入对比查询 "
Call QYZY_TB(CDate(A2), CDate(A1))
End If
ERR:
End Sub
Sub QY_TB(A1 As Date, A2 As Date)
Dim D1 As Recordset
Set D1 = db.OpenRecordset("SELECT RB_DATE,SUM(HJ_MONEY) AS HJ FROM MZ_RB WHERE RB_DATE<=CDATE('" + CStr(A2) + "') AND RB_DATE>=CDATE('" + CStr(A1) + "') GROUP BY RB_DATE ORDER BY RB_DATE")
If D1.EOF Then
D1.Close
Exit Sub
End If
D1.MoveLast
MSChart1.RowCount = D1.RecordCount
D1.MoveFirst
i = 1
Do While Not D1.EOF
MSChart1.Row = i
MSChart1.RowLabel = Right(CStr(D1!RB_DATE), 5)
MSChart1.Data = Val(D1!HJ) / 10000
i = i + 1
D1.MoveNext
Loop
D1.Close
End Sub
Sub KS_TB(A1 As Date, A2 As Date)
Dim D1 As Recordset
Set D1 = db.OpenRecordset("SELECT mz_rb.xm_id as ks_id,xm_table.xm_name as ks_name, SUM(HJ_MONEY) AS HJ FROM MZ_RB left join xm_table on mz_rb.xm_id=xm_table.xm_id WHERE RB_DATE<=CDATE('" + CStr(A2) + "') AND RB_DATE>=CDATE('" + CStr(A1) + "') GROUP BY mz_rb.xm_id,xm_table.xm_NAME ORDER BY mz_rb.xm_id")
If D1.EOF Then
D1.Close
Exit Sub
End If
MSChart1.TitleText = " 门诊各项目收入对比表 "
D1.MoveLast
MSChart1.RowCount = D1.RecordCount
D1.MoveFirst
i = 1
Do While Not D1.EOF
MSChart1.Row = i
MSChart1.RowLabel = Left(CStr(D1!ks_name), 2) + CStr(Format(Val(D1!HJ) / 10000, "0.00"))
MSChart1.Data = Val(D1!HJ) / 10000
i = i + 1
D1.MoveNext
Loop
D1.Close
End Sub
Sub ZYKS_TB(A1 As Date, A2 As Date)
Dim D1 As Recordset
Set D1 = db.OpenRecordset("SELECT zy_rb.xm_id as ks_id,xm_table.xm_name as ks_name, SUM(HJ_MONEY) AS HJ FROM zy_RB left join xm_table on zy_rb.xm_id=xm_table.xm_id WHERE RB_DATE<=CDATE('" + CStr(A2) + "') AND RB_DATE>=CDATE('" + CStr(A1) + "') GROUP BY zy_rb.xm_id,xm_table.xm_NAME ORDER BY zy_rb.xm_id")
If D1.EOF Then
D1.Close
Exit Sub
End If
MSChart1.TitleText = " 各科室住院收入对比表 "
D1.MoveLast
MSChart1.RowCount = D1.RecordCount
D1.MoveFirst
i = 1
Do While Not D1.EOF
MSChart1.Row = i
MSChart1.RowLabel = Left(CStr(D1!ks_name), 2) + CStr(Format(Val(D1!HJ) / 10000, "0.00"))
MSChart1.Data = Val(D1!HJ) / 10000
i = i + 1
D1.MoveNext
Loop
D1.Close
End Sub
Sub QYZY_TB(A1 As Date, A2 As Date)
Dim D1 As Recordset
Set D1 = db.OpenRecordset("SELECT RB_DATE1,SUM(HJ_MONEY) AS HJ FROM ZY_SKRB WHERE RB_DATE1<=CDATE('" + CStr(A2 + 1) + "') AND RB_DATE1>=CDATE('" + CStr(A1) + "') GROUP BY RB_DATE1 ORDER BY RB_DATE1")
If D1.EOF Then
D1.Close
Exit Sub
End If
D1.MoveLast
MSChart1.RowCount = D1.RecordCount
D1.MoveFirst
i = 1
Do While Not D1.EOF
MSChart1.Row = i
MSChart1.RowLabel = Mid(CStr(D1!RB_DATE1), 6, 5)
MSChart1.Data = Val(D1!HJ) / 10000
i = i + 1
D1.MoveNext
Loop
D1.Close
End Sub
Private Sub Form_Load()
A2 = "2000-01-01"
A1 = Date
Call Command3_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
Form3.Enabled = True
Form3.SetFocus
End Sub
Sub MZCZY_TB(A1 As Date, A2 As Date)
MSChart1.TitleText = " 门诊收款员收款对比表 "
Dim D1 As Recordset
Set D1 = db.OpenRecordset("SELECT CZY_ID,CZY_NAME,sum(SKBC-TKBC+GHSK_BC+GHTK_BC) as je1 FROM MZ_JS WHERE JK_date<=cdate('" + CStr(A2) + "') and JK_date>=cdate('" + CStr(A1) + "') GROUP BY CZY_ID,CZY_name ORDER BY CZY_ID")
If D1.EOF Then
D1.Close
MsgBox "无数据显示!"
Exit Sub
End If
D1.MoveLast
MSChart1.RowCount = D1.RecordCount
'MSChart1.TitleText = " 门诊收款员收款比较表 "
MI = 1
D1.MoveFirst
Do While Not D1.EOF
MSChart1.Row = MI
MSChart1.RowLabel = Left(CStr(D1!CZY_NAME), 3) + CStr(D1!je1)
MI = MI + 1
If IsNull(D1!je1) Then
MA = 0
Else
MA = Val(D1!je1)
End If
MSChart1.Data = MA
D1.MoveNext
Loop
D1.Close
Text1.Visible = False
End Sub
Private Sub MSChart1_DblClick()
Select Case MSChart1.ChartType
Case 1
MSChart1.ChartType = 6
Exit Sub
Case 6
MSChart1.ChartType = 14
Exit Sub
Case 14
MSChart1.ChartType = 1
Exit Sub
End Select
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?