publcfunctions.bas

医院糖尿病管理系统．是客户机服务器架构的

Attribute VB_Name = "Module1"

Option Explicit
Public Function addmansave(ByVal rname As String, ByVal rage, ByVal rheight, ByVal rsex, ByVal remployment, _
                           ByVal rnation, rmarry, ByVal rnative_place, ByVal rnowLiveAddr, ByVal rtelephone) As Integer
 


  '开始事务
  PCnnHisDB.BeginTrans
  
  '病人基本信息
   
   '血生化验
   
  '病人基本信息
   PCnnHisDB.Execute "INSERT INTO lc_fz_illman(name,age,height,sex,employment,nation,marry,native_place,nowLiveAddr,telephone) " _
                    & " VALUES('" + rname + "','" + Trim(rage) + "','" + Trim(rheight) + "'," _
                    & "'" + rsex + "'," + "'" + remployment + "'," + "'" + rnation + "'," _
                    & "'" + rmarry + "'," + "'" + rnative_place + "'," + "'" + rnowLiveAddr + "'," _
                    & "'" + rtelephone + "'" _
                    & ") "
   
    
    If CBool(PCnnHisDB.State And adStateExecuting) Then
        PCnnHisDB.Cancel
        PCnnHisDB.RollbackTrans
        MsgBox "保存病人基本信息失败，请重操作。", vbCritical, "提示"
        addmansave = 0   '代表失败
        Exit Function
    Else
        PCnnHisDB.CommitTrans
    End If
  
    addmansave = getmanid(rname)
    
 '在这里用一个复合条件查询，目的是要确定一个儿童的birthdaynow.
 '查询条件：name,sex,telphone,addree,birthday
 '把所得的birthdaynow 赋值给　函数　savebabyinformition
    
End Function




Public Function savefirstrecord( _
  ByVal rmanid, r1Number, _
  ByVal r2Number, ByVal rSeeDcotordata As String, rnarrate, rtiptopbloodcandy, ruseInsulin, rpasthistory, rfamilialhistory, rcourse, rchina_diagnose, rwestern_diagnose, rdoctordeal, raesculapius, _
  ByVal r3Number, rcheck_up_sz, rcheck_up_sg, rcheck_up_st, rcheck_up_tz, rcheck_up_m, rcheck_up_xy, _
  ByVal r17itemid, r4Number, rjejunum, ronehour, rtwohours, rthreehours, _
  ByVal r1itemid, r5Number, rcarrierR1, rcarrierK1, rcarrierR2, rcarrierK2, _
  ByVal r6Number, r5itemid, rfruit, _
  ByVal r7Number, rstarddate, renddate, rchiefDoctor) As String
 
 Dim xiu As Integer
 Dim idstring As String
 
 

  '开始事务
  PCnnHisDB.BeginTrans
  
                
               
   '病历表
   PCnnHisDB.Execute "INSERT INTO lcillman_number(manid,number) " _
                   & " VALUES('" + rmanid + "','" _
                   & r1Number + "')"
                  
  '医生查询表
   PCnnHisDB.Execute "INSERT INTO lcsayillcase( number, " _
                   & "SeeDcotordata," _
                   & "narrate," _
                   & "tiptopbloodcandy," _
                   & "useInsulin," _
                   & "pasthistory," _
                   & "familialhistory," _
                   & "course," _
                   & "china_diagnose," _
                   & "western_diagnose," _
                   & "doctordeal," _
                   & "aesculapius) " _
                   & " VALUES('" _
                   & r2Number + "'," _
                   & "'" + rSeeDcotordata + "','" + rnarrate + "'," + "'" + rtiptopbloodcandy + "'," _
                   & "'" + ruseInsulin + "','" + rpasthistory + "','" + rfamilialhistory + "'," _
                   & "'" + rcourse + "','" + rchina_diagnose + "','" + rwestern_diagnose + "', " _
                   & "'" + rdoctordeal + "','" + raesculapius + "'" + ") "
                   
  '查体
                  
   PCnnHisDB.Execute "INSERT INTO lccheckbody(number,check_up_sz,check_up_sg,check_up_st,check_up_tz,check_up_m,check_up_xy) " _
                   & " VALUES('" + r3Number + "','" + rcheck_up_sz + "','" + rcheck_up_sg + "', " _
                   & "'" + rcheck_up_st + "'," _
                   & "'" + rcheck_up_tz + "'," _
                   & "'" + rcheck_up_m + "','" _
                   & rcheck_up_xy + "') "
                  
   '胰岛功能检测
   Dim i As Integer
     
   For i = 0 To 16
     
   PCnnHisDB.Execute "INSERT INTO lcinsulinfunctioncheck(itemid,number,jejunum,onehour,twohours,threehours) " _
                   & " VALUES('" _
                   & r17itemid(i) + "'," _
                   & "'" + r4Number + "'," _
                   & "'" + rjejunum(i) + "','" + ronehour(i) + "','" + rtwohours(i) + "','" + rthreehours(i) + "') "
   Next i

   
   '胰岛素受体
      
   
   PCnnHisDB.Execute "INSERT INTO lcinsulinCarrier( itemid, " _
                   & "Number ," _
                   & "carrierR1 ," _
                   & "carrierK1 ," _
                   & "carrierR2 ," _
                   & "carrierK2) " _
                   & " VALUES('" _
                   & r1itemid + "'," _
                   & "'" + r5Number + "','" + rcarrierR1 + "','" + rcarrierK1 + "'," _
                   & "'" + rcarrierR2 + "','" + rcarrierK2 + "') "
   
   
   '血生化验
   Dim j As Integer
   For j = 0 To 4
   
   PCnnHisDB.Execute "INSERT INTO lcbloodAssay( number,itemid,fruit) " _
                   & " VALUES('" _
                   & r6Number + "'," _
                   & "'" + r5itemid(j) + "'," _
                   & "'" + rfruit(j) + "') "
   Next j
   
   '观察起止时间
   


   PCnnHisDB.Execute "INSERT INTO lctimebound( number,starddate,enddate,chiefDoctor) " _
                   & " VALUES('" _
                   & r7Number + "'," _
                   & "'" + Trim(rstarddate) + "'," _
                   & "'" + Trim(renddate) + "','" + rchiefDoctor + "') "
             

    
    


    
