BQITMPLS ;VNGT/HS/BEE-Template Add/Edit/Delete/Share ; 05 May 2011 12:06 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
Q
;
DIST(DATA,TIEN,OWNR) ;EP -- BQI GET TMP DIST LIST
;
;Description
; Get the Distribution List for the Template
;Input
; TIEN - The IEN of the Template
; OWNR - If not use DUZ
;Output
; DATA - name of global (passed by reference) in which the data
; is stored
;Expects
; DUZ - the internal entry number of the person signed on
;
S:$G(OWNR)="" OWNR=DUZ
;
;Check for existence of template
I TIEN="" S BMXSEC="Template IEN is missing" Q
I '$D(^BQICARE(OWNR,15,TIEN)) S BMXSEC="Template isn't defined" Q
;
NEW UID,II,TMPLT,DA,IEN
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITMPLS",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S II=0
S @DATA@(II)="I00010USER^I00040USER_NAME^D00030DATE_DISTRIBUTED^T00001DELETED^I00010USER_TMPIEN"_$C(30)
;
S DA=TIEN,DA(1)=OWNR,IEN=$$IENS^DILF(.DA)
D GETS^DIQ(90505.015,IEN,"2*","IE","TMPLT")
;
S IEN="" F S IEN=$O(TMPLT(90505.152,IEN)) Q:IEN="" D
. ;
. NEW USERID,USERNM,DTTM,DELT,UIEN
. S USERID=$G(TMPLT(90505.152,IEN,.01,"I")) Q:USERID=""
. S USERNM=$G(TMPLT(90505.152,IEN,.01,"E"))
. S DTTM=$G(TMPLT(90505.152,IEN,.02,"I"))
. S DELT=$G(TMPLT(90505.152,IEN,.03,"I"))
. S UIEN=$G(TMPLT(90505.152,IEN,.04,"I"))
. S II=II+1,@DATA@(II)=USERID_U_USERNM_U_$$FMTE^BQIUL1(DTTM)_U_DELT_U_UIEN_$C(30)
;
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
;
UPLOAD(DATA,OWNR,TIEN) ;EP -- BQI TEMPLATE UPLOAD
;
;Description
; Upload the template to the directory
;Input
; OWNR - The template owner
; TIEN - The IEN of the Template
;
;Output
; DATA - name of global (passed by reference) in which the data
; is stored
;Expects
; DUZ - the internal entry number of the person signed on
;
S:$G(OWNR)="" OWNR=DUZ
;
;Check for existence of template
I TIEN="" S BMXSEC="Template IEN is missing" Q
I '$D(^BQICARE(OWNR,15,TIEN)) S BMXSEC="Template isn't defined" Q
;
NEW UID,II,TMPLT,DA,IENS,DIC,X,Y,DIEN,OIEN,ERROR,BQIUPD,DLAYGO
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITMPLS",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S II=0
S @DATA@(II)="T00001RESULT"_$C(30)
;
S DA=TIEN,DA(1)=OWNR,IENS=$$IENS^DILF(.DA)
D GETS^DIQ(90505.015,IENS,"**","I","TMPLT")
;
;Look for existing entry or create new one
S X=$G(TMPLT("90505.015",IENS,".01","I")) I X="" G XUPLD
S X=OWNR_X
S DIC(0)="XL",DIC="^BQI(90508.1,",DLAYGO=90508.1
D ^DIC
I Y="-1" S BMXSEC="UNABLE TO UPLOAD ENTRY" Q
S DIEN=+Y
;
;If existing entry delete existing data
I $$GET1^DIQ(90508.1,DIEN_",",".02","I")]"" D
. ;
. N DA,DIK
. S DIK="^BQI(90508.1,"_DIEN_",10,"
. S DA(1)=DIEN
. S DA=0 F S DA=$O(^BQI(90508.1,DIEN,10,DA)) Q:'DA D ^DIK
;
;Save template in ICARE USER TEMPLATES
;
S OIEN=$O(TMPLT("90505.015",""))
I OIEN]"" D
. NEW BQIUPD
. S BQIUPD("90508.1",DIEN_",",".02")=$G(TMPLT("90505.015",OIEN,".02","I"))
. S BQIUPD("90508.1",DIEN_",",".03")=$G(TMPLT("90505.015",OIEN,".01","I"))
. S BQIUPD("90508.1",DIEN_",",".04")=$G(TMPLT("90505.015",OIEN,".04","I"))
. S BQIUPD("90508.1",DIEN_",",".05")=DUZ
. S BQIUPD("90508.1",DIEN_",",".06")=$$NOW^XLFDT()
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
S OIEN="" F S OIEN=$O(TMPLT("90505.151",OIEN)) Q:OIEN="" D
. N FIEN,X,DIC,Y,DA,FLD
. ;
. ;Add field .01 field
. S X=$G(TMPLT("90505.151",OIEN,".01","I")) I X="" Q
. S DA(1)=DIEN
. S DIC(0)="XL",DIC="^BQI(90508.1,"_DIEN_",10,"
. D ^DIC
. I Y="-1" S BMXSEC="UNABLE TO UPLOAD ENTRY" Q
. S FIEN=+Y
. ;
. ;Save each field
. S FLD="" F S FLD=$O(TMPLT("90505.151",OIEN,FLD)) Q:FLD="" D
.. N IENS
.. S IENS=FIEN_","_DIEN_","
.. S BQIUPD("90508.11",IENS,FLD)=$G(TMPLT("90505.151",OIEN,FLD,"I"))
. ;
. ;File entry in new
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
I $D(ERROR) S II=II+1,@DATA@(II)="-1"_$C(30)
E S II=II+1,@DATA@(II)="1"_$C(30)
;
XUPLD S II=II+1,@DATA@(II)=$C(31)
Q
;
LIST(DATA,FAKE) ;EP -- BQI GET TEMPLATE LIST
;
;Description
; Get the list of available templates
;
;Output
; DATA - name of global (passed by reference) in which the data
; is stored
;Expects
; DUZ - the internal entry number of the person signed on
;
NEW UID,II,IEN
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITMPLS",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S II=0
S @DATA@(II)="I00010HIDE_TMP_IEN^T00001TMP_TYPE^T00040TMP_NAME^I00010TMP_AUTHOR_IEN^T00050TMP_AUTHOR^D00030DT_LAST_EDIT^D00030DT_UPLOAD"_$C(30)
;
S IEN=0 F S IEN=$O(^BQI(90508.1,IEN)) Q:'IEN D
. ;
. NEW TMP,IENS,INAME,TTYPE,TNAME,TAUTH,TLEDT,TUPDT,DAUTH
. S IENS=IEN_","
. D GETS^DIQ(90508.1,IENS,".01:.06","I","TMP")
. ;
. S INAME=$G(TMP(90508.1,IENS,.01,"I"))
. S TTYPE=$G(TMP(90508.1,IENS,.02,"I"))
. S TNAME=$G(TMP(90508.1,IENS,.03,"I"))
. S TAUTH=$G(TMP(90508.1,IENS,.05,"I"))
. S DAUTH="" S:TAUTH]"" DAUTH=$$GET1^DIQ(200,TAUTH_",",".01","E")
. S TLEDT=$$FMTE^BQIUL1($G(TMP(90508.1,IENS,.04,"I")))
. S TUPDT=$$FMTE^BQIUL1($G(TMP(90508.1,IENS,.06,"I")))
. ;
. S II=II+1,@DATA@(II)=IEN_U_TTYPE_U_TNAME_U_TAUTH_U_DAUTH_U_TLEDT_U_TUPDT_$C(30)
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
;
DNLOAD(DATA,OWNR,TIEN) ;EP -- BQI DOWNLOAD TEMPLATE
;
;Description
; Download the template to the user's account
;Input
; OWNR - The iCare user to copy the template to
; TIEN - The IEN of the template in 90508.1
;
;Output
; DATA - name of global (passed by reference) in which the data
; is stored
;Expects
; DUZ - the internal entry number of the person signed on
;
S:$G(OWNR)="" OWNR=DUZ
;
;Check for existence of template
I TIEN="" S BMXSEC="Template IEN is missing" Q
I '$D(^BQI(90508.1,TIEN)) S BMXSEC="Template isn't defined" Q
;
NEW UID,II,TMPLT,DIC,X,Y,DIEN,IENS,AUTHOR,LSTEDT,LEN,DA,OIEN,ERROR,BQIUPD
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITMPLS",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S II=0
S @DATA@(II)="T00001RESULT"_$C(30)
;
D GETS^DIQ(90508.1,TIEN_",","**","I","TMPLT")
;
;Look for existing entry or create new one
;
;Get template author
S AUTHOR=$G(TMPLT("90508.1",TIEN_",",".05","I"))
I AUTHOR]"" S AUTHOR=$$GET1^DIQ(200,AUTHOR_",",.01,"E")
;
;Get template last edit date
S LSTEDT=$G(TMPLT("90508.1",TIEN_",",".04","I"))
I LSTEDT]"" S LSTEDT=$$FMTE^BQIUL1(LSTEDT)
;
;Create entry in 90505.015
S X=$S(AUTHOR]"":AUTHOR,1:"")_$S((AUTHOR]""&(LSTEDT]"")):"-",1:"")_LSTEDT
S:X]"" X="-"_X
S LEN=80-$L(X)
S X=$E($G(TMPLT("90508.1",TIEN_",",".03","I")),1,LEN)_X I X="" G XDNLD
S DA(1)=OWNR
S DIC(0)="XL",DIC="^BQICARE("_DA(1)_",15,"
D ^DIC
I Y="-1" S BMXSEC="UNABLE TO DOWNLOAD ENTRY" Q
S DIEN=+Y
;
;If existing entry delete existing data
S DA=DIEN,DA(1)=OWNR,IENS=$$IENS^DILF(.DA)
I $$GET1^DIQ(90505.015,IENS,".02","I")]"" D
. ;
. N DA,DIK
. S DIK="^BQICARE("_OWNR_",15,"_DIEN_",1,"
. S DA(2)=OWNR,DA(1)=DIEN
. S DA=0 F S DA=$O(^BQICARE(OWNR,15,DIEN,1,DA)) Q:'DA D ^DIK
;
;Save template in ICARE USER
;
S OIEN=$O(TMPLT("90508.1",""))
I OIEN]"" D
. N DA,IENS,BQIUPD
. S DA(1)=OWNR,DA=DIEN,IENS=$$IENS^DILF(.DA)
. S BQIUPD("90505.015",IENS,".02")=$G(TMPLT("90508.1",OIEN,".02","I"))
. S BQIUPD("90505.015",IENS,".04")=$G(TMPLT("90508.1",OIEN,".04","I"))
. S BQIUPD("90505.015",IENS,".05")="Y"
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
S OIEN="" F S OIEN=$O(TMPLT("90508.11",OIEN)) Q:OIEN="" D
. N FIEN,X,DIC,Y,DA,FLD,BQIUPD
. ;
. ;Add field .01 field
. S X=$G(TMPLT("90508.11",OIEN,".01","I")) I X="" Q
. S DA(2)=OWNR,DA(1)=DIEN
. S DIC(0)="XL",DIC="^BQICARE("_DA(2)_",15,"_DA(1)_",1,"
. D ^DIC
. I Y="-1" S BMXSEC="UNABLE TO DOWNLOAD ENTRY" Q
. S FIEN=+Y
. ;
. ;Save each field
. S FLD="" F S FLD=$O(TMPLT("90508.11",OIEN,FLD)) Q:FLD="" D
.. N IENS
.. S IENS=FIEN_","_DIEN_","_OWNR_","
.. S BQIUPD("90505.151",IENS,FLD)=$G(TMPLT("90508.11",OIEN,FLD,"I"))
. ;
. ;File entry in new
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
I $D(ERROR) S II=II+1,@DATA@(II)="-1"_$C(30)
E S II=II+1,@DATA@(II)="1"_$C(30)
;
XDNLD S II=II+1,@DATA@(II)=$C(31)
Q
;
DTMPSET(DTYP) ;EP - SET UP DEFAULT TEMPLATE ENTRY FOR USER
N DOR,SOR,SDIR,DATA,UID
;
;Pull the standard fields and sort values for each type
D
. ; If the type is Patient, get the default definition
. I DTYP="D" S DOR=$$DFNC^BQIPLVW(),SOR=$$SFNC^BQIPLVW(),SDIR="A" Q
. ;
. ; If the type is Reminders, get the default definition
. I DTYP="R" S DOR=$$RDEF^BQIRMPL(),SOR=$$SFNC^BQIPLVW(),SDIR="A" Q
. ;
. ; If the type is Performance, get the default definition
. I DTYP="G" S DOR=$$DFNC^BQIGPVW()_$C(29)_$$GDEF^BQIGPVW(),SOR=$$SFNC^BQIGPVW(),SDIR="A" Q
. ;
. ; If the type is MY MEASURES, get the default definition
. I DTYP="Q"!(DTYP="T")!(DTYP="N") D Q
.. 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 DOR=$$DFNC^BQICEVW()_$C(29)_$$CDEF^BQICEVW(),SOR=$$SFNC^BQICEVW(CRN,DTYP),SDIR="A"_$C(29)_"D"_$C(29)_"A"
. I DTYP'="D",DTYP'="R",DTYP'="G" D Q
.. S CRN=$O(^BQI(90506.5,"C",DTYP,"")) I CRN="" Q
.. S CARE=$P(^BQI(90506.5,CRN,0),U,1)
.. S DOR=$$DFNC^BQICMVW()_$C(29)_$$CDEF^BQICMVW(),SOR=$$SFNC^BQICMVW(),SDIR="A"
;
;Save the entry, clear scratch global
D SAV^BQILYDEF("",DUZ,"","",DTYP,"",SOR,SDIR,DOR)
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQILYSAV",UID))
K @DATA
;
Q
;
DTMPDEF(DTYP) ;EP - SET THE DEFAULT TEMPLATE TO THE USER'S DEFAULT
;
N SRCN,TEMPL,TIEN,UID,DATA
;
S SRCN=$O(^BQI(90506.5,"C",DTYP,"")) Q:SRCN=""
S TEMPL=$P(^BQI(90506.5,SRCN,0),U,1)_" Default" Q:TEMPL=""
;
S TIEN=$$TPN^BQILYUTL(DUZ,TEMPL) Q:TIEN=""
;
;Set as default for this type, clear scratch global
D DFLT^BQITMPLE("",DUZ,TIEN,DTYP,TEMPL)
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQILYDEF",UID))
K @DATA
;
Q
;
VIEW(DATA,TIEN) ;EP -- BQI VIEW PUBLIC TEMPLATE
; Parameters
; TIEN - Public Template IEN
;
NEW UID,II,SDIR,DOR,SOR,SORT,DISPLAY,TMPNM,TMPTY,HTMPNM,TMPLE
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITMPLS",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S II=0
;
S @DATA@(II)="I00010TEMPL_IEN^T00001TMP_TYPE^T00040TMP_NAME^T00120DISPLAY_ORDER"
S @DATA@(II)=@DATA@(II)_"^T00120SORT_ORDER^T00120SORT_DIRECTION^D00030LAST_EDITED"_$C(30)
;
S HTMPNM=$$GET1^DIQ(90508.1,TIEN_",",.01,"E")
S TMPTY=$$GET1^DIQ(90508.1,TIEN_",",.02,"I")
S TMPNM=$$GET1^DIQ(90508.1,TIEN_",",.03,"E")
S TMPLE=$$GET1^DIQ(90508.1,TIEN_",",.04,"I")
;
;Get field list
S DOR="",DISPLAY=""
F S DOR=$O(^BQI(90508.1,TIEN,10,"C",DOR)) Q:DOR="" D
. N IEN
. S IEN="" F S IEN=$O(^BQI(90508.1,TIEN,10,"C",DOR,IEN)) Q:IEN="" D
.. N CODE
.. S CODE=$P($G(^BQI(90508.1,TIEN,10,IEN,0)),U,1)
.. S DISPLAY=DISPLAY_CODE_$C(29)
;
S SOR="",SORT="",SDIR=""
F S SOR=$O(^BQI(90508.1,TIEN,10,"D",SOR)) Q:SOR="" D
. N IEN
. S IEN=""
. F S IEN=$O(^BQI(90508.1,TIEN,10,"D",SOR,IEN)) Q:IEN="" D
.. N CODE,DIR
.. S CODE=$P($G(^BQI(90508.1,TIEN,10,IEN,0)),U,1)
.. S DIR=$P($G(^BQI(90508.1,TIEN,10,IEN,0)),U,4)
.. S SORT=SORT_CODE_$C(29),SDIR=SDIR_DIR_$C(29)
;
S DISPLAY=$$TKO^BQIUL1(DISPLAY,$C(29))
S SORT=$$TKO^BQIUL1(SORT,$C(29))
S SDIR=$$TKO^BQIUL1(SDIR,$C(29))
I SDIR="" S SDIR="A"
;
S II=II+1,@DATA@(II)=TIEN_U_TMPTY_U_TMPNM_U_DISPLAY_U_SORT_U_SDIR_U_$$FMTE^BQIUL1(TMPLE)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
DEL(DATA,TIEN) ;EP -- BQI DELETE PUBLIC TEMPLATE
; Parameters
; TIEN - Public Template IEN
;
NEW UID,II,DA,DIK
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITMPLS",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
I TIEN="" S BMXSEC="Template IEN is blank" Q
;
S II=0
;
S @DATA@(II)="I00001RESULT"_$C(30)
;
;Delete template entry
S DIK="^BQI(90508.1,"
S DA=TIEN D ^DIK
;
S II=II+1,@DATA@(II)="1"_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
BQITMPLS ;VNGT/HS/BEE-Template Add/Edit/Delete/Share ; 05 May 2011 12:06 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
+3 QUIT
+4 ;
DIST(DATA,TIEN,OWNR) ;EP -- BQI GET TMP DIST LIST
+1 ;
+2 ;Description
+3 ; Get the Distribution List for the Template
+4 ;Input
+5 ; TIEN - The IEN of the Template
+6 ; OWNR - If not use DUZ
+7 ;Output
+8 ; DATA - name of global (passed by reference) in which the data
+9 ; is stored
+10 ;Expects
+11 ; DUZ - the internal entry number of the person signed on
+12 ;
+13 IF $GET(OWNR)=""
SET OWNR=DUZ
+14 ;
+15 ;Check for existence of template
+16 IF TIEN=""
SET BMXSEC="Template IEN is missing"
QUIT
+17 IF '$DATA(^BQICARE(OWNR,15,TIEN))
SET BMXSEC="Template isn't defined"
QUIT
+18 ;
+19 NEW UID,II,TMPLT,DA,IEN
+20 ;
+21 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+22 SET DATA=$NAME(^TMP("BQITMPLS",UID))
+23 KILL @DATA
+24 ;
+25 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER"
+26 ;
+27 SET II=0
+28 SET @DATA@(II)="I00010USER^I00040USER_NAME^D00030DATE_DISTRIBUTED^T00001DELETED^I00010USER_TMPIEN"_$CHAR(30)
+29 ;
+30 SET DA=TIEN
SET DA(1)=OWNR
SET IEN=$$IENS^DILF(.DA)
+31 DO GETS^DIQ(90505.015,IEN,"2*","IE","TMPLT")
+32 ;
+33 SET IEN=""
FOR
SET IEN=$ORDER(TMPLT(90505.152,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+34 ;
+35 NEW USERID,USERNM,DTTM,DELT,UIEN
+36 SET USERID=$GET(TMPLT(90505.152,IEN,.01,"I"))
IF USERID=""
QUIT
+37 SET USERNM=$GET(TMPLT(90505.152,IEN,.01,"E"))
+38 SET DTTM=$GET(TMPLT(90505.152,IEN,.02,"I"))
+39 SET DELT=$GET(TMPLT(90505.152,IEN,.03,"I"))
+40 SET UIEN=$GET(TMPLT(90505.152,IEN,.04,"I"))
+41 SET II=II+1
SET @DATA@(II)=USERID_U_USERNM_U_$$FMTE^BQIUL1(DTTM)_U_DELT_U_UIEN_$CHAR(30)
End DoDot:1
+42 ;
+43 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+44 QUIT
+45 ;
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 ;
UPLOAD(DATA,OWNR,TIEN) ;EP -- BQI TEMPLATE UPLOAD
+1 ;
+2 ;Description
+3 ; Upload the template to the directory
+4 ;Input
+5 ; OWNR - The template owner
+6 ; TIEN - The IEN of the Template
+7 ;
+8 ;Output
+9 ; DATA - name of global (passed by reference) in which the data
+10 ; is stored
+11 ;Expects
+12 ; DUZ - the internal entry number of the person signed on
+13 ;
+14 IF $GET(OWNR)=""
SET OWNR=DUZ
+15 ;
+16 ;Check for existence of template
+17 IF TIEN=""
SET BMXSEC="Template IEN is missing"
QUIT
+18 IF '$DATA(^BQICARE(OWNR,15,TIEN))
SET BMXSEC="Template isn't defined"
QUIT
+19 ;
+20 NEW UID,II,TMPLT,DA,IENS,DIC,X,Y,DIEN,OIEN,ERROR,BQIUPD,DLAYGO
+21 ;
+22 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+23 SET DATA=$NAME(^TMP("BQITMPLS",UID))
+24 KILL @DATA
+25 ;
+26 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER"
+27 ;
+28 SET II=0
+29 SET @DATA@(II)="T00001RESULT"_$CHAR(30)
+30 ;
+31 SET DA=TIEN
SET DA(1)=OWNR
SET IENS=$$IENS^DILF(.DA)
+32 DO GETS^DIQ(90505.015,IENS,"**","I","TMPLT")
+33 ;
+34 ;Look for existing entry or create new one
+35 SET X=$GET(TMPLT("90505.015",IENS,".01","I"))
IF X=""
GOTO XUPLD
+36 SET X=OWNR_X
+37 SET DIC(0)="XL"
SET DIC="^BQI(90508.1,"
SET DLAYGO=90508.1
+38 DO ^DIC
+39 IF Y="-1"
SET BMXSEC="UNABLE TO UPLOAD ENTRY"
QUIT
+40 SET DIEN=+Y
+41 ;
+42 ;If existing entry delete existing data
+43 IF $$GET1^DIQ(90508.1,DIEN_",",".02","I")]""
Begin DoDot:1
+44 ;
+45 NEW DA,DIK
+46 SET DIK="^BQI(90508.1,"_DIEN_",10,"
+47 SET DA(1)=DIEN
+48 SET DA=0
FOR
SET DA=$ORDER(^BQI(90508.1,DIEN,10,DA))
IF 'DA
QUIT
DO ^DIK
End DoDot:1
+49 ;
+50 ;Save template in ICARE USER TEMPLATES
+51 ;
+52 SET OIEN=$ORDER(TMPLT("90505.015",""))
+53 IF OIEN]""
Begin DoDot:1
+54 NEW BQIUPD
+55 SET BQIUPD("90508.1",DIEN_",",".02")=$GET(TMPLT("90505.015",OIEN,".02","I"))
+56 SET BQIUPD("90508.1",DIEN_",",".03")=$GET(TMPLT("90505.015",OIEN,".01","I"))
+57 SET BQIUPD("90508.1",DIEN_",",".04")=$GET(TMPLT("90505.015",OIEN,".04","I"))
+58 SET BQIUPD("90508.1",DIEN_",",".05")=DUZ
+59 SET BQIUPD("90508.1",DIEN_",",".06")=$$NOW^XLFDT()
+60 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+61 ;
+62 SET OIEN=""
FOR
SET OIEN=$ORDER(TMPLT("90505.151",OIEN))
IF OIEN=""
QUIT
Begin DoDot:1
+63 NEW FIEN,X,DIC,Y,DA,FLD
+64 ;
+65 ;Add field .01 field
+66 SET X=$GET(TMPLT("90505.151",OIEN,".01","I"))
IF X=""
QUIT
+67 SET DA(1)=DIEN
+68 SET DIC(0)="XL"
SET DIC="^BQI(90508.1,"_DIEN_",10,"
+69 DO ^DIC
+70 IF Y="-1"
SET BMXSEC="UNABLE TO UPLOAD ENTRY"
QUIT
+71 SET FIEN=+Y
+72 ;
+73 ;Save each field
+74 SET FLD=""
FOR
SET FLD=$ORDER(TMPLT("90505.151",OIEN,FLD))
IF FLD=""
QUIT
Begin DoDot:2
+75 NEW IENS
+76 SET IENS=FIEN_","_DIEN_","
+77 SET BQIUPD("90508.11",IENS,FLD)=$GET(TMPLT("90505.151",OIEN,FLD,"I"))
End DoDot:2
+78 ;
+79 ;File entry in new
+80 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+81 IF $DATA(ERROR)
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
+82 IF '$TEST
SET II=II+1
SET @DATA@(II)="1"_$CHAR(30)
+83 ;
XUPLD SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
LIST(DATA,FAKE) ;EP -- BQI GET TEMPLATE LIST
+1 ;
+2 ;Description
+3 ; Get the list of available templates
+4 ;
+5 ;Output
+6 ; DATA - name of global (passed by reference) in which the data
+7 ; is stored
+8 ;Expects
+9 ; DUZ - the internal entry number of the person signed on
+10 ;
+11 NEW UID,II,IEN
+12 ;
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQITMPLS",UID))
+15 KILL @DATA
+16 ;
+17 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER"
+18 ;
+19 SET II=0
+20 SET @DATA@(II)="I00010HIDE_TMP_IEN^T00001TMP_TYPE^T00040TMP_NAME^I00010TMP_AUTHOR_IEN^T00050TMP_AUTHOR^D00030DT_LAST_EDIT^D00030DT_UPLOAD"_$CHAR(30)
+21 ;
+22 SET IEN=0
FOR
SET IEN=$ORDER(^BQI(90508.1,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+23 ;
+24 NEW TMP,IENS,INAME,TTYPE,TNAME,TAUTH,TLEDT,TUPDT,DAUTH
+25 SET IENS=IEN_","
+26 DO GETS^DIQ(90508.1,IENS,".01:.06","I","TMP")
+27 ;
+28 SET INAME=$GET(TMP(90508.1,IENS,.01,"I"))
+29 SET TTYPE=$GET(TMP(90508.1,IENS,.02,"I"))
+30 SET TNAME=$GET(TMP(90508.1,IENS,.03,"I"))
+31 SET TAUTH=$GET(TMP(90508.1,IENS,.05,"I"))
+32 SET DAUTH=""
IF TAUTH]""
SET DAUTH=$$GET1^DIQ(200,TAUTH_",",".01","E")
+33 SET TLEDT=$$FMTE^BQIUL1($GET(TMP(90508.1,IENS,.04,"I")))
+34 SET TUPDT=$$FMTE^BQIUL1($GET(TMP(90508.1,IENS,.06,"I")))
+35 ;
+36 SET II=II+1
SET @DATA@(II)=IEN_U_TTYPE_U_TNAME_U_TAUTH_U_DAUTH_U_TLEDT_U_TUPDT_$CHAR(30)
End DoDot:1
+37 ;
+38 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+39 QUIT
+40 ;
+41 ;
DNLOAD(DATA,OWNR,TIEN) ;EP -- BQI DOWNLOAD TEMPLATE
+1 ;
+2 ;Description
+3 ; Download the template to the user's account
+4 ;Input
+5 ; OWNR - The iCare user to copy the template to
+6 ; TIEN - The IEN of the template in 90508.1
+7 ;
+8 ;Output
+9 ; DATA - name of global (passed by reference) in which the data
+10 ; is stored
+11 ;Expects
+12 ; DUZ - the internal entry number of the person signed on
+13 ;
+14 IF $GET(OWNR)=""
SET OWNR=DUZ
+15 ;
+16 ;Check for existence of template
+17 IF TIEN=""
SET BMXSEC="Template IEN is missing"
QUIT
+18 IF '$DATA(^BQI(90508.1,TIEN))
SET BMXSEC="Template isn't defined"
QUIT
+19 ;
+20 NEW UID,II,TMPLT,DIC,X,Y,DIEN,IENS,AUTHOR,LSTEDT,LEN,DA,OIEN,ERROR,BQIUPD
+21 ;
+22 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+23 SET DATA=$NAME(^TMP("BQITMPLS",UID))
+24 KILL @DATA
+25 ;
+26 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER"
+27 ;
+28 SET II=0
+29 SET @DATA@(II)="T00001RESULT"_$CHAR(30)
+30 ;
+31 DO GETS^DIQ(90508.1,TIEN_",","**","I","TMPLT")
+32 ;
+33 ;Look for existing entry or create new one
+34 ;
+35 ;Get template author
+36 SET AUTHOR=$GET(TMPLT("90508.1",TIEN_",",".05","I"))
+37 IF AUTHOR]""
SET AUTHOR=$$GET1^DIQ(200,AUTHOR_",",.01,"E")
+38 ;
+39 ;Get template last edit date
+40 SET LSTEDT=$GET(TMPLT("90508.1",TIEN_",",".04","I"))
+41 IF LSTEDT]""
SET LSTEDT=$$FMTE^BQIUL1(LSTEDT)
+42 ;
+43 ;Create entry in 90505.015
+44 SET X=$SELECT(AUTHOR]"":AUTHOR,1:"")_$SELECT((AUTHOR]""&(LSTEDT]"")):"-",1:"")_LSTEDT
+45 IF X]""
SET X="-"_X
+46 SET LEN=80-$LENGTH(X)
+47 SET X=$EXTRACT($GET(TMPLT("90508.1",TIEN_",",".03","I")),1,LEN)_X
IF X=""
GOTO XDNLD
+48 SET DA(1)=OWNR
+49 SET DIC(0)="XL"
SET DIC="^BQICARE("_DA(1)_",15,"
+50 DO ^DIC
+51 IF Y="-1"
SET BMXSEC="UNABLE TO DOWNLOAD ENTRY"
QUIT
+52 SET DIEN=+Y
+53 ;
+54 ;If existing entry delete existing data
+55 SET DA=DIEN
SET DA(1)=OWNR
SET IENS=$$IENS^DILF(.DA)
+56 IF $$GET1^DIQ(90505.015,IENS,".02","I")]""
Begin DoDot:1
+57 ;
+58 NEW DA,DIK
+59 SET DIK="^BQICARE("_OWNR_",15,"_DIEN_",1,"
+60 SET DA(2)=OWNR
SET DA(1)=DIEN
+61 SET DA=0
FOR
SET DA=$ORDER(^BQICARE(OWNR,15,DIEN,1,DA))
IF 'DA
QUIT
DO ^DIK
End DoDot:1
+62 ;
+63 ;Save template in ICARE USER
+64 ;
+65 SET OIEN=$ORDER(TMPLT("90508.1",""))
+66 IF OIEN]""
Begin DoDot:1
+67 NEW DA,IENS,BQIUPD
+68 SET DA(1)=OWNR
SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+69 SET BQIUPD("90505.015",IENS,".02")=$GET(TMPLT("90508.1",OIEN,".02","I"))
+70 SET BQIUPD("90505.015",IENS,".04")=$GET(TMPLT("90508.1",OIEN,".04","I"))
+71 SET BQIUPD("90505.015",IENS,".05")="Y"
+72 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+73 ;
+74 SET OIEN=""
FOR
SET OIEN=$ORDER(TMPLT("90508.11",OIEN))
IF OIEN=""
QUIT
Begin DoDot:1
+75 NEW FIEN,X,DIC,Y,DA,FLD,BQIUPD
+76 ;
+77 ;Add field .01 field
+78 SET X=$GET(TMPLT("90508.11",OIEN,".01","I"))
IF X=""
QUIT
+79 SET DA(2)=OWNR
SET DA(1)=DIEN
+80 SET DIC(0)="XL"
SET DIC="^BQICARE("_DA(2)_",15,"_DA(1)_",1,"
+81 DO ^DIC
+82 IF Y="-1"
SET BMXSEC="UNABLE TO DOWNLOAD ENTRY"
QUIT
+83 SET FIEN=+Y
+84 ;
+85 ;Save each field
+86 SET FLD=""
FOR
SET FLD=$ORDER(TMPLT("90508.11",OIEN,FLD))
IF FLD=""
QUIT
Begin DoDot:2
+87 NEW IENS
+88 SET IENS=FIEN_","_DIEN_","_OWNR_","
+89 SET BQIUPD("90505.151",IENS,FLD)=$GET(TMPLT("90508.11",OIEN,FLD,"I"))
End DoDot:2
+90 ;
+91 ;File entry in new
+92 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+93 IF $DATA(ERROR)
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
+94 IF '$TEST
SET II=II+1
SET @DATA@(II)="1"_$CHAR(30)
+95 ;
XDNLD SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
DTMPSET(DTYP) ;EP - SET UP DEFAULT TEMPLATE ENTRY FOR USER
+1 NEW DOR,SOR,SDIR,DATA,UID
+2 ;
+3 ;Pull the standard fields and sort values for each type
+4 Begin DoDot:1
+5 ; If the type is Patient, get the default definition
+6 IF DTYP="D"
SET DOR=$$DFNC^BQIPLVW()
SET SOR=$$SFNC^BQIPLVW()
SET SDIR="A"
QUIT
+7 ;
+8 ; If the type is Reminders, get the default definition
+9 IF DTYP="R"
SET DOR=$$RDEF^BQIRMPL()
SET SOR=$$SFNC^BQIPLVW()
SET SDIR="A"
QUIT
+10 ;
+11 ; If the type is Performance, get the default definition
+12 IF DTYP="G"
SET DOR=$$DFNC^BQIGPVW()_$CHAR(29)_$$GDEF^BQIGPVW()
SET SOR=$$SFNC^BQIGPVW()
SET SDIR="A"
QUIT
+13 ;
+14 ; If the type is MY MEASURES, get the default definition
+15 IF DTYP="Q"!(DTYP="T")!(DTYP="N")
Begin DoDot:2
+16 NEW CRN,CARE
+17 SET CRN=$ORDER(^BQI(90506.5,"C",DTYP,""))
IF CRN=""
QUIT
+18 SET CARE=$PIECE(^BQI(90506.5,CRN,0),U,1)
+19 SET DOR=$$DFNC^BQICEVW()_$CHAR(29)_$$CDEF^BQICEVW()
SET SOR=$$SFNC^BQICEVW(CRN,DTYP)
SET SDIR="A"_$CHAR(29)_"D"_$CHAR(29)_"A"
End DoDot:2
QUIT
+20 IF DTYP'="D"
IF DTYP'="R"
IF DTYP'="G"
Begin DoDot:2
+21 SET CRN=$ORDER(^BQI(90506.5,"C",DTYP,""))
IF CRN=""
QUIT
+22 SET CARE=$PIECE(^BQI(90506.5,CRN,0),U,1)
+23 SET DOR=$$DFNC^BQICMVW()_$CHAR(29)_$$CDEF^BQICMVW()
SET SOR=$$SFNC^BQICMVW()
SET SDIR="A"
End DoDot:2
QUIT
End DoDot:1
+24 ;
+25 ;Save the entry, clear scratch global
+26 DO SAV^BQILYDEF("",DUZ,"","",DTYP,"",SOR,SDIR,DOR)
+27 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+28 SET DATA=$NAME(^TMP("BQILYSAV",UID))
+29 KILL @DATA
+30 ;
+31 QUIT
+32 ;
DTMPDEF(DTYP) ;EP - SET THE DEFAULT TEMPLATE TO THE USER'S DEFAULT
+1 ;
+2 NEW SRCN,TEMPL,TIEN,UID,DATA
+3 ;
+4 SET SRCN=$ORDER(^BQI(90506.5,"C",DTYP,""))
IF SRCN=""
QUIT
+5 SET TEMPL=$PIECE(^BQI(90506.5,SRCN,0),U,1)_" Default"
IF TEMPL=""
QUIT
+6 ;
+7 SET TIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
IF TIEN=""
QUIT
+8 ;
+9 ;Set as default for this type, clear scratch global
+10 DO DFLT^BQITMPLE("",DUZ,TIEN,DTYP,TEMPL)
+11 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+12 SET DATA=$NAME(^TMP("BQILYDEF",UID))
+13 KILL @DATA
+14 ;
+15 QUIT
+16 ;
VIEW(DATA,TIEN) ;EP -- BQI VIEW PUBLIC TEMPLATE
+1 ; Parameters
+2 ; TIEN - Public Template IEN
+3 ;
+4 NEW UID,II,SDIR,DOR,SOR,SORT,DISPLAY,TMPNM,TMPTY,HTMPNM,TMPLE
+5 ;
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BQITMPLS",UID))
+8 KILL @DATA
+9 ;
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER"
+11 ;
+12 SET II=0
+13 ;
+14 SET @DATA@(II)="I00010TEMPL_IEN^T00001TMP_TYPE^T00040TMP_NAME^T00120DISPLAY_ORDER"
+15 SET @DATA@(II)=@DATA@(II)_"^T00120SORT_ORDER^T00120SORT_DIRECTION^D00030LAST_EDITED"_$CHAR(30)
+16 ;
+17 SET HTMPNM=$$GET1^DIQ(90508.1,TIEN_",",.01,"E")
+18 SET TMPTY=$$GET1^DIQ(90508.1,TIEN_",",.02,"I")
+19 SET TMPNM=$$GET1^DIQ(90508.1,TIEN_",",.03,"E")
+20 SET TMPLE=$$GET1^DIQ(90508.1,TIEN_",",.04,"I")
+21 ;
+22 ;Get field list
+23 SET DOR=""
SET DISPLAY=""
+24 FOR
SET DOR=$ORDER(^BQI(90508.1,TIEN,10,"C",DOR))
IF DOR=""
QUIT
Begin DoDot:1
+25 NEW IEN
+26 SET IEN=""
FOR
SET IEN=$ORDER(^BQI(90508.1,TIEN,10,"C",DOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+27 NEW CODE
+28 SET CODE=$PIECE($GET(^BQI(90508.1,TIEN,10,IEN,0)),U,1)
+29 SET DISPLAY=DISPLAY_CODE_$CHAR(29)
End DoDot:2
End DoDot:1
+30 ;
+31 SET SOR=""
SET SORT=""
SET SDIR=""
+32 FOR
SET SOR=$ORDER(^BQI(90508.1,TIEN,10,"D",SOR))
IF SOR=""
QUIT
Begin DoDot:1
+33 NEW IEN
+34 SET IEN=""
+35 FOR
SET IEN=$ORDER(^BQI(90508.1,TIEN,10,"D",SOR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+36 NEW CODE,DIR
+37 SET CODE=$PIECE($GET(^BQI(90508.1,TIEN,10,IEN,0)),U,1)
+38 SET DIR=$PIECE($GET(^BQI(90508.1,TIEN,10,IEN,0)),U,4)
+39 SET SORT=SORT_CODE_$CHAR(29)
SET SDIR=SDIR_DIR_$CHAR(29)
End DoDot:2
End DoDot:1
+40 ;
+41 SET DISPLAY=$$TKO^BQIUL1(DISPLAY,$CHAR(29))
+42 SET SORT=$$TKO^BQIUL1(SORT,$CHAR(29))
+43 SET SDIR=$$TKO^BQIUL1(SDIR,$CHAR(29))
+44 IF SDIR=""
SET SDIR="A"
+45 ;
+46 SET II=II+1
SET @DATA@(II)=TIEN_U_TMPTY_U_TMPNM_U_DISPLAY_U_SORT_U_SDIR_U_$$FMTE^BQIUL1(TMPLE)_$CHAR(30)
+47 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+48 QUIT
+49 ;
DEL(DATA,TIEN) ;EP -- BQI DELETE PUBLIC TEMPLATE
+1 ; Parameters
+2 ; TIEN - Public Template IEN
+3 ;
+4 NEW UID,II,DA,DIK
+5 ;
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BQITMPLS",UID))
+8 KILL @DATA
+9 ;
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITMPLS D UNWIND^%ZTER"
+11 ;
+12 IF TIEN=""
SET BMXSEC="Template IEN is blank"
QUIT
+13 ;
+14 SET II=0
+15 ;
+16 SET @DATA@(II)="I00001RESULT"_$CHAR(30)
+17 ;
+18 ;Delete template entry
+19 SET DIK="^BQI(90508.1,"
+20 SET DA=TIEN
DO ^DIK
+21 ;
+22 SET II=II+1
SET @DATA@(II)="1"_$CHAR(30)
+23 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+24 QUIT
