Routine: BTPWBTTR

BTPWBTTR ;VNGT/HS/ALA-Batch Event Trigger ; 21 Oct 2009  1:36 PM

 ;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17

INIT(DATA,BTPWPRC) ;EP -- BTPW BATCH EVENT INITIAL

 NEW UID,II,VALUE,SOURCE,IEN,TYPE,IIEN,BTPWPFND,BTPWFNTR,FNDING,ABLE,FNDING

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BTPWBTTR",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T01024PARMS"_$C(30)

 S IEN="",VALUE=""

 S IEN=$O(^BTPW(90628,1,2,"B",BTPWPRC,IEN))

 I IEN="" S BMXSEC="RPC Failed: This procedure is not on file for batch events" Q

 ; For findings, get default from Site parameters

 S SOURCE="BTPWPFND",TYPE="T",ABLE="Y" D

 . S (FNDING,VALUE)=$P($G(^BTPW(90628,1,2,IEN,1)),U,1)

 . I $P(^BTPW(90621,BTPWPRC,0),U,1)="PAP SMEAR",VALUE]"" S VALUE=VALUE_$C(28)_$P($G(^BTPW(90620.9,VALUE,0)),U) ;Include name with Paps

 . I $P(^BTPW(90621,BTPWPRC,0),U,1)="PAP SMEAR" S ABLE="Y"

 . S @SOURCE=VALUE D UP

 . ;S VALUE=FNDING_$C(29)_$P(^BTPW(90620.9,FNDING,0),U,1) D UP

 . ; for findings interpretation, get default from findings

 S SOURCE="BTPWFNTR",TYPE="C",ABLE="Y" D

 . NEW IIEN

 . S IIEN=$O(^BTPW(90621,BTPWPRC,6,"B",FNDING,"")) I IIEN="" Q

 . S VAL=$P(^BTPW(90621,BTPWPRC,6,IIEN,0),U,2)

 . S VALUE=VAL_$C(29)_$$STC^BQIUL2(90621.06,.02,VAL)

 . S @SOURCE=VALUE

 . D UP

 ; For followup event, same as selected event

 S SOURCE="BTPWPFOL",TYPE="T",ABLE="Y" D

 . ;S VALUE=BTPWPRC_$C(29)_$P(^BTPW(90621,BTPWPRC,0),U,1) D UP

 . S VALUE=$P(^BTPW(90621,BTPWPRC,0),U,1) D UP

 ; For Followup Due By Date, get from Site parameters

 S SOURCE="BTPWPFLD",TYPE="C" D

 . S VALUE=$P(^BTPW(90628,1,2,IEN,0),U,2)

 . S VALUE=VALUE

 . ;_$C(29)_$S(VALUE="24M":"2 years",VALUE="36M":"3 years",1:"1 year")

 . D UP

 ; For close reason, Event Complete = 1

 ;S SOURCE="BTPWPCLR",TYPE="C",VALUE=1_$C(29)_$$STC^BQIUL2(90620,1.04,1) D UP

 S SOURCE="BTPWPCLR",TYPE="C",VALUE=$$STC^BQIUL2(90620,1.04,1) D UP

 ; For State, it is CLOSED

 ;S SOURCE="BTPWSTGE",TYPE="C",VALUE="C"_$C(29)_"CLOSED" D UP

 S SOURCE="BTPWSTGE",TYPE="C",VALUE="CLOSED" D UP

 S SOURCE="BTPWPNOT",TYPE="T",VALUE=$P(^BTPW(90628,1,2,IEN,0),U,5) D UP

 ; For Status, it is TRACKED

 ;S SOURCE="BTPWSTAT",TYPE="C",VALUE="T"_$C(29)_"TRACKED" D UP

 S SOURCE="BTPWSTAT",TYPE="C",VALUE="TRACKED" D UP

 S II=II+1,@DATA@(II)=$C(31)

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)

UP ; Update

 S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_$G(ABLE)_U_VALUE_$C(30)

