BQIDCLK.m

BQIDCLK ;PRXM/HC/DB-Patient Diagnostic Tag Lock/Unlock Functions ; 18 Mar 2008  4:03 PM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 ;

 Q

 ;

LOCK(DATA,DFN,DCAT) ; EP - BQI LOCK PATIENT BY DX TAG

 ; Description

 ;   Attempt to lock a patient diagnostic tag record specified by DCAT 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

 ;   DCAT    - Diagnostic tag defined in ^BQI(90506.2

 ;

 ; 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

 ;            

 N UID,X,BQII,MSG,RESULT,DCATIEN

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

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

 K ^TMP("BQIDCLK",UID)

 ;

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

 ;

 ; Create header record

 S BQII=0,@DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)

 ;

 S MSG=""

 ; If adding register information create temporary ien for locking

 S DCATIEN=$O(^BQI(90506.2,"B",DCAT,"")) I DCATIEN="" D INV Q

 ; Subdefinitions (risk factors that are not standalone) are not valid here

 I $$GET1^DIQ(90506.2,DCATIEN_",",.05,"I") D INV Q

 ;

 N USER

 ;

 ; Attempt lock and set RESULT accordingly

 S RESULT=1

 L +^BQIREG(DCAT,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("BQIDCLK",DCAT,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("BQIDCLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of patient register data"

 . S ^XTMP("BQIDCLK",DCAT,DFN)=DUZ

 ;

 D UPD

 Q

 ;

UNLOCK(DATA,DFN,DCAT) ; EP - BQI UNLOCK PATIENT BY DX TAG

 ; Description

 ;   Unlock the patient diagnostic tag record specified by DCAT 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

 ;   DCAT    - Diagnostic tag defined in ^BQI(90506.2

 ; 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

 ;            

 N UID,X,BQII,MSG,REGIEN,RDATA

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

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

 K ^TMP("BQIDCLK",UID)

 ;

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIDCLK 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("BQIDCLK",DCAT,DFN))

 ;

 ; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.

 I USER=DUZ K ^XTMP("BQIDCLK",DCAT,DFN)

 ;

 ; Unlock and set RESULT

 S RESULT=1

 L -^BQIREG(DCAT,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

 ;

INV ; Invalid dx tag passed - either a subdefinition or not in the file

 S MSG="Invalid diagnostic tag selected.",RESULT=-1

 D UPD

 Q

 ;

ERR ;

 L

 I $G(DCAT)'="",$G(DFN)'="",$G(^XTMP("BQIDCLK",DCAT,DFN))=DUZ K ^XTMP("BQIDCLK",DCAT,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

BQIDCLK   ;PRXM/HC/DB-Patient Diagnostic Tag Lock/Unlock Functions ; 18 Mar 2008  4:03 PM

 +1       ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

 +3        QUIT 

 +4       ;

LOCK(DATA,DFN,DCAT) ; EP - BQI LOCK PATIENT BY DX TAG

 +1       ; Description

 +2       ;   Attempt to lock a patient diagnostic tag record specified by DCAT 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      ;   DCAT    - Diagnostic tag defined in ^BQI(90506.2

 +11      ;

 +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 DCAT (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,RESULT,DCATIEN

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

 +24       SET DATA=$NAME(^TMP("BQIDCLK",UID))

 +25       KILL ^TMP("BQIDCLK",UID)

 +26      ;

 +27      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +28      ;

 +29      ; Create header record

 +30       SET BQII=0

           SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)

 +31      ;

 +32       SET MSG=""

 +33      ; If adding register information create temporary ien for locking

 +34       SET DCATIEN=$ORDER(^BQI(90506.2,"B",DCAT,""))

           IF DCATIEN=""

               DO INV

               QUIT 

 +35      ; Subdefinitions (risk factors that are not standalone) are not valid here

 +36       IF $$GET1^DIQ(90506.2,DCATIEN_",",.05,"I")

               DO INV

               QUIT 

 +37      ;

 +38       NEW USER

 +39      ;

 +40      ; Attempt lock and set RESULT accordingly

 +41       SET RESULT=1

 +42       LOCK +^BQIREG(DCAT,DFN):1

          IF '$TEST

               SET RESULT=0

 +43      ;

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

 +45       IF RESULT=0

               Begin DoDot:1

 +46               SET USER=$GET(^XTMP("BQIDCLK",DCAT,DFN))

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

 +48               IF NAME=""

                       SET NAME="an unknown user"

 +49               SET MSG="This record is currently being updated by "_NAME_"."

               End DoDot:1

 +50      ; If lock is successful, update 'LAST LOCKED BY' in ^XTMP.

 +51       IF RESULT=1

               Begin DoDot:1

 +52               SET ^XTMP("BQIDCLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of patient register data"

 +53               SET ^XTMP("BQIDCLK",DCAT,DFN)=DUZ

               End DoDot:1

 +54      ;

 +55       DO UPD

 +56       QUIT 

 +57      ;

UNLOCK(DATA,DFN,DCAT) ; EP - BQI UNLOCK PATIENT BY DX TAG

 +1       ; Description

 +2       ;   Unlock the patient diagnostic tag record specified by DCAT 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       ;   DCAT    - Diagnostic tag defined in ^BQI(90506.2

 +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       NEW UID,X,BQII,MSG,REGIEN,RDATA

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

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

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

 +20      ;

 +21      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +22      ;

 +23      ; Create header record

 +24       SET BQII=0

           SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)

 +25      ;

 +26       NEW RESULT,USER

 +27      ;

 +28       SET MSG=""

 +29      ; Get 'LAST LOCKED BY'.

 +30       SET USER=$GET(^XTMP("BQIDCLK",DCAT,DFN))

 +31      ;

 +32      ; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.

 +33       IF USER=DUZ

               KILL ^XTMP("BQIDCLK",DCAT,DFN)

 +34      ;

 +35      ; Unlock and set RESULT

 +36       SET RESULT=1

 +37       LOCK -^BQIREG(DCAT,DFN)

 +38      ;

 +39       DO UPD

 +40       QUIT 

 +41      ;

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       ;

INV       ; Invalid dx tag passed - either a subdefinition or not in the file

 +1        SET MSG="Invalid diagnostic tag selected."

           SET RESULT=-1

 +2        DO UPD

 +3        QUIT 

 +4       ;

ERR       ;

 +1        LOCK 

 +2        IF $GET(DCAT)'=""

               IF $GET(DFN)'=""

                   IF $GET(^XTMP("BQIDCLK",DCAT,DFN))=DUZ

                       KILL ^XTMP("BQIDCLK",DCAT,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