AGGLOCK ;VNGT/HS/ALA-Locking Routine for Patient Reg ; 16 May 2010 1:07 PM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
LOCK(DATA,DFN) ; EP - AGG LOCK PATIENT
; Input
; DFN - Patient IEN
;
; 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 invalid patient IEN (shouldn't happen)
; USER = DUZ of the last user to successfully lock this panel
; or
; BMXSEC - if M error encountered
;
NEW UID,X,II,MSG,VAL,RESULT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGLCK",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGLOCK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; Create header record
S II=0,@DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
;
;S AGIEN=$$FIND1^DIC(9009068.3,"","BX",DEF,"","","ERROR")
;I AGIEN=0 S BMXSEC="RPC Failed: Passed in window name "_DEF_" not found" Q
;
;S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2),SECFILE=$P(^AGG(9009068.3,AGIEN,0),U,14)
;
S VAL=$$VAL(DFN),MSG=$P(VAL,U,2),VAL=$P(VAL,U)
I VAL=-1 S RESULT=-1 D SET Q
;
NEW USER
; Attempt lock and set RESULT accordingly
S RESULT=1
L +^DPT(DFN):1 E S RESULT=0
L +^AUPNPAT(DFN):1 E S RESULT=0 L -^DPT(DFN)
; figure out what to lock
;
;
LST ; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.
I RESULT=0 D
. S USER=$P($G(^XTMP("AGGLCK",DFN)),"^")
. S NAME=$$GET1^DIQ(200,USER,.01,"E")
. I NAME="" S NAME="an unknown user"
. S MSG="This event is locked for editing by "_NAME_"."
; If lock is successful, update 'LAST LOCKED BY' in ^XTMP.
I RESULT=1 D
. S ^XTMP("AGGLCK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of Reg data"
. S CNT=+$P($G(^XTMP("AGGLCK",DFN)),"^",2)+1
. S ^XTMP("AGGLCK",DFN)=DUZ_"^"_CNT
;
D SET
Q
;
UNLOCK(DATA,DFN) ; EP - AGG UNLOCK PATIENT
; Input
; DFN - Patient IEN
;
; Output:
; DATA = name of global (passed by reference) in which the data is stored
; RESULT = 1 (unlock will always succeed)
; RESULT = -1 if invalid patient IEN (shouldn't happen)
; or
; BMXSEC - if M error encountered
;
NEW UID,X,II,MSG,VAL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGLCK",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGLOCK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; Create header record
S II=0,@DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
NEW RESULT,USER
S VAL=$$VAL(DFN),MSG=$P(VAL,U,2),VAL=$P(VAL,U)
I VAL=-1 S RESULT=-1 D SET Q
;
; Unlock and set RESULT
D UNL(DFN)
S RESULT=1
D SET
Q
;
SET ; Report results
S II=II+1,@DATA@(II)=RESULT_"^"_$G(MSG)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
D UNL(DFN)
Q
;
VAL(IEN) ; Validate RECORD ien
I $G(^DPT(IEN,0))="" Q "-1^Invalid Patient selected"
I $G(^AUPNPAT(IEN,0))="" Q "-1^Invalid Patient selected"
Q 1
;
UNL(DFN) ;
Q:$G(DFN)=""
; Get 'LAST LOCKED BY'.
N DAT,CNT
S DAT=$G(^XTMP("AGGLCK",DFN))
S USER=$P(DAT,"^")
S CNT=+$P(DAT,"^",2)
;
; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
I USER=DUZ K ^XTMP("AGGLCK",DFN)
F I=1:1:CNT L -^AUPNPAT(DFN),-^DPT(DFN)
Q
AGGLOCK ;VNGT/HS/ALA-Locking Routine for Patient Reg ; 16 May 2010 1:07 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
LOCK(DATA,DFN) ; EP - AGG LOCK PATIENT
+1 ; Input
+2 ; DFN - Patient IEN
+3 ;
+4 ; Output:
+5 ; DATA = name of global (passed by reference) in which the data is stored
+6 ;
+7 ; RESULT = 1 if the lock succeeded
+8 ; = 0 if the lock failed
+9 ; = -1 if invalid patient IEN (shouldn't happen)
+10 ; USER = DUZ of the last user to successfully lock this panel
+11 ; or
+12 ; BMXSEC - if M error encountered
+13 ;
+14 NEW UID,X,II,MSG,VAL,RESULT
+15 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+16 SET DATA=$NAME(^TMP("AGGLCK",UID))
+17 KILL @DATA
+18 ;
+19 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGLOCK D UNWIND^%ZTER"
+20 ;
+21 ; Create header record
+22 SET II=0
SET @DATA@(II)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+23 ;
+24 ;S AGIEN=$$FIND1^DIC(9009068.3,"","BX",DEF,"","","ERROR")
+25 ;I AGIEN=0 S BMXSEC="RPC Failed: Passed in window name "_DEF_" not found" Q
+26 ;
+27 ;S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2),SECFILE=$P(^AGG(9009068.3,AGIEN,0),U,14)
+28 ;
+29 SET VAL=$$VAL(DFN)
SET MSG=$PIECE(VAL,U,2)
SET VAL=$PIECE(VAL,U)
+30 IF VAL=-1
SET RESULT=-1
DO SET
QUIT
+31 ;
+32 NEW USER
+33 ; Attempt lock and set RESULT accordingly
+34 SET RESULT=1
+35 LOCK +^DPT(DFN):1
IF '$TEST
SET RESULT=0
+36 LOCK +^AUPNPAT(DFN):1
IF '$TEST
SET RESULT=0
LOCK -^DPT(DFN)
+37 ; figure out what to lock
+38 ;
+39 ;
LST ; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.
+1 IF RESULT=0
Begin DoDot:1
+2 SET USER=$PIECE($GET(^XTMP("AGGLCK",DFN)),"^")
+3 SET NAME=$$GET1^DIQ(200,USER,.01,"E")
+4 IF NAME=""
SET NAME="an unknown user"
+5 SET MSG="This event is locked for editing by "_NAME_"."
End DoDot:1
+6 ; If lock is successful, update 'LAST LOCKED BY' in ^XTMP.
+7 IF RESULT=1
Begin DoDot:1
+8 SET ^XTMP("AGGLCK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of Reg data"
+9 SET CNT=+$PIECE($GET(^XTMP("AGGLCK",DFN)),"^",2)+1
+10 SET ^XTMP("AGGLCK",DFN)=DUZ_"^"_CNT
End DoDot:1
+11 ;
+12 DO SET
+13 QUIT
+14 ;
UNLOCK(DATA,DFN) ; EP - AGG UNLOCK PATIENT
+1 ; Input
+2 ; DFN - Patient IEN
+3 ;
+4 ; Output:
+5 ; DATA = name of global (passed by reference) in which the data is stored
+6 ; RESULT = 1 (unlock will always succeed)
+7 ; RESULT = -1 if invalid patient IEN (shouldn't happen)
+8 ; or
+9 ; BMXSEC - if M error encountered
+10 ;
+11 NEW UID,X,II,MSG,VAL
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("AGGLCK",UID))
+14 KILL @DATA
+15 ;
+16 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGLOCK D UNWIND^%ZTER"
+17 ;
+18 ; Create header record
+19 SET II=0
SET @DATA@(II)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+20 NEW RESULT,USER
+21 SET VAL=$$VAL(DFN)
SET MSG=$PIECE(VAL,U,2)
SET VAL=$PIECE(VAL,U)
+22 IF VAL=-1
SET RESULT=-1
DO SET
QUIT
+23 ;
+24 ; Unlock and set RESULT
+25 DO UNL(DFN)
+26 SET RESULT=1
+27 DO SET
+28 QUIT
+29 ;
SET ; Report results
+1 SET II=II+1
SET @DATA@(II)=RESULT_"^"_$GET(MSG)_$CHAR(30)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 DO UNL(DFN)
+7 QUIT
+8 ;
VAL(IEN) ; Validate RECORD ien
+1 IF $GET(^DPT(IEN,0))=""
QUIT "-1^Invalid Patient selected"
+2 IF $GET(^AUPNPAT(IEN,0))=""
QUIT "-1^Invalid Patient selected"
+3 QUIT 1
+4 ;
UNL(DFN) ;
+1 IF $GET(DFN)=""
QUIT
+2 ; Get 'LAST LOCKED BY'.
+3 NEW DAT,CNT
+4 SET DAT=$GET(^XTMP("AGGLCK",DFN))
+5 SET USER=$PIECE(DAT,"^")
+6 SET CNT=+$PIECE(DAT,"^",2)
+7 ;
+8 ; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
+9 IF USER=DUZ
KILL ^XTMP("AGGLCK",DFN)
+10 FOR I=1:1:CNT
LOCK -^AUPNPAT(DFN),-^DPT(DFN)
+11 QUIT
