Loading... * 在左下角直接调用exe上报危急值 * 下方没有的脚本请自行新增 > PM_UploadCritical2.vbs ```vbnet Call main() Sub main() set argus=wscript.arguments '接收初始化脚本参数 name=(replace(argus(0),"*","")) '危急值名称 tips=argus(1) '判断危急值 1有 0 无 bb=".\CriticalValues.exe UPLOAD:" cc=bb&argus(2) '危急值程序调用入参 if tips="1" then REM select case msgbox ("该检查已上报了危急值 """&name&"""，"& vbCrLf&"继续上报将以本次上报的危急值内容为准。",vbYesNo + vbExclamation,"警告") select case msgbox ("该检查已上报了危急值，继续上报将以本次上报的危急值内容为准。",vbYesNo + vbExclamation,"提示") case vbYes call startcriss(cc) case vbNo end Select elseif tips="0" then call startcriss(cc) End if End Sub sub startcriss(cc) '调用危急值程序上报危急值 Set shell = CreateObject("WScript.Shell") '上报危急值前先调用程序退出命令，确保危急值上报弹窗每次都能置顶显示！ shell.Run ".\CriticalValues.exe -EXIT-",0,TRUE '启动并传参打开危急值上报界面 shell.Run cc,1,FALSE Set shell = Nothing end sub ``` > Rpt_InitPropList.vbs ```vbnet Call Main() Sub Main() Rpt.PropListAddItem "title","危急值" call crissz End Sub '添加危急值上报按钮 sub crissz Checkserialnum = Rpt.Data.GetNamedValue("CHECKSERIALNUM") UserID= Rpt.Data.GetNamedValue("UserID") sql="select t.criticalvalue from criticalvalueinfo t where t.checkserialnum ='"&Checkserialnum&"' and t.status<>'-1'" Set Conn=Rpt.GetDBConn Set rs4 = Conn.Execute(sql) If not rs4.eof Then criticalvalue=rs4("criticalvalue") tips="1" else criticalvalue="暂未查询到危急值信息****************************************" tips="0" End If wjz=""&criticalvalue&"**************************************** "&tips&" "&Checkserialnum&"|"&UserID&"" CHECKSERIALNUM = Rpt.Data.GetNamedValue("CHECKSERIALNUM") sql = "select criticalvalue,status from (select criticalvalue,status from criticalvalueinfo "&_ " where checkserialnum = '" & CHECKSERIALNUM & "' and status <> '-1' "&_ " order by sendtime desc, status desc) "&_ " where rownum = 1" Set rs = Conn.Execute(sql) If not rs.eof Then CRITICALVALUE = rs("criticalvalue") STATUS = rs("status") End If '危急值审核提醒：若存在已标记的危急值则进行提醒 If STATUS = "1" Then MyScript.MsgBox "该检查已上报影像危急值：" & CRITICALVALUE &" ", vbInformation + vbOKOnly End If Rpt.PropListAddItem "button","危急值","batlist_1",wjz,"","Config\PM_UploadCritical2.vbs" end sub ``` 最后修改：2024 年 04 月 22 日 © 允许规范转载 赞 如果觉得我的文章对你有用，请随意赞赏