frmfigurebus.frm

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

      TabIndex        =   15
      Top             =   900
      Width           =   840
   End
   Begin VB.Label Label2 
      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            =   105
      TabIndex        =   14
      Top             =   1305
      Width           =   840
   End
   Begin VB.Label Label1 
      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            =   2505
      TabIndex        =   13
      Top             =   1275
      Width           =   1050
   End
   Begin VB.Label Label6 
      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            =   45
      TabIndex        =   11
      Top             =   5370
      Width           =   735
   End
   Begin VB.Label lblFairTotal 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "lblFair"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   240
      Left            =   795
      TabIndex        =   10
      Tag             =   "Dyn"
      Top             =   5355
      Width           =   1170
   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        =   9
      Top             =   5640
      Width           =   735
   End
   Begin VB.Label lblFair 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "lblFair"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   240
      Left            =   825
      TabIndex        =   8
      Tag             =   "Dyn"
      Top             =   5640
      Width           =   1140
   End
   Begin VB.Line Line2 
      BorderColor     =   &H8000000C&
      X1              =   0
      X2              =   9480
      Y1              =   5925
      Y2              =   5925
   End
   Begin VB.Line Line3 
      BorderColor     =   &H80000009&
      X1              =   0
      X2              =   9450
      Y1              =   5910
      Y2              =   5910
   End
End
Attribute VB_Name = "frmFigureBus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit



Public Event Ack(TRecipesObj As clsRecipes)  '录入检查治疗项目时使用
Public Event Cancel()
Dim rsRepAmount As Recordset

Public Sickobj As clsSickOP

Public mItemType As Integer   ' 0 - 所有 1 - 检查、治疗

Public RecipesObj As clsRecipes
Private QueryRecipeObj As clsRecipe
Private WithEvents QueryObj As frmFigureQuery
Attribute QueryObj.VB_VarHelpID = -1
Private WithEvents CmnHlp As frmInputHelp
Attribute CmnHlp.VB_VarHelpID = -1
Private mID As String, mDepart As String, mDcCode As String
Private mintCurType As Integer  ' 0 - 西药  1- 中成药     2- 中草药    3 -检查、治疗
Private OldNote As String
Private HouseType As Integer

Private Function getQTFair(key As String) As Boolean
    Dim SQL As String
    Dim Row As Integer
    SQL = "select m_Item.ItemCode,m_Item.ItemName,m_Item.Unit,m_Item.CPrice from f_CusmKindLink " _
       & "Inner join m_Item on m_Item.ItemCode=f_CusmKindLink.SourceID " _
       & "Where ckID='Open_Fix' and CusmID='" & key & "'"
    If gdbobj.GetRs(SQL) > 0 Then
        Row = spd.ActiveRow
        Do While Not gdbobj.Rs.EOF
            PutSpread Row, gdbobj.Rs!ItemCode, gdbobj.Rs!ItemName, "", gdbobj.Rs!unit, 1, gdbobj.Rs!Cprice, 1, 0, _
                gtydSysConfig.DepCode, gtydSysConfig.DepName, 0, ""
            gdbobj.Rs.MoveNext
            Row = Row + 1
            spd.MaxRows = spd.MaxRows + 1
        Loop
        getQTFair = True
    End If
End Function

Private Sub printBusAll()
    Dim i As Integer
    Do While cmdPrevRecipeNum.Enabled
        cmdPrevRecipeNum_Click
    Loop
    printBus
    For i = 1 To Val(lblRecipeTotal) - 1
        cmdNextRecipeNum_Click
        If cmdNextRecipeNum.Enabled Then printBus
    Next i
    
End Sub
Private Sub printBus()
    Dim i As Integer
    spd.Row = spd.MaxRows
    spd.Col = 1
    If spd.Text = "" Then
        If mskPkCount.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 mskPkCount.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 = 5
        spd1.Col = 4
        spd1.Text = spd.Text
        spd.Col = 4
        spd1.Col = 5
        spd1.Text = spd.Text
        spd.Col = 6
        spd1.Col = 6
        spd1.Text = spd.Text
        If gtydSysConfig.PrintAttrCol Then
            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
        Else
            spd1.MaxCols = 6
        End If
    Next i
    If mskPkCount.Visible Then
        spd1.MaxRows = spd1.MaxRows + 1
        spd1.Ro7 = spd1.MaxRows
        spd1.Col = 1
        spd1.Text = "共 " & Val(mskPkCount) & " 副总计"
        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
    If mskPkCount.Visible Then
        spd.MaxRows = spd.MaxRows - 2
        spd.MaxRows = spd.MaxRows + 1
    Else
        spd.MaxRows = spd.MaxRows - 1
        spd.MaxRows = spd.MaxRows + 1
    End If

