XU8P608 ;IRMFO-ALB/CJM - Kernel Lock Manager ;11/28/2012
;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
;;
;
; ******************************************************************
; * *
; * The Kernel Lock Manager is based on the VistA Lock Manager *
; * developed by Tommy Martin. *
; * *
; ******************************************************************
;
POST ;
;D PATCH^ZTMGRSET(608)
D INPUT2
Q
INPUT1 ;
;Not needed - replaced by patch xu*8.0*607
N LINE,OFFSET,LOCKIEN,SUBIEN,RTN
S RTN="XU8P608A"
S OFFSET=1
F S LINE=$T(LOCKS+OFFSET^@RTN) Q:'$L(LINE) Q:$P(LINE,";;",2)="EXIT" S OFFSET=OFFSET+1 D
.I $P(LINE,";",3)="LOCK" S LOCKIEN=$$LOCK($P(LINE,";",4,99)) Q:LOCKIEN I 'LOCKIEN D BMES^XPDUTL("Failed to create an entry in the XULM LOCK DICTIONARY file for "_$P(LINE,";",4,99)) Q
.Q:'LOCKIEN
.I $P(LINE,";",3)="PACKAGE" D Q
..N PACKAGE,DATA
..S PACKAGE=$P(LINE,";",4)
..S PACKAGE=$O(^DIC(9.4,"B",PACKAGE,0))
..I PACKAGE S DATA(1.01)=PACKAGE D UPD^XULMU(8993,LOCKIEN,.DATA)
.I $P(LINE,";",3)="PARTIAL MATCH OK?" D Q
..N DATA
..S DATA(1.03)=$P(LINE,";",4)
..D UPD^XULMU(8993,LOCKIEN,.DATA)
.I $P(LINE,";",3)="USAGE" D Q
..S ^XLM(8993,LOCKIEN,4,0)=$P(LINE,";",4,99)
..N CNT S CNT=0
..F S LINE=$T(LOCKS+OFFSET^@RTN) Q:$E(LINE,2,4)'=";;;" D
...S OFFSET=OFFSET+1
...S LINE=$P(LINE,";;;",2,99)
...S CNT=CNT+1
...S ^XLM(8993,LOCKIEN,4,CNT,0)=LINE
.I $P(LINE,";",3)="SUBSCRIPT" D Q
..N DA,DATA
..S LINE=$P(LINE,";",4,99)
..S DATA(.01)=$P(LINE,"^")
..S DATA(.02)=$P(LINE,"^",2)
..S DATA(.04)=$P(LINE,"^",4)
..S DA(1)=LOCKIEN
..S SUBIEN=$$ADD^XULMU(8993.02,.DA,.DATA)
.I $P(LINE,";",3)="CHECK LOGIC" D
..S:LOCKIEN&SUBIEN ^XLM(8993,LOCKIEN,2,SUBIEN,1)=$P(LINE,";",4,99)
.I $P(LINE,";",3)="FILE REFERENCE" D Q
..N DA,DATA
..S DATA(.01)=$P(LINE,";",4)
..S DA(1)=LOCKIEN
..S SUBIEN=$$ADD^XULMU(8993.03,.DA,.DATA)
.I $P(LINE,";",3)="L" D
..N CODE,X
..S (CODE,X)=$P(LINE,";",4,99)
..D:$L(X) ^DIM
..I '$D(X) D BMES^XPDUTL("Failed syntax check:"),BMES^XPDUTL(CODE) Q
..S:LOCKIEN&SUBIEN ^XLM(8993,LOCKIEN,3,SUBIEN,1)=$G(X)
.I $P(LINE,";",3)="REFERENCE DESCRIPTION" D Q
..S:SUBIEN&LOCKIEN ^XLM(8993,LOCKIEN,3,SUBIEN,2,0)=$P(LINE,";",4,99)
..N CNT S CNT=0
..F S LINE=$T(LOCKS+OFFSET^@RTN) Q:$E(LINE,2,4)'=";;;" D
...S OFFSET=OFFSET+1
...S LINE=$P(LINE,";;;",2,99)
...S CNT=CNT+1
...S:LOCKIEN&SUBIEN ^XLM(8993,LOCKIEN,3,SUBIEN,2,CNT,0)=LINE
Q
LOCK(LOCK) ;Deletes the old entry and adds a new one.
N DATA,DA,QUIT,ERROR
S QUIT=0
S DATA(.01)=$P(LOCK,"^",2,99)
S DATA(1.02)=$S($E(LOCK)="^":1,1:0)
S DA=$O(^XLM(8993,"E",DATA(1.02),DATA(.01),0))
I DA D DELETE^XULMU(8993,DA)
Q $$ADD^XULMU(8993,,.DATA,.ERROR)
;
K DATA
F S LINE=$T(LOCKS+OFFSET^@RTN),OFFSET=OFFSET+1 D Q:QUIT
.N DATA
.I $P(LINE,";",3)="SUBSCRIPT" D Q
..N PARENT S PARENT=DA N DA
..S LINE=$P(LINE,";",4,99)
..S DATA(.01)=$P(LINE,"^")
..S DATA(.02)=$P(LINE,"^",2)
..S DATA(.04)=$P(LINE,"^",4)
..S DA(1)=PARENT
..S DA=$$ADD^XULMU(8993.02,.DA,.DATA)
..S LINE=$T(LOCKS+OFFSET^@RTN)
.S OFFSET=OFFSET-1,QUIT=1
Q
;
INPUT2 ;Add system lock list to parameters
N IEN,LOCK,RTN,OFFSET,TEXT,EXIT,SITE
S EXIT=0
S IEN=$O(^XLM(8993.1,0))
I 'IEN D
.N DATA
.S SITE=+$$SITE^VASITE
.I SITE<1 S SITE=$O(^XTV(8989.3,0)) I SITE S SITE=$P($G(^XTV(8989.3,SITE,"XUS")),"^",17)
.I 'SITE S SITE="NOT YET ENTERED"
.S DATA(.01)=SITE
.S IEN=$$ADD^XULMU(8993.1,,.DATA)
S RTN="XU8P608B"
S OFFSET=1
F S TEXT=$T(LOCKS+OFFSET^@RTN) Q:'$L(TEXT) Q:EXIT D
.S LOCK=$P(TEXT,";;",2,99)
.I LOCK="" S EXIT=1 Q
.I LOCK="EXIT" S EXIT=1 Q
.S OFFSET=OFFSET+1
.Q:$D(^XLM(8993.1,"AC",LOCK))
.N DATA,DA
.S DA(1)=IEN
.I $E(LOCK,1)="^" D
..S DATA(.01)=$P($P(LOCK,"^",2,99),"(")
..S DATA(.02)=$P(LOCK,"^",2,99)
..S DATA(.03)=1
.E D
..S DATA(.01)=$P(LOCK,"(")
..S DATA(.02)=LOCK
..S DATA(.03)=0
.D ADD^XULMU(8993.15,.DA,.DATA)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P608 4155 printed Sep 23, 2025@19:44:30 Page 2
XU8P608 ;IRMFO-ALB/CJM - Kernel Lock Manager ;11/28/2012
+1 ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
+2 ;;
+3 ;
+4 ; ******************************************************************
+5 ; * *
+6 ; * The Kernel Lock Manager is based on the VistA Lock Manager *
+7 ; * developed by Tommy Martin. *
+8 ; * *
+9 ; ******************************************************************
+10 ;
POST ;
+1 ;D PATCH^ZTMGRSET(608)
+2 DO INPUT2
+3 QUIT
INPUT1 ;
+1 ;Not needed - replaced by patch xu*8.0*607
+2 NEW LINE,OFFSET,LOCKIEN,SUBIEN,RTN
+3 SET RTN="XU8P608A"
+4 SET OFFSET=1
+5 FOR
SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
if '$LENGTH(LINE)
QUIT
if $PIECE(LINE,";;",2)="EXIT"
QUIT
SET OFFSET=OFFSET+1
Begin DoDot:1
+6 IF $PIECE(LINE,";",3)="LOCK"
SET LOCKIEN=$$LOCK($PIECE(LINE,";",4,99))
if LOCKIEN
QUIT
IF 'LOCKIEN
DO BMES^XPDUTL("Failed to create an entry in the XULM LOCK DICTIONARY file for "_$PIECE(LINE,";",4,99))
QUIT
+7 if 'LOCKIEN
QUIT
+8 IF $PIECE(LINE,";",3)="PACKAGE"
Begin DoDot:2
+9 NEW PACKAGE,DATA
+10 SET PACKAGE=$PIECE(LINE,";",4)
+11 SET PACKAGE=$ORDER(^DIC(9.4,"B",PACKAGE,0))
+12 IF PACKAGE
SET DATA(1.01)=PACKAGE
DO UPD^XULMU(8993,LOCKIEN,.DATA)
End DoDot:2
QUIT
+13 IF $PIECE(LINE,";",3)="PARTIAL MATCH OK?"
Begin DoDot:2
+14 NEW DATA
+15 SET DATA(1.03)=$PIECE(LINE,";",4)
+16 DO UPD^XULMU(8993,LOCKIEN,.DATA)
End DoDot:2
QUIT
+17 IF $PIECE(LINE,";",3)="USAGE"
Begin DoDot:2
+18 SET ^XLM(8993,LOCKIEN,4,0)=$PIECE(LINE,";",4,99)
+19 NEW CNT
SET CNT=0
+20 FOR
SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
if $EXTRACT(LINE,2,4)'=";;;"
QUIT
Begin DoDot:3
+21 SET OFFSET=OFFSET+1
+22 SET LINE=$PIECE(LINE,";;;",2,99)
+23 SET CNT=CNT+1
+24 SET ^XLM(8993,LOCKIEN,4,CNT,0)=LINE
End DoDot:3
End DoDot:2
QUIT
+25 IF $PIECE(LINE,";",3)="SUBSCRIPT"
Begin DoDot:2
+26 NEW DA,DATA
+27 SET LINE=$PIECE(LINE,";",4,99)
+28 SET DATA(.01)=$PIECE(LINE,"^")
+29 SET DATA(.02)=$PIECE(LINE,"^",2)
+30 SET DATA(.04)=$PIECE(LINE,"^",4)
+31 SET DA(1)=LOCKIEN
+32 SET SUBIEN=$$ADD^XULMU(8993.02,.DA,.DATA)
End DoDot:2
QUIT
+33 IF $PIECE(LINE,";",3)="CHECK LOGIC"
Begin DoDot:2
+34 if LOCKIEN&SUBIEN
SET ^XLM(8993,LOCKIEN,2,SUBIEN,1)=$PIECE(LINE,";",4,99)
End DoDot:2
+35 IF $PIECE(LINE,";",3)="FILE REFERENCE"
Begin DoDot:2
+36 NEW DA,DATA
+37 SET DATA(.01)=$PIECE(LINE,";",4)
+38 SET DA(1)=LOCKIEN
+39 SET SUBIEN=$$ADD^XULMU(8993.03,.DA,.DATA)
End DoDot:2
QUIT
+40 IF $PIECE(LINE,";",3)="L"
Begin DoDot:2
+41 NEW CODE,X
+42 SET (CODE,X)=$PIECE(LINE,";",4,99)
+43 if $LENGTH(X)
DO ^DIM
+44 IF '$DATA(X)
DO BMES^XPDUTL("Failed syntax check:")
DO BMES^XPDUTL(CODE)
QUIT
+45 if LOCKIEN&SUBIEN
SET ^XLM(8993,LOCKIEN,3,SUBIEN,1)=$GET(X)
End DoDot:2
+46 IF $PIECE(LINE,";",3)="REFERENCE DESCRIPTION"
Begin DoDot:2
+47 if SUBIEN&LOCKIEN
SET ^XLM(8993,LOCKIEN,3,SUBIEN,2,0)=$PIECE(LINE,";",4,99)
+48 NEW CNT
SET CNT=0
+49 FOR
SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
if $EXTRACT(LINE,2,4)'=";;;"
QUIT
Begin DoDot:3
+50 SET OFFSET=OFFSET+1
+51 SET LINE=$PIECE(LINE,";;;",2,99)
+52 SET CNT=CNT+1
+53 if LOCKIEN&SUBIEN
SET ^XLM(8993,LOCKIEN,3,SUBIEN,2,CNT,0)=LINE
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+54 QUIT
LOCK(LOCK) ;Deletes the old entry and adds a new one.
+1 NEW DATA,DA,QUIT,ERROR
+2 SET QUIT=0
+3 SET DATA(.01)=$PIECE(LOCK,"^",2,99)
+4 SET DATA(1.02)=$SELECT($EXTRACT(LOCK)="^":1,1:0)
+5 SET DA=$ORDER(^XLM(8993,"E",DATA(1.02),DATA(.01),0))
+6 IF DA
DO DELETE^XULMU(8993,DA)
+7 QUIT $$ADD^XULMU(8993,,.DATA,.ERROR)
+8 ;
+9 KILL DATA
+10 FOR
SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
SET OFFSET=OFFSET+1
Begin DoDot:1
+11 NEW DATA
+12 IF $PIECE(LINE,";",3)="SUBSCRIPT"
Begin DoDot:2
+13 NEW PARENT
SET PARENT=DA
NEW DA
+14 SET LINE=$PIECE(LINE,";",4,99)
+15 SET DATA(.01)=$PIECE(LINE,"^")
+16 SET DATA(.02)=$PIECE(LINE,"^",2)
+17 SET DATA(.04)=$PIECE(LINE,"^",4)
+18 SET DA(1)=PARENT
+19 SET DA=$$ADD^XULMU(8993.02,.DA,.DATA)
+20 SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
End DoDot:2
QUIT
+21 SET OFFSET=OFFSET-1
SET QUIT=1
End DoDot:1
if QUIT
QUIT
+22 QUIT
+23 ;
INPUT2 ;Add system lock list to parameters
+1 NEW IEN,LOCK,RTN,OFFSET,TEXT,EXIT,SITE
+2 SET EXIT=0
+3 SET IEN=$ORDER(^XLM(8993.1,0))
+4 IF 'IEN
Begin DoDot:1
+5 NEW DATA
+6 SET SITE=+$$SITE^VASITE
+7 IF SITE<1
SET SITE=$ORDER(^XTV(8989.3,0))
IF SITE
SET SITE=$PIECE($GET(^XTV(8989.3,SITE,"XUS")),"^",17)
+8 IF 'SITE
SET SITE="NOT YET ENTERED"
+9 SET DATA(.01)=SITE
+10 SET IEN=$$ADD^XULMU(8993.1,,.DATA)
End DoDot:1
+11 SET RTN="XU8P608B"
+12 SET OFFSET=1
+13 FOR
SET TEXT=$TEXT(LOCKS+OFFSET^@RTN)
if '$LENGTH(TEXT)
QUIT
if EXIT
QUIT
Begin DoDot:1
+14 SET LOCK=$PIECE(TEXT,";;",2,99)
+15 IF LOCK=""
SET EXIT=1
QUIT
+16 IF LOCK="EXIT"
SET EXIT=1
QUIT
+17 SET OFFSET=OFFSET+1
+18 if $DATA(^XLM(8993.1,"AC",LOCK))
QUIT
+19 NEW DATA,DA
+20 SET DA(1)=IEN
+21 IF $EXTRACT(LOCK,1)="^"
Begin DoDot:2
+22 SET DATA(.01)=$PIECE($PIECE(LOCK,"^",2,99),"(")
+23 SET DATA(.02)=$PIECE(LOCK,"^",2,99)
+24 SET DATA(.03)=1
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 SET DATA(.01)=$PIECE(LOCK,"(")
+27 SET DATA(.02)=LOCK
+28 SET DATA(.03)=0
End DoDot:2
+29 DO ADD^XULMU(8993.15,.DA,.DATA)
End DoDot:1
+30 ;
+31 QUIT
+32 ;
