- BQIULLK ;PRXM/HC/DB-Miscellaneous BQI utilities - Lock/Unlock Functions ; 28 May 2008 4:03 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- Q
- ;
- LOCK(DATA,DFN,TYPE) ; EP - BQI LOCK RECORD BY TYPE
- ; Description
- ; Attempt to lock a record type (problem, family history, etc.) for a patient
- ; 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
- ; TYPE - Type of record to be locked for this patient
- ;
- ; 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
- ;
- I $G(TYPE)="" S BMXSEC="Invalid record type passed." Q
- N UID,X,BQII,MSG,RESULT,DCATIEN
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIULLK"_$E(TYPE,1,5),UID))
- K ^TMP("BQIULLK"_$E(TYPE,1,5),UID)
- ;
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIULLK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- ; Create header record
- S BQII=0,@DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)
- ;
- S MSG=""
- N USER
- ;
- ; Attempt lock and set RESULT accordingly
- S RESULT=1
- L +^BQILOCK(TYPE,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("BQIULLK",TYPE,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("BQIULLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of "_TYPE_" data"
- . S ^XTMP("BQIULLK",TYPE,DFN)=DUZ
- ;
- D UPD
- Q
- ;
- UNLOCK(DATA,DFN,TYPE) ; EP - BQI UNLOCK RECORD BY TYPE
- ; Description
- ; Unlock a record type (problem, family history, etc. - specified by TYPE)
- ; for a patient 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
- ; TYPE - Type of record to be locked for this patient
- ; 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
- ;
- I $G(TYPE)="" S BMXSEC="Invalid record type passed." Q
- N UID,X,BQII,MSG,REGIEN,RDATA
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIULLK"_$E(TYPE,1,5),UID))
- K ^TMP("BQIULLK"_$E(TYPE,1,5),UID)
- ;
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIULLK 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("BQIULLK",TYPE,DFN))
- ;
- ; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
- I USER=DUZ K ^XTMP("BQIULLK",TYPE,DFN)
- ;
- ; Unlock and set RESULT
- S RESULT=1
- L -^BQILOCK(TYPE,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
- ;
- ERR ;
- L
- I $G(DCAT)'="",$G(DFN)'="",$G(^XTMP("BQIULLK",TYPE,DFN))=DUZ K ^XTMP("BQIULLK",TYPE,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
- BQIULLK ;PRXM/HC/DB-Miscellaneous BQI utilities - Lock/Unlock Functions ; 28 May 2008 4:03 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- +3 QUIT
- +4 ;
- LOCK(DATA,DFN,TYPE) ; EP - BQI LOCK RECORD BY TYPE
- +1 ; Description
- +2 ; Attempt to lock a record type (problem, family history, etc.) for a patient
- +3 ; If successful, sets 'LAST LOCKED BY' with the current DUZ
- +4 ; and returns a RESULT of 1 and the current DUZ.
- +5 ; If unsuccessful, returns a RESULT of 0 and the DUZ from the
- +6 ; 'LAST LOCKED BY' field.
- +7 ; Input:
- +8 ; DFN - Patient IEN
- +9 ; TYPE - Type of record to be locked for this patient
- +10 ;
- +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 ; = -1 if problem identified with DCAT (shouldn't happen)
- +17 ; USER = DUZ of the last user to successfully lock this panel
- +18 ; or
- +19 ; BMXSEC - if M error encountered
- +20 ;
- +21 IF $GET(TYPE)=""
- SET BMXSEC="Invalid record type passed."
- QUIT
- +22 NEW UID,X,BQII,MSG,RESULT,DCATIEN
- +23 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +24 SET DATA=$NAME(^TMP("BQIULLK"_$EXTRACT(TYPE,1,5),UID))
- +25 KILL ^TMP("BQIULLK"_$EXTRACT(TYPE,1,5),UID)
- +26 ;
- +27 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIULLK D UNWIND^%ZTER"
- +28 ;
- +29 ; Create header record
- +30 SET BQII=0
- SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
- +31 ;
- +32 SET MSG=""
- +33 NEW USER
- +34 ;
- +35 ; Attempt lock and set RESULT accordingly
- +36 SET RESULT=1
- +37 LOCK +^BQILOCK(TYPE,DFN):1
- IF '$TEST
- SET RESULT=0
- +38 ;
- +39 ; If lock is unsuccessful, get 'LAST LOCKED BY' from the panel.
- +40 IF RESULT=0
- Begin DoDot:1
- +41 SET USER=$GET(^XTMP("BQIULLK",TYPE,DFN))
- +42 SET NAME=$$GET1^DIQ(200,USER,.01,"E")
- +43 IF NAME=""
- SET NAME="an unknown user"
- +44 SET MSG="This record is currently being updated by "_NAME_"."
- End DoDot:1
- +45 ; If lock is successful, update 'LAST LOCKED BY' in ^XTMP.
- +46 IF RESULT=1
- Begin DoDot:1
- +47 SET ^XTMP("BQIULLK",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()_U_"Maintain locked by information for current locks of "_TYPE_" data"
- +48 SET ^XTMP("BQIULLK",TYPE,DFN)=DUZ
- End DoDot:1
- +49 ;
- +50 DO UPD
- +51 QUIT
- +52 ;
- UNLOCK(DATA,DFN,TYPE) ; EP - BQI UNLOCK RECORD BY TYPE
- +1 ; Description
- +2 ; Unlock a record type (problem, family history, etc. - specified by TYPE)
- +3 ; for a patient 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 ; TYPE - Type of record to be locked for this patient
- +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 IF $GET(TYPE)=""
- SET BMXSEC="Invalid record type passed."
- QUIT
- +17 NEW UID,X,BQII,MSG,REGIEN,RDATA
- +18 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +19 SET DATA=$NAME(^TMP("BQIULLK"_$EXTRACT(TYPE,1,5),UID))
- +20 KILL ^TMP("BQIULLK"_$EXTRACT(TYPE,1,5),UID)
- +21 ;
- +22 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIULLK D UNWIND^%ZTER"
- +23 ;
- +24 ; Create header record
- +25 SET BQII=0
- SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
- +26 ;
- +27 NEW RESULT,USER
- +28 ;
- +29 SET MSG=""
- +30 ; Get 'LAST LOCKED BY'.
- +31 SET USER=$GET(^XTMP("BQIULLK",TYPE,DFN))
- +32 ;
- +33 ; If 'LAST LOCKED BY' is this DUZ then delete the lock entry from ^XTMP.
- +34 IF USER=DUZ
- KILL ^XTMP("BQIULLK",TYPE,DFN)
- +35 ;
- +36 ; Unlock and set RESULT
- +37 SET RESULT=1
- +38 LOCK -^BQILOCK(TYPE,DFN)
- +39 ;
- +40 DO UPD
- +41 QUIT
- +42 ;
- 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 ;
- ERR ;
- +1 LOCK
- +2 IF $GET(DCAT)'=""
- IF $GET(DFN)'=""
- IF $GET(^XTMP("BQIULLK",TYPE,DFN))=DUZ
- KILL ^XTMP("BQIULLK",TYPE,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