BTPWETRG ;VNGT/HS/BEE-Event Triggers ; 20 Jan 2010 10:00 AM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
EN(DATA,BTPWSTGE) ;EP -- BTPW EVENT TRIGGER
NEW UID,II,SOURCE,TYPE,ABLE,HELP,VALUE,%
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWETRG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00030PROP_VALUE^T00001ABLE_FLAG^T00200HELP_TEXT"_$C(30)
I $E(BTPWSTGE,1)="O" S SOURCE="BTPWPCLR",TYPE="C",ABLE="N",HELP="",VALUE="" D UP
I $E(BTPWSTGE,1)="C" S SOURCE="BTPWPCLR",TYPE="C",ABLE="Y",HELP="",VALUE="" D UP
;
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
;
UP ; Update
S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_HELP_$C(30)
Q
;
FND(DATA,CMIEN) ;EP -- BTPW FIND EVENT TRIG
;
; *Initial Trigger for Findings Dialog Box
;
NEW UID,II,PRCN,FN,VALUE,SOURCE,TYPE,ABLE,HELP,IEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWETRG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$C(30)
S PRCN=$P(^BTPWP(CMIEN,0),U,1)
S FN=0,VALUE="",SOURCE="BTPWPFND",TYPE="T",ABLE="Y",HELP=""
F S FN=$O(^BTPW(90621,PRCN,6,FN)) Q:'FN D
. S IEN=$P(^BTPW(90621,PRCN,6,FN,0),U,1)
. S VALUE=VALUE_IEN_$C(29)_$$GET1^DIQ(90620.9,IEN_",",.01,"E")_$C(28)
S VALUE=$$TKO^BQIUL1(VALUE,$C(28)) D UP
;
S SOURCE="CMIEN",VALUE=CMIEN,TYPE="N",ABLE="N",HELP="" D UP
S SOURCE="BTPWFDTM",VALUE=$$FMTE^BQIUL1(DT),TYPE="D",ABLE="Y",HELP="" D UP
D NOW^%DTC
S SOURCE="BTPWLMDT",VALUE=$$FMTE^BQIUL1(%),TYPE="D",ABLE="N",HELP="" D UP
S SOURCE="BTPWLMBY",VALUE=DUZ,TYPE="T",ABLE="N",HELP="" D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
INFOL(DATA,CMIEN) ;EP -- BTPW FOL EVENT TRIG
;
; *Initial Trigger for Follow-up Dialog Box
;
NEW UID,II,PRCN,CAT,FN,VALUE,SOURCE,TYPE,ABLE,HELP
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWETRG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$C(30)
;
S PRCN=$P(^BTPWP(CMIEN,0),U,1)
S CAT=$P(^BTPW(90621,PRCN,0),U,10)
S FN=0,VALUE="",SOURCE="BTPWPFOL",TYPE="T",ABLE="Y",HELP=""
F S FN=$O(^BTPW(90621,"AD",CAT,FN)) Q:'FN S VALUE=VALUE_FN_$C(29)_$P(^BTPW(90621,FN,0),U,1)_$C(28)
S VALUE=$$TKO^BQIUL1(VALUE,$C(28)) D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
FIN(DATA,CMIEN,BTPWPFND) ;EP -- BTPW EVENT FIND TRIG
;
; Called from the Finding field in the Finding Dialog Box
;
NEW UID,II,BTPWPRC,SOURCE,TYPE,ABLE,HELP,IEN,VALUE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWETRG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$C(30)
S BTPWPRC=$P(^BTPWP(CMIEN,0),U,1)
S IEN=$O(^BTPW(90621,BTPWPRC,6,"B",BTPWPFND,"")) Q:IEN=""
S VALUE=$P(^BTPW(90621,BTPWPRC,6,IEN,0),U,2),VALUE=VALUE_$C(28)_$$STC^BQIUL2(90621.06,.02,VALUE)
S SOURCE="BTPWFNTR",TYPE="C",ABLE="",HELP="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
FNFL(DATA,BTPWFLUN,CMIEN,BTPWFIND) ;EP -- BTPW EVENT FIND FOL TRIG
NEW UID,II,SOURCE,TYPE,ABLE,HELP,VALUE,BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY
;
; *Called by Follow-up Needed Field (in the worksheet)
;
NEW UID,II,SOURCE,TYPE,ABLE,HELP,VALUE,PRCN,CAT,FN,BQ
NEW FNDDT,BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWFNFL",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$C(30)
;
;Re-Assemble parameter list if in an array
S BTPWFIND=$G(BTPWFIND,"")
I BTPWFIND="" D
. N LIST,BN
. S LIST="",BN=""
. F S BN=$O(BTPWFIND(BN)) Q:BN="" S LIST=LIST_BTPWFIND(BN)
. K BTPWFIND
. S BTPWFIND=LIST
. K LIST
;
;Parse Parameters
S (BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY)=""
F BQ=1:1:$L(BTPWFIND,$C(28)) D
. N PDATA,NAME,VALUE,BP,BV
. S PDATA=$P(BTPWFIND,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1) I NAME=""!(NAME="CMIEN")!(NAME="EVIEN") Q
. S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
. F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=$G(@NAME)_$S(BP=1:"",1:$C(29))_BV
;
;Get earliest finding date
S FNDDT=""
I BTPFNDTM]"" D
. N I,VAL,CVAL
. S CVAL="" F I=1:1:$L(BTPFNDTM,$C(29)) S VAL=$$DATE^BQIUL1($P(BTPFNDTM,$C(29),I)) I VAL'="",(VAL<CVAL)!(CVAL="") S CVAL=VAL
. S FNDDT=CVAL
;
;Calculate Follow-up Decision Due By
S SOURCE="BTPWFDUE",TYPE="D",ABLE="N",HELP="",VALUE=""
I BTPWFLUN["N" S ABLE="N",VALUE=""
I BTPWFLUN["Y" D
. N IEN
. S ABLE="Y"
. S IEN=$O(^BTPW(90628,0)) Q:IEN=""
. S VALUE=$$GET1^DIQ(90628,IEN_",",1.02,"E") D SYS^BTPWPUTL
. S:FNDDT="" FNDDT=$$DATE^BQIUL1("T")
. S VALUE=$$FMADD^XLFDT(FNDDT,VALUE) S:VALUE<$$DATE^BQIUL1("T") VALUE=$$DATE^BQIUL1("T")
. S VALUE=$$FMTE^BQIUL1(VALUE)
;
D UP
;
;Enable/disable Follow-up Grid
S SOURCE="BTPWFU",TYPE="M",ABLE="N",HELP="",VALUE=""
I BTPWFLUN["Y" S ABLE="Y"
D UP
;
;Populate Notification Due By
I BTPWFLUN["N" D
. N IEN,DUEDT
. S SOURCE="BTPWNDUE",TYPE="D",HELP="",ABLE="Y",VALUE=""
. S IEN=$O(^BTPW(90628,0)) Q:IEN=""
. S VALUE=$$GET1^DIQ(90628,IEN_",",1.03,"E") D SYS^BTPWPUTL
. S DUEDT=FNDDT
. S:DUEDT="" DUEDT=$$DATE^BQIUL1("T")
. S VALUE=$$FMADD^XLFDT(DUEDT,VALUE) S:VALUE<$$DATE^BQIUL1("T") VALUE=$$DATE^BQIUL1("T")
. S VALUE=$$FMTE^BQIUL1(VALUE)
. D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
FOL(DATA,CMIEN,BTPFNDTM,BTPWFLUN,BTPWNDUE,BTPWFIND) ;EP -- BTPW EVENT FOL TRIGGER
;
; *Called by Finding Date field in Finding Dialog Box (after OK is entered)
;
NEW UID,II,VALUE,BTPWFDUE,SOURCE,TYPE,ABLE,HELP
NEW BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY,BQ,FNDDT,FOLND,BTPWFNER
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWETRG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$C(30)
;
;Re-Assemble parameter list if in an array
S BTPWFIND=$G(BTPWFIND,"")
I BTPWFIND="" D
. N LIST,BN
. S LIST="",BN=""
. F S BN=$O(BTPWFIND(BN)) Q:BN="" S LIST=LIST_BTPWFIND(BN)
. K BTPWFIND
. S BTPWFIND=LIST
. K LIST
;
;Parse Parameters
S (BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY,BTPWFNER)=""
F BQ=1:1:$L(BTPWFIND,$C(28)) D
. N PDATA,NAME,VALUE,BP,BV
. S PDATA=$P(BTPWFIND,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1) I NAME=""!(NAME="CMIEN")!(NAME="EVIEN") Q
. S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
. F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=$G(@NAME)_$S(BP=1:"",1:$C(29))_BV
;
;Get earliest finding date
S FNDDT=""
I BTPFNDTM]"" D
. N I,VAL,CVAL
. S CVAL="" F I=1:1:$L(BTPFNDTM,$C(29)) I $P($G(BTPWFNER),$C(29),I)'="Y" S VAL=$$DATE^BQIUL1($P(BTPFNDTM,$C(29),I)) I VAL'="",(VAL<CVAL)!(CVAL="") S CVAL=VAL
. S FNDDT=CVAL
;
;Get Followup Needed Values
S FOLND=""
I BTPFLND]"" D
. N I,VAL,LAST
. S LAST=$P(BTPFLND,$C(29),$L(BTPFLND,$C(29)))
. I BTPWFLUN="N",LAST="N" S FOLND="N" Q ;Use Existing Value if new value is NO
. I BTPWFLUN="Y" S FOLND="Y" Q
. F I=1:1:$L(BTPFLND,$C(29)) I $P($G(BTPWFNER),$C(29),I)'="Y" S VAL=$P(BTPFLND,$C(29),I) S:VAL]"" FOLND=VAL I FOLND="Y" Q
;
;Enable/disable Follow-up Needed
S SOURCE="BTPWFLUN",TYPE="C",HELP="",ABLE="N",VALUE=""
I FNDDT]"" S ABLE="Y",VALUE=FOLND
D UP
;
;Calculate Follow-up Decision Due By
S SOURCE="BTPWFDUE",TYPE="D",ABLE="N",HELP="",VALUE=""
I FOLND="N" S ABLE="N",VALUE=""
I FOLND="Y" D
. N IEN,DUEDT
. S ABLE="Y"
. S IEN=$O(^BTPW(90628,0)) Q:IEN=""
. S VALUE=$$GET1^DIQ(90628,IEN_",",1.02,"E") D SYS^BTPWPUTL
. S DUEDT=FNDDT
. S:DUEDT="" DUEDT=$$DATE^BQIUL1("T")
. S VALUE=$$FMADD^XLFDT(DUEDT,VALUE) S:VALUE<$$DATE^BQIUL1("T") VALUE=$$DATE^BQIUL1("T")
. S VALUE=$$FMTE^BQIUL1(VALUE)
D UP
;
;Enable/disable Follow-up Grid
S SOURCE="BTPWFU",TYPE="M",ABLE="N",HELP="",VALUE=""
I FOLND="Y" S ABLE="Y"
D UP
;
;Enable/disable Notification Due By
S SOURCE="BTPWNDUE",TYPE="D",HELP="",ABLE="N",VALUE=BTPWNDUE
I FNDDT]"" D
. S ABLE="Y"
. I FOLND="N" D
.. N IEN,DUEDT
.. S IEN=$O(^BTPW(90628,0)) Q:IEN=""
.. S VALUE=$$GET1^DIQ(90628,IEN_",",1.03,"E") D SYS^BTPWPUTL
.. S DUEDT=FNDDT
.. S:DUEDT="" DUEDT=$$DATE^BQIUL1("T")
.. S VALUE=$$FMADD^XLFDT(DUEDT,VALUE) S:VALUE<$$DATE^BQIUL1("T") VALUE=$$DATE^BQIUL1("T")
.. S VALUE=$$FMTE^BQIUL1(VALUE)
D UP
;
;Enable/disable Notifications
S SOURCE="BTPWNTY",TYPE="M",HELP="",ABLE="N",VALUE=""
I FNDDT]"" S ABLE="Y"
D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
NOT(DATA,BTPFLDTM,BTPWFU) ; EP -- BTPW EVENT NOT TRIGGER
NEW UID,II,VALUE,BTPWNDUE,SOURCE,TYPE,ABLE,HELP
NEW BTPFLDTM,BTPWPFOL,BTPWPFLD,BTPEDBY,BTPEDTM,BTPWPFCM,FOLDT,BQ
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWETRG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$C(30)
;
;Re-Assemble parameter list if in an array
S BTPWFU=$G(BTPWFU,"")
I BTPWFU="" D
. N LIST,BN
. S LIST="",BN=""
. F S BN=$O(BTPWFU(BN)) Q:BN="" S LIST=LIST_BTPWFU(BN)
. K BTPWFU
. S BTPWFU=LIST
. K LIST
;
;Parse Parameters
S (BTPFLDTM,BTPWPFOL,BTPWPFLD,BTPEDBY,BTPEDTM,BTPWPFCM)=""
F BQ=1:1:$L(BTPWFU,$C(28)) D
. N PDATA,NAME,VALUE,BP,BV
. S PDATA=$P(BTPWFU,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1) I NAME=""!(NAME="CMIEN")!(NAME="EVIEN") Q
. S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
. F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=$G(@NAME)_$S(BP=1:"",1:$C(29))_BV
;
;Get earliest follow-up creation date
S FOLDT=""
I BTPFLDTM]"" D
. N I,VAL,CVAL
. S CVAL="" F I=1:1:$L(BTPFLDTM,$C(29)) S VAL=$$DATE^BQIUL1($P(BTPFLDTM,$C(29),I)) I VAL'="",(VAL<CVAL)!(CVAL="") S CVAL=VAL
. S FOLDT=CVAL
;
;Patient Notification Due Date
S SOURCE="BTPWNDUE",TYPE="D",ABLE="N",HELP=""
I FOLDT]"" D
. S ABLE="Y"
. N IEN,DUEDT
. S IEN=$O(^BTPW(90628,0)) Q:IEN=""
. S VALUE=$$GET1^DIQ(90628,IEN_",",1.03,"E") D SYS^BTPWPUTL
. S DUEDT=FOLDT
. S:DUEDT="" DUEDT=$$DATE^BQIUL1("T")
. S VALUE=$$FMADD^XLFDT(DUEDT,VALUE) S:VALUE<$$DATE^BQIUL1("T") VALUE=$$DATE^BQIUL1("T")
. S VALUE=$$FMTE^BQIUL1(VALUE)
D UP
;
;Enable/disable Notifications
S SOURCE="BTPWNTY",TYPE="M",HELP="",ABLE="N",VALUE=""
I FOLDT]"" S ABLE="Y"
D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
BTPWETRG ;VNGT/HS/BEE-Event Triggers ; 20 Jan 2010 10:00 AM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
EN(DATA,BTPWSTGE) ;EP -- BTPW EVENT TRIGGER
+1 NEW UID,II,SOURCE,TYPE,ABLE,HELP,VALUE,%
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWETRG",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER"
+7 ;
+8 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00030PROP_VALUE^T00001ABLE_FLAG^T00200HELP_TEXT"_$CHAR(30)
+9 IF $EXTRACT(BTPWSTGE,1)="O"
SET SOURCE="BTPWPCLR"
SET TYPE="C"
SET ABLE="N"
SET HELP=""
SET VALUE=""
DO UP
+10 IF $EXTRACT(BTPWSTGE,1)="C"
SET SOURCE="BTPWPCLR"
SET TYPE="C"
SET ABLE="Y"
SET HELP=""
SET VALUE=""
DO UP
+11 ;
+12 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+13 QUIT
+14 ;
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 ;
UP ; Update
+1 SET II=II+1
SET @DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_HELP_$CHAR(30)
+2 QUIT
+3 ;
FND(DATA,CMIEN) ;EP -- BTPW FIND EVENT TRIG
+1 ;
+2 ; *Initial Trigger for Findings Dialog Box
+3 ;
+4 NEW UID,II,PRCN,FN,VALUE,SOURCE,TYPE,ABLE,HELP,IEN
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("BTPWETRG",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER"
+10 ;
+11 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$CHAR(30)
+12 SET PRCN=$PIECE(^BTPWP(CMIEN,0),U,1)
+13 SET FN=0
SET VALUE=""
SET SOURCE="BTPWPFND"
SET TYPE="T"
SET ABLE="Y"
SET HELP=""
+14 FOR
SET FN=$ORDER(^BTPW(90621,PRCN,6,FN))
IF 'FN
QUIT
Begin DoDot:1
+15 SET IEN=$PIECE(^BTPW(90621,PRCN,6,FN,0),U,1)
+16 SET VALUE=VALUE_IEN_$CHAR(29)_$$GET1^DIQ(90620.9,IEN_",",.01,"E")_$CHAR(28)
End DoDot:1
+17 SET VALUE=$$TKO^BQIUL1(VALUE,$CHAR(28))
DO UP
+18 ;
+19 SET SOURCE="CMIEN"
SET VALUE=CMIEN
SET TYPE="N"
SET ABLE="N"
SET HELP=""
DO UP
+20 SET SOURCE="BTPWFDTM"
SET VALUE=$$FMTE^BQIUL1(DT)
SET TYPE="D"
SET ABLE="Y"
SET HELP=""
DO UP
+21 DO NOW^%DTC
+22 SET SOURCE="BTPWLMDT"
SET VALUE=$$FMTE^BQIUL1(%)
SET TYPE="D"
SET ABLE="N"
SET HELP=""
DO UP
+23 SET SOURCE="BTPWLMBY"
SET VALUE=DUZ
SET TYPE="T"
SET ABLE="N"
SET HELP=""
DO UP
+24 ;
+25 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+26 QUIT
+27 ;
INFOL(DATA,CMIEN) ;EP -- BTPW FOL EVENT TRIG
+1 ;
+2 ; *Initial Trigger for Follow-up Dialog Box
+3 ;
+4 NEW UID,II,PRCN,CAT,FN,VALUE,SOURCE,TYPE,ABLE,HELP
+5 ;
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BTPWETRG",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER"
+11 ;
+12 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$CHAR(30)
+13 ;
+14 SET PRCN=$PIECE(^BTPWP(CMIEN,0),U,1)
+15 SET CAT=$PIECE(^BTPW(90621,PRCN,0),U,10)
+16 SET FN=0
SET VALUE=""
SET SOURCE="BTPWPFOL"
SET TYPE="T"
SET ABLE="Y"
SET HELP=""
+17 FOR
SET FN=$ORDER(^BTPW(90621,"AD",CAT,FN))
IF 'FN
QUIT
SET VALUE=VALUE_FN_$CHAR(29)_$PIECE(^BTPW(90621,FN,0),U,1)_$CHAR(28)
+18 SET VALUE=$$TKO^BQIUL1(VALUE,$CHAR(28))
DO UP
+19 ;
+20 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+21 QUIT
+22 ;
FIN(DATA,CMIEN,BTPWPFND) ;EP -- BTPW EVENT FIND TRIG
+1 ;
+2 ; Called from the Finding field in the Finding Dialog Box
+3 ;
+4 NEW UID,II,BTPWPRC,SOURCE,TYPE,ABLE,HELP,IEN,VALUE
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("BTPWETRG",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER"
+10 ;
+11 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$CHAR(30)
+12 SET BTPWPRC=$PIECE(^BTPWP(CMIEN,0),U,1)
+13 SET IEN=$ORDER(^BTPW(90621,BTPWPRC,6,"B",BTPWPFND,""))
IF IEN=""
QUIT
+14 SET VALUE=$PIECE(^BTPW(90621,BTPWPRC,6,IEN,0),U,2)
SET VALUE=VALUE_$CHAR(28)_$$STC^BQIUL2(90621.06,.02,VALUE)
+15 SET SOURCE="BTPWFNTR"
SET TYPE="C"
SET ABLE=""
SET HELP=""
DO UP
+16 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+17 QUIT
+18 ;
FNFL(DATA,BTPWFLUN,CMIEN,BTPWFIND) ;EP -- BTPW EVENT FIND FOL TRIG
+1 NEW UID,II,SOURCE,TYPE,ABLE,HELP,VALUE,BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY
+2 ;
+3 ; *Called by Follow-up Needed Field (in the worksheet)
+4 ;
+5 NEW UID,II,SOURCE,TYPE,ABLE,HELP,VALUE,PRCN,CAT,FN,BQ
+6 NEW FNDDT,BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BTPWFNFL",UID))
+9 KILL @DATA
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER"
+12 ;
+13 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$CHAR(30)
+14 ;
+15 ;Re-Assemble parameter list if in an array
+16 SET BTPWFIND=$GET(BTPWFIND,"")
+17 IF BTPWFIND=""
Begin DoDot:1
+18 NEW LIST,BN
+19 SET LIST=""
SET BN=""
+20 FOR
SET BN=$ORDER(BTPWFIND(BN))
IF BN=""
QUIT
SET LIST=LIST_BTPWFIND(BN)
+21 KILL BTPWFIND
+22 SET BTPWFIND=LIST
+23 KILL LIST
End DoDot:1
+24 ;
+25 ;Parse Parameters
+26 SET (BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY)=""
+27 FOR BQ=1:1:$LENGTH(BTPWFIND,$CHAR(28))
Begin DoDot:1
+28 NEW PDATA,NAME,VALUE,BP,BV
+29 SET PDATA=$PIECE(BTPWFIND,$CHAR(28),BQ)
IF PDATA=""
QUIT
+30 SET NAME=$PIECE(PDATA,"=",1)
IF NAME=""!(NAME="CMIEN")!(NAME="EVIEN")
QUIT
+31 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+32 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET BV=$PIECE(VALUE,$CHAR(29),BP)
SET @NAME=$GET(@NAME)_$SELECT(BP=1:"",1:$CHAR(29))_BV
End DoDot:1
+33 ;
+34 ;Get earliest finding date
+35 SET FNDDT=""
+36 IF BTPFNDTM]""
Begin DoDot:1
+37 NEW I,VAL,CVAL
+38 SET CVAL=""
FOR I=1:1:$LENGTH(BTPFNDTM,$CHAR(29))
SET VAL=$$DATE^BQIUL1($PIECE(BTPFNDTM,$CHAR(29),I))
IF VAL'=""
IF (VAL<CVAL)!(CVAL="")
SET CVAL=VAL
+39 SET FNDDT=CVAL
End DoDot:1
+40 ;
+41 ;Calculate Follow-up Decision Due By
+42 SET SOURCE="BTPWFDUE"
SET TYPE="D"
SET ABLE="N"
SET HELP=""
SET VALUE=""
+43 IF BTPWFLUN["N"
SET ABLE="N"
SET VALUE=""
+44 IF BTPWFLUN["Y"
Begin DoDot:1
+45 NEW IEN
+46 SET ABLE="Y"
+47 SET IEN=$ORDER(^BTPW(90628,0))
IF IEN=""
QUIT
+48 SET VALUE=$$GET1^DIQ(90628,IEN_",",1.02,"E")
DO SYS^BTPWPUTL
+49 IF FNDDT=""
SET FNDDT=$$DATE^BQIUL1("T")
+50 SET VALUE=$$FMADD^XLFDT(FNDDT,VALUE)
IF VALUE<$$DATE^BQIUL1("T")
SET VALUE=$$DATE^BQIUL1("T")
+51 SET VALUE=$$FMTE^BQIUL1(VALUE)
End DoDot:1
+52 ;
+53 DO UP
+54 ;
+55 ;Enable/disable Follow-up Grid
+56 SET SOURCE="BTPWFU"
SET TYPE="M"
SET ABLE="N"
SET HELP=""
SET VALUE=""
+57 IF BTPWFLUN["Y"
SET ABLE="Y"
+58 DO UP
+59 ;
+60 ;Populate Notification Due By
+61 IF BTPWFLUN["N"
Begin DoDot:1
+62 NEW IEN,DUEDT
+63 SET SOURCE="BTPWNDUE"
SET TYPE="D"
SET HELP=""
SET ABLE="Y"
SET VALUE=""
+64 SET IEN=$ORDER(^BTPW(90628,0))
IF IEN=""
QUIT
+65 SET VALUE=$$GET1^DIQ(90628,IEN_",",1.03,"E")
DO SYS^BTPWPUTL
+66 SET DUEDT=FNDDT
+67 IF DUEDT=""
SET DUEDT=$$DATE^BQIUL1("T")
+68 SET VALUE=$$FMADD^XLFDT(DUEDT,VALUE)
IF VALUE<$$DATE^BQIUL1("T")
SET VALUE=$$DATE^BQIUL1("T")
+69 SET VALUE=$$FMTE^BQIUL1(VALUE)
+70 DO UP
End DoDot:1
+71 ;
+72 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+73 QUIT
+74 ;
FOL(DATA,CMIEN,BTPFNDTM,BTPWFLUN,BTPWNDUE,BTPWFIND) ;EP -- BTPW EVENT FOL TRIGGER
+1 ;
+2 ; *Called by Finding Date field in Finding Dialog Box (after OK is entered)
+3 ;
+4 NEW UID,II,VALUE,BTPWFDUE,SOURCE,TYPE,ABLE,HELP
+5 NEW BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY,BQ,FNDDT,FOLND,BTPWFNER
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BTPWETRG",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER"
+11 ;
+12 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$CHAR(30)
+13 ;
+14 ;Re-Assemble parameter list if in an array
+15 SET BTPWFIND=$GET(BTPWFIND,"")
+16 IF BTPWFIND=""
Begin DoDot:1
+17 NEW LIST,BN
+18 SET LIST=""
SET BN=""
+19 FOR
SET BN=$ORDER(BTPWFIND(BN))
IF BN=""
QUIT
SET LIST=LIST_BTPWFIND(BN)
+20 KILL BTPWFIND
+21 SET BTPWFIND=LIST
+22 KILL LIST
End DoDot:1
+23 ;
+24 ;Parse Parameters
+25 SET (BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY,BTPWFNER)=""
+26 FOR BQ=1:1:$LENGTH(BTPWFIND,$CHAR(28))
Begin DoDot:1
+27 NEW PDATA,NAME,VALUE,BP,BV
+28 SET PDATA=$PIECE(BTPWFIND,$CHAR(28),BQ)
IF PDATA=""
QUIT
+29 SET NAME=$PIECE(PDATA,"=",1)
IF NAME=""!(NAME="CMIEN")!(NAME="EVIEN")
QUIT
+30 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+31 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET BV=$PIECE(VALUE,$CHAR(29),BP)
SET @NAME=$GET(@NAME)_$SELECT(BP=1:"",1:$CHAR(29))_BV
End DoDot:1
+32 ;
+33 ;Get earliest finding date
+34 SET FNDDT=""
+35 IF BTPFNDTM]""
Begin DoDot:1
+36 NEW I,VAL,CVAL
+37 SET CVAL=""
FOR I=1:1:$LENGTH(BTPFNDTM,$CHAR(29))
IF $PIECE($GET(BTPWFNER),$CHAR(29),I)'="Y"
SET VAL=$$DATE^BQIUL1($PIECE(BTPFNDTM,$CHAR(29),I))
IF VAL'=""
IF (VAL<CVAL)!(CVAL="")
SET CVAL=VAL
+38 SET FNDDT=CVAL
End DoDot:1
+39 ;
+40 ;Get Followup Needed Values
+41 SET FOLND=""
+42 IF BTPFLND]""
Begin DoDot:1
+43 NEW I,VAL,LAST
+44 SET LAST=$PIECE(BTPFLND,$CHAR(29),$LENGTH(BTPFLND,$CHAR(29)))
+45 ;Use Existing Value if new value is NO
IF BTPWFLUN="N"
IF LAST="N"
SET FOLND="N"
QUIT
+46 IF BTPWFLUN="Y"
SET FOLND="Y"
QUIT
+47 FOR I=1:1:$LENGTH(BTPFLND,$CHAR(29))
IF $PIECE($GET(BTPWFNER),$CHAR(29),I)'="Y"
SET VAL=$PIECE(BTPFLND,$CHAR(29),I)
IF VAL]""
SET FOLND=VAL
IF FOLND="Y"
QUIT
End DoDot:1
+48 ;
+49 ;Enable/disable Follow-up Needed
+50 SET SOURCE="BTPWFLUN"
SET TYPE="C"
SET HELP=""
SET ABLE="N"
SET VALUE=""
+51 IF FNDDT]""
SET ABLE="Y"
SET VALUE=FOLND
+52 DO UP
+53 ;
+54 ;Calculate Follow-up Decision Due By
+55 SET SOURCE="BTPWFDUE"
SET TYPE="D"
SET ABLE="N"
SET HELP=""
SET VALUE=""
+56 IF FOLND="N"
SET ABLE="N"
SET VALUE=""
+57 IF FOLND="Y"
Begin DoDot:1
+58 NEW IEN,DUEDT
+59 SET ABLE="Y"
+60 SET IEN=$ORDER(^BTPW(90628,0))
IF IEN=""
QUIT
+61 SET VALUE=$$GET1^DIQ(90628,IEN_",",1.02,"E")
DO SYS^BTPWPUTL
+62 SET DUEDT=FNDDT
+63 IF DUEDT=""
SET DUEDT=$$DATE^BQIUL1("T")
+64 SET VALUE=$$FMADD^XLFDT(DUEDT,VALUE)
IF VALUE<$$DATE^BQIUL1("T")
SET VALUE=$$DATE^BQIUL1("T")
+65 SET VALUE=$$FMTE^BQIUL1(VALUE)
End DoDot:1
+66 DO UP
+67 ;
+68 ;Enable/disable Follow-up Grid
+69 SET SOURCE="BTPWFU"
SET TYPE="M"
SET ABLE="N"
SET HELP=""
SET VALUE=""
+70 IF FOLND="Y"
SET ABLE="Y"
+71 DO UP
+72 ;
+73 ;Enable/disable Notification Due By
+74 SET SOURCE="BTPWNDUE"
SET TYPE="D"
SET HELP=""
SET ABLE="N"
SET VALUE=BTPWNDUE
+75 IF FNDDT]""
Begin DoDot:1
+76 SET ABLE="Y"
+77 IF FOLND="N"
Begin DoDot:2
+78 NEW IEN,DUEDT
+79 SET IEN=$ORDER(^BTPW(90628,0))
IF IEN=""
QUIT
+80 SET VALUE=$$GET1^DIQ(90628,IEN_",",1.03,"E")
DO SYS^BTPWPUTL
+81 SET DUEDT=FNDDT
+82 IF DUEDT=""
SET DUEDT=$$DATE^BQIUL1("T")
+83 SET VALUE=$$FMADD^XLFDT(DUEDT,VALUE)
IF VALUE<$$DATE^BQIUL1("T")
SET VALUE=$$DATE^BQIUL1("T")
+84 SET VALUE=$$FMTE^BQIUL1(VALUE)
End DoDot:2
End DoDot:1
+85 DO UP
+86 ;
+87 ;Enable/disable Notifications
+88 SET SOURCE="BTPWNTY"
SET TYPE="M"
SET HELP=""
SET ABLE="N"
SET VALUE=""
+89 IF FNDDT]""
SET ABLE="Y"
+90 DO UP
+91 ;
+92 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+93 QUIT
+94 ;
NOT(DATA,BTPFLDTM,BTPWFU) ; EP -- BTPW EVENT NOT TRIGGER
+1 NEW UID,II,VALUE,BTPWNDUE,SOURCE,TYPE,ABLE,HELP
+2 NEW BTPFLDTM,BTPWPFOL,BTPWPFLD,BTPEDBY,BTPEDTM,BTPWPFCM,FOLDT,BQ
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BTPWETRG",UID))
+5 KILL @DATA
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWETRG D UNWIND^%ZTER"
+8 ;
+9 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00200HELP_TEXT"_$CHAR(30)
+10 ;
+11 ;Re-Assemble parameter list if in an array
+12 SET BTPWFU=$GET(BTPWFU,"")
+13 IF BTPWFU=""
Begin DoDot:1
+14 NEW LIST,BN
+15 SET LIST=""
SET BN=""
+16 FOR
SET BN=$ORDER(BTPWFU(BN))
IF BN=""
QUIT
SET LIST=LIST_BTPWFU(BN)
+17 KILL BTPWFU
+18 SET BTPWFU=LIST
+19 KILL LIST
End DoDot:1
+20 ;
+21 ;Parse Parameters
+22 SET (BTPFLDTM,BTPWPFOL,BTPWPFLD,BTPEDBY,BTPEDTM,BTPWPFCM)=""
+23 FOR BQ=1:1:$LENGTH(BTPWFU,$CHAR(28))
Begin DoDot:1
+24 NEW PDATA,NAME,VALUE,BP,BV
+25 SET PDATA=$PIECE(BTPWFU,$CHAR(28),BQ)
IF PDATA=""
QUIT
+26 SET NAME=$PIECE(PDATA,"=",1)
IF NAME=""!(NAME="CMIEN")!(NAME="EVIEN")
QUIT
+27 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+28 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET BV=$PIECE(VALUE,$CHAR(29),BP)
SET @NAME=$GET(@NAME)_$SELECT(BP=1:"",1:$CHAR(29))_BV
End DoDot:1
+29 ;
+30 ;Get earliest follow-up creation date
+31 SET FOLDT=""
+32 IF BTPFLDTM]""
Begin DoDot:1
+33 NEW I,VAL,CVAL
+34 SET CVAL=""
FOR I=1:1:$LENGTH(BTPFLDTM,$CHAR(29))
SET VAL=$$DATE^BQIUL1($PIECE(BTPFLDTM,$CHAR(29),I))
IF VAL'=""
IF (VAL<CVAL)!(CVAL="")
SET CVAL=VAL
+35 SET FOLDT=CVAL
End DoDot:1
+36 ;
+37 ;Patient Notification Due Date
+38 SET SOURCE="BTPWNDUE"
SET TYPE="D"
SET ABLE="N"
SET HELP=""
+39 IF FOLDT]""
Begin DoDot:1
+40 SET ABLE="Y"
+41 NEW IEN,DUEDT
+42 SET IEN=$ORDER(^BTPW(90628,0))
IF IEN=""
QUIT
+43 SET VALUE=$$GET1^DIQ(90628,IEN_",",1.03,"E")
DO SYS^BTPWPUTL
+44 SET DUEDT=FOLDT
+45 IF DUEDT=""
SET DUEDT=$$DATE^BQIUL1("T")
+46 SET VALUE=$$FMADD^XLFDT(DUEDT,VALUE)
IF VALUE<$$DATE^BQIUL1("T")
SET VALUE=$$DATE^BQIUL1("T")
+47 SET VALUE=$$FMTE^BQIUL1(VALUE)
End DoDot:1
+48 DO UP
+49 ;
+50 ;Enable/disable Notifications
+51 SET SOURCE="BTPWNTY"
SET TYPE="M"
SET HELP=""
SET ABLE="N"
SET VALUE=""
+52 IF FOLDT]""
SET ABLE="Y"
+53 DO UP
+54 ;
+55 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+56 QUIT
