BQIPLVWC ;PRXM/HC/ALA-Customized Panel View ; 14 Oct 2005 4:09 PM
;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
;
Q
;
LST(DATA,OWNR,PLIEN) ; EP -- BQI GET PANEL PREFS
;Description
; This returns a customized display order list for a panel
;Input
; OWNR - Owner of panel internal entry number
; PLIEN - Panel internal entry number
;Output
; DATA - name of global (passed by reference) in which the data
; is stored
;Expected
; DUZ - User internal entry number
;Variables used
; UID - TMP global subscript. Will be either $J or "Z" plus the
; TaskMan Task ID
;
NEW UID,II,IEN,DOR,SOR,DVALUE,SVALUE,X,SRC,KEY
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPLVWC",UID))
K @DATA
S II=0
S @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER^T00120SORT_ORDER^T00120SORT_DIRECTION"_$C(30)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLVWC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S OWNR=$G(OWNR,""),PLIEN=$G(PLIEN,"")
; If there is a template
I $$TMPL() G DONE
;
; If there is a customized view
I $$CVW() G DONE
;
S TIEN="",TEMPL="",DEF="",TYP="D"
S DISPLAY=$$DFNC^BQIPLVW()
S SORT=$$SFNC^BQIPLVW()
S SDIR="A",TEMPL="System Default"
S II=II+1,@DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$C(30)
;
DONE ;
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
;
DFNC() ;EP - Custom Display Order function for Owner
S DVALUE=""
S DOR="" F S DOR=$O(^BQICARE(OWNR,1,PLIEN,20,"C",DOR)) Q:DOR="" D
. S IEN=""
. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,20,"C",DOR,IEN)) Q:IEN="" D
.. NEW DA,IENS,STVW,STVCD
.. S DA(2)=OWNR,DA(1)=PLIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S STVW=$$GET1^DIQ(90505.05,IENS,.01,"I")
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. S STVCD=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
.. S DVALUE=DVALUE_STVCD_$C(29)
S DVALUE=$$TKO^BQIUL1(DVALUE,$C(29))
Q DVALUE
;
SFNC() ;EP - Custom Sort Order function for Owner
S SVALUE=""
S SOR="" F S SOR=$O(^BQICARE(OWNR,1,PLIEN,20,"D",SOR)) Q:SOR="" D
. S IEN="" F S IEN=$O(^BQICARE(OWNR,1,PLIEN,20,"D",SOR,IEN)) Q:IEN="" D
.. NEW DA,IENS,STVW,STVCD
.. S DA(2)=OWNR,DA(1)=PLIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S STVW=$$GET1^DIQ(90505.05,IENS,.01,"I")
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. S STVCD=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
.. S SVALUE=SVALUE_STVCD_$C(29)
S SVALUE=$$TKO^BQIUL1(SVALUE,$C(29))
Q SVALUE
;
SDIR() ;EP - Custom Sort Direction function for Owner
S SVALUE=""
S SOR="" F S SOR=$O(^BQICARE(OWNR,1,PLIEN,20,"D",SOR)) Q:SOR="" D
. S IEN="" F S IEN=$O(^BQICARE(OWNR,1,PLIEN,20,"D",SOR,IEN)) Q:IEN="" D
.. NEW DA,IENS,STVW,STVCD
.. S DA(2)=OWNR,DA(1)=PLIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S STVCD=$$GET1^DIQ(90505.05,IENS,.04,"I")
.. S STVW=$$GET1^DIQ(90505.05,IENS,.01,"I")
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. I STVCD="" S STVCD="A"
.. S SVALUE=SVALUE_STVCD_$C(29)
S SVALUE=$$TKO^BQIUL1(SVALUE,$C(29))
Q SVALUE
;
SDFNC() ;EP - Custom Display Order function for Sharer
S DVALUE=""
S DOR="" F S DOR=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"C",DOR)) Q:DOR="" D
. S IEN="" F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"C",DOR,IEN)) Q:IEN="" D
.. NEW DA,IENS,STVW,STVCD
.. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S STVW=$$GET1^DIQ(90505.06,IENS,.01,"I")
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. S STVCD=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
.. S DVALUE=DVALUE_STVCD_$C(29)
S DVALUE=$$TKO^BQIUL1(DVALUE,$C(29))
Q DVALUE
;
SSFNC() ;EP - Custom Sort Order function for Sharer
S SVALUE=""
S SOR="" F S SOR=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"D",SOR)) Q:SOR="" D
. S IEN="" F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"D",SOR,IEN)) Q:IEN="" D
.. NEW DA,IENS,STVW,STVCD
.. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S STVW=$$GET1^DIQ(90505.06,IENS,.01,"I")
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. S STVCD=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
.. S SVALUE=SVALUE_STVCD_$C(29)
S SVALUE=$$TKO^BQIUL1(SVALUE,$C(29))
Q SVALUE
;
SSDIR() ;EP - Custom Sort Direction function for Sharer
S SVALUE=""
S SOR="" F S SOR=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"D",SOR)) Q:SOR="" D
. S IEN="" F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"D",SOR,IEN)) Q:IEN="" D
.. NEW DA,IENS,STVW,STVCD
.. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S STVCD=$$GET1^DIQ(90505.06,IENS,.04,"I")
.. S STVW=$$GET1^DIQ(90505.06,IENS,.01,"I")
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. I STVCD="" S STVCD="A"
.. S SVALUE=SVALUE_STVCD_$C(29)
S SVALUE=$$TKO^BQIUL1(SVALUE,$C(29))
Q SVALUE
;
UPD(DATA,OWNR,PLIEN,TEMPL,SOR,SDIR,DOR) ; EP -- BQI SET PANEL PREFS
;
;Description
; Update the display and sort order for a specified owner and panel
;Input
;
NEW UID,II,IEN,ERROR,BQIDEL,DI,SI,SRDR,X,LIST,BN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPLVWC",UID))
K @DATA
S II=0
S @DATA@(II)="I00010RESULT"_$C(30)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLVWC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S TEMPL=$G(TEMPL,""),SOR=$G(SOR,""),SDIR=$G(SDIR,""),DOR=$G(DOR,"")
I DOR="" D
. S LIST="",BN=""
. F S BN=$O(DOR(BN)) Q:BN="" S LIST=LIST_DOR(BN)
. K DOR
. S DOR=LIST
. K LIST
;
D FIL(OWNR,PLIEN,TEMPL,SOR,SDIR,DOR)
;
I $D(ERROR) S II=II+1,@DATA@(II)="-1"_$C(30)
I '$D(ERROR) S II=II+1,@DATA@(II)="1"_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
FIL(OWNR,PLIEN,TEMPL,SOR,SDIR,DOR) ; EP - File
; If the Owner and the User are the same person.
I OWNR=DUZ D Q
. NEW DA,IENS,Y,STVW,STVCD,BQIDEL
. S DA(2)=OWNR,DA(1)=PLIEN,DA=0
. F S DA=$O(^BQICARE(OWNR,1,PLIEN,20,DA)) Q:'DA D
.. S IENS=$$IENS^DILF(.DA)
.. S BQIDEL(90505.05,IENS,.01)="@"
. I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
. S DA=0
. F S DA=$O(^BQICARE(OWNR,1,PLIEN,4,DA)) Q:'DA D
.. S IENS=$$IENS^DILF(.DA)
.. I $$GET1^DIQ(90505.14,IENS,.02,"I")'="D" Q
.. S BQIDEL(90505.14,IENS,.01)="@"
. I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
. ;
. ; If template
. I $G(TEMPL)'="" D Q
.. NEW DA,DIC,DLAYGO,IENS,DIE
.. S DA(2)=OWNR,DA(1)=PLIEN
.. S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",4,",DIE=DIC
.. S DLAYGO=90505.14,DIC(0)="L",DIC("P")=DLAYGO
.. I '$D(^BQICARE(DA(2),1,DA(1),4,0)) S ^BQICARE(DA(2),1,DA(1),4,0)="^90505.14^^"
.. S X=TEMPL
.. D ^DIC
.. S DA=+Y
.. S IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90505.14,IENS,.02)="D"
.. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
.. K BQIUPD
. ; If customized
. F DI=1:1:$L(DOR,$C(29)) S STVCD=$P(DOR,$C(29),DI) Q:STVCD="" D
.. ;S STVW=$O(^BQI(90506.1,"B",STVCD,""))
.. NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
.. S DA(2)=OWNR,DA(1)=PLIEN
.. S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",20,",DIE=DIC
.. S DLAYGO=90505.05,DIC(0)="L",DIC("P")=DLAYGO
.. S X=STVCD
.. I '$D(^BQICARE(DA(2),1,DA(1),20,0)) S ^BQICARE(DA(2),1,DA(1),20,0)="^90505.05P^^"
.. K DO,DD D FILE^DICN
.. S DA=+Y
.. S IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90505.05,IENS,.02)=DI
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
. K BQIUPD
. ;
. F SI=1:1:$L(SOR,$C(29)) S STVCD=$P(SOR,$C(29),SI) Q:STVCD="" D
.. S SRDR=$P(SDIR,$C(29),SI) S:SRDR="" SRDR="A"
.. ;S STVW=$O(^BQI(90506.1,"B",STVCD,""))
.. NEW DA,IENS
.. S DA(2)=OWNR,DA(1)=PLIEN,DA=$O(^BQICARE(OWNR,1,PLIEN,20,"B",STVCD,""))
.. S IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90505.05,IENS,.03)=SI
.. S BQIUPD(90505.05,IENS,.04)=SRDR
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
. K BQIUPD
;
NEW DA,IENS
S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=0
F S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,DA)) Q:'DA D
. S IENS=$$IENS^DILF(.DA)
. S BQIDEL(90505.06,IENS,.01)="@"
I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
S DA=0
F S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,DA)) Q:'DA D
. S IENS=$$IENS^DILF(.DA)
. I $$GET1^DIQ(90505.34,IENS,.02,"I")'="D" Q
. S BQIDEL(90505.34,IENS,.01)="@"
I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
; If template
I $G(TEMPL)'="" D Q
. NEW DA,DIC,DLAYGO,IENS,DIE
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ
. S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DUZ_",4,",DIE=DIC
. S DLAYGO=90505.34,DIC(0)="L",DIC("P")=DLAYGO
. I '$D(^BQICARE(DA(3),1,DA(2),30,DA(1),20,0)) S ^BQICARE(DA(3),1,DA(2),30,DA(1),4,0)="^90505.34^^"
. S X=TEMPL
. D ^DIC
. S DA=+Y
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90505.34,IENS,.02)="D"
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
. K BQIUPD
; If customized
F DI=1:1:$L(DOR,$C(29)) S STVCD=$P(DOR,$C(29),DI) Q:STVCD="" D
. ;S STVW=$O(^BQI(90506.1,"B",STVCD,""))
. NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ
. S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DUZ_",20,",DIE=DIC
. S DLAYGO=90505.06,DIC(0)="L",DIC("P")=DLAYGO
. S X=STVCD
. I '$D(^BQICARE(DA(3),1,DA(2),30,DA(1),20,0)) S ^BQICARE(DA(3),1,DA(2),30,DA(1),20,0)="^90505.06P^^"
. K DO,DD D FILE^DICN
. S DA=+Y
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90505.06,IENS,.02)=DI
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
F SI=1:1:$L(SOR,$C(29)) S STVCD=$P(SOR,$C(29),SI) Q:STVCD="" D
. S SRDR=$P(SDIR,$C(29),SI) S:SRDR="" SRDR="A"
. ;S STVW=$O(^BQI(90506.1,"B",STVCD,""))
. NEW DA,IENS
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"B",STVCD,""))
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90505.06,IENS,.03)=SI
. S BQIUPD(90505.06,IENS,.04)=SRDR
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
Q
;
TMPL() ;EP - Check if layout template is used
NEW RESULT,CTYP
S RESULT=0,CTYP="D"
NEW DA,IENS,TEMPL,LYIEN
S TEMPL=""
I OWNR'=DUZ D
. I $G(PLIEN)="" Q
. S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
. I DA="" Q
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,IENS=$$IENS^DILF(.DA)
. S TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
I OWNR=DUZ D
. I $G(PLIEN)="" Q
. S DA=$O(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
. I DA="" Q
. S DA(2)=OWNR,DA(1)=PLIEN,IENS=$$IENS^DILF(.DA)
. S TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
I TEMPL'="" D
. ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
. S LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
. I LYIEN="" Q
. D DEF^BQILYDEF(LYIEN)
. S RESULT=1
. ;S DISPLAY=$P(@DATA@(II),U,3),SOR=$P(@DATA@(II),U,4),SDIR=$P(@DATA@(II),U,5)
Q RESULT
;
CVW() ;EP - Get Customized view
NEW TIEN,TEMPL,DEF,TYP,DISPLAY,SORT,SDIR,IEN,GIEN,SIEN,RIEN,CODE,SOR
S DISPLAY="",SORT="",SDIR="",TIEN="",TEMPL="",RESULT=0,DEF=""
S TYP="D"
;
; Owner and user are the same
I OWNR=DUZ D
. S IEN=0,DISPLAY="",SORT="",SDIR=""
. I $G(PLIEN)="" Q
. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,20,IEN)) Q:'IEN D
.. S CODE=$P(^BQICARE(OWNR,1,PLIEN,20,IEN,0),"^",1)
.. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,20,IEN,0),"^",3)
.. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,20,IEN,0),"^",4)
.. S GIEN=$O(^BQI(90506.1,"B",CODE,"")) I GIEN="" Q
.. S KEY=$$GET1^DIQ(90506.1,GIEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. S DISPLAY=DISPLAY_CODE_$C(29)
.. I SIEN'="" D
... ;I SIEN?.N S CODE=$P(^BQI(90506.1,SIEN,0),U,1)
... ;E S CODE=SIEN
... ;S SORT=SORT_CODE_$C(29)
... S $P(SORT,$C(29),SIEN)=CODE
... S $P(SDIR,$C(29),SIEN)=RIEN
.. ;S SDIR=SDIR_RIEN_$C(29)
;
; User is not owner but share
I OWNR'=DUZ D
. S IEN=0,DISPLAY="",SORT="",SDIR=""
. I $G(PLIEN)="" Q
. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,IEN)) Q:'IEN D
.. S CODE=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,IEN,0),"^",1)
.. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,IEN,0),"^",3)
.. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,IEN,0),"^",4)
.. S GIEN=$O(^BQI(90506.1,"B",CODE,"")) I GIEN="" Q
.. S KEY=$$GET1^DIQ(90506.1,GIEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. S DISPLAY=DISPLAY_CODE_$C(29)
.. I SIEN'="" D
... ;I SIEN?.N S CODE=$P(^BQI(90506.1,SIEN,0),U,1)
... ;E S CODE=SIEN
... ;S SORT=SORT_CODE_$C(29)
... S $P(SORT,$C(29),SIEN)=CODE
... S $P(SDIR,$C(29),SIEN)=RIEN
.. ;S SDIR=SDIR_RIEN_$C(29)
;
S DISPLAY=$$TKO^BQIUL1(DISPLAY,$C(29))
S SORT=$$TKO^BQIUL1(SORT,$C(29))
S SDIR=$$TKO^BQIUL1(SDIR,$C(29))
I DISPLAY'="" D
. S RESULT=1
. S II=II+1,@DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$C(30)
Q RESULT
BQIPLVWC ;PRXM/HC/ALA-Customized Panel View ; 14 Oct 2005 4:09 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
+2 ;
+3 QUIT
+4 ;
LST(DATA,OWNR,PLIEN) ; EP -- BQI GET PANEL PREFS
+1 ;Description
+2 ; This returns a customized display order list for a panel
+3 ;Input
+4 ; OWNR - Owner of panel internal entry number
+5 ; PLIEN - Panel internal entry number
+6 ;Output
+7 ; DATA - name of global (passed by reference) in which the data
+8 ; is stored
+9 ;Expected
+10 ; DUZ - User internal entry number
+11 ;Variables used
+12 ; UID - TMP global subscript. Will be either $J or "Z" plus the
+13 ; TaskMan Task ID
+14 ;
+15 NEW UID,II,IEN,DOR,SOR,DVALUE,SVALUE,X,SRC,KEY
+16 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+17 SET DATA=$NAME(^TMP("BQIPLVWC",UID))
+18 KILL @DATA
+19 SET II=0
+20 SET @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER^T00120SORT_ORDER^T00120SORT_DIRECTION"_$CHAR(30)
+21 ;
+22 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPLVWC D UNWIND^%ZTER"
+23 ;
+24 SET OWNR=$GET(OWNR,"")
SET PLIEN=$GET(PLIEN,"")
+25 ; If there is a template
+26 IF $$TMPL()
GOTO DONE
+27 ;
+28 ; If there is a customized view
+29 IF $$CVW()
GOTO DONE
+30 ;
+31 SET TIEN=""
SET TEMPL=""
SET DEF=""
SET TYP="D"
+32 SET DISPLAY=$$DFNC^BQIPLVW()
+33 SET SORT=$$SFNC^BQIPLVW()
+34 SET SDIR="A"
SET TEMPL="System Default"
+35 SET II=II+1
SET @DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$CHAR(30)
+36 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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 ;
DFNC() ;EP - Custom Display Order function for Owner
+1 SET DVALUE=""
+2 SET DOR=""
FOR
SET DOR=$ORDER(^BQICARE(OWNR,1,PLIEN,20,"C",DOR))
IF DOR=""
QUIT
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,20,"C",DOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+5 NEW DA,IENS,STVW,STVCD
+6 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+7 SET STVW=$$GET1^DIQ(90505.05,IENS,.01,"I")
+8 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+9 IF $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC
QUIT
+10 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+11 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+12 SET STVCD=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
+13 SET DVALUE=DVALUE_STVCD_$CHAR(29)
End DoDot:2
End DoDot:1
+14 SET DVALUE=$$TKO^BQIUL1(DVALUE,$CHAR(29))
+15 QUIT DVALUE
+16 ;
SFNC() ;EP - Custom Sort Order function for Owner
+1 SET SVALUE=""
+2 SET SOR=""
FOR
SET SOR=$ORDER(^BQICARE(OWNR,1,PLIEN,20,"D",SOR))
IF SOR=""
QUIT
Begin DoDot:1
+3 SET IEN=""
FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,20,"D",SOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+4 NEW DA,IENS,STVW,STVCD
+5 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+6 SET STVW=$$GET1^DIQ(90505.05,IENS,.01,"I")
+7 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+8 IF $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC
QUIT
+9 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+10 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+11 SET STVCD=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
+12 SET SVALUE=SVALUE_STVCD_$CHAR(29)
End DoDot:2
End DoDot:1
+13 SET SVALUE=$$TKO^BQIUL1(SVALUE,$CHAR(29))
+14 QUIT SVALUE
+15 ;
SDIR() ;EP - Custom Sort Direction function for Owner
+1 SET SVALUE=""
+2 SET SOR=""
FOR
SET SOR=$ORDER(^BQICARE(OWNR,1,PLIEN,20,"D",SOR))
IF SOR=""
QUIT
Begin DoDot:1
+3 SET IEN=""
FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,20,"D",SOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+4 NEW DA,IENS,STVW,STVCD
+5 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+6 SET STVCD=$$GET1^DIQ(90505.05,IENS,.04,"I")
+7 SET STVW=$$GET1^DIQ(90505.05,IENS,.01,"I")
+8 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+9 IF $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC
QUIT
+10 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+11 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+12 IF STVCD=""
SET STVCD="A"
+13 SET SVALUE=SVALUE_STVCD_$CHAR(29)
End DoDot:2
End DoDot:1
+14 SET SVALUE=$$TKO^BQIUL1(SVALUE,$CHAR(29))
+15 QUIT SVALUE
+16 ;
SDFNC() ;EP - Custom Display Order function for Sharer
+1 SET DVALUE=""
+2 SET DOR=""
FOR
SET DOR=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"C",DOR))
IF DOR=""
QUIT
Begin DoDot:1
+3 SET IEN=""
FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"C",DOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+4 NEW DA,IENS,STVW,STVCD
+5 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+6 SET STVW=$$GET1^DIQ(90505.06,IENS,.01,"I")
+7 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+8 IF $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC
QUIT
+9 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+10 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+11 SET STVCD=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
+12 SET DVALUE=DVALUE_STVCD_$CHAR(29)
End DoDot:2
End DoDot:1
+13 SET DVALUE=$$TKO^BQIUL1(DVALUE,$CHAR(29))
+14 QUIT DVALUE
+15 ;
SSFNC() ;EP - Custom Sort Order function for Sharer
+1 SET SVALUE=""
+2 SET SOR=""
FOR
SET SOR=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"D",SOR))
IF SOR=""
QUIT
Begin DoDot:1
+3 SET IEN=""
FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"D",SOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+4 NEW DA,IENS,STVW,STVCD
+5 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+6 SET STVW=$$GET1^DIQ(90505.06,IENS,.01,"I")
+7 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+8 IF $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC
QUIT
+9 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+10 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+11 SET STVCD=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
+12 SET SVALUE=SVALUE_STVCD_$CHAR(29)
End DoDot:2
End DoDot:1
+13 SET SVALUE=$$TKO^BQIUL1(SVALUE,$CHAR(29))
+14 QUIT SVALUE
+15 ;
SSDIR() ;EP - Custom Sort Direction function for Sharer
+1 SET SVALUE=""
+2 SET SOR=""
FOR
SET SOR=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"D",SOR))
IF SOR=""
QUIT
Begin DoDot:1
+3 SET IEN=""
FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"D",SOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+4 NEW DA,IENS,STVW,STVCD
+5 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+6 SET STVCD=$$GET1^DIQ(90505.06,IENS,.04,"I")
+7 SET STVW=$$GET1^DIQ(90505.06,IENS,.01,"I")
+8 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+9 IF $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC
QUIT
+10 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+11 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+12 IF STVCD=""
SET STVCD="A"
+13 SET SVALUE=SVALUE_STVCD_$CHAR(29)
End DoDot:2
End DoDot:1
+14 SET SVALUE=$$TKO^BQIUL1(SVALUE,$CHAR(29))
+15 QUIT SVALUE
+16 ;
UPD(DATA,OWNR,PLIEN,TEMPL,SOR,SDIR,DOR) ; EP -- BQI SET PANEL PREFS
+1 ;
+2 ;Description
+3 ; Update the display and sort order for a specified owner and panel
+4 ;Input
+5 ;
+6 NEW UID,II,IEN,ERROR,BQIDEL,DI,SI,SRDR,X,LIST,BN
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQIPLVWC",UID))
+9 KILL @DATA
+10 SET II=0
+11 SET @DATA@(II)="I00010RESULT"_$CHAR(30)
+12 ;
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPLVWC D UNWIND^%ZTER"
+14 ;
+15 SET TEMPL=$GET(TEMPL,"")
SET SOR=$GET(SOR,"")
SET SDIR=$GET(SDIR,"")
SET DOR=$GET(DOR,"")
+16 IF DOR=""
Begin DoDot:1
+17 SET LIST=""
SET BN=""
+18 FOR
SET BN=$ORDER(DOR(BN))
IF BN=""
QUIT
SET LIST=LIST_DOR(BN)
+19 KILL DOR
+20 SET DOR=LIST
+21 KILL LIST
End DoDot:1
+22 ;
+23 DO FIL(OWNR,PLIEN,TEMPL,SOR,SDIR,DOR)
+24 ;
+25 IF $DATA(ERROR)
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
+26 IF '$DATA(ERROR)
SET II=II+1
SET @DATA@(II)="1"_$CHAR(30)
+27 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+28 QUIT
+29 ;
FIL(OWNR,PLIEN,TEMPL,SOR,SDIR,DOR) ; EP - File
+1 ; If the Owner and the User are the same person.
+2 IF OWNR=DUZ
Begin DoDot:1
+3 NEW DA,IENS,Y,STVW,STVCD,BQIDEL
+4 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=0
+5 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,20,DA))
IF 'DA
QUIT
Begin DoDot:2
+6 SET IENS=$$IENS^DILF(.DA)
+7 SET BQIDEL(90505.05,IENS,.01)="@"
End DoDot:2
+8 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+9 SET DA=0
+10 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,DA))
IF 'DA
QUIT
Begin DoDot:2
+11 SET IENS=$$IENS^DILF(.DA)
+12 IF $$GET1^DIQ(90505.14,IENS,.02,"I")'="D"
QUIT
+13 SET BQIDEL(90505.14,IENS,.01)="@"
End DoDot:2
+14 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+15 ;
+16 ; If template
+17 IF $GET(TEMPL)'=""
Begin DoDot:2
+18 NEW DA,DIC,DLAYGO,IENS,DIE
+19 SET DA(2)=OWNR
SET DA(1)=PLIEN
+20 SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",4,"
SET DIE=DIC
+21 SET DLAYGO=90505.14
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+22 IF '$DATA(^BQICARE(DA(2),1,DA(1),4,0))
SET ^BQICARE(DA(2),1,DA(1),4,0)="^90505.14^^"
+23 SET X=TEMPL
+24 DO ^DIC
+25 SET DA=+Y
+26 SET IENS=$$IENS^DILF(.DA)
+27 SET BQIUPD(90505.14,IENS,.02)="D"
+28 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+29 KILL BQIUPD
End DoDot:2
QUIT
+30 ; If customized
+31 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
SET STVCD=$PIECE(DOR,$CHAR(29),DI)
IF STVCD=""
QUIT
Begin DoDot:2
+32 ;S STVW=$O(^BQI(90506.1,"B",STVCD,""))
+33 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
+34 SET DA(2)=OWNR
SET DA(1)=PLIEN
+35 SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",20,"
SET DIE=DIC
+36 SET DLAYGO=90505.05
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+37 SET X=STVCD
+38 IF '$DATA(^BQICARE(DA(2),1,DA(1),20,0))
SET ^BQICARE(DA(2),1,DA(1),20,0)="^90505.05P^^"
+39 KILL DO,DD
DO FILE^DICN
+40 SET DA=+Y
+41 SET IENS=$$IENS^DILF(.DA)
+42 SET BQIUPD(90505.05,IENS,.02)=DI
End DoDot:2
+43 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+44 KILL BQIUPD
+45 ;
+46 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
SET STVCD=$PIECE(SOR,$CHAR(29),SI)
IF STVCD=""
QUIT
Begin DoDot:2
+47 SET SRDR=$PIECE(SDIR,$CHAR(29),SI)
IF SRDR=""
SET SRDR="A"
+48 ;S STVW=$O(^BQI(90506.1,"B",STVCD,""))
+49 NEW DA,IENS
+50 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,20,"B",STVCD,""))
+51 SET IENS=$$IENS^DILF(.DA)
+52 SET BQIUPD(90505.05,IENS,.03)=SI
+53 SET BQIUPD(90505.05,IENS,.04)=SRDR
End DoDot:2
+54 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+55 KILL BQIUPD
End DoDot:1
QUIT
+56 ;
+57 NEW DA,IENS
+58 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=0
+59 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,DA))
IF 'DA
QUIT
Begin DoDot:1
+60 SET IENS=$$IENS^DILF(.DA)
+61 SET BQIDEL(90505.06,IENS,.01)="@"
End DoDot:1
+62 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+63 SET DA=0
+64 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,DA))
IF 'DA
QUIT
Begin DoDot:1
+65 SET IENS=$$IENS^DILF(.DA)
+66 IF $$GET1^DIQ(90505.34,IENS,.02,"I")'="D"
QUIT
+67 SET BQIDEL(90505.34,IENS,.01)="@"
End DoDot:1
+68 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+69 ; If template
+70 IF $GET(TEMPL)'=""
Begin DoDot:1
+71 NEW DA,DIC,DLAYGO,IENS,DIE
+72 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
+73 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DUZ_",4,"
SET DIE=DIC
+74 SET DLAYGO=90505.34
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+75 IF '$DATA(^BQICARE(DA(3),1,DA(2),30,DA(1),20,0))
SET ^BQICARE(DA(3),1,DA(2),30,DA(1),4,0)="^90505.34^^"
+76 SET X=TEMPL
+77 DO ^DIC
+78 SET DA=+Y
+79 SET IENS=$$IENS^DILF(.DA)
+80 SET BQIUPD(90505.34,IENS,.02)="D"
+81 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+82 KILL BQIUPD
End DoDot:1
QUIT
+83 ; If customized
+84 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
SET STVCD=$PIECE(DOR,$CHAR(29),DI)
IF STVCD=""
QUIT
Begin DoDot:1
+85 ;S STVW=$O(^BQI(90506.1,"B",STVCD,""))
+86 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
+87 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
+88 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DUZ_",20,"
SET DIE=DIC
+89 SET DLAYGO=90505.06
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+90 SET X=STVCD
+91 IF '$DATA(^BQICARE(DA(3),1,DA(2),30,DA(1),20,0))
SET ^BQICARE(DA(3),1,DA(2),30,DA(1),20,0)="^90505.06P^^"
+92 KILL DO,DD
DO FILE^DICN
+93 SET DA=+Y
+94 SET IENS=$$IENS^DILF(.DA)
+95 SET BQIUPD(90505.06,IENS,.02)=DI
End DoDot:1
+96 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+97 KILL BQIUPD
+98 ;
+99 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
SET STVCD=$PIECE(SOR,$CHAR(29),SI)
IF STVCD=""
QUIT
Begin DoDot:1
+100 SET SRDR=$PIECE(SDIR,$CHAR(29),SI)
IF SRDR=""
SET SRDR="A"
+101 ;S STVW=$O(^BQI(90506.1,"B",STVCD,""))
+102 NEW DA,IENS
+103 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,"B",STVCD,""))
+104 SET IENS=$$IENS^DILF(.DA)
+105 SET BQIUPD(90505.06,IENS,.03)=SI
+106 SET BQIUPD(90505.06,IENS,.04)=SRDR
End DoDot:1
+107 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+108 KILL BQIUPD
+109 QUIT
+110 ;
TMPL() ;EP - Check if layout template is used
+1 NEW RESULT,CTYP
+2 SET RESULT=0
SET CTYP="D"
+3 NEW DA,IENS,TEMPL,LYIEN
+4 SET TEMPL=""
+5 IF OWNR'=DUZ
Begin DoDot:1
+6 IF $GET(PLIEN)=""
QUIT
+7 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
+8 IF DA=""
QUIT
+9 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET IENS=$$IENS^DILF(.DA)
+10 SET TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
End DoDot:1
+11 IF OWNR=DUZ
Begin DoDot:1
+12 IF $GET(PLIEN)=""
QUIT
+13 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
+14 IF DA=""
QUIT
+15 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET IENS=$$IENS^DILF(.DA)
+16 SET TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
End DoDot:1
+17 IF TEMPL'=""
Begin DoDot:1
+18 ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
+19 SET LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
+20 IF LYIEN=""
QUIT
+21 DO DEF^BQILYDEF(LYIEN)
+22 SET RESULT=1
+23 ;S DISPLAY=$P(@DATA@(II),U,3),SOR=$P(@DATA@(II),U,4),SDIR=$P(@DATA@(II),U,5)
End DoDot:1
+24 QUIT RESULT
+25 ;
CVW() ;EP - Get Customized view
+1 NEW TIEN,TEMPL,DEF,TYP,DISPLAY,SORT,SDIR,IEN,GIEN,SIEN,RIEN,CODE,SOR
+2 SET DISPLAY=""
SET SORT=""
SET SDIR=""
SET TIEN=""
SET TEMPL=""
SET RESULT=0
SET DEF=""
+3 SET TYP="D"
+4 ;
+5 ; Owner and user are the same
+6 IF OWNR=DUZ
Begin DoDot:1
+7 SET IEN=0
SET DISPLAY=""
SET SORT=""
SET SDIR=""
+8 IF $GET(PLIEN)=""
QUIT
+9 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,20,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+10 SET CODE=$PIECE(^BQICARE(OWNR,1,PLIEN,20,IEN,0),"^",1)
+11 SET SIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,20,IEN,0),"^",3)
+12 SET RIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,20,IEN,0),"^",4)
+13 SET GIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF GIEN=""
QUIT
+14 SET KEY=$$GET1^DIQ(90506.1,GIEN_",",3.1,"E")
+15 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+16 SET DISPLAY=DISPLAY_CODE_$CHAR(29)
+17 IF SIEN'=""
Begin DoDot:3
+18 ;I SIEN?.N S CODE=$P(^BQI(90506.1,SIEN,0),U,1)
+19 ;E S CODE=SIEN
+20 ;S SORT=SORT_CODE_$C(29)
+21 SET $PIECE(SORT,$CHAR(29),SIEN)=CODE
+22 SET $PIECE(SDIR,$CHAR(29),SIEN)=RIEN
End DoDot:3
+23 ;S SDIR=SDIR_RIEN_$C(29)
End DoDot:2
End DoDot:1
+24 ;
+25 ; User is not owner but share
+26 IF OWNR'=DUZ
Begin DoDot:1
+27 SET IEN=0
SET DISPLAY=""
SET SORT=""
SET SDIR=""
+28 IF $GET(PLIEN)=""
QUIT
+29 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+30 SET CODE=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,IEN,0),"^",1)
+31 SET SIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,IEN,0),"^",3)
+32 SET RIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,IEN,0),"^",4)
+33 SET GIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF GIEN=""
QUIT
+34 SET KEY=$$GET1^DIQ(90506.1,GIEN_",",3.1,"E")
+35 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+36 SET DISPLAY=DISPLAY_CODE_$CHAR(29)
+37 IF SIEN'=""
Begin DoDot:3
+38 ;I SIEN?.N S CODE=$P(^BQI(90506.1,SIEN,0),U,1)
+39 ;E S CODE=SIEN
+40 ;S SORT=SORT_CODE_$C(29)
+41 SET $PIECE(SORT,$CHAR(29),SIEN)=CODE
+42 SET $PIECE(SDIR,$CHAR(29),SIEN)=RIEN
End DoDot:3
+43 ;S SDIR=SDIR_RIEN_$C(29)
End DoDot:2
End DoDot:1
+44 ;
+45 SET DISPLAY=$$TKO^BQIUL1(DISPLAY,$CHAR(29))
+46 SET SORT=$$TKO^BQIUL1(SORT,$CHAR(29))
+47 SET SDIR=$$TKO^BQIUL1(SDIR,$CHAR(29))
+48 IF DISPLAY'=""
Begin DoDot:1
+49 SET RESULT=1
+50 SET II=II+1
SET @DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$CHAR(30)
End DoDot:1
+51 QUIT RESULT
