- XOBUZAP ;; mjk/alb - Terminate Jobs Utility ; 08/4/2005 13:00
- ;;1.6;Foundations;;May 08, 2009;Build 15
- ;Per VHA directive 2004-038, this routine should not be modified.
- QUIT
- ;
- ; ----------------------- Main Entry Points -----------------------
- ;
- EN(XOBSEL) ; -- Interactive and main entry point for XOBU TERMINATE JOBS tool
- ;
- ; Input: XOBSEL array that specifies selection criteria
- ; XOBSEL("ROUTINE")=<routine name>
- ; XOBSEL("STATE")=<job state#> (see STATE tag for list of states)
- ; XOBSEL("TITLE")=optional title text to be used by ListManager (upper right of LM screen)
- ; XOBSEL("VISTA INFO REF")=optional reference to array or global containing "CLIENT IP" and "DUZ" nodes
- ;
- ; -- verify job selection critera
- IF '$$VERSEL(.XOBSEL) DO GOTO ENQ
- . WRITE !,"Job selection criteria not specified correctly or is missing!"
- ;
- ; -- start 'Terminate Jobs Utility'
- DO EN^VALM("XOBU TERMINATE JOBS UTILITY")
- ENQ ;
- QUIT
- ;
- ZAP(XOBSEL) ; -- Non-interactive entry point for XOBU TERMINATE JOBS tool
- ; API terminates all jobs that job selection criteria
- ;
- ; Input: XOBSEL array that specifies selection criteria (See above EN tag for information)
- ;
- ; Return: Count of how many jobs terminated OR
- ; -1 if MUMPS implementation is not Cache
- ; -2 if XOBSEL arrary is not passed in or is invalid.
- ;
- NEW XOBJOBS,XOBPID,XOBCNS,XOBCNT
- ; -- check if this is a Cache implementation
- IF '$$CACHE() SET XOBCNT=-1 GOTO ZAPQ
- ;
- ; -- verify job selection critera
- IF '$$VERSEL(.XOBSEL) SET XOBCNT=-2 GOTO ZAPQ
- ;
- DO GETJOBS(.XOBJOBS)
- SET XOBCNS=$$CURNS()
- SET XOBCNT=0
- SET XOBPID=""
- FOR SET XOBPID=$ORDER(XOBJOBS(XOBPID)) QUIT:XOBPID="" DO
- . IF $$CHECK(.XOBSEL,XOBPID,XOBCNS) DO
- . . SET XOBRES=$$TERMJOB(XOBPID)
- . . IF XOBRES=1 SET XOBCNT=XOBCNT+1
- ZAPQ ;
- QUIT XOBCNT
- ;
- ; ----------------------- Listman Related Code -----------------------
- ;
- HDR ; -- header code
- SET VALMHDR(1)=" "_IOUON_"Job Selection Criteria"_IOUOFF_" (matches: "_+$GET(VALMCNT)_")"
- SET VALMHDR(2)=" Box-Volume Pair: "_IOINHI_$$BOXVOL()_IOINORM
- SET VALMHDR(3)=" Current Namespace: "_IOINHI_$$CURNS()_IOINORM
- SET VALMHDR(4)=" Routine: "_IOINHI_$GET(XOBSEL("ROUTINE"),"Unknown")_IOINORM
- SET VALMHDR(5)=" Job State: "_IOINHI_$PIECE($$GETSTATE^XOBUZAP0(+$GET(XOBSEL("STATE"),";;;Unknown")),";",4)_IOINORM
- QUIT
- ;
- INIT ; -- init variables and list array
- IF $DATA(XOBSEL("TITLE")) SET VALM("TITLE")=XOBSEL("TITLE")
- DO BUILD
- SET VALMSG=$$CPMSG()
- QUIT
- ;
- BUILD ; -- build list based on job selection criteria (XOBSEL)
- NEW XOBJOBS,XOBPID,XOBCNS
- DO KILL
- DO KILL^VALM10()
- IF '$$CACHE() DO GOTO BUILDQ
- . DO SET^VALM10(1,"",1)
- . DO SET^VALM10(2,"",2)
- . DO SET^VALM10(3," 'Terminate' actions not supported for the current M implementation ["_$$MUMPS()_"].",3)
- . SET VALMCNT=3
- SET XOBCNS=$$CURNS()
- DO GETJOBS(.XOBJOBS)
- SET VALMCNT=0
- SET XOBPID=""
- FOR SET XOBPID=$ORDER(XOBJOBS(XOBPID)) QUIT:XOBPID="" DO
- . IF $$CHECK(.XOBSEL,XOBPID,XOBCNS) DO
- . . NEW XOBJINFO
- . . DO JOBINFO(XOBPID,.XOBJINFO,.XOBSEL)
- . . SET VALMCNT=VALMCNT+1
- . . SET X=""
- . . SET X=$$SETFLD^VALM1($JUSTIFY(VALMCNT,4),X,"ENTRY")
- . . SET X=$$SETFLD^VALM1(XOBPID,X,"PID")
- . . SET X=$$SETFLD^VALM1($EXTRACT($GET(XOBJINFO("DEVICE"))_":"_$GET(XOBJINFO("CLIENT IP")),1,34),X,"DEVICE")
- . . SET X=$$SETFLD^VALM1($EXTRACT("User="_$SELECT($GET(XOBJINFO("CONNECTOR USER")):"*",1:"")_$GET(XOBJINFO("VISTA USER NAME")),1,30),X,"COMMENT")
- . . DO SET^VALM10(VALMCNT,X,VALMCNT)
- . . SET ^TMP("XOB TERMINATE JOBS","IDX",$JOB,VALMCNT,VALMCNT)=XOBPID
- ;
- BUILDQ ;
- QUIT
- ;
- KILL ; -- kill off list location
- KILL ^TMP("XOB TERMINATE JOBS",$JOB)
- KILL ^TMP("XOB TERMINATE JOBS","IDX",$JOB)
- QUIT
- ;
- HELP ; -- help code
- SET X="?" DO DISP^XQORM1 WRITE !!
- QUIT
- ;
- EXIT ; -- exit code
- QUIT
- ;
- EXPND ; -- expand code
- QUIT
- ;
- MSG ; -- set default message
- SET VALMSG="Use RE (Refresh) to display only alive jobs "
- QUIT
- ;
- CPMSG() ; -- connection proxy user message
- QUIT "* Connector Proxy User"
- ;
- REFRESH ; -- refresh display
- ; -- Protocol: XOBU TERMINATE JOBS REFRESH
- DO BUILD
- SET VALMSG=$$CPMSG()
- KILL VALMHDR
- SET VALMBCK="R"
- QUIT
- ;
- SS ; -- display M os system status
- ; -- Protocol: XOBU TERMINATE SYSTEM STATUS
- DO FULL^VALM1
- IF $DATA(^%ZOSF("SS")) DO
- . XECUTE ^%ZOSF("SS")
- ELSE DO
- . WRITE !,"Error: ^%ZOSF(""SS"") node is not defined."
- DO PAUSE^VALM1
- DO REFRESH
- QUIT
- ;
- TERMALL ; -- terminate all pid/job
- ; -- Protocol: XOBU TERMINATE ALL JOBS
- IF '$$ASK() GOTO TERMALLQ
- NEW XOBI,XOBPID
- SET XOBI=""
- FOR SET XOBI=$ORDER(^TMP("XOB TERMINATE JOBS","IDX",$JOB,XOBI)) QUIT:XOBI="" DO
- . SET XOBPID=$GET(^TMP("XOB TERMINATE JOBS","IDX",$JOB,XOBI,XOBI))
- . DO TERMONE(XOBPID,XOBI)
- DO MSG
- TERMALLQ ;
- SET VALMBCK=""
- QUIT
- ;
- TERMPID ; -- terminate pid/job
- ; -- Protocol: XOBU TERMINATE A JOB
- NEW XOBI,VALMY,XOBPID,XOBRES
- DO EN^VALM2(XQORNOD(0),"OS")
- SET XOBI=+$ORDER(VALMY(""))
- IF XOBI>0 DO
- . NEW XOBPID
- . SET XOBPID=$GET(^TMP("XOB TERMINATE JOBS","IDX",$JOB,XOBI,XOBI))
- . ; -- highlight entire line
- . DO SELECT^VALM10(XOBI,1)
- . IF XOBPID="<terminated>" DO QUIT
- . . WRITE !,"Job has already been terminated!" DO PAUSE^VALM1
- . ;
- . IF $$ASK() DO
- . . DO TERMONE(XOBPID,XOBI),MSG
- . ELSE DO
- . . ; -- unhighlight entire line
- . . DO SELECT^VALM10(XOBI,0)
- SET VALMBCK=""
- QUIT
- ;
- TERMONE(XOBPID,XOBI) ; -- zap one pid and update display
- NEW XOBRES
- ; -- quit if already terminated
- IF XOBPID="<terminated>" QUIT
- ; -- make sure criteris is still met
- IF '$$CHECK(.XOBSEL,XOBPID,$$CURNS()) DO QUIT
- . ; -- insert warning comment into display line
- . DO FLDTEXT^VALM10(XOBI,"COMMENT","Criteria not met!")
- . ; -- highlight entire line
- . DO SELECT^VALM10(XOBI,1)
- ; -- terminate job
- SET XOBRES=$$TERMJOB(XOBPID)
- ; -- insert comment into display line
- DO FLDTEXT^VALM10(XOBI,"COMMENT",$EXTRACT($$RESULT(XOBRES),1,25))
- ; -- highlight entire line
- DO SELECT^VALM10(XOBI,1)
- ; -- remove PID so it can't be terminated again
- SET ^TMP("XOB TERMINATE JOBS","IDX",$JOB,XOBI,XOBI)="<terminated>"
- QUIT
- ;
- ASK(PROMPT) ; -- ask if user is sure
- NEW DIR,Y
- SET DIR("A")=$GET(PROMPT,"Are you sure")
- SET DIR("B")="NO",DIR(0)="Y"
- DO ^DIR
- QUIT +$GET(Y)
- ;
- RESULT(RESULT) ; -- return result text
- ; -- Note: Code number conversions found in RESJOB routine in %SYS namespace
- IF RESULT=1 QUIT "Process terminated"
- IF RESULT=-1 QUIT "Process not responding"
- IF RESULT=-2 QUIT "Process died, not responding"
- IF RESULT=-3 QUIT "Process already died"
- QUIT RESULT_" --> unknown result type"
- ;
- ; ---------- Code used by Interactive and Non-Interactive Entry Points ----------
- ;
- VERSEL(XOBSEL) ; -- every job selection criteria
- NEW XOBOK
- IF $GET(XOBSEL("ROUTINE"))=""!($GET(XOBSEL("STATE"))="") SET XOBOK=0 GOTO VERSELQ
- SET XOBOK=1
- VERSELQ ;
- QUIT XOBOK
- ;
- GETJOBS(XOBJOBS) ; -- build XOBJOBS()=pid information
- NEW XOBPID,XOBCNT
- SET XOBPID="",XOBCNT=0
- FOR SET XOBPID=$ORDER(^$JOB(XOBPID)) QUIT:XOBPID="" DO
- . SET XOBCNT=XOBCNT+1,XOBJOBS(XOBPID)=""
- QUIT
- ;
- CHECK(XOBSEL,XOBPID,XOBNS) ; -- check job info against selection criteria
- ; -- use if 1) in correct namespace [XOBNS],
- ; 2) in correct routine [XOBSEL("ROUTINE")] and
- ; 3) in correct process state [XOBSEL("STATE")]
- NEW XOBJINFO
- DO JOBINFO(XOBPID,.XOBJINFO,.XOBSEL)
- IF XOBJINFO("NAMESPACE")=XOBNS,XOBJINFO("ROUTINE")=$GET(XOBSEL("ROUTINE")),XOBJINFO("STATE")=$GET(XOBSEL("STATE")) QUIT 1
- QUIT 0
- ;
- JOBINFO(XOBPID,XOBJINFO,XOBSEL) ; -- get PID info
- ; -- In future (Cache v5+) use instance proprties of %SYSTEM.Process
- SET XOBJINFO("STATE")=+$ZUTIL(67,4,XOBPID)
- SET XOBJINFO("ROUTINE")=$ZUTIL(67,5,XOBPID)
- SET XOBJINFO("NAMESPACE")=$ZUTIL(67,6,XOBPID)
- SET XOBJINFO("DEVICE")=$ZUTIL(67,7,XOBPID)
- SET XOBJINFO("OS USERNAME")=$ZUTIL(67,11,XOBPID) ; currently not used
- ;
- ; -- get VistA Info is available
- IF $GET(XOBSEL("VISTA INFO REF"))]"" DO
- . NEW XOBY,XOBREF
- . SET XOBREF=$$GETREF^XOBUZAP0(XOBSEL("VISTA INFO REF"),XOBPID)
- . ;
- . SET XOBJINFO("VISTA DUZ")=+$$GETDUZ^XOBUZAP0(XOBREF)
- . SET XOBY=$PIECE($GET(^VA(200,XOBJINFO("VISTA DUZ"),0)),U)
- . SET XOBJINFO("VISTA USER NAME")=$SELECT(XOBY]"":XOBY,1:"<unknown>")
- . SET XOBJINFO("CONNECTOR USER")=$$CPCHK^XUSAP(XOBJINFO("VISTA DUZ"))
- . ;
- . SET XOBY=$$GETIP^XOBUZAP0(XOBREF)
- . SET XOBJINFO("CLIENT IP")=$SELECT(XOBY]"":XOBY,1:"<unknown>")
- QUIT
- ;
- TERMJOB(XOBPID) ; -- terminate pid/job
- ; -- In future (Cache v5+) use instance method %SYSTEM.Process.Terminate()
- ;QUIT 1 ; -- used for testing
- QUIT $ZUTIL(4,XOBPID)
- ;
- BOXVOL() ; -- cpu volume pair
- NEW Y DO GETENV^%ZOSV
- QUIT $P(Y,U,4)
- ;
- CURNS() ; -- get current namespace
- QUIT $ZUTIL(5)
- ;
- MUMPS() ; -- get MUMPS implementation
- QUIT $SELECT(^%ZOSF("OS")["OpenM":"OpenM",^("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",^("OS")["MSM":"MSM",1:"")
- ;
- CACHE() ; -- is this a Cache implementation
- QUIT $$MUMPS()["OpenM"
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBUZAP 9222 printed Feb 18, 2025@23:21:29 Page 2
- XOBUZAP ;; mjk/alb - Terminate Jobs Utility ; 08/4/2005 13:00
- +1 ;;1.6;Foundations;;May 08, 2009;Build 15
- +2 ;Per VHA directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ; ----------------------- Main Entry Points -----------------------
- +6 ;
- EN(XOBSEL) ; -- Interactive and main entry point for XOBU TERMINATE JOBS tool
- +1 ;
- +2 ; Input: XOBSEL array that specifies selection criteria
- +3 ; XOBSEL("ROUTINE")=<routine name>
- +4 ; XOBSEL("STATE")=<job state#> (see STATE tag for list of states)
- +5 ; XOBSEL("TITLE")=optional title text to be used by ListManager (upper right of LM screen)
- +6 ; XOBSEL("VISTA INFO REF")=optional reference to array or global containing "CLIENT IP" and "DUZ" nodes
- +7 ;
- +8 ; -- verify job selection critera
- +9 IF '$$VERSEL(.XOBSEL)
- Begin DoDot:1
- +10 WRITE !,"Job selection criteria not specified correctly or is missing!"
- End DoDot:1
- GOTO ENQ
- +11 ;
- +12 ; -- start 'Terminate Jobs Utility'
- +13 DO EN^VALM("XOBU TERMINATE JOBS UTILITY")
- ENQ ;
- +1 QUIT
- +2 ;
- ZAP(XOBSEL) ; -- Non-interactive entry point for XOBU TERMINATE JOBS tool
- +1 ; API terminates all jobs that job selection criteria
- +2 ;
- +3 ; Input: XOBSEL array that specifies selection criteria (See above EN tag for information)
- +4 ;
- +5 ; Return: Count of how many jobs terminated OR
- +6 ; -1 if MUMPS implementation is not Cache
- +7 ; -2 if XOBSEL arrary is not passed in or is invalid.
- +8 ;
- +9 NEW XOBJOBS,XOBPID,XOBCNS,XOBCNT
- +10 ; -- check if this is a Cache implementation
- +11 IF '$$CACHE()
- SET XOBCNT=-1
- GOTO ZAPQ
- +12 ;
- +13 ; -- verify job selection critera
- +14 IF '$$VERSEL(.XOBSEL)
- SET XOBCNT=-2
- GOTO ZAPQ
- +15 ;
- +16 DO GETJOBS(.XOBJOBS)
- +17 SET XOBCNS=$$CURNS()
- +18 SET XOBCNT=0
- +19 SET XOBPID=""
- +20 FOR
- SET XOBPID=$ORDER(XOBJOBS(XOBPID))
- if XOBPID=""
- QUIT
- Begin DoDot:1
- +21 IF $$CHECK(.XOBSEL,XOBPID,XOBCNS)
- Begin DoDot:2
- +22 SET XOBRES=$$TERMJOB(XOBPID)
- +23 IF XOBRES=1
- SET XOBCNT=XOBCNT+1
- End DoDot:2
- End DoDot:1
- ZAPQ ;
- +1 QUIT XOBCNT
- +2 ;
- +3 ; ----------------------- Listman Related Code -----------------------
- +4 ;
- HDR ; -- header code
- +1 SET VALMHDR(1)=" "_IOUON_"Job Selection Criteria"_IOUOFF_" (matches: "_+$GET(VALMCNT)_")"
- +2 SET VALMHDR(2)=" Box-Volume Pair: "_IOINHI_$$BOXVOL()_IOINORM
- +3 SET VALMHDR(3)=" Current Namespace: "_IOINHI_$$CURNS()_IOINORM
- +4 SET VALMHDR(4)=" Routine: "_IOINHI_$GET(XOBSEL("ROUTINE"),"Unknown")_IOINORM
- +5 SET VALMHDR(5)=" Job State: "_IOINHI_$PIECE($$GETSTATE^XOBUZAP0(+$GET(XOBSEL("STATE"),";;;Unknown")),";",4)_IOINORM
- +6 QUIT
- +7 ;
- INIT ; -- init variables and list array
- +1 IF $DATA(XOBSEL("TITLE"))
- SET VALM("TITLE")=XOBSEL("TITLE")
- +2 DO BUILD
- +3 SET VALMSG=$$CPMSG()
- +4 QUIT
- +5 ;
- BUILD ; -- build list based on job selection criteria (XOBSEL)
- +1 NEW XOBJOBS,XOBPID,XOBCNS
- +2 DO KILL
- +3 DO KILL^VALM10()
- +4 IF '$$CACHE()
- Begin DoDot:1
- +5 DO SET^VALM10(1,"",1)
- +6 DO SET^VALM10(2,"",2)
- +7 DO SET^VALM10(3," 'Terminate' actions not supported for the current M implementation ["_$$MUMPS()_"].",3)
- +8 SET VALMCNT=3
- End DoDot:1
- GOTO BUILDQ
- +9 SET XOBCNS=$$CURNS()
- +10 DO GETJOBS(.XOBJOBS)
- +11 SET VALMCNT=0
- +12 SET XOBPID=""
- +13 FOR
- SET XOBPID=$ORDER(XOBJOBS(XOBPID))
- if XOBPID=""
- QUIT
- Begin DoDot:1
- +14 IF $$CHECK(.XOBSEL,XOBPID,XOBCNS)
- Begin DoDot:2
- +15 NEW XOBJINFO
- +16 DO JOBINFO(XOBPID,.XOBJINFO,.XOBSEL)
- +17 SET VALMCNT=VALMCNT+1
- +18 SET X=""
- +19 SET X=$$SETFLD^VALM1($JUSTIFY(VALMCNT,4),X,"ENTRY")
- +20 SET X=$$SETFLD^VALM1(XOBPID,X,"PID")
- +21 SET X=$$SETFLD^VALM1($EXTRACT($GET(XOBJINFO("DEVICE"))_":"_$GET(XOBJINFO("CLIENT IP")),1,34),X,"DEVICE")
- +22 SET X=$$SETFLD^VALM1($EXTRACT("User="_$SELECT($GET(XOBJINFO("CONNECTOR USER")):"*",1:"")_$GET(XOBJINFO("VISTA USER NAME")),1,30),X,"COMMENT")
- +23 DO SET^VALM10(VALMCNT,X,VALMCNT)
- +24 SET ^TMP("XOB TERMINATE JOBS","IDX",$JOB,VALMCNT,VALMCNT)=XOBPID
- End DoDot:2
- End DoDot:1
- +25 ;
- BUILDQ ;
- +1 QUIT
- +2 ;
- KILL ; -- kill off list location
- +1 KILL ^TMP("XOB TERMINATE JOBS",$JOB)
- +2 KILL ^TMP("XOB TERMINATE JOBS","IDX",$JOB)
- +3 QUIT
- +4 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 QUIT
- +2 ;
- EXPND ; -- expand code
- +1 QUIT
- +2 ;
- MSG ; -- set default message
- +1 SET VALMSG="Use RE (Refresh) to display only alive jobs "
- +2 QUIT
- +3 ;
- CPMSG() ; -- connection proxy user message
- +1 QUIT "* Connector Proxy User"
- +2 ;
- REFRESH ; -- refresh display
- +1 ; -- Protocol: XOBU TERMINATE JOBS REFRESH
- +2 DO BUILD
- +3 SET VALMSG=$$CPMSG()
- +4 KILL VALMHDR
- +5 SET VALMBCK="R"
- +6 QUIT
- +7 ;
- SS ; -- display M os system status
- +1 ; -- Protocol: XOBU TERMINATE SYSTEM STATUS
- +2 DO FULL^VALM1
- +3 IF $DATA(^%ZOSF("SS"))
- Begin DoDot:1
- +4 XECUTE ^%ZOSF("SS")
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 WRITE !,"Error: ^%ZOSF(""SS"") node is not defined."
- End DoDot:1
- +7 DO PAUSE^VALM1
- +8 DO REFRESH
- +9 QUIT
- +10 ;
- TERMALL ; -- terminate all pid/job
- +1 ; -- Protocol: XOBU TERMINATE ALL JOBS
- +2 IF '$$ASK()
- GOTO TERMALLQ
- +3 NEW XOBI,XOBPID
- +4 SET XOBI=""
- +5 FOR
- SET XOBI=$ORDER(^TMP("XOB TERMINATE JOBS","IDX",$JOB,XOBI))
- if XOBI=""
- QUIT
- Begin DoDot:1
- +6 SET XOBPID=$GET(^TMP("XOB TERMINATE JOBS","IDX",$JOB,XOBI,XOBI))
- +7 DO TERMONE(XOBPID,XOBI)
- End DoDot:1
- +8 DO MSG
- TERMALLQ ;
- +1 SET VALMBCK=""
- +2 QUIT
- +3 ;
- TERMPID ; -- terminate pid/job
- +1 ; -- Protocol: XOBU TERMINATE A JOB
- +2 NEW XOBI,VALMY,XOBPID,XOBRES
- +3 DO EN^VALM2(XQORNOD(0),"OS")
- +4 SET XOBI=+$ORDER(VALMY(""))
- +5 IF XOBI>0
- Begin DoDot:1
- +6 NEW XOBPID
- +7 SET XOBPID=$GET(^TMP("XOB TERMINATE JOBS","IDX",$JOB,XOBI,XOBI))
- +8 ; -- highlight entire line
- +9 DO SELECT^VALM10(XOBI,1)
- +10 IF XOBPID="<terminated>"
- Begin DoDot:2
- +11 WRITE !,"Job has already been terminated!"
- DO PAUSE^VALM1
- End DoDot:2
- QUIT
- +12 ;
- +13 IF $$ASK()
- Begin DoDot:2
- +14 DO TERMONE(XOBPID,XOBI)
- DO MSG
- End DoDot:2
- +15 IF '$TEST
- Begin DoDot:2
- +16 ; -- unhighlight entire line
- +17 DO SELECT^VALM10(XOBI,0)
- End DoDot:2
- End DoDot:1
- +18 SET VALMBCK=""
- +19 QUIT
- +20 ;
- TERMONE(XOBPID,XOBI) ; -- zap one pid and update display
- +1 NEW XOBRES
- +2 ; -- quit if already terminated
- +3 IF XOBPID="<terminated>"
- QUIT
- +4 ; -- make sure criteris is still met
- +5 IF '$$CHECK(.XOBSEL,XOBPID,$$CURNS())
- Begin DoDot:1
- +6 ; -- insert warning comment into display line
- +7 DO FLDTEXT^VALM10(XOBI,"COMMENT","Criteria not met!")
- +8 ; -- highlight entire line
- +9 DO SELECT^VALM10(XOBI,1)
- End DoDot:1
- QUIT
- +10 ; -- terminate job
- +11 SET XOBRES=$$TERMJOB(XOBPID)
- +12 ; -- insert comment into display line
- +13 DO FLDTEXT^VALM10(XOBI,"COMMENT",$EXTRACT($$RESULT(XOBRES),1,25))
- +14 ; -- highlight entire line
- +15 DO SELECT^VALM10(XOBI,1)
- +16 ; -- remove PID so it can't be terminated again
- +17 SET ^TMP("XOB TERMINATE JOBS","IDX",$JOB,XOBI,XOBI)="<terminated>"
- +18 QUIT
- +19 ;
- ASK(PROMPT) ; -- ask if user is sure
- +1 NEW DIR,Y
- +2 SET DIR("A")=$GET(PROMPT,"Are you sure")
- +3 SET DIR("B")="NO"
- SET DIR(0)="Y"
- +4 DO ^DIR
- +5 QUIT +$GET(Y)
- +6 ;
- RESULT(RESULT) ; -- return result text
- +1 ; -- Note: Code number conversions found in RESJOB routine in %SYS namespace
- +2 IF RESULT=1
- QUIT "Process terminated"
- +3 IF RESULT=-1
- QUIT "Process not responding"
- +4 IF RESULT=-2
- QUIT "Process died, not responding"
- +5 IF RESULT=-3
- QUIT "Process already died"
- +6 QUIT RESULT_" --> unknown result type"
- +7 ;
- +8 ; ---------- Code used by Interactive and Non-Interactive Entry Points ----------
- +9 ;
- VERSEL(XOBSEL) ; -- every job selection criteria
- +1 NEW XOBOK
- +2 IF $GET(XOBSEL("ROUTINE"))=""!($GET(XOBSEL("STATE"))="")
- SET XOBOK=0
- GOTO VERSELQ
- +3 SET XOBOK=1
- VERSELQ ;
- +1 QUIT XOBOK
- +2 ;
- GETJOBS(XOBJOBS) ; -- build XOBJOBS()=pid information
- +1 NEW XOBPID,XOBCNT
- +2 SET XOBPID=""
- SET XOBCNT=0
- +3 FOR