clsdrugitems.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDrugItems"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"clsDrugItem"
Attribute VB_Ext_KEY = "Member0" ,"clsDrugItem"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Option Explicit

Public BusSerial As String
Public DsCode As String  '药库药房ID
Public DsName As String

Public DtType As TSDtType

Public SheetID As String
Public VsDepCode As String '对方ID
Public VsDepName As String '对方Name


Public BusDate As String
Public HdCode As String
Public HdName As String

Public Comment As String        '备注
Public flag As Integer
Public AskSerial As String
Public AskHdCode As String
Public marker As String
Private mCol As Collection
Public Sub AddObj(tmpObj As clsDrugItem)
    mCol.Add tmpObj
End Sub

Public Function Add(ByVal ItemCode, ByVal itemname, ByVal Model, ByVal Amount, ByVal Gprice, ByVal CPrice, ByVal Unit, ByVal Factor, Optional sKey As String) As clsDrugItem
    '创建新对象
    Dim objNewMember As clsDrugItem
    Set objNewMember = New clsDrugItem
    
    objNewMember.ItemCode = ItemCode
    objNewMember.itemname = itemname
    objNewMember.Model = Model
    objNewMember.Amount = Amount
    objNewMember.Factor = Factor
    objNewMember.Gprice = Gprice
    objNewMember.CPrice = CPrice
    objNewMember.Unit = IIf(IsNull(Unit), "", Unit)
    objNewMember.Factor = Factor
    
    '设置传入方法的属性
    mCol.Add objNewMember


    '返回已创建的对象
    Set Add = objNewMember
    Set objNewMember = Nothing
    Exit Function
End Function
Public Function Save(Optional Trans As Boolean = True) As Boolean
    Dim tmpObj As clsDrugItem
    Dim i As Integer
    Dim DrugAmountsObj As clsDrugAmounts
    Dim VsDrugAmountsObj As clsDrugAmounts
    Dim TmpStr As String
    Dim VsBusSerial As String
    
On Error GoTo errlbl
    BusSerial = gFnGetSerial(stHouseBusSerial)
    Set DrugAmountsObj = New clsDrugAmounts
   If DtType <> tsH_ASK_IN And DtType <> tsH_TRAN_IN Then
        DrugAmountsObj.Direct = Direct
        DrugAmountsObj.DtType = Me.DtType
        DrugAmountsObj.DsCode = gtydSysConfig.DepCode
        For Each tmpObj In mCol
            DrugAmountsObj.Add tmpObj.ItemCode, tmpObj.itemname, tmpObj.Amount
        Next
        Call DrugAmountsObj.GetStorage
        If Not DrugAmountsObj.JugeStorageForOut And DrugAmountsObj.Direct = -1 Then
            gDbObj.ErrDes = DrugAmountsObj.Info
            Exit Function
        End If
        If DtType = tsH_TRAN_OUT Then
            Set VsDrugAmountsObj = New clsDrugAmounts
            VsDrugAmountsObj.Direct = 1
            VsDrugAmountsObj.DtType = tsH_TRAN_IN
            VsDrugAmountsObj.DsCode = VsDepCode
            For Each tmpObj In mCol
                VsDrugAmountsObj.Add tmpObj.ItemCode, tmpObj.itemname, tmpObj.Amount
            Next
            Call VsDrugAmountsObj.GetStorage
            TmpStr = gtydSysConfig.HdCode
            gtydSysConfig.HdCode = AskHdCode
            VsBusSerial = gFnGetSerial(stHouseBusSerial)
            gtydSysConfig.HdCode = TmpStr
            If AskHdCode = HdCode Then
                TmpStr = gfnGetTime(gstrSERIAL_DATE) & HdCode
                BusSerial = TmpStr & Format(Right(VsBusSerial, Len(VsBusSerial) - Len(TmpStr)) + 1, _
                            hisStrRepeat("0", gintSERIAL_BITS))
                
            End If
        End If
        
    End If
    gDbObj.CNExe.BeginTrans
    If DtType = tsH_TRAN_OUT Then

        If Not Update_House_BusMain(HISDBUpdate, flag:=3, _
            UpdateCondition:="BusSerial = '" & AskSerial & "'") Then
            
            GoTo errlbl
        End If
        If Not VsDrugAmountsObj.UpDateStorage Then GoTo errlbl
        If Not Update_House_BusMain(HISDbInsert, VsBusSerial, VsDepCode, _
            gTsObj.Code(tsH_TRAN_IN), 1, BusDate, AskHdCode, gtydSysConfig.DepCode, _
            SheetID, 0) Then
            
            GoTo errlbl
        End If
        
    End If
   If DtType <> tsH_ASK_IN And DtType <> tsH_TRAN_IN Then
        If Not DrugAmountsObj.UpDateStorage Then GoTo errlbl
    End If
    If Not Update_House_BusMain(HISDbInsert, BusSerial, gtydSysConfig.DepCode, gTsObj.Code(DtType), _
        Direct, BusDate, HdCode, VsDepCode, SheetID, flag, Comment, marker) Then
        
        GoTo errlbl
    End If
    For Each tmpObj In mCol
        i = i + 1
        If Not Update_House_BusSub(HISDbInsert, BusSerial, i, tmpObj.ItemCode, tmpObj.Amount, _
            tmpObj.Gprice, tmpObj.GMoney, tmpObj.CPrice, tmpObj.CMoney, tmpObj.Unit, tmpObj.Factor) Then
            
            GoTo errlbl
        End If
        If DtType = tsH_TRAN_OUT Then
            If Not Update_House_BusSub(HISDbInsert, VsBusSerial, i, tmpObj.ItemCode, tmpObj.Amount, _
                tmpObj.Gprice, tmpObj.GMoney, tmpObj.CPrice, tmpObj.CMoney, tmpObj.Unit, tmpObj.Factor) Then
                GoTo errlbl
            End If
        End If
    Next
    gDbObj.CNExe.CommitTrans
    Save = True
    Exit Function
