frminpatidrugmark.frm

医院门诊医生工作站,vb6 SqlServer

    End If
End Sub
Private Sub PutSpread(ByVal Row As Integer, ByVal ItemCode, ByVal ItemName, ByVal Model, _
        ByVal Unit, ByVal Amount, ByVal CPrice, ByVal Factor, ByVal Gprice)
    Dim i As Integer
    
    gUnitobj.Add ItemCode

    spd.Redraw = False
    spd.Row = Row
    spd.Col = 1
    spd.Text = ItemName
    spd.Col = 2
    spd.Text = Model & " * " & Int(Factor)
    spd.Col = 3
    If gUnitobj(ItemCode).Count = 1 Then
        spd.CellType = SS_CELL_TYPE_EDIT
        spd.Text = Unit
        spd.Lock = True
    Else
        spd.CellType = SS_CELL_TYPE_COMBOBOX
        spd.Lock = False
        For i = 1 To gUnitobj(ItemCode).Count
            spd.TypeComboBoxIndex = -1
            spd.TypeComboBoxString = gUnitobj(ItemCode).Item(i).Unit
            If gUnitobj(ItemCode).Item(i).Unit = Unit Then
                spd.TypeComboBoxCurSel = i - 1
            End If
        Next i
    End If
    spd.Col = 4
    spd.Text = Amount / Factor
    spd.Col = 5
    If CPrice = 0 Then
        spd.Lock = False
    Else
        spd.Lock = True
    End If
    
    spd.Text = CPrice * Factor
    spd.Col = 6
    spd.Text = CPrice * Amount
    spd.Col = 7
    spd.Text = ItemCode
    spd.Col = 8
    spd.Text = Factor
    spd.Col = 9
    spd.Text = Gprice
    spd.Redraw = True
End Sub


Private Sub chkBack_Click()
    hisFormClear Me
    chkBaby.Value = 0
    spd.MaxRows = 0
    If Not (SickObj Is Nothing) Then
        Set SickObj = Nothing
    End If
End Sub

Private Sub CmnHlp_ResSelect(ByVal SelData As Variant, ByVal STag As String)
    'Drug: 0名称-1别名-2正式名-3规格-4基本单位-5当前单位-6换算关系-7单价-8Flag
    'item: 0名称-1别名-2正式名-3单位-4单价-5收费科别编码-6收费科别名称-7Flag
    Dim i As Integer

    Me.SetFocus
    Select Case STag
        Case "Item"
            If TypeName(SelData) <> "Nothing" Then
                If spd.MaxRows = spd.ActiveRow Then
                    spd.MaxRows = spd.MaxRows + 1
                End If
                
                PutSpread spd.ActiveRow, SelData(0), SelData(2), SelData(3), _
                    SelData(5), 1 * SelData(6), SelData(7), SelData(6), SelData(9)
            Else
                If spd.MaxRows <> spd.ActiveRow Then  '删除旧的一行
                    spd.Row = spd.ActiveRow
                    spd.Action = SS_ACTION_DELETE_ROW
                    spd.MaxRows = spd.MaxRows - 1
                End If
            End If
            Sum

    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn And Me.ActiveControl.Name <> "spd" Then
        hisToActiveCtl(Me).SetFocus
    End If
End Sub

Private Sub Form_Load()
    hisFormToCenter Me, frmMain
    InitForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmOutDrugMark = Nothing
End Sub

Private Sub lct_PosChanged(ByVal Pos As Long, ByVal OldPos As Long)
   ' FillData
End Sub



Private Sub mcr_Click(ByVal WhichB As UseMaintainCtl.BUTTONKEY)
    Dim ErrDes As String
    Dim TmpObj As Object
    
    Select Case WhichB
        Case BK_ADD
            Set TmpObj = ValidInput(ErrDes)
            If Not (TmpObj Is Nothing) Then
                MsgBox ErrDes, vbCritical
                TmpObj.SetFocus
                Exit Sub
            End If
            If Save Then
                Init
                txtSkID.SetFocus
            Else
                MsgBox gDbObj.ErrDes, vbCritical
            End If
        Case BK_CLEAR
            Init
            txtSkID.SetFocus
        Case BK_EXIT
            Unload Me
        
    End Select
End Sub

