BQIGPVW.m

BQIGPVW ;PRXM/HC/ALA-GPRA View ; 15 Aug 2006  10:12 AM

 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 ;

 Q

 ;

LST(DATA,OWNR,PLIEN) ; EP - BQI GET GPRA VIEW

 ;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,IENS,DA,YEAR,GIEN,DISPLAY,SORT,SDIR,SD,SR,GVALUE,STVCD,SVALUE,DVALUE,KEY

 NEW RIEN

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

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

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPVW 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

 ;

 ; Get GPRA Year and GPRA year values

 ;I OWNR'="",PLIEN'="" D

 ;. S DA(1)=$S(OWNR=DUZ:DUZ,1:OWNR)

 ;. S DA=PLIEN,IENS=$$IENS^DILF(.DA)

 ;. S YEAR=$$GET1^DIQ(90505.01,IENS,3.3,"E")

 ;S BQIH=$$SPM^BQIGPUTL()

 ;I $G(YEAR)="" S YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")

 ;S BQIY=$$LKP^BQIGPUTL(YEAR)

 ;D GFN^BQIGPUTL(BQIH,BQIY)

 ;

 ; If there is a template

 I $$TMPL() G DONE

 ;

 ; If there is a customized view

 I $$CVW() G DONE

 ;

 S TIEN="",TEMPL="",DEF="",TYP="G"

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

 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)

 ;

DONE ;

 ;S @DATA@(II)=YEAR_U_@DATA@(II)

 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,YEAR,TEMPL,SOR,SDIR,DOR) ; EP -- BQI SET GPRA VIEW

 ;

 ;Description

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

 ;Input

 ;   YEAR - The GPRA Year that this view is for

 ;   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,GVALUE,SI,SVALUE,DVALUE,STVCD,BN,IEN,RESULT

 NEW TIEN,TYP,BQIH,BQIINDF,BQIMEASF,BQIY,DEF,LIST

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

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

 K @DATA

 S II=0

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

 ;

 S YEAR=$G(YEAR,"")

 I YEAR="" D

 . I OWNR'="",PLIEN'="" D

 .. NEW DA,IENS

 .. S DA(1)=$S(OWNR=DUZ:DUZ,1:OWNR)

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

 .. S YEAR=$$GET1^DIQ(90505.01,IENS,3.3,"E")

 . S BQIH=$$SPM^BQIGPUTL()

 . I $G(YEAR)="" S YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")

 ;

 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^BQIGPVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 D FIL(OWNR,PLIEN,YEAR,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,YEAR,TEMPL,SOR,SDIR,DOR) ; EP - File customized view

 ; Set the GPRA Year for the panel

 NEW DA,IENS

 S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)

 S BQUPD(90505.01,IENS,3.3)=YEAR

 D FILE^DIE("","BQUPD","ERROR")

 K BQUPD

 ;

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

 I OWNR=DUZ D  Q

 . NEW DA,IENS,BQIDEL

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

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

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

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

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

 .. K BQIUPD

 . ; If customized

 . 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)_",25,",DIE=DIC

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

 .. S X=GIEN

 .. I '$D(^BQICARE(DA(2),1,DA(1),25,0)) S ^BQICARE(DA(2),1,DA(1),25,0)="^90505.125^^"

 .. K DO,DD D FILE^DICN

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

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

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

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

 .. K BQIUPD

 . ;

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

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

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

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

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

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

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

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

 .. K BQIUPD

 ;

 ; 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,25,DA)) Q:'DA  D

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

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

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

 . K BQIUPD

 ; If customized

 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)_",25,",DIE=DIC

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

 . S X=GIEN

 . I '$D(^BQICARE(DA(3),1,DA(2),30,DA(1),25,0)) S ^BQICARE(DA(3),1,DA(2),30,DA(1),25,0)="^90505.325^^"

 . 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,25,"B",SIEN,""))

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

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

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

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

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

 K BQIUPD

 Q

 ;

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

 S DVALUE=""

 ;

 ; Check for normal display order

 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_",",.1,"I")=1 Q

 .. 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() ;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_",",.1,"I")=1 Q

 .. 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_STVCD_$C(29)

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

 Q SVALUE

 ;

