clsinssick.cls

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

    End Select
    Exit Function
lblerror:
    gdbobj.CNExe.RollbackTrans
End Function

Public Sub Class_Initialize()
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCol = Nothing
End Sub
Private Function GetCap(caps As Integer) As String
    Dim Numstr As String
    Numstr = "零壹贰叁肆伍陆柒捌玖"
    GetCap = Mid(Numstr, caps + 1, 1)
    
    
End Function

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


    mCol.Remove vntIndexKey
End Sub

Public Function TranAsk(ByVal DestDepCode As String) As Boolean
    Dim num As Integer
    
On Error GoTo errlbl
    num = mfnGetNewMaxChangePos(SkSerial)
    gdbobj.CNExe.BeginTrans
    If SickObj.BedID <> "" Then
        If Not Update_SickInfo(HISDBUpdate, BedID:=Null, _
            UpdateCondition:="SkSerial ='" & SkSerial & "'") Then
            
            GoTo errlbl
        End If
        If Not gdbobj.DBExec("UPDATE m_Bed Set Flag=Flag & 239,comment=null WHERE BedID = '" & SickObj.BedID & "'") Then
        
            GoTo errlbl
        End If
    End If
    If Not Update_ChangePos(HISDbInsert, SkSerial, num, gfnGetTime, SickObj.depcode, SickObj.BedID, DestDepCode, "", _
        gtydSysConfig.HdCode, "", 1) Then
        
        GoTo errlbl
    End If
    gdbobj.CNExe.CommitTrans
    TranAsk = True
    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans
End Function


Public Function RegCard() As Boolean
    Dim TmpStr As String, busserial As String
    Dim PreI As Integer
    Dim NexI As Integer
    Dim j As Integer
    Dim divstr(11) As String
    busserial = left(Hidvstr, 20)
    If UCase(left(SkSerial, 1)) = "M" Then
        If Spec_Divide2Sub(Hidvstr) = "" Then
            MsgBox "扣卡失败！", vbCritical
            GoTo errlbl
            'Exit Function
        End If
    Else
        If Me.homeFlag = 1 Then
            If Home_Divide2Sub(Hidvstr) = "" Then
                MsgBox "扣卡失败！", vbCritical
                GoTo errlbl
                'Exit Function
            End If
        Else
            If Not Hosp_Divide2Sub(Hidvstr) Then
                MsgBox "扣卡失败！", vbCritical
                GoTo errlbl
                'Exit Function
            End If
        End If
    End If
    TmpStr = busserial & "|" & IcCard & "|" & jztype & "|" & Format(AccountGivFair, "#######0.00") _
            & "|" & CashGivFair
    TmpStr = RegSub(TmpStr)
    TmpStr = Trim(TmpStr)
    TmpStr = left(TmpStr, Len(TmpStr) - 1)
    If left(TmpStr, 1) = "A" Then
        GoTo errlbl
    Else
        PreI = 1
        NexI = 1
        For j = 0 To 11
            If InStr(PreI, TmpStr, "|") > 0 Then
                NexI = InStr(PreI, TmpStr, "|")
                divstr(j) = Mid(TmpStr, PreI, NexI - PreI)
                PreI = NexI + 1
            Else
                divstr(j) = Mid(TmpStr, PreI, Len(TmpStr) - PreI + 1)
            End If
        Next j
        If Not Update_Ins_DecCard(HISDbInsert, SickObj.SkSerial, divstr(0), divstr(1), divstr(2), divstr(3), _
                 divstr(4), divstr(5), divstr(6), Val(divstr(7)), Val(divstr(8)), Val(divstr(9)), _
                 divstr(10), divstr(11)) Then
            GoTo errlbl
        End If
        
    End If
    RegCard = True
    Exit Function
errlbl:
    RegCard = False
End Function

Public Function OpenSpecFootPrint(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
    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("open_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_OpenGetCatiFairBySick '" & 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") = gGetDes("medtype", jztype)
        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("InFair") = TradeInTotalMoney    '医保内总金额
        mpg.IDValue("OutFair") = TradeInTotalMoney - PreMoney - MOPreMoney '特殊病个人自负总金额
        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") = TradeInTotalMoney - PreMoney - MOPreMoney + CommOpenInFair + OpenOutFair - AccountGivFair 'TradeTotalMoney - TradeInTotalMoney
        mpg.IDValue("MidFootFair") = MidTradeTotalMoney - MidTradeInTotalMoney
        mpg.IDValue("commopeninfair") = CommOpenInFair      '普通门诊医保内金额
        mpg.IDValue("openoutfair") = OpenOutFair        '非医保金额
        mpg.IDValue("TradeSerial") = OpenTradeSerial
        
        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
        OpenSpecFootPrint = True
    End If
errlbl:
End Function