📄 frmgetdrugcondition.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{AA0D501B-0C16-11D4-8531-00E098160F52}#4.0#0"; "ComnButtons.ocx"
Begin VB.Form frmGetDrugCondition
BorderStyle = 1 'Fixed Single
Caption = "摆药"
ClientHeight = 3960
ClientLeft = 3360
ClientTop = 2670
ClientWidth = 5430
Icon = "frmGetDrugCondition.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3960
ScaleWidth = 5430
Begin VB.ListBox lst
Height = 3840
Left = 60
TabIndex = 7
Top = 60
Width = 2835
End
Begin MSComCtl2.UpDown upd
Height = 300
Left = 4110
TabIndex = 6
Top = 900
Width = 240
_ExtentX = 450
_ExtentY = 529
_Version = 393216
Value = 1
BuddyControl = "txtDays"
BuddyDispid = 196610
OrigLeft = 4020
OrigTop = 900
OrigRight = 4260
OrigBottom = 1305
Min = 1
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin ComnButtons.ButtonGroup btg
Height = 495
Left = 2970
TabIndex = 5
Top = 3480
Width = 2475
_ExtentX = 4366
_ExtentY = 873
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 = "&A.确定 &C.取消 &E.关闭"
KeyEnabled = "1#1#1#"
End
Begin VB.TextBox txtDays
Height = 300
Left = 3720
Locked = -1 'True
TabIndex = 3
Text = "1"
Top = 900
Width = 390
End
Begin VB.Frame Frame1
Caption = "选项"
Height = 1245
Left = 2970
TabIndex = 0
Top = 1860
Width = 2400
Begin VB.OptionButton OptType
Caption = "全科摆药"
Height = 255
Index = 0
Left = 270
TabIndex = 2
Top = 330
Width = 1455
End
Begin VB.OptionButton OptType
Caption = "按病人摆药"
Height = 255
Index = 1
Left = 270
TabIndex = 1
Top = 780
Width = 1455
End
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "摆药周期(天)"
Height = 180
Left = 3705
TabIndex = 4
Top = 615
Width = 1080
End
End
Attribute VB_Name = "frmGetDrugCondition"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private AllGetDrugObj As clsAllGetDrug
Private WithEvents DebInfoObj As frmDebInfo
Attribute DebInfoObj.VB_VarHelpID = -1
Private mSex(2) As String
Private Sub InitForm()
Dim SQL As String
Dim PNode As Node
Dim i As Integer
hisFormClear Me
If gDbObj.GetRs("select Code,value from f_GenlCode where kindID='Sex' order By Code") > 0 Then
i = 0
Do While Not gDbObj.Rs.EOF
Select Case gDbObj.Rs(1)
Case "男"
mSex(i) = "男"
i = i + 1
Case "女"
mSex(i) = "女"
i = i + 1
End Select
gDbObj.Rs.MoveNext
Loop
End If
lst.Clear
SQL = "SELECT DepCode,DepName,Flag FROM m_Depart " _
& "WHERE Flag & 3 =0 and Flag & 12 =4 ORDER BY DepCode"
If gDbObj.GetRs(SQL) > 0 Then
Do Until gDbObj.Rs.EOF
lst.AddItem gDbObj.Rs!DepCode & " " & gDbObj.Rs!DepName
gDbObj.Rs.MoveNext
Loop
End If
init
End Sub
Public Sub init()
txtDays = gtydSysConfig.DefaultGetDrugDays
OptType(0).Value = True
End Sub
Private Sub btg_Click(ByVal WhichB As Integer)
Select Case WhichB
Case 0
If lst.ListIndex = -1 Then Exit Sub
Me.MousePointer = 11
frmMain.Note = "正在计算,请稍侯......."
GetData
frmMain.Note = ""
Me.MousePointer = 0
If AllGetDrugObj Is Nothing Then
MsgBox "无满足条件的摆药项目", vbInformation
Exit Sub
End If
If AllGetDrugObj.HavingDebInfo Then
Set DebInfoObj = New frmDebInfo
Set DebInfoObj.AllGetItemObj = AllGetDrugObj
DebInfoObj.DepName = Right(lst.Text, Len(lst.Text) - InStr(lst.Text, " "))
DebInfoObj.Show
Else
If OptType(1).Value Then
Set frmGetDrug.AllGetDrugObj = AllGetDrugObj
frmGetDrug.Show
Else
Set frmGetDrugByDepart.AllGetDrugObj = AllGetDrugObj
frmGetDrugByDepart.DepName = Right(lst.Text, Len(lst.Text) - InStr(lst.Text, " "))
frmGetDrugByDepart.Show
End If
Unload Me
End If
Case 1
init
Case 2
Unload Me
End Select
End Sub
Private Sub DebInfoObj_Out()
Dim DepName As String
DepName = Right(lst.Text, Len(lst.Text) - InStr(lst.Text, " "))
Set DebInfoObj = Nothing
If OptType(1).Value Then
Set frmGetDrug.AllGetDrugObj = AllGetDrugObj
frmGetDrug.Show
Else
Set frmGetDrugByDepart.AllGetDrugObj = AllGetDrugObj
frmGetDrugByDepart.DepName = DepName
frmGetDrugByDepart.Show
End If
Unload Me
End Sub
Private Sub Form_Load()
hisFormToCenter Me, frmMain
InitForm
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmGetDrugCondition = Nothing
End Sub
Private Sub GetData()
Dim tmpObj As clsSickGetDrug, Index As Integer, GetDrugObj As clsGetDrug
Dim DepCode As String
Dim TmpRs As Recordset
Dim i As Integer, IsBaby As Boolean
Dim SQL As String
DepCode = Left(lst.Text, InStr(lst.Text, " ") - 1)
SQL = "SELECT SickInfo.SkSerial,SickInfo.BedID,m_SickRegInfo.Name," _
& "ADVDetail.ADVSerial,ADVDetail.Num,SickInfo.DcCode,SickInfo.DepCode," _
& "ADVDetail.ItemCode,ADVDetail.ModelAmount,(SickInfo.PrePay -SickInfo.Fair) as 'RemFair'," _
& "m_Drug.ItemName,m_Drug.Model,m_Drug.Flag as 'DFlag',m_Drug.Gprice,ADVMain.ADVUsID," _
& "m_Drug.Cprice,m_Drug.BaseUnit,ADVMain.ADVFreqID,ADVMain.flag,SickInfo.Status," _
& "ADVMain.EndDate,ADVDetail.PrevEndDate,ADVDetail.SFlag,ADVMain.BeginDate,ADVMain.BeginDcCode,m_SickRegInfo.sex " _
& "FROM (((ADVMain INNER JOIN ADVDetail ON ADVMain.ADVSerial = ADVDetail.ADVSerial " _
& " AND ADVMain.DepCode like '" & DepCode & "%' ) " _
& "INNER JOIN m_Drug ON ADVDetail.ItemCode = m_Drug.ItemCode) " _
& "INNER JOIN SickInfo ON ADVMain.SkSerial = SickInfo.SkSerial AND SickInfo.Status & 1 =0) " _
& "INNER JOIN m_SickRegInfo ON SickInfo.SkID = m_SickRegInfo.SkID " _
& "WHERE (ADVDetail.SFlag & 1) =0 AND (ADVMain.Flag & 2) =0 " _
& gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode") _
& "AND (DateDiff(day,ADVMain.EndDate,ADVDetail.PrevEndDate)< 0 OR ADVMain.EndDate IS NULL ) " _
& "AND (ADVMain.Flag & 4) =4 " _
& "AND DateDiff(day,getdate(),ADVDetail.PrevEndDate) < " & txtDays & " ORDER BY SickInfo.BedID"
' 未停,审核,未结束,该科或其下级科,非自带药, 结束日期>记帐日期 记帐日期-当前日期 < 天
'不包括结束的一天
Set TmpRs = gDbObj.GetNewRs(SQL)
If Not (TmpRs Is Nothing) Then
If TmpRs.RecordCount >= 1 Then
Set AllGetDrugObj = New clsAllGetDrug
Index = 0
Do Until TmpRs.EOF
IsBaby = IIf((TmpRs!flag And 2 ^ (4 - 1)) <> 0, True, False)
Set tmpObj = AllGetDrugObj.ItemBySick(TmpRs!SkSerial, IsBaby)
If tmpObj Is Nothing Then
Set tmpObj = New clsSickGetDrug
tmpObj.SkSerial = TmpRs!SkSerial
tmpObj.Name = TmpRs!Name
tmpObj.BedID = IIf(IsNull(TmpRs!BedID), "", TmpRs!BedID)
tmpObj.IsBaby = IsBaby
tmpObj.DcCode = IIf(IsNull(TmpRs!DcCode), "", TmpRs!DcCode)
tmpObj.DepCode = TmpRs!DepCode
tmpObj.DcCode = IIf(IsNull(TmpRs!BeginDcCode), "", TmpRs!BeginDcCode)
tmpObj.RemFair = TmpRs!RemFair
tmpObj.Sex = IIf(IsNull(TmpRs!Sex), "男", mSex(TmpRs!Sex))
If (TmpRs!Status And 8) Then
tmpObj.CanDeb = True
End If
AllGetDrugObj.Add tmpObj
End If
Set GetDrugObj = tmpObj.Add(TmpRs!ADVSerial, TmpRs!Num, TmpRs!EndDate, _
TmpRs!cprice, TmpRs!Gprice, TmpRs!BaseUnit, _
TmpRs!ADVFreqID, TmpRs!ADVUsID, TmpRs!PrevEndDate, TmpRs!ModelAmount, _
TmpRs!Model, TmpRs!ItemName, TmpRs!ItemCode, _
TmpRs!DFlag, _
IIf((TmpRs!flag And 1) = 0, True, False), TmpRs!BeginDate)
Call GetDrugObj.GetMount(txtDays)
TmpRs.MoveNext
Loop
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -