check.cls

Oracle 10g数据库Java开发 源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Check"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'1 C_Id  number  收费记录编号
'2 R_Id  number  门诊登记编号，与表Register中的R_Id字段对应
'3 P_Id  number  收费项目编号，与表Project中的P_Id字段对应
'4 P_Count number  收费项目数量
'5 P_Type  number  收费项目类型（1 - 中药，2 - 西药，3 - 其他收费项目）

Public C_Id As Integer
Public R_Id As Integer
Public P_Id As String
Public P_Count As Integer
Public P_Type As Integer

Public Sub Init()
  C_Id = 0
  P_Id = ""
  R_Id = 0
  P_Count = 0
  P_Type = 0
End Sub

Public Sub Insert()
  SqlStmt = "INSERT INTO CheckProject Values(S_CKEID.NextVal," _
          + Trim(R_Id) + ",'" + Trim(P_Id) + "'," _
          + Trim(P_Count) + "," + Trim(P_Type) + ")"
'MsgBox SqlStmt
  SQLExt (SqlStmt)
End Sub

'删除收费项目记录
Public Sub Delete(ByVal TmpC_Id As Long)
  SqlStmt = "DELETE FROM CheckProject WHERE C_Id=" + Trim(TmpC_Id)
  SQLExt (SqlStmt)
End Sub

'根据登记记录删除收费项目记录
Public Sub DeleteReg(ByVal TmpR_Id As Long)
  SqlStmt = "DELETE FROM CheckProject WHERE r_id=" + Trim(TmpR_Id)
  SQLExt (SqlStmt)
End Sub

'计算某个门诊登记编号的应收费用总和，参数TmpR_Id表示门诊登记编号
Public Function SumReg(ByVal TmpR_Id As Integer) As Integer
  Dim rs As New ADODB.Recordset
  
  '设置SELECT语句，读取编号为TmpId的记录
  SqlStmt = "SELECT SUM(总和) FROM Check_v WHERE 门诊编号=" + Trim(TmpR_Id)
  '将结果集读取到rs中
  Set rs = QueryExt(SqlStmt)

  If rs.EOF = True Then
    '如果结果集为空，则初始化
    SumReg = 0
  Else
    '将结果集中的数据赋值到成员变量中
    If IsNull(rs.Fields(0)) Then
      subreg = 0
    Else
      SumReg = rs.Fields(0)
    End If
  End If
End Function

'计算某个门诊收费单号的纯利润
Public Function SumEarn(ByVal TmpR_Id As Integer) As Integer
  Dim rs As New ADODB.Recordset
  
  '设置SELECT语句，读取编号为TmpId的记录
  SqlStmt = "SELECT SUM(纯利润) FROM Check_v WHERE 门诊编号=" + Trim(TmpR_Id)
  '将结果集读取到rs中
  Set rs = QueryExt(SqlStmt)

  If rs.EOF = True Then
    '如果结果集为空，则初始化
    SumEarn = 0
  Else
    '将结果集中的数据赋值到成员变量中
    SumEarn = rs.Fields(0)
  End If
End Function

Public Sub Update(ByVal TmpId As Integer)
  SqlStmt = "UPDATE CheckProject Set P_Count=" + Trim(P_Count) _
          + "WHERE C_Id=" + Trim(TmpId)
  SQLExt (SqlStmt)
End Sub

'根据登记编号更改收费项目的库存数量
Public Sub ChangeWareHouse(ByVal TmpRId As Long)
  Dim rs As New ADODB.Recordset
  
  If TmpRId <= 0 Then
    MsgBox "登记编号错误"
    Exit Sub
  End If
  '设置SELECT语句，读取编号为TmpRId的记录
  SqlStmt = "SELECT * FROM CheckProject WHERE R_Id=" + Trim(TmpRId)
  '将结果集读取到rs中
  Set rs = QueryExt(SqlStmt)

  Do While Not rs.EOF
    '对每个收费项目更改库存数量
    'P_Type表示类别
    If rs("P_Type") = 3 Then
      SqlStmt = "UPDATE Project Set P_Count=P_Count-" + Trim(rs("P_Count")) + " Where P_Id='" + Trim(rs("P_Id")) + "'"
    Else
      SqlStmt = "UPDATE Medicine Set M_Total=M_Total-" + Trim(rs("P_Count")) + " Where M_Id='" + Trim(rs("P_Id")) + "'"
    End If
    MsgBox SqlStmt
    QueryExt (SqlStmt)
    rs.MoveNext
  Loop
End Sub