- BQILYDEF ;PRXM/HC/ALA-Layout Template Defaults ; 01 Jun 2007 11:51 AM
- ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- ;
- RET(DATA,BDUZ,TMIEN) ;EP -- BQI GET LAYOUTS
- ;
- ; Input
- ; TMIEN = Template internal entry number, if null gets all
- ; defaults for a user
- ; BDUZ = User IEN
- ;
- NEW UID,II,BN,CODE,BQARY,DIEN,DISPLAY,IEN,SORT,TYP,TMIEN,DEF,TEMPL,DTYP
- NEW DOR,SOR,SDIR,LEDT,TDEF,DDEF
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQILYGET",UID))
- K @DATA
- ;
- S TMIEN=$G(TMIEN,"")
- I TMIEN'?.N S TMIEN=$$TPN^BQILYUTL(BDUZ,TMIEN)
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQILYDEF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER"
- S @DATA@(II)=@DATA@(II)_"^T00120SORT_ORDER^T00120SORT_DIRECTION^D00030LAST_EDITED^T00001CAN_DELETE"
- S @DATA@(II)=@DATA@(II)_"^T00050TITLE^T00050LAYOUT_TYPE^T00245COLUMN_RPC^T00245SYSTEM_DEF_RPC"_$C(30)
- ;
- ; Make sure user has all templates defined - If not, set up
- S DIEN=0
- F S DIEN=$O(^BQICARE(BDUZ,15,DIEN)) Q:'DIEN D
- . N DA,IENS,TYP,DEF
- . ;
- . ;Track whether each type has a default template set up (and if each type has one designated as the default)
- . S DA(1)=DUZ,DA=DIEN,IENS=$$IENS^DILF(.DA)
- . S TYP=$$GET1^DIQ(90505.015,IENS,.02,"I") Q:TYP=""
- . I $$GET1^DIQ(90505.015,IENS,.05,"I")'="Y" S TDEF(TYP)=""
- . I $$GET1^DIQ(90505.015,IENS,.03,"I")="Y" S DDEF(TYP)=""
- ;F TYP="D","G","R","A","H","Q","T","N","B","I","CO" D
- S TYP=""
- F S TYP=$O(^BQI(90506.5,"C",TYP)) Q:TYP="" D
- . S VSIEN=$O(^BQI(90506.5,"C",TYP,""))
- . I $P(^BQI(90506.5,VSIEN,0),U,10)=1 Q
- . S TMTYP=$G(^BQI(90506.5,VSIEN,2))
- . I $P(TMTYP,U,2)="" Q
- . I $P(TMTYP,U,3)=1 Q
- . I '$D(TDEF(TYP)) D DTMPSET^BQITMPLS(TYP) ;Create default template if missing
- . I '$D(DDEF(TYP)) D DTMPDEF^BQITMPLS(TYP) ;Set to default if needed
- ;
- ; Make sure templates are now defined
- S DIEN=$O(^BQICARE(BDUZ,15,0))
- ;
- ; If the template IEN is not null, get the specific information about that template
- I TMIEN'="" D
- . S TYP=$P(^BQICARE(BDUZ,15,TMIEN,0),U,2)
- . D STND(TYP) Q
- . D DEF(TMIEN,1)
- ;
- I TMIEN="" D
- . N STDLST,DEFLST,VSIEN,TMTYP
- . ; Get the standard default displays for all types if there are no default
- . ; templates defined
- . I DIEN="" D Q
- .. ;F TYP="D","G","R","A","H","Q","T","N","I","B","CO" D STND(TYP)
- .. S TYP=""
- .. F S TYP=$O(^BQI(90506.5,"C",TYP)) Q:TYP="" D
- ... S VSIEN=$O(^BQI(90506.5,"C",TYP,""))
- ... S TMTYP=$G(^BQI(90506.5,VSIEN,2))
- ... I $P(TMTYP,U,2)="" Q
- ... I $P(TMTYP,U,3)=1 Q
- ... D STND(TYP)
- . ;
- . ; Otherwise, get the displays for any defined default template
- . S DIEN=0
- . F S DIEN=$O(^BQICARE(BDUZ,15,DIEN)) Q:'DIEN D
- .. N DA,IENS,TYP,DEF
- .. ;
- .. ;Track whether each type has a default template set up
- .. S DA(1)=DUZ,DA=DIEN,IENS=$$IENS^DILF(.DA)
- .. S TYP=$$GET1^DIQ(90505.015,IENS,.02,"I") Q:TYP=""
- .. S ISDEL=$$GET1^DIQ(90505.015,IENS,.05,"I") ;If deletable, not a standard template
- .. I ISDEL="" S STDLST(TYP,DIEN)="" Q
- .. ;
- .. ;Look for non-standard defaults
- .. S DEF=$$GET1^DIQ(90505.015,IENS,.03,"I")
- .. S:DEF="Y" DEFLST(TYP)=""
- .. ;
- .. ;Set up the added entries
- .. D DEF(DIEN,1)
- . ;
- . ;Now set up the standard entries (which may not be defined)
- . ;If no default set yet, set this one as the default
- . ;F TYP="D","G","R","A","H","Q","T","N","I","B","CO" D
- . S TYP=""
- . F S TYP=$O(^BQI(90506.5,"C",TYP)) Q:TYP="" D
- .. S VSIEN=$O(^BQI(90506.5,"C",TYP,""))
- .. I $P(^BQI(90506.5,VSIEN,0),U,10)=1 Q
- .. S TMTYP=$G(^BQI(90506.5,VSIEN,2))
- .. I $P(TMTYP,U,2)="" Q
- .. I $P(TMTYP,U,3)=1 Q
- .. ;
- .. ;IF STANDARD NOT DEFINED - CREATE IT
- .. ;
- .. I '$D(STDLST(TYP)) D Q
- ... ;
- ... ;Already have a default template for type
- ... I $D(DEFLST(TYP)) D STND(TYP,"N") Q
- ... ;
- ... ;No default template yet - use this one
- ... D STND(TYP)
- ... ;
- .. ;If STANDARD DEFINED - USE IT
- .. ;
- .. S DIEN=$O(STDLST(TYP,"")) Q:DIEN=""
- .. ;
- .. ;Already have a default template for type
- .. I $D(DEFLST(TYP)) D DEF(DIEN,1) Q
- .. ;
- .. ;No default template yet - use this one
- .. D DEF(DIEN,1,1)
- ;
- 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
- ;
- STND(DTYP,DEF) ;EP - Get the standard display for each type
- ; Parameters
- ; TEMPL - Template name composed of type and 'Default'
- ; DEF - Whether this template is a default template
- ;
- NEW CRN,CNAM
- S CRN=$O(^BQI(90506.5,"C",DTYP,"")),CNAM="Unknown"
- I CRN'="" D
- . S CNAM=$P(^BQI(90506.5,CRN,0),U,9) I CNAM'="" Q
- . S CNAM=$P(^BQI(90506.5,CRN,0),U,1)
- S TEMPL=CNAM_" Default"
- S DEF=$G(DEF,""),DEF=$S(DEF="N":"",1:"Y")
- ;
- S II=II+1,@DATA@(II)=U_TEMPL_U_DEF_U_DTYP
- ;
- ; If the type is Patient, get the default definition
- I DTYP="D" D
- . S @DATA@(II)=@DATA@(II)_U_$$DFNC^BQIPLVW()_"^"_$$SFNC^BQIPLVW()_"^A^^"_$$GUI(DTYP)_$C(30) Q
- ; If the type is Reminders, get the default definition
- I DTYP="R" D
- . S @DATA@(II)=@DATA@(II)_U_$$RDEF^BQIRMPL()_"^"_$$SFNC^BQIPLVW()_"^A^^"_$$GUI(DTYP)_$C(30) Q
- ; If the type is Performance, get the default definition
- I DTYP="G" D
- . S @DATA@(II)=@DATA@(II)_U_$$DFNC^BQIGPVW()_$C(29)_$$GDEF^BQIGPVW()_"^"_$$SFNC^BQIGPVW()_"^A^^"_$$GUI(DTYP)_$C(30) Q
- I DTYP="Q"!(DTYP="T")!(DTYP="N") D Q
- . S CRN=$O(^BQI(90506.5,"C",DTYP,"")) I CRN="" Q
- . S CARE=$P(^BQI(90506.5,CRN,0),U,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
- I DTYP'="D",DTYP'="R",DTYP'="G" D
- . N CRN,CARE
- . S CRN=$O(^BQI(90506.5,"C",DTYP,"")) I CRN="" Q
- . S CARE=$P(^BQI(90506.5,CRN,0),U,1)
- . S @DATA@(II)=@DATA@(II)_U_$$DFNC^BQICMVW()_$C(29)_$$CDEF^BQICMVW()_"^"_$$SFNC^BQICMVW()_"^A^^"_$$GUI(DTYP)_$C(30) Q
- Q
- ;
- DEF(TIEN,DEL,DEF) ;EP - Get a default display by a specific template record
- ; Parameters
- ; TIEN - Template IEN
- ; DEL - 1 - Return CAN_DELETE field and other fields needed by the GUI
- ; (used by BQI GET LAYOUTS but not BQI GET PANEL LAYOUTS)
- ; DEF - 1 - This template should be set as the default
- ;
- N TEMPL,ISDEL,LEDT,DOR,DISPLAY
- S TEMPL=$P(^BQICARE(DUZ,15,TIEN,0),U,1),TYP=$P(^(0),U,2)
- S DEF=$S($G(DEF)=1:1,1:$P(^BQICARE(DUZ,15,TIEN,0),U,3)) S:DEF=1 DEF="Y"
- S ISDEL=$P(^BQICARE(DUZ,15,TIEN,0),U,5)
- S LEDT=$P(^BQICARE(DUZ,15,TIEN,0),U,4),LEDT=$$FMTE^BQIUL1(LEDT)
- S DOR="",DISPLAY=""
- F S DOR=$O(^BQICARE(DUZ,15,TIEN,1,"C",DOR)) Q:DOR="" D
- . NEW IEN
- . S IEN=""
- . F S IEN=$O(^BQICARE(DUZ,15,TIEN,1,"C",DOR,IEN)) Q:IEN="" D
- .. S CODE=$P(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,1)
- .. S DISPLAY=DISPLAY_CODE_$C(29)
- S DISPLAY=$$TKO^BQIUL1(DISPLAY,$C(29))
- ;
- S SOR="",SORT="",SDIR=""
- F S SOR=$O(^BQICARE(DUZ,15,TIEN,1,"D",SOR)) Q:SOR="" D
- . NEW IEN
- . S IEN=""
- . F S IEN=$O(^BQICARE(DUZ,15,TIEN,1,"D",SOR,IEN)) Q:IEN="" D
- .. N CODE,DIR
- .. S CODE=$P(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,1)
- .. S DIR=$P(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,4)
- .. S SORT=SORT_CODE_$C(29),SDIR=SDIR_DIR_$C(29)
- S SORT=$$TKO^BQIUL1(SORT,$C(29))
- S SDIR=$$TKO^BQIUL1(SDIR,$C(29))
- I SDIR="" S SDIR="A"
- ;
- 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
- E S II=II+1,@DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_U_LEDT_$C(30)
- Q
- ;
- SAV(DATA,OWNR,LYIEN,TEMPL,TYPE,ADDEL,SOR,SDIR,DOR) ;EP -- BQI SAVE LAYOUTS
- ; Input
- ; OWNR - Whose layout this is
- ; LYIEN - Layout internal entry number, will exist if updating an existing
- ; layout and will be null if new layout record
- ; TEMPL - Template name, if null will default to a standard name
- ; TYPE - The type of template P=Patient;G=GPRA;R=Reminders;M=My Measures
- ; ADDEL - Is this a template add (NEW) or a template delete (DEL) - if an add, it is deletable
- ; DOR - Display order
- ; SOR - Sort order
- ; SDIR - Sort direction
- ;
- NEW UID,II,ERROR,DIC,DI,BQIUPD,SI,STVW,STVCD,SRDR,SRCN
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQILYSAV",UID))
- K @DATA
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQILYDEF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S:$G(OWNR)="" OWNR=DUZ
- S TEMPL=$E($G(TEMPL),1,80)
- ;
- S @DATA@(II)="I00010RESULT^T00120ERROR_MESSAGE"_$C(30)
- ;
- ;Perform Deletes
- I $G(ADDEL)="DEL" D DELTMP^BQITMPLE(OWNR,LYIEN,TEMPL,.ERROR) G XSAV
- ;
- I $G(TEMPL)="" D
- . S SRCN=$O(^BQI(90506.5,"C",TYPE,""))
- . S TEMPL=$P(^BQI(90506.5,SRCN,0),U,1)_" Default"
- I $G(LYIEN)="" D
- . NEW DIC,Y,DLAYGO
- . I $G(^BQICARE(OWNR,15,0))="" S ^BQICARE(OWNR,15,0)="^90505.015^^"
- . S DIC(0)="L",DA(1)=OWNR,DLAYGO="90505.015",DIC="^BQICARE("_DA(1)_",15,",X=TEMPL
- . D ^DIC
- . S LYIEN=+Y
- ;
- ;Remove the previous parameters
- NEW DA,IENS,DIK
- K DA
- S DA(2)=OWNR,DA(1)=LYIEN,DA=0
- S DIK="^BQICARE("_DA(2)_",15,"_DA(1)_",1,"
- F S DA=$O(^BQICARE(OWNR,15,LYIEN,1,DA)) Q:'DA D ^DIK
- ;
- NEW DA,IENS
- K DA
- S DA(1)=OWNR,DA=LYIEN,IENS=$$IENS^DILF(.DA)
- S BQIUPD(90505.015,IENS,.01)=TEMPL
- S BQIUPD(90505.015,IENS,.02)=TYPE
- I $G(ADDEL)="NEW" S BQIUPD(90505.015,IENS,.05)="Y"
- S BQIUPD(90505.015,IENS,.04)=$$NOW^XLFDT()
- D FILE^DIE("","BQIUPD","ERROR")
- ;
- S SOR=$G(SOR,""),SDIR=$G(SDIR,"")
- 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
- ;
- F DI=1:1:$L(DOR,$C(29)) S STVCD=$P(DOR,$C(29),DI) Q:STVCD="" D
- . S STVW=STVCD
- . NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
- . S DA(2)=OWNR,DA(1)=LYIEN
- . S DIC="^BQICARE("_DA(2)_",15,"_DA(1)_",1,",DIE=DIC
- . S DLAYGO=90505.151,DIC(0)="L",DIC("P")=DLAYGO
- . S X=STVW
- . I '$D(^BQICARE(DA(2),15,DA(1),1,0)) S ^BQICARE(DA(2),15,DA(1),1,0)="^90505.151^^"
- . K DO,DD D FILE^DICN
- . S DA=+Y
- . S IENS=$$IENS^DILF(.DA)
- . S BQIUPD(90505.151,IENS,.02)=DI
- . D FILE^DIE("","BQIUPD","ERROR")
- . K BQIUPD
- ;
- F SI=1:1:$L(SOR,$C(29)) S STVCD=$P(SOR,$C(29),SI) Q:STVCD="" D
- . S SRDR=$P(SDIR,$C(29),SI) S:SRDR="" SRDR="A"
- . S STVW=STVCD
- . NEW DA,IENS
- . S DA(2)=OWNR,DA(1)=LYIEN,DA=$O(^BQICARE(OWNR,15,LYIEN,1,"B",STVW,""))
- . S IENS=$$IENS^DILF(.DA)
- . S BQIUPD(90505.151,IENS,.03)=SI
- . S BQIUPD(90505.151,IENS,.04)=SRDR
- . D FILE^DIE("","BQIUPD","ERROR")
- . K BQIUPD
- ;
- XSAV I $D(ERROR) S II=II+1,@DATA@(II)="-1^"_$G(ERROR)_$C(30)
- I '$D(ERROR) S II=II+1,@DATA@(II)="1^"_$C(30)
- S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- GUI(TYPE) ;EP - Return additional fields needed by the GUI
- ;
- I $G(TYPE)="" Q "^^^^"
- ;
- NEW TIEN,VALUE,TITLE,LAYTYP,COLRPC,SYSRPC
- ;
- S TIEN=$O(^BQI(90506.5,"C",TYPE,"")) I TIEN="" Q "^"
- ;
- S TITLE=$$GET1^DIQ(90506.5,TIEN_",",2.01,"E")
- S LAYTYP=$$GET1^DIQ(90506.5,TIEN_",",2.02,"E")
- S COLRPC=$$GET1^DIQ(90506.5,TIEN_",",3,"E")
- S SYSRPC=$$GET1^DIQ(90506.5,TIEN_",",4,"E")
- ;
- ;Set up return information
- S VALUE=U_TITLE_U_LAYTYP_U_COLRPC_U_SYSRPC
- ;
- Q VALUE
- BQILYDEF ;PRXM/HC/ALA-Layout Template Defaults ; 01 Jun 2007 11:51 AM
- +1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- +2 ;
- RET(DATA,BDUZ,TMIEN) ;EP -- BQI GET LAYOUTS
- +1 ;
- +2 ; Input
- +3 ; TMIEN = Template internal entry number, if null gets all
- +4 ; defaults for a user
- +5 ; BDUZ = User IEN
- +6 ;
- +7 NEW UID,II,BN,CODE,BQARY,DIEN,DISPLAY,IEN,SORT,TYP,TMIEN,DEF,TEMPL,DTYP
- +8 NEW DOR,SOR,SDIR,LEDT,TDEF,DDEF
- +9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +10 SET DATA=$NAME(^TMP("BQILYGET",UID))
- +11 KILL @DATA
- +12 ;
- +13 SET TMIEN=$GET(TMIEN,"")
- +14 IF TMIEN'?.N
- SET TMIEN=$$TPN^BQILYUTL(BDUZ,TMIEN)
- +15 ;
- +16 SET II=0
- +17 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQILYDEF D UNWIND^%ZTER"
- +18 ;
- +19 SET @DATA@(II)="I00010TEMPL_IEN^T00040TEMPLATE_NAME^T00001DEFAULT^T00001TYPE^T00120DISPLAY_ORDER"
- +20 SET @DATA@(II)=@DATA@(II)_"^T00120SORT_ORDER^T00120SORT_DIRECTION^D00030LAST_EDITED^T00001CAN_DELETE"
- +21 SET @DATA@(II)=@DATA@(II)_"^T00050TITLE^T00050LAYOUT_TYPE^T00245COLUMN_RPC^T00245SYSTEM_DEF_RPC"_$CHAR(30)
- +22 ;
- +23 ; Make sure user has all templates defined - If not, set up
- +24 SET DIEN=0
- +25 FOR
- SET DIEN=$ORDER(^BQICARE(BDUZ,15,DIEN))
- IF 'DIEN
- QUIT
- Begin DoDot:1
- +26 NEW DA,IENS,TYP,DEF
- +27 ;
- +28 ;Track whether each type has a default template set up (and if each type has one designated as the default)
- +29 SET DA(1)=DUZ
- SET DA=DIEN
- SET IENS=$$IENS^DILF(.DA)
- +30 SET TYP=$$GET1^DIQ(90505.015,IENS,.02,"I")
- IF TYP=""
- QUIT
- +31 IF $$GET1^DIQ(90505.015,IENS,.05,"I")'="Y"
- SET TDEF(TYP)=""
- +32 IF $$GET1^DIQ(90505.015,IENS,.03,"I")="Y"
- SET DDEF(TYP)=""
- End DoDot:1
- +33 ;F TYP="D","G","R","A","H","Q","T","N","B","I","CO" D
- +34 SET TYP=""
- +35 FOR
- SET TYP=$ORDER(^BQI(90506.5,"C",TYP))
- IF TYP=""
- QUIT
- Begin DoDot:1
- +36 SET VSIEN=$ORDER(^BQI(90506.5,"C",TYP,""))
- +37 IF $PIECE(^BQI(90506.5,VSIEN,0),U,10)=1
- QUIT
- +38 SET TMTYP=$GET(^BQI(90506.5,VSIEN,2))
- +39 IF $PIECE(TMTYP,U,2)=""
- QUIT
- +40 IF $PIECE(TMTYP,U,3)=1
- QUIT
- +41 ;Create default template if missing
- IF '$DATA(TDEF(TYP))
- DO DTMPSET^BQITMPLS(TYP)
- +42 ;Set to default if needed
- IF '$DATA(DDEF(TYP))
- DO DTMPDEF^BQITMPLS(TYP)
- End DoDot:1
- +43 ;
- +44 ; Make sure templates are now defined
- +45 SET DIEN=$ORDER(^BQICARE(BDUZ,15,0))
- +46 ;
- +47 ; If the template IEN is not null, get the specific information about that template
- +48 IF TMIEN'=""
- Begin DoDot:1
- +49 SET TYP=$PIECE(^BQICARE(BDUZ,15,TMIEN,0),U,2)
- +50 DO STND(TYP)
- QUIT
- +51 DO DEF(TMIEN,1)
- End DoDot:1
- +52 ;
- +53 IF TMIEN=""
- Begin DoDot:1
- +54 NEW STDLST,DEFLST,VSIEN,TMTYP
- +55 ; Get the standard default displays for all types if there are no default
- +56 ; templates defined
- +57 IF DIEN=""
- Begin DoDot:2
- +58 ;F TYP="D","G","R","A","H","Q","T","N","I","B","CO" D STND(TYP)
- +59 SET TYP=""
- +60 FOR
- SET TYP=$ORDER(^BQI(90506.5,"C",TYP))
- IF TYP=""
- QUIT
- Begin DoDot:3
- +61 SET VSIEN=$ORDER(^BQI(90506.5,"C",TYP,""))
- +62 SET TMTYP=$GET(^BQI(90506.5,VSIEN,2))
- +63 IF $PIECE(TMTYP,U,2)=""
- QUIT
- +64 IF $PIECE(TMTYP,U,3)=1
- QUIT
- +65 DO STND(TYP)
- End DoDot:3
- End DoDot:2
- QUIT
- +66 ;
- +67 ; Otherwise, get the displays for any defined default template
- +68 SET DIEN=0
- +69 FOR
- SET DIEN=$ORDER(^BQICARE(BDUZ,15,DIEN))
- IF 'DIEN
- QUIT
- Begin DoDot:2
- +70 NEW DA,IENS,TYP,DEF
- +71 ;
- +72 ;Track whether each type has a default template set up
- +73 SET DA(1)=DUZ
- SET DA=DIEN
- SET IENS=$$IENS^DILF(.DA)
- +74 SET TYP=$$GET1^DIQ(90505.015,IENS,.02,"I")
- IF TYP=""
- QUIT
- +75 ;If deletable, not a standard template
- SET ISDEL=$$GET1^DIQ(90505.015,IENS,.05,"I")
- +76 IF ISDEL=""
- SET STDLST(TYP,DIEN)=""
- QUIT
- +77 ;
- +78 ;Look for non-standard defaults
- +79 SET DEF=$$GET1^DIQ(90505.015,IENS,.03,"I")
- +80 IF DEF="Y"
- SET DEFLST(TYP)=""
- +81 ;
- +82 ;Set up the added entries
- +83 DO DEF(DIEN,1)
- End DoDot:2
- +84 ;
- +85 ;Now set up the standard entries (which may not be defined)
- +86 ;If no default set yet, set this one as the default
- +87 ;F TYP="D","G","R","A","H","Q","T","N","I","B","CO" D
- +88 SET TYP=""
- +89 FOR
- SET TYP=$ORDER(^BQI(90506.5,"C",TYP))
- IF TYP=""
- QUIT
- Begin DoDot:2
- +90 SET VSIEN=$ORDER(^BQI(90506.5,"C",TYP,""))
- +91 IF $PIECE(^BQI(90506.5,VSIEN,0),U,10)=1
- QUIT
- +92 SET TMTYP=$GET(^BQI(90506.5,VSIEN,2))
- +93 IF $PIECE(TMTYP,U,2)=""
- QUIT
- +94 IF $PIECE(TMTYP,U,3)=1
- QUIT
- +95 ;
- +96 ;IF STANDARD NOT DEFINED - CREATE IT
- +97 ;
- +98 IF '$DATA(STDLST(TYP))
- Begin DoDot:3
- +99 ;
- +100 ;Already have a default template for type
- +101 IF $DATA(DEFLST(TYP))
- DO STND(TYP,"N")
- QUIT
- +102 ;
- +103 ;No default template yet - use this one
- +104 DO STND(TYP)
- +105 ;
- End DoDot:3
- QUIT
- +106 ;If STANDARD DEFINED - USE IT
- +107 ;
- +108 SET DIEN=$ORDER(STDLST(TYP,""))
- IF DIEN=""
- QUIT
- +109 ;
- +110 ;Already have a default template for type
- +111 IF $DATA(DEFLST(TYP))
- DO DEF(DIEN,1)
- QUIT
- +112 ;
- +113 ;No default template yet - use this one
- +114 DO DEF(DIEN,1,1)
- End DoDot:2
- End DoDot:1
- +115 ;
- 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 ;
- STND(DTYP,DEF) ;EP - Get the standard display for each type
- +1 ; Parameters
- +2 ; TEMPL - Template name composed of type and 'Default'
- +3 ; DEF - Whether this template is a default template
- +4 ;
- +5 NEW CRN,CNAM
- +6 SET CRN=$ORDER(^BQI(90506.5,"C",DTYP,""))
- SET CNAM="Unknown"
- +7 IF CRN'=""
- Begin DoDot:1
- +8 SET CNAM=$PIECE(^BQI(90506.5,CRN,0),U,9)
- IF CNAM'=""
- QUIT
- +9 SET CNAM=$PIECE(^BQI(90506.5,CRN,0),U,1)
- End DoDot:1
- +10 SET TEMPL=CNAM_" Default"
- +11 SET DEF=$GET(DEF,"")
- SET DEF=$SELECT(DEF="N":"",1:"Y")
- +12 ;
- +13 SET II=II+1
- SET @DATA@(II)=U_TEMPL_U_DEF_U_DTYP
- +14 ;
- +15 ; If the type is Patient, get the default definition
- +16 IF DTYP="D"
- Begin DoDot:1
- +17 SET @DATA@(II)=@DATA@(II)_U_$$DFNC^BQIPLVW()_"^"_$$SFNC^BQIPLVW()_"^A^^"_$$GUI(DTYP)_$CHAR(30)
- QUIT
- End DoDot:1
- +18 ; If the type is Reminders, get the default definition
- +19 IF DTYP="R"
- Begin DoDot:1
- +20 SET @DATA@(II)=@DATA@(II)_U_$$RDEF^BQIRMPL()_"^"_$$SFNC^BQIPLVW()_"^A^^"_$$GUI(DTYP)_$CHAR(30)
- QUIT
- End DoDot:1
- +21 ; If the type is Performance, get the default definition
- +22 IF DTYP="G"
- Begin DoDot:1
- +23 SET @DATA@(II)=@DATA@(II)_U_$$DFNC^BQIGPVW()_$CHAR(29)_$$GDEF^BQIGPVW()_"^"_$$SFNC^BQIGPVW()_"^A^^"_$$GUI(DTYP)_$CHAR(30)
- QUIT
- End DoDot:1
- +24 IF DTYP="Q"!(DTYP="T")!(DTYP="N")
- Begin DoDot:1
- +25 SET CRN=$ORDER(^BQI(90506.5,"C",DTYP,""))
- IF CRN=""
- QUIT
- +26 SET CARE=$PIECE(^BQI(90506.5,CRN,0),U,1)
- +27 SET @DATA@(II)=@DATA@(II)_U_$$DFNC^BQICEVW()_$CHAR(29)_$$CDEF^BQICEVW()_"^"_$$SFNC^BQICEVW(CRN,DTYP)_"^A"_$CHAR(29)_"D"_$CHAR(29)_"A^^"_$$GUI(DTYP)_$CHAR(30)
- QUIT
- End DoDot:1
- QUIT
- +28 IF DTYP'="D"
- IF DTYP'="R"
- IF DTYP'="G"
- Begin DoDot:1
- +29 NEW CRN,CARE
- +30 SET CRN=$ORDER(^BQI(90506.5,"C",DTYP,""))
- IF CRN=""
- QUIT
- +31 SET CARE=$PIECE(^BQI(90506.5,CRN,0),U,1)
- +32 SET @DATA@(II)=@DATA@(II)_U_$$DFNC^BQICMVW()_$CHAR(29)_$$CDEF^BQICMVW()_"^"_$$SFNC^BQICMVW()_"^A^^"_$$GUI(DTYP)_$CHAR(30)
- QUIT
- End DoDot:1
- +33 QUIT
- +34 ;
- DEF(TIEN,DEL,DEF) ;EP - Get a default display by a specific template record
- +1 ; Parameters
- +2 ; TIEN - Template IEN
- +3 ; DEL - 1 - Return CAN_DELETE field and other fields needed by the GUI
- +4 ; (used by BQI GET LAYOUTS but not BQI GET PANEL LAYOUTS)
- +5 ; DEF - 1 - This template should be set as the default
- +6 ;
- +7 NEW TEMPL,ISDEL,LEDT,DOR,DISPLAY
- +8 SET TEMPL=$PIECE(^BQICARE(DUZ,15,TIEN,0),U,1)
- SET TYP=$PIECE(^(0),U,2)
- +9 SET DEF=$SELECT($GET(DEF)=1:1,1:$PIECE(^BQICARE(DUZ,15,TIEN,0),U,3))
- IF DEF=1
- SET DEF="Y"
- +10 SET ISDEL=$PIECE(^BQICARE(DUZ,15,TIEN,0),U,5)
- +11 SET LEDT=$PIECE(^BQICARE(DUZ,15,TIEN,0),U,4)
- SET LEDT=$$FMTE^BQIUL1(LEDT)
- +12 SET DOR=""
- SET DISPLAY=""
- +13 FOR
- SET DOR=$ORDER(^BQICARE(DUZ,15,TIEN,1,"C",DOR))
- IF DOR=""
- QUIT
- Begin DoDot:1
- +14 NEW IEN
- +15 SET IEN=""
- +16 FOR
- SET IEN=$ORDER(^BQICARE(DUZ,15,TIEN,1,"C",DOR,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:2
- +17 SET CODE=$PIECE(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,1)
- +18 SET DISPLAY=DISPLAY_CODE_$CHAR(29)
- End DoDot:2
- End DoDot:1
- +19 SET DISPLAY=$$TKO^BQIUL1(DISPLAY,$CHAR(29))
- +20 ;
- +21 SET SOR=""
- SET SORT=""
- SET SDIR=""
- +22 FOR
- SET SOR=$ORDER(^BQICARE(DUZ,15,TIEN,1,"D",SOR))
- IF SOR=""
- QUIT
- Begin DoDot:1
- +23 NEW IEN
- +24 SET IEN=""
- +25 FOR
- SET IEN=$ORDER(^BQICARE(DUZ,15,TIEN,1,"D",SOR,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:2
- +26 NEW CODE,DIR
- +27 SET CODE=$PIECE(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,1)
- +28 SET DIR=$PIECE(^BQICARE(DUZ,15,TIEN,1,IEN,0),U,4)
- +29 SET SORT=SORT_CODE_$CHAR(29)
- SET SDIR=SDIR_DIR_$CHAR(29)
- End DoDot:2
- End DoDot:1
- +30 SET SORT=$$TKO^BQIUL1(SORT,$CHAR(29))
- +31 SET SDIR=$$TKO^BQIUL1(SDIR,$CHAR(29))
- +32 IF SDIR=""
- SET SDIR="A"
- +33 ;
- +34 IF $GET(DEL)=1
- SET II=II+1
- SET @DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_U_LEDT_U_ISDEL_$$GUI(TYP)_$CHAR(30)
- QUIT
- +35 IF '$TEST
- SET II=II+1
- SET @DATA@(II)=TIEN_U_TEMPL_U_DEF_U_TYP_U_DISPLAY_U_SORT_U_SDIR_U_LEDT_$CHAR(30)
- +36 QUIT
- +37 ;
- SAV(DATA,OWNR,LYIEN,TEMPL,TYPE,ADDEL,SOR,SDIR,DOR) ;EP -- BQI SAVE LAYOUTS
- +1 ; Input
- +2 ; OWNR - Whose layout this is
- +3 ; LYIEN - Layout internal entry number, will exist if updating an existing
- +4 ; layout and will be null if new layout record
- +5 ; TEMPL - Template name, if null will default to a standard name
- +6 ; TYPE - The type of template P=Patient;G=GPRA;R=Reminders;M=My Measures
- +7 ; ADDEL - Is this a template add (NEW) or a template delete (DEL) - if an add, it is deletable
- +8 ; DOR - Display order
- +9 ; SOR - Sort order
- +10 ; SDIR - Sort direction
- +11 ;
- +12 NEW UID,II,ERROR,DIC,DI,BQIUPD,SI,STVW,STVCD,SRDR,SRCN
- +13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +14 SET DATA=$NAME(^TMP("BQILYSAV",UID))
- +15 KILL @DATA
- +16 ;
- +17 SET II=0
- +18 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQILYDEF D UNWIND^%ZTER"
- +19 ;
- +20 IF $GET(OWNR)=""
- SET OWNR=DUZ
- +21 SET TEMPL=$EXTRACT($GET(TEMPL),1,80)
- +22 ;
- +23 SET @DATA@(II)="I00010RESULT^T00120ERROR_MESSAGE"_$CHAR(30)
- +24 ;
- +25 ;Perform Deletes
- +26 IF $GET(ADDEL)="DEL"
- DO DELTMP^BQITMPLE(OWNR,LYIEN,TEMPL,.ERROR)
- GOTO XSAV
- +27 ;
- +28 IF $GET(TEMPL)=""
- Begin DoDot:1
- +29 SET SRCN=$ORDER(^BQI(90506.5,"C",TYPE,""))
- +30 SET TEMPL=$PIECE(^BQI(90506.5,SRCN,0),U,1)_" Default"
- End DoDot:1
- +31 IF $GET(LYIEN)=""
- Begin DoDot:1
- +32 NEW DIC,Y,DLAYGO
- +33 IF $GET(^BQICARE(OWNR,15,0))=""
- SET ^BQICARE(OWNR,15,0)="^90505.015^^"
- +34 SET DIC(0)="L"
- SET DA(1)=OWNR
- SET DLAYGO="90505.015"
- SET DIC="^BQICARE("_DA(1)_",15,"
- SET X=TEMPL
- +35 DO ^DIC
- +36 SET LYIEN=+Y
- End DoDot:1
- +37 ;
- +38 ;Remove the previous parameters
- +39 NEW DA,IENS,DIK
- +40 KILL DA
- +41 SET DA(2)=OWNR
- SET DA(1)=LYIEN
- SET DA=0
- +42 SET DIK="^BQICARE("_DA(2)_",15,"_DA(1)_",1,"
- +43 FOR
- SET DA=$ORDER(^BQICARE(OWNR,15,LYIEN,1,DA))
- IF 'DA
- QUIT
- DO ^DIK
- +44 ;
- +45 NEW DA,IENS
- +46 KILL DA
- +47 SET DA(1)=OWNR
- SET DA=LYIEN
- SET IENS=$$IENS^DILF(.DA)
- +48 SET BQIUPD(90505.015,IENS,.01)=TEMPL
- +49 SET BQIUPD(90505.015,IENS,.02)=TYPE
- +50 IF $GET(ADDEL)="NEW"
- SET BQIUPD(90505.015,IENS,.05)="Y"
- +51 SET BQIUPD(90505.015,IENS,.04)=$$NOW^XLFDT()
- +52 DO FILE^DIE("","BQIUPD","ERROR")
- +53 ;
- +54 SET SOR=$GET(SOR,"")
- SET SDIR=$GET(SDIR,"")
- +55 IF SOR=""
- SET SOR="PN"
- IF SDIR=""
- SET SDIR="A"
- +56 ;
- +57 SET DOR=$GET(DOR,"")
- +58 IF DOR=""
- Begin DoDot:1
- +59 SET LIST=""
- SET BN=""
- +60 FOR
- SET BN=$ORDER(DOR(BN))
- IF BN=""
- QUIT
- SET LIST=LIST_DOR(BN)
- +61 KILL DOR
- +62 SET DOR=LIST
- +63 KILL LIST
- End DoDot:1
- +64 ;
- +65 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
- SET STVCD=$PIECE(DOR,$CHAR(29),DI)
- IF STVCD=""
- QUIT
- Begin DoDot:1
- +66 SET STVW=STVCD
- +67 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
- +68 SET DA(2)=OWNR
- SET DA(1)=LYIEN
- +69 SET DIC="^BQICARE("_DA(2)_",15,"_DA(1)_",1,"
- SET DIE=DIC
- +70 SET DLAYGO=90505.151
- SET DIC(0)="L"
- SET DIC("P")=DLAYGO
- +71 SET X=STVW
- +72 IF '$DATA(^BQICARE(DA(2),15,DA(1),1,0))
- SET ^BQICARE(DA(2),15,DA(1),1,0)="^90505.151^^"
- +73 KILL DO,DD
- DO FILE^DICN
- +74 SET DA=+Y
- +75 SET IENS=$$IENS^DILF(.DA)
- +76 SET BQIUPD(90505.151,IENS,.02)=DI
- +77 DO FILE^DIE("","BQIUPD","ERROR")
- +78 KILL BQIUPD
- End DoDot:1
- +79 ;
- +80 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
- SET STVCD=$PIECE(SOR,$CHAR(29),SI)
- IF STVCD=""
- QUIT
- Begin DoDot:1
- +81 SET SRDR=$PIECE(SDIR,$CHAR(29),SI)
- IF SRDR=""
- SET SRDR="A"
- +82 SET STVW=STVCD
- +83 NEW DA,IENS
- +84 SET DA(2)=OWNR
- SET DA(1)=LYIEN
- SET DA=$ORDER(^BQICARE(OWNR,15,LYIEN,1,"B",STVW,""))
- +85 SET IENS=$$IENS^DILF(.DA)
- +86 SET BQIUPD(90505.151,IENS,.03)=SI
- +87 SET BQIUPD(90505.151,IENS,.04)=SRDR
- +88 DO FILE^DIE("","BQIUPD","ERROR")
- +89 KILL BQIUPD
- End DoDot:1
- +90 ;
- XSAV IF $DATA(ERROR)
- SET II=II+1
- SET @DATA@(II)="-1^"_$GET(ERROR)_$CHAR(30)
- +1 IF '$DATA(ERROR)
- SET II=II+1
- SET @DATA@(II)="1^"_$CHAR(30)
- +2 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +3 QUIT
- +4 ;
- GUI(TYPE) ;EP - Return additional fields needed by the GUI
- +1 ;
- +2 IF $GET(TYPE)=""
- QUIT "^^^^"
- +3 ;
- +4 NEW TIEN,VALUE,TITLE,LAYTYP,COLRPC,SYSRPC
- +5 ;
- +6 SET TIEN=$ORDER(^BQI(90506.5,"C",TYPE,""))
- IF TIEN=""
- QUIT "^"
- +7 ;
- +8 SET TITLE=$$GET1^DIQ(90506.5,TIEN_",",2.01,"E")
- +9 SET LAYTYP=$$GET1^DIQ(90506.5,TIEN_",",2.02,"E")
- +10 SET COLRPC=$$GET1^DIQ(90506.5,TIEN_",",3,"E")
- +11 SET SYSRPC=$$GET1^DIQ(90506.5,TIEN_",",4,"E")
- +12 ;
- +13 ;Set up return information
- +14 SET VALUE=U_TITLE_U_LAYTYP_U_COLRPC_U_SYSRPC
- +15 ;
- +16 QUIT VALUE