XULMOUT ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;08/28/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. *
; * *
; ******************************************************************
;
OUTPUT1 ; Lock Dictionary
N LOCK,IEN,DATA,LINE,RLINE
S IEN=0
F S IEN=$O(^XLM(8993,IEN)) Q:'IEN D
.N NODE1
.S LOCK=$NA(^XLM(8993,IEN))
.S DATA=$G(@LOCK@(0))
.Q:DATA=""
.S NODE1=$G(@LOCK@(1))
.I $P(NODE1,"^",2) S DATA="^"_DATA
.D W(";;LOCK;"_DATA)
.S DATA=$P($G(NODE1),"^",1)
.I DATA S DATA=$P($G(^DIC(9.4,DATA,0)),"^")
.I $L(DATA) D W(";;PACKAGE;"_DATA)
.;
.S DATA=$P($G(NODE1),"^",3)
.I $L(DATA) D W(";;PARTIAL MATCH OK?;"_DATA)
.;
.;description of lock
.D W(";;USAGE;"_$G(@LOCK@(4,0)))
.S LINE=0 F S LINE=$O(@LOCK@(4,LINE)) Q:'LINE D W(";;;"_$G(@LOCK@(4,LINE,0)))
.;
.;subscripts in lock expression
.S LINE=0 F S LINE=$O(@LOCK@(2,LINE)) Q:'LINE D
..D W(";;SUBSCRIPT;"_$G(@LOCK@(2,LINE,0))) D:$D(@LOCK@(2,LINE,1)) W(";;CHECK LOGIC;"_$G(@LOCK@(2,LINE,1)))
.;
.;file references
.S LINE=0 F S LINE=$O(@LOCK@(3,LINE)) Q:'LINE D
..D W(";;FILE REFERENCE;"_$G(@LOCK@(3,LINE,0))),W(";;L;"_$G(@LOCK@(3,LINE,1)))
..;
..N LINE2
..D W(";;REFERENCE DESCRIPTION;"_$G(@LOCK@(3,LINE,2,0)))
..S LINE2=0 F S LINE2=$O(@LOCK@(3,LINE,2,LINE2)) Q:'LINE2 D W(";;;"_$G(@LOCK@(3,LINE,2,LINE2,0)))
D W(";;EXIT")
Q
;
OUTPUT2 ;system locks for parameter file
N GLB,TEXT,RLINE
S GLB=$NA(^XLM(8993.1,"AC"))
S TEXT=""
F S TEXT=$O(@GLB@(TEXT)) Q:TEXT="" D W(";;"_TEXT)
Q
;
;
;
;
;
;
W(LINE) ;
I '$G(RLINE) D
.K ^TMP($J,"RTN")
.S RLINE=0
S RLINE=RLINE+1
S ^TMP($J,"RTN",RLINE)=" "_LINE
Q
;
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXULMOUT 2100 printed Oct 16, 2024@18:10:46 Page 2
XULMOUT ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;08/28/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 ;
OUTPUT1 ; Lock Dictionary
+1 NEW LOCK,IEN,DATA,LINE,RLINE
+2 SET IEN=0
+3 FOR
SET IEN=$ORDER(^XLM(8993,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 NEW NODE1
+5 SET LOCK=$NAME(^XLM(8993,IEN))
+6 SET DATA=$GET(@LOCK@(0))
+7 if DATA=""
QUIT
+8 SET NODE1=$GET(@LOCK@(1))
+9 IF $PIECE(NODE1,"^",2)
SET DATA="^"_DATA
+10 DO W(";;LOCK;"_DATA)
+11 SET DATA=$PIECE($GET(NODE1),"^",1)
+12 IF DATA
SET DATA=$PIECE($GET(^DIC(9.4,DATA,0)),"^")
+13 IF $LENGTH(DATA)
DO W(";;PACKAGE;"_DATA)
+14 ;
+15 SET DATA=$PIECE($GET(NODE1),"^",3)
+16 IF $LENGTH(DATA)
DO W(";;PARTIAL MATCH OK?;"_DATA)
+17 ;
+18 ;description of lock
+19 DO W(";;USAGE;"_$GET(@LOCK@(4,0)))
+20 SET LINE=0
FOR
SET LINE=$ORDER(@LOCK@(4,LINE))
if 'LINE
QUIT
DO W(";;;"_$GET(@LOCK@(4,LINE,0)))
+21 ;
+22 ;subscripts in lock expression
+23 SET LINE=0
FOR
SET LINE=$ORDER(@LOCK@(2,LINE))
if 'LINE
QUIT
Begin DoDot:2
+24 DO W(";;SUBSCRIPT;"_$GET(@LOCK@(2,LINE,0)))
if $DATA(@LOCK@(2,LINE,1))
DO W(";;CHECK LOGIC;"_$GET(@LOCK@(2,LINE,1)))
End DoDot:2
+25 ;
+26 ;file references
+27 SET LINE=0
FOR
SET LINE=$ORDER(@LOCK@(3,LINE))
if 'LINE
QUIT
Begin DoDot:2
+28 DO W(";;FILE REFERENCE;"_$GET(@LOCK@(3,LINE,0)))
DO W(";;L;"_$GET(@LOCK@(3,LINE,1)))
+29 ;
+30 NEW LINE2
+31 DO W(";;REFERENCE DESCRIPTION;"_$GET(@LOCK@(3,LINE,2,0)))
+32 SET LINE2=0
FOR
SET LINE2=$ORDER(@LOCK@(3,LINE,2,LINE2))
if 'LINE2
QUIT
DO W(";;;"_$GET(@LOCK@(3,LINE,2,LINE2,0)))
End DoDot:2
End DoDot:1
+33 DO W(";;EXIT")
+34 QUIT
+35 ;
OUTPUT2 ;system locks for parameter file
+1 NEW GLB,TEXT,RLINE
+2 SET GLB=$NAME(^XLM(8993.1,"AC"))
+3 SET TEXT=""
+4 FOR
SET TEXT=$ORDER(@GLB@(TEXT))
if TEXT=""
QUIT
DO W(";;"_TEXT)
+5 QUIT
+6 ;
+7 ;
+8 ;
+9 ;
+10 ;
+11 ;
W(LINE) ;
+1 IF '$GET(RLINE)
Begin DoDot:1
+2 KILL ^TMP($JOB,"RTN")
+3 SET RLINE=0
End DoDot:1
+4 SET RLINE=RLINE+1
+5 SET ^TMP($JOB,"RTN",RLINE)=" "_LINE
+6 QUIT
+7 ;
+8 ;
+9 ;
