frmfetch.frm

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

         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   30
      TabIndex        =   10
      Top             =   5370
      Width           =   525
   End
   Begin VB.Label lblFairTotal 
      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            =   675
      TabIndex        =   9
      Tag             =   "Dyn"
      Top             =   5385
      Width           =   735
   End
   Begin VB.Label Label10 
      AutoSize        =   -1  'True
      Caption         =   "取药:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   30
      TabIndex        =   8
      Top             =   5640
      Width           =   525
   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            =   660
      TabIndex        =   7
      Tag             =   "Dyn"
      Top             =   5640
      Width           =   735
   End
   Begin VB.Line Line2 
      BorderColor     =   &H8000000C&
      X1              =   0
      X2              =   9480
      Y1              =   5955
      Y2              =   5955
   End
   Begin VB.Line Line3 
      BorderColor     =   &H80000009&
      X1              =   0
      X2              =   9450
      Y1              =   5940
      Y2              =   5940
   End
End
Attribute VB_Name = "frmFetchBus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Sickobj As clsSickOP
Public mID As String
Private Fetchsobj As clsFetchs
Private CurFetchObj As clsFetch
Public WithEvents QueryObj As frmFetchQuery
Attribute QueryObj.VB_VarHelpID = -1
Private Sub printBus()
    Dim i As Integer
    If spd.MaxRows = 0 Then Exit Sub
    If MsgBox("是否打印清单?", vbYesNo + 32) <> vbYes Then Exit Sub
    spd.Row = spd.MaxRows
    spd.Col = 1
    If spd.Text = "" Then
        If lblPkCount.Visible Then
            spd.Text = "每副合计"
        Else
            spd.Text = "合  计"
        End If
        spd.Col = 6
        spd.Text = lblFair
    Else
        spd.Col = 1
        spd.MaxRows = spd.MaxRows + 1
        spd.Row = spd.MaxRows
        If lblPkCount.Visible Then
            spd.Text = "每副合计"
        Else
            spd.Text = "合  计"
        End If
        spd.Col = 6
        spd.Text = lblFair
    End If
    spd1.Col = -1
    spd1.Row = -1
    spd1.Text = ""
    spd1.MaxRows = spd.MaxRows
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd1.Row = i
        spd.Col = 1
        spd1.Col = 1
        spd1.Text = spd.Text
        spd.Col = 2
        spd1.Col = 2
        spd1.Text = spd.Text
        spd.Col = 3
        spd1.Col = 3
        spd1.Text = spd.Text
        spd.Col = 6
        spd1.Col = 4
        spd1.Text = spd.Text
        spd.Col = 5
        spd1.Col = 5
        spd1.Text = spd.Text
        spd.Col = 7
        spd1.Col = 6
        spd1.Text = spd.Text
        spd.Col = 8
        spd1.Col = 7
        If i < spd.MaxRows Then
            If spd.Text = "1" Then
                spd1.Text = "公费"
            Else
                spd1.Text = "自费"
            End If
        End If
    Next i
    If lblPkCount.Visible Then
        spd1.MaxRows = spd1.MaxRows + 1
        spd1.Row = spd1.MaxRows
        spd1.Col = 1
        spd1.Text = "共 " & CurFetchObj.PKCount & " 副总计"
        spd1.Col = 6
        spd1.Text = lblFairTotal
    End If

    spd1.PrintHeader = "            /fz""12"" /fb1" & gtydSysConfig.HospName & " 门诊药品明细单/n/n" _
    & "/fz""10"" /fb0 病人ID：" & txtID & Space(4) & "姓名：" & txtName & Space(6) & "日期:" & gfnGetTime(gstrCHINA_DATE)
    spd1.PrintBorder = False
    spd1.PrintColHeaders = True
    spd1.PrintRowHeaders = False
    spd1.PrintShadows = False
    spd1.PrintGrid = False
    spd1.PrintMarginLeft = 0
    spd1.PrintUseDataMax = False
    spd1.Action = SS_ACTION_PRINT
    spd1.Redraw = True

End Sub

Private Sub InitForm()
'    Call hisFormToCenter(Me, frmMain)
 
    Set Me.lct.CN = gdbobj.CN
    lct.Visible = False
    init
    Set usp.DBInter = gdbobj
    Set usp.CurSpread = spd
    usp.Load