'
    If CBool(PCnnHisDB.State And adStateExecuting) Then
        PCnnHisDB.Cancel
        PCnnHisDB.RollbackTrans
        MsgBox "保存儿童基本信息失败，请重操作。", vbCritical, "提示"
        savefirstrecord = "失败"
        Exit Function
    Else
        PCnnHisDB.CommitTrans
        
    End If
    
    savefirstrecord = "成功"
  
 '在这里用一个复合条件查询，目的是要确定一个儿童的birthdaynow.
 '查询条件：name,sex,telphone,addree,birthday
 '把所得的birthdaynow 赋值给　函数　savebabyinformition
    
End Function

Public Function saveotherrecord(ByVal rNumber, ByVal ritemid, ByVal rfruit, ByVal i As Integer) As String


   
 
  '开始事务
  PCnnHisDB.BeginTrans
  
  '病人基本信息
                                  
    Dim u As Integer
   
  
   '血生化验
  
   
   For u = 0 To i - 1
   
   PCnnHisDB.Execute "INSERT INTO lcbloodAssay( number,itemid,fruit) " _
                   & " VALUES('" _
                   & rNumber + "'," _
                   & "'" + ritemid(u) + "'," _
                   & "'" + rfruit(u) + "') "
   
   
   Next u


    

    If CBool(PCnnHisDB.State And adStateExecuting) Then
        PCnnHisDB.Cancel
        PCnnHisDB.RollbackTrans
        MsgBox "保存儿童基本信息失败，请重操作。", vbCritical, "提示"
        saveotherrecord = "失败"
        Exit Function
    Else
        PCnnHisDB.CommitTrans
    End If
  
 '在这里用一个复合条件查询，目的是要确定一个儿童的birthdaynow.
 '查询条件：name,sex,telphone,addree,birthday
 '把所得的birthdaynow 赋值给　函数　savebabyinformition
    saveotherrecord = "成功"
