BQIPLLK.m

BQIPLLK ;VNGT/HS/KJH-Panel Lock/Unlock Functions ; 23 Feb 2006  5:08 PM

 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 ;

 Q

 ;

LOCK(DATA,OWNR,PLIEN) ; EP -- BQI LOCK PANEL

 ; Description

 ;   Attempt to lock the panel specified by OWNR and PLIEN 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:

 ;   OWNR   - Owner of the panel to be locked

 ;   PLIEN  - Panel 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

 ;   USER   = DUZ of the last user to successfully lock this panel

 ; or

 ;   BMXSEC - if $D(ERROR) when filing or M error encountered

 ;            

 N UID,X,BQII

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLLK",UID))

 K ^TMP("BQIPLLK",UID)

 ;

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 ; Create header record

 S BQII=0,^TMP("BQIPLLK",UID,BQII)="I00010RESULT^I00010USER^T00035NAME"_$C(30)

 ;

 ; Check for existence of the panel. (May have been edited/deleted by owner while share had it on their list.)

 I $G(PLIEN)="" S BMXSEC="RPC Call Failed: Panel does not exist. May have been edited by another user." Q

 I '$D(^BQICARE(OWNR,1,PLIEN,0)) S BMXSEC="RPC Call Failed: Panel does not exist. May have been edited by another user." Q

 ;

 N DA,IENS,RESULT,USER,NAME,ERROR

 S DA=PLIEN,DA(1)=OWNR,IENS=$$IENS^DILF(.DA),USER=""

 ;

 ; Attempt lock and set RESULT accordingly

 S RESULT=1

 L +^BQICARE(OWNR,1,PLIEN,0):1 E  S RESULT=0

 ;

 ; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.

 I RESULT=0 S USER=$$GET1^DIQ(90505.01,IENS,.16,"I")

 ;

 ; If lock is successful, update 'LAST LOCKED BY' on the panel.

 I RESULT=1 D

 . N BQINEW

 . S (BQINEW(90505.01,IENS,.16),USER)=DUZ

 . D FILE^DIE("","BQINEW","ERROR")

 . I $D(ERROR) S BMXSEC="RPC Call Failed: Error encountered while updating user last locked." Q

 . Q

 ;

 ; If an error occurred after the lock was set then unlock and quit.

 I $G(BMXSEC)'="" L -^BQICARE(OWNR,1,PLIEN,0) Q

 ;

 ; Get user name (if available)

 S NAME=$$GET1^DIQ(200,USER,.01,"E")

 I NAME="" S NAME="an unknown user"

 ;

 ; Report results

 S BQII=BQII+1,^TMP("BQIPLLK",UID,BQII)=RESULT_"^"_USER_"^"_NAME_$C(30)

 S BQII=BQII+1,^TMP("BQIPLLK",UID,BQII)=$C(31)

 Q

 ;

UNLOCK(DATA,OWNR,PLIEN) ; EP -- BQI UNLOCK PANEL

 ; Description

 ;   Unlock the panel specified by OWNR and PLIEN 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:

 ;   OWNR   - Owner of the panel to be unlocked

 ;   PLIEN  - Panel IEN to be unlocked

 ; Output:

 ;   DATA  = name of global (passed by reference) in which the data is stored

 ;

 ;   RESULT = 1 (unlock will always succeed)

 ; or

 ;   BMXSEC - if $D(ERROR) when filing or M error encountered

 ;            

 N UID,X,BQII

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLLK",UID))

 K ^TMP("BQIPLLK",UID)

 ;

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 ; Create header record

 S BQII=0,^TMP("BQIPLLK",UID,BQII)="I00010RESULT"_$C(30)

 ;

 N DA,IENS,RESULT,USER,ERROR

 S DA=PLIEN,DA(1)=OWNR,IENS=$$IENS^DILF(.DA)

 ;

 ; Get 'LAST LOCKED BY' from the panel.

 S USER=$$GET1^DIQ(90505.01,IENS,.16,"I")

 ;

 ; If 'LAST LOCKED BY' is this DUZ then delete it from the panel.

 I USER=DUZ D

 . N BQINEW

 . S BQINEW(90505.01,IENS,.16)="@"

 . D FILE^DIE("","BQINEW","ERROR")

 . I $D(ERROR) S BMXSEC="RPC Call Failed: Error encountered while updating user last locked." Q

 . Q

 ;

 ; Unlock and set RESULT

 S RESULT=1

 L -^BQICARE(OWNR,1,PLIEN,0)

 ;

 ; Report results

 S BQII=BQII+1,^TMP("BQIPLLK",UID,BQII)=RESULT_$C(30)

 S BQII=BQII+1,^TMP("BQIPLLK",UID,BQII)=$C(31)

 Q

 ;

ERR ;

 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

 ;