errlbl:
    gDbObj.CNExe.RollbackTrans
End Function

Public Property Get Item(vntIndexKey As Variant) As clsDrugItem
Attribute Item.VB_UserMemId = 0
    '引用集合中的一个元素时使用。
    'vntIndexKey 包含集合的索引或关键字，
    '这是为什么要声明为 Variant 的原因
    '语法：Set foo = x.Item(xyz) or Set foo = x.Item(5)
  Set Item = mCol(vntIndexKey)
End Property



Public Property Get Count() As Long
    '检索集合中的元素数时使用。语法：Debug.Print x.Count
    Count = mCol.Count
End Property


Public Sub Remove(vntIndexKey As Variant)
    '删除集合中的元素时使用。
    'vntIndexKey 包含索引或关键字，这是为什么要声明为 Variant 的原因
    '语法：x.Remove(xyz)


    mCol.Remove vntIndexKey
End Sub


Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    '本属性允许用 For...Each 语法枚举该集合。
    Set NewEnum = mCol.[_NewEnum]
End Property


Private Sub Class_Initialize()
    '创建类后创建集合
    Set mCol = New Collection

End Sub


Private Sub Class_Terminate()
    '类终止后破坏集合
    Set mCol = Nothing
End Sub
Public Property Get CMoney() As Single
    Dim i As Integer
    
    For i = 1 To Count
        CMoney = CMoney + Item(i).CMoney
    Next i
End Property
Public Property Get GMoney() As Single
    Dim i As Integer
    
    For i = 1 To Count
        GMoney = GMoney + Item(i).GMoney
    Next i
End Property

