AGGLOCK.m

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