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)
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_$G(ABLE)_U_VALUE_$C(30)
Q
;
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)
Q
;
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)
Q
;
HDR ; Header
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00030PROP_VALUE^T00001ABLE_FLAG^T00001REQ_OPT^T00200HELP_TEXT^T01024CLEAR_FIELDS^T00001CLEAR_FLAG"_$C(30)
Q
;
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)
Q
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