NOT(DATA,BTPWPNOT) ; EP - BTPW TRIGGER NOTIFICATION

 NEW UID,II,VALUE,SOURCE,HELP,ABLE,REQ,CLEAR,TYPE,ABR,CLFLAG

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BTPWBTTR",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 D HDR

 S ABR=$P(^BTPW(90622,BTPWPNOT,0),U,3)

 I ABR="L"!(ABR="T") D

 . S SOURCE="BTPWTDOC",VALUE="",HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="T" D REC

 . S SOURCE="BTPWTTMP",VALUE="",HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="T" D REC

 . S SOURCE="BTPWSIGN",VALUE="",HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="P" D REC

 . S SOURCE="BTPWLNK",VALUE="",HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="X" D REC

 E  D

 . S SOURCE="BTPWTDOC",VALUE="",HELP="",ABLE="N",REQ="R",CLEAR="BTPWTDOC",CLFLAG="",TYPE="T" D REC

 . S SOURCE="BTPWTTMP",VALUE="",HELP="",ABLE="N",REQ="R",CLEAR="BTPWTTMP",CLFLAG="",TYPE="T" D REC

 . S SOURCE="BTPWSIGN",VALUE="",HELP="",ABLE="N",REQ="R",CLEAR="BTPWSIGN",CLFLAG="",TYPE="P" D REC

 . S SOURCE="BTPWLNK",VALUE="",HELP="",ABLE="N",REQ="R",CLEAR="BTPWLNK",CLFLAG="",TYPE="X" D REC

 S II=II+1,@DATA@(II)=$C(31)

STATE(DATA,BTPWSTGE,BTPWRDUE,BTPWFDUE,BTPWNDUE,BTPWFLUN,BTPWFIND) ; EP - BTPW TRIGGER STATE

 NEW UID,II,VALUE,SOURCE,HELP,ABLE,REQ,CLEAR,TYPE

 NEW BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY,FNDDT

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BTPWBTTR",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;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

 S BTPWRDUE=$$FMTE^BQIUL1($$DATE^BQIUL1(BTPWRDUE))

 S BTPWFDUE=$$FMTE^BQIUL1($$DATE^BQIUL1(BTPWFDUE))

 S BTPWNDUE=$$FMTE^BQIUL1($$DATE^BQIUL1(BTPWNDUE))

 D HDR

 I BTPWSTGE="O" D

 . S SOURCE="BTPCLREA",VALUE="",HELP="",ABLE="N",REQ="",CLEAR="BTPCLREA",CLFLAG="",TYPE="C" D REC

 . S SOURCE="BTPOTCOM",VALUE="",HELP="",ABLE="Y",REQ="",CLEAR="BTPOTCOM",CLFLAG="",TYPE="X" D REC

. ;

 . ;Enable/disable Follow-up Needed

 . I FNDDT]"" S SOURCE="BTPWFLUN",VALUE=BTPWFLUN,HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="C" D REC

. ;

 . ;Enable Follow-up Decision Due By

 . I BTPWFLUN="Y" S SOURCE="BTPWFDUE",VALUE=BTPWFDUE,HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="D" D REC

. ;

 . ;Enable Findings Due By

 . S SOURCE="BTPWRDUE",VALUE=BTPWRDUE,HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="D" D REC

. ;

 . ;Enable Findings Grid

 . S SOURCE="BTPWFIND",VALUE="",HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="M" D REC

. ;

 . ;Enable Follow-up Grid

 . I BTPWFLUN="Y" S SOURCE="BTPWFU",VALUE="",HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="M" D REC

. ;

 . ;Enable Notifications Due By

 . I FNDDT]"" S SOURCE="BTPWNDUE",VALUE=BTPWNDUE,HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="D" D REC

. ;

 . ;Enable Notifications Grid

 . I FNDDT]"" S SOURCE="BTPWNTY",VALUE="",HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="M" D REC

