📄 dlgksgzl.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form dlgKSGZL
BackColor = &H00D3DABC&
BorderStyle = 3 'Fixed Dialog
Caption = "科室工作量统计"
ClientHeight = 8130
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 7995
Icon = "dlgKSGZL.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8130
ScaleWidth = 7995
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame3
BackColor = &H00D3DABC&
Caption = "操作"
Height = 3015
Left = 6360
TabIndex = 6
Top = 1020
Width = 1545
Begin XPControls.XPCommandButton XPCommandButton1
Cancel = -1 'True
Height = 375
Left = 240
TabIndex = 7
Top = 2340
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "退出(&E)"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton cmdStatistic
Height = 375
Left = 240
TabIndex = 8
Top = 450
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "统计(&S)"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton cmdPrint
Height = 375
Left = 240
TabIndex = 9
Top = 1395
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Enabled = 0 'False
Caption = "打印(&P)"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4650
Top = 3390
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame2
BackColor = &H00D3DABC&
Caption = "条件设置"
Height = 765
Left = 120
TabIndex = 0
Top = 90
Width = 7785
Begin MSComCtl2.DTPicker dtpBegin
Height = 345
Left = 2040
TabIndex = 1
Top = 270
Width = 1425
_ExtentX = 2514
_ExtentY = 609
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 23789569
CurrentDate = 38045
MaxDate = 73415
MinDate = 2
End
Begin MSComCtl2.DTPicker dtpStop
Height = 345
Left = 4680
TabIndex = 2
Top = 270
Width = 1455
_ExtentX = 2566
_ExtentY = 609
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 23789569
CurrentDate = 38045
MaxDate = 73415
MinDate = 2
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "终止日期："
Height = 285
Left = 3690
TabIndex = 4
Top = 360
Width = 975
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "起始日期："
Height = 315
Left = 1080
TabIndex = 3
Top = 360
Width = 945
End
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1
Height = 6975
Left = 120
TabIndex = 5
Top = 990
Width = 6045
_ExtentX = 10663
_ExtentY = 12303
_Version = 393216
BackColorFixed = 12640511
BackColorBkg = 12648447
SelectionMode = 1
AllowUserResizing= 3
RowSizingMode = 1
_NumberOfBands = 1
_Band(0).Cols = 2
End
End
Attribute VB_Name = "dlgKSGZL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mblnKShi As Boolean '当前是否统计科室工作量
Dim mstrSQL As String
'被调函数，用于统计科室工作量和医生工作量
Public Function ShowStatistic(ByVal blnKShi As Boolean) As Boolean
mblnKShi = blnKShi
If blnKShi = True Then
Me.Caption = "科室工作量统计"
Else
Me.Caption = "医生工作量统计"
End If
Me.Show vbModal
End Function
Private Sub cmdPrint_Click()
PrintReport
End Sub
Private Sub cmdStatistic_Click()
On Error GoTo ErrMsg
Dim Status
Dim strSQL As String
Dim rstemp As ADODB.Recordset
Dim rsDX As ADODB.Recordset
Dim i As Integer
Dim dtmBegin As Date
Dim dtmStop As Date
Me.MousePointer = vbHourglass
'禁用打印按钮
cmdPrint.Enabled = False
'判断时间是否符合条件
If dtpBegin.Value > dtpStop.Value Then
MsgBox "起始日期不能大于终止日期，请重新设置！", vbInformation, "提示"
GoTo ExitLab
End If
'记录起止时间
dtmBegin = dtpBegin.Value
dtmStop = dtpStop.Value & " 23:59:00"
strSQL = "select Count(*) from SET_DX"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenKeyset, adLockOptimistic
If rstemp(0) < 1 Then
MsgBox "还没有建立科室项目，无从统计！请联系系统管理员！", vbInformation, "提示"
GoTo ExitLab
End If
rstemp.Close
If mblnKShi = True Then
'科室体检
strSQL = "select DXMC as 项目组合,KSMC as 所属科室" _
& ",Count(YY_SJDJDX.DXID) as [工作量(人/次)]" _
& " from YY_SJDJDX,SET_DX,SET_KSSZ,SET_GRXX" _
& " where YY_SJDJDX.DXID=SET_DX.DXID" _
& " and SET_DX.KSID=SET_KSSZ.KSID" _
& " and YY_SJDJDX.GUID=SET_GRXX.GUID" _
& " and YY_SJDJDX.SFTJ>0" _
& " and SET_GRXX.TJRQ between '" & dtmBegin & "' and '" & dtmStop & "'" _
& " group by DXMC,KSMC"
'总检
strSQL = strSQL & " union "
strSQL = strSQL & "select 项目组合='总检',所属科室='总检'" _
& ",Count(DATA_ZJJL.GUID) as [工作量(人/次)]" _
& " from DATA_ZJJL" _
& " where DATA_ZJJL.TJRQ between '" & dtmBegin & "' and '" & dtmStop & "'"
'排序
strSQL = strSQL & " order by 所属科室,项目组合"
' '**************************20040910改 闻******************************
' strSQL = "select KSMC as 科室名称,Count(Data_KSXJ.KSID) as [工作量] from Data_KSXJ,SET_KSSZ" _
' & " where Data_KSXJ.KSID=SET_KSSZ.KSID" _
' & " and Data_KSXJ.TJRQ>='" & dtmBegin & "'" _
' & " and Data_KSXJ.TJRQ<='" & dtmStop & "'" _
' & " group by KSMC"
' '**************************20040910改完 闻****************************
Else
'科室体检
strSQL = "select Name as 姓名,DXMC as 项目组合,KSMC as 所属科室" _
& ",Count(YY_SJDJDX.DXID) as [工作量(人/次)]" _
& " from RY_Employee,YY_SJDJDX,SET_DX,SET_KSSZ,SET_GRXX" _
& " where RY_Employee.EmployeeID=YY_SJDJDX.EmployeeID" _
& " and YY_SJDJDX.DXID=SET_DX.DXID" _
& " and SET_DX.KSID=SET_KSSZ.KSID" _
& " and YY_SJDJDX.GUID=SET_GRXX.GUID" _
& " and YY_SJDJDX.SFTJ>0" _
& " and SET_GRXX.TJRQ between '" & dtmBegin & "' and '" & dtmStop & "'" _
& " group by Name,DXMC,KSMC"
'总检
strSQL = strSQL & " union "
strSQL = strSQL & "select Name as 姓名,项目组合='总检',所属科室='总检'" _
& ",Count(DATA_ZJJL.GUID) as [工作量(人/次)]" _
& " from RY_Employee,DATA_ZJJL" _
& " where RY_Employee.EmployeeID=DATA_ZJJL.EmployeeID" _
& " and DATA_ZJJL.TJRQ between '" & dtmBegin & "' and '" & dtmStop & "'" _
& " group by Name"
'排序
strSQL = strSQL & " order by 姓名,所属科室,项目组合"
End If
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenKeyset, adLockOptimistic
If rstemp.RecordCount < 1 Then
'然后清空网格控件的显示
With Me.MSHFlexGrid1
.Clear
.Rows = 2
.Refresh
End With
GoTo ExitLab
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -