frmhousetranout.frm

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

            Set Obj = ValidInput(ErrDes, Row, Col)
            If Not (Obj Is Nothing) Then
                MsgBox ErrDes, vbCritical
                If Obj.Name = "spd" Then
                    hisActiveSpreadCell spd, Row, Col
                Else
                    Obj.SetFocus
                End If
                Exit Sub
            End If
            Set ItemsObj = New clsDrugItems
            LoadData
            If Not ItemsObj.Save Then
                MsgBox gDbObj.ErrDes, vbCritical
            Else
                Init
                txtSheetID.SetFocus
            End If
        Case BK_QUERY
            Set QueryObj = New frmHouseTranOutQuery
            QueryObj.Show vbModal
            
        Case BK_TRANS
            mcr.Status = CL_ADD
            Init
            txtSheetID.SetFocus
        Case BK_PRINT
            If mcr.Status = CL_ADD Then
                Set Obj = ValidInput(ErrDes, Row, Col)
                If Not (Obj Is Nothing) Then
                    MsgBox ErrDes, vbCritical
                    If Obj.Name = "spd" Then
                        hisActiveSpreadCell spd, Row, Col
                    Else
                        Obj.SetFocus
                    End If
                    Exit Sub
                End If
                Set ItemsObj = New clsDrugItems
                LoadData
            End If
            ItemsObj.PrintSheet lblAsker, lblAskSheetID
        Case BK_CLEAR
            Init
            txtSheetID.SetFocus
        Case BK_EXIT
            Unload Me
    End Select
End Sub

Private Sub mcr_StatusChanged()
   If mcr.Status = CL_ADD Then
        hisLockInput Me, False
        lct.Visible = False
        fra.Visible = False
        lblNote.Visible = True
    Else
        hisLockInput Me, True
        lct.Visible = True
        fra.Visible = True
        lblNote.Visible = False
    End If
End Sub

Private Sub QueryObj_Ack(ByVal Cdt As String)
    Dim SQL As String
    
    SQL = "SELECT House_BusMain.BusSerial FROM House_BusMain" _
        & " INNER JOIN House_BusSub ON House_BusMain.BusSerial = House_BusSub.BusSerial " _
        & " WHERE DsCode = '" & gtydSysConfig.DepCode & "' AND " & Cdt & " GROUP BY House_BusMain.BusSerial"
    lct.SQL = SQL
    lct.Refresh
    If lct.Count > 0 Then
        mcr.Status = CL_UPDATE
        FillData
    Else
        mcr.Status = CL_ADD
        Init
    End If
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, Factor As Integer
    Dim Gprice As Currency, CPrice As Currency
    Dim Amount As Long, CurUnit As String, ItemCode As String, Model As String
    
    If ChangeMade Then
        spd.Col = Col
        spd.Row = Row
        TmpStr = spd.Text
        Select Case Col
            Case 2 '名称
                If TmpStr <> "" Then
                    CmnHlp.SQL = "SELECT m_Drug.ItemCode,m_Drug.ItemName,m_Drug.ItemName," _
                        & "m_Drug.Model," _
                        & "M_Drug.GenalUnit,m_Drug.factor,m_Drug.GPrice,m_Drug.Cprice " _
                        & "FROM m_Drug WHERE Brief Like '##%' and m_drug.flag & 32=0 " _
                        & gfnMakeLimit(gtydSysConfig.ItemCode, "ItemCode") _
                        & "UNION SELECT m_Drug.ItemCode,m_DrugAlias.AliasName," _
                        & "m_Drug.ItemName,m_Drug.Model,m_Drug.GenalUnit,m_Drug.factor," _
                        & "m_Drug.GPrice,m_Drug.Cprice " _
                        & "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 Row <> spd.MaxRows Then
                        spd.Row = Row
                        spd.Action = SS_ACTION_DELETE_ROW
                        spd.MaxRows = spd.MaxRows - 1
                        Sum
                    End If
                    
                End If
            Case 4 '单位 ----> 变  数量不变、批发、实际、零售
                If Row = spd.MaxRows Then Exit Sub
                CurUnit = TmpStr
                spd.Col = 1
                ItemCode = spd.Text
                spd.Col = 3
                Model = Left(spd.Text, InStr(spd.Text, " * ") - 1)
                spd.Text = Model & " * " & Int(CurUnitObj(ItemCode).Item(CurUnit).Factor)

                spd.Col = 5
                Amount = Val(spd.Text)
                spd.Col = 11
                Factor = Val(spd.Text)
                
                spd.Col = 6 '批发价
                spd.Text = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                Gprice = Val(spd.Text)
                spd.Col = 7
                spd.Text = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                spd.Col = 8 '零售价
                spd.Text = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                CPrice = Val(spd.Text)
                spd.Col = 9
                spd.Text = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                spd.Col = 10
                spd.Text = CPrice - Gprice
                spd.Col = 11
                spd.Text = CurUnitObj(ItemCode).Item(CurUnit).Factor
                Sum
            Case 5 '数量
                spd.Col = 6
                Gprice = Val(spd.Text)
                spd.Col = 7
                spd.Text = Val(TmpStr) * Gprice
                spd.Col = 8
                CPrice = Val(spd.Text)
                spd.Col = 9
                spd.Text = Val(TmpStr) * CPrice
                Sum

                
        End Select
    End If
