📄 mdlsubmain.bas
字号:
Call SetSystemProperty("ShowBarCodePrint_InPR", "1", Add)
'个人预约里面的导引单打印按钮
Call SetSystemProperty("ShowGuiderPrint_InPR", "1", Add)
'个人预约里面的计价功能
Call SetSystemProperty("Price_InPR", "1", Add)
'个人预约里面的收费功能
Call SetSystemProperty("Charging_InPR", "1", Add)
'登记里面的计价功能
Call SetSystemProperty("Price_InAffirm", "1", Add)
'登记里面的收费功能
Call SetSystemProperty("Charging_InAffirm", "1", Add)
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'个人付费里面，增加备注信息
dtmModifyDate = DateValue("2005-01-09")
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If dtmCurrentVersion < dtmModifyDate Then
Call AlterTable("SET_GRXX", "PriceMemo", "VARCHAR(1000) NULL")
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'创建新表SET_GRXX_VIDEO，用于存放个人影像数据
dtmModifyDate = DateValue("2005-01-12")
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If dtmCurrentVersion < dtmModifyDate Then
'创建新表
strSQL = "CREATE TABLE [dbo].[LOG_OPERATION] (" _
& vbCrLf & "[OperationTime] [datetime] NOT NULL ," _
& vbCrLf & "[Contents] [varchar] (2000) COLLATE Chinese_PRC_CI_AS NULL ," _
& vbCrLf & "[ManagerName] [varchar] (100) COLLATE Chinese_PRC_CI_AS NULL ," _
& vbCrLf & "[FromComputer] [varchar] (200) COLLATE Chinese_PRC_CI_AS NULL " _
& vbCrLf & ") ON [PRIMARY]"
'创建主键
strSQLAppend = "ALTER TABLE [dbo].[LOG_OPERATION] ADD " _
& vbCrLf & "CONSTRAINT [PK_LOG_OPERATION] PRIMARY KEY CLUSTERED " _
& vbCrLf & "(" _
& vbCrLf & "[OperationTime]" _
& vbCrLf & ") ON [PRIMARY] " _
& vbCrLf & ""
Call CreateTable("LOG_OPERATION", False, strSQL, strSQLAppend)
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
'
' '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' '更新HavePhoto字段
' dtmModifyDate = DateValue("2005-01-15")
' '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' If dtmCurrentVersion < dtmModifyDate Then
strSQL = "update SET_XX set" _
& " HavePhoto=0" _
& " where HavePhoto Is NUll"
GCon.Execute strSQL
' '写入新日期
' Call WriteCurrentVersion(CStr(dtmModifyDate))
' End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'导引单模式
dtmModifyDate = DateValue("2005-01-17")
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If dtmCurrentVersion < dtmModifyDate Then
Call SetSystemProperty("GuiderType", "0", Add)
'更新“团体登记与分组”的菜单名称为“团体登记”
strSQL = "update SET_MNU_Data set" _
& " mnuCaption='团体登记'" _
& " where mnuName='mnuTTDJ'"
GCon.Execute strSQL
'更新“密码更改”为“更改密码”
strSQL = "update SET_MNU_Data set" _
& " mnuCaption='更改密码'" _
& " where mnuName='mnuMMGG'"
GCon.Execute strSQL
strSQL = "update SET_MNU_Data set" _
& " mnuCaption='更改密码'" _
& " where mnuName='mnuQF_GGMM'"
GCon.Execute strSQL
'创建新表
strSQL = "CREATE TABLE [dbo].[DATA_HealthStatus] (" _
& vbCrLf & "[GUID] [bigint] NOT NULL ," _
& vbCrLf & "[TJRQ] [smalldatetime] NULL ," _
& vbCrLf & "[HealthStatusID] [smallint] NULL ," _
& vbCrLf & "[HealthResult] [varchar] (1000) NULL ," _
& vbCrLf & "[JYContent] [varchar] (4000) COLLATE Chinese_PRC_CI_AS NULL ," _
& vbCrLf & "[EmployeeID] [int] NULL" _
& vbCrLf & ") ON [PRIMARY]"
'创建主键
strSQLAppend = "ALTER TABLE [dbo].[DATA_HealthStatus] ADD " _
& vbCrLf & "CONSTRAINT [PK_DATA_HealthStatus] PRIMARY KEY CLUSTERED " _
& vbCrLf & "(" _
& vbCrLf & "[GUID]" _
& vbCrLf & ") ON [PRIMARY] "
Call CreateTable("DATA_HealthStatus", False, strSQL, strSQLAppend)
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'去掉自定义报告、单位病患汇总导出、报表打印与预览菜单
dtmModifyDate = DateValue("2005-01-19")
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If dtmCurrentVersion < dtmModifyDate Then
strSQL = "delete from SET_MNU_DATA" _
& " where mnuName in('mnuZDYTJBB'" _
& ",'mnuBBZH'" _
& ",'mnuDWBHHZDC'" _
& ",'mnuQF_DWBHHZDC'" _
& ",'mnuDYYL'" _
& ",'mnuQF_DYYL'" _
& ",'mnuQF_ZDYTJBB'" _
& ",'mnuQF_BBZH'" _
& ")"
GCon.Execute strSQL
'更新菜单名称
strSQL = "update SET_MNU_DATA set" _
& " mnuCaption='打印与预览'" _
& " where mnuName in('mnuMBBB','mnuQF_MBBB')"
GCon.Execute strSQL
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'创建新表SET_ORDER，用于保存操作人员选择顺序
dtmModifyDate = DateValue("2005-01-21")
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If dtmCurrentVersion < dtmModifyDate Then
'创建新表
strSQL = "CREATE TABLE [dbo].[SET_ORDER] (" _
& vbCrLf & "[EmployeeID] [int] NOT NULL ," _
& vbCrLf & "[KSID] [varchar] (2) COLLATE Chinese_PRC_CI_AS NOT NULL ," _
& vbCrLf & "[SelectID] [int] NOT NULL ," _
& vbCrLf & "[SelectTime] [datetime] NULL" _
& vbCrLf & ") ON [PRIMARY]"
'创建主键
strSQLAppend = "ALTER TABLE [dbo].[SET_ORDER] WITH NOCHECK ADD " _
& vbCrLf & "CONSTRAINT [PK_SET_ORDER] PRIMARY KEY CLUSTERED " _
& vbCrLf & "(" _
& vbCrLf & "[EmployeeID]," _
& vbCrLf & "[KSID]," _
& vbCrLf & "[SelectID]" _
& vbCrLf & ") ON [PRIMARY] " _
& vbCrLf & ""
Call CreateTable("SET_ORDER", False, strSQL, strSQLAppend)
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'去掉自定义报告、单位病患汇总导出、报表打印与预览菜单
dtmModifyDate = DateValue("2005-01-22")
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If dtmCurrentVersion < dtmModifyDate Then
'更新菜单名称
strSQL = "update SET_MNU_DATA set" _
& " mnuCaption='体检报告设置'" _
& " where mnuName in('mnuBBMBWH','mnuQF_BBMBWH')"
GCon.Execute strSQL
strSQL = "update SET_MNU_DATA set" _
& " mnuCaption='数据备份/恢复'" _
& " where mnuName in('mnuBZB_SJKBF','mnuQF_SJKBF')"
GCon.Execute strSQL
strSQL = "update SET_MNU_DATA set" _
& " mnuCaption='阳性汇总导出'" _
& " where mnuName in('mnuDWYXHZDC','mnuQF_DWYXHZDC')"
GCon.Execute strSQL
strSQL = "update SET_MNU_DATA set" _
& " mnuCaption='团检报告导出'" _
& " where mnuName in('mnuDWTJBGDC','mnuQF_DWTJBGDC')"
GCon.Execute strSQL
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'添加与RIS的连接参数
dtmModifyDate = DateValue("2005-01-24")
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If dtmCurrentVersion < dtmModifyDate Then
'RIS连接设置
Call SetSystemProperty("KDYY", "", Add)
Call SetSystemProperty("KDKB", "", Add)
Call SetSystemProperty("KDYS", "", Add)
'SET_XX中添加一列
Call AlterTable("SET_XX", "BHID", "int")
'创建RIS项目表
strSQL = "CREATE TABLE [Set_djxm] (" _
& vbCrLf & "[bhid] [int] IDENTITY (1, 1) NOT NULL ," _
& vbCrLf & "[jcsb] [varchar] (255) COLLATE Chinese_PRC_CI_AS NULL ," _
& vbCrLf & "[jcbw] [varchar] (255) COLLATE Chinese_PRC_CI_AS NULL ," _
& vbCrLf & "[jcff] [varchar] (255) COLLATE Chinese_PRC_CI_AS NULL ," _
& vbCrLf & "CONSTRAINT [PK_123] PRIMARY KEY CLUSTERED " _
& vbCrLf & "(" _
& vbCrLf & "[bhid]" _
& vbCrLf & ") ON [PRIMARY] " _
& vbCrLf & ") ON [PRIMARY]"
Call CreateTable("Set_djxm", False, strSQL)
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'去掉SET_GRXX中多余的索引
dtmModifyDate = DateValue("2005-01-26")
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If dtmCurrentVersion < dtmModifyDate Then
strSQL = "IF EXISTS (SELECT name FROM sysindexes" _
& vbCrLf & "WHERE name = 'index_HealthID')" _
& vbCrLf & "DROP INDEX SET_GRXX.index_HealthID"
GCon.Execute strSQL
'写入新日期
Call WriteCurrentVersion(CStr(dtmModifyDate))
End If
GoTo ExitLab
ErrMsg:
Status = SetError(Err.Number, Err.Description, Err.Source)
ErrMsg Status
Resume Next '继续更新其他部分
ExitLab:
'
End Function
'获取当前客户数据库版本
Private Function GetCurrentVersion() As Date
On Error GoTo ErrMsg
Dim Status
Dim strSQL As String
Dim rsVersion As ADODB.Recordset
Dim dtmVersion As Date
'检索当前版本
strSQL = "select SYSTEMPROPERTY from SET_SYSTEM" _
& " where SYSTEMNAME='DatabaseVersion'"
Set rsVersion = New ADODB.Recordset
rsVersion.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
If rsVersion.EOF Then
'尚未写入
dtmVersion = DateValue("2004-01-01")
strSQL = "insert into SET_SYSTEM(SYSTEMNAME,SYSTEMPROPERTY) values(" _
& "'DatabaseVersion'" _
& ",'" & dtmVersion & "'" _
& ")"
GCon.Execute strSQL
Else
If (IsNull(rsVersion("SYSTEMPROPERTY"))) Or (rsVersion("SYSTEMPROPERTY") = "") Then
'删除
dtmVersion = DateValue("2004-01-01")
strSQL = "delete from SET_SYSTEM" _
& " where SYSTEMNAME='DatabaseVersion'"
GCon.Execute strSQL
Else
dtmVersion = rsVersion("SYSTEMPROPERTY")
End If
End If
'返回
GetCurrentVersion = dtmVersion
GoTo ExitLab
ErrMsg:
Status = SetError(Err.Number, Err.Description, Err.Source)
ErrMsg Status
ExitLab:
'
End Function
'写入数据库版本
Private Function WriteCurrentVersion(ByVal strCurrentVersion As String) As Boolean
On Error GoTo ErrMsg
Dim Status
Dim strSQL As String
Dim rsExist As ADODB.Recordset
strSQL = "select Count(*) from SET_SYSTEM" _
& " where SYSTEMNAME='DatabaseVersion'"
Set rsExist = New ADODB.Recordset
rsExist.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
If rsExist(0) < 1 Then
strSQL = "insert into SET_SYSTEM(SYSTEMNAME,SYSTEMPROPERTY) values(" _
& "'DatabaseVersion'" _
& ",'" & strCurrentVersion & "'" _
& ")"
Else
strSQL = "update SET_SYSTEM set" _
& " SYSTEMPROPERTY='" & strCurrentVersion & "'" _
& " where SYSTEMNAME='DatabaseVersion'"
End If
rsExist.Close
GCon.Execute strSQL
'返回
WriteCurrentVersion = True
GoTo ExitLab
ErrMsg:
Status = SetError(Err.Number, Err.Description, Err.Source)
ErrMsg Status
ExitLab:
'
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -