clsinssick.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 = "clsInsSick"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public mstrSkID As String

'Public SkId As String
Public SickObj As clsSick
Public SpecillObj As clsSpecIlls
Public Name As String
Public num As Integer
Public IDCard As String    '身份证号
Public IcCard As String    'IC卡号
Public BloodType As String  '血型
Public medtype As String    '医保人员参保类型
Public jztype As String    '就诊类型

Public sociserial As String     '社保号码
Public AreaCode As String   '交费地区代码
Public PerFair As Currency '个人帐户余额
Public offsign As String   '公务员标识
Public offdeal As String    '公务员待遇
Public FixHosp As String  '定点医院
Public InType As String     '入院类型
'Public SpecIllSign As String
Public inHospStyle As String
Public Specill As String
Public SpecFixHosp As String
Public SpecFixHospSign As String
Public SpecStopDate As String

'医保病人分解后费用
Public SkSerial As String '病人序列号
Public TradeTotalMoney As Currency '本次交易总金额
Public TradeInTotalMoney As Currency  '医保内总金额
Public PreMoney As Currency '统筹支付金额
Public selfmoney As Currency '统筹自付金额
Public MOPreMoney As Currency '大额/公务员支付金额
Public MOSelfmoney As Currency  '大额/公务员自付金额
Public SelfTotalMoney As Currency '个人应付总金额
Public Paccmoney As Currency '个人账户支付
Public topin As Currency '本次交易统筹封顶后医保内总金额

'医保病人中途结算费用合计
Public MidTradeTotalMoney As Currency '本次交易总金额
Public MidTradeInTotalMoney As Currency  '医保内总金额
Public MidPreMoney As Currency '统筹支付金额
Public Midselfmoney As Currency '统筹自付金额
Public MidMOPreMoney As Currency '大额/公务员支付金额
Public MidMOSelfMoney As Currency  '大额/公务员自付金额
Public MidSelfTotalMoney As Currency '个人应付总金额
Public Midtopin As Currency '本次交易统筹封顶后医保内总金额
Public InsFlag As Integer
Public IcFlag As Boolean
Public homeFlag As Integer
Public Hidvstr As String
Public AccountGivFair As Currency
Public CashGivFair As Currency

Public BackFair As Currency
Public FatchFair As Currency
Public mCol As Collection
Public mFootSerial As String
Public SpecOpenPerSelfFair As Currency   '门诊特殊病个人自负总金额
Public CommOpenInFair As Currency    '普通门诊医保内金额
Public OpenOutFair As Currency     '门诊非医保金额
Public OpenTradeSerial As String
'Public InDate As String
'Public mPreFootDate As String

Public Property Get medtypedes() As String

    If gdbobj.GetRs("select code,value,defaultflag from f_genlcode where kindid='pertype' and code='" & medtype & "'") > 0 Then
        medtypedes = gdbobj.Rs!value
    End If
End Property

Public Property Get Area() As String

    If gdbobj.GetRs("select code,value,defaultflag from f_genlcode where kindid='areacode' and code='" & Me.AreaCode & "'") > 0 Then
        Area = gdbobj.Rs!value
    End If
End Property


Public Property Let SkFootID(ByVal vData As String)
    Dim TmpRs As Recordset
    Set TmpRs = gdbobj.GetNewRs("select * from ins_SickFoot where Footserial like '" & vData & "%' and cancelhd is null")
    Do While Not TmpRs.EOF
        mFootSerial = TmpRs!FootSerial
        TradeTotalMoney = TmpRs!FootedOutFair + TmpRs!FootedInFair
        TradeInTotalMoney = TmpRs!FootedInFair
        PreMoney = TmpRs!FootedAccountFair
        MOPreMoney = TmpRs!FootedMuchFair
        MOSelfmoney = TmpRs!FootedOffFair
        PreMoney = TmpRs!FootedPlanFair
        SelfTotalMoney = IIf(IsNull(TmpRs!FootedSelfTotalFair), 0, TmpRs!FootedSelfTotalFair)
        Paccmoney = IIf(IsNull(TmpRs!PaccFair), 0, TmpRs!PaccFair)
        Set TmpRs = gdbobj.GetNewRs("select * from ins_inpati_fairmain where Footserial like '" & mFootSerial & "' and skserial='" & SickObj.SkSerial & "'")
        If Not TmpRs Is Nothing Then
            If Not TmpRs.EOF Then
                topin = TmpRs!topin
            End If
        End If
        Exit Do
    Loop
End Property

