frmbackbus.frm

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

   End
   Begin VB.Label lblFair 
      AutoSize        =   -1  'True
      Caption         =   "lblFair"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   210
      Left            =   960
      TabIndex        =   7
      Tag             =   "Dyn"
      Top             =   4425
      Width           =   735
   End
   Begin VB.Line Line2 
      BorderColor     =   &H8000000C&
      X1              =   0
      X2              =   9480
      Y1              =   4755
      Y2              =   4755
   End
   Begin VB.Line Line3 
      BorderColor     =   &H80000009&
      X1              =   0
      X2              =   9450
      Y1              =   4740
      Y2              =   4740
   End
End
Attribute VB_Name = "frmBackBus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public SickObj As clsSickOP
Private mID As String
Private Fetchsobj As clsFetchs
Private CurFetchObj As clsFetch
Private mdate(0 To 1) As String
Private Sub InitForm()
    Call hisFormToCenter(Me, frmMain)
    Set usp.DBInter = gdbobj
    Set usp.CurSpread = spd
    usp.Load
    init

End Sub
Private Sub init()
    hisFormClear Me
    mskDate(0).Text = gfnGetTime(gstrCOMN_DATE)
    mskDate(1).Text = gfnGetTime(gstrCOMN_DATE)
    cmdPrevRecipeNum.Enabled = False
    cmdNextRecipeNum.Enabled = False
    txtPkCount = ""
    lblPkCount = ""
    spd.MaxRows = 0
    If Not (SickObj Is Nothing) Then
        Set SickObj = Nothing
    End If
    If Not (Fetchsobj Is Nothing) Then
        Set Fetchsobj = Nothing
    End If
    If gtydSysConfig.DeFaultPatientID Then
        txtID = gfnGetTime("yymmdd")
    End If
End Sub
Private Sub cmdNextRecipeNum_Click()
    lblRecipeNum = lblRecipeNum + 1
    If lblRecipeNum = lblRecipeTotal Then
        cmdNextRecipeNum.Enabled = False
    End If
    cmdPrevRecipeNum.Enabled = True
    Set CurFetchObj = Fetchsobj.Item(Val(lblRecipeNum))
    FillDataByFetch
End Sub
Private Sub cmdPrevRecipeNum_Click()
    lblRecipeNum = lblRecipeNum - 1
    If lblRecipeNum = "1" Then
        cmdPrevRecipeNum.Enabled = False
    End If
    cmdNextRecipeNum.Enabled = True
    Set CurFetchObj = Fetchsobj.Item(Val(lblRecipeNum))
    FillDataByFetch
End Sub
Private Sub FillData()
    Me.lblRecipeTotal = Fetchsobj.Count
    lblRecipeNum = "1"
    If lblRecipeNum = lblRecipeTotal Then
        cmdNextRecipeNum.Enabled = False
    Else
        cmdNextRecipeNum.Enabled = True
    
    End If
    cmdPrevRecipeNum.Enabled = False

    Set CurFetchObj = Fetchsobj.Item(Val(lblRecipeNum))
    FillDataByFetch

End Sub
Private Sub FillDataByFetch()
    Dim i As Integer
    Dim Amount As Integer
    txtDoctor = CurFetchObj.DcName
    txtDepart = CurFetchObj.DepName
    spd.MaxRows = 0
    spd.MaxRows = CurFetchObj.Count
    lblDate = CurFetchObj.RecentFetchDate
    lblPkCount = IIf(CurFetchObj.PKCount = 0, 1, CurFetchObj.PKCount)
    txtPkCount = ""
    If CurFetchObj.Ack Then
        mcr.KeyEnabled(BK_ADD) = False
        txtPkCount.Enabled = False
    Else
        mcr.KeyEnabled(BK_ADD) = True
        txtPkCount.Enabled = True
    End If
    For i = 1 To spd.MaxRows
        If UCase(left(CurFetchObj.Item(i).ItemCode, 1)) = "C" Then
            fraback.Visible = True
        Else
            fraback.Visible = False
        End If
        spd.Row = CurFetchObj.Item(i).ItemNum