Private Sub spd_EditMode(ByVal Col As Long, ByVal Row As Long, ByVal Mode As Integer, ByVal ChangeMade As Boolean)
    Dim TmpStr As String
    Dim mFactor As Single
    Dim i As Integer, ItemCode As String
    Dim CPrice As Currency, Amount As Single, Factor As Single, Model As String, CurUnit As String
    
    spd.Col = Col
    spd.Row = Row
    If ChangeMade Or gfnGetCell(spd, Row, 1) = "" Then
        Select Case Col
            Case 1: '名称
                TmpStr = spd.Text
                If TmpStr <> "" Then
                    CmnHlp.Sql = "SELECT ItemCode,ItemName,ItemName," _
                        & "Model,BaseUnit,BaseUnit,1,Cprice,Flag,Gprice  " _
                        & "FROM m_Drug WHERE Brief Like '##%' AND Flag & 32 = 0 " _
                        & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode") _
                        & " UNION SELECT m_Drug.ItemCode,m_DrugAlias.AliasName,m_Drug.ItemName," _
                        & "m_Drug.model,m_Drug.BaseUnit,m_Drug.BaseUnit,1,m_Drug.Cprice,Flag,GPrice " _
                        & "FROM m_Drug INNER JOIN m_DrugAlias ON " _
                        & "m_Drug.ItemCode = m_DrugAlias.ItemCode " _
                        & "WHERE m_DrugAlias.Brief LIKE '##%' AND m_Drug.Flag & 32 = 0 " _
                        & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode")

                    CmnHlp.FormatHead = _
                        "|名                       称         ||规              格||单    位|| 零售价"
                    CmnHlp.InitPut = TmpStr
                    CmnHlp.WidthRate = 1.5
                    CmnHlp.ParmTag = "Item"
                    CmnHlp.ShowHelp vbModal
                Else
                    If spd.MaxRows <> Row Then
                        spd.Row = Row
                        spd.Action = SS_ACTION_DELETE_ROW
                        spd.MaxRows = spd.MaxRows - 1
                    End If
                    Sum
                End If
            Case 3 '单位 ----> 变  数量不变、批发、实际、零售
                If Row = spd.MaxRows Then Exit Sub
                TmpStr = spd.Text
                CurUnit = TmpStr
                spd.Col = 7
                ItemCode = spd.Text
                spd.Col = 2
                Model = Left(spd.Text, InStr(spd.Text, " * ") - 1)
                spd.Text = Model & " * " & Int(gUnitobj(ItemCode).Item(CurUnit).Factor)

                spd.Col = 4
                Amount = Val(spd.Text)
                spd.Col = 8
                Factor = Val(spd.Text)
                
                spd.Col = 5 '零售价
                spd.Text = Val(spd.Text) * (gUnitobj(ItemCode).Item(CurUnit).Factor / Factor)
                CPrice = Val(spd.Text)
                spd.Col = 6
                spd.Text = CPrice * Amount
                spd.Col = 8
                spd.Text = gUnitobj(ItemCode).Item(CurUnit).Factor
                Sum
            Case 4 '数量
                If Row = spd.MaxRows Then Exit Sub
                TmpStr = spd.Text
                spd.Col = 5
                CPrice = Val(spd.Text)
                spd.Col = 6
                spd.Text = Val(TmpStr) * CPrice
                Sum '            Case 3 '单位
            Case 5 '单价变 -->金额变
                spd.Col = 4
                Amount = Val(spd.Text)
                spd.Col = 5
                CPrice = Val(spd.Text)
                If CPrice <= 0 Then
                    MsgBox "单价必须大于 0.00", vbCritical
                    Exit Sub
                End If
                spd.Col = 6
                
                spd.Text = Amount * CPrice
                Sum
        End Select
    End If
End Sub

Private Sub spd_KeyPress(KeyAscii As Integer)
    If spd.ActiveRow = spd.MaxRows _
        And KeyAscii = vbKeyReturn Then
        
        spd.Col = spd.ActiveCol
        spd.Row = spd.ActiveRow
        If spd.Text = "" Then
            hisToActiveCtl(Me).SetFocus
        End If
        KeyAscii = 0
    End If
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 Sub txtSkID_GotFocus()
    OldSkID = txtSkID
End Sub

