BTPWPTRG ;VNGT/HS/ALA-Event Worksheet Trigger ; 24 Nov 2009 11:13 AM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
;
INIT(DATA,CMIEN) ;EP -- BTPW EVENT WORKSHEET INITIAL
NEW UID,II,VALUE,SOURCE,IEN,TYPE,BTPWX,VFIEN,FLD,ACT,FDATA,ABLE,CLFLAG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPTRG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPTRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T00001CLEAR_FLAG^T01024PARMS"_$C(30)
D SRC
S SOURCE=""
F S SOURCE=$O(BTPWX(SOURCE)) Q:SOURCE="" D
. S VALUE=$P(BTPWX(SOURCE),U,1),TYPE=$P(BTPWX(SOURCE),U,2),ABLE=$P(BTPWX(SOURCE),U,3),CLFLAG=$P(BTPWX(SOURCE),U,4)
. 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_ABLE_U_CLFLAG_U_VALUE_$C(30)
Q
;
SRC ;
NEW TDATA,TDATA1,EXEC,FNDDT,CLFLAG,FOLYN
S TDATA=^BTPWP(CMIEN,0)
S TDATA1=$G(^BTPWP(CMIEN,1))
S VFIEN=$$FIND1^DIC(90506.3,"","MX","CMET Worksheet","","","ERROR")
S ORD=""
F S ORD=$O(^BQI(90506.3,VFIEN,10,"C",ORD)) Q:ORD="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.3,VFIEN,10,"C",ORD,IEN)) Q:IEN="" D
.. S CLFLAG=""
.. I $P(^BQI(90506.3,VFIEN,10,IEN,0),"^",11)'="" Q
.. S FLD=$P($G(^BQI(90506.3,VFIEN,10,IEN,3)),"^",1),TYPE=$P($G(^BQI(90506.3,VFIEN,10,IEN,1)),U,1)
.. S SOURCE=$P(^BQI(90506.3,VFIEN,10,IEN,0),"^",7)
.. S EXEC=$G(^BQI(90506.3,VFIEN,10,IEN,8))
.. S ACT=$P($G(^BQI(90506.3,VFIEN,10,IEN,1)),U,5),VALUE="",ABLE="Y"
.. I ACT="L" D
... ;S RCNN=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")
... ;S WHR=$P(^BTPWP(CMIEN,0),U,9),RDR=$P(^(0),U,10),VISIT=$P(^(0),U,4)
... S VALUE=$$LNK(CMIEN,FLD)
.. I TYPE="T"!(TYPE="C") D
... ;I VALUE="" Q
... I ACT="D" S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
... I ACT'="D" S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")
... ;S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")_$C(28)_$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
.. I TYPE="W" D
... N VAL,CN
... D GETS^DIQ(90620,CMIEN_",",FLD,"E","VAL")
... S VALUE="",CN=0 F S CN=$O(VAL(CN)) Q:'CN S VALUE=VALUE_$S(VALUE]"":$C(10),1:"")_$G(VAL(CN))
.. I TYPE'="T",TYPE'="C",TYPE'="W" D
... I VALUE'="" Q
... I TYPE="D" S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I") S:VALUE]"" VALUE=$$FMTE^BQIUL1(VALUE) Q
... I TYPE="M" S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
.. ;
.. ;Look for executable code
.. I EXEC'="" X EXEC
.. ;
.. ;Special Handling
.. ;
.. I SOURCE="BTPWPREV" S VALUE=$P(TDATA,U,11),VALUE=$S(VALUE'="":"Y"_$C(28)_"YES",1:"N"_$C(28)_"NONE")
.. I SOURCE="EVIEN" S VALUE=CMIEN
.. ;
.. ;Follow-up Recommended
.. I SOURCE="BTPWFLUN" D
... I $P($$FND^BTPWPCLO(CMIEN),U,1)=-1 S ABLE="N",VALUE="" Q
... S ABLE="Y"
.. ;
.. ;Follow-ups
.. I SOURCE="BTPWFU"!(SOURCE="BTPWFDUE") S FOLYN=$P(TDATA1,U,11) S ABLE=$S(FOLYN["Y":"Y",1:"N"),VALUE=$S(FOLYN["Y":VALUE,1:"")
.. I SOURCE="BTPWNTY",$P($$FND^BTPWPCLO(CMIEN),U,1)=-1 S ABLE="N",$P(BTPWX("BTPWNDUE"),U,3)="N"
.. S BTPWX(SOURCE)=VALUE_U_TYPE_U_ABLE_U_CLFLAG
;
;Disable necessary field if in an open state
I $P($G(BTPWX("BTPWSTGE")),U)="O" D
. ;
. ;Disable Close Reason
. S $P(BTPWX("BTPCLREA"),U,3)="N"
. ;
. I $P($$FND^BTPWPCLO(CMIEN),U)=-1 D
.. S $P(BTPWX("BTPWFU"),U,3)="N"
.. S $P(BTPWX("BTPWFLUN"),U,3)="N",$P(BTPWX("BTPWFLUN"),U,4)="Y"
.. S $P(BTPWX("BTPWFDUE"),U,3)="N",$P(BTPWX("BTPWFDUE"),U,4)="Y"
.. S $P(BTPWX("BTPWNDUE"),U,3)="N",$P(BTPWX("BTPWNDUE"),U,4)="Y"
;
;Disable Fields if in Closed State
I $P($G(BTPWX("BTPWSTGE")),U)="C" D
. S $P(BTPWX("BTPWFIND"),U,3)="N"
. S $P(BTPWX("BTPWFU"),U,3)="N"
. S $P(BTPWX("BTPWNTY"),U,3)="N"
. S $P(BTPWX("BTPWRDUE"),U,3)="N",$P(BTPWX("BTPWRDUE"),U,4)="N"
. S $P(BTPWX("BTPWFLUN"),U,3)="N",$P(BTPWX("BTPWFLUN"),U,4)="N"
. S $P(BTPWX("BTPWFDUE"),U,3)="N",$P(BTPWX("BTPWFDUE"),U,4)="N"
. S $P(BTPWX("BTPWNDUE"),U,3)="N",$P(BTPWX("BTPWNDUE"),U,4)="N"
Q
;
LNK(TRIEN,FLD) ; EP - Get links for a tracked event
NEW RCNN,RCTP,WHR,RDR,VISIT,PRCDT,LINK,RIEN,ACCN,TDATA
S RCNN=$$GET1^DIQ(90620,TRIEN_",",FLD,"I")
S RCTP=$$GET1^DIQ(90620,TRIEN_",",FLD,"E")
S PRCDT=$$GET1^DIQ(90620,TRIEN_",",.03,"I")
S PRCDT=$$FMTE^BQIUL1(PRCDT)
S TDATA=^BTPWP(TRIEN,0)
S WHR=$P(TDATA,U,9),RDR=$P(TDATA,U,10),VISIT=$P(TDATA,U,4)
S ACCN=$P(TDATA,U,15),RIEN=$P(TDATA,U,5),PREVT=$P(TDATA,U,14)
I RIEN="" S RIEN=$P($G(^BTPWQ(PREVT,0)),"^",5)
S LINK=""
I WHR'="",$P($G(^BWPCD(WHR,0)),U,5)="" S WHR=""
I WHR'="" S LINK=PRCDT_$C(28)_"WH RECORD"_$C(28)_"W:"_WHR
I RDR'="" S LINK=PRCDT_$C(28)_RCTP_$C(28)_"R:"_RDR
I ACCN'="" D
. I $E(ACCN,1,2)="WH" Q
. NEW RES
. S RES=$P($G(^AUPNVLAB(RIEN,0)),U,4)
. I RES="",$P($G(^AUPNVLAB(RIEN,11)),U,9)'="R" Q
. S LINK=PRCDT_$C(28)_RCTP_$C(28)_"L:"_RIEN
;Q PRCDT_$C(28)_RCTP_$C(28)_"V:"_VISIT
Q LINK
;
QLNK(QRIEN,FLD) ; EP - Get links for a queued event
NEW RCNN,RCTP,WHR,RDR,VISIT,PRCDT,LINK,QDATA,ACCN,RIEN,DFN
S RCNN=$$GET1^DIQ(90629,QRIEN_",",FLD,"I")
S RCTP=$$GET1^DIQ(90629,QRIEN_",",FLD,"E")
S PRCDT=$$GET1^DIQ(90629,QRIEN_",",.03,"I")
S DFN=$P(^BTPWQ(QRIEN,0),"^",2)
S PRCDT=$$FMTE^BQIUL1(PRCDT)
S QDATA=^BTPWQ(QRIEN,0),FULLR=""
S WHR=$P(QDATA,U,9),RDR=$P(QDATA,U,10),VISIT=$P(QDATA,U,4),ACCN=$P(QDATA,U,15),RIEN=$P(QDATA,U,5)
S LINK=""
I WHR'="",$P($G(^BWPCD(WHR,0)),U,5)="" S WHR=""
I WHR'="" D
. NEW DATA
. D EN^BTPWRWHP(.DATA,WHR)
. F I=1:1 Q:@DATA@(I)=$C(30) S FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
. S LINK=PRCDT_$C(28)_"WH RECORD"_$C(28)_"W:"_WHR_$C(28)_FULLR
I RDR'="" D
. NEW DATA
. D EN^BTPWRRAD(.DATA,DFN,RDR)
. F I=1:1 Q:@DATA@(I)=$C(30) S FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
. S LINK=PRCDT_$C(28)_RCTP_$C(28)_"R:"_RDR_$C(28)_FULLR
I ACCN'="" D
. I $E(ACCN,1,2)="WH" Q
. I $G(^AUPNVLAB(RIEN,0))="" Q
. NEW RES
. S RES=$P($G(^AUPNVLAB(RIEN,0)),U,4)
. NEW DATA
. D EN^BTPWRLAB(.DATA,DFN,RIEN)
. F I=1:1 Q:@DATA@(I)=$C(30) S FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
. ;I RES="",$P($G(^AUPNVLAB(RIEN,11)),U,9)'="R"
. S LINK=PRCDT_$C(28)_RCTP_$C(28)_"L:"_RIEN_$C(28)_FULLR
Q LINK
;
EXEV(QIEN) ;EP - Expanded Event
NEW TDATA,TIEN,FULLE,RCIEN,RCFILE,FIL,FLD,TAB,LIEN
S TDATA=^BTPWQ(QIEN,0)
S TIEN=$P(TDATA,U,14)
S FULLE="Event obtained from: "_$C(13)_$C(10) D
. S RCIEN=$P(TDATA,U,5),RCFILE=$P(TDATA,U,6)
. S FULLE=FULLE_$P(^BTPW(90621.1,RCFILE,0),"^",1)_" - "
. NEW FIL,FLD
. S FIL=$P(^BTPW(90621.1,RCFILE,0),"^",2),FLD=$P(^(0),"^",3),TAB=$P(^(0),"^",8)
. S FULLE=FULLE_$$GET1^DIQ(FIL,RCIEN_",",FLD,"E")
. S LIEN=$$GET1^DIQ(FIL,RCIEN_",",FLD,"I")
. I TAB=80!(TAB=80.1)!(TAB=81) D
. I TAB=80 S FULLE=FULLE_" "_$$ICD9^BQIUL3(LIEN,,4)_$C(13)_$C(10) Q
. I TAB=80.1 S FULLE=FULLE_" "_$$ICD0^BQIUL3(LIEN,,5)_$C(13)_$C(10) Q
. I TAB=81 S FULLE=FULLE_" "_$$ICPT^BQIUL3(LIEN,"",3)
Q FULLE
;
FCOMM(QIEN) ;EP - Get Findings Comments
NEW FIEN,FCOMM
S FCOMM=""
S FIEN=0
F S FIEN=$O(^BTPWQ(QIEN,4,FIEN)) Q:'FIEN D
. S FCOMM=FCOMM_$S(FCOMM]"":" ",1:"")_$G(^BTPWQ(QIEN,4,FIEN,0))
Q FCOMM
BTPWPTRG ;VNGT/HS/ALA-Event Worksheet Trigger ; 24 Nov 2009 11:13 AM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
+3 ;
INIT(DATA,CMIEN) ;EP -- BTPW EVENT WORKSHEET INITIAL
+1 NEW UID,II,VALUE,SOURCE,IEN,TYPE,BTPWX,VFIEN,FLD,ACT,FDATA,ABLE,CLFLAG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWPTRG",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPTRG D UNWIND^%ZTER"
+7 ;
+8 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T00001CLEAR_FLAG^T01024PARMS"_$CHAR(30)
+9 DO SRC
+10 SET SOURCE=""
+11 FOR
SET SOURCE=$ORDER(BTPWX(SOURCE))
IF SOURCE=""
QUIT
Begin DoDot:1
+12 SET VALUE=$PIECE(BTPWX(SOURCE),U,1)
SET TYPE=$PIECE(BTPWX(SOURCE),U,2)
SET ABLE=$PIECE(BTPWX(SOURCE),U,3)
SET CLFLAG=$PIECE(BTPWX(SOURCE),U,4)
+13 DO UP
End DoDot:1
+14 ;
+15 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+16 QUIT
+17 ;
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_ABLE_U_CLFLAG_U_VALUE_$CHAR(30)
+2 QUIT
+3 ;
SRC ;
+1 NEW TDATA,TDATA1,EXEC,FNDDT,CLFLAG,FOLYN
+2 SET TDATA=^BTPWP(CMIEN,0)
+3 SET TDATA1=$GET(^BTPWP(CMIEN,1))
+4 SET VFIEN=$$FIND1^DIC(90506.3,"","MX","CMET Worksheet","","","ERROR")
+5 SET ORD=""
+6 FOR
SET ORD=$ORDER(^BQI(90506.3,VFIEN,10,"C",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+7 SET IEN=""
+8 FOR
SET IEN=$ORDER(^BQI(90506.3,VFIEN,10,"C",ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+9 SET CLFLAG=""
+10 IF $PIECE(^BQI(90506.3,VFIEN,10,IEN,0),"^",11)'=""
QUIT
+11 SET FLD=$PIECE($GET(^BQI(90506.3,VFIEN,10,IEN,3)),"^",1)
SET TYPE=$PIECE($GET(^BQI(90506.3,VFIEN,10,IEN,1)),U,1)
+12 SET SOURCE=$PIECE(^BQI(90506.3,VFIEN,10,IEN,0),"^",7)
+13 SET EXEC=$GET(^BQI(90506.3,VFIEN,10,IEN,8))
+14 SET ACT=$PIECE($GET(^BQI(90506.3,VFIEN,10,IEN,1)),U,5)
SET VALUE=""
SET ABLE="Y"
+15 IF ACT="L"
Begin DoDot:3
+16 ;S RCNN=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")
+17 ;S WHR=$P(^BTPWP(CMIEN,0),U,9),RDR=$P(^(0),U,10),VISIT=$P(^(0),U,4)
+18 SET VALUE=$$LNK(CMIEN,FLD)
End DoDot:3
+19 IF TYPE="T"!(TYPE="C")
Begin DoDot:3
+20 ;I VALUE="" Q
+21 IF ACT="D"
SET VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
+22 IF ACT'="D"
SET VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")
+23 ;S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")_$C(28)_$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
End DoDot:3
+24 IF TYPE="W"
Begin DoDot:3
+25 NEW VAL,CN
+26 DO GETS^DIQ(90620,CMIEN_",",FLD,"E","VAL")
+27 SET VALUE=""
SET CN=0
FOR
SET CN=$ORDER(VAL(CN))
IF 'CN
QUIT
SET VALUE=VALUE_$SELECT(VALUE]"":$CHAR(10),1:"")_$GET(VAL(CN))
End DoDot:3
+28 IF TYPE'="T"
IF TYPE'="C"
IF TYPE'="W"
Begin DoDot:3
+29 IF VALUE'=""
QUIT
+30 IF TYPE="D"
SET VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")
IF VALUE]""
SET VALUE=$$FMTE^BQIUL1(VALUE)
QUIT
+31 IF TYPE="M"
SET VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
End DoDot:3
+32 ;
+33 ;Look for executable code
+34 IF EXEC'=""
XECUTE EXEC
+35 ;
+36 ;Special Handling
+37 ;
+38 IF SOURCE="BTPWPREV"
SET VALUE=$PIECE(TDATA,U,11)
SET VALUE=$SELECT(VALUE'="":"Y"_$CHAR(28)_"YES",1:"N"_$CHAR(28)_"NONE")
+39 IF SOURCE="EVIEN"
SET VALUE=CMIEN
+40 ;
+41 ;Follow-up Recommended
+42 IF SOURCE="BTPWFLUN"
Begin DoDot:3
+43 IF $PIECE($$FND^BTPWPCLO(CMIEN),U,1)=-1
SET ABLE="N"
SET VALUE=""
QUIT
+44 SET ABLE="Y"
End DoDot:3
+45 ;
+46 ;Follow-ups
+47 IF SOURCE="BTPWFU"!(SOURCE="BTPWFDUE")
SET FOLYN=$PIECE(TDATA1,U,11)
SET ABLE=$SELECT(FOLYN["Y":"Y",1:"N")
SET VALUE=$SELECT(FOLYN["Y":VALUE,1:"")
+48 IF SOURCE="BTPWNTY"
IF $PIECE($$FND^BTPWPCLO(CMIEN),U,1)=-1
SET ABLE="N"
SET $PIECE(BTPWX("BTPWNDUE"),U,3)="N"
+49 SET BTPWX(SOURCE)=VALUE_U_TYPE_U_ABLE_U_CLFLAG
End DoDot:2
End DoDot:1
+50 ;
+51 ;Disable necessary field if in an open state
+52 IF $PIECE($GET(BTPWX("BTPWSTGE")),U)="O"
Begin DoDot:1
+53 ;
+54 ;Disable Close Reason
+55 SET $PIECE(BTPWX("BTPCLREA"),U,3)="N"
+56 ;
+57 IF $PIECE($$FND^BTPWPCLO(CMIEN),U)=-1
Begin DoDot:2
+58 SET $PIECE(BTPWX("BTPWFU"),U,3)="N"
+59 SET $PIECE(BTPWX("BTPWFLUN"),U,3)="N"
SET $PIECE(BTPWX("BTPWFLUN"),U,4)="Y"
+60 SET $PIECE(BTPWX("BTPWFDUE"),U,3)="N"
SET $PIECE(BTPWX("BTPWFDUE"),U,4)="Y"
+61 SET $PIECE(BTPWX("BTPWNDUE"),U,3)="N"
SET $PIECE(BTPWX("BTPWNDUE"),U,4)="Y"
End DoDot:2
End DoDot:1
+62 ;
+63 ;Disable Fields if in Closed State
+64 IF $PIECE($GET(BTPWX("BTPWSTGE")),U)="C"
Begin DoDot:1
+65 SET $PIECE(BTPWX("BTPWFIND"),U,3)="N"
+66 SET $PIECE(BTPWX("BTPWFU"),U,3)="N"
+67 SET $PIECE(BTPWX("BTPWNTY"),U,3)="N"
+68 SET $PIECE(BTPWX("BTPWRDUE"),U,3)="N"
SET $PIECE(BTPWX("BTPWRDUE"),U,4)="N"
+69 SET $PIECE(BTPWX("BTPWFLUN"),U,3)="N"
SET $PIECE(BTPWX("BTPWFLUN"),U,4)="N"
+70 SET $PIECE(BTPWX("BTPWFDUE"),U,3)="N"
SET $PIECE(BTPWX("BTPWFDUE"),U,4)="N"
+71 SET $PIECE(BTPWX("BTPWNDUE"),U,3)="N"
SET $PIECE(BTPWX("BTPWNDUE"),U,4)="N"
End DoDot:1
+72 QUIT
+73 ;
LNK(TRIEN,FLD) ; EP - Get links for a tracked event
+1 NEW RCNN,RCTP,WHR,RDR,VISIT,PRCDT,LINK,RIEN,ACCN,TDATA
+2 SET RCNN=$$GET1^DIQ(90620,TRIEN_",",FLD,"I")
+3 SET RCTP=$$GET1^DIQ(90620,TRIEN_",",FLD,"E")
+4 SET PRCDT=$$GET1^DIQ(90620,TRIEN_",",.03,"I")
+5 SET PRCDT=$$FMTE^BQIUL1(PRCDT)
+6 SET TDATA=^BTPWP(TRIEN,0)
+7 SET WHR=$PIECE(TDATA,U,9)
SET RDR=$PIECE(TDATA,U,10)
SET VISIT=$PIECE(TDATA,U,4)
+8 SET ACCN=$PIECE(TDATA,U,15)
SET RIEN=$PIECE(TDATA,U,5)
SET PREVT=$PIECE(TDATA,U,14)
+9 IF RIEN=""
SET RIEN=$PIECE($GET(^BTPWQ(PREVT,0)),"^",5)
+10 SET LINK=""
+11 IF WHR'=""
IF $PIECE($GET(^BWPCD(WHR,0)),U,5)=""
SET WHR=""
+12 IF WHR'=""
SET LINK=PRCDT_$CHAR(28)_"WH RECORD"_$CHAR(28)_"W:"_WHR
+13 IF RDR'=""
SET LINK=PRCDT_$CHAR(28)_RCTP_$CHAR(28)_"R:"_RDR
+14 IF ACCN'=""
Begin DoDot:1
+15 IF $EXTRACT(ACCN,1,2)="WH"
QUIT
+16 NEW RES
+17 SET RES=$PIECE($GET(^AUPNVLAB(RIEN,0)),U,4)
+18 IF RES=""
IF $PIECE($GET(^AUPNVLAB(RIEN,11)),U,9)'="R"
QUIT
+19 SET LINK=PRCDT_$CHAR(28)_RCTP_$CHAR(28)_"L:"_RIEN
End DoDot:1
+20 ;Q PRCDT_$C(28)_RCTP_$C(28)_"V:"_VISIT
+21 QUIT LINK
+22 ;
QLNK(QRIEN,FLD) ; EP - Get links for a queued event
+1 NEW RCNN,RCTP,WHR,RDR,VISIT,PRCDT,LINK,QDATA,ACCN,RIEN,DFN
+2 SET RCNN=$$GET1^DIQ(90629,QRIEN_",",FLD,"I")
+3 SET RCTP=$$GET1^DIQ(90629,QRIEN_",",FLD,"E")
+4 SET PRCDT=$$GET1^DIQ(90629,QRIEN_",",.03,"I")
+5 SET DFN=$PIECE(^BTPWQ(QRIEN,0),"^",2)
+6 SET PRCDT=$$FMTE^BQIUL1(PRCDT)
+7 SET QDATA=^BTPWQ(QRIEN,0)
SET FULLR=""
+8 SET WHR=$PIECE(QDATA,U,9)
SET RDR=$PIECE(QDATA,U,10)
SET VISIT=$PIECE(QDATA,U,4)
SET ACCN=$PIECE(QDATA,U,15)
SET RIEN=$PIECE(QDATA,U,5)
+9 SET LINK=""
+10 IF WHR'=""
IF $PIECE($GET(^BWPCD(WHR,0)),U,5)=""
SET WHR=""
+11 IF WHR'=""
Begin DoDot:1
+12 NEW DATA
+13 DO EN^BTPWRWHP(.DATA,WHR)
+14 FOR I=1:1
IF @DATA@(I)=$CHAR(30)
QUIT
SET FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
+15 SET LINK=PRCDT_$CHAR(28)_"WH RECORD"_$CHAR(28)_"W:"_WHR_$CHAR(28)_FULLR
End DoDot:1
+16 IF RDR'=""
Begin DoDot:1
+17 NEW DATA
+18 DO EN^BTPWRRAD(.DATA,DFN,RDR)
+19 FOR I=1:1
IF @DATA@(I)=$CHAR(30)
QUIT
SET FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
+20 SET LINK=PRCDT_$CHAR(28)_RCTP_$CHAR(28)_"R:"_RDR_$CHAR(28)_FULLR
End DoDot:1
+21 IF ACCN'=""
Begin DoDot:1
+22 IF $EXTRACT(ACCN,1,2)="WH"
QUIT
+23 IF $GET(^AUPNVLAB(RIEN,0))=""
QUIT
+24 NEW RES
+25 SET RES=$PIECE($GET(^AUPNVLAB(RIEN,0)),U,4)
+26 NEW DATA
+27 DO EN^BTPWRLAB(.DATA,DFN,RIEN)
+28 FOR I=1:1
IF @DATA@(I)=$CHAR(30)
QUIT
SET FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
+29 ;I RES="",$P($G(^AUPNVLAB(RIEN,11)),U,9)'="R"
+30 SET LINK=PRCDT_$CHAR(28)_RCTP_$CHAR(28)_"L:"_RIEN_$CHAR(28)_FULLR
End DoDot:1
+31 QUIT LINK
+32 ;
EXEV(QIEN) ;EP - Expanded Event
+1 NEW TDATA,TIEN,FULLE,RCIEN,RCFILE,FIL,FLD,TAB,LIEN
+2 SET TDATA=^BTPWQ(QIEN,0)
+3 SET TIEN=$PIECE(TDATA,U,14)
+4 SET FULLE="Event obtained from: "_$CHAR(13)_$CHAR(10)
Begin DoDot:1
+5 SET RCIEN=$PIECE(TDATA,U,5)
SET RCFILE=$PIECE(TDATA,U,6)
+6 SET FULLE=FULLE_$PIECE(^BTPW(90621.1,RCFILE,0),"^",1)_" - "
+7 NEW FIL,FLD
+8 SET FIL=$PIECE(^BTPW(90621.1,RCFILE,0),"^",2)
SET FLD=$PIECE(^(0),"^",3)
SET TAB=$PIECE(^(0),"^",8)
+9 SET FULLE=FULLE_$$GET1^DIQ(FIL,RCIEN_",",FLD,"E")
+10 SET LIEN=$$GET1^DIQ(FIL,RCIEN_",",FLD,"I")
+11 IF TAB=80!(TAB=80.1)!(TAB=81)
Begin DoDot:2
End DoDot:2
+12 IF TAB=80
SET FULLE=FULLE_" "_$$ICD9^BQIUL3(LIEN,,4)_$CHAR(13)_$CHAR(10)
QUIT
+13 IF TAB=80.1
SET FULLE=FULLE_" "_$$ICD0^BQIUL3(LIEN,,5)_$CHAR(13)_$CHAR(10)
QUIT
+14 IF TAB=81
SET FULLE=FULLE_" "_$$ICPT^BQIUL3(LIEN,"",3)
End DoDot:1
+15 QUIT FULLE
+16 ;
FCOMM(QIEN) ;EP - Get Findings Comments
+1 NEW FIEN,FCOMM
+2 SET FCOMM=""
+3 SET FIEN=0
+4 FOR
SET FIEN=$ORDER(^BTPWQ(QIEN,4,FIEN))
IF 'FIEN
QUIT
Begin DoDot:1
+5 SET FCOMM=FCOMM_$SELECT(FCOMM]"":" ",1:"")_$GET(^BTPWQ(QIEN,4,FIEN,0))
End DoDot:1
+6 QUIT FCOMM
