BQIPLSH ;PRXM/HC/ALA - Panel Sharing Update ; 07 Nov 2005 3:53 PM
;;2.4;ICARE MANAGEMENT SYSTEM;**3**;Apr 01, 2015;Build 5
;
Q
;
EN(DATA,OWNR,PLIEN,WHO,ACTION,ACCESS,DTSTRT,DTEND,LTYPE,OVRRD) ; EP -- BQI UPDATE SHARE LIST BY PANEL
;Description
; Add/Update/Remove a panel share, given the owner ien, panel ien, WHO ien, share action flag, and access.
;
;Input
; OWNR - Owner of the panel
; PLIEN - Panel internal entry number
; WHO - internal entry number of who is being added as
; a share person
; ACTION - Action flag 'U' for update, 'D' for delete, 'A' for add
; ACCESS - Access flag 'R' for read only, 'RW' for read/write
; and 'I' for inactive
; DTSTRT - Start share date
; DTEND - End share date
; LTYPE - Layout Type (Y-Share All,N-No Sharing,A-Asthma,D-Patient,H-HIV/AIDS,R-Reminder,G-Nat'l Measures)
; (Q-Queued,T-Tracked,P-Planned)
; OVRRD - Override Flag (1-Override Shared User Layout, 0/Null-Do not Override)
;
;Output
; RESULT - 1 for Success, 0 for Failure, <0 for Error.
;
NEW UID,II,DFN,X,RESULT,OACTION,NDA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISHARE",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLSH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT"_$C(30)
;
S DTSTRT=$$DATE^BQIUL1($G(DTSTRT))
S DTEND=$$DATE^BQIUL1($G(DTEND))
S LTYPE=$G(LTYPE,"") S:LTYPE="" LTYPE="N"
S OVRRD=$G(OVRRD,"")
;
; Branch off to specific tag, depending on action.
S OACTION=ACTION ; Save original action - add is reset to update
I ACTION="A" S RESULT=$$ASHR() I RESULT>0 S ACTION="U"
I ACTION="D"!(ACTION="U") S RESULT=$$USHR()
S II=II+1,@DATA@(II)=RESULT_$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)
Q
;
ASHR() ;EP - Add a person to share a panel
;
;Description
; Adds a person to a panel owned by someone else
;
;Output
; Y - if -1, then it wasn't successful, otherwise it should
; be the same as the WHO since the field is DINUM'd
;
NEW DA,X,DINUM,DIC,DIE,DLAYGO,ERROR,Y
S DA(2)=OWNR,DA(1)=PLIEN,(X,DINUM)=WHO
S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",30,",DIE=DIC
S DLAYGO=90505.03,DIC(0)="LN",DIC("P")=DLAYGO
I '$D(^BQICARE(DA(2),1,DA(1),30,0)) S ^BQICARE(DA(2),1,DA(1),30,0)="^90505.03P^^"
K DO,DD D FILE^DICN S NDA=+Y
I NDA<1 Q NDA
;
; Update flags when sharing
NEW DFN
S DFN=0
F S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN D
. D UPU^BQIFLAG(DFN,WHO)
;
; Layout Sharing
I LTYPE]"" D I $D(ERROR) Q -1
. ;Update SHARE LAYOUTS field
. N DA,IENS,BQISHARE
. S DA(2)=OWNR,DA(1)=PLIEN,DA=WHO
. S IENS=$$IENS^DILF(.DA)
. S BQISHARE(90505.03,IENS,.05)=$S(LTYPE="N":0,1:1)
. D FILE^DIE("","BQISHARE","ERROR")
. ;
. ;Copy Layouts
. I LTYPE="N" Q
. D CPLAY
;
; Send notification
NEW TEXT,DA,IENS
S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
S TEXT="You have been added as a shared user for Panel "_$$GET1^DIQ(90505.01,IENS,.01,"E")_" by "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
I $G(DTSTRT)'="" S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)
;
I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
Q NDA
;
USHR() ;EP - Update a share record
;
;Description
; Update a share record with data
;
NEW DA,SIENS,BQISHRUP,ERROR,TEXT,IENS
S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
S DA(2)=OWNR,DA(1)=PLIEN,DA=WHO
S SIENS=$$IENS^DILF(.DA)
I ACTION="D" D
. S BQISHRUP(90505.03,SIENS,.01)="@"
. I WHO=DUZ D Q
.. S TEXT=$$GET1^DIQ(200,DUZ_",",.01,"E")_" has been removed from sharing panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)
.. I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" 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")
. I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
;
I ACTION="U" D
. I $G(ACCESS)="I",$$GET1^DIQ(90505.03,SIENS,.02,"I")'="I" D
.. I WHO=DUZ D Q
... S TEXT=$$GET1^DIQ(200,WHO_",",.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")
... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" 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")
.. I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
. I $G(ACCESS)'="I" D
.. N ODTST,ODTEND
.. S ODTST=$$GET1^DIQ(90505.03,SIENS,.03,"I")
.. S ODTEND=$$GET1^DIQ(90505.03,SIENS,.04,"I")
.. ; Date notifications should only be issued for an update
.. I OACTION="U",ODTST'=$G(DTSTRT)!(ODTEND'=$G(DTEND)) D
... I ODTEND,ODTEND<$G(DTSTRT) D Q ; reinstated share
.... I WHO=DUZ D Q
..... S TEXT=$$GET1^DIQ(200,WHO_",",.01,"E")_" has been reactivated as a share for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
..... I $G(DTSTRT)'="" S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
..... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(OWNR,TEXT)
.... S TEXT="You have been reactivated as a share for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
.... S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
.... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
... I WHO=DUZ D Q
.... S TEXT=$$GET1^DIQ(200,WHO_",",.01,"E")_"'s share dates have been changed for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
.... I $G(DTSTRT)'="" S TEXT=TEXT_". The new dates are "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
.... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(OWNR,TEXT)
... S TEXT="Your share dates have been changed for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
... S TEXT=TEXT_". The new dates are "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
. S BQISHRUP(90505.03,SIENS,.02)=$G(ACCESS)
. S BQISHRUP(90505.03,SIENS,.03)=$G(DTSTRT)
. S BQISHRUP(90505.03,SIENS,.04)=$G(DTEND)
D FILE^DIE("","BQISHRUP","ERROR")
I $D(ERROR) Q 0
Q 1
;
CKSHR(OWNR,PLIEN) ;EP -- Check the write rights of a shared person
;
;Description
; This function checks the write status of a shared user
;Input
; OWNR - Owner of the panel
; PLIEN - Panel internal entry number
;Output
; 1 - if okay to write to the panel
; 0 - if not okay to write to the panel
;
NEW DA,IENS,ACCESS
I DUZ=OWNR Q 1
S DA(2)=OWNR,DA(1)=PLIEN,DA=DUZ
S IENS=$$IENS^DILF(.DA)
S ACCESS=$$GET1^DIQ(90505.03,IENS,.02,"I")
I ACCESS="RW" Q 1
Q 0
;
CPLAY ;EP -- Copy Owner Layout to Shared User
;
;Description
; This function copies the layouts from the panel owner to the selected shared user
;
;N BQIUPD,ERROR,LAYDD,LAYFLD,OLAY,RESULT,SLAYDD,TMPIEN
;
;Set up dictionary/field values
; Templates
NEW TMPIEN,VWN
S TMPIEN=0
I $G(^BQICARE(OWNR,1,PLIEN,4,TMPIEN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN))="" D
. S ^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN)=^BQICARE(OWNR,1,PLIEN,4,TMPIEN)
. F S TMPIEN=$O(^BQICARE(OWNR,1,PLIEN,4,TMPIEN)) Q:'TMPIEN D
.. S TMPNM=$P($G(^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)),U) Q:TMPNM=""
.. I TMPNM'[" Default" Q
.. S ^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN,0)=^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)
; Patient
S VWN=0
I $G(^BQICARE(OWNR,1,PLIEN,20,VWN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN))="" D
. S ^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN)=^BQICARE(OWNR,1,PLIEN,20,VWN)
. F S VWN=$O(^BQICARE(OWNR,1,PLIEN,20,VWN)) Q:'VWN D
.. S ^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN,0)=^BQICARE(OWNR,1,PLIEN,20,VWN,0)
; Reminder
S VWN=0
I $G(^BQICARE(OWNR,1,PLIEN,22,VWN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN))="" D
. S ^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN)=^BQICARE(OWNR,1,PLIEN,22,VWN)
. F S VWN=$O(^BQICARE(OWNR,1,PLIEN,22,VWN)) Q:'VWN D
.. S ^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN,0)=^BQICARE(OWNR,1,PLIEN,22,VWN,0)
; Natl Measures
S VWN=0
I $G(^BQICARE(OWNR,1,PLIEN,25,VWN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN))="" D
. S ^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN)=^BQICARE(OWNR,1,PLIEN,25,VWN)
. F S VWN=$O(^BQICARE(OWNR,1,PLIEN,25,VWN)) Q:'VWN D
.. S ^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN,0)=^BQICARE(OWNR,1,PLIEN,25,VWN,0)
; Care Management
S VWN=0
I $G(^BQICARE(OWNR,1,PLIEN,23,VWN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN))="" D
. S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN)=^BQICARE(OWNR,1,PLIEN,23,VWN)
. F S VWN=$O(^BQICARE(OWNR,1,PLIEN,23,VWN)) Q:'VWN D
.. S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,0)=^BQICARE(OWNR,1,PLIEN,23,VWN,0)
.. S CVN=0
.. S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,1,CVN)=^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN)
.. F S CVN=$O(^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN)) Q:'CVN D
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,1,CVN,0)=^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN,0)
;
NEW DA,DIK
S DA=NDA,DA(1)=PLIEN,DA(2)=OWNR,DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",30,"
D IX1^DIK
;
;Non-default templates turn into customized
NEW TMPIEN,TMPNM,TN,TYP,CN,CMN,FILE,CVN
S TMPIEN=0
F S TMPIEN=$O(^BQICARE(OWNR,1,PLIEN,4,TMPIEN)) Q:'TMPIEN D
. S TMPNM=$P($G(^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)),"^",1) Q:TMPNM=""
. I TMPNM[" Default" Q
. S TN=$O(^BQICARE(OWNR,15,"B",TMPNM,"")) I TN="" Q
. S TYP=$P(^BQICARE(OWNR,15,TN,0),"^",2)
. S CN=$O(^BQI(90506.5,"C",TYP,"")) I CN="" Q
. S CMN=$P(^BQI(90506.5,CN,0),"^",1)
. S FILE=$P($G(^BQI(90506.5,CN,2)),"^",5) I FILE="" Q
. I FILE=90505.3231 D
.. S CNM=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,23,"B",CMN,""))
.. I CNM'="" S CVN=CNM I $O(^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,0))'="" Q
.. I CNM="" S CVN=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,23,"B"),-1),CVN=CVN+1
.. ;copy over the template into customized
.. I $G(^BQICARE(OWNR,1,PLIEN,30,NDA,23,0))="" S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,0)="^90505.123^"_CVN_"^"_CVN
.. S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,0)=CMN
.. S N=0 F S N=$O(^BQICARE(OWNR,15,TN,1,N)) Q:'N D
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,0)="^90505.1231^"_N_"^"_N
. I FILE=90505.322 D
.. S CMN=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,22,0)) I CMN'="" Q
.. S N=0 F S N=$O(^BQICARE(OWNR,15,TN,1,N)) Q:'N D
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,22,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,22,0)="90505.322^"_N_"^"_N
. I FILE=90505.06 D
.. S CMN=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,20,0)) I CMN'="" Q
.. S N=0 F S N=$O(^BQICARE(OWNR,15,TN,1,N)) Q:'N D
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,20,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,20,0)="90505.06^"_N_"^"_N
. I FILE=90505.325 D
.. S CMN=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,25,0)) I CMN'="" Q
.. S N=0 F S N=$O(^BQICARE(OWNR,15,TN,1,N)) Q:'N D
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,25,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
... S ^BQICARE(OWNR,1,PLIEN,30,NDA,25,0)="^90505.125^"_N_"^"_N
;
; Cross-reference
NEW DA,DIK
S DA=NDA,DA(1)=PLIEN,DA(2)=OWNR,DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",30,"
D IX1^DIK
;Check Override field
S:$G(OVRRD)'=1 OVRRD=0
;
;Initialize Result Variable
S RESULT=1
Q
BQIPLSH ;PRXM/HC/ALA - Panel Sharing Update ; 07 Nov 2005 3:53 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;**3**;Apr 01, 2015;Build 5
+2 ;
+3 QUIT
+4 ;
EN(DATA,OWNR,PLIEN,WHO,ACTION,ACCESS,DTSTRT,DTEND,LTYPE,OVRRD) ; EP -- BQI UPDATE SHARE LIST BY PANEL
+1 ;Description
+2 ; Add/Update/Remove a panel share, given the owner ien, panel ien, WHO ien, share action flag, and access.
+3 ;
+4 ;Input
+5 ; OWNR - Owner of the panel
+6 ; PLIEN - Panel internal entry number
+7 ; WHO - internal entry number of who is being added as
+8 ; a share person
+9 ; ACTION - Action flag 'U' for update, 'D' for delete, 'A' for add
+10 ; ACCESS - Access flag 'R' for read only, 'RW' for read/write
+11 ; and 'I' for inactive
+12 ; DTSTRT - Start share date
+13 ; DTEND - End share date
+14 ; LTYPE - Layout Type (Y-Share All,N-No Sharing,A-Asthma,D-Patient,H-HIV/AIDS,R-Reminder,G-Nat'l Measures)
+15 ; (Q-Queued,T-Tracked,P-Planned)
+16 ; OVRRD - Override Flag (1-Override Shared User Layout, 0/Null-Do not Override)
+17 ;
+18 ;Output
+19 ; RESULT - 1 for Success, 0 for Failure, <0 for Error.
+20 ;
+21 NEW UID,II,DFN,X,RESULT,OACTION,NDA
+22 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+23 SET DATA=$NAME(^TMP("BQISHARE",UID))
+24 KILL @DATA
+25 ;
+26 SET II=0
+27 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPLSH D UNWIND^%ZTER"
+28 ;
+29 SET @DATA@(II)="I00010RESULT"_$CHAR(30)
+30 ;
+31 SET DTSTRT=$$DATE^BQIUL1($GET(DTSTRT))
+32 SET DTEND=$$DATE^BQIUL1($GET(DTEND))
+33 SET LTYPE=$GET(LTYPE,"")
IF LTYPE=""
SET LTYPE="N"
+34 SET OVRRD=$GET(OVRRD,"")
+35 ;
+36 ; Branch off to specific tag, depending on action.
+37 ; Save original action - add is reset to update
SET OACTION=ACTION
+38 IF ACTION="A"
SET RESULT=$$ASHR()
IF RESULT>0
SET ACTION="U"
+39 IF ACTION="D"!(ACTION="U")
SET RESULT=$$USHR()
+40 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+41 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+42 ;
+43 QUIT
+44 ;
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 QUIT
+7 ;
ASHR() ;EP - Add a person to share a panel
+1 ;
+2 ;Description
+3 ; Adds a person to a panel owned by someone else
+4 ;
+5 ;Output
+6 ; Y - if -1, then it wasn't successful, otherwise it should
+7 ; be the same as the WHO since the field is DINUM'd
+8 ;
+9 NEW DA,X,DINUM,DIC,DIE,DLAYGO,ERROR,Y
+10 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET (X,DINUM)=WHO
+11 SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",30,"
SET DIE=DIC
+12 SET DLAYGO=90505.03
SET DIC(0)="LN"
SET DIC("P")=DLAYGO
+13 IF '$DATA(^BQICARE(DA(2),1,DA(1),30,0))
SET ^BQICARE(DA(2),1,DA(1),30,0)="^90505.03P^^"
+14 KILL DO,DD
DO FILE^DICN
SET NDA=+Y
+15 IF NDA<1
QUIT NDA
+16 ;
+17 ; Update flags when sharing
+18 NEW DFN
+19 SET DFN=0
+20 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+21 DO UPU^BQIFLAG(DFN,WHO)
End DoDot:1
+22 ;
+23 ; Layout Sharing
+24 IF LTYPE]""
Begin DoDot:1
+25 ;Update SHARE LAYOUTS field
+26 NEW DA,IENS,BQISHARE
+27 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=WHO
+28 SET IENS=$$IENS^DILF(.DA)
+29 SET BQISHARE(90505.03,IENS,.05)=$SELECT(LTYPE="N":0,1:1)
+30 DO FILE^DIE("","BQISHARE","ERROR")
+31 ;
+32 ;Copy Layouts
+33 IF LTYPE="N"
QUIT
+34 DO CPLAY
End DoDot:1
IF $DATA(ERROR)
QUIT -1
+35 ;
+36 ; Send notification
+37 NEW TEXT,DA,IENS
+38 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+39 SET TEXT="You have been added as a shared user for Panel "_$$GET1^DIQ(90505.01,IENS,.01,"E")_" by "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+40 IF $GET(DTSTRT)'=""
SET TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)
+41 ;
+42 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(WHO,TEXT)
+43 QUIT NDA
+44 ;
USHR() ;EP - Update a share record
+1 ;
+2 ;Description
+3 ; Update a share record with data
+4 ;
+5 NEW DA,SIENS,BQISHRUP,ERROR,TEXT,IENS
+6 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+7 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=WHO
+8 SET SIENS=$$IENS^DILF(.DA)
+9 IF ACTION="D"
Begin DoDot:1
+10 SET BQISHRUP(90505.03,SIENS,.01)="@"
+11 IF WHO=DUZ
Begin DoDot:2
+12 SET TEXT=$$GET1^DIQ(200,DUZ_",",.01,"E")_" has been removed from sharing panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)
+13 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(OWNR,TEXT)
End DoDot:2
QUIT
+14 SET TEXT="You have been deleted from sharing panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+15 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(WHO,TEXT)
End DoDot:1
+16 ;
+17 IF ACTION="U"
Begin DoDot:1
+18 IF $GET(ACCESS)="I"
IF $$GET1^DIQ(90505.03,SIENS,.02,"I")'="I"
Begin DoDot:2
+19 IF WHO=DUZ
Begin DoDot:3
+20 SET TEXT=$$GET1^DIQ(200,WHO_",",.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")
+21 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(OWNR,TEXT)
End DoDot:3
QUIT
+22 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")
+23 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(WHO,TEXT)
End DoDot:2
+24 IF $GET(ACCESS)'="I"
Begin DoDot:2
+25 NEW ODTST,ODTEND
+26 SET ODTST=$$GET1^DIQ(90505.03,SIENS,.03,"I")
+27 SET ODTEND=$$GET1^DIQ(90505.03,SIENS,.04,"I")
+28 ; Date notifications should only be issued for an update
+29 IF OACTION="U"
IF ODTST'=$GET(DTSTRT)!(ODTEND'=$GET(DTEND))
Begin DoDot:3
+30 ; reinstated share
IF ODTEND
IF ODTEND<$GET(DTSTRT)
Begin DoDot:4
+31 IF WHO=DUZ
Begin DoDot:5
+32 SET TEXT=$$GET1^DIQ(200,WHO_",",.01,"E")_" has been reactivated as a share for panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+33 IF $GET(DTSTRT)'=""
SET TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
+34 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(OWNR,TEXT)
End DoDot:5
QUIT
+35 SET TEXT="You have been reactivated as a share for panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+36 SET TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
+37 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(WHO,TEXT)
End DoDot:4
QUIT
+38 IF WHO=DUZ
Begin DoDot:4
+39 SET TEXT=$$GET1^DIQ(200,WHO_",",.01,"E")_"'s share dates have been changed for panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+40 IF $GET(DTSTRT)'=""
SET TEXT=TEXT_". The new dates are "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
+41 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(OWNR,TEXT)
End DoDot:4
QUIT
+42 SET TEXT="Your share dates have been changed for panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
+43 SET TEXT=TEXT_". The new dates are "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
+44 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
IF $$GET1^DIQ(90505.01,IENS,.15,"I")=""
DO FIL^BQINOTF(WHO,TEXT)
End DoDot:3
End DoDot:2
+45 SET BQISHRUP(90505.03,SIENS,.02)=$GET(ACCESS)
+46 SET BQISHRUP(90505.03,SIENS,.03)=$GET(DTSTRT)
+47 SET BQISHRUP(90505.03,SIENS,.04)=$GET(DTEND)
End DoDot:1
+48 DO FILE^DIE("","BQISHRUP","ERROR")
+49 IF $DATA(ERROR)
QUIT 0
+50 QUIT 1
+51 ;
CKSHR(OWNR,PLIEN) ;EP -- Check the write rights of a shared person
+1 ;
+2 ;Description
+3 ; This function checks the write status of a shared user
+4 ;Input
+5 ; OWNR - Owner of the panel
+6 ; PLIEN - Panel internal entry number
+7 ;Output
+8 ; 1 - if okay to write to the panel
+9 ; 0 - if not okay to write to the panel
+10 ;
+11 NEW DA,IENS,ACCESS
+12 IF DUZ=OWNR
QUIT 1
+13 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=DUZ
+14 SET IENS=$$IENS^DILF(.DA)
+15 SET ACCESS=$$GET1^DIQ(90505.03,IENS,.02,"I")
+16 IF ACCESS="RW"
QUIT 1
+17 QUIT 0
+18 ;
CPLAY ;EP -- Copy Owner Layout to Shared User
+1 ;
+2 ;Description
+3 ; This function copies the layouts from the panel owner to the selected shared user
+4 ;
+5 ;N BQIUPD,ERROR,LAYDD,LAYFLD,OLAY,RESULT,SLAYDD,TMPIEN
+6 ;
+7 ;Set up dictionary/field values
+8 ; Templates
+9 NEW TMPIEN,VWN
+10 SET TMPIEN=0
+11 IF $GET(^BQICARE(OWNR,1,PLIEN,4,TMPIEN))'=""
IF $GET(^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN))=""
Begin DoDot:1
+12 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN)=^BQICARE(OWNR,1,PLIEN,4,TMPIEN)
+13 FOR
SET TMPIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,4,TMPIEN))
IF 'TMPIEN
QUIT
Begin DoDot:2
+14 SET TMPNM=$PIECE($GET(^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)),U)
IF TMPNM=""
QUIT
+15 IF TMPNM'[" Default"
QUIT
+16 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN,0)=^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)
End DoDot:2
End DoDot:1
+17 ; Patient
+18 SET VWN=0
+19 IF $GET(^BQICARE(OWNR,1,PLIEN,20,VWN))'=""
IF $GET(^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN))=""
Begin DoDot:1
+20 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN)=^BQICARE(OWNR,1,PLIEN,20,VWN)
+21 FOR
SET VWN=$ORDER(^BQICARE(OWNR,1,PLIEN,20,VWN))
IF 'VWN
QUIT
Begin DoDot:2
+22 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN,0)=^BQICARE(OWNR,1,PLIEN,20,VWN,0)
End DoDot:2
End DoDot:1
+23 ; Reminder
+24 SET VWN=0
+25 IF $GET(^BQICARE(OWNR,1,PLIEN,22,VWN))'=""
IF $GET(^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN))=""
Begin DoDot:1
+26 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN)=^BQICARE(OWNR,1,PLIEN,22,VWN)
+27 FOR
SET VWN=$ORDER(^BQICARE(OWNR,1,PLIEN,22,VWN))
IF 'VWN
QUIT
Begin DoDot:2
+28 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN,0)=^BQICARE(OWNR,1,PLIEN,22,VWN,0)
End DoDot:2
End DoDot:1
+29 ; Natl Measures
+30 SET VWN=0
+31 IF $GET(^BQICARE(OWNR,1,PLIEN,25,VWN))'=""
IF $GET(^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN))=""
Begin DoDot:1
+32 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN)=^BQICARE(OWNR,1,PLIEN,25,VWN)
+33 FOR
SET VWN=$ORDER(^BQICARE(OWNR,1,PLIEN,25,VWN))
IF 'VWN
QUIT
Begin DoDot:2
+34 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN,0)=^BQICARE(OWNR,1,PLIEN,25,VWN,0)
End DoDot:2
End DoDot:1
+35 ; Care Management
+36 SET VWN=0
+37 IF $GET(^BQICARE(OWNR,1,PLIEN,23,VWN))'=""
IF $GET(^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN))=""
Begin DoDot:1
+38 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN)=^BQICARE(OWNR,1,PLIEN,23,VWN)
+39 FOR
SET VWN=$ORDER(^BQICARE(OWNR,1,PLIEN,23,VWN))
IF 'VWN
QUIT
Begin DoDot:2
+40 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,0)=^BQICARE(OWNR,1,PLIEN,23,VWN,0)
+41 SET CVN=0
+42 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,1,CVN)=^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN)
+43 FOR
SET CVN=$ORDER(^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN))
IF 'CVN
QUIT
Begin DoDot:3
+44 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,1,CVN,0)=^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN,0)
End DoDot:3
End DoDot:2
End DoDot:1
+45 ;
+46 NEW DA,DIK
+47 SET DA=NDA
SET DA(1)=PLIEN
SET DA(2)=OWNR
SET DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",30,"
+48 DO IX1^DIK
+49 ;
+50 ;Non-default templates turn into customized
+51 NEW TMPIEN,TMPNM,TN,TYP,CN,CMN,FILE,CVN
+52 SET TMPIEN=0
+53 FOR
SET TMPIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,4,TMPIEN))
IF 'TMPIEN
QUIT
Begin DoDot:1
+54 SET TMPNM=$PIECE($GET(^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)),"^",1)
IF TMPNM=""
QUIT
+55 IF TMPNM[" Default"
QUIT
+56 SET TN=$ORDER(^BQICARE(OWNR,15,"B",TMPNM,""))
IF TN=""
QUIT
+57 SET TYP=$PIECE(^BQICARE(OWNR,15,TN,0),"^",2)
+58 SET CN=$ORDER(^BQI(90506.5,"C",TYP,""))
IF CN=""
QUIT
+59 SET CMN=$PIECE(^BQI(90506.5,CN,0),"^",1)
+60 SET FILE=$PIECE($GET(^BQI(90506.5,CN,2)),"^",5)
IF FILE=""
QUIT
+61 IF FILE=90505.3231
Begin DoDot:2
+62 SET CNM=$ORDER(^BQICARE(OWNR,1,PLIEN,30,NDA,23,"B",CMN,""))
+63 IF CNM'=""
SET CVN=CNM
IF $ORDER(^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,0))'=""
QUIT
+64 IF CNM=""
SET CVN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,NDA,23,"B"),-1)
SET CVN=CVN+1
+65 ;copy over the template into customized
+66 IF $GET(^BQICARE(OWNR,1,PLIEN,30,NDA,23,0))=""
SET ^BQICARE(OWNR,1,PLIEN,30,NDA,23,0)="^90505.123^"_CVN_"^"_CVN
+67 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,0)=CMN
+68 SET N=0
FOR
SET N=$ORDER(^BQICARE(OWNR,15,TN,1,N))
IF 'N
QUIT
Begin DoDot:3
+69 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
+70 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,0)="^90505.1231^"_N_"^"_N
End DoDot:3
End DoDot:2
+71 IF FILE=90505.322
Begin DoDot:2
+72 SET CMN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,NDA,22,0))
IF CMN'=""
QUIT
+73 SET N=0
FOR
SET N=$ORDER(^BQICARE(OWNR,15,TN,1,N))
IF 'N
QUIT
Begin DoDot:3
+74 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,22,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
+75 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,22,0)="90505.322^"_N_"^"_N
End DoDot:3
End DoDot:2
+76 IF FILE=90505.06
Begin DoDot:2
+77 SET CMN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,NDA,20,0))
IF CMN'=""
QUIT
+78 SET N=0
FOR
SET N=$ORDER(^BQICARE(OWNR,15,TN,1,N))
IF 'N
QUIT
Begin DoDot:3
+79 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,20,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
+80 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,20,0)="90505.06^"_N_"^"_N
End DoDot:3
End DoDot:2
+81 IF FILE=90505.325
Begin DoDot:2
+82 SET CMN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,NDA,25,0))
IF CMN'=""
QUIT
+83 SET N=0
FOR
SET N=$ORDER(^BQICARE(OWNR,15,TN,1,N))
IF 'N
QUIT
Begin DoDot:3
+84 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,25,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
+85 SET ^BQICARE(OWNR,1,PLIEN,30,NDA,25,0)="^90505.125^"_N_"^"_N
End DoDot:3
End DoDot:2
End DoDot:1
+86 ;
+87 ; Cross-reference
+88 NEW DA,DIK
+89 SET DA=NDA
SET DA(1)=PLIEN
SET DA(2)=OWNR
SET DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",30,"
+90 DO IX1^DIK
+91 ;Check Override field
+92 IF $GET(OVRRD)'=1
SET OVRRD=0
+93 ;
+94 ;Initialize Result Variable
+95 SET RESULT=1
+96 QUIT
