Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RALOCK

RALOCK.m

Go to the documentation of this file.
  1. RALOCK ;HCIOFO/SG - FILE/RECORD/FIELD LOCK ; 5/21/08 12:44pm
  1. ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1. ;
  1. ; Entry points of this routine use the ^XTMP("RALOCK",...) global
  1. ; nodes to store lock descriptors:
  1. ;
  1. ; ^XTMP("RALOCK",
  1. ; 0) Standard node descriptor
  1. ; ^1: Purge date (FileMan)
  1. ; ^2: Create date (FileMan)
  1. ; ^3: Description
  1. ;
  1. ; NodeNdx) Internal lock descriptor
  1. ; ^01: Date/Time (FileMan)
  1. ; ^02: User/Process name
  1. ; ^03: User IEN (DUZ)
  1. ; ^04: $JOB
  1. ; ^05: Task number
  1. ; ^06: Lock counter
  1. ;
  1. ; The NodeNdx is calculated by the $$XLNDX^RALOCK01 as the name
  1. ; reference to the locked node without the closing parenthesis.
  1. ;
  1. Q
  1. ;
  1. ;***** LOCKS THE (SUB)FILE, RECORD OR FIELD NODE
  1. ;
  1. ; [.]FILE File/subfile number
  1. ; [IENS] IENS of the record or subfile
  1. ; [FIELD] Field number
  1. ;
  1. ; If just the FILE has a value, then the whole file is
  1. ; locked. If the FILE references a subfile, then the
  1. ; subfile IENS (the 1st ","-piece is empty) should be
  1. ; passed in the IENS parameter.
  1. ;
  1. ; If the IENS references a record of a file/subfile
  1. ; (the 1st ","-piece is not empty), then this record
  1. ; is locked.
  1. ;
  1. ; If the IENS references a record and the FIELD is
  1. ; also defined, then only the node that stores this
  1. ; field is locked.
  1. ;
  1. ; In addition (or instead) to the main locked object
  1. ; defined by the FILE, IENS, and FIELD, you can define
  1. ; several additional objects using subscripts of the
  1. ; FILE parameter:
  1. ;
  1. ; ;--- Lock the whole file #72
  1. ; S FILE(72)=""
  1. ; ;--- Lock the EXAMINATIONS multiple
  1. ; S FILE(70.02,",6928784.9143,398,")=""
  1. ; ;--- Lock 2 exams
  1. ; S FILE(70.03,"1,6828784.9143,398,")=""
  1. ; S FILE(70.03,"3,6828784.9143,398,")=""
  1. ; ;--- Lock just the "BA" node of the order
  1. ; S FILE(75.1,"123,",91)=""
  1. ; ;--- Lock the objects
  1. ; S RC=$$LOCKFM^RALOCK(.FILE)
  1. ;
  1. ; All these objects are locked at the same time. If
  1. ; even one of them cannot be locked, then nothing
  1. ; is locked.
  1. ;
  1. ; [TO] Timeout (value of DILOCKTM, by default)
  1. ;
  1. ; [NAME] Process name. If this parameter is defined and not
  1. ; empty, then its value will be returned in the lock
  1. ; descriptor instead of the user name.
  1. ;
  1. ; [FLAGS] Flags that control the execution (can be combined):
  1. ;
  1. ; D Do not actually lock the node(s); just create
  1. ; the lock descriptor(s).
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok (the objects have been locked)
  1. ; >0 The object is locked by another user or task and
  1. ; a lock descriptor is returned.
  1. ; ^01: Date/Time (FileMan)
  1. ; ^02: User/Process name
  1. ; ^03: User IEN (DUZ)
  1. ; ^04: $JOB
  1. ; ^05: Task number
  1. ;
  1. ; If the third piece is empty then check the 2nd one for the
  1. ; custom process name.
  1. ;
  1. LOCKFM(FILE,IENS,FIELD,TO,NAME,FLAGS) ;
  1. N DESCR,NDX,NODELIST,NODE,PI,RC,TMP
  1. S:$G(TO,-1)<0 TO=$G(DILOCKTM,3)
  1. S FLAGS=$G(FLAGS)
  1. ;--- Update the ^XTMP("RALOCK",0) once per session
  1. I '$D(RAPARAMS("XTMPLOCK")) D S RAPARAMS("XTMPLOCK")=""
  1. . D XTMPHDR^RAUTL22("RALOCK",30,"Radiology LOCK Descriptors")
  1. ;--- Check if a single object should be locked
  1. I $D(FILE)<10 S RC=0 D:$G(FILE)>0 Q RC
  1. . S RC=$$LOCK1^RALOCK01(FILE,$G(IENS),$G(FIELD),TO,$G(NAME),FLAGS)
  1. ;--- Compile the list of global nodes
  1. S RC=$$NODELIST^RALOCK01(.NODELIST,.FILE,$G(IENS),$G(FIELD))
  1. Q:RC<0 RC Q:NODELIST="" 0
  1. ;--- Try to lock the object(s)
  1. I FLAGS'["D" D X TMP E Q $$LDSC^RALOCK01(.NODELIST)
  1. . S TMP="L +("_NODELIST_"):"_TO
  1. ;--- Create the lock descriptor(s)
  1. S DESCR=$$NOW^XLFDT_U_$G(NAME)_U_U_$JOB_U_$G(ZTSK)
  1. S:$G(NAME)="" $P(DESCR,U,3)=$G(DUZ)
  1. S NODE=""
  1. F S NODE=$O(NODELIST(NODE)) Q:NODE="" D
  1. . S NDX=$$XLNDX^RALOCK01(NODE)
  1. . ;--- Calculate the lock counter
  1. . S TMP=$G(^XTMP("RALOCK",NDX))
  1. . S $P(DESCR,U,6)=$S($P(TMP,U,4)=$JOB:$P(TMP,U,6)+1,1:1)
  1. . ;--- Store the descriptor
  1. . S ^XTMP("RALOCK",NDX)=DESCR
  1. Q 0
  1. ;
  1. ;***** GENERATES A TEXT DESCRIPTION FROM THE LOCK DESCRIPTOR
  1. ;
  1. ; LDSC Lock descriptor returned by the $$LOCKFM^RALOCK
  1. ;
  1. ; Return Values:
  1. ; "" If the 1st "^"-piece is not greater than 0,
  1. ; then an empty string is returned.
  1. ; ... Otherwise, a text describing who/what and when
  1. ; locked the object according to the descriptor
  1. ;
  1. TEXT(LDSC) ;
  1. Q:LDSC'>0 ""
  1. N LTEXT,PARAMS,RABUF
  1. S PARAMS("LDT")=$$FMTE^XLFDT(+LDSC) ; Lock date/time
  1. S PARAMS("NAME")=$P(LDSC,U,2) ; User/process name
  1. S PARAMS("JOB")=$P(LDSC,U,4) ; Job number
  1. S PARAMS("TASK")=$P(LDSC,U,5) ; Task number
  1. D BLD^DIALOG(700005.002,.PARAMS,,"RABUF","S")
  1. Q RABUF(1)_$S(PARAMS("TASK")'="":$G(RABUF(2)),1:"")
  1. ;
  1. ;***** UNLOCKS THE (SUB)FILE, RECORD OR FIELD NODE
  1. ;
  1. ; [.]FILE File/subfile number
  1. ; [IENS] IENS of the record or subfile
  1. ; [FIELD] Field number
  1. ;
  1. ; See description of the LOCKFM^RALOCK for details
  1. ; about the FILE, IENS, and FIELD parameters.
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. ; NOTE: This entry point can also be called as a procedure:
  1. ; D UNLOCKFM^RALOCK(...) if you do not need its return value.
  1. ;
  1. UNLOCKFM(FILE,IENS,FIELD) ;
  1. N DESCR,NDX,NODELIST,NODE,PI,RC
  1. I $D(FILE)<10 S RC=0 D:$G(FILE)>0 Q:$QUIT RC Q
  1. . S RC=$$UNLOCK1^RALOCK01(FILE,$G(IENS),$G(FIELD))
  1. ;--- Compile the list of global nodes
  1. S RC=$$NODELIST^RALOCK01(.NODELIST,.FILE,$G(IENS),$G(FIELD))
  1. I RC<0 Q:$QUIT RC Q
  1. I NODELIST="" Q:$QUIT 0 Q
  1. ;--- Remove the lock descriptor(s)
  1. S NODE=""
  1. F S NODE=$O(NODELIST(NODE)) Q:NODE="" D
  1. . S NDX=$$XLNDX^RALOCK01(NODE),DESCR=$G(^XTMP("RALOCK",NDX))
  1. . Q:$P(DESCR,U,4)'=$JOB
  1. . I $P(DESCR,U,6)>1 D
  1. . . S $P(^XTMP("RALOCK",NDX),U,6)=$P(DESCR,U,6)-1
  1. . E K ^XTMP("RALOCK",NDX)
  1. ;--- Unlock the object(s)
  1. X "L -("_NODELIST_")"
  1. Q:$QUIT 0 Q