Loading... > 无他,需要下面两个按钮只查询当前设备的患者信息,还需要手动去修改配置文件,就很麻烦,搞了个自动写ini的脚本。需要注意的是,登录后第一次双击的患者需要是分诊到当前设备的检查记录!  - ~~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 日 © 允许规范转载 打赏 赞赏作者 支付宝微信 赞 0 如果觉得我的文章对你有用,请随意赞赏