'        spd.Row = i
        spd.Col = 1
        spd.Text = CurFetchObj.Item(i).ItemName
        spd.Col = 2
        spd.Text = CurFetchObj.Item(i).batchid & "\" & CurFetchObj.Item(i).model & " * " & CurFetchObj.Item(i).Factor
        spd.Col = 3
        spd.Text = CurFetchObj.Item(i).unit
        spd.Col = 4
        spd.Text = CurFetchObj.Item(i).FetchedAmount / CurFetchObj.Item(i).Factor
        Amount = Val(spd.Text)
        spd.Col = 5
        spd.Text = CurFetchObj.Item(i).BackAmount / CurFetchObj.Item(i).Factor
        If Amount = 0 Then spd.Lock = True
        spd.Col = 6
        spd.Text = CurFetchObj.Item(i).Cprice * CurFetchObj.Item(i).Factor
        spd.Col = 7
        spd.Text = CurFetchObj.Item(i).FetchedFair
        spd.Col = 8
        spd.Text = CurFetchObj.Item(i).BackFair
        spd.Col = 9
        spd.value = IIf(CurFetchObj.Item(i).Pub, 1, 0)
        spd.Col = 10
        spd.value = IIf(CurFetchObj.Item(i).Export, 1, 0)
        
    Next i
    Sum
    If fraback.Visible And txtPkCount.Enabled Then txtPkCount.SetFocus
End Sub


Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn And Me.ActiveControl.Name <> "spd" Then
        hisToActiveCtl(Me, True).SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub Form_Load()
    InitForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmBackBus = Nothing
End Sub

Private Sub Sum()
    Me.lblFairTotal = Format(CurFetchObj.FetchedFair, gstrMONEY_FORMAT)
    Me.lblFair = Format(CurFetchObj.BackFair, gstrMONEY_FORMAT)
    Me.lblOutFairTotal = Format(CurFetchObj.FetchedExportFair, gstrMONEY_FORMAT)
    Me.lblOutFair = Format(CurFetchObj.BackExportFair, gstrMONEY_FORMAT)
    Me.lblSelfFairTotal = Format(CurFetchObj.FetchedSelfFair, gstrMONEY_FORMAT)
    Me.lblSelfFair = Format(CurFetchObj.BackSelfFair, gstrMONEY_FORMAT)
    Me.lblPubFairTotal = Format(CurFetchObj.FetchedPubFair, gstrMONEY_FORMAT)
    Me.lblPubFair = Format(CurFetchObj.BackPubFair, gstrMONEY_FORMAT)
End Sub



Private Sub mcr_Click(ByVal WhichB As UseMaintainCtl.BUTTONKEY)
    Dim tmpObj As Object
    
    Select Case WhichB
        Case BK_ADD
            Set tmpObj = ValidCheck
            If Not (tmpObj Is Nothing) Then
                tmpObj.SetFocus
                Exit Sub
            End If
            loaddata
'            CurFetchObj.PKCount = CurFetchObj.PKCount - IIf(Val(txtPkCount) = 0, 1, Val(txtPkCount))
            
            CurFetchObj.PName = SickObj.Name
            If Not CurFetchObj.Back(SickObj) Then
                MsgBox gdbobj.ErrDes, vbCritical
            Else
                If Fetchsobj.AllAck Then
                    init
                    txtID.SetFocus
                    Set SickObj = Nothing
                    Set Fetchsobj = Nothing
                    Set CurFetchObj = Nothing
                Else
                    mcr.KeyEnabled(BK_ADD) = False
                End If
            End If
        Case BK_CLEAR
            init
            txtID.SetFocus
        Case BK_EXIT
            Unload Me
    End Select
End Sub

