BQIMSVW ;PRXM/HC/ALA-My Measures View ; 01 Jun 2007 5:38 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
RET(DATA,OWNR,PLIEN) ; EP -- BQI GET MEASURES VIEW
; Input
; OWNR - Owner of the panel
; PLIEN - Panel internal entry number
;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
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMSVW",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMSVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T01024DISPLAY_ORDER^T00300SORT_ORDER^T00300SORT_DIRECTION"_$C(30)
;
S OWNR=$G(OWNR,$G(DUZ)),PLIEN=$G(PLIEN,"") ; If no owner supplied use DUZ
;
I OWNR=DUZ,PLIEN'="" D G DONE
. ; Check if customized My Measures view
. S IEN=0,DISPLAY="",SOR="",SDIR=""
. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,21,IEN)) Q:'IEN D
.. S GIEN=$P(^BQICARE(OWNR,1,PLIEN,21,IEN,0),"^",1)
.. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,21,IEN,0),"^",3)
.. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,21,IEN,0),"^",4)
.. S DISPLAY=DISPLAY_GIEN_$C(29)
.. S SOR=SOR_SIEN_$C(29)
.. S SDIR=SDIR_RIEN_$C(29)
. S DISPLAY=$$TKO^BQIUL1(DISPLAY,$C(29))
. S SOR=$$TKO^BQIUL1(SOR,$C(29))
. S SDIR=$$TKO^BQIUL1(SDIR,$C(29))
. ;
. I $G(DISPLAY)="" D
.. ; check if layout template used
.. NEW DA,IENS,TEMPL,LYIEN
.. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
.. S TEMPL=$$GET1^DIQ(90505.01,IENS,4.02,"E")
.. I TEMPL'="" D
... S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
... I LYIEN="" Q
... D DEF^BQILYDEF(LYIEN)
... S DISPLAY=$P(@DATA@(II),U,3),SOR=$P(@DATA@(II),U,4),SDIR=$P(@DATA@(II),U,5)
.. ;
.. I $G(DISPLAY)'="" Q
.. ;
.. S DISPLAY=$$DFNC()_$C(29)_$$MDEF()
.. ;S DISPLAY=$$DFNC()
.. ;S SOR=$$SFNC()_$C(29)
.. S SOR=$$SFNC()
.. S SDIR=""
. I SDIR="" S SDIR="A"
. S II=II+1,@DATA@(II)=DISPLAY_"^"_SOR_"^"_SDIR_$C(30)
;
I OWNR'="",OWNR'=DUZ,PLIEN'="" D
. S IEN=0,DISPLAY="",SORT="",SDIR=""
. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN)) Q:'IEN D
.. S GIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN,0),"^",1)
.. S SR=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN,0),"^",2)
.. S SD=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN,0),"^",3)
.. S DISPLAY=DISPLAY_GIEN_$C(29)
.. I SR'="" S SORT=SORT_SR_$C(29)
.. I SD'="" S SDIR=SDIR_SD_$C(29)
. S DISPLAY=$$TKO^BQIUL1(DISPLAY,$C(29))
. S SORT=$$TKO^BQIUL1(SORT,$C(29))
. S SDIR=$$TKO^BQIUL1(SDIR,$C(29))
;
I $G(DISPLAY)="" D
.; check if layout template used
. NEW DA,IENS,TEMPL,LYIEN
. S DA(2)=OWNR,DA(1)=PLIEN,DA=DUZ,IENS=$$IENS^DILF(.DA)
. S TEMPL=$$GET1^DIQ(90505.03,IENS,4.02,"E")
. I TEMPL'="" D
.. S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
.. I LYIEN="" Q
.. D DEF^BQILYDEF(LYIEN)
.. S DISPLAY=$P(@DATA@(II),U,3),SOR=$P(@DATA@(II),U,4),SDIR=$P(@DATA@(II),U,5)
. ;
. I $G(DISPLAY)'="" Q
. ;
. S DISPLAY=$$DFNC()_$C(29)_$$MDEF()
. ;S DISPLAY=$$DFNC()
. S SORT=$$SFNC()
. S SDIR="A"
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,SOR,SDIR,DOR) ; EP -- BQI SET MEASURES VIEW
;
;Description
; Update the display and sort order for a specified owner and panel
;Input
; DOR - The display order
; SOR - The sort order
; SDIR - The sort direction
;
; If the Owner and the User are the same person.
NEW UID,II,IEN,ERROR,BQIDEL,DI,GIEN,SI
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMSVW",UID))
K @DATA
S II=0
S @DATA@(II)="I00010RESULT"_$C(30)
;
S SOR=$G(SOR,""),SDIR=$G(SDIR,"")
S 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^BQIMSVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; If the user is the owner, delete the previous view values
I OWNR=DUZ D G DONE
. NEW DA,IENS
. S DA(2)=OWNR,DA(1)=PLIEN,DA=0
. F S DA=$O(^BQICARE(OWNR,1,PLIEN,21,DA)) Q:'DA D
.. S IENS=$$IENS^DILF(.DA)
.. S BQIDEL(90505.13,IENS,.01)="@"
. I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
. ;
. F DI=1:1:$L(DOR,$C(29)) S GIEN=$P(DOR,$C(29),DI) Q:GIEN="" D
.. NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
.. S DA(2)=OWNR,DA(1)=PLIEN
.. S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",21,",DIE=DIC
.. S DLAYGO=90505.13,DIC(0)="L",DIC("P")=DLAYGO
.. S X=GIEN
.. I '$D(^BQICARE(DA(2),1,DA(1),21,0)) S ^BQICARE(DA(2),1,DA(1),21,0)="^90505.13^^"
.. K DO,DD D FILE^DICN
.. S DA=+Y I DA<1 S ERROR=1 Q
.. S IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90505.13,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
.. S DA(2)=OWNR,DA(1)=PLIEN,DA=SI,IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90505.13,IENS,.03)=SIEN
.. S BQIUPD(90505.13,IENS,.04)=$P(SDIR,$C(29),SI)
.. D FILE^DIE("","BQIUPD","ERROR")
. ;
. I $D(ERROR) S II=II+1,@DATA@(II)="-1"_$C(30)
. I '$D(ERROR) S II=II+1,@DATA@(II)="1"_$C(30)
;
; If the user is sharing someone else's panel.
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,21,DA)) Q:'DA D
. S IENS=$$IENS^DILF(.DA)
. S BQIDEL(90505.321,IENS,.01)="@"
I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
;
F DI=1:1:$L(DOR,$C(29)) S GIEN=$P(DOR,$C(29),DI) Q:GIEN="" D
. 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,"_DA(1)_",21,",DIE=DIC
. S DLAYGO=90505.321,DIC(0)="L",DIC("P")=DLAYGO
. S X=GIEN
. I '$D(^BQICARE(DA(3),1,DA(2),30,DA(1),21,0)) S ^BQICARE(DA(3),1,DA(2),30,DA(1),21,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
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=SI,IENS=$$IENS^DILF(.DA)
. S BQIUPD(90505.321,IENS,.02)=SIEN
. S BQIUPD(90505.321,IENS,.03)=$P(SDIR,$C(29),SI)
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
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
;
DFNC() ;EP -- Get the standard display order
S DVALUE=""
S DOR="" F S DOR=$O(^BQI(90506.1,"AD","D",DOR)) Q:DOR="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AD","D",DOR,IEN)) Q:IEN="" D
.. ;I $$GET1^DIQ(90506.1,IEN_",",.13,"I")'="O" 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)
S DVALUE=$$TKO^BQIUL1(DVALUE,$C(29))
Q DVALUE
;
SFNC() ;EP -- Get the standard sort order
S SVALUE=""
S SOR="" F S SOR=$O(^BQI(90506.1,"AE","D",SOR)) Q:SOR="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AE","D",SOR,IEN)) Q:IEN="" D
.. ;I $$GET1^DIQ(90506.1,IEN_",",.13,"I")'="O" 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
;
MDEF() ; EP - Get Measures default fields
S MVALUE=""
F TYP="G","R","A","H" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AC",TYP,IEN)) Q:IEN="" D
.. ;I $$GET1^DIQ(90506.1,IEN_",",.09,"I")'="O" 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
BQIMSVW ;PRXM/HC/ALA-My Measures View ; 01 Jun 2007 5:38 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
RET(DATA,OWNR,PLIEN) ; EP -- BQI GET MEASURES VIEW
+1 ; Input
+2 ; OWNR - Owner of the panel
+3 ; PLIEN - Panel internal entry number
+4 ;Output
+5 ; DATA - name of global (passed by reference) in which the data
+6 ; is stored
+7 ;Variables used
+8 ; UID - TMP global subscript. Will be either $J or "Z" plus the
+9 ; TaskMan Task ID
+10 ;
+11 NEW UID,II,MVALUE,IEN,GIEN,SIEN,DISPLAY,SOR,SDIR,TEMPL,LYIEN
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("BQIMSVW",UID))
+14 KILL @DATA
+15 SET II=0
+16 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMSVW D UNWIND^%ZTER"
+17 ;
+18 SET @DATA@(II)="T01024DISPLAY_ORDER^T00300SORT_ORDER^T00300SORT_DIRECTION"_$CHAR(30)
+19 ;
+20 ; If no owner supplied use DUZ
SET OWNR=$GET(OWNR,$GET(DUZ))
SET PLIEN=$GET(PLIEN,"")
+21 ;
+22 IF OWNR=DUZ
IF PLIEN'=""
Begin DoDot:1
+23 ; Check if customized My Measures view
+24 SET IEN=0
SET DISPLAY=""
SET SOR=""
SET SDIR=""
+25 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,21,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+26 SET GIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,21,IEN,0),"^",1)
+27 SET SIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,21,IEN,0),"^",3)
+28 SET RIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,21,IEN,0),"^",4)
+29 SET DISPLAY=DISPLAY_GIEN_$CHAR(29)
+30 SET SOR=SOR_SIEN_$CHAR(29)
+31 SET SDIR=SDIR_RIEN_$CHAR(29)
End DoDot:2
+32 SET DISPLAY=$$TKO^BQIUL1(DISPLAY,$CHAR(29))
+33 SET SOR=$$TKO^BQIUL1(SOR,$CHAR(29))
+34 SET SDIR=$$TKO^BQIUL1(SDIR,$CHAR(29))
+35 ;
+36 IF $GET(DISPLAY)=""
Begin DoDot:2
+37 ; check if layout template used
+38 NEW DA,IENS,TEMPL,LYIEN
+39 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+40 SET TEMPL=$$GET1^DIQ(90505.01,IENS,4.02,"E")
+41 IF TEMPL'=""
Begin DoDot:3
+42 SET LYIEN=$$DEF^BQILYUTL(OWNR,"M")
+43 IF LYIEN=""
QUIT
+44 DO DEF^BQILYDEF(LYIEN)
+45 SET DISPLAY=$PIECE(@DATA@(II),U,3)
SET SOR=$PIECE(@DATA@(II),U,4)
SET SDIR=$PIECE(@DATA@(II),U,5)
End DoDot:3
+46 ;
+47 IF $GET(DISPLAY)'=""
QUIT
+48 ;
+49 SET DISPLAY=$$DFNC()_$CHAR(29)_$$MDEF()
+50 ;S DISPLAY=$$DFNC()
+51 ;S SOR=$$SFNC()_$C(29)
+52 SET SOR=$$SFNC()
+53 SET SDIR=""
End DoDot:2
+54 IF SDIR=""
SET SDIR="A"
+55 SET II=II+1
SET @DATA@(II)=DISPLAY_"^"_SOR_"^"_SDIR_$CHAR(30)
End DoDot:1
GOTO DONE
+56 ;
+57 IF OWNR'=""
IF OWNR'=DUZ
IF PLIEN'=""
Begin DoDot:1
+58 SET IEN=0
SET DISPLAY=""
SET SORT=""
SET SDIR=""
+59 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+60 SET GIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN,0),"^",1)
+61 SET SR=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN,0),"^",2)
+62 SET SD=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,IEN,0),"^",3)
+63 SET DISPLAY=DISPLAY_GIEN_$CHAR(29)
+64 IF SR'=""
SET SORT=SORT_SR_$CHAR(29)
+65 IF SD'=""
SET SDIR=SDIR_SD_$CHAR(29)
End DoDot:2
+66 SET DISPLAY=$$TKO^BQIUL1(DISPLAY,$CHAR(29))
+67 SET SORT=$$TKO^BQIUL1(SORT,$CHAR(29))
+68 SET SDIR=$$TKO^BQIUL1(SDIR,$CHAR(29))
End DoDot:1
+69 ;
+70 IF $GET(DISPLAY)=""
Begin DoDot:1
+71 ; check if layout template used
+72 NEW DA,IENS,TEMPL,LYIEN
+73 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=DUZ
SET IENS=$$IENS^DILF(.DA)
+74 SET TEMPL=$$GET1^DIQ(90505.03,IENS,4.02,"E")
+75 IF TEMPL'=""
Begin DoDot:2
+76 SET LYIEN=$$DEF^BQILYUTL(OWNR,"M")
+77 IF LYIEN=""
QUIT
+78 DO DEF^BQILYDEF(LYIEN)
+79 SET DISPLAY=$PIECE(@DATA@(II),U,3)
SET SOR=$PIECE(@DATA@(II),U,4)
SET SDIR=$PIECE(@DATA@(II),U,5)
End DoDot:2
+80 ;
+81 IF $GET(DISPLAY)'=""
QUIT
+82 ;
+83 SET DISPLAY=$$DFNC()_$CHAR(29)_$$MDEF()
+84 ;S DISPLAY=$$DFNC()
+85 SET SORT=$$SFNC()
+86 SET SDIR="A"
End DoDot:1
+87 SET II=II+1
SET @DATA@(II)=DISPLAY_"^"_$GET(SORT)_"^"_$GET(SDIR)_$CHAR(30)
+88 ;
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,SOR,SDIR,DOR) ; EP -- BQI SET MEASURES VIEW
+1 ;
+2 ;Description
+3 ; Update the display and sort order for a specified owner and panel
+4 ;Input
+5 ; DOR - The display order
+6 ; SOR - The sort order
+7 ; SDIR - The sort direction
+8 ;
+9 ; If the Owner and the User are the same person.
+10 NEW UID,II,IEN,ERROR,BQIDEL,DI,GIEN,SI
+11 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+12 SET DATA=$NAME(^TMP("BQIMSVW",UID))
+13 KILL @DATA
+14 SET II=0
+15 SET @DATA@(II)="I00010RESULT"_$CHAR(30)
+16 ;
+17 SET SOR=$GET(SOR,"")
SET SDIR=$GET(SDIR,"")
+18 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^BQIMSVW D UNWIND^%ZTER"
+27 ;
+28 ; If the user is the owner, delete the previous view values
+29 IF OWNR=DUZ
Begin DoDot:1
+30 NEW DA,IENS
+31 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=0
+32 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,21,DA))
IF 'DA
QUIT
Begin DoDot:2
+33 SET IENS=$$IENS^DILF(.DA)
+34 SET BQIDEL(90505.13,IENS,.01)="@"
End DoDot:2
+35 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+36 ;
+37 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
SET GIEN=$PIECE(DOR,$CHAR(29),DI)
IF GIEN=""
QUIT
Begin DoDot:2
+38 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
+39 SET DA(2)=OWNR
SET DA(1)=PLIEN
+40 SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",21,"
SET DIE=DIC
+41 SET DLAYGO=90505.13
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+42 SET X=GIEN
+43 IF '$DATA(^BQICARE(DA(2),1,DA(1),21,0))
SET ^BQICARE(DA(2),1,DA(1),21,0)="^90505.13^^"
+44 KILL DO,DD
DO FILE^DICN
+45 SET DA=+Y
IF DA<1
SET ERROR=1
QUIT
+46 SET IENS=$$IENS^DILF(.DA)
+47 SET BQIUPD(90505.13,IENS,.02)=DI
+48 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:2
+49 ;
+50 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
SET SIEN=$PIECE(SOR,$CHAR(29),SI)
Begin DoDot:2
+51 NEW DA,X,IENS,BQIUPD
+52 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=SI
SET IENS=$$IENS^DILF(.DA)
+53 SET BQIUPD(90505.13,IENS,.03)=SIEN
+54 SET BQIUPD(90505.13,IENS,.04)=$PIECE(SDIR,$CHAR(29),SI)
+55 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:2
+56 ;
+57 IF $DATA(ERROR)
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
+58 IF '$DATA(ERROR)
SET II=II+1
SET @DATA@(II)="1"_$CHAR(30)
End DoDot:1
GOTO DONE
+59 ;
+60 ; If the user is sharing someone else's panel.
+61 NEW DA,IENS
+62 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=0
+63 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,21,DA))
IF 'DA
QUIT
Begin DoDot:1
+64 SET IENS=$$IENS^DILF(.DA)
+65 SET BQIDEL(90505.321,IENS,.01)="@"
End DoDot:1
+66 IF $DATA(BQIDEL)
DO FILE^DIE("","BQIDEL","ERROR")
+67 ;
+68 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
SET GIEN=$PIECE(DOR,$CHAR(29),DI)
IF GIEN=""
QUIT
Begin DoDot:1
+69 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
+70 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
+71 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DA(1)_",21,"
SET DIE=DIC
+72 SET DLAYGO=90505.321
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+73 SET X=GIEN
+74 IF '$DATA(^BQICARE(DA(3),1,DA(2),30,DA(1),21,0))
SET ^BQICARE(DA(3),1,DA(2),30,DA(1),21,0)="^90505.321^^"
+75 KILL DO,DD
DO FILE^DICN
+76 SET DA=+Y
IF DA<1
SET ERROR=1
End DoDot:1
+77 ;
+78 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
SET SIEN=$PIECE(SOR,$CHAR(29),SI)
IF SIEN=""
QUIT
Begin DoDot:1
+79 NEW DA,X,IENS
+80 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=SI
SET IENS=$$IENS^DILF(.DA)
+81 SET BQIUPD(90505.321,IENS,.02)=SIEN
+82 SET BQIUPD(90505.321,IENS,.03)=$PIECE(SDIR,$CHAR(29),SI)
End DoDot:1
+83 DO FILE^DIE("","BQIUPD","ERROR")
+84 KILL BQIUPD
+85 ;
+86 IF $DATA(ERROR)
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
+87 IF '$DATA(ERROR)
SET II=II+1
SET @DATA@(II)="1"_$CHAR(30)
+88 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+89 QUIT
+90 ;
DFNC() ;EP -- Get the standard display order
+1 SET DVALUE=""
+2 SET DOR=""
FOR
SET DOR=$ORDER(^BQI(90506.1,"AD","D",DOR))
IF DOR=""
QUIT
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD","D",DOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+5 ;I $$GET1^DIQ(90506.1,IEN_",",.13,"I")'="O" D
+6 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+7 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+8 SET DVALUE=DVALUE_STVCD_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET DVALUE=$$TKO^BQIUL1(DVALUE,$CHAR(29))
+10 QUIT DVALUE
+11 ;
SFNC() ;EP -- Get the standard sort order
+1 SET SVALUE=""
+2 SET SOR=""
FOR
SET SOR=$ORDER(^BQI(90506.1,"AE","D",SOR))
IF SOR=""
QUIT
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(^BQI(90506.1,"AE","D",SOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+5 ;I $$GET1^DIQ(90506.1,IEN_",",.13,"I")'="O" D
+6 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+7 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+8 SET SVALUE=SVALUE_STVCD_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET SVALUE=$$TKO^BQIUL1(SVALUE,$CHAR(29))
+10 QUIT SVALUE
+11 ;
MDEF() ; EP - Get Measures default fields
+1 SET MVALUE=""
+2 FOR TYP="G","R","A","H"
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(^BQI(90506.1,"AC",TYP,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+5 ;I $$GET1^DIQ(90506.1,IEN_",",.09,"I")'="O" D
+6 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:3
+7 SET STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
+8 SET MVALUE=MVALUE_STVCD_$CHAR(29)
End DoDot:3
End DoDot:2
End DoDot:1
+9 ;
+10 SET MVALUE=$$TKO^BQIUL1(MVALUE,$CHAR(29))
+11 QUIT MVALUE
