Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIPLRFV

BQIPLRFV.m

Go to the documentation of this file. 
  1. BQIPLRFV ;GDIT/HS/ALA-Referrals View ; 06 Jan 2015  8:25 AM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
  1.  ;
  1.  ;
  1. LST(DATA,OWNR,PLIEN) ; EP - BQI GET REFERRALS VIEW
  1.  ;Description
  1.  ;  This returns the referrals view
  1.  ;Input
  1.  ;  OWNR  - Owner of panel
  1.  ;  PLIEN - panel ien
  1.  ;Output
  1.  ;  DATA  - name of global (passed by reference) in which the data
  1.  ;          is stored
  1.  ;Variables used
  1.  ;  UID - TMP global subscript. Will be either $J or "Z" plus the
  1.  ;        TaskMan Task ID
  1.  ;        
  1.  NEW UID,II,IEN,DOR,DVALUE,SOR,SVALUE,X,STVCD,DISPLAY,SORT,SDIR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPLRFV",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRFV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER^T00120SORT_ORDER^T00120SORT_DIRECTION"_$C(30)
  1.  ;
  1.  S OWNR=$G(OWNR,$G(DUZ)),PLIEN=$G(PLIEN,"") ; If no owner supplied use DUZ
  1.  ;
  1.  ; If there is a template
  1.  I $$TMPL() G DONE
  1.  ;
  1.  ; If there is a customized view
  1.  I $$CVW() G DONE
  1.  ;
  1.  S TIEN="",TEMPL="",DEF="",TYP="RF",CARE="Referrals"
  1.  S DISPLAY=$$DFNC^BQIGPVW()_$C(29)_$$CDEF^BQICMVW()
  1.  S SORT=$$SFNC^BQIGPVW()
  1.  S SDIR="A",TEMPL="System Default"
  1.  S II=II+1,@DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UPD(DATA,OWNR,PLIEN,TEMPL,SOR,SDIR,DOR) ; EP -- BQI SET REFERRALS VIEW
  1.  ;
  1.  ;Description
  1.  ;   Update the display and sort order for referrals
  1.  ;Input
  1.  ;   OWNR  - Owner
  1.  ;   PLIEN - Panel
  1.  ;   TEMPL - Template name
  1.  ;   DOR   - The display order
  1.  ;   SOR   - The sort order
  1.  ;   SDIR  - The sort direction
  1.  ;
  1.  ; If the Owner and the User are the same person.
  1.  NEW UID,II,IEN,ERROR,BQIDEL,DI,GIEN,LIST,BQIUPD,SI
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPLRFV",UID))
  1.  K @DATA
  1.  S II=0
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  ;
  1.  S TEMPL=$G(TEMPL,""),SOR=$G(SOR,""),SDIR=$G(SDIR,""),DOR=$G(DOR,"")
  1.  S:SOR="" SOR="PN" S:SDIR="" SDIR="A"
  1.  ;
  1.  S DOR=$G(DOR,"")
  1.  I DOR="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(DOR(BN)) Q:BN=""  S LIST=LIST_DOR(BN)
  1.  . K DOR
  1.  . S DOR=LIST
  1.  . K LIST
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRFV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D FIL(OWNR,PLIEN,TEMPL,SOR,SDIR,DOR)
  1.  ;
  1.  I $D(ERROR) S II=II+1,@DATA@(II)="-1"_$C(30)
  1.  I '$D(ERROR) S II=II+1,@DATA@(II)="1"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. FIL(OWNR,PLIEN,TEMPL,SOR,SDIR,DOR) ; EP - File data
  1.  ;
  1.  I OWNR=DUZ D  Q
  1.  . NEW DA,IENS
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,DA=0
  1.  . F  S DA=$O(^BQICARE(OWNR,1,PLIEN,26,DA)) Q:'DA  D
  1.  .. S IENS=$$IENS^DILF(.DA)
  1.  .. S BQIDEL(90505.126,IENS,.01)="@"
  1.  . I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
  1.  . S DA=0
  1.  . F  S DA=$O(^BQICARE(OWNR,1,PLIEN,4,DA)) Q:'DA  D
  1.  .. S IENS=$$IENS^DILF(.DA)
  1.  .. I $$GET1^DIQ(90505.14,IENS,.02,"I")'="RF" Q
  1.  .. S BQIDEL(90505.14,IENS,.01)="@"
  1.  . I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
  1.  . ; If template
  1.  . I $G(TEMPL)'=""  D  Q
  1.  .. NEW DA,DIC,DLAYGO,IENS,DIE
  1.  .. S DA(2)=OWNR,DA(1)=PLIEN
  1.  .. S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",4,",DIE=DIC
  1.  .. S DLAYGO=90505.14,DIC(0)="L",DIC("P")=DLAYGO
  1.  .. I '$D(^BQICARE(DA(2),1,DA(1),4,0)) S ^BQICARE(DA(2),1,DA(1),4,0)="^90505.14^^"
  1.  .. S X=TEMPL
  1.  .. D ^DIC
  1.  .. S DA=+Y
  1.  .. S IENS=$$IENS^DILF(.DA)
  1.  .. S BQIUPD(90505.14,IENS,.02)="RF"
  1.  .. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  .. K BQIUPD
  1.  . ; If customized
  1.  . F DI=1:1:$L(DOR,$C(29)) S GIEN=$P(DOR,$C(29),DI) Q:GIEN=""  D
  1.  .. NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
  1.  .. S DA(2)=OWNR,DA(1)=PLIEN
  1.  .. S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",26,",DIE=DIC
  1.  .. S DLAYGO=90505.126,DIC(0)="L",DIC("P")=DLAYGO
  1.  .. S X=GIEN
  1.  .. I '$D(^BQICARE(DA(2),1,DA(1),26,0)) S ^BQICARE(DA(2),1,DA(1),26,0)="^90505.126^^"
  1.  .. K DO,DD D FILE^DICN
  1.  .. S DA=+Y I DA<1 S ERROR=1 Q
  1.  .. S IENS=$$IENS^DILF(.DA)
  1.  .. S BQIUPD(90505.126,IENS,.02)=DI
  1.  .. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  . ;
  1.  . F SI=1:1:$L(SOR,$C(29)) S SIEN=$P(SOR,$C(29),SI) Q:SIEN=""  D
  1.  .. NEW DA,X,IENS,BQIUPD,SN
  1.  .. S SN=$O(^BQICARE(OWNR,1,PLIEN,26,"B",SIEN,""))
  1.  .. S DA(2)=OWNR,DA(1)=PLIEN,DA=SN,IENS=$$IENS^DILF(.DA)
  1.  .. S BQIUPD(90505.126,IENS,.03)=SI
  1.  .. S BQIUPD(90505.126,IENS,.04)=$P(SDIR,$C(29),SI)
  1.  .. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ; If the user is sharing someone else's panel.
  1.  NEW DA,IENS
  1.  S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=0
  1.  F  S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,26,DA)) Q:'DA  D
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . S BQIDEL(90505.326,IENS,.01)="@"
  1.  I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
  1.  S DA=0
  1.  F  S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,DA)) Q:'DA  D
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . I $$GET1^DIQ(90505.34,IENS,.02,"I")'="RF" Q
  1.  . S BQIDEL(90505.34,IENS,.01)="@"
  1.  I $D(BQIDEL) D FILE^DIE("","BQIDEL","ERROR")
  1.  ; If template
  1.  I $G(TEMPL)'=""  D  Q
  1.  . NEW DA,DIC,DLAYGO,IENS,DIE
  1.  . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ
  1.  . S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DUZ_",4,",DIE=DIC
  1.  . S DLAYGO=90505.34,DIC(0)="L",DIC("P")=DLAYGO
  1.  . 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^^"
  1.  . S X=TEMPL
  1.  . D ^DIC
  1.  . S DA=+Y
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . S BQIUPD(90505.34,IENS,.02)="RF"
  1.  . I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  . K BQIUPD
  1.  ; If customized
  1.  F DI=1:1:$L(DOR,$C(29)) S GIEN=$P(DOR,$C(29),DI) Q:GIEN=""  D
  1.  . NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
  1.  . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ
  1.  . S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DA(1)_",26,",DIE=DIC
  1.  . S DLAYGO=90505.326,DIC(0)="L",DIC("P")=DLAYGO
  1.  . S X=GIEN
  1.  . I '$D(^BQICARE(DA(3),1,DA(2),30,DA(1),26,0)) S ^BQICARE(DA(3),1,DA(2),30,DA(1),26,0)="^90505.326^^"
  1.  . K DO,DD D FILE^DICN
  1.  . S DA=+Y I DA<1 S ERROR=1
  1.  ;
  1.  F SI=1:1:$L(SOR,$C(29)) S SIEN=$P(SOR,$C(29),SI) Q:SIEN=""  D
  1.  . NEW DA,X,IENS,SN
  1.  . S SN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,26,"B",SIEN,""))
  1.  . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=SN,IENS=$$IENS^DILF(.DA)
  1.  . S BQIUPD(90505.326,IENS,.02)=SI
  1.  . S BQIUPD(90505.326,IENS,.03)=$P(SDIR,$C(29),SI)
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  Q
  1.  ;
  1. TMPL() ; EP - Check if layout template is used
  1.  NEW RESULT,CTYP
  1.  S RESULT=0,CTYP="RF"
  1.  NEW DA,IENS,TEMPL,LYIEN
  1.  S TEMPL=""
  1.  I OWNR'=DUZ D
  1.  . I $G(PLIEN)="" Q
  1.  . S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
  1.  . I DA="" Q
  1.  . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,IENS=$$IENS^DILF(.DA)
  1.  . S TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
  1.  I OWNR=DUZ D
  1.  . I $G(PLIEN)="" Q
  1.  . S DA=$O(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
  1.  . I DA="" Q
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  . S TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
  1.  I TEMPL'="" D
  1.  . S LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
  1.  . I LYIEN="" Q
  1.  . D DEF^BQILYDEF(LYIEN)
  1.  . S RESULT=1
  1.  Q RESULT
  1.  ;
  1. CVW() ;EP - Get Customized view
  1.  NEW TIEN,TEMPL,DEF,TYP,DISPLAY,SORT,SDIR,IEN,GIEN,SIEN,RIEN,CODE,SOR
  1.  S DISPLAY="",SORT="",SDIR="",TIEN="",TEMPL="",RESULT=0,DEF=""
  1.  S TYP="RF"
  1.  ;
  1.  ; Owner and user are the same
  1.  I OWNR=DUZ D
  1.  . S IEN=0,DISPLAY="",SORT="",SDIR=""
  1.  . I $G(PLIEN)="" Q
  1.  . F  S IEN=$O(^BQICARE(OWNR,1,PLIEN,26,IEN)) Q:'IEN  D
  1.  .. S CODE=$P(^BQICARE(OWNR,1,PLIEN,26,IEN,0),"^",1)
  1.  .. S GIEN=$O(^BQI(90506.1,"B",CODE,""))
  1.  .. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,26,IEN,0),"^",3)
  1.  .. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,26,IEN,0),"^",4)
  1.  .. S DISPLAY=DISPLAY_CODE_$C(29)
  1.  .. I SIEN'="" D
  1.  ... S $P(SORT,$C(29),SIEN)=CODE
  1.  ... S $P(SDIR,$C(29),SIEN)=RIEN
  1.  ;
  1.  ; User is not owner but share
  1.  I OWNR'=DUZ D
  1.  . S IEN=0,DISPLAY="",SORT="",SDIR=""
  1.  . I $G(PLIEN)="" Q
  1.  . F  S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,26,IEN)) Q:'IEN  D
  1.  .. S CODE=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,26,IEN,0),"^",1)
  1.  .. S GIEN=$O(^BQI(90506.1,"B",CODE,""))
  1.  .. S SIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,26,IEN,0),"^",3)
  1.  .. S RIEN=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,26,IEN,0),"^",4)
  1.  .. S DISPLAY=DISPLAY_CODE_$C(29)
  1.  .. I SIEN'="" D
  1.  ... S $P(SORT,$C(29),SIEN)=CODE
  1.  ... S $P(SDIR,$C(29),SIEN)=RIEN
  1.  ;
  1.  S DISPLAY=$$TKO^BQIUL1(DISPLAY,$C(29))
  1.  S SORT=$$TKO^BQIUL1(SORT,$C(29))
  1.  S SDIR=$$TKO^BQIUL1(SDIR,$C(29))
  1.  I DISPLAY'="" D
  1.  . S RESULT=1
  1.  . S II=II+1,@DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_$C(30)
  1.  Q RESULT