Public Function FairAdd(SkSerial As String, num As Integer, ChargeYear As String, BeginDate As String, EndDate As String, _
            TotalMoney As Currency, InMoney As Currency, PreMoney As Currency, selfmoney As Currency, _
            MOPreMoney As Currency, MOSelfmoney As Currency, SelfTotalMoney As Currency, Optional sKey As String) As clsInsFairSub
    Dim InsFairSub As clsInsFairSub
    Set InsFairSub = New clsInsFairSub
    
    InsFairSub.SkSerial = SkSerial
    InsFairSub.num = IIf(num = 0, 1, num)
    InsFairSub.ChargeYear = ChargeYear
    InsFairSub.BeginDate = BeginDate
    InsFairSub.EndDate = EndDate
    InsFairSub.TotalMoney = TotalMoney
    InsFairSub.InMoney = InMoney
    InsFairSub.PreMoney = PreMoney
    InsFairSub.selfmoney = selfmoney
    InsFairSub.MOPreMoney = MOPreMoney
    InsFairSub.MOSelfmoney = MOSelfmoney
    InsFairSub.SelfTotalMoney = SelfTotalMoney
    If Len(sKey) > 0 Then
        mCol.Add InsFairSub, sKey
    Else
        mCol.Add InsFairSub
    End If
    Set FairAdd = InsFairSub
    Set InsFairSub = Nothing
End Function

Public Function Add(SkID As String, Name As String, medtype As String, inhosptype As String, _
            InDate As Date, OutDate As Date, outhosptype As String, totalfair As Currency, _
            socifair As Currency, muchfair As Currency, selfgeld As Currency, _
            topin As Currency, selfmoney As Currency, Optional sKey As String) As Boolean  ' As clsInsSickSub
    Dim InsSickSub As clsInsSickSub
    Set InsSickSub = New clsInsSickSub
    
    InsSickSub.SkID = SkID
    InsSickSub.Name = Name
    InsSickSub.medtype = medtype
    InsSickSub.inhosptype = inhosptype
    InsSickSub.InDate = InDate
    InsSickSub.OutDate = OutDate
    InsSickSub.outhosptype = outhosptype
    InsSickSub.totalfair = totalfair
    InsSickSub.socifair = socifair
    InsSickSub.muchfair = muchfair
    InsSickSub.selfgeld = selfgeld
    InsSickSub.topin = topin
    InsSickSub.selfmoney = selfmoney
    If Len(sKey) > 0 Then
        mCol.Add InsSickSub, sKey
    Else
        mCol.Add InsSickSub
    End If
    
    Add = True
    '返回已创建的对象
    'Set Add = InsSickSub
    'Set InsSickSub = Nothing
End Function
Public Property Get Item(ItemNum As Variant) As clsInsSickSub
    On Error GoTo lblerr:
    Set Item = mCol(ItemNum)
    gdbobj.GetRs ("select des from f_genlcode where kindid='medtype' and code='" & Item.medtype & "'")
    Item.medtypedes = gdbobj.Rs!Des
    gdbobj.GetRs ("select des from f_genlcode where kindid='inhosptype' and code='" & Item.inhosptype & "'")
    Item.inhosptypedes = gdbobj.Rs!Des
    gdbobj.GetRs ("select des from f_genlcode where kindid='outhosptype' and code='" & Item.outhosptype & "'")
    Item.outhosptypedes = gdbobj.Rs!Des
    
lblerr:
End Property
Public Property Get Count() As Long
    Count = mCol.Count
End Property
Public Property Get SkID() As String
    SkID = mstrSkID
End Property

Public Property Let SkID(ByVal vData As String)
    mstrSkID = vData
End Property

Public Function SkIdByQueryIns(ByVal SkID As String) As Boolean
    Dim Rs As Recordset
    Set Rs = gdbobj.GetNewRs("select top 1 * from ins_sickreginfo inner join ins_sickreginfoapd on ins_sickreginfoapd.skid=" _
                   & " ins_sickreginfo.skid where ins_sickreginfo.skid='" & SkID & "' order by num desc")
    If Rs.RecordCount > 0 Then
        SkSerial = SickObj.SkSerial
        IcCard = Rs!IcCard
        IDCard = yhCStr(Rs!IDCard)
        Specill = yhCStr(Rs!SpecIllType)
        InType = yhCStr(Rs!inhosptype)
        inHospStyle = yhCStr(Rs!inHospStyle)
        sociserial = Rs!socialid
        PerFair = Rs!peraccountmoney
        jztype = yhCStr(Rs!jztype)
        If IsNull(Rs!Flag) Then
            homeFlag = 0
        Else
            homeFlag = Rs!Flag
        End If
        num = Rs!num
        BloodType = yhCStr(Rs!BloodType)
        medtype = yhCStr(Rs!medtype)
        AreaCode = yhCStr(Rs!chargeareacode)
        offsign = Rs!ifofficial
        
        If Rs!ifofficial = "0" Then offdeal = Rs!officialdeal
        FixHosp = yhCStr(Rs!FixHosp)
        Me.SpecFixHospSign = yhCStr(Rs!SpecFixHospSign)
        If gdbobj.GetRs("select *from Ins_Inpati_perFairRecord where iccard='" & IcCard & "'") > 0 Then
            Do While Not gdbobj.Rs.EOF
                Add SickObj.SkID, SickObj.Name, gdbobj.Rs!medtype, yhCStr(gdbobj.Rs!inhosptype), gdbobj.Rs!inhospdate, _
                    gdbobj.Rs!outhospdate, gdbobj.Rs!outhosptype, gdbobj.Rs!totalfair, gdbobj.Rs!SocialPayFair, _
                    gdbobj.Rs!MuchPayFair, gdbobj.Rs!PerSelfPay, gdbobj.Rs!TopInFair, gdbobj.Rs!SelfPayFair
                gdbobj.Rs.MoveNext
            Loop
        End If
        Set SpecillObj = New clsSpecIlls
        SpecillObj.SkID = SkID
        SkIdByQueryIns = True
    Else
        SkIdByQueryIns = False
    End If
    'Set RS = gdbobj.GetNewRs("select *from ins_Inpati_perfairRecord where IcCard='" & ICcard & "' order by num")
    'If RS.RecordCount > 0 Then
        
    'End If