. ;

 I BTPWSTGE="C" D

 . S SOURCE="BTPCLREA",VALUE="",HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="T" D REC

 . S SOURCE="BTPOTCOM",VALUE="",HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="X" D REC

 . S SOURCE="BTPWFIND",VALUE="",HELP="",ABLE="N",REQ="",CLEAR="",CLFLAG="",TYPE="M" D REC

 . S SOURCE="BTPWFU",VALUE="",HELP="",ABLE="N",REQ="",CLEAR="",CLFLAG="",TYPE="M" D REC

 . S SOURCE="BTPWNTY",VALUE="",HELP="",ABLE="N",REQ="",CLEAR="",CLFLAG="",TYPE="M" D REC

 . S SOURCE="BTPWRDUE",VALUE=BTPWRDUE,HELP="",ABLE="N",REQ="",CLEAR="",CLFLAG="N",TYPE="D" D REC

 . S SOURCE="BTPWFDUE",VALUE=BTPWFDUE,HELP="",ABLE="N",REQ="",CLEAR="",CLFLAG="N",TYPE="D" D REC

 . S SOURCE="BTPWNDUE",VALUE=BTPWNDUE,HELP="",ABLE="N",REQ="",CLEAR="",CLFLAG="N",TYPE="D" D REC

 . S SOURCE="BTPWFLUN",VALUE=BTPWFLUN,HELP="",ABLE="N",REQ="",CLEAR="",CLFLAG="N",TYPE="C" D REC

 S II=II+1,@DATA@(II)=$C(31)

HDR ; Header

 S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00030PROP_VALUE^T00001ABLE_FLAG^T00001REQ_OPT^T00200HELP_TEXT^T01024CLEAR_FIELDS^T00001CLEAR_FLAG"_$C(30)

REC ; Record

 S II=II+1,@DATA@(II)=$G(SOURCE)_U_$G(TYPE)_U_$G(VALUE)_U_U_$G(ABLE)_U_$G(REQ)_U_$G(HELP)_U_$G(CLEAR)_U_$G(CLFLAG)_$C(30)

BTPWBTTR  ;VNGT/HS/ALA-Batch Event Trigger ; 21 Oct 2009  1:36 PM

 +1       ;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17

 +2       ;

 +3       ;

