MAGUTL07 ;WOIFO/SG - FILE/RECORD/FIELD LOCK ; 3/9/09 12:53pm
;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
; Entry points of this routine use the ^XTMP("MAGLOCK",...) global
; nodes to store lock descriptors:
;
; ^XTMP("MAGLOCK",
; 0) Standard node descriptor
; ^1: Purge date (FileMan)
; ^2: Create date (FileMan)
; ^3: Description
;
; NodeNdx) Internal lock descriptor
; ^01: Date/Time (FileMan)
; ^02: User/Process name
; ^03: User IEN (DUZ)
; ^04: $JOB
; ^05: Task number
; ^06: Lock counter
;
; The NodeNdx is calculated by the $$XLNDX^MAGUTL08 as the name
; reference to the locked node without the closing parenthesis.
;
; This routine uses the following ICRs:
;
; #2054 Get value of the DILOCKTM variable
;
Q
;
;##### LOCKS THE (SUB)FILE, RECORD OR FIELD NODE
;
; [.]FILE File/subfile number
; [IENS] IENS of the record or subfile
; [FIELD] Field number
;
; If just the FILE has a value, then the whole file is
; locked. If the FILE references a subfile, then the
; subfile IENS (the 1st ","-piece is empty) should be
; passed in the IENS parameter.
;
; If the IENS references a record of a file/subfile
; (the 1st ","-piece is not empty), then this record
; is locked.
;
; If the IENS references a record and the FIELD is
; also defined, then only the node that stores this
; field is locked.
;
; In addition (or instead) to the main locked object
; defined by the FILE, IENS, and FIELD, you can define
; several additional objects using subscripts of the
; FILE parameter:
;
; ;--- Lock the whole file #2005
; S FILE(2005)=""
; ;--- Lock the OBJECT GROUP multiple (4)
; S FILE(2005.04,",398,")=""
; ;--- Lock 2 images
; S FILE(2005,"454,")=""
; S FILE(2005,"455,")=""
; ;--- Lock just the node "40" of the image entry
; S FILE(2005,"123,",42)=""
; ;--- Lock the objects
; S RC=$$LOCKFM^MAGUTL07(.FILE)
;
; All these objects are locked at the same time. If
; even one of them cannot be locked, then nothing
; is locked.
;
; [TO] Timeout (value of DILOCKTM, by default)
;
; [NAME] Process name. If this parameter is defined and not
; empty, then its value will be returned in the lock
; descriptor instead of the user name.
;
; [FLAGS] Flags that control the execution (can be combined):
;
; D Do not actually lock the node(s); just create
; the lock descriptor(s).
;
; Input Variables
; ===============
; MAGJOB("XTMPLOCK")
;
; Output Variables
; ================
; MAGJOB("XTMPLOCK")
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Ok (the objects have been locked)
; >0 The object is locked by another user or task and
; a lock descriptor is returned.
; ^01: Date/Time (FileMan)
; ^02: User/Process name
; ^03: User IEN (DUZ). If this piece is empty, then
; check the 2nd piece for custom process name.
; ^04: $JOB
; ^05: Task number
;
LOCKFM(FILE,IENS,FIELD,TO,NAME,FLAGS) ;
N DESCR,NDX,NODELIST,NODE,PI,RC,TMP
S:$G(TO,-1)<0 TO=$G(DILOCKTM,3)
S FLAGS=$G(FLAGS)
;
;=== Update the ^XTMP("MAGLOCK",0) once per session
I '$D(MAGJOB("XTMPLOCK")) D S MAGJOB("XTMPLOCK")=""
. D XTMPHDR^MAGUTL05("MAGLOCK",30,"Imaging LOCK Descriptors")
. Q
;
;=== Check if a single object should be locked
I $D(FILE)<10 S RC=0 D:$G(FILE)>0 Q RC
. S RC=$$LOCK1^MAGUTL08(FILE,$G(IENS),$G(FIELD),TO,$G(NAME),FLAGS)
. Q
;
;=== Compile the list of global nodes
S RC=$$NODELIST^MAGUTL08(.NODELIST,.FILE,$G(IENS),$G(FIELD))
Q:RC<0 RC Q:NODELIST="" 0
;
;=== Try to lock the object(s)
I FLAGS'["D" D X TMP E Q $$LDSC^MAGUTL08(.NODELIST)
. S TMP="L +("_NODELIST_"):"_TO
. Q
;
;=== 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^MAGUTL08(NODE)
. ;--- Calculate the lock counter
. S TMP=$G(^XTMP("MAGLOCK",NDX))
. S $P(DESCR,U,6)=$S($P(TMP,U,4)=$JOB:$P(TMP,U,6)+1,1:1)
. ;--- Store the descriptor
. S ^XTMP("MAGLOCK",NDX)=DESCR
. Q
;===
Q 0
;
;##### GENERATES A TEXT DESCRIPTION FROM THE LOCK DESCRIPTOR
;
; LDSC Lock descriptor returned by the $$LOCKFM^MAGUTL07
;
; Return Values:
; "" If the 1st "^"-piece of the LDSC is not greater than 0,
; then an empty string is returned.
; ... Otherwise, a text describing who/what and when
; locked the object according to the descriptor
;
TEXT(LDSC) ;
Q:LDSC'>0 ""
N TEXT,TMP
S TEXT="Locked by "_$P(LDSC,U,2)_" about "_$$FMTE^XLFDT(+LDSC)
S TEXT=TEXT_"; Job #"_$P(LDSC,U,4)
S TMP=$P(LDSC,U,5) S:TMP'="" TEXT=TEXT_"; Task #"_TMP
Q TEXT
;
;##### UNLOCKS THE (SUB)FILE, RECORD OR FIELD NODE
;
; [.]FILE File/subfile number
; [IENS] IENS of the record or subfile
; [FIELD] Field number
;
; See description of the LOCKFM^MAGUTL07 for details
; about the FILE, IENS, and FIELD parameters.
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Ok
;
; Notes
; =====
;
; This entry point can also be called as a procedure:
; D UNLOCKFM^MAGUTL07(...) if you do not need its return value.
;
UNLOCKFM(FILE,IENS,FIELD) ;
N DESCR,NDX,NODELIST,NODE,PI,RC
;
;=== Check if a single object should be unlocked
I $D(FILE)<10 S RC=0 D:$G(FILE)>0 Q:$QUIT RC Q
. S RC=$$UNLOCK1^MAGUTL08(FILE,$G(IENS),$G(FIELD))
. Q
;
;=== Compile the list of global nodes
S RC=$$NODELIST^MAGUTL08(.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^MAGUTL08(NODE),DESCR=$G(^XTMP("MAGLOCK",NDX))
. Q:$P(DESCR,U,4)'=$JOB
. I $P(DESCR,U,6)>1 D
. . S $P(^XTMP("MAGLOCK",NDX),U,6)=$P(DESCR,U,6)-1
. . Q
. E K ^XTMP("MAGLOCK",NDX)
. Q
;
;=== Unlock the object(s)
X "L -("_NODELIST_")"
Q:$QUIT 0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUTL07 8152 printed Sep 23, 2025@19:45:26 Page 2
MAGUTL07 ;WOIFO/SG - FILE/RECORD/FIELD LOCK ; 3/9/09 12:53pm
+1 ;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 ; Entry points of this routine use the ^XTMP("MAGLOCK",...) global
+19 ; nodes to store lock descriptors:
+20 ;
+21 ; ^XTMP("MAGLOCK",
+22 ; 0) Standard node descriptor
+23 ; ^1: Purge date (FileMan)
+24 ; ^2: Create date (FileMan)
+25 ; ^3: Description
+26 ;
+27 ; NodeNdx) Internal lock descriptor
+28 ; ^01: Date/Time (FileMan)
+29 ; ^02: User/Process name
+30 ; ^03: User IEN (DUZ)
+31 ; ^04: $JOB
+32 ; ^05: Task number
+33 ; ^06: Lock counter
+34 ;
+35 ; The NodeNdx is calculated by the $$XLNDX^MAGUTL08 as the name
+36 ; reference to the locked node without the closing parenthesis.
+37 ;
+38 ; This routine uses the following ICRs:
+39 ;
+40 ; #2054 Get value of the DILOCKTM variable
+41 ;
+42 QUIT
+43 ;
+44 ;##### LOCKS THE (SUB)FILE, RECORD OR FIELD NODE
+45 ;
+46 ; [.]FILE File/subfile number
+47 ; [IENS] IENS of the record or subfile
+48 ; [FIELD] Field number
+49 ;
+50 ; If just the FILE has a value, then the whole file is
+51 ; locked. If the FILE references a subfile, then the
+52 ; subfile IENS (the 1st ","-piece is empty) should be
+53 ; passed in the IENS parameter.
+54 ;
+55 ; If the IENS references a record of a file/subfile
+56 ; (the 1st ","-piece is not empty), then this record
+57 ; is locked.
+58 ;
+59 ; If the IENS references a record and the FIELD is
+60 ; also defined, then only the node that stores this
+61 ; field is locked.
+62 ;
+63 ; In addition (or instead) to the main locked object
+64 ; defined by the FILE, IENS, and FIELD, you can define
+65 ; several additional objects using subscripts of the
+66 ; FILE parameter:
+67 ;
+68 ; ;--- Lock the whole file #2005
+69 ; S FILE(2005)=""
+70 ; ;--- Lock the OBJECT GROUP multiple (4)
+71 ; S FILE(2005.04,",398,")=""
+72 ; ;--- Lock 2 images
+73 ; S FILE(2005,"454,")=""
+74 ; S FILE(2005,"455,")=""
+75 ; ;--- Lock just the node "40" of the image entry
+76 ; S FILE(2005,"123,",42)=""
+77 ; ;--- Lock the objects
+78 ; S RC=$$LOCKFM^MAGUTL07(.FILE)
+79 ;
+80 ; All these objects are locked at the same time. If
+81 ; even one of them cannot be locked, then nothing
+82 ; is locked.
+83 ;
+84 ; [TO] Timeout (value of DILOCKTM, by default)
+85 ;
+86 ; [NAME] Process name. If this parameter is defined and not
+87 ; empty, then its value will be returned in the lock
+88 ; descriptor instead of the user name.
+89 ;
+90 ; [FLAGS] Flags that control the execution (can be combined):
+91 ;
+92 ; D Do not actually lock the node(s); just create
+93 ; the lock descriptor(s).
+94 ;
+95 ; Input Variables
+96 ; ===============
+97 ; MAGJOB("XTMPLOCK")
+98 ;
+99 ; Output Variables
+100 ; ================
+101 ; MAGJOB("XTMPLOCK")
+102 ;
+103 ; Return Values
+104 ; =============
+105 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+106 ; 0 Ok (the objects have been locked)
+107 ; >0 The object is locked by another user or task and
+108 ; a lock descriptor is returned.
+109 ; ^01: Date/Time (FileMan)
+110 ; ^02: User/Process name
+111 ; ^03: User IEN (DUZ). If this piece is empty, then
+112 ; check the 2nd piece for custom process name.
+113 ; ^04: $JOB
+114 ; ^05: Task number
+115 ;
LOCKFM(FILE,IENS,FIELD,TO,NAME,FLAGS) ;
+1 NEW DESCR,NDX,NODELIST,NODE,PI,RC,TMP
+2 if $GET(TO,-1)<0
SET TO=$GET(DILOCKTM,3)
+3 SET FLAGS=$GET(FLAGS)
+4 ;
+5 ;=== Update the ^XTMP("MAGLOCK",0) once per session
+6 IF '$DATA(MAGJOB("XTMPLOCK"))
Begin DoDot:1
+7 DO XTMPHDR^MAGUTL05("MAGLOCK",30,"Imaging LOCK Descriptors")
+8 QUIT
End DoDot:1
SET MAGJOB("XTMPLOCK")=""
+9 ;
+10 ;=== Check if a single object should be locked
+11 IF $DATA(FILE)<10
SET RC=0
if $GET(FILE)>0
Begin DoDot:1
+12 SET RC=$$LOCK1^MAGUTL08(FILE,$GET(IENS),$GET(FIELD),TO,$GET(NAME),FLAGS)
+13 QUIT
End DoDot:1
QUIT RC
+14 ;
+15 ;=== Compile the list of global nodes
+16 SET RC=$$NODELIST^MAGUTL08(.NODELIST,.FILE,$GET(IENS),$GET(FIELD))
+17 if RC<0
QUIT RC
if NODELIST=""
QUIT 0
+18 ;
+19 ;=== Try to lock the object(s)
+20 IF FLAGS'["D"
Begin DoDot:1
+21 SET TMP="L +("_NODELIST_"):"_TO
+22 QUIT
End DoDot:1
XECUTE TMP
IF '$TEST
QUIT $$LDSC^MAGUTL08(.NODELIST)
+23 ;
+24 ;=== Create the lock descriptor(s)
+25 SET DESCR=$$NOW^XLFDT_U_$G(NAME)_U_U_$JOB_U_$GET(ZTSK)
+26 if $GET(NAME)=""
SET $PIECE(DESCR,U,3)=$GET(DUZ)
+27 SET NODE=""
+28 FOR
SET NODE=$ORDER(NODELIST(NODE))
if NODE=""
QUIT
Begin DoDot:1
+29 SET NDX=$$XLNDX^MAGUTL08(NODE)
+30 ;--- Calculate the lock counter
+31 SET TMP=$GET(^XTMP("MAGLOCK",NDX))
+32 SET $PIECE(DESCR,U,6)=$SELECT($PIECE(TMP,U,4)=$JOB:$PIECE(TMP,U,6)+1,1:1)
+33 ;--- Store the descriptor
+34 SET ^XTMP("MAGLOCK",NDX)=DESCR
+35 QUIT
End DoDot:1
+36 ;===
+37 QUIT 0
+38 ;
+39 ;##### GENERATES A TEXT DESCRIPTION FROM THE LOCK DESCRIPTOR
+40 ;
+41 ; LDSC Lock descriptor returned by the $$LOCKFM^MAGUTL07
+42 ;
+43 ; Return Values:
+44 ; "" If the 1st "^"-piece of the LDSC is not greater than 0,
+45 ; then an empty string is returned.
+46 ; ... Otherwise, a text describing who/what and when
+47 ; locked the object according to the descriptor
+48 ;
TEXT(LDSC) ;
+1 if LDSC'>0
QUIT ""
+2 NEW TEXT,TMP
+3 SET TEXT="Locked by "_$PIECE(LDSC,U,2)_" about "_$$FMTE^XLFDT(+LDSC)
+4 SET TEXT=TEXT_"; Job #"_$PIECE(LDSC,U,4)
+5 SET TMP=$PIECE(LDSC,U,5)
if TMP'=""
SET TEXT=TEXT_"; Task #"_TMP
+6 QUIT TEXT
+7 ;
+8 ;##### UNLOCKS THE (SUB)FILE, RECORD OR FIELD NODE
+9 ;
+10 ; [.]FILE File/subfile number
+11 ; [IENS] IENS of the record or subfile
+12 ; [FIELD] Field number
+13 ;
+14 ; See description of the LOCKFM^MAGUTL07 for details
+15 ; about the FILE, IENS, and FIELD parameters.
+16 ;
+17 ; Return Values
+18 ; =============
+19 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+20 ; 0 Ok
+21 ;
+22 ; Notes
+23 ; =====
+24 ;
+25 ; This entry point can also be called as a procedure:
+26 ; D UNLOCKFM^MAGUTL07(...) if you do not need its return value.
+27 ;
UNLOCKFM(FILE,IENS,FIELD) ;
+1 NEW DESCR,NDX,NODELIST,NODE,PI,RC
+2 ;
+3 ;=== Check if a single object should be unlocked
+4 IF $DATA(FILE)<10
SET RC=0
if $GET(FILE)>0
Begin DoDot:1
+5 SET RC=$$UNLOCK1^MAGUTL08(FILE,$GET(IENS),$GET(FIELD))
+6 QUIT
End DoDot:1
if $QUIT
QUIT RC
QUIT
+7 ;
+8 ;=== Compile the list of global nodes
+9 SET RC=$$NODELIST^MAGUTL08(.NODELIST,.FILE,$GET(IENS),$GET(FIELD))
+10 IF RC<0
if $QUIT
QUIT RC
QUIT
+11 IF NODELIST=""
if $QUIT
QUIT 0
QUIT
+12 ;
+13 ;=== Remove the lock descriptor(s)
+14 SET NODE=""
+15 FOR
SET NODE=$ORDER(NODELIST(NODE))
if NODE=""
QUIT
Begin DoDot:1
+16 SET NDX=$$XLNDX^MAGUTL08(NODE)
SET DESCR=$GET(^XTMP("MAGLOCK",NDX))
+17 if $PIECE(DESCR,U,4)'=$JOB
QUIT
+18 IF $PIECE(DESCR,U,6)>1
Begin DoDot:2
+19 SET $PIECE(^XTMP("MAGLOCK",NDX),U,6)=$PIECE(DESCR,U,6)-1
+20 QUIT
End DoDot:2
+21 IF '$TEST
KILL ^XTMP("MAGLOCK",NDX)
+22 QUIT
End DoDot:1
+23 ;
+24 ;=== Unlock the object(s)
+25 XECUTE "L -("_NODELIST_")"
+26 if $QUIT
QUIT 0
QUIT
