BTPWPLVW.m

BTPWPLVW ;VNGT/HS/ALA-Panel View for CMET items ; 12 Feb 2009  1:18 PM

 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011

 ;

 ;

RET(DATA,OWNR,PLIEN) ; EP - BTPW GET CMET VIEW

 ;Input Parameters

 ;  OWNR  - Owner of panel

 ;  PLIEN - Panel IEN

 ;

 NEW UID,II,MVALUE,IEN,GIEN,SIEN,DISPLAY,SOR,SDIR,TEMPL,LYIEN,BN,CIEN,CODE

 NEW DVALUE,ORD,RIEN,SD,SORT,SR,SVALUE,STVCD,CRN

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

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

 K @DATA

 S II=0

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

 ;

 S @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER^T00120SORT_ORDER^T00120SORT_DIRECTION"_$C(30)

 ;

 S OWNR=$G(OWNR,$G(DUZ)),PLIEN=$G(PLIEN,"") ; If no owner supplied use DUZ

 ;I $G(CARE)="" S BMXSEC="No Care Management Selected" Q

 S CARE="Event Tracking"

 I CARE?.N S CARE=$P(^BQI(90506.5,CARE,0),U,1),TYP=$P(^(0),U,2)

 I CARE'?.N S CRN=$O(^BQI(90506.5,"B",CARE,"")),TYP=$P(^BQI(90506.5,CRN,0),U,2)

 ;

 ; If there is a template

 I $$TMPL(CARE) G DONE

 ;

 ; If there is a customized view

 I $$CVW(CARE) G DONE

 ;

 S TIEN="",TEMPL="",DEF=""

 S DISPLAY=$$DFNC()_$C(29)_$$CDEF()

 S SORT=$$SFNC()

 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)

 ;S II=II+1,@DATA@(II)=DISPLAY_"^"_$G(SORT)_"^"_$G(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

 ;

UPD(DATA,OWNR,PLIEN,CARE,TEMPL,SOR,SDIR,DOR) ; EP -- BTPW SET CMET VIEW

 ;

 ;Description

 ;   Update the display and sort order for a specified owner and panel

 ;Input

 ;   CARE - Source View Type

 ;   SOR  - The sort order

 ;   SDIR - The sort direction

 ;   DOR  - The display order

 ;

 ; If the Owner and the User are the same person.

 NEW UID,II,IEN,ERROR,BQIDEL,DI,GIEN,SI,GCODE,LIST,BN

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

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

 K @DATA

 S II=0

 S @DATA@(II)="I00010RESULT"_$C(30)

 ;

 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

 ;

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

 ;

 D FIL(OWNR,PLIEN,CARE,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,CARE,TEMPL,SOR,SDIR,DOR) ; EP - Filer

 NEW CRN,CTYP

 S CRN=$O(^BQI(90506.5,"B",CARE,""))

 S CTYP=$P(^BQI(90506.5,CRN,0),U,2)

 ; If the user is the owner, delete the previous view values

 I OWNR=DUZ D  Q

 . S CRIEN=$O(^BQICARE(OWNR,1,PLIEN,23,"B",CARE,""))

 . I CRIEN="" D

 .. NEW DA,DIC

 .. S DA(2)=OWNR,DA(1)=PLIEN,X=CARE

 .. S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",23,",DIC(0)="L",DLAYGO=90505.123

 .. K DO,DD D FILE^DICN

 .. S CRIEN=+Y

 . NEW DA,IENS

 . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=CRIEN,DA=0

 . F  S DA=$O(^BQICARE(OWNR,1,PLIEN,23,CRIEN,1,DA)) Q:'DA  D

 .. S IENS=$$IENS^DILF(.DA)

 .. S BQIDEL(90505.1231,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")'=CTYP 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)=CTYP

 .. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")

 .. K BQIUPD

 . ; If customized 

 . F DI=1:1:$L(DOR,$C(29)) S GCODE=$P(DOR,$C(29),DI) Q:GCODE=""  D

 .. NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS

 .. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=CRIEN

 .. S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",23,"_DA(1)_",1,",DIE=DIC

 .. S DLAYGO=90505.1231,DIC(0)="L",DIC("P")=DLAYGO

 .. S GIEN=$O(^BQI(90506.1,"B",GCODE,""))

 .. S X=GIEN

 .. I $G(^BQICARE(DA(3),1,DA(2),23,DA(1),0))="" S ^BQICARE(DA(3),1,DA(2),23,DA(1),0)="^90505.1231^^"

 .. K DO,DD D FILE^DICN

 .. S DA=+Y I DA<1 S ERROR=1 Q

 .. S IENS=$$IENS^DILF(.DA)

 .. S BQIUPD(90505.1231,IENS,.02)=DI

 .. D FILE^DIE("","BQIUPD","ERROR")

 . ;

 . F SI=1:1:$L(SOR,$C(29)) S SIEN=$P(SOR,$C(29),SI) D

 .. NEW DA,X,IENS,BQIUPD,SN

 .. S SN=$O(^BQICARE(OWNR,1,PLIEN,23,CRIEN,"B",SIEN,""))

 .. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=CRIEN,DA=SN,IENS=$$IENS^DILF(.DA)

 .. ;S BQIUPD(90505.1231,IENS,.03)=SIEN

 .. S BQIUPD(90505.1231,IENS,.03)=SI

 .. S BQIUPD(90505.1231,IENS,.04)=$P(SDIR,$C(29),SI)

 .. D FILE^DIE("","BQIUPD","ERROR")

 ;

 ; If the user is sharing someone else's panel.

 I OWNR'=DUZ D

 . S CRIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,"B",CARE,""))

 . I CRIEN="" D

 .. NEW DA,DIC

 .. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,X=CARE

 .. S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DA(1)_",23,",DIC(0)="L",DLAYGO=90505.323

 .. K DO,DD D FILE^DICN

 .. S CRIEN=+Y

 . NEW DA,IENS

 . S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=DUZ,DA(1)=CRIEN,DA=0

 . F  S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CRIEN,1,DA)) Q:'DA  D

 .. S IENS=$$IENS^DILF(.DA)

 .. S BQIDEL(90505.3231,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")'=CTYP 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)=CTYP

 .. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")

 .. K BQIUPD

 . ; If customized

 . F DI=1:1:$L(DOR,$C(29)) S GCODE=$P(DOR,$C(29),DI) Q:GCODE=""  D

 .. NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS

 .. S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=DUZ,DA(1)=CRIEN

 .. S DIC="^BQICARE("_DA(4)_",1,"_DA(3)_",30,"_DA(2)_",23,"_DA(1)_",1,",DIE=DIC

 .. S DLAYGO=90505.3231,DIC(0)="L",DIC("P")=DLAYGO

 .. S GIEN=$O(^BQI(90506.1,"B",GCODE,""))

 .. S X=GIEN

 .. I $G(^BQICARE(DA(4),1,DA(3),30,DA(2),23,DA(1),0))="" S ^BQICARE(DA(4),1,DA(3),30,DA(2),23,DA(1),0)="^90505.321^^"

 .. K DO,DD D FILE^DICN

 .. S DA=+Y I DA<1 S ERROR=1

 . ;

 . F SI=1:1:$L(SOR,$C(29)) S SIEN=$P(SOR,$C(29),SI) Q:SIEN=""  D

 .. NEW DA,X,IENS,SN

 .. S SN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CRIEN,"B",SIEN,""))

 .. S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=DUZ,DA(1)=CRIEN,DA=SN,IENS=$$IENS^DILF(.DA)

 .. ;S BQIUPD(90505.3231,IENS,.02)=SIEN

 .. S BQIUPD(90505.3231,IENS,.02)=SI

 .. S BQIUPD(90505.3231,IENS,.03)=$P(SDIR,$C(29),SI)

 . D FILE^DIE("I","BQIUPD","ERROR")

 . K BQIUPD

 Q

 ;

