BQITMPLE ;GDIT/HC/BEE-Template Handling ; 01 Jun 2007 11:51 AM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
DFLT(DATA,OWNR,LYIEN,TYPE,TMPNAM) ;EP -- BQI SET TEMPLATE DFLT
;
; Input
; OWNR - Whose template this is
; LYIEN - Template internal entry number
; TYPE - The type of template
; TMPNAM - The template name
;
NEW UID,II,ERROR,HDR,IEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQILYDEF",UID))
K @DATA
;
;Define Header
S @DATA@(0)="T00001RESULT"_$C(30)
;
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 LYIEN=$G(LYIEN,"")
S TYPE=$G(TYPE,"")
;
I LYIEN="" S BMXSEC="Template IEN is blank." Q
I TYPE="" D I TYPE="" S BMXSEC="Template TYPE is blank." Q
. N DA,IENS
. S DA(1)=OWNR,DA=LYIEN,IENS=$$IENS^DILF(.DA)
. S TYPE=$$GET1^DIQ(90505.015,IENS,".02","I")
;
;Loop through all templates for type and set/remove default
S IEN=0 F S IEN=$O(^BQICARE(OWNR,15,"C",TYPE,IEN)) Q:'IEN D Q:$D(ERROR)
. ;
. NEW DA,IENS,BQIUPD,CHG,DEF
. S DA(1)=OWNR,DA=IEN,IENS=$$IENS^DILF(.DA)
. ;
. ;Get current default value
. S DEF=$$GET1^DIQ(90505.015,IENS,".03","I")
. ;
. ;Set Change Flag
. S CHG=0
. ;
. ;If this one is the passed in one
. I IEN=LYIEN D
.. I DEF="Y" Q ;Already default - don't save
.. S BQIUPD(90505.015,IENS,".03")="Y",CHG=1
. ;
. ;Look for other templates
. I IEN'=LYIEN D
.. I DEF="" Q ;Already not the default - don't save
.. S BQIUPD(90505.015,IENS,".03")="",CHG=1
. ;
. ;Set last edited
. I CHG=1 S BQIUPD(90505.015,IENS,.04)=$$NOW^XLFDT()
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
S II=II+1
I $D(ERROR) S @DATA@(II)="-1"_$C(30)
E S @DATA@(II)="1"_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
TMUSE(DATA,OWNR,TIEN) ;EP -- BQI GET TEMPLATE USE
;
; Input
; OWNR - Whose template this is
; TIEN - Template internal entry number
;
NEW UID,II,ERROR,HDR,TNAME,PLIEN,DA,IENS,OWNIEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQILYDEF",UID))
K @DATA
;
;Define Header
S @DATA@(0)="I00010PANEL_IEN^T00120PANEL_NAME^T00250PANEL_DESCRIPTION^I00010PANEL_OWNER"_$C(30)
;
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
;
I TIEN="" S BMXSEC="Template IEN is blank." Q
;
;Get template name
S DA(1)=OWNR,DA=TIEN,IENS=$$IENS^DILF(.DA)
S TNAME=$$GET1^DIQ(90505.015,IENS,".01","E") I TNAME="" S BMXSEC="Template does not have a NAME assigned to it" Q
;
;Loop through all panels for user to see if template in use
S PLIEN=0
F S PLIEN=$O(^BQICARE(OWNR,1,PLIEN)) Q:'PLIEN D
. NEW PNAME,PDESC,DA,IENS,DIC,X,Y
. ;
. ;Quit if template isn't used in panel
. S DIC="^BQICARE("_OWNR_",1,"_PLIEN_",4,",DIC(0)="X"
. S X=TNAME D ^DIC I +Y=-1 Q
. ;
. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
. S PNAME=$$GET1^DIQ(90505.01,IENS,.01,"E")
. S PDESC=$$GET1^DIQ(90505.01,IENS,1,"E")
. S II=$G(II)+1,@DATA@(II)=PLIEN_U_PNAME_U_PDESC_U_OWNR_$C(30)
;
;Loop through all panels shared to user and see if template is in use
S OWNRIEN=""
F S OWNRIEN=$O(^BQICARE("C",OWNR,OWNRIEN)) Q:'OWNRIEN D
. S PLIEN=0 F S PLIEN=$O(^BQICARE("C",OWNR,OWNRIEN,PLIEN)) Q:'PLIEN D
.. ;
.. ;Quit if template isn't used in panel
.. N DIC,X,Y
.. S DIC="^BQICARE("_OWNRIEN_",1,"_PLIEN_",30,"_OWNR_",4,",DIC(0)="X"
.. S X=TNAME D ^DIC I +Y=-1 Q
.. ;
.. S DA(1)=OWNRIEN,DA=PLIEN,IENS=$$IENS^DILF(.DA)
.. S PNAME=$$GET1^DIQ(90505.01,IENS,.01,"E")
.. S PDESC=$$GET1^DIQ(90505.01,IENS,1,"E")
.. S II=$G(II)+1,@DATA@(II)=PLIEN_U_PNAME_U_PDESC_U_OWNRIEN_$C(30)
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
DELTMP(OWNR,TIEN,TNAME,ERROR) ;EP - Delete Template
;
;Input: TIEN - Template IEN
;Output: ERROR (if unsuccessful)
;
NEW DA,IENS,OWNRIEN,PLIEN
;
;Check for template IEN
I TIEN="" S ERROR="Template IEN is null" Q
;
S DA(1)=OWNR,DA=TIEN,IENS=$$IENS^DILF(.DA)
;
;Check for default template
I $$GET1^DIQ(90505.015,IENS,".05","I")'="Y" S ERROR="Cannot delete default templates" Q
;
;Get Template name
I TNAME="" D Q:$G(ERROR)=1
. S TNAME=$$GET1^DIQ(90505.015,IENS,".01","E") I TNAME="" S ERROR="Cannot find template name" Q
;
;Loop through all panels for user to see if template in use
S PLIEN=0
F S PLIEN=$O(^BQICARE(OWNR,1,PLIEN)) Q:'PLIEN D
. NEW DA,DIK
. ;
. ;Quit if template isn't used in panel
. S DIC="^BQICARE("_OWNR_",1,"_PLIEN_",4,",DIC(0)="X"
. S X=TNAME D ^DIC I +Y=-1 Q
. ;
. S DA=+Y Q:DA=0
. S DA(2)=OWNR,DA(1)=PLIEN,IENS=$$IENS^DILF(.DA)
. S DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",4,"
. D ^DIK
;
;Loop through all panels shared to user and see if template is in use
S OWNRIEN=""
F S OWNRIEN=$O(^BQICARE("C",OWNR,OWNRIEN)) Q:'OWNRIEN D
. S PLIEN=0 F S PLIEN=$O(^BQICARE("C",OWNR,OWNRIEN,PLIEN)) Q:'PLIEN D
.. N DA,IENS,DIK
.. ;
.. ;Quit if template isn't used in panel
.. N DIC,X,Y
.. S DIC="^BQICARE("_OWNRIEN_",1,"_PLIEN_",30,"_OWNR_",4,",DIC(0)="X"
.. S X=TNAME D ^DIC I +Y=-1 Q
.. ;
.. S DA=+Y Q:DA=0
.. S DA(3)=OWNRIEN,DA(2)=PLIEN,DA(1)=OWNR,IENS=$$IENS^DILF(.DA)
.. S DIK="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DA(1)_",4,"
.. D ^DIK
;
;Delete the template
S DA(1)=OWNR,DA=TIEN
S DIK="^BQICARE("_DA(1)_",15,"
D ^DIK
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
BQITMPLE ;GDIT/HC/BEE-Template Handling ; 01 Jun 2007 11:51 AM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
DFLT(DATA,OWNR,LYIEN,TYPE,TMPNAM) ;EP -- BQI SET TEMPLATE DFLT
+1 ;
+2 ; Input
+3 ; OWNR - Whose template this is
+4 ; LYIEN - Template internal entry number
+5 ; TYPE - The type of template
+6 ; TMPNAM - The template name
+7 ;
+8 NEW UID,II,ERROR,HDR,IEN
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BQILYDEF",UID))
+11 KILL @DATA
+12 ;
+13 ;Define Header
+14 SET @DATA@(0)="T00001RESULT"_$CHAR(30)
+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 IF $GET(OWNR)=""
SET OWNR=DUZ
+20 SET LYIEN=$GET(LYIEN,"")
+21 SET TYPE=$GET(TYPE,"")
+22 ;
+23 IF LYIEN=""
SET BMXSEC="Template IEN is blank."
QUIT
+24 IF TYPE=""
Begin DoDot:1
+25 NEW DA,IENS
+26 SET DA(1)=OWNR
SET DA=LYIEN
SET IENS=$$IENS^DILF(.DA)
+27 SET TYPE=$$GET1^DIQ(90505.015,IENS,".02","I")
End DoDot:1
IF TYPE=""
SET BMXSEC="Template TYPE is blank."
QUIT
+28 ;
+29 ;Loop through all templates for type and set/remove default
+30 SET IEN=0
FOR
SET IEN=$ORDER(^BQICARE(OWNR,15,"C",TYPE,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+31 ;
+32 NEW DA,IENS,BQIUPD,CHG,DEF
+33 SET DA(1)=OWNR
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+34 ;
+35 ;Get current default value
+36 SET DEF=$$GET1^DIQ(90505.015,IENS,".03","I")
+37 ;
+38 ;Set Change Flag
+39 SET CHG=0
+40 ;
+41 ;If this one is the passed in one
+42 IF IEN=LYIEN
Begin DoDot:2
+43 ;Already default - don't save
IF DEF="Y"
QUIT
+44 SET BQIUPD(90505.015,IENS,".03")="Y"
SET CHG=1
End DoDot:2
+45 ;
+46 ;Look for other templates
+47 IF IEN'=LYIEN
Begin DoDot:2
+48 ;Already not the default - don't save
IF DEF=""
QUIT
+49 SET BQIUPD(90505.015,IENS,".03")=""
SET CHG=1
End DoDot:2
+50 ;
+51 ;Set last edited
+52 IF CHG=1
SET BQIUPD(90505.015,IENS,.04)=$$NOW^XLFDT()
+53 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
IF $DATA(ERROR)
QUIT
+54 ;
+55 SET II=II+1
+56 IF $DATA(ERROR)
SET @DATA@(II)="-1"_$CHAR(30)
+57 IF '$TEST
SET @DATA@(II)="1"_$CHAR(30)
+58 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+59 QUIT
+60 ;
TMUSE(DATA,OWNR,TIEN) ;EP -- BQI GET TEMPLATE USE
+1 ;
+2 ; Input
+3 ; OWNR - Whose template this is
+4 ; TIEN - Template internal entry number
+5 ;
+6 NEW UID,II,ERROR,HDR,TNAME,PLIEN,DA,IENS,OWNIEN
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQILYDEF",UID))
+9 KILL @DATA
+10 ;
+11 ;Define Header
+12 SET @DATA@(0)="I00010PANEL_IEN^T00120PANEL_NAME^T00250PANEL_DESCRIPTION^I00010PANEL_OWNER"_$CHAR(30)
+13 ;
+14 SET II=0
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQILYDEF D UNWIND^%ZTER"
+16 ;
+17 IF $GET(OWNR)=""
SET OWNR=DUZ
+18 ;
+19 IF TIEN=""
SET BMXSEC="Template IEN is blank."
QUIT
+20 ;
+21 ;Get template name
+22 SET DA(1)=OWNR
SET DA=TIEN
SET IENS=$$IENS^DILF(.DA)
+23 SET TNAME=$$GET1^DIQ(90505.015,IENS,".01","E")
IF TNAME=""
SET BMXSEC="Template does not have a NAME assigned to it"
QUIT
+24 ;
+25 ;Loop through all panels for user to see if template in use
+26 SET PLIEN=0
+27 FOR
SET PLIEN=$ORDER(^BQICARE(OWNR,1,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:1
+28 NEW PNAME,PDESC,DA,IENS,DIC,X,Y
+29 ;
+30 ;Quit if template isn't used in panel
+31 SET DIC="^BQICARE("_OWNR_",1,"_PLIEN_",4,"
SET DIC(0)="X"
+32 SET X=TNAME
DO ^DIC
IF +Y=-1
QUIT
+33 ;
+34 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+35 SET PNAME=$$GET1^DIQ(90505.01,IENS,.01,"E")
+36 SET PDESC=$$GET1^DIQ(90505.01,IENS,1,"E")
+37 SET II=$GET(II)+1
SET @DATA@(II)=PLIEN_U_PNAME_U_PDESC_U_OWNR_$CHAR(30)
End DoDot:1
+38 ;
+39 ;Loop through all panels shared to user and see if template is in use
+40 SET OWNRIEN=""
+41 FOR
SET OWNRIEN=$ORDER(^BQICARE("C",OWNR,OWNRIEN))
IF 'OWNRIEN
QUIT
Begin DoDot:1
+42 SET PLIEN=0
FOR
SET PLIEN=$ORDER(^BQICARE("C",OWNR,OWNRIEN,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:2
+43 ;
+44 ;Quit if template isn't used in panel
+45 NEW DIC,X,Y
+46 SET DIC="^BQICARE("_OWNRIEN_",1,"_PLIEN_",30,"_OWNR_",4,"
SET DIC(0)="X"
+47 SET X=TNAME
DO ^DIC
IF +Y=-1
QUIT
+48 ;
+49 SET DA(1)=OWNRIEN
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+50 SET PNAME=$$GET1^DIQ(90505.01,IENS,.01,"E")
+51 SET PDESC=$$GET1^DIQ(90505.01,IENS,1,"E")
+52 SET II=$GET(II)+1
SET @DATA@(II)=PLIEN_U_PNAME_U_PDESC_U_OWNRIEN_$CHAR(30)
End DoDot:2
End DoDot:1
+53 ;
+54 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+55 QUIT
+56 ;
DELTMP(OWNR,TIEN,TNAME,ERROR) ;EP - Delete Template
+1 ;
+2 ;Input: TIEN - Template IEN
+3 ;Output: ERROR (if unsuccessful)
+4 ;
+5 NEW DA,IENS,OWNRIEN,PLIEN
+6 ;
+7 ;Check for template IEN
+8 IF TIEN=""
SET ERROR="Template IEN is null"
QUIT
+9 ;
+10 SET DA(1)=OWNR
SET DA=TIEN
SET IENS=$$IENS^DILF(.DA)
+11 ;
+12 ;Check for default template
+13 IF $$GET1^DIQ(90505.015,IENS,".05","I")'="Y"
SET ERROR="Cannot delete default templates"
QUIT
+14 ;
+15 ;Get Template name
+16 IF TNAME=""
Begin DoDot:1
+17 SET TNAME=$$GET1^DIQ(90505.015,IENS,".01","E")
IF TNAME=""
SET ERROR="Cannot find template name"
QUIT
End DoDot:1
IF $GET(ERROR)=1
QUIT
+18 ;
+19 ;Loop through all panels for user to see if template in use
+20 SET PLIEN=0
+21 FOR
SET PLIEN=$ORDER(^BQICARE(OWNR,1,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:1
+22 NEW DA,DIK
+23 ;
+24 ;Quit if template isn't used in panel
+25 SET DIC="^BQICARE("_OWNR_",1,"_PLIEN_",4,"
SET DIC(0)="X"
+26 SET X=TNAME
DO ^DIC
IF +Y=-1
QUIT
+27 ;
+28 SET DA=+Y
IF DA=0
QUIT
+29 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET IENS=$$IENS^DILF(.DA)
+30 SET DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",4,"
+31 DO ^DIK
End DoDot:1
+32 ;
+33 ;Loop through all panels shared to user and see if template is in use
+34 SET OWNRIEN=""
+35 FOR
SET OWNRIEN=$ORDER(^BQICARE("C",OWNR,OWNRIEN))
IF 'OWNRIEN
QUIT
Begin DoDot:1
+36 SET PLIEN=0
FOR
SET PLIEN=$ORDER(^BQICARE("C",OWNR,OWNRIEN,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:2
+37 NEW DA,IENS,DIK
+38 ;
+39 ;Quit if template isn't used in panel
+40 NEW DIC,X,Y
+41 SET DIC="^BQICARE("_OWNRIEN_",1,"_PLIEN_",30,"_OWNR_",4,"
SET DIC(0)="X"
+42 SET X=TNAME
DO ^DIC
IF +Y=-1
QUIT
+43 ;
+44 SET DA=+Y
IF DA=0
QUIT
+45 SET DA(3)=OWNRIEN
SET DA(2)=PLIEN
SET DA(1)=OWNR
SET IENS=$$IENS^DILF(.DA)
+46 SET DIK="^BQICARE("_DA(3)_",1,"_DA(2)_",30,"_DA(1)_",4,"
+47 DO ^DIK
End DoDot:2
End DoDot:1
+48 ;
+49 ;Delete the template
+50 SET DA(1)=OWNR
SET DA=TIEN
+51 SET DIK="^BQICARE("_DA(1)_",15,"
+52 DO ^DIK
+53 QUIT
+54 ;
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
