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

MAGUTL08.m

Go to the documentation of this file.
  1. MAGUTL08 ;WOIFO/SG - INTERNAL LOCK UTILITIES ; 3/9/09 12:54pm
  1. ;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ; Entry points of this routine use the ^XTMP("MAGLOCK",...) global
  1. ; nodes to store lock descriptors (see the MAGUTL07 routine for
  1. ; details).
  1. ;
  1. ; This routine uses the following ICRs:
  1. ;
  1. ; #10060 Read file #200 (supported)
  1. ;
  1. Q
  1. ;
  1. ;##### DELETES STRAY LOCK DESCRIPTORS
  1. ;
  1. ; This is a service procedure. Do not call it from regular
  1. ; applications!
  1. ;
  1. PURGE() ;
  1. N NDX,NODE
  1. S NDX=0
  1. F S NDX=$O(^XTMP("MAGLOCK",NDX)) Q:$E(NDX,1)'="^" D
  1. . S NODE=$S(NDX["(":NDX_")",1:NDX)
  1. . D LOCK^DILF(NODE) E Q
  1. . K ^XTMP("MAGLOCK",NDX) L -@NODE
  1. . Q
  1. Q
  1. ;
  1. ;+++++ RETURNS THE LOCK DESCRIPTOR FOR THE GLOBAL NODE(S)
  1. ;
  1. ; This is an internal entry point. Do not call it from any routines
  1. ; except MAGUTL07 and MAGUTL08.
  1. ;
  1. LDSC(NODELIST) ;
  1. N DESCR,IENS,L,MAGMSG,NDX,NODE,SP,TMP
  1. S:$D(NODELIST)<10 NODELIST(NODELIST)=""
  1. ;
  1. ;=== Search for the most appropriate descriptor
  1. S (DESCR,NODE)=""
  1. F S NODE=$O(NODELIST(NODE)) Q:NODE="" D
  1. . ;--- The node itself
  1. . S SP=$$XLNDX(NODE),TMP=$G(^XTMP("MAGLOCK",SP))
  1. . S:TMP>DESCR DESCR=TMP
  1. . ;--- Left siblings and ancestors
  1. . S NDX=SP
  1. . F S NDX=$O(^XTMP("MAGLOCK",NDX),-1),L=$L(NDX) Q:(NDX="")!(NDX'=$E(SP,1,L)) D
  1. . . S TMP=$G(^XTMP("MAGLOCK",NDX)) S:TMP>DESCR DESCR=TMP
  1. . . Q
  1. . ;--- Right siblings and descendants
  1. . S NDX=SP,L=$L(SP)
  1. . F S NDX=$O(^XTMP("MAGLOCK",NDX)) Q:(NDX="")!($E(NDX,1,L)'=SP) D
  1. . . S TMP=$G(^XTMP("MAGLOCK",NDX)) S:TMP>DESCR DESCR=TMP
  1. . . Q
  1. . Q
  1. ;
  1. ;=== Populate as many fields of the descriptor as possible
  1. S:'DESCR $P(DESCR,U)=$$NOW^XLFDT
  1. ;--- Get the user name if the DUZ is available
  1. D:$P(DESCR,U,3)>0
  1. . S IENS=+$P(DESCR,U,3)_","
  1. . S $P(DESCR,U,2)=$$GET1^DIQ(200,IENS,.01,,,"MAGMSG")
  1. . Q
  1. ;--- If the originator of the lock is unknown, indicate this fact
  1. S:$P(DESCR,U,2)="" $P(DESCR,U,2)="UNKNOWN"
  1. ;
  1. ;=== Return the lock descriptor
  1. Q $P(DESCR,U,1,5)
  1. ;
  1. ;+++++ LOCKS THE SINGLE NODE
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; <0 Error descriptor (see the $$ERROR^MAGUERR)
  1. ; 0 Ok
  1. ; >0 Lock descriptor
  1. ;
  1. ; Notes
  1. ; =====
  1. ;
  1. ; This is an internal entry point. Do not call it from any routines
  1. ; except MAGUTL07 and MAGUTL08.
  1. ;
  1. LOCK1(FILE,IENS,FIELD,TO,NAME,FLAGS) ;
  1. N DESCR,NDX,NODE,TMP
  1. S NODE=$$NODE(FILE,IENS,FIELD)
  1. Q:NODE<0 NODE
  1. ;--- Try to lock the object
  1. I FLAGS'["D" L +@NODE:TO E Q $$LDSC(NODE)
  1. ;--- Create the lock descriptor
  1. S DESCR=$$NOW^XLFDT_U_NAME_U_U_$JOB_U_$G(ZTSK)
  1. S:NAME="" $P(DESCR,U,3)=$G(DUZ)
  1. ;--- Calculate the lock counter
  1. S NDX=$$XLNDX(NODE),TMP=$G(^XTMP("MAGLOCK",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("MAGLOCK",NDX)=DESCR
  1. Q 0
  1. ;
  1. ;+++++ RETURNS THE GLOBAL NODE OF THE OBJECT
  1. ;
  1. ; FILE File/subfile number
  1. ; IENS IENS of the record or subfile
  1. ; FIELD Field number
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; <0 Error descriptor (see the $$ERROR^MAGUERR)
  1. ; ... Closed root
  1. ;
  1. ; Notes
  1. ; =====
  1. ;
  1. ; This is an internal entry point. Do not call it from any routines
  1. ; except MAGUTL07 and MAGUTL08.
  1. ;
  1. NODE(FILE,IENS,FIELD) ;
  1. N FGL,IEN,MAGMSG,NODE,RC
  1. I IENS'="" Q:'$$VALIENS^MAGUTL05(IENS,"S") $$IPVE^MAGUERR("IENS")
  1. S IEN=+IENS
  1. I IEN S $P(IENS,",")="" S:IENS="," IENS=""
  1. ;--- Closed root of the (sub)file
  1. S NODE=$$ROOT^DILFD(FILE,IENS,1)
  1. Q:NODE="" $$ERROR^MAGUERR(-48,,FILE,IENS)
  1. Q:'IEN NODE
  1. ;--- The record node
  1. S NODE=$NA(@NODE@(IEN))
  1. Q:'FIELD NODE
  1. ;--- Field node
  1. S FGL=$$GET1^DID(FILE,FIELD,,"GLOBAL SUBSCRIPT LOCATION",,"MAGMSG")
  1. Q:$G(DIERR) $$DBS^MAGUERR("MAGMSG",FILE)
  1. S:$P(FGL,";")'="" NODE=$NA(@NODE@($P(FGL,";")))
  1. Q NODE
  1. ;
  1. ;+++++ COMPILES THE LIST OF GLOBAL NODES
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; <0 Error descriptor (see the $$ERROR^MAGUERR)
  1. ; 0 Ok
  1. ;
  1. ; Notes
  1. ; =====
  1. ;
  1. ; This is an internal entry point. Do not call it from any routines
  1. ; except MAGUTL07 and MAGUTL08.
  1. ;
  1. NODELIST(NODELIST,FILE,IENS,FIELD) ;
  1. N NODE,PI,RC K NODELIST
  1. S NODELIST="",RC=0
  1. ;--- Main object
  1. I $G(FILE)>0 D Q:RC<0 RC
  1. . S NODE=$$NODE(FILE,IENS,FIELD)
  1. . I NODE<0 S RC=NODE Q
  1. . S NODELIST=NODELIST_","_NODE
  1. . S NODELIST(NODE)=""
  1. . Q
  1. ;--- Linked objects
  1. S PI="FILE"
  1. F S PI=$Q(@PI) Q:PI="" D Q:RC<0
  1. . S NODE=$$NODE($QS(PI,1),$QS(PI,2),$QS(PI,3))
  1. . I NODE<0 S RC=NODE Q
  1. . S NODELIST=NODELIST_","_NODE
  1. . S NODELIST(NODE)=""
  1. . Q
  1. Q:RC<0 RC
  1. ;---
  1. S NODELIST=$P(NODELIST,",",2,999)
  1. Q RC
  1. ;
  1. ;+++++ UNLOCKS THE SINGLE NODE
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; <0 Error descriptor (see the $$ERROR^MAGUERR)
  1. ; 0 Ok
  1. ;
  1. ; Notes
  1. ; =====
  1. ;
  1. ; This is an internal entry point. Do not call it from any routines
  1. ; except MAGUTL07 and MAGUTL08.
  1. ;
  1. UNLOCK1(FILE,IENS,FIELD) ;
  1. N DESCR,NDX,NODE
  1. S NODE=$$NODE(FILE,IENS,FIELD)
  1. Q:NODE<0 NODE
  1. ;--- Remove the lock descriptor
  1. S NDX=$$XLNDX(NODE),DESCR=$G(^XTMP("MAGLOCK",NDX))
  1. D:$P(DESCR,U,4)=$JOB
  1. . I $P(DESCR,U,6)>1 D
  1. . . S $P(^XTMP("MAGLOCK",NDX),U,6)=$P(DESCR,U,6)-1
  1. . . Q
  1. . E K ^XTMP("MAGLOCK",NDX)
  1. . Q
  1. ;--- Unlock the object
  1. L -@NODE
  1. Q 0
  1. ;
  1. ;+++++ RETURNS SUBSCRIPT OF THE NODE IN THE DESCRIPTOR TABLE
  1. ;
  1. ; This is an internal entry point. Do not call it from any routines
  1. ; except MAGUTL07 and MAGUTL08.
  1. ;
  1. XLNDX(NODE) ;
  1. N L S L=$L(NODE)
  1. Q $S($E(NODE,L)=")":$E(NODE,1,L-1),1:NODE)