DFNC() ;EP -- Get the standard display order

 NEW CRIEN,TYP,ORD

 S DVALUE=""

 ; Check for any alternate display order which trumps source display order

 S CRIEN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")

 S TYP=$P(^BQI(90506.5,CRIEN,0),U,2)

 S ORD=""

 F  S ORD=$O(^BQI(90506.1,"AF",TYP,ORD)) Q:ORD=""  D

 . S IEN=""

 . F  S IEN=$O(^BQI(90506.1,"AF",TYP,ORD,IEN)) Q:IEN=""  D

 .. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D

 ... S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")

 ... S DVALUE=DVALUE_STVCD_$C(29)

 ;

 ; Get demographic data display order

 S CRIEN=$$FIND1^DIC(90506.5,"","B","Patient","","","ERROR")

 S TYP=$P(^BQI(90506.5,CRIEN,0),U,2)

 ; Check for alternate display order first

 S ORD=""

 F  S ORD=$O(^BQI(90506.1,"AD",TYP,ORD)) Q:ORD=""  D

 . S IEN=""

 . F  S IEN=$O(^BQI(90506.1,"AD",TYP,ORD,IEN)) Q:IEN=""  D

 .. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D

 ... S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")

 ... I STVCD="DCAT" Q

 ... S DVALUE=DVALUE_STVCD_$C(29)

 S DVALUE=$$TKO^BQIUL1(DVALUE,$C(29))

 Q DVALUE

 ;