Private Sub mskDate_GotFocus(Index As Integer)
    mdate(Index) = mskDate(Index).Text
End Sub

Private Sub mskDate_LostFocus(Index As Integer)
    
    If Not IsDate(mskDate(Index)) Then
        MsgBox "输入正确的日期!", vbCritical
        mskDate(Index).SetFocus
        Exit Sub
    End If
    If SickObj Is Nothing Then Exit Sub
    If mdate(Index) <> mskDate(Index).Text Then
        QueryData
    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 BackAmount As Single, Amount As Single
    Dim Cprice As Currency
    Dim Fair As Currency
    If ChangeMade Then
        spd.Row = Row
        Select Case Col
            Case 5
                spd.Col = 4
                Amount = spd.Text
                spd.Col = 5
                BackAmount = spd.Text
                If BackAmount < 0 Or BackAmount > Amount Then
                     MsgBox "退的数量不能小于 0 或着 大于 可退数量!", vbCritical
                     spd.Text = 0
                     BackAmount = 0
                End If
                spd.Col = 6
                Cprice = spd.Text
                spd.Col = 7
                Fair = spd.Text
                spd.Col = 8
                If BackAmount = Amount Then
                    spd.Text = Fair
                Else
                    spd.Text = Cprice * BackAmount
                    If Val(spd.Text) = 0 And BackAmount > 0 Then spd.Text = 0.01
                End If
        End Select
        loaddata
        Sum
    End If
        
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 spd_RightClick(ByVal ClickType As Integer, ByVal Col As Long, ByVal Row As Long, ByVal MouseX As Long, ByVal MouseY As Long)
    Call usp.RightClick
End Sub

Private Sub txtID_GotFocus()
    mID = txtID
End Sub

Private Sub txtID_LostFocus()
    Dim SQL As String
    Dim i As Integer
    
    If mID = txtID Then Exit Sub
    If txtID = "" Then
        init
        Exit Sub
    End If
    Set SickObj = New clsSickOP
    SickObj.SkIDByBaseQuery = txtID
    txtName = SickObj.Name
    txtPtType = SickObj.PtDes
    If SickObj.Id = "" Then
        init
        txtID.SetFocus
        Exit Sub
    End If
    QueryData
