- 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
