📄 frmgetdrugquery.frm
字号:
VERSION 5.00
Object = "{AA0D501B-0C16-11D4-8531-00E098160F52}#4.0#0"; "COMNBUTTONS.OCX"
Object = "{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0"; "SS32X25.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Object = "{D52F4AA5-2D61-11D3-8E3D-0080C879E48B}#54.0#0"; "USERSPREAD.OCX"
Begin VB.Form frmGetDrugQuery
BorderStyle = 1 'Fixed Single
Caption = "摆药查询"
ClientHeight = 5475
ClientLeft = 525
ClientTop = 390
ClientWidth = 9030
Icon = "frmGetDrugQuery.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5475
ScaleWidth = 9030
Begin FPSpread.vaSpread spd
Height = 4485
Left = -15
OleObjectBlob = "frmGetDrugQuery.frx":0442
TabIndex = 0
Top = 480
Width = 8985
End
Begin VB.OptionButton optFS
Caption = "退药"
ForeColor = &H00C00000&
Height = 345
Index = 2
Left = 2070
TabIndex = 8
Top = 5100
Width = 825
End
Begin VB.OptionButton optFS
Caption = "取药"
ForeColor = &H00C00000&
Height = 345
Index = 1
Left = 1140
TabIndex = 7
Top = 5100
Width = 825
End
Begin VB.OptionButton optFS
Caption = "摆药"
ForeColor = &H00C00000&
Height = 345
Index = 0
Left = 300
TabIndex = 6
Top = 5100
Value = -1 'True
Width = 1065
End
Begin VB.ComboBox cboDepart
Height = 300
Left = 930
Style = 2 'Dropdown List
TabIndex = 2
Top = 90
Width = 2685
End
Begin SpreadEnhanced.UserSpread usp
Left = 2400
Top = 0
_ExtentX = 847
_ExtentY = 847
End
Begin ComnButtons.ButtonGroup btg
Height = 405
Left = 4245
TabIndex = 1
Top = 5040
Width = 4590
_ExtentX = 8096
_ExtentY = 714
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = -2147483638
ButtonCount = 3
ButtonCaption = "&Q.查 询 &P.打 印 &E.关 闭"
KeyEnabled = "1#1#1#"
End
Begin MSMask.MaskEdBox mskDate
Height = 315
Index = 0
Left = 6105
TabIndex = 3
Top = 60
Width = 1215
_ExtentX = 2143
_ExtentY = 556
_Version = 393216
MaxLength = 10
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mask = "####-##-##"
PromptChar = " "
End
Begin MSMask.MaskEdBox mskDate
Height = 312
Index = 1
Left = 7644
TabIndex = 4
Top = 60
Width = 1212
_ExtentX = 2117
_ExtentY = 556
_Version = 393216
MaxLength = 10
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mask = "####-##-##"
PromptChar = " "
End
Begin VB.Label Label2
Caption = "日期(不包括当天)"
ForeColor = &H00800080&
Height = 255
Left = 4590
TabIndex = 9
Top = 150
Width = 1755
End
Begin VB.Line Line1
X1 = 7350
X2 = 7620
Y1 = 210
Y2 = 210
End
Begin VB.Label Label1
Caption = "科室"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 390
TabIndex = 5
Top = 150
Width = 915
End
End
Attribute VB_Name = "frmGetDrugQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private TDate(0 To 1) As String
Private Sub InitForm()
Set usp.DBInter = gDbObj
Set usp.CurSpread = spd
cboDepart.Clear
cboDepart.AddItem "全部"
If gDbObj.GetRs("SELECT m_Depart.DepCode,m_Depart.DepName FROM m_Depart" _
& " WHERE (Flag & 12) = 4 AND (Flag & 3) = 0 AND Leaf =1") > 1 Then
Do Until gDbObj.Rs.EOF
cboDepart.AddItem gDbObj.Rs!DepCode & " " & gDbObj.Rs!DepName
gDbObj.Rs.MoveNext
Loop
End If
If cboDepart.ListCount > 0 Then cboDepart.ListIndex = 0
usp.ID = "C_GetDrugQuery"
usp.SumRowStr = "<10>"
usp.Load
spd.MaxRows = 0
mskDate(0) = gfnGetTime(gstrCOMN_DATE)
mskDate(1) = mskDate(0)
frmMain.Note = "此功能可能会占用较长时间"
End Sub
Private Sub btg_Click(ByVal WhichB As Integer)
Dim DepName As String
Dim mFontHeader As String
Select Case WhichB
Case 0
FillData
Case 1
If cboDepart.ListIndex = -1 Then Exit Sub
DepName = Right(cboDepart.Text, Len(cboDepart.Text) - InStr(cboDepart.Text, " "))
mFontHeader = "/fn""宋体"" /fz""14"" /fb1 /fi0 /fu1 /fk0 /c /fs1"
spd.PrintHeader = " /fz""14"" /fb1 " & DepName _
& " /n/n" _
& "/fz""11"" /fb0 打印操作员：" & gtydSysConfig.HDName & "" _
& "开始日期:" & mskDate(0) & "/r/n" _
& "结束日期:" & mskDate(1) & "/r/n" _
& "打印时间:" & gfnGetTime(gstrCOMN_DATE_LONG) & "/r/n"
spd.PrintRowHeaders = True
spd.PrintShadows = False
spd.PrintMarginLeft = 0
spd.PrintUseDataMax = False
spd.PrintOrientation = 1
spd.Action = SS_ACTION_PRINT
Case 2
Unload Me
End Select
End Sub
Private Sub Form_Load()
hisFormToCenter Me, frmMain
InitForm
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmMain.Note = ""
Set frmGetDrugQuery = Nothing
End Sub
Private Sub spd_RightClick(ByVal ClickType As Integer, ByVal Col As Long, ByVal Row As Long, ByVal MouseX As Long, ByVal MouseY As Long)
Call usp.RightClick
End Sub
Private Sub FillData()
Dim DepCode As String
Dim SQL As String
If cboDepart.ListIndex = -1 Then Exit Sub
If cboDepart.ListIndex > 0 Then
DepCode = " and FairMarkMain.DepCode= '" & Left(cboDepart.Text, InStr(cboDepart.Text, " ") - 1) & "' "
Else
DepCode = ""
End If
Screen.MousePointer = 11
If optFS(0).Value Then
SQL = "Select SickInfo.SKID,m_SickRegInfo.Name,(CASE WHEN BedId IS NULL THEN '' else right(BedID,len(bedid)-CharIndex('#',BedID)) end)," _
& "(CASE WHEN FairMarkMain.Flag & 2 =2 THEN '是' ELSE '' END),ItemName," _
& "model,Amount/FairMarkSub.Factor,FairMarkSub.Unit,FairMarkSub.CPrice * FairMarkSub.Factor," _
& "FairMarkSub.Fair,MarkDate,FairMarkMain.HdCode,m_Doctor.dcName " _
& "FROM FairMarkMain INNER JOIN SickInfo ON FairMarkMain.SkSerial = SickInfo.SkSerial " & DepCode _
& " AND FairMarkMain.MarkSerial >= '" & Format(mskDate(0), "yymmdd") & "' " _
& " AND FairMarkMain.Markserial<= '" & Format(mskDate(1), "yymmdd") & "' " _
& " INNER JOIN FairMarkSub ON FairMarkMain.MarkSerial = FairMarkSub.MarkSerial " _
& " INNER JOIN m_SickregInfo ON SickInfo.SkID = m_SickregInfo.SkID " _
& " INNER JOIN m_Drug ON FairMarkSub.ItemCode = m_Drug.ItemCode " _
& " LEFT JOIN m_Doctor ON FairMarkMain.DcCode = m_Doctor.DcCode " _
& " WHERE ADvSerial IS NOT NULL AND FairMarkSub.DsCode = '" & gtydSysConfig.DepCode & "' "
End If
If optFS(1).Value Then
SQL = "Select SickInfo.SKID,m_SickRegInfo.Name,(CASE WHEN BedId IS NULL THEN '' else right(BedID,len(bedid)-CharIndex('#',BedID)) end)," _
& "(CASE WHEN FairMarkMain.Flag & 2 =2 THEN '是' ELSE '' END),ItemName," _
& "model,Amount/FairMarkSub.Factor,FairMarkSub.Unit,FairMarkSub.CPrice * FairMarkSub.Factor," _
& "FairMarkSub.Fair,MarkDate,FairMarkMain.HdCode,m_Doctor.dcName " _
& "FROM FairMarkMain INNER JOIN SickInfo ON FairMarkMain.SkSerial = SickInfo.SkSerial " & DepCode _
& " AND FairMarkMain.MarkSerial >= '" & Format(mskDate(0), "yymmdd") & "' " _
& " AND FairMarkMain.Markserial<= '" & Format(mskDate(1), "yymmdd") & "' " _
& " INNER JOIN FairMarkSub ON FairMarkMain.MarkSerial = FairMarkSub.MarkSerial " _
& " INNER JOIN m_SickregInfo ON SickInfo.SkID = m_SickregInfo.SkID " _
& " INNER JOIN m_Drug ON FairMarkSub.ItemCode = m_Drug.ItemCode " _
& " LEFT JOIN m_Doctor ON FairMarkMain.DcCode = m_Doctor.DcCode " _
& " WHERE ADvSerial IS NULL AND amount>0 AND FairMarkSub.DsCode = '" & gtydSysConfig.DepCode & "' """
End If
If optFS(2).Value Then
SQL = "Select SickInfo.SKID,m_SickRegInfo.Name,(CASE WHEN BedId IS NULL THEN '' else right(BedID,len(bedid)-CharIndex('#',BedID)) end)," _
& "(CASE WHEN FairMarkMain.Flag & 2 =2 THEN '是' ELSE '' END),ItemName," _
& "model,Amount/FairMarkSub.Factor,FairMarkSub.Unit,FairMarkSub.CPrice * FairMarkSub.Factor," _
& "FairMarkSub.Fair,MarkDate,FairMarkMain.HdCode,m_Doctor.dcName " _
& "FROM FairMarkMain INNER JOIN SickInfo ON FairMarkMain.SkSerial = SickInfo.SkSerial " & DepCode _
& " AND FairMarkMain.MarkSerial >= '" & Format(mskDate(0), "yymmdd") & "' " _
& " AND FairMarkMain.Markserial<= '" & Format(mskDate(1), "yymmdd") & "' " _
& " INNER JOIN FairMarkSub ON FairMarkMain.MarkSerial = FairMarkSub.MarkSerial " _
& " INNER JOIN m_SickregInfo ON SickInfo.SkID = m_SickregInfo.SkID " _
& " INNER JOIN m_Drug ON FairMarkSub.ItemCode = m_Drug.ItemCode " _
& " LEFT JOIN m_Doctor ON FairMarkMain.DcCode = m_Doctor.DcCode " _
& " WHERE amount<0 AND FairMarkSub.DsCode = '" & gtydSysConfig.DepCode & "' "
End If
If gstrMODULEID = "C" Then SQL = SQL & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode")
SQL = SQL & " ORDER BY SickInfo.BedID,FairMarkMain.flag & 2 "
usp.SQL = SQL
usp.Refresh
Screen.MousePointer = 0
End Sub
Private Sub mskDate_GotFocus(Index As Integer)
TDate(Index) = mskDate(Index).Text
End Sub
Private Sub mskDate_LostFocus(Index As Integer)
If TDate(Index) = mskDate(Index) Then Exit Sub
If Not IsDate(mskDate(Index).Text) Then
MsgBox gstrDATE_ERROR_MSG, vbCritical
mskDate(Index).SetFocus
Else
hisClearSpread spd
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -