技师工作站自动绑定设备VBS脚本分享

博主：猫不是猫
发布时间：2023 年 05 月 26 日
101 次浏览
暂无评论
11496字数
分类：放射

> 无他，需要下面两个按钮只查询当前设备的患者信息，还需要手动去修改配置文件，就很麻烦，搞了个自动写ini的脚本。需要注意的是，登录后第一次双击的患者需要是分诊到当前设备的检查记录！

![](https://image.cnotcat.cn/blogimg/20230526094620.png)

- ~~Restart.bat~~

> ~~该文件作用是用于绑定成功后重启技师工作站,该文件路径为03/bin/config。~~（经测试不需要重新登录就能生效）

```shell
@echo off
if "%1"=="h" goto begin
start mshta vbscript:createobject("wscript.shell").run("""%~nx0"" h",0)(window.close)&&exit
:begin
taskkill /f /im ArtificerWorkStation.exe
ping -n 2 127.0.0.1 >nul
start ArtificerWorkStation.exe
```

- DevicePrepare.ini

> 该文件用于记录技师工作站双击患者后，是否弹出绑定设备的弹窗，Prepare=0则弹出，在绑定成功后会被vbs脚本改成Prepare=1，需要重置则手动修改成0，或者在右键加个菜单调vbs脚本重置。该文件路径为03/bin/config

```ini
[Default]
Prepare=0
```

- TW_ArtificerWorkStation.vbs

> 该脚本是双击患者记录的时候会调用的脚本，里面写了对DevicePrepare.ini文件Prepare节点的判断，以及ini文件的读写。该文件路径为03/bin/config

```vbnet

Call Main

Sub Main()
	checkSerialNum = Data.GetNamedValue("检查流水号")
	Data.SetNamedValue CStr("ShowStudyInfo"),0

writepath=".\Config\TW_BottomShortCutQuery.ini"
writepath1=".\Config\DevicePrepare.ini"
writepath2=".\Config\TW_TopShortCutQuery.ini"
writesectionName="Default"
writekeyName1="DEVICEID"
writekeyName2="DEVICETYPEID"
writekeyName3="Prepare"
newvalue="1"

cc = ReadIni(writepath1, writesectionName, writekeyName3)
if cc =0 then

'------------------------查询设备信息 - Start-----------------------------'
strSql = "select de.devicetypeid,de.devicetypename,d.deviceid,d.devicename from studyinfo s left join devicetable d on d.deviceid=s.deviceid left join devicetypeinfo de on de.devicetypeid=s.devicetypeid where s.checkserialnum='" & checkSerialNum & "'"
	Set rs = DBConnection.Execute(strSql)
	If  not rs.eof Then
		devicetypeid = rs("devicetypeid")
		devicetypename = rs("devicetypename")
		deviceid = rs("deviceid")
		devicename = rs("devicename")
		end if 
'------------------------查询设备信息 - End-----------------------------'

msgtxt1 = "为准确的让技师工作站与检查设备绑定，需要您确认以下信息：" + vbcrlf
msgtxt2 =msgtxt1 + "即将绑定的设备信息为：" + vbcrlf
msgtxt3 = msgtxt2 + vbcrlf
msgtxt4 =msgtxt3 + "设备类型："&devicetypename&"" + vbcrlf
msgtxt5 =msgtxt4 + "设备名称："&devicename&"" + vbcrlf
msgtxt6 = msgtxt5 + vbcrlf
msgtxt7 = msgtxt6 + "以上信息无误请点击 是 ，如信息不符请选择分诊到所在设备的检查"

select case MsgBox (msgtxt7,vbYesNo,"诊室初始化设置提醒")
 case vbYes 
 Call WriteIni (writepath1,writesectionName,writekeyName3,newvalue) 
 Call WriteIni (writepath,writesectionName,writekeyName1,deviceid)
 Call WriteIni (writepath,writesectionName,writekeyName2,devicetypeid)
 Call WriteIni (writepath2,writesectionName,writekeyName1,deviceid)
 Call WriteIni (writepath2,writesectionName,writekeyName2,devicetypeid)
MsgBox "绑定成功" 
 case vbNo
MsgBox "取消绑定"
 end Select

end if

end sub

Sub WriteIni( myFilePath, mySection, myKey, myValue )  '写ini
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
    Dim intEqualPos
    Dim objFSO, objNewIni, objOrgIni, wshShell
    Dim strFilePath, strFolderPath, strKey, strLeftString
    Dim strLine, strSection, strTempDir, strTempFile, strValue

strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )
    strValue    = Trim( myValue )

Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
    Set wshShell = CreateObject( "WScript.Shell" )

strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
    strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )

Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
    Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )

blnInSection     = False
    blnSectionExists = False
    ' Check if the specified key already exists
    blnKeyExists     = ( ReadIni( strFilePath, strSection, strKey ) <> "" )
    blnWritten       = False

' Check if path to INI file exists, quit if not
    strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
    If Not objFSO.FolderExists ( strFolderPath ) Then
        WScript.Echo "Error: WriteIni failed, folder path (" _
                   & strFolderPath & ") to ini file " _
                   & strFilePath & " not found!"
        Set objOrgIni = Nothing
        Set objNewIni = Nothing
        Set objFSO    = Nothing
        WScript.Quit 1
    End If

While objOrgIni.AtEndOfStream = False
        strLine = Trim( objOrgIni.ReadLine )
        If blnWritten = False Then
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                blnSectionExists = True
                blnInSection = True
            ElseIf InStr( strLine, "[" ) = 1 Then
                blnInSection = False
            End If
        End If

If blnInSection Then
            If blnKeyExists Then
                intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
                If intEqualPos > 0 Then
                    strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                    If LCase( strLeftString ) = LCase( strKey ) Then
                        ' Only write the key if the value isn't empty
                        ' Modification by Johan Pol
                        If strValue <> "<DELETE_THIS_VALUE>" Then
                            objNewIni.WriteLine strKey & "=" & strValue
                        End If
                        blnWritten   = True
                        blnInSection = False
                    End If
                End If
                If Not blnWritten Then
                    objNewIni.WriteLine strLine
                End If
            Else
                objNewIni.WriteLine strLine
                    ' Only write the key if the value isn't empty
                    ' Modification by Johan Pol
                    If strValue <> "<DELETE_THIS_VALUE>" Then
                        objNewIni.WriteLine strKey & "=" & strValue
                    End If
                blnWritten   = True
                blnInSection = False
            End If
        Else
            objNewIni.WriteLine strLine
        End If
    Wend

If blnSectionExists = False Then ' section doesn't exist
        objNewIni.WriteLine
        objNewIni.WriteLine "[" & strSection & "]"
            ' Only write the key if the value isn't empty
            ' Modification by Johan Pol
            If strValue <> "<DELETE_THIS_VALUE>" Then
                objNewIni.WriteLine strKey & "=" & strValue
            End If
    End If

objOrgIni.Close
    objNewIni.Close

' Delete old INI file
    objFSO.DeleteFile strFilePath, True
    ' Rename new INI file
    objFSO.MoveFile strTempFile, strFilePath

Set objOrgIni = Nothing
    Set objNewIni = Nothing
    Set objFSO    = Nothing
    Set wshShell  = Nothing
End Sub

Function ReadIni( myFilePath, mySection, myKey )  ' 读ini
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

Dim intEqualPos
    Dim objFSO, objIniFile
    Dim strFilePath, strKey, strLeftString, strLine, strSection

Set objFSO = CreateObject( "Scripting.FileSystemObject" )

ReadIni     = ""
    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )

If objFSO.FileExists( strFilePath ) Then
        Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
        Do While objIniFile.AtEndOfStream = False
            strLine = Trim( objIniFile.ReadLine )

' Check if section is found in the current line
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                strLine = Trim( objIniFile.ReadLine )

' Parse lines until the next section is reached
                Do While Left( strLine, 1 ) <> "["
                    ' Find position of equal sign in the line
                    intEqualPos = InStr( 1, strLine, "=", 1 )
                    If intEqualPos > 0 Then
                        strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                        ' Check if item is found in the current line
                        If LCase( strLeftString ) = LCase( strKey ) Then
                            ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
                            ' In case the item exists but value is blank
                            If ReadIni = "" Then
                                ReadIni = " "
                            End If
                            ' Abort loop when item is found
                            Exit Do
                        End If
                    End If

' Abort if the end of the INI file is reached
                    If objIniFile.AtEndOfStream Then Exit Do

' Continue with next line
                    strLine = Trim( objIniFile.ReadLine )
                Loop
            Exit Do
            End If
        Loop
        objIniFile.Close
    Else
        WScript.Echo strFilePath & " doesn't exists. Exiting..."
        Wscript.Quit 1
    End If
End Function
```

- TW_BottomShortCutQuery.ini

> 该文件就是配置 查询已检查 按钮默认查询的设备类型和设备ID信息的，目前通过vbs脚本读写。该文件路径为03/bin/config

```ini
[登录技师已检查]
PHOTOMAKERID=super
[COMMON]
CONDITION=Default
[Default]
NDAY=3
DEVICETYPEID=3
DEVICEID=332
;STUDYSTATUS=30 , 40 , 50 , 51 , 55 , 60 , 61 , 65 , 70 , 80
;PHOTOMAKERID = is not null
```

- TW_TopShortCutQuery.ini

> 这个是配置 查询待检查 按钮的设备类型和设备ID的 该文件路径为03/bin/config

```ini
[待检查]
NDAY=2
;PHOTOMAKERID = is null
PHOTOMAKER=超级用户
[COMMON]
CONDITION =Default
[FYL]
STUDYSTATUS=0 , 10 , 20
;NDAY=7
[Default]
NDAY=3
DEVICETYPEID=3
DEVICEID=332
STUDYSTATUS=0 , 10 , 20
;PHOTOMAKERID = is null
```

- ArtVBS.ini

> 这个配置的是点击 检查完成 后 调用的vbs脚本文件 该文件路径为03/bin/config

```ini
[VBS]
Name=TW_StudyComplated.vbs
```

- TW_StudyComplated.vbs

> 这个用来解决检查状态>30的患者无法记录技师ID的问题，该文件路径为03/bin/config

```vbnet
'On Error Resume Next

Call Main()

Sub Main()

strCheckserialnum = Param.GetNamedValue("CHECKSERIALNUM")
	strUserid = Param.GetNamedValue("Userid")
	strUserName = Param.GetNamedValue("UserName")

If GetStudystatus(strcheckserialnum) > 30 and  IsNull(GetPhotomakerid(strcheckserialnum)) Then  '判断状态是否大于30并且技师id为空
		   result = UpdatePhotomaker(strcheckserialnum,struserid,strUserName)
		End If

End Sub

Function GetPhotomakerid(strcheckserialnum)   '获取技师id 
	strSql = "select s.photomakerid from studyinfo s where s.checkserialnum='" & strCheckserialnum & "'"
	Set rs = Param.commoninfoquery(strSql)
	If not rs.eof Then
		GetPhotomakerid = rs("photomakerid")
		Exit Function
	End If
	GetPhotomakerid = ""
End Function

Function GetStudystatus(strcheckserialnum)  '获取检查状态
	strSql = "select s.photomaker,s.photomakerid,s.studystatus from studyinfo s where s.checkserialnum='" & strCheckserialnum & "'"
	Set rs = Param.commoninfoquery(strSql)
	If not rs.eof Then
		StudyStatus = rs("studystatus")
		GetStudystatus = CInt(StudyStatus)
		Exit Function
	End If
	GetStudystatus = 0
End Function

Function UpdatePhotomaker(strcheckserialnum,struserid,strUserName)   '更新技师id
	strSql = "update studyinfo s set s.photomaker='" & strUserName & "', s.photomakerid='" & strUserid &"' where s.checkserialnum='" & strcheckserialnum & "'"
	UpdatePhotomaker = param.commoninfoupdate(strSql)
End Function

```

~~文件打包好了~~，链接：[传送门](https://catch.lanzoul.com/iIfw70xaqsmf)

请使用上面的代码  打包的的脚本写的有点问题，上面的已经修改过来了

最后修改：2023 年 05 月 30 日

如果觉得我的文章对你有用，请随意赞赏

发表评论取消回复
使用cookie技术保留您的个人信息以便您下次快速评论，继续评论表示您已同意该条款

评论 *

私密评论

名称 *

🎲

邮箱 *

地址

技师工作站自动绑定设备VBS脚本分享

猫不是猫 • 2023 年 05 月 26 日

![](https://image.cnotcat.cn/blogimg/20230526094620.png)

- ~~Restart.bat~~

> ~~该文件作用是用于绑定成功后重启技师工作站,该文件路径为03/bin/config。~~（经测试不需要重新登录就能生效）

- DevicePrepare.ini

```ini
[Default]
Prepare=0
```

- TW_ArtificerWorkStation.vbs

> 该脚本是双击患者记录的时候会调用的脚本，里面写了对DevicePrepare.ini文件Prepare节点的判断，以及ini文件的读写。该文件路径为03/bin/config

```vbnet

Call Main

Sub Main()
	checkSerialNum = Data.GetNamedValue("检查流水号")
	Data.SetNamedValue CStr("ShowStudyInfo"),0

cc = ReadIni(writepath1, writesectionName, writekeyName3)
if cc =0 then

end if

end sub

Sub WriteIni( myFilePath, mySection, myKey, myValue )  '写ini
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )
    strValue    = Trim( myValue )

Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
    Set wshShell = CreateObject( "WScript.Shell" )

strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
    strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )

Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
    Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )

objOrgIni.Close
    objNewIni.Close

' Delete old INI file
    objFSO.DeleteFile strFilePath, True
    ' Rename new INI file
    objFSO.MoveFile strTempFile, strFilePath

Set objOrgIni = Nothing
    Set objNewIni = Nothing
    Set objFSO    = Nothing
    Set wshShell  = Nothing
End Sub

Function ReadIni( myFilePath, mySection, myKey )  ' 读ini
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

Dim intEqualPos
    Dim objFSO, objIniFile
    Dim strFilePath, strKey, strLeftString, strLine, strSection

Set objFSO = CreateObject( "Scripting.FileSystemObject" )

ReadIni     = ""
    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )

' Check if section is found in the current line
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                strLine = Trim( objIniFile.ReadLine )

' Abort if the end of the INI file is reached
                    If objIniFile.AtEndOfStream Then Exit Do

- TW_BottomShortCutQuery.ini

> 该文件就是配置 查询已检查 按钮默认查询的设备类型和设备ID信息的，目前通过vbs脚本读写。该文件路径为03/bin/config

- TW_TopShortCutQuery.ini

> 这个是配置 查询待检查 按钮的设备类型和设备ID的 该文件路径为03/bin/config

- ArtVBS.ini

> 这个配置的是点击 检查完成 后 调用的vbs脚本文件 该文件路径为03/bin/config

```ini
[VBS]
Name=TW_StudyComplated.vbs
```

- TW_StudyComplated.vbs

> 这个用来解决检查状态>30的患者无法记录技师ID的问题，该文件路径为03/bin/config

```vbnet
'On Error Resume Next

Call Main()

Sub Main()

strCheckserialnum = Param.GetNamedValue("CHECKSERIALNUM")
	strUserid = Param.GetNamedValue("Userid")
	strUserName = Param.GetNamedValue("UserName")

End Sub

```

~~文件打包好了~~，链接：[传送门](https://catch.lanzoul.com/iIfw70xaqsmf)

请使用上面的代码  打包的的脚本写的有点问题，上面的已经修改过来了

技师工作站自动绑定设备VBS脚本分享

发表评论取消回复
使用cookie技术保留您的个人信息以便您下次快速评论，继续评论表示您已同意该条款

快让你的Typecho冲上PHP7.4

百度云下载不限速：Pandowload第三方修改版

301重定向：让顶级域名跳转到二级域名

IntelliJ IDEA 2020.2.2官网最新版激活到2089年教程（mac+win通用）

Typecho开启伪静态-去掉烦人的archives

百度云下载不限速：Pandowload第三方修改版

关于输入模板工具只显示描述，不显示诊断

工作站写报告时导入临床诊断和病史

快让你的Typecho冲上PHP7.4

注册外服英雄联盟（RIOT）账号

技师工作站自动绑定设备VBS脚本分享

发表评论 取消回复 使用cookie技术保留您的个人信息以便您下次快速评论，继续评论表示您已同意该条款

技师工作站自动绑定设备VBS脚本分享

发表评论取消回复
使用cookie技术保留您的个人信息以便您下次快速评论，继续评论表示您已同意该条款