clsinssick.cls

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

    Dim I As Integer, j As Integer
    Dim capstr As String
    Dim TmpRs As Recordset, TPrePay As Currency, TPrePayA As Currency
    Dim BeginDate As String
    Dim tmpfoot As String
    If InStr(FootSerial, "-") > 0 Then
        tmpfoot = left(FootSerial, InStr(FootSerial, "-") - 1)
    Else
        tmpfoot = FootSerial
    End If
On Error GoTo errlbl
    BeginDate = IIf(SickObj.mPreFootDate = "", SickObj.InDate, SickObj.mPreFootDate)
    Set mpg = New clsPage
    Set mpg.gdbobj = gdbobj
    'If gtydSysConfig.SheetName = "" Then gtydSysConfig.SheetName = "Ins_Inpati_sickFoot"
    If mpg.ReadFromDB(IIf(SickObj.depcode = gtydSysConfig.HomeDepcode, "open_ins_sickfoot", "inpati_ins_sickfoot")) Then
'        Set tmprs = gDbObj.GetNewRs("select sum(payfair) from sickpay where footserial='" & footserial & "' and paytype=0")
        If SheetID <> "" Then
            Call gdbobj.DBExec("update sickfoot set sheetID='" & SheetID & "' where footserial like '" & FootSerial & "%' " _
                 & "and sheetid is null")
        End If
        Set FairObj = New clsItemFairs
        FairObj.Make "INS_GetCatiFairBySick '" & SkSerial & "','" & tmpfoot & "','',''"
        mpg.IDValue("Name") = SickObj.Name
        mpg.IDValue("Sex") = SickObj.SexDes
        mpg.IDValue("FootDate") = Format(FootDate, "yyyy-mm-dd")
        mpg.IDValue("CurDate") = gfnGetTime("yyyy-mm-dd")
        mpg.IDValue("HdName") = gtydSysConfig.HdCode
        mpg.IDValue("HdCode") = gtydSysConfig.HdCode
        mpg.IDValue("PtType") = SickObj.PtDes
        mpg.IDValue("DepName") = TDepName
        mpg.IDValue("InDate") = Format(BeginDate, "yyyy-mm-dd")
        mpg.IDValue("OutDate") = Format(IIf(SickObj.OutDate = "", EndDate, SickObj.OutDate), "yyyy-mm-dd")
        mpg.IDValue("EndDate") = Format(IIf(EndDate = "", SickObj.OutDate, EndDate), "yyyy-mm-dd")
        mpg.IDValue("InYear") = Format(BeginDate, "yyyy")
        mpg.IDValue("InMonth") = Format(BeginDate, "mm")
        mpg.IDValue("Inday") = Format(BeginDate, "dd")
        mpg.IDValue("OutYear") = Format(SickObj.OutDate, "yyyy")
        mpg.IDValue("OutMonth") = Format(SickObj.OutDate, "mm")
        mpg.IDValue("Outday") = Format(SickObj.OutDate, "dd")
        mpg.IDValue("FootYear") = Format(FootDate, "yyyy")
        mpg.IDValue("FootMonth") = Format(FootDate, "mm")
        mpg.IDValue("Footday") = Format(FootDate, "dd")
        mpg.IDValue("Addr") = SickObj.Addr
        mpg.IDValue("HospName") = gtydSysConfig.hospname
        mpg.IDValue("BeginDateTitle") = IIf(SickObj.mPreFootDate = "", "入院日期:", "上次结算:")
        mpg.IDValue("SkSerial") = SkSerial
        mpg.IDValue("MedType") = Right(gGetDes("pertype", medtype), Len(gGetDes("pertype", medtype)) - InStr(1, gGetDes("pertype", medtype), " "))
        mpg.IDValue("IcCard") = IcCard
        mpg.IDValue("IdCard") = IDCard
        mpg.IDValue("fatchfair") = FatchFair
        mpg.IDValue("backfair") = BackFair
        
        If EndDate <> "" Then '中途结算
            mpg.IDValue("InDays") = DateDiff("d", BeginDate, EndDate)
            mpg.IDValue("EndDateTitle") = "中结日期:"
            
        Else
            mpg.IDValue("InDays") = DateDiff("d", BeginDate, SickObj.OutDate)
            mpg.IDValue("BeginDateTitle") = "出院日期:"
        End If
            
        mpg.IDValue("PayMode") = IIf(PayMode = 0, "现金", "支票")
        mpg.IDValue("Age") = SickObj.Age
        mpg.IDValue("SkID") = SickObj.SkID
        j = 1
        For I = 1 To FairObj.Count
            If mpg.IDObject(FairObj.Item(I).ID & "Value") Is Nothing Then
                mpg.IDValue("AddItemDes" & j) = FairObj.Item(I).Des
                mpg.IDValue("AddItemFair" & j) = Format(FairObj.Item(I).InFair, gstrMONEY_FORMAT)
                j = j + 1
            Else
                mpg.IDValue(FairObj.Item(I).ID) = FairObj.Item(I).Des
                mpg.IDValue(FairObj.Item(I).ID & "Value") = Format(FairObj.Item(I).InFair, gstrMONEY_FORMAT)
            End If
            mpg.IDValue("ItemDes" & I) = FairObj.Item(I).Des
            mpg.IDValue("ItemFair" & I) = Format(FairObj.Item(I).InFair, gstrMONEY_FORMAT)
        Next I
        mpg.IDValue("Fair") = Format(FairObj.InFair, gstrMONEY_FORMAT)
        mpg.IDValue("FairCap") = hisGetMoneyCap(FairObj.InFair)
        mpg.IDValue("TFair") = Format(FairObj.Fair, gstrMONEY_FORMAT)
        mpg.IDValue("TFairCap") = hisGetMoneyCap(FairObj.Fair)
        mpg.IDValue("RateFair") = Format(FairObj.Fair - FairObj.InFair, gstrMONEY_FORMAT)
        mpg.IDValue("RateFairCap") = hisGetMoneyCap(FairObj.Fair - FairObj.InFair)
        capstr = Format(Abs(FairObj.InFair * 100), "##################")
        For I = 0 To Len(capstr) - 1
            mpg.IDValue("FairCap" & Format(I, "0")) = GetCap(Mid(capstr, Len(capstr) - I, 1))
        Next I

        capstr = Format(Abs(FairObj.Fair * 100), "##################")
        For I = 0 To Len(capstr) - 1
            mpg.IDValue("TFairCap" & Format(I, "0")) = GetCap(Mid(capstr, Len(capstr) - I, 1))
        Next I
        
        capstr = Format(Abs((FairObj.Fair - FairObj.InFair) * 100), "##################")
        For I = 0 To Len(capstr) - 1
            mpg.IDValue("RateFairCap" & Format(I, "0")) = GetCap(Mid(capstr, Len(capstr) - I, 1))
        Next I
                
        '以下为医保病人的结算明晰
        'Set TmpRs = gDbObj.GetNewRs("select tradetotalmoney,tradeintotalmoney,premoney,selfmoney,mopremoney,moselfmoney," _
                                & " selftotalmoney,topin from ins_inpati_fairmain where skserial='" & SkSerial & "'")
        If InStr(FootSerial, "-") > 0 Then
            SkSerialQueryFair SkSerial, FootSerial, 2
        Else
            SkSerialQueryFair SkSerial, tmpfoot, 0
        End If
        mpg.IDValue("commopeninfair") = TradeInTotalMoney
        mpg.IDValue("openoutfair") = TradeTotalMoney - TradeInTotalMoney
        mpg.IDValue("infair") = TradeInTotalMoney
        mpg.IDValue("outfair") = TradeTotalMoney - TradeInTotalMoney
        mpg.IDValue("AccountFair") = AccountGivFair
        mpg.IDValue("MuchFair") = IIf(offsign, MOPreMoney, 0)
        mpg.IDValue("PlanFair") = PreMoney
        mpg.IDValue("OffFair") = IIf(offsign, 0, MOPreMoney)
        mpg.IDValue("CashFair") = TradeInTotalMoney - AccountGivFair - PreMoney - MOPreMoney
        mpg.IDValue("CashSelfFair") = SelfTotalMoney - AccountGivFair 'TradeTotalMoney - TradeInTotalMoney
        mpg.IDValue("MidFootFair") = MidTradeTotalMoney - MidTradeInTotalMoney
        
        Set TmpRs = gdbobj.GetNewRs("SELECT Sum(case when paytype=0 then PayFair else 0 end)," _
                & "Sum(case when paytype=1 or paytype=3 or paytype=2 then PayFair else 0 end) FROM SickPay " _
            & "WHERE FootSerial ='" & FootSerial & "'")
        
        If IsNull(TmpRs.Fields(0)) Then
            TPrePay = 0
        Else
            TPrePay = TmpRs.Fields(0)
        End If
        If IsNull(TmpRs.Fields(1)) Then
            TPrePayA = 0
        Else
            TPrePayA = Round(TmpRs.Fields(1), 2)
        End If
        mpg.IDValue("PrePay") = Format(TPrePay, gstrMONEY_FORMAT)
        mpg.IDValue("PrePayCap") = hisGetMoneyCap(TPrePayA)
        If TPrePay > Me.SelfTotalMoney Then
            mpg.IDValue("PaySwitch") = "实退"
            If PayMode = 0 Then
                mpg.IDValue("backPay") = Format(-TPrePayA, gstrMONEY_FORMAT)
            Else
                mpg.IDValue("backPayB") = Format(-TPrePayA, gstrMONEY_FORMAT)
            End If
            mpg.IDValue("BackPayCap") = hisGetMoneyCap(TPrePayA)
            
        Else
            mpg.IDValue("PaySwitch") = "实交"
            If FairObj.Fair - TPrePay > TPrePayA Then
                mpg.IDValue("PayDec") = Format(FairObj.InFair - TPrePay - TPrePayA, gstrMONEY_FORMAT)
            End If
            If PayMode = 0 Then
                mpg.IDValue("Pay") = Format(TPrePayA, gstrMONEY_FORMAT)
            Else
                mpg.IDValue("PayB") = Format(TPrePayA, gstrMONEY_FORMAT)
            End If
            mpg.IDValue("PayCap") = hisGetMoneyCap(TPrePayA)
        End If
        mpg.IDValue("ABSPay") = Format(Abs(FairObj.InFair - TPrePay), gstrMONEY_FORMAT)
        mpg.IDValue("ABSPayCap") = hisGetMoneyCap(Abs(FairObj.InFair - TPrePay))
        If gdbobj.GetRs("SELECT COUNT(DISTINCT SICKFOOT.FOOTSERIAL) FROM SickFoot " _
            & "INNER JOIN SickPay ON SickFoot.FootSerial = SickPay.FootSerial and PayType in (1,2) " _
            & "WHERE SickPay.PayDate <= '" & FootDate & "'") > 0 Then
            mpg.IDValue("FootID") = Format(gdbobj.Rs(0), "000000")
        End If
        If gtydSysConfig.Status > 0 Then
            mpg.RPrint
        Else
            mpg.PreView vbModal
        End If
        FootPrint = True
    End If
