BQIRGLK ;PRXM/HC/DB-Patient Register Lock/Unlock Functions ; 14 Nov 2007 4:03 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
LOCK(DATA,DFN,REG,PTIEN) ; EP - BQI LOCK PATIENT BY REGISTER
; Description
; Attempt to lock a patient register record specified by REG and PTIEN for
; exclusive editing access.
; 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
; REG - Register defined in ^BQI(90507
; PTIEN - Register patient IEN to be locked
; 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 file 90507 (shouldn't happen)
; USER = DUZ of the last user to successfully lock this panel
; or
; BMXSEC - if M error encountered
;
N UID,X,BQII,MSG,FILE,RESULT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRGLK",UID))
K ^TMP("BQIRGLK",UID)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; Create header record
S BQII=0,@DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)
;
S FILE=$$RFILE(REG),MSG=$P(FILE,U,2),FILE=$P(FILE,U)
I FILE=-1 S RESULT=-1 D UPD Q
; If adding register information create temporary ien for locking
I $L(PTIEN,",")=3 S PTIEN=$P(PTIEN,",",2) ; Returned as IENS
I $E(PTIEN,$L(PTIEN))="," S PTIEN=$$TKO^BQIUL1(PTIEN,",")
I 'PTIEN S PTIEN="T"_DFN
S GLBREF=$$ROOT^DILFD(FILE,"")_$S('PTIEN:""""_PTIEN_"""",1:PTIEN)_")"
;
N USER
;
; Attempt lock and set RESULT accordingly
S RESULT=1
L +@GLBREF:1 E S RESULT=0
;
; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.
I RESULT=0 D
. S USER=$G(^XTMP("BQIRGLK",FILE,PTIEN))
. 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("BQIRGLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of patient register data"
. S ^XTMP("BQIRGLK",FILE,PTIEN)=DUZ
;
D UPD
Q
;
UNLOCK(DATA,DFN,REG,PTIEN) ; EP - BQI UNLOCK PATIENT BY REGISTER
; Description
; Unlock the patient register record specified by REG and PTIEN which was
; 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
; REG - Register defined in ^BQI(90507
; PTIEN - Register IEN to be locked
; Output:
; DATA = name of global (passed by reference) in which the data is stored
;
; RESULT = 1 (unlock will always succeed)
; RESULT = -1 if problem identified with file 90507 (shouldn't happen)
; or
; BMXSEC - if M error encountered
;
N UID,X,BQII,MSG,REGIEN,RDATA,FILE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRGLK",UID))
K ^TMP("BQIRGLK",UID)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGLK 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 FILE=$$RFILE(REG),MSG=$P(FILE,U,2),FILE=$P(FILE,U)
I FILE=-1 S RESULT=-1 D UPD Q
; If adding register information create temporary ien for locking
I $L(PTIEN,",")=3 S PTIEN=$P(PTIEN,",",2) ; Returned as IENS
I $E(PTIEN,$L(PTIEN))="," S PTIEN=$$TKO^BQIUL1(PTIEN,",")
I 'PTIEN S PTIEN="T"_DFN
S GLBREF=$$ROOT^DILFD(FILE,"")_$S('PTIEN:""""_PTIEN_"""",1:PTIEN)_")"
;
; Get 'LAST LOCKED BY'.
S USER=$G(^XTMP("BQIRGLK",FILE,PTIEN))
;
; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
I USER=DUZ K ^XTMP("BQIRGLK",FILE,PTIEN)
;
; Unlock and set RESULT
S RESULT=1
L -@GLBREF
;
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
;
RFILE(REG) ; Get register file number
N REGIEN,RDATA,FILE
S REGIEN=$O(^BQI(90507,"B",REG,""))
I 'REGIEN Q "-1^Invalid register"
I $$GET1^DIQ(90507,REGIEN_",",.08,"I")=1 Q "-1^Inactive register"
S RDATA=^BQI(90507,REGIEN,0),FILE=$P(RDATA,"^",7)
I '$$VFILE^DILFD(FILE) Q "-1^Invalid file number"
Q FILE
;
ERR ;
L
I $G(FILE)'="",$G(PTIEN)'="",$G(^XTMP("BQIRGLK",FILE,PTIEN))=DUZ K ^XTMP("BQIRGLK",FILE,PTIEN)
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
BQIRGLK ;PRXM/HC/DB-Patient Register Lock/Unlock Functions ; 14 Nov 2007 4:03 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
LOCK(DATA,DFN,REG,PTIEN) ; EP - BQI LOCK PATIENT BY REGISTER
+1 ; Description
+2 ; Attempt to lock a patient register record specified by REG and PTIEN for
+3 ; exclusive editing access.
+4 ; If successful, sets 'LAST LOCKED BY' with the current DUZ
+5 ; and returns a RESULT of 1 and the current DUZ.
+6 ; If unsuccessful, returns a RESULT of 0 and the DUZ from the
+7 ; 'LAST LOCKED BY' field.
+8 ; Input:
+9 ; DFN - Patient IEN
+10 ; REG - Register defined in ^BQI(90507
+11 ; PTIEN - Register patient IEN to be locked
+12 ; Output:
+13 ; DATA = name of global (passed by reference) in which the data is stored
+14 ;
+15 ; RESULT = 1 if the lock succeeded
+16 ; = 0 if the lock failed
+17 ; = -1 if problem identified with file 90507 (shouldn't happen)
+18 ; USER = DUZ of the last user to successfully lock this panel
+19 ; or
+20 ; BMXSEC - if M error encountered
+21 ;
+22 NEW UID,X,BQII,MSG,FILE,RESULT
+23 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+24 SET DATA=$NAME(^TMP("BQIRGLK",UID))
+25 KILL ^TMP("BQIRGLK",UID)
+26 ;
+27 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRGLK D UNWIND^%ZTER"
+28 ;
+29 ; Create header record
+30 SET BQII=0
SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+31 ;
+32 SET FILE=$$RFILE(REG)
SET MSG=$PIECE(FILE,U,2)
SET FILE=$PIECE(FILE,U)
+33 IF FILE=-1
SET RESULT=-1
DO UPD
QUIT
+34 ; If adding register information create temporary ien for locking
+35 ; Returned as IENS
IF $LENGTH(PTIEN,",")=3
SET PTIEN=$PIECE(PTIEN,",",2)
+36 IF $EXTRACT(PTIEN,$LENGTH(PTIEN))=","
SET PTIEN=$$TKO^BQIUL1(PTIEN,",")
+37 IF 'PTIEN
SET PTIEN="T"_DFN
+38 SET GLBREF=$$ROOT^DILFD(FILE,"")_$SELECT('PTIEN:""""_PTIEN_"""",1:PTIEN)_")"
+39 ;
+40 NEW USER
+41 ;
+42 ; Attempt lock and set RESULT accordingly
+43 SET RESULT=1
+44 LOCK +@GLBREF:1
IF '$TEST
SET RESULT=0
+45 ;
+46 ; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.
+47 IF RESULT=0
Begin DoDot:1
+48 SET USER=$GET(^XTMP("BQIRGLK",FILE,PTIEN))
+49 SET NAME=$$GET1^DIQ(200,USER,.01,"E")
+50 IF NAME=""
SET NAME="an unknown user"
+51 SET MSG="This record is currently being updated by "_NAME_"."
End DoDot:1
+52 ; If lock is successful, update 'LAST LOCKED BY' in ^XTMP.
+53 IF RESULT=1
Begin DoDot:1
+54 SET ^XTMP("BQIRGLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of patient register data"
+55 SET ^XTMP("BQIRGLK",FILE,PTIEN)=DUZ
End DoDot:1
+56 ;
+57 DO UPD
+58 QUIT
+59 ;
UNLOCK(DATA,DFN,REG,PTIEN) ; EP - BQI UNLOCK PATIENT BY REGISTER
+1 ; Description
+2 ; Unlock the patient register record specified by REG and PTIEN which was
+3 ; 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 ; REG - Register defined in ^BQI(90507
+9 ; PTIEN - Register IEN to be locked
+10 ; Output:
+11 ; DATA = name of global (passed by reference) in which the data is stored
+12 ;
+13 ; RESULT = 1 (unlock will always succeed)
+14 ; RESULT = -1 if problem identified with file 90507 (shouldn't happen)
+15 ; or
+16 ; BMXSEC - if M error encountered
+17 ;
+18 NEW UID,X,BQII,MSG,REGIEN,RDATA,FILE
+19 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+20 SET DATA=$NAME(^TMP("BQIRGLK",UID))
+21 KILL ^TMP("BQIRGLK",UID)
+22 ;
+23 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRGLK D UNWIND^%ZTER"
+24 ;
+25 ; Create header record
+26 SET BQII=0
SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+27 ;
+28 NEW RESULT,USER
+29 ;
+30 SET FILE=$$RFILE(REG)
SET MSG=$PIECE(FILE,U,2)
SET FILE=$PIECE(FILE,U)
+31 IF FILE=-1
SET RESULT=-1
DO UPD
QUIT
+32 ; If adding register information create temporary ien for locking
+33 ; Returned as IENS
IF $LENGTH(PTIEN,",")=3
SET PTIEN=$PIECE(PTIEN,",",2)
+34 IF $EXTRACT(PTIEN,$LENGTH(PTIEN))=","
SET PTIEN=$$TKO^BQIUL1(PTIEN,",")
+35 IF 'PTIEN
SET PTIEN="T"_DFN
+36 SET GLBREF=$$ROOT^DILFD(FILE,"")_$SELECT('PTIEN:""""_PTIEN_"""",1:PTIEN)_")"
+37 ;
+38 ; Get 'LAST LOCKED BY'.
+39 SET USER=$GET(^XTMP("BQIRGLK",FILE,PTIEN))
+40 ;
+41 ; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
+42 IF USER=DUZ
KILL ^XTMP("BQIRGLK",FILE,PTIEN)
+43 ;
+44 ; Unlock and set RESULT
+45 SET RESULT=1
+46 LOCK -@GLBREF
+47 ;
+48 DO UPD
+49 QUIT
+50 ;
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 ;
RFILE(REG) ; Get register file number
+1 NEW REGIEN,RDATA,FILE
+2 SET REGIEN=$ORDER(^BQI(90507,"B",REG,""))
+3 IF 'REGIEN
QUIT "-1^Invalid register"
+4 IF $$GET1^DIQ(90507,REGIEN_",",.08,"I")=1
QUIT "-1^Inactive register"
+5 SET RDATA=^BQI(90507,REGIEN,0)
SET FILE=$PIECE(RDATA,"^",7)
+6 IF '$$VFILE^DILFD(FILE)
QUIT "-1^Invalid file number"
+7 QUIT FILE
+8 ;
ERR ;
+1 LOCK
+2 IF $GET(FILE)'=""
IF $GET(PTIEN)'=""
IF $GET(^XTMP("BQIRGLK",FILE,PTIEN))=DUZ
KILL ^XTMP("BQIRGLK",FILE,PTIEN)
+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
