BQIULLK ;PRXM/HC/DB-Miscellaneous BQI utilities - Lock/Unlock Functions ; 28 May 2008 4:03 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
LOCK(DATA,DFN,TYPE) ; EP - BQI LOCK RECORD BY TYPE
; Description
; Attempt to lock a record type (problem, family history, etc.) for a patient
; If successful, sets 'LAST LOCKED BY' with the current DUZ
; and returns a RESULT of 1 and the current DUZ.
; If unsuccessful, returns a RESULT of 0 and the DUZ from the
; 'LAST LOCKED BY' field.
; Input:
; DFN - Patient IEN
; TYPE - Type of record to be locked for this patient
;
; Output:
; DATA = name of global (passed by reference) in which the data is stored
;
; RESULT = 1 if the lock succeeded
; = 0 if the lock failed
; = -1 if problem identified with DCAT (shouldn't happen)
; USER = DUZ of the last user to successfully lock this panel
; or
; BMXSEC - if M error encountered
;
I $G(TYPE)="" S BMXSEC="Invalid record type passed." Q
N UID,X,BQII,MSG,RESULT,DCATIEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIULLK"_$E(TYPE,1,5),UID))
K ^TMP("BQIULLK"_$E(TYPE,1,5),UID)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIULLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; Create header record
S BQII=0,@DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)
;
S MSG=""
N USER
;
; Attempt lock and set RESULT accordingly
S RESULT=1
L +^BQILOCK(TYPE,DFN):1 E S RESULT=0
;
; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.
I RESULT=0 D
. S USER=$G(^XTMP("BQIULLK",TYPE,DFN))
. S NAME=$$GET1^DIQ(200,USER,.01,"E")
. I NAME="" S NAME="an unknown user"
. S MSG="This record is currently being updated by "_NAME_"."
; If lock is successful, update 'LAST LOCKED BY' in ^XTMP.
I RESULT=1 D
. S ^XTMP("BQIULLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of "_TYPE_" data"
. S ^XTMP("BQIULLK",TYPE,DFN)=DUZ
;
D UPD
Q
;
UNLOCK(DATA,DFN,TYPE) ; EP - BQI UNLOCK RECORD BY TYPE
; Description
; Unlock a record type (problem, family history, etc. - specified by TYPE)
; for a patient previously locked for exclusive editing access. If the
; entry in the 'LAST LOCKED BY' field is for this DUZ then
; delete it (so another user can't accidentally update it).
; Input:
; DFN - Patient IEN
; TYPE - Type of record to be locked for this patient
; Output:
; DATA = name of global (passed by reference) in which the data is stored
;
; RESULT = 1 (unlock will always succeed)
; or
; BMXSEC - if M error encountered
;
I $G(TYPE)="" S BMXSEC="Invalid record type passed." Q
N UID,X,BQII,MSG,REGIEN,RDATA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIULLK"_$E(TYPE,1,5),UID))
K ^TMP("BQIULLK"_$E(TYPE,1,5),UID)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIULLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; Create header record
S BQII=0,@DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)
;
N RESULT,USER
;
S MSG=""
; Get 'LAST LOCKED BY'.
S USER=$G(^XTMP("BQIULLK",TYPE,DFN))
;
; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
I USER=DUZ K ^XTMP("BQIULLK",TYPE,DFN)
;
; Unlock and set RESULT
S RESULT=1
L -^BQILOCK(TYPE,DFN)
;
D UPD
Q
;
UPD ; Report results
S BQII=BQII+1,@DATA@(BQII)=RESULT_"^"_MSG_$C(30)
S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
;
ERR ;
L
I $G(DCAT)'="",$G(DFN)'="",$G(^XTMP("BQIULLK",TYPE,DFN))=DUZ K ^XTMP("BQIULLK",TYPE,DFN)
D ^%ZTER
N Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
Q
BQIULLK ;PRXM/HC/DB-Miscellaneous BQI utilities - Lock/Unlock Functions ; 28 May 2008 4:03 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
LOCK(DATA,DFN,TYPE) ; EP - BQI LOCK RECORD BY TYPE
+1 ; Description
+2 ; Attempt to lock a record type (problem, family history, etc.) for a patient
+3 ; If successful, sets 'LAST LOCKED BY' with the current DUZ
+4 ; and returns a RESULT of 1 and the current DUZ.
+5 ; If unsuccessful, returns a RESULT of 0 and the DUZ from the
+6 ; 'LAST LOCKED BY' field.
+7 ; Input:
+8 ; DFN - Patient IEN
+9 ; TYPE - Type of record to be locked for this patient
+10 ;
+11 ; Output:
+12 ; DATA = name of global (passed by reference) in which the data is stored
+13 ;
+14 ; RESULT = 1 if the lock succeeded
+15 ; = 0 if the lock failed
+16 ; = -1 if problem identified with DCAT (shouldn't happen)
+17 ; USER = DUZ of the last user to successfully lock this panel
+18 ; or
+19 ; BMXSEC - if M error encountered
+20 ;
+21 IF $GET(TYPE)=""
SET BMXSEC="Invalid record type passed."
QUIT
+22 NEW UID,X,BQII,MSG,RESULT,DCATIEN
+23 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+24 SET DATA=$NAME(^TMP("BQIULLK"_$EXTRACT(TYPE,1,5),UID))
+25 KILL ^TMP("BQIULLK"_$EXTRACT(TYPE,1,5),UID)
+26 ;
+27 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIULLK D UNWIND^%ZTER"
+28 ;
+29 ; Create header record
+30 SET BQII=0
SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+31 ;
+32 SET MSG=""
+33 NEW USER
+34 ;
+35 ; Attempt lock and set RESULT accordingly
+36 SET RESULT=1
+37 LOCK +^BQILOCK(TYPE,DFN):1
IF '$TEST
SET RESULT=0
+38 ;
+39 ; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.
+40 IF RESULT=0
Begin DoDot:1
+41 SET USER=$GET(^XTMP("BQIULLK",TYPE,DFN))
+42 SET NAME=$$GET1^DIQ(200,USER,.01,"E")
+43 IF NAME=""
SET NAME="an unknown user"
+44 SET MSG="This record is currently being updated by "_NAME_"."
End DoDot:1
+45 ; If lock is successful, update 'LAST LOCKED BY' in ^XTMP.
+46 IF RESULT=1
Begin DoDot:1
+47 SET ^XTMP("BQIULLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of "_TYPE_" data"
+48 SET ^XTMP("BQIULLK",TYPE,DFN)=DUZ
End DoDot:1
+49 ;
+50 DO UPD
+51 QUIT
+52 ;
UNLOCK(DATA,DFN,TYPE) ; EP - BQI UNLOCK RECORD BY TYPE
+1 ; Description
+2 ; Unlock a record type (problem, family history, etc. - specified by TYPE)
+3 ; for a patient previously locked for exclusive editing access. If the
+4 ; entry in the 'LAST LOCKED BY' field is for this DUZ then
+5 ; delete it (so another user can't accidentally update it).
+6 ; Input:
+7 ; DFN - Patient IEN
+8 ; TYPE - Type of record to be locked for this patient
+9 ; Output:
+10 ; DATA = name of global (passed by reference) in which the data is stored
+11 ;
+12 ; RESULT = 1 (unlock will always succeed)
+13 ; or
+14 ; BMXSEC - if M error encountered
+15 ;
+16 IF $GET(TYPE)=""
SET BMXSEC="Invalid record type passed."
QUIT
+17 NEW UID,X,BQII,MSG,REGIEN,RDATA
+18 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+19 SET DATA=$NAME(^TMP("BQIULLK"_$EXTRACT(TYPE,1,5),UID))
+20 KILL ^TMP("BQIULLK"_$EXTRACT(TYPE,1,5),UID)
+21 ;
+22 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIULLK D UNWIND^%ZTER"
+23 ;
+24 ; Create header record
+25 SET BQII=0
SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+26 ;
+27 NEW RESULT,USER
+28 ;
+29 SET MSG=""
+30 ; Get 'LAST LOCKED BY'.
+31 SET USER=$GET(^XTMP("BQIULLK",TYPE,DFN))
+32 ;
+33 ; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
+34 IF USER=DUZ
KILL ^XTMP("BQIULLK",TYPE,DFN)
+35 ;
+36 ; Unlock and set RESULT
+37 SET RESULT=1
+38 LOCK -^BQILOCK(TYPE,DFN)
+39 ;
+40 DO UPD
+41 QUIT
+42 ;
UPD ; Report results
+1 SET BQII=BQII+1
SET @DATA@(BQII)=RESULT_"^"_MSG_$CHAR(30)
+2 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+3 QUIT
+4 ;
ERR ;
+1 LOCK
+2 IF $GET(DCAT)'=""
IF $GET(DFN)'=""
IF $GET(^XTMP("BQIULLK",TYPE,DFN))=DUZ
KILL ^XTMP("BQIULLK",TYPE,DFN)
+3 DO ^%ZTER
+4 NEW Y,ERRDTM
+5 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+6 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+7 QUIT