Public Property Let BusSerialByQuery(ByVal Vdata As String)
    Dim TmpRs As Recordset
    
    Set TmpRs = gDbObj.GetNewRs("SELECT House_BusMain.*,House_BusSub.*,m_Depart.DepName,m_Drug.ItemName," _
        & " m_Drug.Model,Dep1.DepName as 'DsName',marker " _
        & " FROM (((House_BusMain INNER JOIN House_BusSub ON House_BusMain.BusSerial = House_BusSub.BusSerial) " _
        & " INNER JOIN m_Drug ON House_BusSub.ItemCode = m_Drug.ItemCode) " _
        & " LEFT JOIN m_Depart Dep1 ON House_BusMain.DsCode = Dep1.DepCode)" _
        & " LEFT JOIN m_Depart ON House_BusMain.VsDepCode = m_Depart.DepCode" _
        & " WHERE House_BusMain.BusSerial = '" & Vdata & "'")
    Me.Clear
    Me.BusSerial = Vdata
    Do Until TmpRs.EOF
        Me.SheetID = IIf(IsNull(TmpRs!SheetID), "", TmpRs!SheetID)
        DtType = gTsObj.GetDtTypeByDtCode(TmpRs!DtCode)
        HdCode = TmpRs!HdCode
        DsCode = TmpRs!DsCode
        DsName = TmpRs!DsName
        VsDepCode = IIf(IsNull(TmpRs!VsDepCode), "", TmpRs!VsDepCode)
        VsDepName = IIf(IsNull(TmpRs!DepName), "", TmpRs!DepName)
        Comment = IIf(IsNull(TmpRs!Comment), "", TmpRs!Comment)
        marker = IIf(IsNull(TmpRs!marker), "", TmpRs!marker)
        BusDate = TmpRs!BusDate
        flag = TmpRs!flag
        Me.Add TmpRs!ItemCode, TmpRs!itemname, TmpRs!Model, TmpRs!Amount, TmpRs!Gprice, TmpRs!CPrice, _
            TmpRs!Unit, TmpRs!Factor
        TmpRs.MoveNext
    Loop
End Property
Public Sub Clear()
    Dim i As Integer
    
    For i = 1 To mCol.Count
        Remove 1
    Next i
End Sub
Public Property Get Direct() As Integer

    If DtType = tsH_ASK_IN Or DtType = tsH_DEPART_IN Or DtType = tsH_PATIENT_IN _
        Or DtType = tsH_SICK_IN Or DtType = tsH_TRAN_IN Or DtType = tsA_CHECK_IN Then
        
        Direct = 1
    Else
        Direct = -1
    End If
End Property


Public Function FindDrug(ByVal ItemCode As String) As Boolean
    Dim tmpObj As clsDrugItem
    
    For Each tmpObj In mCol
        If tmpObj.ItemCode = ItemCode Then
            FindDrug = True
            Exit Function
        End If
    Next
End Function

Public Sub PrintSheet(Optional Asker As String, Optional AskSheetId As String)
    Dim mPg As clsPage
    Dim tmpObj As clsDrugItem, i As Integer, J As Integer, PageNum As Integer
    Dim Rows As Integer, Pages As Integer
    Dim SubGMoney As Currency, SubCMoney As Currency
    Dim SubDevCGMoney As Currency
    Dim GMoney As Currency, CMoney As Currency
    Dim DevCGMoney As Currency
    
    