ULK(DATA,OWNR) ; EP -- BQI LOCK ICARE USER

 ; Input:

 ;   OWNR   - Owner of the panel to be locked

 ;   

 ;   RESULT = 1 if the lock succeeded

 ;          = 0 if the lock failed

 NEW UID,X,BQII,RESULT

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLULK",UID))

 K @DATA

 S BQII=0,OWNR=$G(OWNR,DUZ)

 ;

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 ; Create header record

 S @DATA@(BQII)="I00010RESULT"_$C(30)

 ;

 ; Attempt lock and set RESULT accordingly

 S RESULT=1

 L +^BQICARE(OWNR,0):1 E  S RESULT=0

 ;

 ; Report results

 S BQII=BQII+1,@DATA@(BQII)=RESULT_$C(30)

 S BQII=BQII+1,@DATA@(BQII)=$C(31)

 Q

 ;

UULK(DATA,OWNR) ; EP -- BQI UNLOCK ICARE USER

 NEW UID,X,BQII,RESULT

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLUULK",UID))

 K @DATA

 S BQII=0,OWNR=$G(OWNR,DUZ)

 ;

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 ; Create header record

 S @DATA@(BQII)="I00010RESULT"_$C(30)

 ;

 ; Unlock and set RESULT

 S RESULT=1

 L -^BQICARE(OWNR,0)

 ;

 ; Report results

 S BQII=BQII+1,@DATA@(BQII)=RESULT_$C(30)

 S BQII=BQII+1,@DATA@(BQII)=$C(31)

 Q

BQIPLLK   ;VNGT/HS/KJH-Panel Lock/Unlock Functions ; 23 Feb 2006  5:08 PM

 +1       ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 +2       ;

 +3        QUIT 

 +4       ;

LOCK(DATA,OWNR,PLIEN) ; EP -- BQI LOCK PANEL

 +1       ; Description

 +2       ;   Attempt to lock the panel specified by OWNR and PLIEN 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       ;   OWNR   - Owner of the panel to be locked

 +10      ;   PLIEN  - Panel IEN to be locked

 +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      ;   USER   = DUZ of the last user to successfully lock this panel

 +17      ; or

 +18      ;   BMXSEC - if $D(ERROR) when filing or M error encountered

 +19      ;            

 +20       NEW UID,X,BQII

 +21       SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +22       SET DATA=$NAME(^TMP("BQIPLLK",UID))

 +23       KILL ^TMP("BQIPLLK",UID)

 +24      ;

 +25      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLLK D UNWIND^%ZTER"

 +26      ;

 +27      ; Create header record

 +28       SET BQII=0

           SET ^TMP("BQIPLLK",UID,BQII)="I00010RESULT^I00010USER^T00035NAME"_$CHAR(30)

 +29      ;

 +30      ; Check for existence of the panel. (May have been edited/deleted by owner while share had it on their list.)

 +31       IF $GET(PLIEN)=""

               SET BMXSEC="RPC Call Failed: Panel does not exist. May have been edited by another user."

               QUIT 

 +32       IF '$DATA(^BQICARE(OWNR,1,PLIEN,0))

               SET BMXSEC="RPC Call Failed: Panel does not exist. May have been edited by another user."

               QUIT 

 +33      ;

 +34       NEW DA,IENS,RESULT,USER,NAME,ERROR

 +35       SET DA=PLIEN

           SET DA(1)=OWNR

           SET IENS=$$IENS^DILF(.DA)

           SET USER=""

 +36      ;

 +37      ; Attempt lock and set RESULT accordingly

 +38       SET RESULT=1

 +39       LOCK +^BQICARE(OWNR,1,PLIEN,0):1

          IF '$TEST

               SET RESULT=0

 +40      ;

 +41      ; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.

 +42       IF RESULT=0

               SET USER=$$GET1^DIQ(90505.01,IENS,.16,"I")

 +43      ;

 +44      ; If lock is successful, update 'LAST LOCKED BY' on the panel.

 +45       IF RESULT=1

               Begin DoDot:1

 +46               NEW BQINEW

 +47               SET (BQINEW(90505.01,IENS,.16),USER)=DUZ

 +48               DO FILE^DIE("","BQINEW","ERROR")

 +49               IF $DATA(ERROR)

                       SET BMXSEC="RPC Call Failed: Error encountered while updating user last locked."

                       QUIT 

 +50               QUIT 

               End DoDot:1

 +51      ;

 +52      ; If an error occurred after the lock was set then unlock and quit.

 +53       IF $GET(BMXSEC)'=""

               LOCK -^BQICARE(OWNR,1,PLIEN,0)

               QUIT 

 +54      ;

 +55      ; Get user name (if available)

 +56       SET NAME=$$GET1^DIQ(200,USER,.01,"E")

 +57       IF NAME=""

               SET NAME="an unknown user"

 +58      ;

 +59      ; Report results

 +60       SET BQII=BQII+1

           SET ^TMP("BQIPLLK",UID,BQII)=RESULT_"^"_USER_"^"_NAME_$CHAR(30)

 +61       SET BQII=BQII+1

           SET ^TMP("BQIPLLK",UID,BQII)=$CHAR(31)

 +62       QUIT 

 +63      ;

