Loading... * 现场超声经常A医生登录了系统后离开，B医生没注意就用A医生的工作做检查暂存了 * 增加右键菜单减少人工操作 * 先新建一个vbs，然后右键菜单调用该vbs > updatadoc1.vbs ```vbnet Call main() Sub main() UserID = CStr(PatientList.GetCurUserID) Roleid = PatientList.GetCurRoleID CHECKSERIALNUM = PatientList.GetSelectedValue("CHECKSERIALNUM") sql = "select studystatus,diagrptid from studyinfo where checkserialnum='"&CHECKSERIALNUM&"'" '查询检查状态和报告ID Set Conn=PatientList.GetDBConn Set rs = Conn.Execute(sql)'查询检查状态和报告ID studystatus=Cint(rs("studystatus")) if studystatus<70 then '状态小于70不能修改 MyScript.MsgBox"报告未确认，不能更新" exit sub end if diagrptid=rs("diagrptid") sql2="select docid1 from patientdiagrptinfo where diagrptid='"&diagrptid&"'" '查询报告的报告医生 Set rs = Conn.Execute(sql2)'查询报告的报告医生 docid1=CStr(rs("docid1")) Dim newdocid1 '接收输入的医生工号 if STRCOMP(docid1,UserID)<>0 then '判断报告医生和当前医生是否一致 newdocid1=inputbox("请输入需要修改的报告医生工号","输入工号") ' 用户是否点击取消按钮或关闭窗口，是则结束函数 If newdocid1 = "" Then exit sub End If else MyScript.MsgBox "你没用权限操作该检查，因为该检查的报告医生不是你" exit sub end if sql3="select userid,username from pacsuser where loginid='"&newdocid1&"' and DEPARTMENTID ='0159' " Set rs = Conn.Execute(sql3)'查询需要修改的医生userid If Not rs.EOF Then ' 如果结果集不为空 newuserid = CStr(rs("userid")) newusername = CStr(rs("username")) Else MyScript.MsgBox "你输入的工号不存在，请检查后重试" exit sub End If if STRCOMP(newuserid,docid1)=0 then MyScript.MsgBox"你输入的工号与原报告医生一致，无法修改" exit Sub end if sql4 = "update patientdiagrptinfo set docid1='"&newuserid&"' where diagrptid='"&diagrptid&"'" '更新报告医生 ReturnValue=MyScript.MsgBox("报告医生即将改为“"&newusername&"”，是否继续操作？",vbQuestion+vbYesNo) If CInt(ReturnValue)=vbNo Then Exit Sub ElseIf CInt(ReturnValue)=vbYes Then Set rs = Conn.Execute(sql4)'修改的医生userid MyScript.MsgBox"更新完成，重新提交报告后生效" Exit Sub Else Exit Sub End If Set rs = Nothing ' 释放结果集对象 End Sub ``` 最后修改：2024 年 04 月 22 日 © 允许规范转载 赞 如果觉得我的文章对你有用，请随意赞赏