GDEF() ; EP - Get GPRA default fields

 NEW CAT,ARRAY,TITLE,GCAT,TYP,KEY

 S GVALUE=""

 S IEN=""

 F  S IEN=$O(^BQI(90506.1,"AC","G",IEN)) Q:IEN=""  D

 . I $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q

 . S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")

 . I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q

 . S TYP=$P($G(^BQI(90506.1,IEN,3)),U,4)

 . I TYP="O" Q

 . S GCAT=$$GET1^DIQ(90506.1,IEN_",",3.03,"E")

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

 . S CAT=$$GET1^DIQ(90506.1,IEN_",",3.02,"E")

 . S CAT=$$UP^XLFSTR(CAT)

 . S TITLE=$$GET1^DIQ(90506.1,IEN_",",.03,"E")

 . S ARRAY(CAT,TITLE,IEN)=STVCD

 ; Take presorted data and set as default

 S CAT=""

 F  S CAT=$O(ARRAY(CAT)) Q:CAT=""  D

 . S TITLE=""

 . F  S TITLE=$O(ARRAY(CAT,TITLE)) Q:TITLE=""  D

 .. S IEN=""

 .. F  S IEN=$O(ARRAY(CAT,TITLE,IEN)) Q:IEN=""  D

 ... S STVCD=ARRAY(CAT,TITLE,IEN)

 ... S GVALUE=GVALUE_STVCD_$C(29)

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

 Q GVALUE

 ;

TMPL() ; Check if layout template is used

 NEW RESULT,CTYP

 S RESULT=0,CTYP="G"

 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="G"

 ;

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

 .. S CODE=$P(^BQICARE(OWNR,1,PLIEN,25,IEN,0),"^",1)

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

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

 .. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,25,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,25,IEN)) Q:'IEN  D

 .. S CODE=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,25,IEN,0),"^",1)

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

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

 .. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,25,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

BQIGPVW   ;PRXM/HC/ALA-GPRA View ; 15 Aug 2006  10:12 AM

 +1       ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 +2       ;

 +3        QUIT 

 +4       ;

LST(DATA,OWNR,PLIEN) ; EP - BQI GET GPRA VIEW

 +1       ;Output

 +2       ;  DATA  - name of global (passed by reference) in which the data

 +3       ;          is stored

 +4       ;Variables used

 +5       ;  UID - TMP global subscript. Will be either $J or "Z" plus the

 +6       ;        TaskMan Task ID

 +7       ;        

 +8        NEW UID,II,IENS,DA,YEAR,GIEN,DISPLAY,SORT,SDIR,SD,SR,GVALUE,STVCD,SVALUE,DVALUE,KEY

 +9        NEW RIEN

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

 +11       SET DATA=$NAME(^TMP("BQIGPVW",UID))

 +12       KILL @DATA

 +13       SET II=0

 +14      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +15      ;

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

 +17      ;

 +18      ; If no owner supplied use DUZ

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

           SET PLIEN=$GET(PLIEN,"")

 +19      ;

 +20      ; Get GPRA Year and GPRA year values

 +21      ;I OWNR'="",PLIEN'="" D

 +22      ;. S DA(1)=$S(OWNR=DUZ:DUZ,1:OWNR)

 +23      ;. S DA=PLIEN,IENS=$$IENS^DILF(.DA)

 +24      ;. S YEAR=$$GET1^DIQ(90505.01,IENS,3.3,"E")

 +25      ;S BQIH=$$SPM^BQIGPUTL()

 +26      ;I $G(YEAR)="" S YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")

 +27      ;S BQIY=$$LKP^BQIGPUTL(YEAR)

 +28      ;D GFN^BQIGPUTL(BQIH,BQIY)

 +29      ;

 +30      ; If there is a template

 +31       IF $$TMPL()

               GOTO DONE

 +32      ;

 +33      ; If there is a customized view

 +34       IF $$CVW()

               GOTO DONE

 +35      ;

 +36       SET TIEN=""

           SET TEMPL=""

           SET DEF=""

           SET TYP="G"

 +37       SET DISPLAY=$$DFNC()_$CHAR(29)_$$GDEF()

 +38       SET SORT=$$SFNC()

 +39       SET SDIR="A"

           SET TEMPL="System Default"

 +40       SET II=II+1

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

 +41      ;