End Function

Public Function saveotherrecordTwo(ByVal rNumber, ByVal ritemid, ByVal rfruit, ByVal i As Integer) As String

  '开始事务
  PCnnHisDB.BeginTrans
  
  '病人基本信息
                                  
    Dim t As Integer
   
  
   '血生化验
  
   
   For t = 0 To i - 1
   
   PCnnHisDB.Execute "INSERT INTO lcbloodAssay( number,itemid,fruit) " _
                   & " VALUES('" _
                   & rNumber + "'," _
                   & "'" + ritemid(t) + "'," _
                   & "'" + rfruit(t) + "') "
   
   
   Next t


  

    If CBool(PCnnHisDB.State And adStateExecuting) Then
        PCnnHisDB.Cancel
        PCnnHisDB.RollbackTrans
        MsgBox "保存儿童基本信息失败，请重操作。", vbCritical, "提示"
        saveotherrecordTwo = "失败"
        Exit Function
    Else
        PCnnHisDB.CommitTrans
    End If
  
 '在这里用一个复合条件查询，目的是要确定一个儿童的birthdaynow.
 '查询条件：name,sex,telphone,addree,birthday
 '把所得的birthdaynow 赋值给　函数　savebabyinformition
    saveotherrecordTwo = "成功"
End Function

Public Function saveotherrecordThree(ByVal rNumber, ByVal ritemid, ByVal rsfruit, ByVal i As Integer) As String


   
 
  '开始事务
  PCnnHisDB.BeginTrans
  
  '病人基本信息
                                  
    Dim th As Integer
   
  
   '血生化验
  
   
   For th = 0 To i - 1
   
   PCnnHisDB.Execute "INSERT INTO lcbloodAssay( number,itemid,fruit) " _
                   & " VALUES('" _
                   & rNumber + "'," _
                   & "'" + ritemid(th) + "'," _
                   & "'" + Trim(rsfruit(th)) + "') "
   
   
   Next th


    
    If CBool(PCnnHisDB.State And adStateExecuting) Then
        PCnnHisDB.Cancel
        PCnnHisDB.RollbackTrans
        MsgBox "保存儿童基本信息失败，请重操作。", vbCritical, "提示"
        saveotherrecordThree = "失败"
        Exit Function
    Else
        PCnnHisDB.CommitTrans
    End If
  
 '在这里用一个复合条件查询，目的是要确定一个儿童的birthdaynow.
 '查询条件：name,sex,telphone,addree,birthday
 '把所得的birthdaynow 赋值给　函数　savebabyinformition
    saveotherrecordThree = "成功"
End Function




Public Function FunGetid(s As Date) As String   '获取儿童标识
    Dim newstring As String
    newstring = "CONVERT(nvarchar(8)," + Format(s, "yyyymmdd") + ")+CONVERT(nvarchar(24),CONVERT(nvarchar(24),getdate(),8)" + ",8)"
    Dim AdoRsDateTime As ADODB.Recordset
    Set AdoRsDateTime = New ADODB.Recordset
    AdoRsDateTime.Open "SELECT " & newstring, PCnnHisDB, adOpenForwardOnly
    AdoRsDateTime.MoveFirst
    FunGetid = AdoRsDateTime.Fields(0)
    AdoRsDateTime.Close: Set AdoRsDateTime = Nothing
End Function

Private Function getmanid(man As String) As Integer  '获取儿童标识
    Dim newstring As String
    newstring = "* from lc_fz_illman where name='" + Trim(man) + "'"
    Dim AdoRsDateTime As ADODB.Recordset
    Set AdoRsDateTime = New ADODB.Recordset
    AdoRsDateTime.Open "SELECT " & newstring, PCnnHisDB, 2 'adOpenForwardOnly
    AdoRsDateTime.MoveLast
    getmanid = AdoRsDateTime.Fields(0)
    AdoRsDateTime.Close: Set AdoRsDateTime = Nothing
End Function