frmfigurebus.frm

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

                txtDepart = SelData(3)
            Else
                txtDoctor.Tag = ""
                txtDoctor = ""
                txtDepart.Tag = ""
                txtDepart = ""
            End If
'            Call RecipesObj.UpDateRecipeInfo(Val(lblDepartNum), txtDepart.Tag, txtDepart, txtDoctor.Tag, txtDoctor)
    End Select
End Sub
Private Sub LoadDataByRecipe(RecipeObj As clsRecipe)  '装入 单张处方
    Dim i As Integer
    Dim RecipeItemObj As clsRecipeItem
    Dim Amount As Integer
    Dim Cprice As Currency, Factor As Integer, TotalFair As Currency
    RecipeObj.Clear
    RecipeObj.DcCode = txtDoctor.Tag
    RecipeObj.DcName = txtDoctor
    RecipeObj.DepCode = txtDepart.Tag
    RecipeObj.DepName = txtDepart
    RecipeObj.RecipeType = CurType
    If CurType = 2 Then
        RecipeObj.PKCount = IIf(Val(mskPkCount) = 0, 1, Val(mskPkCount))
    End If
    For i = 1 To spd.MaxRows - 1
        Set RecipeItemObj = New clsRecipeItem
        spd.Row = i
        spd.Col = 12
        If Val(spd.Text) = 0 Then Exit Sub
        RecipeItemObj.Factor = Val(spd.Text)
        spd.Col = 1
        RecipeItemObj.ItemName = spd.Text
        If spd.Text = "" Then Exit Sub
        spd.Col = 2
        RecipeItemObj.batchid = ""
        If spd.Text <> "" And InStr(spd.Text, "\") > 1 Then
            If InStr(spd.Text, "\") > 1 Then
                RecipeItemObj.batchid = left(spd.Text, InStr(spd.Text, "\") - 1)
            End If
            RecipeItemObj.model = Right(spd.Text, Len(spd.Text) - Len(RecipeItemObj.batchid))
            RecipeItemObj.model = left(RecipeItemObj.model, InStr(RecipeItemObj.model, " * ") - 1)
        End If
        spd.Col = 3
        RecipeItemObj.unit = spd.Text
        spd.Col = 4
        RecipeItemObj.Amount = spd.Text * RecipeItemObj.Factor * RecipeObj.PKCount
        spd.Col = 5
        RecipeItemObj.Cprice = spd.Text / RecipeItemObj.Factor
        spd.Col = 6
'        spd.Text = RecipeItemObj.cprice * RecipeItemObj.amount / RecipeObj.PKCount
        RecipeItemObj.Fair = spd.Text * RecipeObj.PKCount '这样可以舌入处理
        spd.Col = 7
        RecipeItemObj.RevDepName = spd.Text
        spd.Col = 8
        RecipeItemObj.Pub = IIf(spd.value = 1, True, False)
        spd.Col = 9
        RecipeItemObj.ItemCode = spd.Text
        spd.Col = 10
        RecipeItemObj.Export = IIf(spd.value = 1, True, False)
        spd.Col = 11
        RecipeItemObj.RevDepCode = spd.Text
        spd.Col = 13
        RecipeItemObj.gprice = spd.Text
        RecipeObj.AddObj RecipeItemObj
        Set RecipeItemObj = Nothing
    Next i
End Sub

Private Sub FillDataByRecipe(RecipeObj As clsRecipe)  '装入 单张处方
    Dim i As Integer
    Dim RecipeItemObj As clsRecipeItem
    If RecipeObj Is Nothing Then Exit Sub
    txtDoctor.Tag = RecipeObj.DcCode
    txtDoctor = RecipeObj.DcName
    txtDepart.Tag = RecipeObj.DepCode
    txtDepart = RecipeObj.DepName
    CurType = RecipeObj.RecipeType
    spd.MaxRows = 0
    spd.MaxRows = RecipeObj.Count + 1
    mskPkCount.Text = Format(RecipeObj.PKCount, "000")
    For i = 1 To spd.MaxRows - 1
        Set RecipeItemObj = RecipeObj.Item(i)
        If RecipeObj.PKCount = 0 Then RecipeObj.PKCount = 1
        spd.Row = i
        spd.Col = 1
        spd.Text = RecipeItemObj.ItemName
        spd.Col = 2
        spd.Text = RecipeItemObj.batchid & "\" & RecipeItemObj.model & " * " & RecipeItemObj.Factor
        spd.Col = 3
        spd.Text = RecipeItemObj.unit
        spd.Col = 4
        spd.Text = (RecipeItemObj.Amount / RecipeItemObj.Factor) / RecipeObj.PKCount
        spd.Col = 5
        spd.Text = RecipeItemObj.Cprice * RecipeItemObj.Factor
        spd.Col = 6
        spd.Text = RecipeItemObj.Fair / RecipeObj.PKCount
        spd.Col = 7
        spd.Text = RecipeItemObj.RevDepName
        spd.Col = 8
        spd.value = IIf(RecipeItemObj.Pub, 1, 0)
        spd.Col = 9
        spd.Text = RecipeItemObj.ItemCode
        spd.Col = 10
        spd.value = IIf(RecipeItemObj.Export, 1, 0)
        spd.Col = 11
        spd.Text = RecipeItemObj.RevDepCode
        spd.Col = 12
        spd.Text = RecipeItemObj.Factor
        spd.Col = 13
        spd.Text = RecipeItemObj.gprice
    Next i
    Sum
End Sub
Private Sub FillData()
    Set Sickobj = New clsSickOP
    
    Sickobj.SkIDByBaseQuery = QueryRecipeObj.PatientID
    txtID = Sickobj.Id
    txtName = Sickobj.Name
    txtPtType = Sickobj.PtDes
    lblDate = QueryRecipeObj.RecipeDate
    Me.lblHander = QueryRecipeObj.HdName
    lblCancel.Visible = QueryRecipeObj.IsCancel
    If QueryRecipeObj.FetchDate <> "" Then
        lblFetch.Visible = True
    Else
        lblFetch.Visible = False
    End If
    If QueryRecipeObj.ActRevSerial <> "" Then
        lblRev.Visible = True
    Else
        lblRev.Visible = False
    End If
    If Not QueryRecipeObj.IsCancel And QueryRecipeObj.FetchDate = "" And QueryRecipeObj.ActRevSerial = "" Then
        mcr.KeyEnabled(BK_DEL) = True
    Else
        mcr.KeyEnabled(BK_DEL) = False
    End If
    FillDataByRecipe QueryRecipeObj
'    Sum
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If mItemType = 1 Then Exit Sub
    SetSpdMoney
    Select Case KeyCode
        Case vbKeyF1
            If (HouseType And 1) = 1 Then
                If spd.MaxRows > 1 Then cmdNextRecipeNum_Click
                CurType = 0
            End If
        Case vbKeyF2
            If (HouseType And 2) = 2 Then
                If spd.MaxRows > 1 Then cmdNextRecipeNum_Click
                CurType = 1
            End If
        Case vbKeyF3
            If (HouseType And 4) = 4 Then
                If spd.MaxRows > 1 Then cmdNextRecipeNum_Click
                CurType = 2
            End If
        Case vbKeyF4
            If (HouseType And 8) = 8 Then
                If spd.MaxRows > 1 Then cmdNextRecipeNum_Click
                CurType = 3
            End If
    End Select
    If spd.MaxRows = 1 Then cmdNextRecipeNum.Enabled = False

End Sub

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

Private Sub Form_Load()
    Dim i As Integer
    Call hisFormToCenter(Me, frmMain)
    InitForm
    CboPtType.Clear
    For i = 1 To gPatientTypesObj.Count
        CboPtType.AddItem gPatientTypesObj.Item(i).Id & " " & gPatientTypesObj.Item(i).Des
    Next i
    
    Set CmnHlp = New frmInputHelp
    Set CmnHlp.CN = gdbobj.CN
    Set Me.ListCtl1.CN = gdbobj.CN
    If mcr.Status = CL_ADD Then
        Me.ListCtl1.Visible = False
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmMain.Note = OldNote
    Set frmFigureBus = Nothing
End Sub



Private Sub ListCtl1_PosChanged(ByVal Pos As Long, ByVal OldPos As Long)
    If Not (QueryRecipeObj Is Nothing) Then
        
        Set QueryRecipeObj = Nothing
    End If
    Set QueryRecipeObj = New clsRecipe
    QueryRecipeObj.RecipeSerialByQuery = ListCtl1.CurColumns(0)
    FillData
End Sub

Private Sub mcr_Click(ByVal WhichB As UseMaintainCtl.BUTTONKEY)
    Dim SheetID As String
    Dim i As Integer
    Dim tmpObj As Object, ErrDes As String
    
    Select Case WhichB
        Case BK_ADD
            loaddata
            Set tmpObj = ValidInput(ErrDes)
            If Not (tmpObj Is Nothing) Then
                MsgBox ErrDes, vbCritical
                tmpObj.SetFocus
                Exit Sub
            End If
'            RoundRec
            If gstrMODULEID = "A2" Then
                RaiseEvent Ack(RecipesObj)
            Else
                If Not gtydSysConfig.NeedRegiForFigure Then
                    LoadDataForSick Sickobj
                End If
                If Not RecipesObj.Save Then
                    MsgBox gdbobj.ErrDes, vbCritical
                    Exit Sub
                End If
                If Not gtydSysConfig.NotPrintRec Then
                    printBusAll
                End If
                init
                Set RecipesObj = Nothing
                txtID.SetFocus
            End If
        Case BK_DEL
            If QueryRecipeObj.Cancel Then
                mcr.KeyEnabled(BK_DEL) = False
                Me.lblCancel.Visible = True
            End If
        Case BK_CLEAR
            init
            clearrecipe
            hisActiveSpreadCell spd, 1, 1
            If txtID.Enabled Then
                Me.txtID.SetFocus
            Else
                txtDoctor.SetFocus
            End If
        Case BK_TRANS
            mcr.Status = CL_ADD
            mcr.KeyEnabled(BK_PRINT) = False
            If mItemType = 0 Then
                txtID.SetFocus
            End If
        Case BK_PRINT
            printBus
        Case BK_QUERY
            Set QueryObj = New frmFigureQuery
            QueryObj.Show vbModal
        Case BK_EXIT
            RaiseEvent Cancel
            Unload Me
    End Select
End Sub

Private Sub mcr_StatusChanged()
    If mcr.Status = CL_ADD Then
        init
        hisLockInput Me, False
        ListCtl1.Visible = False
        Me.cmdNextRecipeNum.Enabled = True
        lblDate.Visible = False
        Me.lblHander.Visible = False
    Else
        init
        CboPtType.Visible = False
        CboPtType.TabStop = False
        hisLockInput Me, True
        ListCtl1.Visible = True
        Me.cmdNextRecipeNum.Enabled = False
        lblDate.Visible = True
        Me.lblHander.Visible = True
        
    End If
End Sub


Private Sub mskPkCount_GotFocus()
    mskPkCount.SelStart = 0
    mskPkCount.SelLength = Len(mskPkCount.Text)
End Sub

Private Sub mskPkCount_LostFocus()
    Sum
End Sub

Private Sub QueryObj_Ack(ByVal Cdt As String)
    Dim SQL As String
    
    If gtydSysConfig.DepCode = "" Then
        SQL = "SELECT RecipeSerial FROM Open_RecipeMain" _
            & " WHERE DsCode IS NULL AND Status & 2 = 0 AND " & Cdt & ""
    Else
        SQL = "SELECT RecipeSerial FROM Open_RecipeMain" _
            & " WHERE Status & 2 = 0 AND DsCode ='" & gtydSysConfig.DepCode & "' AND " & Cdt & ""
    End If
    Set QueryObj = Nothing
    ListCtl1.SQL = SQL
    ListCtl1.Refresh
    If ListCtl1.Count > 0 Then
        mcr.Status = CL_UPDATE
        mcr.KeyEnabled(BK_PRINT) = True
        Set QueryRecipeObj = New clsRecipe
        QueryRecipeObj.RecipeSerialByQuery = ListCtl1.CurColumns(0)
        FillData
    Else
        init
        mcr.Status = CL_ADD
    End If
End Sub

Private Sub spd_ButtonClicked(ByVal Col As Long, ByVal Row As Long, ByVal ButtonDown As Integer)
    If spd.ActiveCol = Col Then
        Sum
    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 TmpStr As String
    Dim mFactor As Single
    Dim i As Integer, ItemCode As String
    Dim Cprice As Currency, Amount As Single, Factor As Single, model As String, CurUnit As String
    Dim astr As String
    Dim SQL As String
    If gtydSysConfig.IfDecStore And Not gtydSysConfig.IFAllowNeg Then astr = "and amount>0"
    spd.Col = Col
    spd.Row = Row
    If ChangeMade Or gfnGetCell(spd, Row, 1) = "" Then
        Select Case Col
            
            Case 1: '名称
                TmpStr = spd.Text
                If TmpStr <> "" Then
                    If getQTFair(TmpStr) Then Exit Sub
                    Select Case CurType
                        Case 0 '西药
                        
                            If gtydSysConfig.IFJudgeStore = True Then
                                                       
                              SQL = "SELECT m_Drug.ItemCode,ItemName,ItemName," _
                                & "Model,BaseUnit," _
                                & IIf(gtydSysConfig.DefaultUnit = 1, "GenalUnit,Factor", "BaseUnit,1") _
                                & ",house_drugbus.Cprice,m_Drug.Flag,house_drugbus.Gprice,Amount,Ptdes,batchid  " _
                                & "FROM m_Drug " _
                                & "LEFT join House_Drugbus on House_drugbus.ItemCode=m_Drug.itemcode and dscode='" _
                                & gtydSysConfig.VsADepCode & "' " _
                                & "left join Ins_Paytype on INS_Paytype.ptcode=m_Drug.ptcode " _
                                & "WHERE Brief Like '##%' AND m_Drug.Flag & 32 = 0 and house_drugbus.amount>0 " _
                                & " AND m_Drug.ItemCode Like 'A%' " & astr _
                                & " UNION SELECT m_Drug.ItemCode,m_DrugAlias.AliasName,m_Drug.ItemName," _
                                & "m_Drug.model,m_Drug.BaseUnit," _
                                & IIf(gtydSysConfig.DefaultUnit = 1, "GenalUnit,Factor", "BaseUnit,1") _
                                & ",house_drugbus.Cprice,m_Drug.Flag,house_drugbus.GPrice,amount,ptdes,batchid " _
                                & "FROM m_Drug INNER JOIN m_DrugAlias ON " _
                                & "m_Drug.ItemCode = m_DrugAlias.ItemCode " _
                                & "LEFT join House_Drugbus on House_drugbus.ItemCode=m_Drug.itemcode and dscode='" _
                                & gtydSysConfig.VsADepCode & "' " _