SFNC() ;EP -- Get the standard sort order

 NEW CRIEN,TYP,ORD

 S SVALUE=""

 S CRIEN=$$FIND1^DIC(90506.5,"","B","Patient","","","ERROR")

 S TYP=$P(^BQI(90506.5,CRIEN,0),U,2)

 S ORD=""

 F  S ORD=$O(^BQI(90506.1,"AE",TYP,ORD)) Q:ORD=""  D

 . S IEN=""

 . F  S IEN=$O(^BQI(90506.1,"AE",TYP,ORD,IEN)) Q:IEN=""  D

 .. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D

 ... S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")

 ... S SVALUE=SVALUE_STVCD_$C(29)

 S SVALUE=$$TKO^BQIUL1(SVALUE,$C(29))

 Q SVALUE

 ;

CDEF() ; EP - Get Care Management source default fields

 NEW CRIEN,TYP,ORD

 S MVALUE=""

 S CRIEN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")

 S TYP=$P(^BQI(90506.5,CRIEN,0),U,2)

 ;

 ; Check for normal display order

 S ORD=""

 F  S ORD=$O(^BQI(90506.1,"AD",TYP,ORD)) Q:ORD=""  D

 . S IEN=""

 . F  S IEN=$O(^BQI(90506.1,"AD",TYP,ORD,IEN)) Q:IEN=""  D

 .. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D

 ... S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")

 ... S MVALUE=MVALUE_STVCD_$C(29)

 ;

 S MVALUE=$$TKO^BQIUL1(MVALUE,$C(29))

 Q MVALUE

 ;

TMPL(CARE) ;EP - Check if layout template is used

 ; CTYP = Care Mgmt type

 NEW CRN,CTYP,RESULT

 S CRN=$O(^BQI(90506.5,"B",CARE,""))

 S CTYP=$P(^BQI(90506.5,CRN,0),U,2),RESULT=0

 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(CARE) ;EP - Get Customized Care Management view

 NEW TIEN,TEMPL,DEF,TYP,DISPLAY,SORT,SDIR,CIEN,IEN,GIEN,SIEN,RIEN,CODE,SOR

 S DISPLAY="",SORT="",SDIR="",TIEN="",TEMPL="",RESULT=0,DEF=""

 S CIEN=$O(^BQICARE(OWNR,1,PLIEN,23,"B",CARE,"")) I CIEN="" Q RESULT

 S CRN=$O(^BQI(90506.5,"B",CARE,""))

 S TYP=$P(^BQI(90506.5,CRN,0),U,2)

 ;

 ; 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,23,CIEN,1,IEN)) Q:'IEN  D

 .. S GIEN=$P(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",1)

 .. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",3)

 .. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",4)

 .. S CODE=$P(^BQI(90506.1,GIEN,0),U,1)

 .. 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,23,CIEN,1,IEN)) Q:'IEN  D

 .. S GIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",1)

 .. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",3)

 .. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",4)

 .. S CODE=$P(^BQI(90506.1,GIEN,0),U,1)

 .. 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

