📄 frmgetdrug.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 1080
TabIndex = 10
Tag = "Dyn"
Top = 690
Width = 735
End
Begin VB.Label Label15
AutoSize = -1 'True
Caption = "类 型:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 300
TabIndex = 9
Top = 690
Width = 735
End
Begin VB.Label lblContactorAddr
AutoSize = -1 'True
Caption = "lblContactorAddr"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 3075
TabIndex = 8
Tag = "Dyn"
Top = 1425
Width = 2100
End
Begin VB.Label lblContactor
AutoSize = -1 'True
Caption = "lblContactor"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 1080
TabIndex = 7
Tag = "Dyn"
Top = 1425
Width = 1110
End
End
Begin VB.CheckBox chkBaby
Caption = "新生儿"
Enabled = 0 'False
Height = 225
Left = 7380
TabIndex = 5
Top = 225
Width = 1245
End
Begin VB.TextBox txtSkID
Enabled = 0 'False
Height = 285
Left = 810
TabIndex = 4
Text = "txtSkID"
Top = 105
Width = 1905
End
Begin LstCtl.ListCtl lct
Height = 210
Left = 0
TabIndex = 2
Top = 4530
Width = 2820
_ExtentX = 4974
_ExtentY = 370
End
Begin ComnButtons.ButtonGroup btg
Height = 405
Left = -120
TabIndex = 31
Top = 4770
Width = 8985
_ExtentX = 15849
_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 = 6
ButtonCaption = "&S.全部选中 &C.全部取消 &K.记 帐 &P.打 印 &E.关 闭 &Q.查 询"
KeyEnabled = "1#1#1#1#1#1#"
End
Begin SpreadEnhanced.UserSpread usp
Left = 600
Top = 1350
_ExtentX = 847
_ExtentY = 847
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "病案号:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 60
TabIndex = 3
Top = 150
Width = 735
End
Begin VB.Line Line3
BorderColor = &H80000005&
X1 = 3315
X2 = 6165
Y1 = 330
Y2 = 330
End
Begin VB.Line Line2
BorderColor = &H80000003&
X1 = 3330
X2 = 6180
Y1 = 345
Y2 = 345
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "摆 药 单"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 3870
TabIndex = 1
Top = 0
Width = 1575
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "摆 药 单"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 285
Left = 3840
TabIndex = 32
Top = 0
Width = 1575
End
End
Attribute VB_Name = "frmGetDrug"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public AllGetDrugObj As clsAllGetDrug
Private Sub InitForm()
hisFormClear Me
Set Lct.CN = gDbObj.CN
Lct.Count = AllGetDrugObj.Count
' Set usp.CurSpread = spd
' usp.ID = "C_GetDrugBySick"
' usp.Load
FillData 1
End Sub
Public Sub FillData(ByVal Num As Integer)
Dim i As Integer
Dim TmpObj As clsGetDrug
Dim SickObj As clsSick
Dim DcCode As String
Set SickObj = New clsSick
SickObj.SkSerialByQuery = AllGetDrugObj.Item(Num).SkSerial
DcCode = AllGetDrugObj.Item(Num).DcCode
gfnFillDataBySickRegInfo Me, SickObj
chkBaby.Value = IIf(AllGetDrugObj.Item(Num).IsBaby, 1, 0)
txtSkID = AllGetDrugObj.Item(Num).SkID
spd.Redraw = False
spd.MaxRows = 0
For Each TmpObj In AllGetDrugObj.Item(Num)
spd.MaxRows = spd.MaxRows + 1
spd.Row = spd.MaxRows
spd.Col = 1
spd.Text = TmpObj.ADVSerial
spd.Col = 2
spd.Text = TmpObj.Num
spd.Col = 3
spd.Text = TmpObj.ItemName
spd.Col = 4
spd.Text = TmpObj.Model
spd.Col = 5
spd.Text = TmpObj.FreqDes
spd.Col = 6
spd.Text = Format(TmpObj.ModelAmount, "#######0.####") & TmpObj.ModelUnit
spd.Col = 7
spd.Text = TmpObj.Unit
spd.Col = 8
spd.Text = TmpObj.Mount
spd.Col = 9
spd.Text = TmpObj.cprice
Select Case TmpObj.Status
Case 0
spd.Col = 10
spd.Value = 0
spd.Lock = False
spd.Col = 11
spd.Value = 0
Case 1
spd.Col = 10
spd.Value = 1
spd.Lock = False
spd.Col = 11
spd.Value = 0
Case 2
spd.Col = 10
spd.Value = 0
spd.Lock = True
spd.Col = 11
spd.Value = 1
Case 2
End Select
spd.Col = 12
If gDbObj.GetRs("select DcName From m_Doctor where dcCode='" & DcCode & "'") > 0 Then
spd.Text = gDbObj.Rs(0)
End If
spd.Col = 13
spd.Text = Format(TmpObj.BeginDate, "yyyy-mm-dd hh:mm:ss")
Next
spd.Redraw = True
AllGetDrugObj.Item(Num).RemFair = SickObj.RemFair
If AllGetDrugObj.Item(Num).CanKeep Then
btg.KeyEnabled(0) = True
btg.KeyEnabled(1) = True
btg.KeyEnabled(2) = True
btg.KeyEnabled(3) = True
Else
btg.KeyEnabled(0) = False
btg.KeyEnabled(1) = False
btg.KeyEnabled(2) = False
btg.KeyEnabled(3) = False
End If
End Sub
Private Sub btg_Click(ByVal WhichB As Integer)
Dim i As Integer, SkID As String
Dim Obj As Object, ErrDes As String, Row As Long, Col As Long
Select Case WhichB
Case 0
For i = 1 To spd.MaxRows
spd.Row = i
spd.Col = 11
If spd.Value = 0 Then
spd.Col = 10
spd.Value = 1
End If
Next i
Case 1
For i = 1 To spd.MaxRows
spd.Row = i
spd.Col = 10
spd.Value = 0
Next i
Case 2
Set Obj = ValidInput(ErrDes, Row, Col)
If Not (Obj Is Nothing) Then
MsgBox ErrDes, vbCritical
hisActiveSpreadCell spd, Row, Col
Exit Sub
End If
LoadData
Me.MousePointer = 11
If Not AllGetDrugObj.Item(Hct.CurPos).Save Then
Me.MousePointer = 0
MsgBox gDbObj.ErrDes, vbCritical
Else
AllGetDrugObj.Item(Lct.CurPos).SetStatus
Me.MousePointer = 0
MsgBox "此病人记帐完成!", vbInformation
FillData Lct.CurPos
End If
Case 3
spd.PrintHeader = " /fz""12"" /fb1 " & "住院病人取药" _
& " /n/n" _
& "/fz""10"" /fb0 病案号：" & txtSkID _
& Space(10) & "姓名:" & lblName _
& Space(10) & "性别:" & lblSex _
& Space(10) & "入院日期:" & Format(lblInDate, gstrCHINA_DATE) & "/n" _
& Space(50) & "打印日期:" & gfnGetTime(gstrCHINA_DATE) & "/r/n"
spd.PrintRowHeaders = False
spd.PrintShadows = False
spd.PrintMarginLeft = 0
spd.PrintUseDataMax = False
For i = 1 To spd.MaxRows
spd.Row = i
spd.Col = 10
If spd.Value = 0 Then
spd.RowHidden = True
End If
Next i
spd.Action = SS_ACTION_PRINT
For i = 1 To spd.MaxRows
spd.Row = i
spd.Col = 10
If spd.Value = 0 Then
spd.RowHidden = False
End If
Next i
Case 4
Unload Me
Case 5
SkID = InputBox("请输入病人病案号:", "记帐病人查询")
i = AllGetDrugObj.SkIDIndex(SkID)
If i > 0 Then
Lct.CurPos = i
End If
End Select
End Sub
Private Sub Form_Load()
hisFormToCenter Me, frmMain
InitForm
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmGetDrug = Nothing
End Sub
Private Sub Lct_PosChanged(ByVal Pos As Long, ByVal OldPos As Long)
FillData Pos
End Sub
Private Sub spd_LeaveCell(ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
gpdSpreadControl spd, Col, Row, NewCol, NewRow
End Sub
Private Function ValidInput(ErrDes As String, Row As Long, Col As Long) As Object
Dim i As Integer, Having As Boolean
For i = 1 To spd.MaxRows
spd.Row = i
spd.Col = 10
If spd.Value = 1 Then
Having = True
End If
Next i
If Not Having Then
ErrDes = "请选择记帐项目!"
Set ValidInput = spd
Row = 1
Col = 10
Exit Function
End If
End Function
Private Sub LoadData()
Dim TmpObj As clsGetDrug
Dim ADVSerial As String
Dim Num As Integer, i As Integer
For i = 1 To spd.MaxRows
spd.Row = i
spd.Col = 10
If spd.Value = 1 Then
spd.Col = 1
ADVSerial = spd.Text
spd.Col = 2
Num = Val(spd.Text)
Set TmpObj = AllGetDrugObj.ADVItem(ADVSerial, Num)
If Not (TmpObj Is Nothing) Then
TmpObj.Status = 1
End If
Else
spd.Col = 1
ADVSerial = spd.Text
spd.Col = 2
Num = Val(spd.Text)
Set TmpObj = AllGetDrugObj.ADVItem(ADVSerial, Num)
If Not (TmpObj Is Nothing) Then
spd.Col = 11
If spd.Value = 1 Then
TmpObj.Status = 2
Else
TmpObj.Status = 0
End If
End If
End If
Next i
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -