BQIPLRP ;PRXM/HC/KJH-Replace Panel Functions ; 24 Jan 2006 5:38 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(DATA,OWNR,PLIEN,ASSOC,PLNM) ; EP - BQI REPLACE PANEL
; Description
; Replaces the original panel (PLIEN) with the new associated panel (ASSOC).
; Various data is copied from the original panel to the new panel and then
; the original panel is deleted. The new panel may optionally be renamed
; during the process. Otherwise, it will assume the name of the original.
; Input:
; OWNR - Owner of the panel
; PLIEN - Original panel IEN
; ASSOC - New associated panel IEN
; PLNM - New panel name (optional)
; Output:
; DATA = name of global (passed by reference) in which the data is stored
;
; RESULT = 1 if the process completed
; or
; BMXSEC - if records can't be locked or 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("BQIPLRP",UID))
K ^TMP("BQIPLRP",UID)
;
; Check if share and has write access
I '$$CKSHR^BQIPLSH(OWNR,PLIEN) S BMXSEC="You do not have write access" Q
I '$$CKSHR^BQIPLSH(OWNR,ASSOC) S BMXSEC="You do not have write access" Q
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; Create header record
S BQII=0,^TMP("BQIPLRP",UID,BQII)="I00010RESULT"_$C(30)
;
NEW DA,DIK,OIENS,IENS,BQIOLD,BQINEW,ERROR,TEXT,TMP
;
; Get information to be copied from 'original' panel
S DA=PLIEN,DA(1)=OWNR,OIENS=$$IENS^DILF(.DA)
;D GETS^DIQ(90505.01,OIENS,".01;.02","I","BQIOLD")
D GETS^DIQ(90505.01,OIENS,"*","I","BQIOLD")
;
D SHARE ; Send shared notifications
;
; Delete 'original' panel
S DIK="^BQICARE("_DA(1)_",1,"
D ^DIK
;
; Update information for 'new' panel
S DA=ASSOC,DA(1)=OWNR,IENS=$$IENS^DILF(.DA)
NEW FLDS
F FLDS=.03:.01:.12,.14,.16 I $$GET1^DIQ(90505.01,IENS,FLDS,"I")="",$G(BQIOLD(90505.01,OIENS,FLDS,"I"))'="" S BQINEW(90505.01,IENS,FLDS)=$G(BQIOLD(90505.01,OIENS,FLDS,"I"))
F FLDS=3.3:.1:3.7 I $$GET1^DIQ(90505.01,IENS,FLDS,"I")="",$G(BQIOLD(90505.01,OIENS,FLDS,"I"))'="" S BQINEW(90505.01,IENS,FLDS)=$G(BQIOLD(90505.01,OIENS,FLDS,"I"))
I $G(BQIOLD(90505.01,OIENS,.01,"I"))'="" S BQINEW(90505.01,IENS,.01)=$G(BQIOLD(90505.01,OIENS,.01,"I"))
I $G(BQIOLD(90505.01,OIENS,.02,"I"))'="" S BQINEW(90505.01,IENS,.02)=$G(BQIOLD(90505.01,OIENS,.02,"I"))
;
; Change name if new name was supplied.
; If new name is currently in use on another panel then just leave the old name.
I $G(PLNM)]"" D
. N DA,PIENS,ERROR
. S DA(1)=OWNR,DA=""
. S PIENS=$$IENS^DILF(.DA)
. S TMP=$$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")
. I TMP'=0 Q ; Name currently in use
. S BQINEW(90505.01,IENS,.01)=PLNM
. Q
;
; Remove 'associated IEN' and 'status' information
S BQINEW(90505.01,IENS,.13)="@"
S BQINEW(90505.01,IENS,.15)="@"
;
; Save information to 'new' panel
D FILE^DIE("","BQINEW","ERROR")
I $D(ERROR) S BMXSEC="Error encountered while replacing panel." Q
;
; Update message notification
S TEXT="Panel "_$$GET1^DIQ(90505.01,IENS,.01,"E")_" has been modified"
I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T" D UPD^BQINOTF(OWNR,ASSOC,TEXT)
; Report success
I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)="1"_$C(30)
I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
;
SHARE ; Compare share status from original and new panels and issue notifications
; PLIEN - Original panel IEN
; ASSOC - New associated panel IEN
N DA,SHR,SIENS,OSTA,NSTA,TEXT
S DA(2)=OWNR
S SHR=0
F S SHR=$O(^BQICARE(OWNR,1,PLIEN,30,SHR)) Q:'SHR D ; Shared node is DINUM'd
. I '$D(^BQICARE(OWNR,1,ASSOC,30,SHR)) D Q
.. ; Shared user was deleted
.. I SHR=DUZ D Q
... S TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been removed from sharing panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)
... D FIL^BQINOTF(OWNR,TEXT)
.. S TEXT="You have been deleted from sharing panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
.. D FIL^BQINOTF(SHR,TEXT)
. ;
. S DA=SHR,DA(1)=PLIEN,SIENS=$$IENS^DILF(.DA)
. S OSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
. S DA=SHR,DA(1)=ASSOC,SIENS=$$IENS^DILF(.DA)
. S NSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
. I NSTA="I",NSTA'=OSTA D
.. ; Inactive status notification
.. I SHR=DUZ D Q
... S TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been inactivated as a share for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
... D FIL^BQINOTF(OWNR,TEXT)
.. S TEXT="You have been inactivated as a share for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
.. D FIL^BQINOTF(SHR,TEXT)
.. ;
S SHR=0
F S SHR=$O(^BQICARE(OWNR,1,ASSOC,30,SHR)) Q:'SHR D ; Shared node is DINUM'd
. I '$D(^BQICARE(OWNR,1,PLIEN,30,SHR)) D Q
.. ; Shared user was added
.. S TEXT="You have been added as a shared user for Panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" by "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
.. I $P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)'="" D
... NEW DTSTRT,DTEND
... S DTSTRT=$P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)
... S DTEND=$P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,4)
... S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)
.. D FIL^BQINOTF(SHR,TEXT)
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
BQIPLRP ;PRXM/HC/KJH-Replace Panel Functions ; 24 Jan 2006 5:38 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(DATA,OWNR,PLIEN,ASSOC,PLNM) ; EP - BQI REPLACE PANEL
+1 ; Description
+2 ; Replaces the original panel (PLIEN) with the new associated panel (ASSOC).
+3 ; Various data is copied from the original panel to the new panel and then
+4 ; the original panel is deleted. The new panel may optionally be renamed
+5 ; during the process. Otherwise, it will assume the name of the original.
+6 ; Input:
+7 ; OWNR - Owner of the panel
+8 ; PLIEN - Original panel IEN
+9 ; ASSOC - New associated panel IEN
+10 ; PLNM - New panel name (optional)
+11 ; Output:
+12 ; DATA = name of global (passed by reference) in which the data is stored
+13 ;
+14 ; RESULT = 1 if the process completed
+15 ; or
+16 ; BMXSEC - if records can't be locked or if $D(ERROR)
+17 ; when filing or M error encountered
+18 ;
+19 NEW UID,X,BQII
+20 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+21 SET DATA=$NAME(^TMP("BQIPLRP",UID))
+22 KILL ^TMP("BQIPLRP",UID)
+23 ;
+24 ; Check if share and has write access
+25 IF '$$CKSHR^BQIPLSH(OWNR,PLIEN)
SET BMXSEC="You do not have write access"
QUIT
+26 IF '$$CKSHR^BQIPLSH(OWNR,ASSOC)
SET BMXSEC="You do not have write access"
QUIT
+27 ;
+28 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPLRP D UNWIND^%ZTER"
+29 ;
+30 ; Create header record
+31 SET BQII=0
SET ^TMP("BQIPLRP",UID,BQII)="I00010RESULT"_$CHAR(30)
+32 ;
+33 NEW DA,DIK,OIENS,IENS,BQIOLD,BQINEW,ERROR,TEXT,TMP
+34 ;
+35 ; Get information to be copied from 'original' panel
+36 SET DA=PLIEN
SET DA(1)=OWNR
SET OIENS=$$IENS^DILF(.DA)
+37 ;D GETS^DIQ(90505.01,OIENS,".01;.02","I","BQIOLD")
+38 DO GETS^DIQ(90505.01,OIENS,"*","I","BQIOLD")
+39 ;
+40 ; Send shared notifications
DO SHARE
+41 ;
+42 ; Delete 'original' panel
+43 SET DIK="^BQICARE("_DA(1)_",1,"
+44 DO ^DIK
+45 ;
+46 ; Update information for 'new' panel
+47 SET DA=ASSOC
SET DA(1)=OWNR
SET IENS=$$IENS^DILF(.DA)
+48 NEW FLDS
+49 FOR FLDS=.03:.01:.12,.14,.16
IF $$GET1^DIQ(90505.01,IENS,FLDS,"I")=""
IF $GET(BQIOLD(90505.01,OIENS,FLDS,"I"))'=""
SET BQINEW(90505.01,IENS,FLDS)=$GET(BQIOLD(90505.01,OIENS,FLDS,"I"))
+50 FOR FLDS=3.3:.1:3.7
IF $$GET1^DIQ(90505.01,IENS,FLDS,"I")=""
IF $GET(BQIOLD(90505.01,OIENS,FLDS,"I"))'=""
SET BQINEW(90505.01,IENS,FLDS)=$GET(BQIOLD(90505.01,OIENS,FLDS,"I"))
+51 IF $GET(BQIOLD(90505.01,OIENS,.01,"I"))'=""
SET BQINEW(90505.01,IENS,.01)=$GET(BQIOLD(90505.01,OIENS,.01,"I"))
+52 IF $GET(BQIOLD(90505.01,OIENS,.02,"I"))'=""
SET BQINEW(90505.01,IENS,.02)=$GET(BQIOLD(90505.01,OIENS,.02,"I"))
+53 ;
+54 ; Change name if new name was supplied.
+55 ; If new name is currently in use on another panel then just leave the old name.
+56 IF $GET(PLNM)]""
Begin DoDot:1
+57 NEW DA,PIENS,ERROR
+58 SET DA(1)=OWNR
SET DA=""
+59 SET PIENS=$$IENS^DILF(.DA)
+60 SET TMP=$$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")
+61 ; Name currently in use
IF TMP'=0
QUIT
+62 SET BQINEW(90505.01,IENS,.01)=PLNM
+63 QUIT
End DoDot:1
+64 ;
+65 ; Remove 'associated IEN' and 'status' information
+66 SET BQINEW(90505.01,IENS,.13)="@"
+67 SET BQINEW(90505.01,IENS,.15)="@"
+68 ;
+69 ; Save information to 'new' panel
+70 DO FILE^DIE("","BQINEW","ERROR")
+71 IF $DATA(ERROR)
SET BMXSEC="Error encountered while replacing panel."
QUIT
+72 ;
+73 ; Update message notification
+74 SET TEXT="Panel "_$$GET1^DIQ(90505.01,IENS,.01,"E")_" has been modified"
+75 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
DO UPD^BQINOTF(OWNR,ASSOC,TEXT)
+76 ; Report success
+77 IF $DATA(BQII)
IF $DATA(DATA)
SET BQII=BQII+1
SET @DATA@(BQII)="1"_$CHAR(30)
+78 IF $DATA(BQII)
IF $DATA(DATA)
SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+79 QUIT
+80 ;
SHARE ; Compare share status from original and new panels and issue notifications
+1 ; PLIEN - Original panel IEN
+2 ; ASSOC - New associated panel IEN
+3 NEW DA,SHR,SIENS,OSTA,NSTA,TEXT
+4 SET DA(2)=OWNR
+5 SET SHR=0
+6 ; Shared node is DINUM'd
FOR
SET SHR=$ORDER(^BQICARE(OWNR,1,PLIEN,30,SHR))
IF 'SHR
QUIT
Begin DoDot:1
+7 IF '$DATA(^BQICARE(OWNR,1,ASSOC,30,SHR))
Begin DoDot:2
+8 ; Shared user was deleted
+9 IF SHR=DUZ
Begin DoDot:3
+10 SET TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been removed from sharing panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)
+11 DO FIL^BQINOTF(OWNR,TEXT)
End DoDot:3
QUIT
+12 SET TEXT="You have been deleted from sharing panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+13 DO FIL^BQINOTF(SHR,TEXT)
End DoDot:2
QUIT
+14 ;
+15 SET DA=SHR
SET DA(1)=PLIEN
SET SIENS=$$IENS^DILF(.DA)
+16 SET OSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
+17 SET DA=SHR
SET DA(1)=ASSOC
SET SIENS=$$IENS^DILF(.DA)
+18 SET NSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
+19 IF NSTA="I"
IF NSTA'=OSTA
Begin DoDot:2
+20 ; Inactive status notification
+21 IF SHR=DUZ
Begin DoDot:3
+22 SET TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been inactivated as a share for panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+23 DO FIL^BQINOTF(OWNR,TEXT)
End DoDot:3
QUIT
+24 SET TEXT="You have been inactivated as a share for panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+25 DO FIL^BQINOTF(SHR,TEXT)
+26 ;
End DoDot:2
End DoDot:1
+27 SET SHR=0
+28 ; Shared node is DINUM'd
FOR
SET SHR=$ORDER(^BQICARE(OWNR,1,ASSOC,30,SHR))
IF 'SHR
QUIT
Begin DoDot:1
+29 IF '$DATA(^BQICARE(OWNR,1,PLIEN,30,SHR))
Begin DoDot:2
+30 ; Shared user was added
+31 SET TEXT="You have been added as a shared user for Panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" by "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+32 IF $PIECE(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)'=""
Begin DoDot:3
+33 NEW DTSTRT,DTEND
+34 SET DTSTRT=$PIECE(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)
+35 SET DTEND=$PIECE(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,4)
+36 SET TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)
End DoDot:3
+37 DO FIL^BQINOTF(SHR,TEXT)
End DoDot:2
QUIT
End DoDot:1
+38 QUIT
+39 ;
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
