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

BQIRGLK.m

Go to the documentation of this file. 
  1. BQIRGLK ;PRXM/HC/DB-Patient Register Lock/Unlock Functions ; 14 Nov 2007  4:03 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. LOCK(DATA,DFN,REG,PTIEN) ; EP - BQI LOCK PATIENT BY REGISTER
  1.  ; Description
  1.  ;   Attempt to lock a patient register record specified by REG and PTIEN for
  1.  ;   exclusive editing access.
  1.  ;   If successful, sets 'LAST LOCKED BY' with the current DUZ
  1.  ;   and returns a RESULT of 1 and the current DUZ.
  1.  ;   If unsuccessful, returns a RESULT of 0 and the DUZ from the
  1.  ;   'LAST LOCKED BY' field.
  1.  ; Input:
  1.  ;   DFN     - Patient IEN
  1.  ;   REG     - Register defined in ^BQI(90507
  1.  ;   PTIEN   - Register patient IEN to be locked
  1.  ; Output:
  1.  ;   DATA  = name of global (passed by reference) in which the data is stored
  1.  ;
  1.  ;   RESULT = 1 if the lock succeeded
  1.  ;          = 0 if the lock failed
  1.  ;          = -1 if problem identified with file 90507 (shouldn't happen)
  1.  ;   USER   = DUZ of the last user to successfully lock this panel
  1.  ; or
  1.  ;   BMXSEC - if M error encountered
  1.  ;            
  1.  N UID,X,BQII,MSG,FILE,RESULT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIRGLK",UID))
  1.  K ^TMP("BQIRGLK",UID)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ; Create header record
  1.  S BQII=0,@DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)
  1.  ;
  1.  S FILE=$$RFILE(REG),MSG=$P(FILE,U,2),FILE=$P(FILE,U)
  1.  I FILE=-1 S RESULT=-1 D UPD Q
  1.  ; If adding register information create temporary ien for locking
  1.  I $L(PTIEN,",")=3 S PTIEN=$P(PTIEN,",",2) ; Returned as IENS
  1.  I $E(PTIEN,$L(PTIEN))="," S PTIEN=$$TKO^BQIUL1(PTIEN,",")
  1.  I 'PTIEN S PTIEN="T"_DFN
  1.  S GLBREF=$$ROOT^DILFD(FILE,"")_$S('PTIEN:""""_PTIEN_"""",1:PTIEN)_")"
  1.  ;
  1.  N USER
  1.  ;
  1.  ; Attempt lock and set RESULT accordingly
  1.  S RESULT=1
  1.  L +@GLBREF:1 E  S RESULT=0
  1.  ;
  1.  ; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.
  1.  I RESULT=0 D
  1.  . S USER=$G(^XTMP("BQIRGLK",FILE,PTIEN))
  1.  . S NAME=$$GET1^DIQ(200,USER,.01,"E")
  1.  . I NAME="" S NAME="an unknown user"
  1.  . S MSG="This record is currently being updated by "_NAME_"."
  1.  ; If lock is successful, update 'LAST LOCKED BY' in ^XTMP.
  1.  I RESULT=1 D
  1.  . S ^XTMP("BQIRGLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of patient register data"
  1.  . S ^XTMP("BQIRGLK",FILE,PTIEN)=DUZ
  1.  ;
  1.  D UPD
  1.  Q
  1.  ;
  1. UNLOCK(DATA,DFN,REG,PTIEN) ; EP - BQI UNLOCK PATIENT BY REGISTER
  1.  ; Description
  1.  ;   Unlock the patient register record specified by REG and PTIEN which was
  1.  ;   previously locked for exclusive editing access. If the
  1.  ;   entry in the 'LAST LOCKED BY' field is for this DUZ then
  1.  ;   delete it (so another user can't accidentally update it).
  1.  ; Input:
  1.  ;   DFN     - Patient IEN
  1.  ;   REG     - Register defined in ^BQI(90507
  1.  ;   PTIEN  - Register IEN to be locked
  1.  ; Output:
  1.  ;   DATA  = name of global (passed by reference) in which the data is stored
  1.  ;
  1.  ;   RESULT = 1 (unlock will always succeed)
  1.  ;   RESULT = -1 if problem identified with file 90507 (shouldn't happen)
  1.  ; or
  1.  ;   BMXSEC - if M error encountered
  1.  ;            
  1.  N UID,X,BQII,MSG,REGIEN,RDATA,FILE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIRGLK",UID))
  1.  K ^TMP("BQIRGLK",UID)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ; Create header record
  1.  S BQII=0,@DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)
  1.  ;
  1.  N RESULT,USER
  1.  ;
  1.  S FILE=$$RFILE(REG),MSG=$P(FILE,U,2),FILE=$P(FILE,U)
  1.  I FILE=-1 S RESULT=-1 D UPD Q
  1.  ; If adding register information create temporary ien for locking
  1.  I $L(PTIEN,",")=3 S PTIEN=$P(PTIEN,",",2) ; Returned as IENS
  1.  I $E(PTIEN,$L(PTIEN))="," S PTIEN=$$TKO^BQIUL1(PTIEN,",")
  1.  I 'PTIEN S PTIEN="T"_DFN
  1.  S GLBREF=$$ROOT^DILFD(FILE,"")_$S('PTIEN:""""_PTIEN_"""",1:PTIEN)_")"
  1.  ;
  1.  ; Get 'LAST LOCKED BY'.
  1.  S USER=$G(^XTMP("BQIRGLK",FILE,PTIEN))
  1.  ;
  1.  ; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
  1.  I USER=DUZ K ^XTMP("BQIRGLK",FILE,PTIEN)
  1.  ;
  1.  ; Unlock and set RESULT
  1.  S RESULT=1
  1.  L -@GLBREF
  1.  ;
  1.  D UPD
  1.  Q
  1.  ;
  1. UPD ; Report results
  1.  S BQII=BQII+1,@DATA@(BQII)=RESULT_"^"_MSG_$C(30)
  1.  S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. RFILE(REG) ; Get register file number
  1.  N REGIEN,RDATA,FILE
  1.  S REGIEN=$O(^BQI(90507,"B",REG,""))
  1.  I 'REGIEN Q "-1^Invalid register"
  1.  I $$GET1^DIQ(90507,REGIEN_",",.08,"I")=1 Q "-1^Inactive register"
  1.  S RDATA=^BQI(90507,REGIEN,0),FILE=$P(RDATA,"^",7)
  1.  I '$$VFILE^DILFD(FILE) Q "-1^Invalid file number"
  1.  Q FILE
  1.  ;
  1. ERR ;
  1.  L
  1.  I $G(FILE)'="",$G(PTIEN)'="",$G(^XTMP("BQIRGLK",FILE,PTIEN))=DUZ K ^XTMP("BQIRGLK",FILE,PTIEN)
  1.  D ^%ZTER
  1.  N Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  Q