BTPWPLVW  ;VNGT/HS/ALA-Panel View for CMET items ; 12 Feb 2009  1:18 PM

 +1       ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011

 +2       ;

 +3       ;

RET(DATA,OWNR,PLIEN) ; EP - BTPW GET CMET VIEW

 +1       ;Input Parameters

 +2       ;  OWNR  - Owner of panel

 +3       ;  PLIEN - Panel IEN

 +4       ;

 +5        NEW UID,II,MVALUE,IEN,GIEN,SIEN,DISPLAY,SOR,SDIR,TEMPL,LYIEN,BN,CIEN,CODE

 +6        NEW DVALUE,ORD,RIEN,SD,SORT,SR,SVALUE,STVCD,CRN

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

 +8        SET DATA=$NAME(^TMP("BQICMVW",UID))

 +9        KILL @DATA

 +10       SET II=0

 +11      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +12      ;

 +13       SET @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER^T00120SORT_ORDER^T00120SORT_DIRECTION"_$CHAR(30)

 +14      ;

 +15      ; If no owner supplied use DUZ

           SET OWNR=$GET(OWNR,$GET(DUZ))

           SET PLIEN=$GET(PLIEN,"")

 +16      ;I $G(CARE)="" S BMXSEC="No Care Management Selected" Q

 +17       SET CARE="Event Tracking"

 +18       IF CARE?.N

               SET CARE=$PIECE(^BQI(90506.5,CARE,0),U,1)

               SET TYP=$PIECE(^(0),U,2)

 +19       IF CARE'?.N

               SET CRN=$ORDER(^BQI(90506.5,"B",CARE,""))

               SET TYP=$PIECE(^BQI(90506.5,CRN,0),U,2)

 +20      ;

 +21      ; If there is a template

 +22       IF $$TMPL(CARE)

               GOTO DONE

 +23      ;

 +24      ; If there is a customized view

 +25       IF $$CVW(CARE)

               GOTO DONE

 +26      ;

 +27       SET TIEN=""

           SET TEMPL=""

           SET DEF=""

 +28       SET DISPLAY=$$DFNC()_$CHAR(29)_$$CDEF()

 +29       SET SORT=$$SFNC()

 +30       SET SDIR="A"

           SET TEMPL="System Default"

 +31       SET II=II+1

           SET @DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$CHAR(30)

 +32      ;S II=II+1,@DATA@(II)=DISPLAY_"^"_$G(SORT)_"^"_$G(SDIR)_$C(30)

 +33      ;

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       ;

UPD(DATA,OWNR,PLIEN,CARE,TEMPL,SOR,SDIR,DOR) ; EP -- BTPW SET CMET VIEW

 +1       ;

 +2       ;Description

 +3       ;   Update the display and sort order for a specified owner and panel

 +4       ;Input

 +5       ;   CARE - Source View Type

 +6       ;   SOR  - The sort order

 +7       ;   SDIR - The sort direction

 +8       ;   DOR  - The display order

 +9       ;

 +10      ; If the Owner and the User are the same person.

 +11       NEW UID,II,IEN,ERROR,BQIDEL,DI,GIEN,SI,GCODE,LIST,BN

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

 +13       SET DATA=$NAME(^TMP("BQICMVW",UID))

 +14       KILL @DATA

 +15       SET II=0

 +16       SET @DATA@(II)="I00010RESULT"_$CHAR(30)

 +17      ;

 +18       SET TEMPL=$GET(TEMPL,"")

           SET SOR=$GET(SOR,"")

           SET SDIR=$GET(SDIR,"")

           SET DOR=$GET(DOR,"")

 +19       IF DOR=""

               Begin DoDot:1

 +20               SET LIST=""

                   SET BN=""

 +21               FOR 

                       SET BN=$ORDER(DOR(BN))

                       IF BN=""

                           QUIT 

                       SET LIST=LIST_DOR(BN)

 +22               KILL DOR

 +23               SET DOR=LIST

 +24               KILL LIST

               End DoDot:1

 +25      ;

 +26      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +27      ;

 +28       DO FIL(OWNR,PLIEN,CARE,TEMPL,SOR,SDIR,DOR)

 +29      ;

 +30       IF $DATA(ERROR)

               SET II=II+1

               SET @DATA@(II)="-1"_$CHAR(30)

 +31       IF '$DATA(ERROR)

               SET II=II+1

               SET @DATA@(II)="1"_$CHAR(30)

 +32       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +33       QUIT 

 +34      ;