End Sub
Private Sub QueryData()
    Dim SQL As String
    
    SQL = "SELECT Open_ActReceiveSub.ActRevSerial,Open_ActReceiveSub.RecipeNum," _
        & "Open_ActReceiveSubItem.Num,Open_ActReceiveSub.DcCode,m_Doctor.DcName," _
        & "Open_ActReceiveSub.DepCode,m_Depart.DepName,Open_ActReceiveSubItem.Flag," _
        & "m_Drug.ItemCode,m_Drug.ItemName,m_Drug.Model,Open_ActReceiveSubItem.Cprice," _
        & "Open_ActReceiveSubItem.Unit,Open_ActReceiveSubItem.Factor,m_Drug.Gprice,m_Drug.BaseUnit," _
        & "Open_ActReceiveSubItem.Amount,Open_ActReceiveSubItem.Fair,Open_ActReceiveSubItem.FetchAmount,Open_ActReceiveSubItem.FetchFair, " _
        & "Open_ActReceiveSubItem.revDepcode,Open_ActReceiveSub.RecentFetchDate, " _
        & "Open_ActReceiveSub.RecentFetchHdCode,Open_ActReceiveMain.RecentDate, " _
        & "Open_ActReceiveMain.SheetID,m_Drug.Cprice as 'T_Price',Open_ActReceiveSub.DsCode,Open_ActReceiveSub.Rate, " _
        & "Open_ActReceiveSub.pkcount,batchid " _
        & "FROM ((((Open_ActReceiveMain INNER JOIN Open_ActReceiveSub " _
        & "ON Open_ActReceiveMain.ActRevSerial =Open_ActReceiveSub.ActRevSerial) " _
        & " INNER JOIN Open_ActReceiveSubItem " _
        & " ON Open_ActReceiveSub.ActRevSerial =Open_ActReceiveSubItem.ActRevSerial" _
        & " AND Open_ActReceiveSub.recipeNum =Open_ActReceiveSubItem.RecipeNum) " _
        & " INNER JOIN m_Drug ON m_Drug.ItemCode = Open_ActReceiveSubItem.ItemCode) " _
        & " INNER JOIN m_Depart ON Open_ActReceiveSub.DepCode =m_Depart.DepCode) " _
        & " LEFT JOIN m_Doctor ON Open_ActReceiveSub.DcCode =m_Doctor.DcCode " _
        & " WHERE Open_ActReceiveSub.Status & 2 = 2 " _
        & " AND Open_ActReceiveSub.DsCode ='" & gtydSysConfig.DepCode & "'" _
        & " AND Open_ActReceiveMain.PatientID = '" & SickObj.Id & "'" _
        & " AND Open_ActReceiveSub.RecentFetchDate >= '" & mskDate(0) & " 00:00:00'" _
        & " AND Open_ActReceiveSub.RecentFetchDate<= '" & mskDate(1) & " 23:59:59' and Amount>=0 " _
        & " ORDER BY Open_ActReceiveSub.ActRevSerial,Open_ActReceiveSub.RecipeNum,Open_ActReceiveSubItem.Num"
        
        
        '收费未退完 的 处方
        
    Set Fetchsobj = New clsFetchs
    Fetchsobj.Make SQL
    If Fetchsobj.Count = 0 Then
        MsgBox "病人无取药记录!", vbCritical
        init
        txtID.SetFocus
        Exit Sub
    End If
    FillData
End Sub
Private Sub loaddata()
    Dim i As Integer
    
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 5
        CurFetchObj.Item(i).BackAmount = spd.Text * CurFetchObj.Item(i).Factor
        spd.Col = 8
        CurFetchObj.Item(i).BackFair = spd.Text
    Next i
    CurFetchObj.FetchDate = gfnGetTime
    CurFetchObj.HdCode = gtydSysConfig.HdCode
End Sub

Private Function ValidCheck() As Object
    Dim i As Integer
    Dim Having As Boolean
    
    If SickObj Is Nothing Then
        MsgBox "请输入病人ID!", vbCritical
        Set ValidCheck = txtID
        Exit Function
    End If
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 5
        If Val(spd.Text) <> 0 Then
            Having = True
        End If
    Next i
    If Not Having Then
        MsgBox "此病人无退药项目!", vbCritical
        Set ValidCheck = spd
        Exit Function
    End If
    
End Function

Private Sub txtPkCount_LostFocus()
    Dim i As Integer
    Dim Amount As Integer
    Dim BackAmount As Integer
    Dim allAmount As Integer
    Dim Cprice As Currency, Fair As Currency
    If Val(txtPkCount) <> 0 Then
        If Val(txtPkCount) > Val(lblPkCount) Then
            MsgBox "退要药数不能大于实际数！", vbCritical
            txtPkCount.SetFocus
            Exit Sub
        End If
        For i = 1 To spd.MaxRows
            spd.Col = 4
            allAmount = Val(spd.Text)
            Amount = Val(spd.Text) / Val(lblPkCount)
            spd.Col = 5
            spd.Text = Amount * Val(txtPkCount)
            BackAmount = Val(spd.Text)
            spd.Col = 6
            Cprice = Val(spd.Text)
            spd.Col = 7
            Fair = Val(spd.Text)
            spd.Col = 8
            If allAmount = BackAmount Then
                spd.Text = Fair
            Else
                spd.Text = Cprice * BackAmount
                If Val(spd.Text) = 0 And BackAmount > 0 Then spd.Text = 0.01
            End If
            spd.Col = 5
            spd.Row = i
        Next i
        loaddata
        Sum
    End If
End Sub