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