FIL(OWNR,PLIEN,CARE,TEMPL,SOR,SDIR,DOR) ; EP - Filer

 +1        NEW CRN,CTYP

 +2        SET CRN=$ORDER(^BQI(90506.5,"B",CARE,""))

 +3        SET CTYP=$PIECE(^BQI(90506.5,CRN,0),U,2)

 +4       ; If the user is the owner, delete the previous view values

 +5        IF OWNR=DUZ

               Begin DoDot:1

 +6                SET CRIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,23,"B",CARE,""))

 +7                IF CRIEN=""

                       Begin DoDot:2

 +8                        NEW DA,DIC

 +9                        SET DA(2)=OWNR

                           SET DA(1)=PLIEN

                           SET X=CARE

 +10                       SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",23,"

                           SET DIC(0)="L"

                           SET DLAYGO=90505.123

 +11                       KILL DO,DD

                           DO FILE^DICN

 +12                       SET CRIEN=+Y

                       End DoDot:2

 +13               NEW DA,IENS

 +14               SET DA(3)=OWNR

                   SET DA(2)=PLIEN

                   SET DA(1)=CRIEN

                   SET DA=0

 +15               FOR 

                       SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,23,CRIEN,1,DA))

                       IF 'DA

                           QUIT 

                       Begin DoDot:2

 +16                       SET IENS=$$IENS^DILF(.DA)

 +17                       SET BQIDEL(90505.1231,IENS,.01)="@"

                       End DoDot:2

 +18               IF $DATA(BQIDEL)

                       DO FILE^DIE("","BQIDEL","ERROR")

 +19               SET DA=0

 +20               FOR 

                       SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,DA))

                       IF 'DA

                           QUIT 

                       Begin DoDot:2

 +21                       SET IENS=$$IENS^DILF(.DA)

 +22                       IF $$GET1^DIQ(90505.14,IENS,.02,"I")'=CTYP

                               QUIT 

 +23                       SET BQIDEL(90505.14,IENS,.01)="@"

                       End DoDot:2

 +24               IF $DATA(BQIDEL)

                       DO FILE^DIE("","BQIDEL","ERROR")

 +25      ;

 +26      ; If template

 +27               IF $GET(TEMPL)'=""

                       Begin DoDot:2

 +28                       NEW DA,DIC,DLAYGO,IENS,DIE

 +29                       SET DA(2)=OWNR

                           SET DA(1)=PLIEN

 +30                       SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",4,"

                           SET DIE=DIC

 +31                       SET DLAYGO=90505.14

                           SET DIC(0)="L"

                           SET DIC("P")=DLAYGO

 +32                       IF '$DATA(^BQICARE(DA(2),1,DA(1),4,0))

                               SET ^BQICARE(DA(2),1,DA(1),4,0)="^90505.14^^"

 +33                       SET X=TEMPL

 +34                       DO ^DIC

 +35                       SET DA=+Y

 +36                       SET IENS=$$IENS^DILF(.DA)

 +37                       SET BQIUPD(90505.14,IENS,.02)=CTYP

 +38                       IF $DATA(BQIUPD)

                               DO FILE^DIE("","BQIUPD","ERROR")

 +39                       KILL BQIUPD

                       End DoDot:2

                       QUIT 

 +40      ; If customized 

 +41               FOR DI=1:1:$LENGTH(DOR,$CHAR(29))

                       SET GCODE=$PIECE(DOR,$CHAR(29),DI)