End Sub
Private Sub init()
    hisFormClear Me
    cmdPrevRecipeNum.Enabled = False
    cmdNextRecipeNum.Enabled = False
    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
    lblPkCount = "草药副数:"
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 RTotal As Currency
    txtDoctor = CurFetchObj.DcName
    txtDepart = CurFetchObj.DepName
    spd.Redraw = False
    spd.MaxRows = 0
    spd.MaxRows = CurFetchObj.Count
    lblDate = CurFetchObj.RecentFetchDate
    If CurFetchObj.Ack Then
        mcr.KeyEnabled(BK_ADD) = False
    Else
        mcr.KeyEnabled(BK_ADD) = True
    End If
    lblPkCount = "共 " & CurFetchObj.PKCount & " 副"
    mskPkCount = Format(CurFetchObj.PKCount, "000")
    If CurFetchObj.PKCount > 1 Then
        fraPK.Visible = True
    Else
        fraPK.Visible = False
    End If
    For i = 1 To spd.MaxRows
        spd.Row = CurFetchObj.Item(i).ItemNum
        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).ActAmount / CurFetchObj.Item(i).Factor / CurFetchObj.PKCount
        spd.Col = 5
        spd.Text = CurFetchObj.Item(i).FetchAmount / CurFetchObj.Item(i).Factor / CurFetchObj.PKCount
        spd.Col = 6
        spd.Text = CurFetchObj.Item(i).Cprice * CurFetchObj.Item(i).Factor
        spd.Col = 7
        spd.Text = CurFetchObj.Item(i).FetchFair / CurFetchObj.PKCount
        RTotal = RTotal + Val(spd.Text)
        spd.Col = 8
        spd.value = IIf(CurFetchObj.Item(i).Pub, 1, 0)
        spd.Col = 9
        spd.value = IIf(CurFetchObj.Item(i).Export, 1, 0)
        If spd.MaxCols < 10 Then
            spd.MaxCols = 10
            spd.Col = 10
            spd.Row = 0
            spd.Text = "用法"
            spd.Row = i
        End If
        spd.Col = 10
        spd.value = CurFetchObj.Item(i).Comment
    Next i
    spd.Redraw = True
    Sum
End Sub


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

Private Sub Form_Load()
    InitForm
    fraPK.Visible = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmFetchBus = Nothing
    frmFecthList.closeflag = True
    Unload frmFecthList
End Sub

Private Sub Sum()
    Me.lblFairTotal = Format(CurFetchObj.ActFair, gstrMONEY_FORMAT)
    Me.lblFair = Format(CurFetchObj.FetchFair, gstrMONEY_FORMAT)
    Me.lblOutFairTotal = Format(CurFetchObj.ActExportFair, gstrMONEY_FORMAT)
    Me.lblOutFair = Format(CurFetchObj.FetchExportFair, gstrMONEY_FORMAT)
    Me.lblSelfFairTotal = Format(CurFetchObj.ActSelfFair, gstrMONEY_FORMAT)
    Me.lblSelfFair = Format(CurFetchObj.FetchSelfFair, gstrMONEY_FORMAT)
    Me.lblPubFairTotal = Format(CurFetchObj.ActPubFair, gstrMONEY_FORMAT)
    Me.lblPubFair = Format(CurFetchObj.FetchPubFair, gstrMONEY_FORMAT)
End Sub



Private Sub Frame1_DragDrop(Source As Control, x As Single, y As Single)

End Sub

Private Sub Lct_PosChanged(ByVal Pos As Long, ByVal OldPos As Long)
    FillQuery
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
            If Not chkAmount Then Exit Sub
            loaddata True
            CurFetchObj.PName = Sickobj.Name
            If Not CurFetchObj.Save(Sickobj) Then
                MsgBox gdbobj.ErrDes, vbCritical
            Else
                If gtydSysConfig.FetchPrint Then printBus
                If Fetchsobj.AllAck Then
                    init
                    txtID.SetFocus
                    Set Sickobj = Nothing
                    Set Fetchsobj = Nothing
                    Set CurFetchObj = Nothing
                    If gtydSysConfig.IfFetchList Then frmFecthList.tvfecth.SetFocus
                    If gtydSysConfig.IfFetchList Then frmFecthList.getList
                        
                Else
                    mcr.KeyEnabled(BK_ADD) = False
                End If
            End If
        Case BK_QUERY
            Set QueryObj = New frmFetchQuery
            QueryObj.Show
        Case BK_CLEAR
            init
            txtID.SetFocus
            Set Sickobj = Nothing
            Set Fetchsobj = Nothing
            Set CurFetchObj = Nothing
        Case BK_PRINT
            printBus
        Case BK_TRANS
            mcr.Status = CL_ADD
            init
            txtID.SetFocus
        Case BK_EXIT
            Unload Me
    End Select
End Sub