BTPWETRG.m

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      ;