errlbl:
End Function

Public Function SkSerialQueryFairCZ(ByVal SkSerial As String, Optional FootSerial As String, Optional CZ As String)
    Dim TmpRs As Recordset
    Set TmpRs = gdbobj.GetNewRs("select tradetotalmoney,tradeintotalmoney,premoney,selfmoney,mopremoney,moselfmoney," _
                            & " selftotalmoney,topin,busserial from ins_inpati_fairmain where skserial='" & SkSerial & "' " _
                            & " and " & IIf(FootSerial = "", "footserial is null", "footserial='" & FootSerial & "'") _
                            & " and " & IIf(CZ = "0", "flag & 2=0", "flag & 2=2"))
    If Not TmpRs.EOF Then
        TradeTotalMoney = TmpRs!TradeTotalMoney
        TradeInTotalMoney = TmpRs!TradeInTotalMoney
        PreMoney = TmpRs!PreMoney
        selfmoney = TmpRs!selfmoney
        MOPreMoney = TmpRs!MOPreMoney
        MOSelfmoney = TmpRs!MOSelfmoney
        SelfTotalMoney = TmpRs!SelfTotalMoney
        topin = TmpRs!topin
        AccountGivFair = 0
        OpenTradeSerial = TmpRs!busserial
    End If
End Function
Public Function SkSerialQueryFair(ByVal SkSerial As String, Optional FootSerial As String, Optional Status As Integer)
    Dim TmpRs As Recordset
    Dim sqlstr As String
    
    Select Case Status
    Case 2
        sqlstr = "select tradetotalmoney,tradeintotalmoney,premoney,selfmoney,mopremoney,moselfmoney," _
             & " selftotalmoney,topin,ins_inpati_fairmain.specopenperselffair,ins_inpati_fairmain.commopeninfair,ins_inpati_fairmain.openoutfair,paccfair " _
             & " ,ins_inpati_fairmain.busserial from ins_inpati_fairmain " _
             & "inner join ins_sickfoot on ins_sickfoot.footserial=ins_inpati_fairmain.footserial " _
             & "where skserial='" & SkSerial & "' " _
             & " and " & IIf(FootSerial = "", "ins_inpati_fairmain.footserial is null", "ins_inpati_fairmain.footserial='" & FootSerial & "'") & " and ins_inpati_fairmain.flag & 2=2"
    Case 0
        sqlstr = "select tradetotalmoney,tradeintotalmoney,premoney,selfmoney,mopremoney,moselfmoney," _
             & " selftotalmoney,topin,ins_inpati_fairmain.specopenperselffair ,ins_inpati_fairmain.commopeninfair,ins_inpati_fairmain.openoutfair,paccfair " _
             & " ,ins_inpati_fairmain.busserial from ins_inpati_fairmain " _
             & "inner join ins_sickfoot on ins_sickfoot.footserial=ins_inpati_fairmain.footserial " _
              & "where skserial='" & SkSerial & "' " _
              & " and " & IIf(FootSerial = "", "ins_inpati_fairmain.footserial is null", "ins_inpati_fairmain.footserial='" & FootSerial & "'")
    Case Else
    
        sqlstr = "select tradetotalmoney,tradeintotalmoney,premoney,selfmoney,mopremoney,moselfmoney," _
             & " selftotalmoney,topin,ins_inpati_fairmain.specopenperselffair,ins_inpati_fairmain.commopeninfair,ins_inpati_fairmain.openoutfair,paccfair " _
             & " ,ins_inpati_fairmain.busserial from ins_inpati_fairmain " _
             & "inner join ins_sickfoot on ins_sickfoot.footserial=ins_inpati_fairmain.footserial " _
              & "where skserial='" & SkSerial & "' " _
              & " and " & IIf(FootSerial = "", "ins_inpati_fairmain.footserial is null", "ins_inpati_fairmain.footserial='" & FootSerial & "'") & " and ins_inpati_fairmain.flag & 4=0"
    End Select
    Set TmpRs = gdbobj.GetNewRs(sqlstr)
    If Not TmpRs.EOF Then
        TradeTotalMoney = TmpRs!TradeTotalMoney
        TradeInTotalMoney = TmpRs!TradeInTotalMoney
        PreMoney = TmpRs!PreMoney
        selfmoney = TmpRs!selfmoney
        MOPreMoney = TmpRs!MOPreMoney
        MOSelfmoney = TmpRs!MOSelfmoney
        SelfTotalMoney = TmpRs!SelfTotalMoney
        topin = TmpRs!topin
        SpecOpenPerSelfFair = IIf(IsNull(TmpRs!SpecOpenPerSelfFair), 0, TmpRs!SpecOpenPerSelfFair)
        CommOpenInFair = IIf(IsNull(TmpRs!CommOpenInFair), 0, TmpRs!CommOpenInFair)
        OpenOutFair = IIf(IsNull(TmpRs!OpenOutFair), 0, TmpRs!OpenOutFair)
        Me.AccountGivFair = IIf(IsNull(TmpRs!PaccFair), 0, TmpRs!PaccFair)
        OpenTradeSerial = TmpRs!busserial
        If Status = 2 Then AccountGivFair = 0
    End If