INIT(DATA,BTPWPRC) ;EP -- BTPW BATCH EVENT INITIAL

 +1        NEW UID,II,VALUE,SOURCE,IEN,TYPE,IIEN,BTPWPFND,BTPWFNTR,FNDING,ABLE,FNDING

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("BTPWBTTR",UID))

 +4        KILL @DATA

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER"

 +7       ;

 +8        SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T01024PARMS"_$CHAR(30)

 +9        SET IEN=""

           SET VALUE=""

 +10       SET IEN=$ORDER(^BTPW(90628,1,2,"B",BTPWPRC,IEN))

 +11       IF IEN=""

               SET BMXSEC="RPC Failed: This procedure is not on file for batch events"

               QUIT

 +12      ; For findings, get default from Site parameters

 +13       SET SOURCE="BTPWPFND"

           SET TYPE="T"

           SET ABLE="Y"

           Begin DoDot:1

 +14           SET (FNDING,VALUE)=$PIECE($GET(^BTPW(90628,1,2,IEN,1)),U,1)

 +15      ;Include name with Paps

               IF $PIECE(^BTPW(90621,BTPWPRC,0),U,1)="PAP SMEAR"

                   IF VALUE]""

                       SET VALUE=VALUE_$CHAR(28)_$PIECE($GET(^BTPW(90620.9,VALUE,0)),U)

 +16           IF $PIECE(^BTPW(90621,BTPWPRC,0),U,1)="PAP SMEAR"

                   SET ABLE="Y"

 +17           SET @SOURCE=VALUE

               DO UP

 +18      ;S VALUE=FNDING_$C(29)_$P(^BTPW(90620.9,FNDING,0),U,1) D UP

 +19      ; for findings interpretation, get default from findings

           End DoDot:1

 +20       SET SOURCE="BTPWFNTR"

           SET TYPE="C"

           SET ABLE="Y"

           Begin DoDot:1

 +21           NEW IIEN

 +22           SET IIEN=$ORDER(^BTPW(90621,BTPWPRC,6,"B",FNDING,""))

               IF IIEN=""

                   QUIT

 +23           SET VAL=$PIECE(^BTPW(90621,BTPWPRC,6,IIEN,0),U,2)

 +24           SET VALUE=VAL_$CHAR(29)_$$STC^BQIUL2(90621.06,.02,VAL)

 +25           SET @SOURCE=VALUE

 +26           DO UP

           End DoDot:1

 +27      ; For followup event, same as selected event

 +28       SET SOURCE="BTPWPFOL"

           SET TYPE="T"

           SET ABLE="Y"

           Begin DoDot:1

 +29      ;S VALUE=BTPWPRC_$C(29)_$P(^BTPW(90621,BTPWPRC,0),U,1) D UP

 +30           SET VALUE=$PIECE(^BTPW(90621,BTPWPRC,0),U,1)

               DO UP

           End DoDot:1

 +31      ; For Followup Due By Date, get from Site parameters

 +32       SET SOURCE="BTPWPFLD"

           SET TYPE="C"

           Begin DoDot:1

 +33           SET VALUE=$PIECE(^BTPW(90628,1,2,IEN,0),U,2)

 +34           SET VALUE=VALUE

 +35      ;_$C(29)_$S(VALUE="24M":"2 years",VALUE="36M":"3 years",1:"1 year")

 +36           DO UP

           End DoDot:1

 +37      ; For close reason, Event Complete = 1

 +38      ;S SOURCE="BTPWPCLR",TYPE="C",VALUE=1_$C(29)_$$STC^BQIUL2(90620,1.04,1) D UP

 +39       SET SOURCE="BTPWPCLR"

           SET TYPE="C"

           SET VALUE=$$STC^BQIUL2(90620,1.04,1)

           DO UP

 +40      ; For State, it is CLOSED

 +41      ;S SOURCE="BTPWSTGE",TYPE="C",VALUE="C"_$C(29)_"CLOSED" D UP

 +42       SET SOURCE="BTPWSTGE"

           SET TYPE="C"

           SET VALUE="CLOSED"

           DO UP

 +43       SET SOURCE="BTPWPNOT"

           SET TYPE="T"

           SET VALUE=$PIECE(^BTPW(90628,1,2,IEN,0),U,5)

           DO UP

 +44      ; For Status, it is TRACKED

 +45      ;S SOURCE="BTPWSTAT",TYPE="C",VALUE="T"_$C(29)_"TRACKED" D UP

 +46       SET SOURCE="BTPWSTAT"

           SET TYPE="C"

           SET VALUE="TRACKED"

           DO UP

 +47      ;

 +48       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +49       QUIT

 +50      ;

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_$GET(ABLE)_U_VALUE_$CHAR(30)

 +2        QUIT

 +3       ;

NOT(DATA,BTPWPNOT) ; EP - BTPW TRIGGER NOTIFICATION

 +1        NEW UID,II,VALUE,SOURCE,HELP,ABLE,REQ,CLEAR,TYPE,ABR,CLFLAG

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("BTPWBTTR",UID))

 +4        KILL @DATA

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER"

 +7       ;

 +8        DO HDR

 +9       ;

 +10       SET ABR=$PIECE(^BTPW(90622,BTPWPNOT,0),U,3)

 +11       IF ABR="L"!(ABR="T")

               Begin DoDot:1

 +12               SET SOURCE="BTPWTDOC"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ="R"

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="T"

                   DO REC

 +13               SET SOURCE="BTPWTTMP"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ="R"

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="T"

                   DO REC

 +14               SET SOURCE="BTPWSIGN"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ="R"

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="P"

                   DO REC

 +15               SET SOURCE="BTPWLNK"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ="R"

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="X"

                   DO REC

               End DoDot:1

 +16      IF '$TEST

               Begin DoDot:1

 +17               SET SOURCE="BTPWTDOC"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ="R"

                   SET CLEAR="BTPWTDOC"

                   SET CLFLAG=""

                   SET TYPE="T"

                   DO REC

 +18               SET SOURCE="BTPWTTMP"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ="R"

                   SET CLEAR="BTPWTTMP"

                   SET CLFLAG=""

                   SET TYPE="T"

                   DO REC

 +19               SET SOURCE="BTPWSIGN"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ="R"

                   SET CLEAR="BTPWSIGN"

                   SET CLFLAG=""

                   SET TYPE="P"

                   DO REC

 +20               SET SOURCE="BTPWLNK"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ="R"

                   SET CLEAR="BTPWLNK"

                   SET CLFLAG=""

                   SET TYPE="X"

                   DO REC

               End DoDot:1

 +21       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +22       QUIT

 +23      ;

