BQICEVW ;VNGT/HS/BEE - CMET Views ; 06 Jun 2008 2:22 PM
;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
;
RET(DATA,OWNR,PLIEN,CARE) ; EP - BQI GET CMET VIEW
; Input
; OWNR - Owner of the panel
; PLIEN - Panel internal entry number
; CARE - CMET Type
;Output
; DATA - name of global (passed by reference) in which the data
; is stored
;Variables used
; UID - TMP global subscript. Will be either $J or "Z" plus the
; TaskMan Task ID
;
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("BQICEVW",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICEVW 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,DUZ),PLIEN=$G(PLIEN,"") ; If no owner supplied use DUZ
I $G(CARE)="" S BMXSEC="No CMET Selected" Q
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(CRN,TYP)
S SDIR="A"_$C(29)_"D"_$C(29)_"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 -- BQI SET CARE MGMT 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^T00120MSG"_$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^"_$G(ERROR("DIERR",1,"TEXT",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")
. K DA,IENS
. ;
. N DA,IENS
. S DA(2)=OWNR,DA(1)=PLIEN
. 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")
. K DA,IENS
. ;
. ; 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=GCODE
.. 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) Q:SIEN="" D
.. NEW DA,X,IENS,BQIUPD
.. ;I SIEN'?.N S SIEN=$O(^BQI(90506.1,"B",SIEN,""))
.. S SN=$O(^BQICARE(OWNR,1,PLIEN,23,CRIEN,1,"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")
. K DA,IENS
. ;
. N DA,IENS
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ
. 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")
. K DA,IENS
. ;
. ; 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=GCODE
.. 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
.. ;I SIEN'?.N S SIEN=$O(^BQI(90506.1,"B",SIEN,""))
.. S SN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CRIEN,1,"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,KEY
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
.. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. 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,"AF",TYP,ORD)) Q:ORD="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AF",TYP,ORD,IEN)) Q:IEN="" D
.. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. 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)
;
; 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
.. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. 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)
S DVALUE=$$TKO^BQIUL1(DVALUE,$C(29))
Q DVALUE
;
SFNC(CRN,TYP) ;EP -- Get the standard sort order
NEW IEN,ORD,STVCD,SVALUE,KEY
S SVALUE=""
;
;Get CMET Sort(s) First
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
.. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
... S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
... S SVALUE=SVALUE_$S(SVALUE]"":$C(29),1:"")_STVCD
;
;Now Get Patient Sort(s)
S CRN=$$FIND1^DIC(90506.5,"","B","Patient","","","ERROR")
S TYP=$P(^BQI(90506.5,CRN,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
.. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
... S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
... S SVALUE=SVALUE_$S(SVALUE]"":$C(29),1:"")_STVCD
Q SVALUE
;
CDEF() ; EP - Get Care Management source default fields
NEW CRIEN,TYP,ORD,KEY
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
.. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. 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)
;
NEW KEY,DXCL,FDATA,CAT,REQ,SRC
S KEY=$P(^BQI(90506.5,CRIEN,0),U,12)
I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
S DXCL=0
F S DXCL=$O(^BQI(90506.5,CRIEN,10,DXCL)) Q:'DXCL D
. S FDATA=^BQI(90506.5,CRIEN,10,DXCL,0)
. I $P(FDATA,U,6)'="",$P(FDATA,U,6)'="O" D
.. S MVALUE=MVALUE_$P(FDATA,U,1)_$C(29)
;Get locally created care management columns if associated with a dx tag
NEW DXTN
S DXTN=$P($G(^BQI(90506.5,CRIEN,0)),U,11)
I DXTN'="" D
. S DXCL=0
. F S DXCL=$O(^BQI(90506.2,DXTN,6,DXCL)) Q:'DXCL D
.. S FDATA=^BQI(90506.2,DXTN,6,DXCL,0)
.. I $P(FDATA,U,6)'="",$P(FDATA,U,6)'="O" D
... S MVALUE=MVALUE_$P(FDATA,U,1)_$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 FL,TIEN,TEMPL,DEF,TYP,DISPLAY,SORT,SDIR,CIEN,IEN,GIEN,SIEN,RIEN,CODE,SOR
S DISPLAY="",SORT="",SDIR="",TIEN="",TEMPL="",RESULT=0,DEF=""
I $G(PLIEN)="" Q 0
;
; Owner and user are the same
S FL=1
I OWNR=DUZ D I FL=0 Q 0
. S CIEN=$O(^BQICARE(OWNR,1,PLIEN,23,"B",CARE,"")) I CIEN="" S FL=0 Q
. S CRN=$O(^BQI(90506.5,"B",CARE,""))
. S TYP=$P(^BQI(90506.5,CRN,0),U,2)
. S IEN=0,DISPLAY="",SORT="",SDIR=""
. 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 CODE=$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 I FL=0 Q 0
.S CIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,"B",CARE,"")) I CIEN="" S FL=0 Q
. S CRN=$O(^BQI(90506.5,"B",CARE,""))
. S TYP=$P(^BQI(90506.5,CRN,0),U,2)
. S IEN=0,DISPLAY="",SORT="",SDIR=""
. 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 CODE=$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
BQICEVW ;VNGT/HS/BEE - CMET Views ; 06 Jun 2008 2:22 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
+2 ;
RET(DATA,OWNR,PLIEN,CARE) ; EP - BQI GET CMET VIEW
+1 ; Input
+2 ; OWNR - Owner of the panel
+3 ; PLIEN - Panel internal entry number
+4 ; CARE - CMET Type
+5 ;Output
+6 ; DATA - name of global (passed by reference) in which the data
+7 ; is stored
+8 ;Variables used
+9 ; UID - TMP global subscript. Will be either $J or "Z" plus the
+10 ; TaskMan Task ID
+11 ;
+12 NEW UID,II,MVALUE,IEN,GIEN,SIEN,DISPLAY,SOR,SDIR,TEMPL,LYIEN,BN,CIEN,CODE
+13 NEW DVALUE,ORD,RIEN,SD,SORT,SR,SVALUE,STVCD,CRN
+14 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+15 SET DATA=$NAME(^TMP("BQICEVW",UID))
+16 KILL @DATA
+17 SET II=0
+18 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICEVW D UNWIND^%ZTER"
+19 ;
+20 SET @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER^T00120SORT_ORDER^T00120SORT_DIRECTION"_$CHAR(30)
+21 ;
+22 ; If no owner supplied use DUZ
SET OWNR=$GET(OWNR,DUZ)
SET PLIEN=$GET(PLIEN,"")
+23 IF $GET(CARE)=""
SET BMXSEC="No CMET Selected"
QUIT
+24 IF CARE?.N
SET CARE=$PIECE(^BQI(90506.5,CARE,0),U,1)
SET TYP=$PIECE(^(0),U,2)
+25 IF CARE'?.N
SET CRN=$ORDER(^BQI(90506.5,"B",CARE,""))
SET TYP=$PIECE(^BQI(90506.5,CRN,0),U,2)
+26 ;
+27 ; If there is a template
+28 IF $$TMPL(CARE)
GOTO DONE
+29 ;
+30 ; If there is a customized view
+31 IF $$CVW(CARE)
GOTO DONE
+32 ;
+33 SET TIEN=""
SET TEMPL=""
SET DEF=""
+34 SET DISPLAY=$$DFNC()_$CHAR(29)_$$CDEF()
+35 SET SORT=$$SFNC(CRN,TYP)
+36 SET SDIR="A"_$CHAR(29)_"D"_$CHAR(29)_"A"
SET TEMPL="System Default"
+37 SET II=II+1
SET @DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$CHAR(30)
+38 ;S II=II+1,@DATA@(II)=DISPLAY_"^"_$G(SORT)_"^"_$G(SDIR)_$C(30)
+39 ;
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 -- BQI SET CARE MGMT 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^T00120MSG"_$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^"_$GET(ERROR("DIERR",1,"TEXT",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 KILL DA,IENS
+20 ;
+21 NEW DA,IENS
+22 SET DA(2)=OWNR
SET DA(1)=PLIEN
+23 SET DA=0
+24 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,DA))
IF 'DA
QUIT
Begin DoDot:2
+25 SET IENS=$$IENS^DILF(.DA)
+26 IF $$GET1^DIQ(90505.14,IENS,.02,"I")'=CTYP
QUIT
+27 SET BQIDEL(90505.14,IENS,.01)="@"
End DoDot:2
+28 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+29 KILL DA,IENS
+30 ;
+31 ; If template
+32 IF $GET(TEMPL)'=""
Begin DoDot:2
+33 NEW DA,DIC,DLAYGO,IENS,DIE
+34 SET DA(2)=OWNR
SET DA(1)=PLIEN
+35 SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",4,"
SET DIE=DIC
+36 SET DLAYGO=90505.14
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+37 IF '$DATA(^BQICARE(DA(2),1,DA(1),4,0))
SET ^BQICARE(DA(2),1,DA(1),4,0)="^90505.14^^"
+38 SET X=TEMPL
+39 DO ^DIC
+40 SET DA=+Y
+41 SET IENS=$$IENS^DILF(.DA)
+42 SET BQIUPD(90505.14,IENS,.02)=CTYP
+43 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+44 KILL BQIUPD
End DoDot:2
QUIT
+45 ; If customized
+46 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
SET GCODE=$PIECE(DOR,$CHAR(29),DI)
IF GCODE=""
QUIT
Begin DoDot:2
+47 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
+48 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=CRIEN
+49 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",23,"_DA(1)_",1,"
SET DIE=DIC
+50 SET DLAYGO=90505.1231
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+51 ;S GIEN=$O(^BQI(90506.1,"B",GCODE,""))
+52 SET X=GCODE
+53 IF $GET(^BQICARE(DA(3),1,DA(2),23,DA(1),0))=""
SET ^BQICARE(DA(3),1,DA(2),23,DA(1),0)="^90505.1231^^"
+54 KILL DO,DD
DO FILE^DICN
+55 SET DA=+Y
IF DA<1
SET ERROR=1
QUIT
+56 SET IENS=$$IENS^DILF(.DA)
+57 SET BQIUPD(90505.1231,IENS,.02)=DI
+58 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:2
+59 ;
+60 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
SET SIEN=$PIECE(SOR,$CHAR(29),SI)
IF SIEN=""
QUIT
Begin DoDot:2
+61 NEW DA,X,IENS,BQIUPD
+62 ;I SIEN'?.N S SIEN=$O(^BQI(90506.1,"B",SIEN,""))
+63 SET SN=$ORDER(^BQICARE(OWNR,1,PLIEN,23,CRIEN,1,"B",SIEN,""))
+64 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=CRIEN
SET DA=SN
SET IENS=$$IENS^DILF(.DA)
+65 ;S BQIUPD(90505.1231,IENS,.03)=SIEN
+66 SET BQIUPD(90505.1231,IENS,.03)=SI
+67 SET BQIUPD(90505.1231,IENS,.04)=$PIECE(SDIR,$CHAR(29),SI)
+68 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:2
End DoDot:1
QUIT
+69 ;
+70 ; If the user is sharing someone else's panel.
+71 IF OWNR'=DUZ
Begin DoDot:1
+72 SET CRIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,"B",CARE,""))
+73 IF CRIEN=""
Begin DoDot:2
+74 NEW DA,DIC
+75 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET X=CARE
+76 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DA(1)_",23,"
SET DIC(0)="L"
SET DLAYGO=90505.323
+77 KILL DO,DD
DO FILE^DICN
+78 SET CRIEN=+Y
End DoDot:2
+79 NEW DA,IENS
+80 SET DA(4)=OWNR
SET DA(3)=PLIEN
SET DA(2)=DUZ
SET DA(1)=CRIEN
SET DA=0
+81 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CRIEN,1,DA))
IF 'DA
QUIT
Begin DoDot:2
+82 SET IENS=$$IENS^DILF(.DA)
+83 SET BQIDEL(90505.3231,IENS,.01)="@"
End DoDot:2
+84 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+85 KILL DA,IENS
+86 ;
+87 NEW DA,IENS
+88 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
+89 SET DA=0
+90 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,DA))
IF 'DA
QUIT
Begin DoDot:2
+91 SET IENS=$$IENS^DILF(.DA)
+92 IF $$GET1^DIQ(90505.34,IENS,.02,"I")'=CTYP
QUIT
+93 SET BQIDEL(90505.34,IENS,.01)="@"
End DoDot:2
+94 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+95 KILL DA,IENS
+96 ;
+97 ; If template
+98 IF $GET(TEMPL)'=""
Begin DoDot:2
+99 NEW DA,DIC,DLAYGO,IENS,DIE
+100 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
+101 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DUZ_",4,"
SET DIE=DIC
+102 SET DLAYGO=90505.34
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+103 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^^"
+104 SET X=TEMPL
+105 DO ^DIC
+106 SET DA=+Y
+107 SET IENS=$$IENS^DILF(.DA)
+108 SET BQIUPD(90505.34,IENS,.02)=CTYP
+109 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+110 KILL BQIUPD
End DoDot:2
QUIT
+111 ; If customized
+112 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
SET GCODE=$PIECE(DOR,$CHAR(29),DI)
IF GCODE=""
QUIT
Begin DoDot:2
+113 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
+114 SET DA(4)=OWNR
SET DA(3)=PLIEN
SET DA(2)=DUZ
SET DA(1)=CRIEN
+115 SET DIC="^BQICARE("_DA(4)_",1,"_DA(3)_",30,"_DA(2)_",23,"_DA(1)_",1,"
SET DIE=DIC
+116 SET DLAYGO=90505.3231
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+117 ;S GIEN=$O(^BQI(90506.1,"B",GCODE,""))
+118 SET X=GCODE
+119 IF $GET(^BQICARE(DA(4),1,DA(3),30,DA(2),23,DA(1),0))=""
SET ^BQICARE(DA(4),1,DA(3),30,DA(2),23,DA(1),0)="^90505.321^^"
+120 KILL DO,DD
DO FILE^DICN
+121 SET DA=+Y
IF DA<1
SET ERROR=1
End DoDot:2
+122 ;
+123 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
SET SIEN=$PIECE(SOR,$CHAR(29),SI)
IF SIEN=""
QUIT
Begin DoDot:2
+124 NEW DA,X,IENS
+125 ;I SIEN'?.N S SIEN=$O(^BQI(90506.1,"B",SIEN,""))
+126 SET SN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CRIEN,1,"B",SIEN,""))
+127 SET DA(4)=OWNR
SET DA(3)=PLIEN
SET DA(2)=DUZ
SET DA(1)=CRIEN
SET DA=SN
SET IENS=$$IENS^DILF(.DA)
+128 ;S BQIUPD(90505.3231,IENS,.02)=SIEN
+129 SET BQIUPD(90505.3231,IENS,.02)=SI
+130 SET BQIUPD(90505.3231,IENS,.03)=$PIECE(SDIR,$CHAR(29),SI)
End DoDot:2
+131 DO FILE^DIE("I","BQIUPD","ERROR")
+132 KILL BQIUPD
End DoDot:1
+133 QUIT
+134 ;
DFNC() ;EP -- Get the standard display order
+1 NEW CRIEN,TYP,ORD,KEY
+2 SET DVALUE=""
+3 ; Check for any alternate display order which trumps source display order
+4 SET CRIEN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")
+5 SET TYP=$PIECE(^BQI(90506.5,CRIEN,0),U,2)
+6 SET ORD=""
+7 FOR
SET ORD=$ORDER(^BQI(90506.1,"AF",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+8 SET IEN=""
+9 FOR
SET IEN=$ORDER(^BQI(90506.1,"AF",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+10 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+11 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+12 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+13 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+14 SET DVALUE=DVALUE_STVCD_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 ; Get demographic data display order
+17 SET CRIEN=$$FIND1^DIC(90506.5,"","B","Patient","","","ERROR")
+18 SET TYP=$PIECE(^BQI(90506.5,CRIEN,0),U,2)
+19 ; Check for alternate display order first
+20 SET ORD=""
+21 FOR
SET ORD=$ORDER(^BQI(90506.1,"AF",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+22 SET IEN=""
+23 FOR
SET IEN=$ORDER(^BQI(90506.1,"AF",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+24 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+25 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+26 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+27 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+28 SET DVALUE=DVALUE_STVCD_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;
+30 ; Check for normal display order
+31 SET ORD=""
+32 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+33 SET IEN=""
+34 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+35 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+36 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+37 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+38 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+39 SET DVALUE=DVALUE_STVCD_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+40 SET DVALUE=$$TKO^BQIUL1(DVALUE,$CHAR(29))
+41 QUIT DVALUE
+42 ;
SFNC(CRN,TYP) ;EP -- Get the standard sort order
+1 NEW IEN,ORD,STVCD,SVALUE,KEY
+2 SET SVALUE=""
+3 ;
+4 ;Get CMET Sort(s) First
+5 SET ORD=""
+6 FOR
SET ORD=$ORDER(^BQI(90506.1,"AE",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+7 SET IEN=""
+8 FOR
SET IEN=$ORDER(^BQI(90506.1,"AE",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+9 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+10 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+11 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+12 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+13 SET SVALUE=SVALUE_$SELECT(SVALUE]"":$CHAR(29),1:"")_STVCD
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 ;Now Get Patient Sort(s)
+16 SET CRN=$$FIND1^DIC(90506.5,"","B","Patient","","","ERROR")
+17 SET TYP=$PIECE(^BQI(90506.5,CRN,0),U,2)
+18 SET ORD=""
+19 FOR
SET ORD=$ORDER(^BQI(90506.1,"AE",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+20 SET IEN=""
+21 FOR
SET IEN=$ORDER(^BQI(90506.1,"AE",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+22 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+23 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+24 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+25 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+26 SET SVALUE=SVALUE_$SELECT(SVALUE]"":$CHAR(29),1:"")_STVCD
End DoDot:3
End DoDot:2
End DoDot:1
+27 QUIT SVALUE
+28 ;
CDEF() ; EP - Get Care Management source default fields
+1 NEW CRIEN,TYP,ORD,KEY
+2 SET MVALUE=""
+3 SET CRIEN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")
+4 SET TYP=$PIECE(^BQI(90506.5,CRIEN,0),U,2)
+5 ;
+6 ; Check for normal display order
+7 SET ORD=""
+8 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD",TYP,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+9 SET IEN=""
+10 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD",TYP,ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+11 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+12 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+13 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+14 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+15 SET MVALUE=MVALUE_STVCD_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 NEW KEY,DXCL,FDATA,CAT,REQ,SRC
+18 SET KEY=$PIECE(^BQI(90506.5,CRIEN,0),U,12)
+19 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+20 SET DXCL=0
+21 FOR
SET DXCL=$ORDER(^BQI(90506.5,CRIEN,10,DXCL))
IF 'DXCL
QUIT
Begin DoDot:1
+22 SET FDATA=^BQI(90506.5,CRIEN,10,DXCL,0)
+23 IF $PIECE(FDATA,U,6)'=""
IF $PIECE(FDATA,U,6)'="O"
Begin DoDot:2
+24 SET MVALUE=MVALUE_$PIECE(FDATA,U,1)_$CHAR(29)
End DoDot:2
End DoDot:1
+25 ;Get locally created care management columns if associated with a dx tag
+26 NEW DXTN
+27 SET DXTN=$PIECE($GET(^BQI(90506.5,CRIEN,0)),U,11)
+28 IF DXTN'=""
Begin DoDot:1
+29 SET DXCL=0
+30 FOR
SET DXCL=$ORDER(^BQI(90506.2,DXTN,6,DXCL))
IF 'DXCL
QUIT
Begin DoDot:2
+31 SET FDATA=^BQI(90506.2,DXTN,6,DXCL,0)
+32 IF $PIECE(FDATA,U,6)'=""
IF $PIECE(FDATA,U,6)'="O"
Begin DoDot:3
+33 SET MVALUE=MVALUE_$PIECE(FDATA,U,1)_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+34 SET MVALUE=$$TKO^BQIUL1(MVALUE,$CHAR(29))
+35 QUIT MVALUE
+36 ;
TMPL(CARE) ;EP - Check if layout template is used
+1 ; CTYP = Care Mgmt type
+2 NEW CRN,CTYP,RESULT
+3 SET CRN=$ORDER(^BQI(90506.5,"B",CARE,""))
+4 SET CTYP=$PIECE(^BQI(90506.5,CRN,0),U,2)
SET RESULT=0
+5 NEW DA,IENS,TEMPL,LYIEN
+6 SET TEMPL=""
+7 IF OWNR'=DUZ
Begin DoDot:1
+8 IF $GET(PLIEN)=""
QUIT
+9 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
+10 IF DA=""
QUIT
+11 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET IENS=$$IENS^DILF(.DA)
+12 SET TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
End DoDot:1
+13 IF OWNR=DUZ
Begin DoDot:1
+14 IF $GET(PLIEN)=""
QUIT
+15 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
+16 IF DA=""
QUIT
+17 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET IENS=$$IENS^DILF(.DA)
+18 SET TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
End DoDot:1
+19 IF TEMPL'=""
Begin DoDot:1
+20 ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
+21 SET LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
+22 IF LYIEN=""
QUIT
+23 DO DEF^BQILYDEF(LYIEN)
+24 SET RESULT=1
+25 ;S DISPLAY=$P(@DATA@(II),U,3),SOR=$P(@DATA@(II),U,4),SDIR=$P(@DATA@(II),U,5)
End DoDot:1
+26 QUIT RESULT
+27 ;
CVW(CARE) ;EP - Get Customized Care Management view
+1 NEW FL,TIEN,TEMPL,DEF,TYP,DISPLAY,SORT,SDIR,CIEN,IEN,GIEN,SIEN,RIEN,CODE,SOR
+2 SET DISPLAY=""
SET SORT=""
SET SDIR=""
SET TIEN=""
SET TEMPL=""
SET RESULT=0
SET DEF=""
+3 IF $GET(PLIEN)=""
QUIT 0
+4 ;
+5 ; Owner and user are the same
+6 SET FL=1
+7 IF OWNR=DUZ
Begin DoDot:1
+8 SET CIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,23,"B",CARE,""))
IF CIEN=""
SET FL=0
QUIT
+9 SET CRN=$ORDER(^BQI(90506.5,"B",CARE,""))
+10 SET TYP=$PIECE(^BQI(90506.5,CRN,0),U,2)
+11 SET IEN=0
SET DISPLAY=""
SET SORT=""
SET SDIR=""
+12 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+13 ;S GIEN=$P(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",1)
+14 SET CODE=$PIECE(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",1)
+15 SET SIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",3)
+16 SET RIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,23,CIEN,1,IEN,0),"^",4)
+17 ;S CODE=$P(^BQI(90506.1,GIEN,0),U,1)
+18 SET DISPLAY=DISPLAY_CODE_$CHAR(29)
+19 IF SIEN'=""
Begin DoDot:3
+20 ;I SIEN?.N S CODE=$P(^BQI(90506.1,SIEN,0),U,1)
+21 ;E S CODE=SIEN
+22 ;S SORT=SORT_CODE_$C(29)
+23 SET $PIECE(SORT,$CHAR(29),SIEN)=CODE
+24 SET $PIECE(SDIR,$CHAR(29),SIEN)=RIEN
End DoDot:3
+25 ;S SDIR=SDIR_RIEN_$C(29)
End DoDot:2
End DoDot:1
IF FL=0
QUIT 0
+26 ;
+27 ; User is not owner but share
+28 IF OWNR'=DUZ
Begin DoDot:1
+29 SET CIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,"B",CARE,""))
IF CIEN=""
SET FL=0
QUIT
+30 SET CRN=$ORDER(^BQI(90506.5,"B",CARE,""))
+31 SET TYP=$PIECE(^BQI(90506.5,CRN,0),U,2)
+32 SET IEN=0
SET DISPLAY=""
SET SORT=""
SET SDIR=""
+33 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+34 ;S GIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",1)
+35 SET CODE=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",1)
+36 SET SIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",3)
+37 SET RIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,23,CIEN,1,IEN,0),"^",4)
+38 ;S CODE=$P(^BQI(90506.1,GIEN,0),U,1)
+39 SET DISPLAY=DISPLAY_CODE_$CHAR(29)
+40 IF SIEN'=""
Begin DoDot:3
+41 ;I SIEN?.N S CODE=$P(^BQI(90506.1,SIEN,0),U,1)
+42 ;E S CODE=SIEN
+43 ;S SORT=SORT_CODE_$C(29)
+44 SET $PIECE(SORT,$CHAR(29),SIEN)=CODE
+45 SET $PIECE(SDIR,$CHAR(29),SIEN)=RIEN
End DoDot:3
+46 ;S SDIR=SDIR_RIEN_$C(29)
End DoDot:2
End DoDot:1
IF FL=0
QUIT 0
+47 ;
+48 SET DISPLAY=$$TKO^BQIUL1(DISPLAY,$CHAR(29))
+49 SET SORT=$$TKO^BQIUL1(SORT,$CHAR(29))
+50 SET SDIR=$$TKO^BQIUL1(SDIR,$CHAR(29))
+51 IF DISPLAY'=""
Begin DoDot:1
+52 SET RESULT=1
+53 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
+54 QUIT RESULT
