- XULMRPC ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;10/15/2012
- ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
- ;;Per VA Directive 6402, this routine should not be modified
- ;
- ; ******************************************************************
- ; * *
- ; * The Kernel Lock Manager is based on the VistA Lock Manager *
- ; * developed by Tommy Martin. *
- ; * *
- ; ******************************************************************
- ;
- ;
- LOCKS(RETURN,LOCKS,RESULT,SCREEN) ; Compile lock table
- ;
- ;Inputs:
- ; LOCKS - the global location to set the data, referenced by indirection
- ; SCREEN = 1 if system locks should be screened out, 0 otherwise
- ; RESULT - global location to store the result
- ;Outputs:
- ; @LOCKS will contain the locks obtained from the lock table
- ; RETURN - return variable required for a RPC (doesn't seem to work)
- ; @RESULT - global location where result is placed 1 if success, 0 otherwise
- ;
- D GETLOCKS^XULMU(LOCKS)
- S:$L($G(RESULT)) @RESULT=1
- S RETURN=1
- Q RETURN
- ;
- ;
- KILLPROC(RETURN,PID,RESULT) ;
- ;Description:
- ; Kills the process identified to OS by PID
- ;Inputs:
- ; PID -
- ; RESULT - global location to store the result
- ;Outputs:
- ; RETURN - return variable required for a RPC (doesn't seem to work)
- ; @RESULT - global location where result is placed - 1 if success, 0 otherwise
- ;
- D
- .N $ETRAP S $ETRAP="G ERROR^XULMRPC"
- .S RETURN=$$KILL^%ZLMLIB(PID)
- S:$L($G(RESULT)) @RESULT=RETURN
- I RETURN D CLEANUP^XULMU(PID)
- Q RETURN
- ;
- ERROR ;
- S $ETRAP="Q:$QUIT """" Q"
- S $ECODE=""
- Q:$QUIT ""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXULMRPC 1775 printed Feb 18, 2025@23:36:27 Page 2
- XULMRPC ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;10/15/2012
- +1 ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
- +2 ;;Per VA Directive 6402, this routine should not be modified
- +3 ;
- +4 ; ******************************************************************
- +5 ; * *
- +6 ; * The Kernel Lock Manager is based on the VistA Lock Manager *
- +7 ; * developed by Tommy Martin. *
- +8 ; * *
- +9 ; ******************************************************************
- +10 ;
- +11 ;
- LOCKS(RETURN,LOCKS,RESULT,SCREEN) ; Compile lock table
- +1 ;
- +2 ;Inputs:
- +3 ; LOCKS - the global location to set the data, referenced by indirection
- +4 ; SCREEN = 1 if system locks should be screened out, 0 otherwise
- +5 ; RESULT - global location to store the result
- +6 ;Outputs:
- +7 ; @LOCKS will contain the locks obtained from the lock table
- +8 ; RETURN - return variable required for a RPC (doesn't seem to work)
- +9 ; @RESULT - global location where result is placed 1 if success, 0 otherwise
- +10 ;
- +11 DO GETLOCKS^XULMU(LOCKS)
- +12 if $LENGTH($GET(RESULT))
- SET @RESULT=1
- +13 SET RETURN=1
- +14 QUIT RETURN
- +15 ;
- +16 ;
- KILLPROC(RETURN,PID,RESULT) ;
- +1 ;Description:
- +2 ; Kills the process identified to OS by PID
- +3 ;Inputs:
- +4 ; PID -
- +5 ; RESULT - global location to store the result
- +6 ;Outputs:
- +7 ; RETURN - return variable required for a RPC (doesn't seem to work)
- +8 ; @RESULT - global location where result is placed - 1 if success, 0 otherwise
- +9 ;
- +10 Begin DoDot:1
- +11 NEW $ETRAP
- SET $ETRAP="G ERROR^XULMRPC"
- +12 SET RETURN=$$KILL^%ZLMLIB(PID)
- End DoDot:1
- +13 if $LENGTH($GET(RESULT))
- SET @RESULT=RETURN
- +14 IF RETURN
- DO CLEANUP^XULMU(PID)
- +15 QUIT RETURN
- +16 ;
- ERROR ;
- +1 SET $ETRAP="Q:$QUIT """" Q"
- +2 SET $ECODE=""
- +3 if $QUIT
- QUIT ""
- +4 QUIT