UNLOCK(DATA,OWNR,PLIEN) ; EP -- BQI UNLOCK PANEL

 +1       ; Description

 +2       ;   Unlock the panel specified by OWNR and PLIEN 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       ;   OWNR   - Owner of the panel to be unlocked

 +8       ;   PLIEN  - Panel IEN to be unlocked

 +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 $D(ERROR) when filing or M error encountered

 +15      ;            

 +16       NEW UID,X,BQII

 +17       SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +18       SET DATA=$NAME(^TMP("BQIPLLK",UID))

 +19       KILL ^TMP("BQIPLLK",UID)

 +20      ;

 +21      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLLK D UNWIND^%ZTER"

 +22      ;

 +23      ; Create header record

 +24       SET BQII=0

           SET ^TMP("BQIPLLK",UID,BQII)="I00010RESULT"_$CHAR(30)

 +25      ;

 +26       NEW DA,IENS,RESULT,USER,ERROR

 +27       SET DA=PLIEN

           SET DA(1)=OWNR

           SET IENS=$$IENS^DILF(.DA)

 +28      ;

 +29      ; Get 'LAST LOCKED BY' from the panel.

 +30       SET USER=$$GET1^DIQ(90505.01,IENS,.16,"I")

 +31      ;

 +32      ; If 'LAST LOCKED BY' is this DUZ then delete it from the panel.

 +33       IF USER=DUZ

               Begin DoDot:1

 +34               NEW BQINEW

 +35               SET BQINEW(90505.01,IENS,.16)="@"

 +36               DO FILE^DIE("","BQINEW","ERROR")

 +37               IF $DATA(ERROR)

                       SET BMXSEC="RPC Call Failed: Error encountered while updating user last locked."

                       QUIT 

 +38               QUIT 

               End DoDot:1

 +39      ;

 +40      ; Unlock and set RESULT

 +41       SET RESULT=1

 +42       LOCK -^BQICARE(OWNR,1,PLIEN,0)

 +43      ;

 +44      ; Report results

 +45       SET BQII=BQII+1

           SET ^TMP("BQIPLLK",UID,BQII)=RESULT_$CHAR(30)

 +46       SET BQII=BQII+1

           SET ^TMP("BQIPLLK",UID,BQII)=$CHAR(31)

 +47       QUIT 

 +48      ;

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        QUIT 

 +6       ;

ULK(DATA,OWNR) ; EP -- BQI LOCK ICARE USER

 +1       ; Input:

 +2       ;   OWNR   - Owner of the panel to be locked

 +3       ;   

 +4       ;   RESULT = 1 if the lock succeeded

 +5       ;          = 0 if the lock failed

 +6        NEW UID,X,BQII,RESULT

 +7        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +8        SET DATA=$NAME(^TMP("BQIPLULK",UID))

 +9        KILL @DATA

 +10       SET BQII=0

           SET OWNR=$GET(OWNR,DUZ)

 +11      ;

 +12      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLLK D UNWIND^%ZTER"

 +13      ;

 +14      ; Create header record

 +15       SET @DATA@(BQII)="I00010RESULT"_$CHAR(30)

 +16      ;

 +17      ; Attempt lock and set RESULT accordingly

 +18       SET RESULT=1

 +19       LOCK +^BQICARE(OWNR,0):1

          IF '$TEST

               SET RESULT=0

 +20      ;

 +21      ; Report results

 +22       SET BQII=BQII+1

           SET @DATA@(BQII)=RESULT_$CHAR(30)

 +23       SET BQII=BQII+1

           SET @DATA@(BQII)=$CHAR(31)

 +24       QUIT 

 +25      ;

UULK(DATA,OWNR) ; EP -- BQI UNLOCK ICARE USER

 +1        NEW UID,X,BQII,RESULT

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("BQIPLUULK",UID))

 +4        KILL @DATA

 +5        SET BQII=0

           SET OWNR=$GET(OWNR,DUZ)

 +6       ;

 +7       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLLK D UNWIND^%ZTER"

 +8       ;

 +9       ; Create header record

 +10       SET @DATA@(BQII)="I00010RESULT"_$CHAR(30)

 +11      ;

 +12      ; Unlock and set RESULT

 +13       SET RESULT=1

 +14       LOCK -^BQICARE(OWNR,0)

 +15      ;

 +16      ; Report results

 +17       SET BQII=BQII+1

           SET @DATA@(BQII)=RESULT_$CHAR(30)

 +18       SET BQII=BQII+1

           SET @DATA@(BQII)=$CHAR(31)

 +19       QUIT