End Function

Public Function Save(Optional UpFlag As DbOpType = HISDbInsert) As Boolean
    Dim tmpobj As clsInsSickSub
    Dim dnum As Integer
    Dim SQL As String
    Dim Flag As Integer
    Flag = homeFlag
    Select Case UpFlag
    Case HISDbInsert
        SQL = "select max(num) as num from ins_sickreginfoapd where skid='" & SkID & "' and footserial is not null"
        If gdbobj.GetRs(SQL) > 0 Then
            dnum = IIf(IsNull(gdbobj.Rs!num), 1, gdbobj.Rs!num + 1)
        Else
            dnum = 1
        End If
        gdbobj.CNExe.BeginTrans
        If Not gdbobj.DBExec("delete Ins_SickReginfo where skid='" & SickObj.SkID & "'") Then
            GoTo lblerror
        End If
        If Not gdbobj.DBExec("delete Ins_SickReginfoapd where skid='" & SickObj.SkID & "' and footserial is null") Then
            GoTo lblerror
        End If
        If Not gdbobj.DBExec("delete INS_Inpati_PerFairRecord where iccard='" & IcCard & "'") Then
            GoTo lblerror
        End If
        
        
        If Not Update_Ins_SickReginfo(HISDbInsert, SickObj.SkID, SickObj.Name, SickObj.Sex, IcCard, IDCard, BloodType, _
                sociserial, offsign, offdeal) Then
            GoTo lblerror
        End If
        If Not Update_Ins_SickRegInfoApd(HISDbInsert, SickObj.SkID, dnum, medtype, AreaCode, PerFair, FixHosp, InType, inHospStyle, _
                SpecFixHosp, SpecFixHospSign, Specill, jztype, SpecStopDate, Flag) Then
            GoTo lblerror
        End If
        For Each tmpobj In mCol
            If Not Update_Ins_Inpati_PerFairRecord(HISDbInsert, IcCard, tmpobj.medtype, Format(tmpobj.InDate, "yyyy-mm-dd hh:mm:ss"), _
                Format(tmpobj.OutDate, "yyyy-mm-dd hh:mm:ss"), _
                tmpobj.inhosptype, tmpobj.outhosptype, tmpobj.totalfair, tmpobj.socifair, tmpobj.muchfair, _
                tmpobj.selfgeld, tmpobj.selfmoney, tmpobj.topin, "") Then
                GoTo lblerror:
            End If
        Next
        If Not SpecillObj.Save Then
            GoTo lblerror
        End If
        Save = True
        gdbobj.CNExe.CommitTrans
    Case HISDBUpdate
        SQL = "select max(num) as num from ins_sickreginfoapd where skid='" & SkID & "' and footserial is null"
        If gdbobj.GetRs(SQL) > 0 Then
            dnum = IIf(IsNull(gdbobj.Rs!num), 1, gdbobj.Rs!num + 1)
        Else
            dnum = 1
        End If
        gdbobj.CNExe.BeginTrans
        If Not gdbobj.DBExec("delete Ins_SickReginfoapd where skid='" & SickObj.SkID & "' and footserial is not null") Then
            GoTo lblerror
        End If
        If Not Update_Ins_SickRegInfoApd(HISDbInsert, SickObj.SkID, dnum, medtype, AreaCode, PerFair, FixHosp, InType, inHospStyle, _
                SpecFixHosp, SpecFixHospSign, Specill, jztype, SpecStopDate, Flag) Then
            GoTo lblerror
        End If
        gdbobj.CNExe.CommitTrans
        Save = True