On Error GoTo errlbl
    Set mPg = New clsPage
    Set mPg.gDbObj = gDbObj
    If mPg.ReadFromDB("House_BusSheet") Then
        mPg.IDValue("HospName") = gtydSysConfig.HospName
        mPg.IDValue("Title") = gTsObj.Name(DtType) & "单"
        mPg.IDValue("SheetID") = SheetID
        Select Case DtType
            Case tsH_ASK_IN, tsH_BACK_OUT
                mPg.IDValue("VsDepartTitle") = "药库"
            Case tsH_TRAN_IN, tsH_TRAN_OUT
                mPg.IDValue("VsDepartTitle") = "药房"
            Case tsH_DEPART_IN, tsH_DEPART_OUT
                mPg.IDValue("VsDepartTitle") = "科室"
        End Select
        mPg.IDValue("VsDepart") = VsDepName
        mPg.IDValue("HdName") = HdName
        mPg.IDValue("BusDate") = Format(Me.BusDate, gstrCOMN_DATE)
        mPg.IDValue("CurDate") = gfnGetTime(gstrCOMN_DATE)
        mPg.IDValue("DepName") = gtydSysConfig.DepName
        mPg.IDValue("Marker") = marker
        If DtType = tsH_TRAN_OUT Then
            If Not (mPg.IDObject("askSheetIDTitle") Is Nothing) Then
                mPg.IDValue("askSheetIDTitle") = mPg.IDObject("askSheetIDTitle").Str
            End If
            If Not (mPg.IDObject("askerTitle") Is Nothing) Then
                mPg.IDValue("askerTitle") = mPg.IDObject("askerTitle").Str
            End If
            mPg.IDValue("askSheetID") = AskSheetId
            mPg.IDValue("asker") = Asker
        End If
        
        J = 1
        For Each tmpObj In mCol
            If mPg.IDObject("Name" & J) Is Nothing Then
                Exit For
            End If
            J = J + 1
        Next
        
        Rows = J - 1
        If Rows <= 0 Then Exit Sub
        Pages = Me.Count \ Rows + IIf(Me.Count Mod Rows = 0, 0, 1)
        mPg.IDValue("Pages") = Pages
        J = 0
        For Each tmpObj In mCol
            J = J + 1
            mPg.IDValue("Name" & J) = tmpObj.itemname
            mPg.IDValue("Model" & J) = tmpObj.Model
            mPg.IDValue("ModelFactor" & J) = tmpObj.Model & "*" & tmpObj.Factor
            mPg.IDValue("Model" & J) = tmpObj.Model
            mPg.IDValue("Unit" & J) = tmpObj.Unit
            mPg.IDValue("Amount" & J) = tmpObj.Amount / tmpObj.Factor
            mPg.IDValue("GPrice" & J) = Format(tmpObj.Gprice * tmpObj.Factor, gstrMONEY_FORMAT_EXT)
            mPg.IDValue("GMoney" & J) = Format(tmpObj.GMoney, gstrMONEY_FORMAT)
            mPg.IDValue("CPrice" & J) = Format(tmpObj.CPrice * tmpObj.Factor, gstrMONEY_FORMAT_EXT)
            mPg.IDValue("CMoney" & J) = Format(tmpObj.CMoney, gstrMONEY_FORMAT)
            mPg.IDValue("DevCGMoney" & J) = Format(tmpObj.CMoney - tmpObj.GMoney, gstrMONEY_FORMAT)
            mPg.IDValue("DevCGPrice" & J) = Format(tmpObj.CPrice - tmpObj.Gprice, gstrMONEY_FORMAT)
            SubGMoney = SubGMoney + tmpObj.GMoney
            SubCMoney = SubCMoney + tmpObj.CMoney
            SubDevCGMoney = SubDevCGMoney + tmpObj.CMoney - tmpObj.GMoney
            If J = Rows Or J + PageNum * Rows = Count Then
                GMoney = GMoney + SubGMoney
                CMoney = CMoney + SubCMoney
                DevCGMoney = DevCGMoney + SubDevCGMoney
                mPg.IDValue("GMoney") = Format(SubGMoney, gstrMONEY_FORMAT)
                mPg.IDValue("CMoney") = Format(SubCMoney, gstrMONEY_FORMAT)
                mPg.IDValue("DevCGMoney") = Format(SubDevCGMoney, gstrMONEY_FORMAT)
                If J + PageNum * Rows = Count Then '完成
                    mPg.IDValue("TGMoney") = Format(GMoney, gstrMONEY_FORMAT)
                    mPg.IDValue("TCMoney") = Format(CMoney, gstrMONEY_FORMAT)
                    mPg.IDValue("TDevCGMoney") = Format(DevCGMoney, gstrMONEY_FORMAT)
                End If
                PageNum = PageNum + 1
                mPg.IDValue("PageNum") = PageNum
                SubGMoney = 0
                SubCMoney = 0
                SubDevCGMoney = 0
                mPg.RPrint
                For i = 1 To J
                    mPg.IDValue("Name" & i) = ""
                    mPg.IDValue("Model" & i) = ""
                    mPg.IDValue("ModelFactor" & i) = ""
                    mPg.IDValue("Unit" & i) = ""
                    mPg.IDValue("Amount" & i) = ""
                    mPg.IDValue("GPrice" & i) = ""
                    mPg.IDValue("GMoney" & i) = ""
                    mPg.IDValue("CPrice" & i) = ""
                    mPg.IDValue("CMoney" & i) = ""
                    mPg.IDValue("DevCGMoney" & i) = ""
                    mPg.IDValue("DevCGPrice" & i) = ""
                Next i
                J = 0
            End If
        Next
    End If
errlbl:

End Sub