STATE(DATA,BTPWSTGE,BTPWRDUE,BTPWFDUE,BTPWNDUE,BTPWFLUN,BTPWFIND) ; EP - BTPW TRIGGER STATE

 +1        NEW UID,II,VALUE,SOURCE,HELP,ABLE,REQ,CLEAR,TYPE

 +2        NEW BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY,FNDDT

 +3       ;

 +4        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +5        SET DATA=$NAME(^TMP("BTPWBTTR",UID))

 +6        KILL @DATA

 +7        SET II=0

 +8       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER"

 +9       ;

 +10      ;Re-Assemble parameter list if in an array

 +11       SET BTPWFIND=$GET(BTPWFIND,"")

 +12       IF BTPWFIND=""

               Begin DoDot:1

 +13               NEW LIST,BN

 +14               SET LIST=""

                   SET BN=""

 +15               FOR

                       SET BN=$ORDER(BTPWFIND(BN))

                       IF BN=""

                           QUIT

                       SET LIST=LIST_BTPWFIND(BN)

 +16               KILL BTPWFIND

 +17               SET BTPWFIND=LIST

 +18               KILL LIST

               End DoDot:1

 +19      ;

 +20      ;Parse Parameters

 +21       SET (BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY)=""

 +22       FOR BQ=1:1:$LENGTH(BTPWFIND,$CHAR(28))

               Begin DoDot:1

 +23               NEW PDATA,NAME,VALUE,BP,BV

 +24               SET PDATA=$PIECE(BTPWFIND,$CHAR(28),BQ)

                   IF PDATA=""

                       QUIT

 +25               SET NAME=$PIECE(PDATA,"=",1)

                   IF NAME=""!(NAME="CMIEN")!(NAME="EVIEN")

                       QUIT

 +26               SET VALUE=$PIECE(PDATA,"=",2,99)

                   IF VALUE=""

                       QUIT

 +27               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

 +28      ;

 +29      ;Get earliest finding date

 +30       SET FNDDT=""

 +31       IF BTPFNDTM]""

               Begin DoDot:1

 +32               NEW I,VAL,CVAL

 +33               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

 +34               SET FNDDT=CVAL

               End DoDot:1

 +35      ;

 +36       SET BTPWRDUE=$$FMTE^BQIUL1($$DATE^BQIUL1(BTPWRDUE))

 +37       SET BTPWFDUE=$$FMTE^BQIUL1($$DATE^BQIUL1(BTPWFDUE))

 +38       SET BTPWNDUE=$$FMTE^BQIUL1($$DATE^BQIUL1(BTPWNDUE))

 +39      ;

 +40       DO HDR

 +41       IF BTPWSTGE="O"

               Begin DoDot:1

 +42               SET SOURCE="BTPCLREA"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ=""

                   SET CLEAR="BTPCLREA"

                   SET CLFLAG=""

                   SET TYPE="C"

                   DO REC

 +43               SET SOURCE="BTPOTCOM"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ=""

                   SET CLEAR="BTPOTCOM"

                   SET CLFLAG=""

                   SET TYPE="X"

                   DO REC

 +44      ;

 +45      ;Enable/disable Follow-up Needed

 +46               IF FNDDT]""

                       SET SOURCE="BTPWFLUN"

                       SET VALUE=BTPWFLUN

                       SET HELP=""

                       SET ABLE="Y"

                       SET REQ=""

                       SET CLEAR=""

                       SET CLFLAG=""

                       SET TYPE="C"

                       DO REC

 +47      ;

 +48      ;Enable Follow-up Decision Due By

 +49               IF BTPWFLUN="Y"

                       SET SOURCE="BTPWFDUE"

                       SET VALUE=BTPWFDUE

                       SET HELP=""

                       SET ABLE="Y"

                       SET REQ=""

                       SET CLEAR=""

                       SET CLFLAG=""

                       SET TYPE="D"

                       DO REC

 +50      ;

 +51      ;Enable Findings Due By

 +52               SET SOURCE="BTPWRDUE"

                   SET VALUE=BTPWRDUE

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="D"

                   DO REC

 +53      ;

 +54      ;Enable Findings Grid

 +55               SET SOURCE="BTPWFIND"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="M"

                   DO REC

 +56      ;

 +57      ;Enable Follow-up Grid

 +58               IF BTPWFLUN="Y"

                       SET SOURCE="BTPWFU"

                       SET VALUE=""

                       SET HELP=""

                       SET ABLE="Y"

                       SET REQ=""

                       SET CLEAR=""

                       SET CLFLAG=""

                       SET TYPE="M"

                       DO REC

 +59      ;

 +60      ;Enable Notifications Due By

 +61               IF FNDDT]""

                       SET SOURCE="BTPWNDUE"

                       SET VALUE=BTPWNDUE

                       SET HELP=""

                       SET ABLE="Y"

                       SET REQ=""

                       SET CLEAR=""

                       SET CLFLAG=""

                       SET TYPE="D"

                       DO REC

 +62      ;

 +63      ;Enable Notifications Grid

 +64               IF FNDDT]""

                       SET SOURCE="BTPWNTY"

                       SET VALUE=""

                       SET HELP=""

                       SET ABLE="Y"

                       SET REQ=""

                       SET CLEAR=""

                       SET CLFLAG=""

                       SET TYPE="M"

                       DO REC

 +65      ;

               End DoDot:1

 +66      ;

 +67       IF BTPWSTGE="C"

               Begin DoDot:1

 +68               SET SOURCE="BTPCLREA"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ="R"

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="T"

                   DO REC

 +69               SET SOURCE="BTPOTCOM"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="Y"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="X"

                   DO REC

 +70               SET SOURCE="BTPWFIND"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="M"

                   DO REC

 +71               SET SOURCE="BTPWFU"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="M"

                   DO REC

 +72               SET SOURCE="BTPWNTY"

                   SET VALUE=""

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG=""

                   SET TYPE="M"

                   DO REC

 +73               SET SOURCE="BTPWRDUE"

                   SET VALUE=BTPWRDUE

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG="N"

                   SET TYPE="D"

                   DO REC

 +74               SET SOURCE="BTPWFDUE"

                   SET VALUE=BTPWFDUE

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG="N"

                   SET TYPE="D"

                   DO REC

 +75               SET SOURCE="BTPWNDUE"

                   SET VALUE=BTPWNDUE

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG="N"

                   SET TYPE="D"

                   DO REC

 +76               SET SOURCE="BTPWFLUN"

                   SET VALUE=BTPWFLUN

                   SET HELP=""

                   SET ABLE="N"

                   SET REQ=""

                   SET CLEAR=""

                   SET CLFLAG="N"

                   SET TYPE="C"

                   DO REC

               End DoDot:1

 +77      ;

 +78       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +79       QUIT

 +80      ;

HDR       ; Header

 +1        SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00030PROP_VALUE^T00001ABLE_FLAG^T00001REQ_OPT^T00200HELP_TEXT^T01024CLEAR_FIELDS^T00001CLEAR_FLAG"_$CHAR(30)

 +2        QUIT

 +3       ;

REC       ; Record

 +1        SET II=II+1

           SET @DATA@(II)=$GET(SOURCE)_U_$GET(TYPE)_U_$GET(VALUE)_U_U_$GET(ABLE)_U_$GET(REQ)_U_$GET(HELP)_U_$GET(CLEAR)_U_$GET(CLFLAG)_$CHAR(30)

 +2        QUIT

BTPWBTTR.m