RORLOCK ;HCIOFO/SG - LOCKS AND TRANSACTIONS ;17 Mar 2015 11:45 AM
;;1.5;CLINICAL CASE REGISTRIES;**1,27**;Feb 17, 2006;Build 58
;
; This routine uses the following IAs:
; #2052 GET1^DID (supported)
; #2055 ROOT^DILFD (supported)
; #2056 GET1^DIQ (supported)
; #10103 FMTE^XLFDT (supported)
; #10103 NOW^XLFDT (supported)
;
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*27 FEB 2015 T KOPP Changed default lock time from 3 to
; DILOCKTM if DILOCKTM > 3
;******************************************************************************
Q
;
;***** FINDS THE LOCK DESCRIPTOR FOR THE GLOBAL NODE
LDSC(NODELIST) ;
N DESCR,IENS,L,NDX,NODE,RORMSG,SP,TMP
S:$D(NODELIST)<10 NODELIST(NODELIST)=""
S (DESCR,NODE)=""
F S NODE=$O(NODELIST(NODE)) Q:NODE="" D
. ;--- The Node itself
. S SP=$$XLNDX(NODE),TMP=$G(^XTMP("RORLOCK",SP))
. S:TMP>DESCR DESCR=TMP
. ;--- Left Siblings and Ancestors
. S NDX=SP
. F S NDX=$O(^XTMP("RORLOCK",NDX),-1),L=$L(NDX) Q:(NDX="")!(NDX'=$E(SP,1,L)) D
. . S TMP=$G(^XTMP("RORLOCK",NDX)) S:TMP>DESCR DESCR=TMP
. ;--- Right Siblings and Descendants
. S NDX=SP,L=$L(SP)
. F S NDX=$O(^XTMP("RORLOCK",NDX)) Q:(NDX="")!($E(NDX,1,L)'=SP) D
. . S TMP=$G(^XTMP("RORLOCK",NDX)) S:TMP>DESCR DESCR=TMP
;--- Prepare the lock descriptor
S:'DESCR $P(DESCR,U)=$$NOW^XLFDT
D:$P(DESCR,U,3)>0
. S IENS=+$P(DESCR,U,3)_","
. S $P(DESCR,U,2)=$$GET1^DIQ(200,IENS,.01,,,"RORMSG")
. D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,200,IENS)
S:$P(DESCR,U,2)="" $P(DESCR,U,2)="UNKNOWN USER"
Q $P(DESCR,U,1,5)
;
;***** LOCKS THE (SUB)FILE, RECORD OR FIELD NODE
;
; FILE File/subfile number
; [IENS] IENS of the record or subfile
; [FIELD] Field number
; [TO] Timeout (DILOCKTM sec, by default)
; [NAME] Process name
;
; Return Values:
; <0 Error code
; 0 Ok (the object has been locked)
; >0 The object is locked by another user. A lock descriptor
; is returned in this case:
; ^01: Date/Time (FileMan)
; ^02: User/Process name
; ^03: User IEN (DUZ)
; ^04: $JOB
; ^05: Task number
;
; If the third field is empty then the object is locked by a
; registry background process (see the name in the 2nd field).
;
LOCK(FILE,IENS,FIELD,TO,NAME) ;
N DESCR,NDX,NODELIST,NODE,PI,RC,TMP
I $D(FILE)<10 S RC=0 D:$G(FILE)>0 Q RC
. S RC=$$LOCK1(FILE,$G(IENS),$G(FIELD),$G(TO),$G(NAME))
;--- Compile the list of global nodes
S RC=$$NODELIST(.NODELIST,.FILE,$G(IENS),$G(FIELD))
Q:RC<0 RC Q:NODELIST="" 0
;--- Try to lock the object(s)
X "L +("_NODELIST_"):"_$S($G(TO)>0:TO,$G(DILOCKTM)>3:DILOCKTM,1:3) E Q $$LDSC(.NODELIST)
;--- Create the lock descriptor(s)
S DESCR=$$NOW^XLFDT_U_$G(NAME)_U_U_$JOB_U_$G(ZTSK)
S:$G(NAME)="" $P(DESCR,U,3)=$G(DUZ)
S NODE=""
F S NODE=$O(NODELIST(NODE)) Q:NODE="" D
. S NDX=$$XLNDX(NODE)
. ;--- Calculate the lock counter
. S TMP=$G(^XTMP("RORLOCK",NDX))
. S $P(DESCR,U,6)=$S($P(TMP,U,4)=$JOB:$P(TMP,U,6)+1,1:1)
. ;--- Store the descriptor
. S ^XTMP("RORLOCK",NDX)=DESCR
Q 0
;
LOCK1(FILE,IENS,FIELD,TO,NAME) ;
N DESCR,NDX,NODE,TMP,RORLTM
S NODE=$$NODE(FILE,$G(IENS),$G(FIELD)),RORLTM=$S($G(DILOCKTM)>3:DILOCKTM,1:3)
Q:NODE<0 NODE
;--- Try to lock the object
L +@NODE:$S($G(TO)>0:TO,1:RORLTM) E Q $$LDSC(NODE)
;--- Create the lock descriptor
S DESCR=$$NOW^XLFDT_U_$G(NAME)_U_U_$JOB_U_$G(ZTSK)
S:$G(NAME)="" $P(DESCR,U,3)=$G(DUZ)
;--- Calculate the lock counter
S NDX=$$XLNDX(NODE),TMP=$G(^XTMP("RORLOCK",NDX))
S $P(DESCR,U,6)=$S($P(TMP,U,4)=$JOB:$P(TMP,U,6)+1,1:1)
;--- Store the descriptor
S ^XTMP("RORLOCK",NDX)=DESCR
Q 0
;
;***** RETURNS THE GLOBAL NODE OF THE OBJECT
;
; FILE File/subfile number
; IENS IENS of the record or subfile
; FIELD Field number
;
; Return Values:
; <0 Error code
; Closed root
;
NODE(FILE,IENS,FIELD) ;
N FGL,IEN,NODE,RC
S IEN=+IENS S:IEN $P(IENS,",")=""
;--- Closed root of the (sub)file
S NODE=$$ROOT^DILFD(FILE,IENS,1)
I NODE="" D Q RC
. S RC=$$ERROR^RORERR(-98,,,,FILE,IENS)
Q:'IEN NODE
;--- The record node
S NODE=$NA(@NODE@(IEN))
Q:'FIELD NODE
;--- Field node
S FGL=$$GET1^DID(FILE,FIELD,,"GLOBAL SUBSCRIPT LOCATION",,"RORMSG")
I $G(DIERR) D Q RC
. S RC=$$DBS^RORERR("RORMSG",-9,,,FILE)
S:$P(FGL,";")'="" NODE=$NA(@NODE@($P(FGL,";")))
Q NODE
;
;***** COMPILES THE LIST OF GLOBAL NODES
NODELIST(NODELIST,FILE,IENS,FIELD) ;
N NODE,PI,RC K NODELIST
S NODELIST="",RC=0
;--- Main object
I $G(FILE)>0 D Q:RC<0 RC
. S NODE=$$NODE(FILE,IENS,FIELD)
. I NODE<0 S RC=+NODE Q
. S NODELIST=NODELIST_","_NODE
. S NODELIST(NODE)=""
;--- Linked objects
S PI="FILE"
F S PI=$Q(@PI) Q:PI="" D Q:RC<0
. S NODE=$$NODE($QS(PI,1),$QS(PI,2),$QS(PI,3))
. I NODE<0 S RC=+NODE Q
. S NODELIST=NODELIST_","_NODE
. S NODELIST(NODE)=""
Q:RC<0 RC
;---
S NODELIST=$P(NODELIST,",",2,999)
Q RC
;
;***** GENERATES A TEXT DESCRIPTION FROM THE LOCK DESCRIPTOR
;
; LDSC Lock descriptor returned by the $$LOCK^RORLOCK
;
TEXT(LDSC) ;
N LTEXT
S LTEXT=$P(LDSC,U,2)_" about "_$$FMTE^XLFDT(+LDSC)
S:$P(LDSC,U,4) LTEXT=LTEXT_"; Job #"_$P(LDSC,U,4)
S:$P(LDSC,U,5) LTEXT=LTEXT_"; Task #"_$P(LDSC,U,5)
Q LTEXT
;
;***** UNLOCKS THE (SUB)FILE, RECORD OR FIELD NODE
;
; FILE File/subfile number
; [IENS] IENS of the record or subfile
; [FIELD] Field number
;
; Return Values:
; <0 Error code
; 0 Ok
;
; NOTE: This entry point can also be called as a procedure:
; D UNLOCK^RORLOCK(...) if you do not need its return value.
;
UNLOCK(FILE,IENS,FIELD) ;
N DESCR,NDX,NODELIST,NODE,PI,RC
I $D(FILE)<10 S RC=0 D:$G(FILE)>0 Q:$QUIT RC Q
. S RC=$$UNLOCK1(FILE,$G(IENS),$G(FIELD))
;--- Compile the list of global nodes
S RC=$$NODELIST(.NODELIST,.FILE,$G(IENS),$G(FIELD))
I RC<0 Q:$QUIT RC Q
I NODELIST="" Q:$QUIT 0 Q
;--- Remove the lock descriptor(s)
S NODE=""
F S NODE=$O(NODELIST(NODE)) Q:NODE="" D
. S NDX=$$XLNDX(NODE),DESCR=$G(^XTMP("RORLOCK",NDX))
. Q:$P(DESCR,U,4)'=$JOB
. I $P(DESCR,U,6)>1 D
. . S $P(^XTMP("RORLOCK",NDX),U,6)=$P(DESCR,U,6)-1
. E K ^XTMP("RORLOCK",NDX)
;--- Unlock the object(s)
X "L -("_NODELIST_")"
Q:$QUIT 0 Q
;
UNLOCK1(FILE,IENS,FIELD) ;
N DESCR,NDX,NODE
S NODE=$$NODE(FILE,$G(IENS),$G(FIELD))
Q:NODE<0 NODE
;--- Remove the lock descriptor
S NDX=$$XLNDX(NODE),DESCR=$G(^XTMP("RORLOCK",NDX))
D:$P(DESCR,U,4)=$JOB
. I $P(DESCR,U,6)>1 D
. . S $P(^XTMP("RORLOCK",NDX),U,6)=$P(DESCR,U,6)-1
. E K ^XTMP("RORLOCK",NDX)
;--- Unlock the object
L -@NODE
Q 0
;
;***** RETURNS SUBSCRIPT OF THE NODE IN THE DESCRIPTOR TABLE
XLNDX(NODE) ;
N L S L=$L(NODE)
Q $S($E(NODE,L)=")":$E(NODE,1,L-1),1:NODE)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORLOCK 7272 printed Dec 13, 2024@01:42:11 Page 2
RORLOCK ;HCIOFO/SG - LOCKS AND TRANSACTIONS ;17 Mar 2015 11:45 AM
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,27**;Feb 17, 2006;Build 58
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2052 GET1^DID (supported)
+5 ; #2055 ROOT^DILFD (supported)
+6 ; #2056 GET1^DIQ (supported)
+7 ; #10103 FMTE^XLFDT (supported)
+8 ; #10103 NOW^XLFDT (supported)
+9 ;
+10 ;******************************************************************************
+11 ; --- ROUTINE MODIFICATION LOG ---
+12 ;
+13 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+14 ;----------- ---------- ----------- ----------------------------------------
+15 ;ROR*1.5*27 FEB 2015 T KOPP Changed default lock time from 3 to
+16 ; DILOCKTM if DILOCKTM > 3
+17 ;******************************************************************************
+18 QUIT
+19 ;
+20 ;***** FINDS THE LOCK DESCRIPTOR FOR THE GLOBAL NODE
LDSC(NODELIST) ;
+1 NEW DESCR,IENS,L,NDX,NODE,RORMSG,SP,TMP
+2 if $DATA(NODELIST)<10
SET NODELIST(NODELIST)=""
+3 SET (DESCR,NODE)=""
+4 FOR
SET NODE=$ORDER(NODELIST(NODE))
if NODE=""
QUIT
Begin DoDot:1
+5 ;--- The Node itself
+6 SET SP=$$XLNDX(NODE)
SET TMP=$GET(^XTMP("RORLOCK",SP))
+7 if TMP>DESCR
SET DESCR=TMP
+8 ;--- Left Siblings and Ancestors
+9 SET NDX=SP
+10 FOR
SET NDX=$ORDER(^XTMP("RORLOCK",NDX),-1)
SET L=$LENGTH(NDX)
if (NDX="")!(NDX'=$EXTRACT(SP,1,L))
QUIT
Begin DoDot:2
+11 SET TMP=$GET(^XTMP("RORLOCK",NDX))
if TMP>DESCR
SET DESCR=TMP
End DoDot:2
+12 ;--- Right Siblings and Descendants
+13 SET NDX=SP
SET L=$LENGTH(SP)
+14 FOR
SET NDX=$ORDER(^XTMP("RORLOCK",NDX))
if (NDX="")!($EXTRACT(NDX,1,L)'=SP)
QUIT
Begin DoDot:2
+15 SET TMP=$GET(^XTMP("RORLOCK",NDX))
if TMP>DESCR
SET DESCR=TMP
End DoDot:2
End DoDot:1
+16 ;--- Prepare the lock descriptor
+17 if 'DESCR
SET $PIECE(DESCR,U)=$$NOW^XLFDT
+18 if $PIECE(DESCR,U,3)>0
Begin DoDot:1
+19 SET IENS=+$PIECE(DESCR,U,3)_","
+20 SET $PIECE(DESCR,U,2)=$$GET1^DIQ(200,IENS,.01,,,"RORMSG")
+21 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,200,IENS)
End DoDot:1
+22 if $PIECE(DESCR,U,2)=""
SET $PIECE(DESCR,U,2)="UNKNOWN USER"
+23 QUIT $PIECE(DESCR,U,1,5)
+24 ;
+25 ;***** LOCKS THE (SUB)FILE, RECORD OR FIELD NODE
+26 ;
+27 ; FILE File/subfile number
+28 ; [IENS] IENS of the record or subfile
+29 ; [FIELD] Field number
+30 ; [TO] Timeout (DILOCKTM sec, by default)
+31 ; [NAME] Process name
+32 ;
+33 ; Return Values:
+34 ; <0 Error code
+35 ; 0 Ok (the object has been locked)
+36 ; >0 The object is locked by another user. A lock descriptor
+37 ; is returned in this case:
+38 ; ^01: Date/Time (FileMan)
+39 ; ^02: User/Process name
+40 ; ^03: User IEN (DUZ)
+41 ; ^04: $JOB
+42 ; ^05: Task number
+43 ;
+44 ; If the third field is empty then the object is locked by a
+45 ; registry background process (see the name in the 2nd field).
+46 ;
LOCK(FILE,IENS,FIELD,TO,NAME) ;
+1 NEW DESCR,NDX,NODELIST,NODE,PI,RC,TMP
+2 IF $DATA(FILE)<10
SET RC=0
if $GET(FILE)>0
Begin DoDot:1
+3 SET RC=$$LOCK1(FILE,$GET(IENS),$GET(FIELD),$GET(TO),$GET(NAME))
End DoDot:1
QUIT RC
+4 ;--- Compile the list of global nodes
+5 SET RC=$$NODELIST(.NODELIST,.FILE,$GET(IENS),$GET(FIELD))
+6 if RC<0
QUIT RC
if NODELIST=""
QUIT 0
+7 ;--- Try to lock the object(s)
+8 XECUTE "L +("_NODELIST_"):"_$SELECT($GET(TO)>0:TO,$GET(DILOCKTM)>3:DILOCKTM,1:3)
IF '$TEST
QUIT $$LDSC(.NODELIST)
+9 ;--- Create the lock descriptor(s)
+10 SET DESCR=$$NOW^XLFDT_U_$G(NAME)_U_U_$JOB_U_$GET(ZTSK)
+11 if $GET(NAME)=""
SET $PIECE(DESCR,U,3)=$GET(DUZ)
+12 SET NODE=""
+13 FOR
SET NODE=$ORDER(NODELIST(NODE))
if NODE=""
QUIT
Begin DoDot:1
+14 SET NDX=$$XLNDX(NODE)
+15 ;--- Calculate the lock counter
+16 SET TMP=$GET(^XTMP("RORLOCK",NDX))
+17 SET $PIECE(DESCR,U,6)=$SELECT($PIECE(TMP,U,4)=$JOB:$PIECE(TMP,U,6)+1,1:1)
+18 ;--- Store the descriptor
+19 SET ^XTMP("RORLOCK",NDX)=DESCR
End DoDot:1
+20 QUIT 0
+21 ;
LOCK1(FILE,IENS,FIELD,TO,NAME) ;
+1 NEW DESCR,NDX,NODE,TMP,RORLTM
+2 SET NODE=$$NODE(FILE,$GET(IENS),$GET(FIELD))
SET RORLTM=$SELECT($GET(DILOCKTM)>3:DILOCKTM,1:3)
+3 if NODE<0
QUIT NODE
+4 ;--- Try to lock the object
+5 LOCK +@NODE:$SELECT($GET(TO)>0:TO,1:RORLTM)
IF '$TEST
QUIT $$LDSC(NODE)
+6 ;--- Create the lock descriptor
+7 SET DESCR=$$NOW^XLFDT_U_$G(NAME)_U_U_$JOB_U_$GET(ZTSK)
+8 if $GET(NAME)=""
SET $PIECE(DESCR,U,3)=$GET(DUZ)
+9 ;--- Calculate the lock counter
+10 SET NDX=$$XLNDX(NODE)
SET TMP=$GET(^XTMP("RORLOCK",NDX))
+11 SET $PIECE(DESCR,U,6)=$SELECT($PIECE(TMP,U,4)=$JOB:$PIECE(TMP,U,6)+1,1:1)
+12 ;--- Store the descriptor
+13 SET ^XTMP("RORLOCK",NDX)=DESCR
+14 QUIT 0
+15 ;
+16 ;***** RETURNS THE GLOBAL NODE OF THE OBJECT
+17 ;
+18 ; FILE File/subfile number
+19 ; IENS IENS of the record or subfile
+20 ; FIELD Field number
+21 ;
+22 ; Return Values:
+23 ; <0 Error code
+24 ; Closed root
+25 ;
NODE(FILE,IENS,FIELD) ;
+1 NEW FGL,IEN,NODE,RC
+2 SET IEN=+IENS
if IEN
SET $PIECE(IENS,",")=""
+3 ;--- Closed root of the (sub)file
+4 SET NODE=$$ROOT^DILFD(FILE,IENS,1)
+5 IF NODE=""
Begin DoDot:1
+6 SET RC=$$ERROR^RORERR(-98,,,,FILE,IENS)
End DoDot:1
QUIT RC
+7 if 'IEN
QUIT NODE
+8 ;--- The record node
+9 SET NODE=$NAME(@NODE@(IEN))
+10 if 'FIELD
QUIT NODE
+11 ;--- Field node
+12 SET FGL=$$GET1^DID(FILE,FIELD,,"GLOBAL SUBSCRIPT LOCATION",,"RORMSG")
+13 IF $GET(DIERR)
Begin DoDot:1
+14 SET RC=$$DBS^RORERR("RORMSG",-9,,,FILE)
End DoDot:1
QUIT RC
+15 if $PIECE(FGL,";")'=""
SET NODE=$NAME(@NODE@($PIECE(FGL,";")))
+16 QUIT NODE
+17 ;
+18 ;***** COMPILES THE LIST OF GLOBAL NODES
NODELIST(NODELIST,FILE,IENS,FIELD) ;
+1 NEW NODE,PI,RC
KILL NODELIST
+2 SET NODELIST=""
SET RC=0
+3 ;--- Main object
+4 IF $GET(FILE)>0
Begin DoDot:1
+5 SET NODE=$$NODE(FILE,IENS,FIELD)
+6 IF NODE<0
SET RC=+NODE
QUIT
+7 SET NODELIST=NODELIST_","_NODE
+8 SET NODELIST(NODE)=""
End DoDot:1
if RC<0
QUIT RC
+9 ;--- Linked objects
+10 SET PI="FILE"
+11 FOR
SET PI=$QUERY(@PI)
if PI=""
QUIT
Begin DoDot:1
+12 SET NODE=$$NODE($QSUBSCRIPT(PI,1),$QSUBSCRIPT(PI,2),$QSUBSCRIPT(PI,3))
+13 IF NODE<0
SET RC=+NODE
QUIT
+14 SET NODELIST=NODELIST_","_NODE
+15 SET NODELIST(NODE)=""
End DoDot:1
if RC<0
QUIT
+16 if RC<0
QUIT RC
+17 ;---
+18 SET NODELIST=$PIECE(NODELIST,",",2,999)
+19 QUIT RC
+20 ;
+21 ;***** GENERATES A TEXT DESCRIPTION FROM THE LOCK DESCRIPTOR
+22 ;
+23 ; LDSC Lock descriptor returned by the $$LOCK^RORLOCK
+24 ;
TEXT(LDSC) ;
+1 NEW LTEXT
+2 SET LTEXT=$PIECE(LDSC,U,2)_" about "_$$FMTE^XLFDT(+LDSC)
+3 if $PIECE(LDSC,U,4)
SET LTEXT=LTEXT_"; Job #"_$PIECE(LDSC,U,4)
+4 if $PIECE(LDSC,U,5)
SET LTEXT=LTEXT_"; Task #"_$PIECE(LDSC,U,5)
+5 QUIT LTEXT
+6 ;
+7 ;***** UNLOCKS THE (SUB)FILE, RECORD OR FIELD NODE
+8 ;
+9 ; FILE File/subfile number
+10 ; [IENS] IENS of the record or subfile
+11 ; [FIELD] Field number
+12 ;
+13 ; Return Values:
+14 ; <0 Error code
+15 ; 0 Ok
+16 ;
+17 ; NOTE: This entry point can also be called as a procedure:
+18 ; D UNLOCK^RORLOCK(...) if you do not need its return value.
+19 ;
UNLOCK(FILE,IENS,FIELD) ;
+1 NEW DESCR,NDX,NODELIST,NODE,PI,RC
+2 IF $DATA(FILE)<10
SET RC=0
if $GET(FILE)>0
Begin DoDot:1
+3 SET RC=$$UNLOCK1(FILE,$GET(IENS),$GET(FIELD))
End DoDot:1
if $QUIT
QUIT RC
QUIT
+4 ;--- Compile the list of global nodes
+5 SET RC=$$NODELIST(.NODELIST,.FILE,$GET(IENS),$GET(FIELD))
+6 IF RC<0
if $QUIT
QUIT RC
QUIT
+7 IF NODELIST=""
if $QUIT
QUIT 0
QUIT
+8 ;--- Remove the lock descriptor(s)
+9 SET NODE=""
+10 FOR
SET NODE=$ORDER(NODELIST(NODE))
if NODE=""
QUIT
Begin DoDot:1
+11 SET NDX=$$XLNDX(NODE)
SET DESCR=$GET(^XTMP("RORLOCK",NDX))
+12 if $PIECE(DESCR,U,4)'=$JOB
QUIT
+13 IF $PIECE(DESCR,U,6)>1
Begin DoDot:2
+14 SET $PIECE(^XTMP("RORLOCK",NDX),U,6)=$PIECE(DESCR,U,6)-1
End DoDot:2
+15 IF '$TEST
KILL ^XTMP("RORLOCK",NDX)
End DoDot:1
+16 ;--- Unlock the object(s)
+17 XECUTE "L -("_NODELIST_")"
+18 if $QUIT
QUIT 0
QUIT
+19 ;
UNLOCK1(FILE,IENS,FIELD) ;
+1 NEW DESCR,NDX,NODE
+2 SET NODE=$$NODE(FILE,$GET(IENS),$GET(FIELD))
+3 if NODE<0
QUIT NODE
+4 ;--- Remove the lock descriptor
+5 SET NDX=$$XLNDX(NODE)
SET DESCR=$GET(^XTMP("RORLOCK",NDX))
+6 if $PIECE(DESCR,U,4)=$JOB
Begin DoDot:1
+7 IF $PIECE(DESCR,U,6)>1
Begin DoDot:2
+8 SET $PIECE(^XTMP("RORLOCK",NDX),U,6)=$PIECE(DESCR,U,6)-1
End DoDot:2
+9 IF '$TEST
KILL ^XTMP("RORLOCK",NDX)
End DoDot:1
+10 ;--- Unlock the object
+11 LOCK -@NODE
+12 QUIT 0
+13 ;
+14 ;***** RETURNS SUBSCRIPT OF THE NODE IN THE DESCRIPTOR TABLE
XLNDX(NODE) ;
+1 NEW L
SET L=$LENGTH(NODE)
+2 QUIT $SELECT($EXTRACT(NODE,L)=")":$EXTRACT(NODE,1,L-1),1:NODE)