DONE      ;

 +1       ;S @DATA@(II)=YEAR_U_@DATA@(II)

 +2        SET II=II+1

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

 +3        QUIT 

 +4       ;

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,YEAR,TEMPL,SOR,SDIR,DOR) ; EP -- BQI SET GPRA VIEW

 +1       ;

 +2       ;Description

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

 +4       ;Input

 +5       ;   YEAR - The GPRA Year that this view is for

 +6       ;   DOR  - The display order

 +7       ;   SOR  - The sort order

 +8       ;   SDIR - The sort direction

 +9       ;

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

 +11       NEW UID,II,IEN,ERROR,BQIDEL,DI,GIEN,GVALUE,SI,SVALUE,DVALUE,STVCD,BN,IEN,RESULT

 +12       NEW TIEN,TYP,BQIH,BQIINDF,BQIMEASF,BQIY,DEF,LIST

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

 +14       SET DATA=$NAME(^TMP("BQIGPVW",UID))

 +15       KILL @DATA

 +16       SET II=0

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

 +18      ;

 +19       SET YEAR=$GET(YEAR,"")

 +20       IF YEAR=""

               Begin DoDot:1

 +21               IF OWNR'=""

                       IF PLIEN'=""

                           Begin DoDot:2

 +22                           NEW DA,IENS

 +23                           SET DA(1)=$SELECT(OWNR=DUZ:DUZ,1:OWNR)

 +24                           SET DA=PLIEN

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

 +25                           SET YEAR=$$GET1^DIQ(90505.01,IENS,3.3,"E")

                           End DoDot:2

 +26               SET BQIH=$$SPM^BQIGPUTL()

 +27               IF $GET(YEAR)=""

                       SET YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")

               End DoDot:1

 +28      ;

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

           SET SOR=$GET(SOR,"")

           SET SDIR=$GET(SDIR,"")

           SET DOR=$GET(DOR,"")

 +30       IF DOR=""

               Begin DoDot:1

 +31               SET LIST=""

                   SET BN=""

 +32               FOR 

                       SET BN=$ORDER(DOR(BN))

                       IF BN=""

                           QUIT 

                       SET LIST=LIST_DOR(BN)

 +33               KILL DOR

 +34               SET DOR=LIST

 +35               KILL LIST

               End DoDot:1

 +36      ;

 +37      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +38      ;

 +39       DO FIL(OWNR,PLIEN,YEAR,TEMPL,SOR,SDIR,DOR)

 +40      ;

 +41       IF $DATA(ERROR)

               SET II=II+1

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

 +42       IF '$DATA(ERROR)

               SET II=II+1

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

 +43       SET II=II+1

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

 +44       QUIT 

 +45      ;

FIL(OWNR,PLIEN,YEAR,TEMPL,SOR,SDIR,DOR) ; EP - File customized view

 +1       ; Set the GPRA Year for the panel

 +2        NEW DA,IENS

 +3        SET DA(1)=OWNR

           SET DA=PLIEN

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

 +4        SET BQUPD(90505.01,IENS,3.3)=YEAR

 +5        DO FILE^DIE("","BQUPD","ERROR")

 +6        KILL BQUPD

 +7       ;

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

 +9        IF OWNR=DUZ

               Begin DoDot:1

 +10               NEW DA,IENS,BQIDEL

 +11               SET DA(2)=OWNR

                   SET DA(1)=PLIEN

                   SET DA=0

 +12               FOR 

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

                       IF 'DA

                           QUIT 

                       Begin DoDot:2

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

 +14                       SET BQIDEL(90505.125,IENS,.01)="@"

                       End DoDot:2

 +15               IF $DATA(BQIDEL)

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

 +16               SET DA=0

 +17               FOR 

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

                       IF 'DA

                           QUIT 

                       Begin DoDot:2

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

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

                               QUIT 

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

                       End DoDot:2

 +21               IF $DATA(BQIDEL)

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

 +22      ;

 +23      ; If template

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

                       Begin DoDot:2

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

 +26                       SET DA(2)=OWNR

                           SET DA(1)=PLIEN

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

                           SET DIE=DIC

 +28                       SET DLAYGO=90505.14

                           SET DIC(0)="L"

                           SET DIC("P")=DLAYGO

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

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

 +30                       SET X=TEMPL

 +31                       DO ^DIC

 +32                       SET DA=+Y

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

 +34                       SET BQIUPD(90505.14,IENS,.02)="G"

 +35                       IF $DATA(BQIUPD)

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

 +36                       KILL BQIUPD

                       End DoDot:2

                       QUIT 

 +37      ; If customized

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

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

                       IF GIEN=""

                           QUIT 

                       Begin DoDot:2

 +39                       NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS

 +40                       SET DA(2)=OWNR

                           SET DA(1)=PLIEN

 +41                       SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",25,"

                           SET DIE=DIC

 +42                       SET DLAYGO=90505.125

                           SET DIC(0)="L"

                           SET DIC("P")=DLAYGO

 +43                       SET X=GIEN

 +44                       IF '$DATA(^BQICARE(DA(2),1,DA(1),25,0))

                               SET ^BQICARE(DA(2),1,DA(1),25,0)="^90505.125^^"

 +45                       KILL DO,DD

                           DO FILE^DICN

 +46                       SET DA=+Y

                           IF DA<1