Private Sub txtSkID_LostFocus()
    Dim mStr As String
    
    If txtSkID = OldSkID Then Exit Sub
    If txtSkID = "" Then
        Init
        Exit Sub
    End If
    If SickObj Is Nothing Then
        Set SickObj = New clsSick
    End If
    SickObj.SkIDByQuery = txtSkID
    If Not SickObj.IfRegInfo Then
        MsgBox "病案号> " & txtSkID & " <不存在", vbCritical
        Init
        txtSkID.SetFocus
        Exit Sub
    Else
        
        If SickObj.Num <= 0 Then
            MsgBox "病人未住过院!", vbCritical
            Init
            txtSkID.SetFocus
            Exit Sub
        Else
            If SickObj.IFOutHosp And SickObj.IFFoot And chkBack.Value = 0 Then
                MsgBox "病人已出院结算!", vbCritical
                Init
                txtSkID.SetFocus
                Exit Sub
            End If
        End If
    End If
    Call gfnFillDataBySickRegInfo(Me, SickObj)
    If SickObj.OutDate = "" Then
        lblOutDate = ""
    Else
        lblOutDate = Format(SickObj.OutDate, gstrCOMN_DATE)
    End If
    spd.MaxRows = 1 '避免错退
End Sub


Public Function Save()
    Dim i As Integer, J As Integer
    Dim MarkSerial As String, ItemName As String
    Dim ItemCode As String, Amount As Double, CPrice As Currency, GMoney As Currency
    Dim Gprice As Currency, Unit As String, Factor As Integer, Fair As Currency, TotalFair As Currency
    Dim Flag As Integer
    
    
On Error GoTo errlbl
    If chkBaby Then
        Flag = 2 + 4 + 8
    Else
        Flag = 4 + 8
    End If
    If SickObj.IFFoot And SickObj.IFOutHosp And chkBack.Value = 1 Then
        Flag = Flag + 1
    End If
    MarkSerial = gFnGetSerial(stFairMark)
    
    gDbObj.CNExe.BeginTrans
    If Not Update_FairMarkMain(HISDbInsert, MarkSerial, SickObj.SkSerial, gfnGetTime(), _
        gtydSysConfig.HdCode, SickObj.DepCode, SickObj.DcCode, Flag:=Flag) Then
        
        GoTo errlbl
    End If
    For i = 1 To spd.MaxRows - 1
        spd.Row = i
        spd.Col = 8
        Factor = Val(spd.Value)
        spd.Col = 4
        Amount = Val(spd.Value) * Factor * IIf(chkBack.Value = 1, -1, 1)
        spd.Col = 7
        ItemCode = spd.Text
        spd.Col = 5
        CPrice = Val(spd.Value) / Factor
        spd.Col = 9
        Gprice = Val(spd.Value) / Factor
        spd.Col = 6
        Fair = Val(spd.Value) * IIf(chkBack.Value = 1, -1, 1)
        spd.Col = 3
        Unit = spd.Text
        GMoney = Format(Gprice * Amount, "0.00") * IIf(chkBack.Value = 1, -1, 1)
        TotalFair = TotalFair + Fair
        If Not Update_FairMarkSub(HISDbInsert, MarkSerial, i, ItemCode, _
            gtydSysConfig.DepCode, Amount, CPrice, Factor, Unit, Fair, Fair, _
            Gprice:=Gprice, GMoney:=GMoney) Then
            GoTo errlbl
        End If
    Next i
    If Not gDbObj.DBExec("UPDATE SickInfo Set Fair=Fair+  " & TotalFair _
        & " WHERE SkSerial = '" & SickObj.SkSerial & "'") Then
        GoTo errlbl
    End If
    Save = True
    gDbObj.CNExe.CommitTrans
    Exit Function
errlbl:
    gDbObj.CNExe.RollbackTrans
End Function


Private Sub Sum()
    Dim i As Integer
    Dim TotalFair As Currency
    
    spd.Col = 6
    For i = 1 To spd.MaxRows - 1
        spd.Row = i
        TotalFair = TotalFair + spd.Text
    Next i
    lblTotalFair = Format(TotalFair, gstrMONEY_FORMAT)
End Sub

Public Function ValidInput(ErrDes As String) As Object
    If SickObj Is Nothing Then
        ErrDes = "必须输入病人信息!"
        Set ValidInput = Me.txtSkID
        Exit Function
    End If
    If spd.MaxRows = 1 Then
        ErrDes = "请输入出院带药项目!"
        Set ValidInput = spd
    End If
    
End Function