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

BQILYDEF.m

Go to the documentation of this file.
  1. BQILYDEF ;PRXM/HC/ALA-Layout Template Defaults ; 01 Jun 2007 11:51 AM
  1. ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1. ;
  1. RET(DATA,BDUZ,TMIEN) ;EP -- BQI GET LAYOUTS
  1. ;
  1. ; Input
  1. ; TMIEN = Template internal entry number, if null gets all
  1. ; defaults for a user
  1. ; BDUZ = User IEN
  1. ;
  1. NEW UID,II,BN,CODE,BQARY,DIEN,DISPLAY,IEN,SORT,TYP,TMIEN,DEF,TEMPL,DTYP
  1. NEW DOR,SOR,SDIR,LEDT,TDEF,DDEF
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQILYGET",UID))
  1. K @DATA
  1. ;
  1. S TMIEN=$G(TMIEN,"")
  1. I TMIEN'?.N S TMIEN=$$TPN^BQILYUTL(BDUZ,TMIEN)
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQILYDEF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER"
  1. S @DATA@(II)=@DATA@(II)_"^T00120SORT_ORDER^T00120SORT_DIRECTION^D00030LAST_EDITED^T00001CAN_DELETE"
  1. S @DATA@(II)=@DATA@(II)_"^T00050TITLE^T00050LAYOUT_TYPE^T00245COLUMN_RPC^T00245SYSTEM_DEF_RPC"_$C(30)
  1. ;
  1. ; Make sure user has all templates defined - If not, set up
  1. S DIEN=0
  1. F S DIEN=$O(^BQICARE(BDUZ,15,DIEN)) Q:'DIEN D
  1. . N DA,IENS,TYP,DEF
  1. . ;
  1. . ;Track whether each type has a default template set up (and if each type has one designated as the default)
  1. . S DA(1)=DUZ,DA=DIEN,IENS=$$IENS^DILF(.DA)
  1. . S TYP=$$GET1^DIQ(90505.015,IENS,.02,"I") Q:TYP=""
  1. . I $$GET1^DIQ(90505.015,IENS,.05,"I")'="Y" S TDEF(TYP)=""
  1. . I $$GET1^DIQ(90505.015,IENS,.03,"I")="Y" S DDEF(TYP)=""
  1. ;F TYP="D","G","R","A","H","Q","T","N","B","I","CO" D
  1. S TYP=""
  1. F S TYP=$O(^BQI(90506.5,"C",TYP)) Q:TYP="" D
  1. . S VSIEN=$O(^BQI(90506.5,"C",TYP,""))
  1. . I $P(^BQI(90506.5,VSIEN,0),U,10)=1 Q
  1. . S TMTYP=$G(^BQI(90506.5,VSIEN,2))
  1. . I $P(TMTYP,U,2)="" Q
  1. . I $P(TMTYP,U,3)=1 Q
  1. . I '$D(TDEF(TYP)) D DTMPSET^BQITMPLS(TYP) ;Create default template if missing
  1. . I '$D(DDEF(TYP)) D DTMPDEF^BQITMPLS(TYP) ;Set to default if needed
  1. ;
  1. ; Make sure templates are now defined
  1. S DIEN=$O(^BQICARE(BDUZ,15,0))
  1. ;
  1. ; If the template IEN is not null, get the specific information about that template
  1. I TMIEN'="" D
  1. . S TYP=$P(^BQICARE(BDUZ,15,TMIEN,0),U,2)
  1. . D STND(TYP) Q
  1. . D DEF(TMIEN,1)
  1. ;
  1. I TMIEN="" D
  1. . N STDLST,DEFLST,VSIEN,TMTYP
  1. . ; Get the standard default displays for all types if there are no default
  1. . ; templates defined
  1. . I DIEN="" D Q
  1. .. ;F TYP="D","G","R","A","H","Q","T","N","I","B","CO" D STND(TYP)
  1. .. S TYP=""
  1. .. F S TYP=$O(^BQI(90506.5,"C",TYP)) Q:TYP="" D
  1. ... S VSIEN=$O(^BQI(90506.5,"C",TYP,""))
  1. ... S TMTYP=$G(^BQI(90506.5,VSIEN,2))
  1. ... I $P(TMTYP,U,2)="" Q
  1. ... I $P(TMTYP,U,3)=1 Q
  1. ... D STND(TYP)
  1. . ;
  1. . ; Otherwise, get the displays for any defined default template
  1. . S DIEN=0
  1. . F S DIEN=$O(^BQICARE(BDUZ,15,DIEN)) Q:'DIEN D
  1. .. N DA,IENS,TYP,DEF
  1. .. ;
  1. .. ;Track whether each type has a default template set up
  1. .. S DA(1)=DUZ,DA=DIEN,IENS=$$IENS^DILF(.DA)
  1. .. S TYP=$$GET1^DIQ(90505.015,IENS,.02,"I") Q:TYP=""
  1. .. S ISDEL=$$GET1^DIQ(90505.015,IENS,.05,"I") ;If deletable, not a standard template
  1. .. I ISDEL="" S STDLST(TYP,DIEN)="" Q
  1. .. ;
  1. .. ;Look for non-standard defaults
  1. .. S DEF=$$GET1^DIQ(90505.015,IENS,.03,"I")
  1. .. S:DEF="Y" DEFLST(TYP)=""
  1. .. ;
  1. .. ;Set up the added entries
  1. .. D DEF(DIEN,1)
  1. . ;
  1. . ;Now set up the standard entries (which may not be defined)
  1. . ;If no default set yet, set this one as the default
  1. . ;F TYP="D","G","R","A","H","Q","T","N","I","B","CO" D
  1. . S TYP=""
  1. . F S TYP=$O(^BQI(90506.5,"C",TYP)) Q:TYP="" D
  1. .. S VSIEN=$O(^BQI(90506.5,"C",TYP,""))
  1. .. I $P(^BQI(90506.5,VSIEN,0),U,10)=1 Q
  1. .. S TMTYP=$G(^BQI(90506.5,VSIEN,2))
  1. .. I $P(TMTYP,U,2)="" Q
  1. .. I $P(TMTYP,U,3)=1 Q
  1. .. ;
  1. .. ;IF STANDARD NOT DEFINED - CREATE IT
  1. .. ;
  1. .. I '$D(STDLST(TYP)) D Q
  1. ... ;
  1. ... ;Already have a default template for type
  1. ... I $D(DEFLST(TYP)) D STND(TYP,"N") Q
  1. ... ;
  1. ... ;No default template yet - use this one
  1. ... D STND(TYP)
  1. ... ;
  1. .. ;If STANDARD DEFINED - USE IT
  1. .. ;
  1. .. S DIEN=$O(STDLST(TYP,"")) Q:DIEN=""
  1. .. ;
  1. .. ;Already have a default template for type
  1. .. I $D(DEFLST(TYP)) D DEF(DIEN,1) Q
  1. .. ;
  1. .. ;No default template yet - use this one
  1. .. D DEF(DIEN,1,1)
  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. STND(DTYP,DEF) ;EP - Get the standard display for each type
  1. ; Parameters
  1. ; TEMPL - Template name composed of type and 'Default'
  1. ; DEF - Whether this template is a default template
  1. ;
  1. NEW CRN,CNAM
  1. S CRN=$O(^BQI(90506.5,"C",DTYP,"")),CNAM="Unknown"
  1. I CRN'="" D
  1. . S CNAM=$P(^BQI(90506.5,CRN,0),U,9) I CNAM'="" Q
  1. . S CNAM=$P(^BQI(90506.5,CRN,0),U,1)
  1. S TEMPL=CNAM_" Default"
  1. S DEF=$G(DEF,""),DEF=$S(DEF="N":"",1:"Y")
  1. ;
  1. S II=II+1,@DATA@(II)=U_TEMPL_U_DEF_U_DTYP
  1. ;
  1. ; If the type is Patient, get the default definition
  1. I DTYP="D" D
  1. . S @DATA@(II)=@DATA@(II)_U_$$DFNC^BQIPLVW()_"^"_$$SFNC^BQIPLVW()_"^A^^"_$$GUI(DTYP)_$C(30) Q
  1. ; If the type is Reminders, get the default definition
  1. I DTYP="R" D
  1. . S @DATA@(II)=@DATA@(II)_U_$$RDEF^BQIRMPL()_"^"_$$SFNC^BQIPLVW()_"^A^^"_$$GUI(DTYP)_$C(30) Q
  1. ; If the type is Performance, get the default definition
  1. I DTYP="G" D
  1. . S @DATA@(II)=@DATA@(II)_U_$$DFNC^BQIGPVW()_$C(29)_$$GDEF^BQIGPVW()_"^"_$$SFNC^BQIGPVW()_"^A^^"_$$GUI(DTYP)_$C(30) Q
  1. I DTYP="Q"!(DTYP="T")!(DTYP="N") D Q
  1. . S CRN=$O(^BQI(90506.5,"C",DTYP,"")) I CRN="" Q
  1. . S CARE=$P(^BQI(90506.5,CRN,0),U,1)
  1. . S @DATA@(II)=@DATA@(II)_U_$$DFNC^BQICEVW()_$C(29)_$$CDEF^BQICEVW()_"^"_$$SFNC^BQICEVW(CRN,DTYP)_"^A"_$C(29)_"D"_$C(29)_"A^^"_$$GUI(DTYP)_$C(30) Q
  1. I DTYP'="D",DTYP'="R",DTYP'="G" D
  1. . N CRN,CARE
  1. . S CRN=$O(^BQI(90506.5,"C",DTYP,"")) I CRN="" Q
  1. . S CARE=$P(^BQI(90506.5,CRN,0),U,1)
  1. . S @DATA@(II)=@DATA@(II)_U_$$DFNC^BQICMVW()_$C(29)_$$CDEF^BQICMVW()_"^"_$$SFNC^BQICMVW()_"^A^^"_$$GUI(DTYP)_$C(30) Q
  1. Q
  1. ;
  1. DEF(TIEN,DEL,DEF) ;EP - Get a default display by a specific template record
  1. ; Parameters
  1. ; TIEN - Template IEN
  1. ; DEL - 1 - Return CAN_DELETE field and other fields needed by the GUI
  1. ; (used by BQI GET LAYOUTS but not BQI GET PANEL LAYOUTS)
  1. ; DEF - 1 - This template should be set as the default
  1. ;
  1. N TEMPL,ISDEL,LEDT,DOR,DISPLAY
  1. S TEMPL=$P(^BQICARE(DUZ,15,TIEN,0),U,1),TYP=$P(^(0),U,2)
  1. S DEF=$S($G(DEF)=1:1,1:$P(^BQICARE(DUZ,15,TIEN,0),U,3)) S:DEF=1 DEF="Y"
  1. S ISDEL=$P(^BQICARE(DUZ,15,TIEN,0),U,5)
  1. S LEDT=$P(^BQICARE(DUZ,15,TIEN,0),U,4),LEDT=$$FMTE^BQIUL1(LEDT)
  1. S DOR="",DISPLAY=""
  1. F S DOR=$O(^BQICARE(DUZ,15,TIEN,1,"C",DOR)) Q:DOR="" D
  1. . NEW IEN
  1. . S IEN=""
  1. . F S IEN=$O(^BQICARE(DUZ,15,TIEN,1,"C",DOR,IEN)) Q:IEN="" D
  1. .. S CODE=$P(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,1)
  1. .. S DISPLAY=DISPLAY_CODE_$C(29)
  1. S DISPLAY=$$TKO^BQIUL1(DISPLAY,$C(29))
  1. ;
  1. S SOR="",SORT="",SDIR=""
  1. F S SOR=$O(^BQICARE(DUZ,15,TIEN,1,"D",SOR)) Q:SOR="" D
  1. . NEW IEN
  1. . S IEN=""
  1. . F S IEN=$O(^BQICARE(DUZ,15,TIEN,1,"D",SOR,IEN)) Q:IEN="" D
  1. .. N CODE,DIR
  1. .. S CODE=$P(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,1)
  1. .. S DIR=$P(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,4)
  1. .. S SORT=SORT_CODE_$C(29),SDIR=SDIR_DIR_$C(29)
  1. S SORT=$$TKO^BQIUL1(SORT,$C(29))
  1. S SDIR=$$TKO^BQIUL1(SDIR,$C(29))
  1. I SDIR="" S SDIR="A"
  1. ;
  1. I $G(DEL)=1 S II=II+1,@DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_U_LEDT_U_ISDEL_$$GUI(TYP)_$C(30) Q
  1. E S II=II+1,@DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_U_LEDT_$C(30)
  1. Q
  1. ;
  1. SAV(DATA,OWNR,LYIEN,TEMPL,TYPE,ADDEL,SOR,SDIR,DOR) ;EP -- BQI SAVE LAYOUTS
  1. ; Input
  1. ; OWNR - Whose layout this is
  1. ; LYIEN - Layout internal entry number, will exist if updating an existing
  1. ; layout and will be null if new layout record
  1. ; TEMPL - Template name, if null will default to a standard name
  1. ; TYPE - The type of template P=Patient;G=GPRA;R=Reminders;M=My Measures
  1. ; ADDEL - Is this a template add (NEW) or a template delete (DEL) - if an add, it is deletable
  1. ; DOR - Display order
  1. ; SOR - Sort order
  1. ; SDIR - Sort direction
  1. ;
  1. NEW UID,II,ERROR,DIC,DI,BQIUPD,SI,STVW,STVCD,SRDR,SRCN
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQILYSAV",UID))
  1. K @DATA
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQILYDEF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S:$G(OWNR)="" OWNR=DUZ
  1. S TEMPL=$E($G(TEMPL),1,80)
  1. ;
  1. S @DATA@(II)="I00010RESULT^T00120ERROR_MESSAGE"_$C(30)
  1. ;
  1. ;Perform Deletes
  1. I $G(ADDEL)="DEL" D DELTMP^BQITMPLE(OWNR,LYIEN,TEMPL,.ERROR) G XSAV
  1. ;
  1. I $G(TEMPL)="" D
  1. . S SRCN=$O(^BQI(90506.5,"C",TYPE,""))
  1. . S TEMPL=$P(^BQI(90506.5,SRCN,0),U,1)_" Default"
  1. I $G(LYIEN)="" D
  1. . NEW DIC,Y,DLAYGO
  1. . I $G(^BQICARE(OWNR,15,0))="" S ^BQICARE(OWNR,15,0)="^90505.015^^"
  1. . S DIC(0)="L",DA(1)=OWNR,DLAYGO="90505.015",DIC="^BQICARE("_DA(1)_",15,",X=TEMPL
  1. . D ^DIC
  1. . S LYIEN=+Y
  1. ;
  1. ;Remove the previous parameters
  1. NEW DA,IENS,DIK
  1. K DA
  1. S DA(2)=OWNR,DA(1)=LYIEN,DA=0
  1. S DIK="^BQICARE("_DA(2)_",15,"_DA(1)_",1,"
  1. F S DA=$O(^BQICARE(OWNR,15,LYIEN,1,DA)) Q:'DA D ^DIK
  1. ;
  1. NEW DA,IENS
  1. K DA
  1. S DA(1)=OWNR,DA=LYIEN,IENS=$$IENS^DILF(.DA)
  1. S BQIUPD(90505.015,IENS,.01)=TEMPL
  1. S BQIUPD(90505.015,IENS,.02)=TYPE
  1. I $G(ADDEL)="NEW" S BQIUPD(90505.015,IENS,.05)="Y"
  1. S BQIUPD(90505.015,IENS,.04)=$$NOW^XLFDT()
  1. D FILE^DIE("","BQIUPD","ERROR")
  1. ;
  1. S SOR=$G(SOR,""),SDIR=$G(SDIR,"")
  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. F DI=1:1:$L(DOR,$C(29)) S STVCD=$P(DOR,$C(29),DI) Q:STVCD="" D
  1. . S STVW=STVCD
  1. . NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
  1. . S DA(2)=OWNR,DA(1)=LYIEN
  1. . S DIC="^BQICARE("_DA(2)_",15,"_DA(1)_",1,",DIE=DIC
  1. . S DLAYGO=90505.151,DIC(0)="L",DIC("P")=DLAYGO
  1. . S X=STVW
  1. . I '$D(^BQICARE(DA(2),15,DA(1),1,0)) S ^BQICARE(DA(2),15,DA(1),1,0)="^90505.151^^"
  1. . K DO,DD D FILE^DICN
  1. . S DA=+Y
  1. . S IENS=$$IENS^DILF(.DA)
  1. . S BQIUPD(90505.151,IENS,.02)=DI
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . K BQIUPD
  1. ;
  1. F SI=1:1:$L(SOR,$C(29)) S STVCD=$P(SOR,$C(29),SI) Q:STVCD="" D
  1. . S SRDR=$P(SDIR,$C(29),SI) S:SRDR="" SRDR="A"
  1. . S STVW=STVCD
  1. . NEW DA,IENS
  1. . S DA(2)=OWNR,DA(1)=LYIEN,DA=$O(^BQICARE(OWNR,15,LYIEN,1,"B",STVW,""))
  1. . S IENS=$$IENS^DILF(.DA)
  1. . S BQIUPD(90505.151,IENS,.03)=SI
  1. . S BQIUPD(90505.151,IENS,.04)=SRDR
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . K BQIUPD
  1. ;
  1. XSAV I $D(ERROR) S II=II+1,@DATA@(II)="-1^"_$G(ERROR)_$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. GUI(TYPE) ;EP - Return additional fields needed by the GUI
  1. ;
  1. I $G(TYPE)="" Q "^^^^"
  1. ;
  1. NEW TIEN,VALUE,TITLE,LAYTYP,COLRPC,SYSRPC
  1. ;
  1. S TIEN=$O(^BQI(90506.5,"C",TYPE,"")) I TIEN="" Q "^"
  1. ;
  1. S TITLE=$$GET1^DIQ(90506.5,TIEN_",",2.01,"E")
  1. S LAYTYP=$$GET1^DIQ(90506.5,TIEN_",",2.02,"E")
  1. S COLRPC=$$GET1^DIQ(90506.5,TIEN_",",3,"E")
  1. S SYSRPC=$$GET1^DIQ(90506.5,TIEN_",",4,"E")
  1. ;
  1. ;Set up return information
  1. S VALUE=U_TITLE_U_LAYTYP_U_COLRPC_U_SYSRPC
  1. ;
  1. Q VALUE