End Sub
Private Sub InitForm()
    Dim Note As String
    Dim tmprs As Recordset
    Dim TmpStr As String
    CboPtType.Visible = False
    CboPtType.TabStop = False
    OldNote = frmMain.Note
    If mItemType = 0 Then
        HouseType = gfnGetHouseType
        If (HouseType And 1) = 1 Then
            Note = "F1-西药;"
        End If
        If (HouseType And 2) = 2 Then
            Note = Note & "F2-成药;"
        End If
        If (HouseType And 4) = 4 Then
            Note = Note & "F3-中草;"
        End If
        If (HouseType And 8) = 8 Then
            Note = Note & "F4-其他;"
        End If
        frmMain.Note = Note
    End If
    hisFormClear Me
    txtDoctor.Tag = ""
    txtDepart.Tag = ""
    Me.lblRecipeTotal = "1"
    Me.lblRecipeNum = "1"
    Me.lblFair = "0.00"
    Me.lblFairTotal = "0.00"
    Me.lblPubFair = "0.00"
    Me.lblSelfFair = "0.00"
    Me.lblOutFair = "0.00"
    Me.lblPubFairTotal = "0.00"
    Me.lblSelfFairTotal = "0.00"
    Me.lblOutFairTotal = "0.00"
    Me.lblDate.Visible = False
    Me.lblHander.Visible = False
    Me.lblCancel.Visible = False
    Me.lblFetch.Visible = False
    Me.lblRev.Visible = False
    Me.cmdPrevRecipeNum.Enabled = False
    Set usp.DBInter = gdbobj
    Set usp.CurSpread = spd
    mintCurType = -1
    If mItemType = 0 Then
        If (HouseType And 1) = 1 Then
            CurType = 0
        Else
            If (HouseType And 2) = 2 Then
                CurType = 1
            Else
                CurType = 2
            End If
        End If
    Else
        usp.Id = "A_ItemFigure"
        CurType = 3
    End If
    If Not (Sickobj Is Nothing) Then
        txtID.Enabled = False
        Me.txtID.TabStop = False
        txtID = Sickobj.PatientID
        txtName = Sickobj.Name
        txtPtType = Sickobj.PtDes
        If Not (RecipesObj Is Nothing) Then
            FillDataByRecipe RecipesObj.Item(1)
            Me.lblRecipeTotal = RecipesObj.Count
            cmdNextRecipeNum.Enabled = True
            cmdPrevRecipeNum.Enabled = False
        End If
    Else
        If gtydSysConfig.IFAutoID And gtydSysConfig.WorkStationNum <> "" _
            And Not gtydSysConfig.NeedRegiForFigure Then
            
            TmpStr = gfnGetTime("yymmdd") & gtydSysConfig.WorkStationNum
            Set tmprs = gdbobj.GetNewRs("SELECT MAX(PatientID) FROM Open_m_PatientBaseInfo " _
                & " WHERE PatientID Like '" & TmpStr & "%'")
            If Not IsNull(tmprs(0)) Then
                txtID = TmpStr & Format(Right(tmprs(0), Len(tmprs(0)) - Len(TmpStr)) + 1, _
                        hisStrRepeat("0", 3))
            Else
                txtID = TmpStr & Format(1, hisStrRepeat("0", 3))
            End If
        Else
            If gtydSysConfig.DeFaultPatientID Then
                txtID = gfnGetTime("yymmdd")
            End If
        End If
        CboPtType.Visible = True
        CboPtType.TabStop = True
        If CboPtType.ListCount > 0 Then CboPtType.ListIndex = 0
    End If
End Sub
Private Property Let CurType(ByVal FigureType As Integer)
    If mintCurType = FigureType Then Exit Property
    mintCurType = FigureType