End Function

Public Function SkIdByICNo(ByVal ICNo As String, Optional Flag As Integer = 0) As Boolean
    Dim Rs As Recordset
    If Flag = 0 Then
        Set Rs = gdbobj.GetNewRs("select top 1 * from ins_sickreginfo inner join ins_sickreginfoapd on ins_sickreginfoapd.skid=" _
                       & " ins_sickreginfo.skid where ins_sickreginfo.ICCard='" & ICNo & "' and ins_sickreginfo.skid like 'M%' order by num desc")
    Else
        Set Rs = gdbobj.GetNewRs("select top 1 * from ins_sickreginfo inner join ins_sickreginfoapd on ins_sickreginfoapd.skid=" _
                       & " ins_sickreginfo.skid where ins_sickreginfo.ICCard='" & ICNo & "' " _
                       & " and not ins_sickreginfo.skid like 'M%' order by num desc")
    End If
    If Rs.RecordCount > 0 Then
        IcCard = Rs!IcCard
        IDCard = yhCStr(Rs!IDCard)
        Specill = yhCStr(Rs!SpecIllType)
        InType = yhCStr(Rs!inhosptype)
        inHospStyle = yhCStr(Rs!inHospStyle)
        sociserial = Rs!socialid
        PerFair = Rs!peraccountmoney
        jztype = yhCStr(Rs!jztype)
        homeFlag = IIf(IsNull(Rs!Flag), 0, Rs!Flag And 1)
        num = Rs!num
        BloodType = yhCStr(Rs!BloodType)
        medtype = yhCStr(Rs!medtype)
        AreaCode = yhCStr(Rs!chargeareacode)
        offsign = Rs!ifofficial
        If Rs!ifofficial = "0" Then offdeal = Rs!officialdeal
        FixHosp = yhCStr(Rs!FixHosp)
        Set SickObj = New clsSick
        SickObj.SkIDByQuery = Rs!SkID
        If gdbobj.GetRs("select *from Ins_Inpati_perFairRecord where iccard='" & IcCard & "'") > 0 Then
            Do While Not gdbobj.Rs.EOF
                Add SickObj.SkID, SickObj.Name, gdbobj.Rs!medtype, yhCStr(gdbobj.Rs!inhosptype), gdbobj.Rs!inhospdate, _
                    gdbobj.Rs!outhospdate, gdbobj.Rs!outhosptype, gdbobj.Rs!totalfair, gdbobj.Rs!SocialPayFair, _
                    gdbobj.Rs!MuchPayFair, gdbobj.Rs!PerSelfPay, gdbobj.Rs!TopInFair, gdbobj.Rs!SelfPayFair
                gdbobj.Rs.MoveNext
            Loop
        End If
        SkIdByICNo = True
        Set SpecillObj = New clsSpecIlls
        SpecillObj.SkID = Rs!SkID
        
    Else
        SkIdByICNo = False
    End If
    'Set RS = gdbobj.GetNewRs("select *from ins_Inpati_perfairRecord where IcCard='" & ICcard & "' order by num")
    'If RS.RecordCount > 0 Then
        
    'End If
End Function

Public Function FootPrint(ByVal FootSerial As String, ByVal FootDate As String, _
    ByVal TDepName As String, ByVal PayMode As Integer, Optional EndDate As String = "", Optional SheetID As String = "", Optional SkSerial As String) As Boolean
    
    'PayMode 0  现金
    Dim mpg As clsPage
    Dim FairObj As clsItemFairs