- BQIPLRVW ;PRXM/HC/ALA-Reminders View ; 15 Feb 2007 3:11 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- Q
- ;
- LST(DATA,OWNR,PLIEN) ; EP - BQI GET REMINDERS VIEW
- ;Description
- ; This returns the reminders view
- ;Input
- ; OWNR - Owner of panel
- ; PLIEN - panel ien
- ;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,IEN,DOR,DVALUE,SOR,SVALUE,X,STVCD,DISPLAY,SORT,SDIR
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPLRVW",UID))
- K @DATA
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRVW 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
- ;
- ; If there is a template
- I $$TMPL() G DONE
- ;
- ; If there is a customized view
- I $$CVW() G DONE
- ;
- S TIEN="",TEMPL="",DEF="",TYP="R"
- S DISPLAY=$$DFNC^BQIGPVW()_$C(29)_$$RDEF^BQIRMPL()
- S SORT=$$SFNC^BQIGPVW()
- 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 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,TEMPL,SOR,SDIR,DOR) ; EP -- BQI SET REMINDERS VIEW
- ;
- ;Description
- ; Update the display and sort order for reminders
- ;Input
- ; OWNR - Owner
- ; PLIEN - Panel
- ; TEMPL - Template name
- ; 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,LIST,BQIUPD,SI
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPLRVW",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,"")
- S:SOR="" SOR="PN" S:SDIR="" SDIR="A"
- ;
- 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^BQIPLRVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- D FIL(OWNR,PLIEN,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,TEMPL,SOR,SDIR,DOR) ; EP - File data
- ;
- I OWNR=DUZ D Q
- . NEW DA,IENS
- . S DA(2)=OWNR,DA(1)=PLIEN,DA=0
- . F S DA=$O(^BQICARE(OWNR,1,PLIEN,22,DA)) Q:'DA D
- .. S IENS=$$IENS^DILF(.DA)
- .. S BQIDEL(90505.122,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")'="R" 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)="R"
- .. 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)_",22,",DIE=DIC
- .. S DLAYGO=90505.122,DIC(0)="L",DIC("P")=DLAYGO
- .. S X=GIEN
- .. I '$D(^BQICARE(DA(2),1,DA(1),22,0)) S ^BQICARE(DA(2),1,DA(1),22,0)="^90505.122^^"
- .. K DO,DD D FILE^DICN
- .. S DA=+Y I DA<1 S ERROR=1 Q
- .. S IENS=$$IENS^DILF(.DA)
- .. S BQIUPD(90505.122,IENS,.02)=DI
- .. I $D(BQIUPD) 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,SN
- .. S SN=$O(^BQICARE(OWNR,1,PLIEN,22,"B",SIEN,""))
- .. S DA(2)=OWNR,DA(1)=PLIEN,DA=SN,IENS=$$IENS^DILF(.DA)
- .. ;S BQIUPD(90505.122,IENS,.03)=SIEN
- .. S BQIUPD(90505.122,IENS,.03)=SI
- .. S BQIUPD(90505.122,IENS,.04)=$P(SDIR,$C(29),SI)
- .. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
- ;
- ; 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,22,DA)) Q:'DA D
- . S IENS=$$IENS^DILF(.DA)
- . S BQIDEL(90505.322,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")'="R" 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)="R"
- . 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)_",22,",DIE=DIC
- . S DLAYGO=90505.322,DIC(0)="L",DIC("P")=DLAYGO
- . S X=GIEN
- . I '$D(^BQICARE(DA(3),1,DA(2),30,DA(1),22,0)) S ^BQICARE(DA(3),1,DA(2),30,DA(1),22,0)="^90505.322^^"
- . 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,22,"B",SIEN,""))
- . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=SN,IENS=$$IENS^DILF(.DA)
- . ;S BQIUPD(90505.322,IENS,.02)=SIEN
- . S BQIUPD(90505.322,IENS,.02)=SI
- . S BQIUPD(90505.322,IENS,.03)=$P(SDIR,$C(29),SI)
- I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
- K BQIUPD
- Q
- ;
- TMPL() ; EP - Check if layout template is used
- NEW RESULT,CTYP
- S RESULT=0,CTYP="R"
- 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="R"
- ;
- ; 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,22,IEN)) Q:'IEN D
- .. S CODE=$P(^BQICARE(OWNR,1,PLIEN,22,IEN,0),"^",1)
- .. S GIEN=$O(^BQI(90506.1,"B",CODE,""))
- .. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,22,IEN,0),"^",3)
- .. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,22,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,22,IEN)) Q:'IEN D
- .. S CODE=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN,0),"^",1)
- .. S GIEN=$O(^BQI(90506.1,"B",CODE,""))
- .. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN,0),"^",3)
- .. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,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
- BQIPLRVW ;PRXM/HC/ALA-Reminders View ; 15 Feb 2007 3:11 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 QUIT
- +3 ;
- LST(DATA,OWNR,PLIEN) ; EP - BQI GET REMINDERS VIEW
- +1 ;Description
- +2 ; This returns the reminders view
- +3 ;Input
- +4 ; OWNR - Owner of panel
- +5 ; PLIEN - panel ien
- +6 ;Output
- +7 ; DATA - name of global (passed by reference) in which the data
- +8 ; is stored
- +9 ;Variables used
- +10 ; UID - TMP global subscript. Will be either $J or "Z" plus the
- +11 ; TaskMan Task ID
- +12 ;
- +13 NEW UID,II,IEN,DOR,DVALUE,SOR,SVALUE,X,STVCD,DISPLAY,SORT,SDIR
- +14 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +15 SET DATA=$NAME(^TMP("BQIPLRVW",UID))
- +16 KILL @DATA
- +17 SET II=0
- +18 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPLRVW 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,$GET(DUZ))
- SET PLIEN=$GET(PLIEN,"")
- +23 ;
- +24 ; If there is a template
- +25 IF $$TMPL()
- GOTO DONE
- +26 ;
- +27 ; If there is a customized view
- +28 IF $$CVW()
- GOTO DONE
- +29 ;
- +30 SET TIEN=""
- SET TEMPL=""
- SET DEF=""
- SET TYP="R"
- +31 SET DISPLAY=$$DFNC^BQIGPVW()_$CHAR(29)_$$RDEF^BQIRMPL()
- +32 SET SORT=$$SFNC^BQIGPVW()
- +33 SET SDIR="A"
- SET TEMPL="System Default"
- +34 SET II=II+1
- SET @DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$CHAR(30)
- +35 ;
- 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,TEMPL,SOR,SDIR,DOR) ; EP -- BQI SET REMINDERS VIEW
- +1 ;
- +2 ;Description
- +3 ; Update the display and sort order for reminders
- +4 ;Input
- +5 ; OWNR - Owner
- +6 ; PLIEN - Panel
- +7 ; TEMPL - Template name
- +8 ; DOR - The display order
- +9 ; SOR - The sort order
- +10 ; SDIR - The sort direction
- +11 ;
- +12 ; If the Owner and the User are the same person.
- +13 NEW UID,II,IEN,ERROR,BQIDEL,DI,GIEN,LIST,BQIUPD,SI
- +14 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +15 SET DATA=$NAME(^TMP("BQIPLRVW",UID))
- +16 KILL @DATA
- +17 SET II=0
- +18 SET @DATA@(II)="I00010RESULT"_$CHAR(30)
- +19 ;
- +20 SET TEMPL=$GET(TEMPL,"")
- SET SOR=$GET(SOR,"")
- SET SDIR=$GET(SDIR,"")
- SET DOR=$GET(DOR,"")
- +21 IF SOR=""
- SET SOR="PN"
- IF SDIR=""
- SET SDIR="A"
- +22 ;
- +23 SET DOR=$GET(DOR,"")
- +24 IF DOR=""
- Begin DoDot:1
- +25 SET LIST=""
- SET BN=""
- +26 FOR
- SET BN=$ORDER(DOR(BN))
- IF BN=""
- QUIT
- SET LIST=LIST_DOR(BN)
- +27 KILL DOR
- +28 SET DOR=LIST
- +29 KILL LIST
- End DoDot:1
- +30 ;
- +31 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPLRVW D UNWIND^%ZTER"
- +32 ;
- +33 DO FIL(OWNR,PLIEN,TEMPL,SOR,SDIR,DOR)
- +34 ;
- +35 IF $DATA(ERROR)
- SET II=II+1
- SET @DATA@(II)="-1"_$CHAR(30)
- +36 IF '$DATA(ERROR)
- SET II=II+1
- SET @DATA@(II)="1"_$CHAR(30)
- +37 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +38 QUIT
- +39 ;
- FIL(OWNR,PLIEN,TEMPL,SOR,SDIR,DOR) ; EP - File data
- +1 ;
- +2 IF OWNR=DUZ
- Begin DoDot:1
- +3 NEW DA,IENS
- +4 SET DA(2)=OWNR
- SET DA(1)=PLIEN
- SET DA=0
- +5 FOR
- SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,22,DA))
- IF 'DA
- QUIT
- Begin DoDot:2
- +6 SET IENS=$$IENS^DILF(.DA)
- +7 SET BQIDEL(90505.122,IENS,.01)="@"
- End DoDot:2
- +8 IF $DATA(BQIDEL)
- DO FILE^DIE("","BQIDEL","ERROR")
- +9 SET DA=0
- +10 FOR
- SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,DA))
- IF 'DA
- QUIT
- Begin DoDot:2
- +11 SET IENS=$$IENS^DILF(.DA)
- +12 IF $$GET1^DIQ(90505.14,IENS,.02,"I")'="R"
- QUIT
- +13 SET BQIDEL(90505.14,IENS,.01)="@"
- End DoDot:2
- +14 IF $DATA(BQIDEL)
- DO FILE^DIE("","BQIDEL","ERROR")
- +15 ; If template
- +16 IF $GET(TEMPL)'=""
- Begin DoDot:2
- +17 NEW DA,DIC,DLAYGO,IENS,DIE
- +18 SET DA(2)=OWNR
- SET DA(1)=PLIEN
- +19 SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",4,"
- SET DIE=DIC
- +20 SET DLAYGO=90505.14
- SET DIC(0)="L"
- SET DIC("P")=DLAYGO
- +21 IF '$DATA(^BQICARE(DA(2),1,DA(1),4,0))
- SET ^BQICARE(DA(2),1,DA(1),4,0)="^90505.14^^"
- +22 SET X=TEMPL
- +23 DO ^DIC
- +24 SET DA=+Y
- +25 SET IENS=$$IENS^DILF(.DA)
- +26 SET BQIUPD(90505.14,IENS,.02)="R"
- +27 IF $DATA(BQIUPD)
- DO FILE^DIE("","BQIUPD","ERROR")
- +28 KILL BQIUPD
- End DoDot:2
- QUIT
- +29 ; If customized
- +30 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
- SET GIEN=$PIECE(DOR,$CHAR(29),DI)
- IF GIEN=""
- QUIT
- Begin DoDot:2
- +31 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
- +32 SET DA(2)=OWNR
- SET DA(1)=PLIEN
- +33 SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",22,"
- SET DIE=DIC
- +34 SET DLAYGO=90505.122
- SET DIC(0)="L"
- SET DIC("P")=DLAYGO
- +35 SET X=GIEN
- +36 IF '$DATA(^BQICARE(DA(2),1,DA(1),22,0))
- SET ^BQICARE(DA(2),1,DA(1),22,0)="^90505.122^^"
- +37 KILL DO,DD
- DO FILE^DICN
- +38 SET DA=+Y
- IF DA<1
- SET ERROR=1
- QUIT
- +39 SET IENS=$$IENS^DILF(.DA)
- +40 SET BQIUPD(90505.122,IENS,.02)=DI
- +41 IF $DATA(BQIUPD)
- DO FILE^DIE("","BQIUPD","ERROR")
- End DoDot:2
- +42 ;
- +43 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
- SET SIEN=$PIECE(SOR,$CHAR(29),SI)
- IF SIEN=""
- QUIT
- Begin DoDot:2
- +44 NEW DA,X,IENS,BQIUPD,SN
- +45 SET SN=$ORDER(^BQICARE(OWNR,1,PLIEN,22,"B",SIEN,""))
- +46 SET DA(2)=OWNR
- SET DA(1)=PLIEN
- SET DA=SN
- SET IENS=$$IENS^DILF(.DA)
- +47 ;S BQIUPD(90505.122,IENS,.03)=SIEN
- +48 SET BQIUPD(90505.122,IENS,.03)=SI
- +49 SET BQIUPD(90505.122,IENS,.04)=$PIECE(SDIR,$CHAR(29),SI)
- +50 IF $DATA(BQIUPD)
- DO FILE^DIE("","BQIUPD","ERROR")
- End DoDot:2
- End DoDot:1
- QUIT
- +51 ;
- +52 ; If the user is sharing someone else's panel.
- +53 NEW DA,IENS
- +54 SET DA(3)=OWNR
- SET DA(2)=PLIEN
- SET DA(1)=DUZ
- SET DA=0
- +55 FOR
- SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,DA))
- IF 'DA
- QUIT
- Begin DoDot:1
- +56 SET IENS=$$IENS^DILF(.DA)
- +57 SET BQIDEL(90505.322,IENS,.01)="@"
- End DoDot:1
- +58 IF $DATA(BQIDEL)
- DO FILE^DIE("","BQIDEL","ERROR")
- +59 SET DA=0
- +60 FOR
- SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,DA))
- IF 'DA
- QUIT
- Begin DoDot:1
- +61 SET IENS=$$IENS^DILF(.DA)
- +62 IF $$GET1^DIQ(90505.34,IENS,.02,"I")'="R"
- QUIT
- +63 SET BQIDEL(90505.34,IENS,.01)="@"
- End DoDot:1
- +64 IF $DATA(BQIDEL)
- DO FILE^DIE("","BQIDEL","ERROR")
- +65 ; If template
- +66 IF $GET(TEMPL)'=""
- Begin DoDot:1
- +67 NEW DA,DIC,DLAYGO,IENS,DIE
- +68 SET DA(3)=OWNR
- SET DA(2)=PLIEN
- SET DA(1)=DUZ
- +69 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DUZ_",4,"
- SET DIE=DIC
- +70 SET DLAYGO=90505.34
- SET DIC(0)="L"
- SET DIC("P")=DLAYGO
- +71 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^^"
- +72 SET X=TEMPL
- +73 DO ^DIC
- +74 SET DA=+Y
- +75 SET IENS=$$IENS^DILF(.DA)
- +76 SET BQIUPD(90505.34,IENS,.02)="R"
- +77 IF $DATA(BQIUPD)
- DO FILE^DIE("","BQIUPD","ERROR")
- +78 KILL BQIUPD
- End DoDot:1
- QUIT
- +79 ; If customized
- +80 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
- SET GIEN=$PIECE(DOR,$CHAR(29),DI)
- IF GIEN=""
- QUIT
- Begin DoDot:1
- +81 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
- +82 SET DA(3)=OWNR
- SET DA(2)=PLIEN
- SET DA(1)=DUZ
- +83 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DA(1)_",22,"
- SET DIE=DIC
- +84 SET DLAYGO=90505.322
- SET DIC(0)="L"
- SET DIC("P")=DLAYGO
- +85 SET X=GIEN
- +86 IF '$DATA(^BQICARE(DA(3),1,DA(2),30,DA(1),22,0))
- SET ^BQICARE(DA(3),1,DA(2),30,DA(1),22,0)="^90505.322^^"
- +87 KILL DO,DD
- DO FILE^DICN
- +88 SET DA=+Y
- IF DA<1
- SET ERROR=1
- End DoDot:1
- +89 ;
- +90 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
- SET SIEN=$PIECE(SOR,$CHAR(29),SI)
- IF SIEN=""
- QUIT
- Begin DoDot:1
- +91 NEW DA,X,IENS,SN
- +92 SET SN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,"B",SIEN,""))
- +93 SET DA(3)=OWNR
- SET DA(2)=PLIEN
- SET DA(1)=DUZ
- SET DA=SN
- SET IENS=$$IENS^DILF(.DA)
- +94 ;S BQIUPD(90505.322,IENS,.02)=SIEN
- +95 SET BQIUPD(90505.322,IENS,.02)=SI
- +96 SET BQIUPD(90505.322,IENS,.03)=$PIECE(SDIR,$CHAR(29),SI)
- End DoDot:1
- +97 IF $DATA(BQIUPD)
- DO FILE^DIE("","BQIUPD","ERROR")
- +98 KILL BQIUPD
- +99 QUIT
- +100 ;
- TMPL() ; EP - Check if layout template is used
- +1 NEW RESULT,CTYP
- +2 SET RESULT=0
- SET CTYP="R"
- +3 NEW DA,IENS,TEMPL,LYIEN
- +4 SET TEMPL=""
- +5 IF OWNR'=DUZ
- Begin DoDot:1
- +6 IF $GET(PLIEN)=""
- QUIT
- +7 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
- +8 IF DA=""
- QUIT
- +9 SET DA(3)=OWNR
- SET DA(2)=PLIEN
- SET DA(1)=DUZ
- SET IENS=$$IENS^DILF(.DA)
- +10 SET TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
- End DoDot:1
- +11 IF OWNR=DUZ
- Begin DoDot:1
- +12 IF $GET(PLIEN)=""
- QUIT
- +13 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
- +14 IF DA=""
- QUIT
- +15 SET DA(2)=OWNR
- SET DA(1)=PLIEN
- SET IENS=$$IENS^DILF(.DA)
- +16 SET TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
- End DoDot:1
- +17 IF TEMPL'=""
- Begin DoDot:1
- +18 ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
- +19 SET LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
- +20 IF LYIEN=""
- QUIT
- +21 DO DEF^BQILYDEF(LYIEN)
- +22 SET RESULT=1
- +23 ;S DISPLAY=$P(@DATA@(II),U,3),SOR=$P(@DATA@(II),U,4),SDIR=$P(@DATA@(II),U,5)
- End DoDot:1
- +24 QUIT RESULT
- +25 ;
- CVW() ;EP - Get Customized view
- +1 NEW TIEN,TEMPL,DEF,TYP,DISPLAY,SORT,SDIR,IEN,GIEN,SIEN,RIEN,CODE,SOR
- +2 SET DISPLAY=""
- SET SORT=""
- SET SDIR=""
- SET TIEN=""
- SET TEMPL=""
- SET RESULT=0
- SET DEF=""
- +3 SET TYP="R"
- +4 ;
- +5 ; Owner and user are the same
- +6 IF OWNR=DUZ
- Begin DoDot:1
- +7 SET IEN=0
- SET DISPLAY=""
- SET SORT=""
- SET SDIR=""
- +8 IF $GET(PLIEN)=""
- QUIT
- +9 FOR
- SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,22,IEN))
- IF 'IEN
- QUIT
- Begin DoDot:2
- +10 SET CODE=$PIECE(^BQICARE(OWNR,1,PLIEN,22,IEN,0),"^",1)
- +11 SET GIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
- +12 SET SIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,22,IEN,0),"^",3)
- +13 SET RIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,22,IEN,0),"^",4)
- +14 ;S CODE=$P(^BQI(90506.1,GIEN,0),U,1)
- +15 SET DISPLAY=DISPLAY_CODE_$CHAR(29)
- +16 IF SIEN'=""
- Begin DoDot:3
- +17 ;I SIEN?.N S CODE=$P(^BQI(90506.1,SIEN,0),U,1)
- +18 ;E S CODE=SIEN
- +19 ;S SORT=SORT_CODE_$C(29)
- +20 SET $PIECE(SORT,$CHAR(29),SIEN)=CODE
- +21 SET $PIECE(SDIR,$CHAR(29),SIEN)=RIEN
- End DoDot:3
- +22 ;S SDIR=SDIR_RIEN_$C(29)
- End DoDot:2
- End DoDot:1
- +23 ;
- +24 ; User is not owner but share
- +25 IF OWNR'=DUZ
- Begin DoDot:1
- +26 SET IEN=0
- SET DISPLAY=""
- SET SORT=""
- SET SDIR=""
- +27 IF $GET(PLIEN)=""
- QUIT
- +28 FOR
- SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN))
- IF 'IEN
- QUIT
- Begin DoDot:2
- +29 SET CODE=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN,0),"^",1)
- +30 SET GIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
- +31 SET SIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN,0),"^",3)
- +32 SET RIEN=$PIECE(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN,0),"^",4)
- +33 ;S CODE=$P(^BQI(90506.1,GIEN,0),U,1)
- +34 SET DISPLAY=DISPLAY_CODE_$CHAR(29)
- +35 IF SIEN'=""
- Begin DoDot:3
- +36 ;I SIEN?.N S CODE=$P(^BQI(90506.1,SIEN,0),U,1)
- +37 ;E S CODE=SIEN
- +38 ;S SORT=SORT_CODE_$C(29)
- +39 SET $PIECE(SORT,$CHAR(29),SIEN)=CODE
- +40 SET $PIECE(SDIR,$CHAR(29),SIEN)=RIEN
- End DoDot:3
- +41 ;S SDIR=SDIR_RIEN_$C(29)
- End DoDot:2
- End DoDot:1
- +42 ;
- +43 SET DISPLAY=$$TKO^BQIUL1(DISPLAY,$CHAR(29))
- +44 SET SORT=$$TKO^BQIUL1(SORT,$CHAR(29))
- +45 SET SDIR=$$TKO^BQIUL1(SDIR,$CHAR(29))
- +46 IF DISPLAY'=""
- Begin DoDot:1
- +47 SET RESULT=1
- +48 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
- +49 QUIT RESULT