End Sub
Private Sub Sum()
    Dim i As Integer
    Dim Total As Currency
    Dim Count As Long
    
    If mcr.Status = CL_ADD Then
        Count = spd.MaxRows - 1
    Else
        Count = spd.MaxRows
    End If
    
    spd.Col = 7
    For i = 1 To Count
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblGMoney = Format(Total, gstrMONEY_FORMAT)
    spd.Col = 9
    Total = 0
    For i = 1 To Count
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblCMoney = Format(Total, gstrMONEY_FORMAT)
    spd.Col = 10
    Total = 0
    For i = 1 To Count
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblCGMoney = Format(Total, gstrMONEY_FORMAT)
End Sub

Private Sub spd_KeyPress(KeyAscii As Integer)
    If spd.ActiveCol = 2 And 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
        
    End If
End Sub


Private Sub LoadData()
    Dim tmpObj As clsDrugItem
    Dim i As Integer
    
    ItemsObj.BusDate = gfnGetTime
    ItemsObj.Comment = lblAskSheetID & ":" & lblAsker & ":" '特殊处理
    ItemsObj.DtType = tsH_TRAN_OUT
    ItemsObj.VsDepCode = lblDepart.Tag
    ItemsObj.SheetID = txtSheetID
    ItemsObj.HdCode = gtydSysConfig.HdCode
    ItemsObj.HdName = gtydSysConfig.HdName
    ItemsObj.DsCode = gtydSysConfig.DepCode
    ItemsObj.DsName = gtydSysConfig.DepName
    ItemsObj.AskSerial = AsksObj.BusSerial
    ItemsObj.AskHdCode = AsksObj.HdCode
    ItemsObj.marker = txtMarker
    For i = 1 To spd.MaxRows - 1
        spd.Row = i
        Set tmpObj = New clsDrugItem
        spd.Col = 1
        tmpObj.ItemCode = spd.Text
        spd.Col = 11
        tmpObj.Factor = Val(spd.Text)
        spd.Col = 2
        tmpObj.itemname = spd.Text
        spd.Col = 3
        tmpObj.Model = Left(spd.Text, InStr(spd.Text, " * ") - 1)
        spd.Col = 4
        tmpObj.Unit = spd.Text
        spd.Col = 5
        tmpObj.Amount = Val(spd.Text) * tmpObj.Factor
        spd.Col = 6
        tmpObj.Gprice = Val(spd.Text) / tmpObj.Factor
        spd.Col = 8
        tmpObj.CPrice = Val(spd.Text) / tmpObj.Factor
        ItemsObj.AddObj tmpObj
    Next i
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 FillData()
    Dim tmpObj As clsDrugItem
    Dim i As Integer
    Dim Pos1 As Integer, Pos2 As Integer
    
    If ItemsObj Is Nothing Then
        Set ItemsObj = New clsDrugItems
    End If
    ItemsObj.BusSerialByQuery = lct.CurColumns!BusSerial
    txtSheetID = ItemsObj.SheetID
    If ItemsObj.Comment <> "" Then
        Pos1 = InStr(ItemsObj.Comment, ":")
        If Pos1 <> 0 Then
            lblAskSheetID = Left(ItemsObj.Comment, Pos1 - 1)
            Pos2 = InStr(Pos1 + 1, ItemsObj.Comment, ":")
            If Pos2 <> 0 Then
                lblAsker = mID(ItemsObj.Comment, Pos1 + 1, Pos2 - Pos1 - 1)
            End If
        End If
    End If
    spd.Redraw = False
    spd.MaxRows = 0
    spd.MaxRows = ItemsObj.Count
    i = 1
    For Each tmpObj In ItemsObj
        PutSpread i, tmpObj.ItemCode, tmpObj.itemname, tmpObj.Model, _
            tmpObj.Unit, tmpObj.Amount, tmpObj.Gprice, tmpObj.CPrice, tmpObj.Factor
        i = i + 1
    Next
    spd.Redraw = True
    Me.lblHander = ItemsObj.HdCode
    lblDate = Format(ItemsObj.BusDate, gstrCHINA_DATE)
    lblDepart = ItemsObj.VsDepName

    Sum
End Sub

Private Function ValidInput(ErrDes As String, Row As Long, Col As Long) As Object
    Dim i As Integer, Amount As Long
    
    If lblDepart.Tag = "" Then
        ErrDes = "必须选择调拨请领单!"
        Set ValidInput = txtSheetID
        Exit Function
    End If
    
    For i = 1 To spd.MaxRows - 1
        spd.Row = i
        spd.Col = 5
        Amount = Val(spd.Text)
        If Amount <= 0 Then
            ErrDes = "数量必须大于零!"
            Set ValidInput = spd
            Row = i
            Col = 5
            Exit Function
        End If
    Next i
    If spd.MaxRows = 1 Then
        ErrDes = "请输入药品项!"
        Set ValidInput = spd
        Row = 1
        Col = 2
        Exit Function
    End If
End Function
Private Sub FillDataByAsk()
    Dim tmpObj As clsDrugItem
    Dim i As Integer
    Dim TmpRs As Recordset
    
    lblAskSheetID = AsksObj.SheetID
    Set TmpRs = gDbObj.GetNewRs("Select HdName from m_Handler where HdCOde='" & AsksObj.HdCode & "'")
    lblAsker = TmpRs!HdName
    lblDepart = AsksObj.DsName
    lblDepart.Tag = AsksObj.DsCode
    spd.Redraw = False
    spd.MaxRows = 0
    spd.MaxRows = AsksObj.Count + 1
    i = 1
    For Each tmpObj In AsksObj
        PutSpread i, tmpObj.ItemCode, tmpObj.itemname, tmpObj.Model, _
            tmpObj.Unit, tmpObj.Amount, tmpObj.Gprice, tmpObj.CPrice, tmpObj.Factor
        i = i + 1
    Next
    spd.Redraw = True
    Sum
End Sub