BTPWPPAT ;VNGT/HS/ALA-Get list of procedures by patient ; 12 Feb 2009 10:23 AM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
;
RET(DATA,DFN,VIEW,STATE,CMLST) ; EP - BTPW GET CMET BY PATIENT
; Description
; Get the grid values for a specific patient for either queued or tracked events
; Input
; DFN - Patient internal entry number
; VIEW - 'T' for tracked events, 'Q' for queued events, 'N' for planned
; STATE - State or status
; CMLST - List of file IENs to include (optional)
;
NEW UID,II,RESULT,RIEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPPAT",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPPAT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S VIEW=$G(VIEW,""),STATE=$G(STATE,"")
;
;Check for IEN List
I $G(CMLST)]"" D
. N I,IEN
. F I=1:1:$L(CMLST,$C(29)) S IEN=$P(CMLST,$C(29),I) I IEN]"" S CMLST(IEN)=""
;
;Check for VIEW
I VIEW'="Q",VIEW'="N",VIEW'="T" S BMXSEC="View (Parameter) must be passed" G DONE
;
S @DATA@(II)="T00040CATEGORY^T00015STATUS^T00010STAGE^D00015EVNT_DATE^T00060EVENT^"
S @DATA@(II)=@DATA@(II)_"I00010HIDE_VISIT_IEN^I00010WH_IEN^T00035DATA_FILE^T00030RAD_CASENUM^"
S @DATA@(II)=@DATA@(II)_"I00010HIDE_CMET_IEN^T00001CMET_HIST"_$C(30)
;
I VIEW="T" D TR(DFN,STATE) G DONE
I VIEW="Q" D QU(DFN,STATE) G DONE
I VIEW="N" D PL(DFN) G DONE
;
DONE ;
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
S II=II+1,@DATA@(II)=$C(31)
Q
;
TR(DFN,STATE) ; EP - Loop through and retrieve Tracked Events
;
N RIEN,RESULT
;
;Tracked Header
S @DATA@(II)="I00010HIDE_CMET_IEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^T00060EVENT^D00015EVNT_DATE"
S @DATA@(II)=@DATA@(II)_"^I00010HIDE_EVENTTYPE_IEN^D00030RESULT^T01024HIDE_RESULT^T00050INTERPRETATION^T00050HIDE_INTERPRETATION^T01024FINDINGS^T01024HIDE_FINDINGS^D00015FINDING_DATE"
S @DATA@(II)=@DATA@(II)_"^T01024FOLLOW_UPS^T01024HIDE_FOLLOW_UPS^D00015FOLLOW_UP_DATE^T01024NOTIFICATIONS^T01024HIDE_NOTIFICATIONS^D00015NOTIFICATION_DATE"
S @DATA@(II)=@DATA@(II)_"^T00015STATE^D00030LAST_MODIFIED_DATE^T00035LAST_MODIFIED_BY^T01024FIND_SUMM"_$C(30)
;
I STATE'="" S RIEN="" F S RIEN=$O(^BTPWP("AE",DFN,STATE,RIEN)) Q:RIEN="" D
. ;
. ;If individual event request, check against list
. I $G(CMLST)]"",'$D(CMLST(RIEN)) Q
. ;
. D TREC(RIEN,.RESULT) Q:RESULT=""
. S II=II+1,@DATA@(II)=RESULT_$C(30)
I STATE="" S RIEN="" F S RIEN=$O(^BTPWP("AD",DFN,RIEN)) Q:RIEN="" D
. ;
. ;If individual event request, check against list
. I $G(CMLST)]"",'$D(CMLST(RIEN)) Q
. ;
. D TREC(RIEN,.RESULT) Q:RESULT=""
. S II=II+1,@DATA@(II)=RESULT_$C(30)
Q
;
TREC(TIEN,RESULT) ; EP - Get a tracked event record
NEW TDATA,PROC,PROCNM,CAT,VISIT,PRCDT,RES,PEV,FND,FUP,NOT,STATE,WHO,WHEN,FNDDT,FUPDT,NOTDT,QIEN,STATUS
NEW HFND,HFUP,HNOT,HRES,INT,HINT,RIEN,FSUMM
;
S RESULT=""
S TDATA=^BTPWP(TIEN,0)
;
;Status Check - Must be Tracked
S QIEN=$P(TDATA,U,14) Q:QIEN=""
S STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I") I STATUS'="",STATUS'="T" Q
;
S PROC=$P(TDATA,U,1),PROCNM=$P(^BTPW(90621,PROC,0),U,1)
S CAT=$$CAT^BTPWPDSP(PROC)
S VISIT=$P(TDATA,U,4) I VISIT="~" S VISIT=""
S PRCDT=$$FMTE^BQIUL1($P(TDATA,U,3))
S FSUMM=$$FNDS^BTPWPLND(TIEN)
;
;Result
S RES=$$LNK^BTPWPTRG(TIEN,.06),HRES=$P(RES,$C(28),2,3),RES=$P(RES,$C(28))
;
S PEV=$P(TDATA,U,11) S:PEV]"" PEV="Y" ;Preceding Event
;
S FNDDT=$$FND(TIEN) ;Latest Finding Date
S FUPDT=$$FOL(TIEN) ;Latest Follow-up Date
S NOTDT=$$NOT(TIEN) ;Latest Notification Date
;
S FND=$$FND^BTPWPEVT(TIEN),HFND=$P(FND,$C(28),2),FND=$P(FND,$C(28)) ;Findings
S FUP=$$FUP^BTPWPEVT(TIEN),HFUP=$P(FUP,$C(28),2),FUP=$P(FUP,$C(28)) ;Follow Ups
S NOT=$$NOT^BTPWPEVT(TIEN),HNOT=$P(NOT,$C(28),2),NOT=$P(NOT,$C(28)) ;Notifications
;
S INT=$$INTER^BTPWPEVT(TIEN),HINT=$P(INT,$C(26),2),INT=$P(INT,$C(26)) ;Interpretation
;
S STATE=$$GET1^DIQ(90620,TIEN_",",1.01,"E") ;STATE
I STATE="FUTURE" Q ;Do not include Future Events
;
S WHO=$$GET1^DIQ(90620,TIEN_",",1.1,"E") ;LAST MODIFIED BY
S WHEN=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.09,"I")) ;LAST MODIFIED DATE
;
S RESULT=TIEN_U_VISIT_U_CAT_U_PROCNM_U_PRCDT_U_PROC_U_RES_U_HRES_U_INT_U_HINT_U_FND_U_HFND_U_FNDDT_U_FUP_U_HFUP_U_FUPDT_U_NOT_U_HNOT_U_NOTDT_U_STATE_U_WHEN_U_WHO_U_FSUMM
Q
;
PL(DFN) ; Loop through and retrieve Planned Events
;
N RIEN,RESULT
;
;Planned Header
S @DATA@(II)="I00010HIDE_CMET_IEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^T00060PLANNED_EVENT^D00015PLANNED_EVNT_DATE^I00010HIDE_PREVIOUS_EVENT^D00030PRECEDING_EVENT^T00060HIDE_PRVEVT^T00001ORDERED^T00030HIDE_ORD_NUM^D00030HIDE_ORD_DT"_$C(30)
;
S RIEN="" F S RIEN=$O(^BTPWP("AE",DFN,"F",RIEN)) Q:RIEN="" D
. ;
. ;If individual event request, check against list
. I $G(CMLST)]"",'$D(CMLST(RIEN)) Q
. ;
. D PREC(RIEN,.RESULT)
. S II=II+1,@DATA@(II)=RESULT_$C(30)
;
Q
;
PREC(QIEN,RESULT) ; EP - Get a planned event record
NEW TDATA,PROC,PROCNM,CAT,VISIT,PTNAME,DUE,PRV,PRVEVT,ORD,ORDYN,ORDNM,ORDDT
S TDATA=$G(^BTPWP(QIEN,0)),ORD=""
S PROC=$P(TDATA,U,1),PROCNM=$P(^BTPW(90621,PROC,0),U,1)
S CAT=$$CAT^BTPWPDSP(PROC)
S VISIT=$P(TDATA,U,4) I VISIT="~" S VISIT=""
S DUE=$$FMTE^BQIUL1($P(TDATA,U,13))
S PRV=$P(TDATA,U,11) ;Previous event
S ORD=$$GET1^DIQ(90621,PROC_",",.11,"I")
I ORD]"" S ORD=$$ORD(DFN,ORD)
S ORDYN=$S(ORD]"":"Y",1:"")
S ORDNM=$P(ORD,U)
S ORDDT=$$FMTE^BQIUL1($P(ORD,U,2))
;
S (PRVDT,PRVEVT)="" I PRV]"" S PRVDT=$$GET1^DIQ(90620,PRV_",",".03","I"),PRVDT=$$FMTE^BQIUL1(PRVDT),PRVEVT=$$GET1^DIQ(90620,PRV_",",".01","E") ;Prv DT
;
;
S RESULT=QIEN_U_VISIT_U_CAT_U_PROCNM_U_DUE_U_PRV_U_PRVDT_U_PRVEVT_U_ORDYN_U_ORDNM_U_ORDDT
;
Q
;
QU(DFN,STATE) ; EP - Loop through and retrieve Queued Events
;
N RIEN,RESULT
;
;Queued Header
S @DATA@(II)="I00010HIDE_CMET_IEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^T00060EVENT^D00015EVNT_DATE^T01024EXP_EVENT^"
S @DATA@(II)=@DATA@(II)_"D00030RESULT^T01024HIDE_RESULT^T01024EXP_RESULT^T00015STATUS^T01024STATUS_COMMENT^"
S @DATA@(II)=@DATA@(II)_"D00030LAST_MODIFIED_DT^T00030LAST_MODIFIED_BY^T00070FINDING^T01024FIND_COMM"_$C(30)
;
I STATE'="" S RIEN="" F S RIEN=$O(^BTPWQ("AE",DFN,STATE,RIEN)) Q:RIEN="" D
. ;
. ;If individual event request, check against list
. I $G(CMLST)]"",'$D(CMLST(RIEN)) Q
. ;
. ;Screen out Tracked records
. ;I $$GET1^DIQ(90629,RIEN_",",.08,"I")="T" Q
. ;
. D QREC(RIEN,.RESULT)
. S II=II+1,@DATA@(II)=RESULT_$C(30)
I STATE="" S RIEN="" F S RIEN=$O(^BTPWQ("AD",DFN,RIEN)) Q:RIEN="" D
. ;
. ;If individual event request, check against list
. I $G(CMLST)]"",'$D(CMLST(RIEN)) Q
. ;
. ;Screen out Tracked records
. ;I $$GET1^DIQ(90629,RIEN_",",.08,"I")="T" Q
. ;
. D QREC(RIEN,.RESULT)
. S II=II+1,@DATA@(II)=RESULT_$C(30)
Q
;
QREC(QIEN,RESULT) ; EP - Get a queued event record
NEW TDATA,PROC,PROCNM,CAT,VISIT,PRCDT,STAT,PTNAME,SCOMM,LMDT,LMBY,RES,HRES,FCOM,FC
S TDATA=$G(^BTPWQ(QIEN,0))
S PROC=$P(TDATA,U,1),PROCNM=$P(^BTPW(90621,PROC,0),U,1)
S CAT=$$CAT^BTPWPDSP(PROC)
S STAT=$$GET1^DIQ(90629,QIEN_",",.08,"E")
S VISIT=$P(TDATA,U,4) I VISIT="~" S VISIT=""
S PRCDT=$$FMTE^BQIUL1($P(TDATA,U,3))
S LMDT=$$FMTE^BQIUL1($P(TDATA,U,11))
S LMBY=$P(TDATA,U,12)
S FIND=$$GET1^DIQ(90629,QIEN_",",1.02,"E")
S FCOMM="",FC=0 F S FC=$O(^BTPWQ(QIEN,4,FC)) Q:FC="" S FCOMM=FCOMM_^BTPWQ(QIEN,4,FC,0)_$C(10)_$C(13)
S FCOMM=$$TKO^BQIUL1(FCOMM,$C(10)_$C(13))
S TIEN=$P(TDATA,U,14),FULLR=""
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)
;
;Retrieve Status Comments
S SCOMM=$$SCOMM^BTPWPDS1(QIEN)
;
;Retrieve Result
S RES=$$QLNK^BTPWPTRG(QIEN,.06),HRES=$P(RES,$C(28),2,3),FULLR=$P(RES,$C(28),4),RES=$P(RES,$C(28))
;
;Build Result String
S RESULT=QIEN_U_VISIT_U_CAT_U_PROCNM_U_PRCDT_U_FULLE_U_RES_U_HRES_U_FULLR_U_STAT_U_SCOMM_U_LMDT_U_LMBY_U_FIND_U_FCOMM
Q
;
FND(TIEN) ;Calculate latest finding date
N FDATA,CDT,FDT,FIEN
D GETS^DIQ(90620,TIEN_",","10*","I","FDATA")
;
S FDT="",FIEN=0 F S FIEN=$O(FDATA(90620.01,FIEN)) Q:FIEN="" D
. ;
. ;Skip ENTERED IN ERROR
. I $G(FDATA(90620.01,FIEN,".08","I"))="Y" Q
. ;
. S CDT=$P($G(FDATA(90620.01,FIEN,".01","I")),".") S:CDT>FDT FDT=CDT
;
S FDT=$$FMTE^BQIUL1(FDT)
Q FDT
;
FOL(TIEN) ;Calculate latest follow-up date
;
N FDATA,CDT,FDT,FIEN
D GETS^DIQ(90620,TIEN_",","12*","I","FDATA")
;
S FDT="",FIEN="" F S FIEN=$O(FDATA(90620.012,FIEN)) Q:FIEN="" D
. ;
. ;Skip ENTERED IN ERROR
. I $G(FDATA(90620.012,FIEN,".07","I"))="Y" Q
. ;
. S CDT=$P($G(FDATA(90620.012,FIEN,".05","I")),".") S:CDT>FDT FDT=CDT
;
S FDT=$$FMTE^BQIUL1(FDT)
Q FDT
;
NOT(TIEN) ;Calculate latest notification date
;
N NDATA,CDT,NDT,NIEN
D GETS^DIQ(90620,TIEN_",","11*","I","NDATA")
;
S NDT="",NIEN="" F S NIEN=$O(NDATA(90620.011,NIEN)) Q:NIEN="" D
. ;
. ;Skip ENTERED IN ERROR
. I $G(NDATA(90620.011,NIEN,".09","I"))="Y" Q
. ;
. S CDT=$P($G(NDATA(90620.011,NIEN,".01","I")),".") S:CDT>NDT NDT=CDT
;
S NDT=$$FMTE^BQIUL1(NDT)
Q NDT
;
FLG(DFN) ; EP - Return TICKLER INDICATOR for patient
;
N TIEN,FLG
;
Q:DFN="" ""
;
S (FLG,TIEN)="" F S TIEN=$O(^BTPWP("AD",DFN,TIEN)) Q:TIEN="" D Q:FLG="T"
. S FLG=$$FLG^BTPWPDSP(TIEN) Q:FLG="T"
. S FLG=""
;
S:FLG="T" FLG="Y"
Q FLG
;
ORD(DFN,ORDITM) ;EP - Return active order information for selected test
;
NEW ORDINFO,ORLIST,CNT
;
;Pull all active orders
K ^TMP("ORR",$J)
D AGET^ORWORR("",DFN,2,"","","","")
;
;Look for duplicate order
S (ORINFO,ORLIST)="" F S ORLIST=$O(^TMP("ORR",$J,ORLIST)) Q:ORLIST="" D Q:ORINFO]""
. S CNT=.1 F S CNT=$O(^TMP("ORR",$J,ORLIST,CNT)) Q:'CNT D Q:ORINFO]""
.. NEW ORD,ORDDT,DTIEN
.. S ORD=$P($P($G(^TMP("ORR",$J,ORLIST,CNT)),U),";")
.. Q:'$D(^OR(100,ORD,.1,"B",ORDITM))
.. ;
.. ;Pull Date Desired
.. S ORDDT=""
.. S ORDDT=$$GET1^DIQ(100,ORD_",",21,"I")
.. I ORDDT="" D
... S DTIEN=$O(^OR(100,ORD,4.5,"ID","START","")) Q:DTIEN=""
... S ORDDT=$G(^OR(100,ORD,4.5,DTIEN,1))
.. S ORINFO=ORD_U_$$FMTE^BQIUL1(ORDDT)
K ^TMP("ORR",$J)
Q ORINFO
;
GORD(TIEN) ;EP - Field BTPWFUOR
;
NEW ORD,DFN,PRC
;
S ORD=""
S DFN=$$GET1^DIQ(90620,TIEN_",",.02,"I") G XGORD:DFN=""
S PRC=$$GET1^DIQ(90620,TIEN_",",.01,"I") G XGORD:PRC=""
S PRC=$$GET1^DIQ(90621,PRC_",",.11,"I")
I PRC]"" S ORD=$$ORD(DFN,PRC)
;
;No order yet
I ORD="" G XGORD
;
;Have order, return info
S ORD="Y"_$C(28)_"Order #:"_$P(ORD,U)_" Order Date: "_$P(ORD,U,2)
;
XGORD Q ORD
BTPWPPAT ;VNGT/HS/ALA-Get list of procedures by patient ; 12 Feb 2009 10:23 AM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
+3 ;
RET(DATA,DFN,VIEW,STATE,CMLST) ; EP - BTPW GET CMET BY PATIENT
+1 ; Description
+2 ; Get the grid values for a specific patient for either queued or tracked events
+3 ; Input
+4 ; DFN - Patient internal entry number
+5 ; VIEW - 'T' for tracked events, 'Q' for queued events, 'N' for planned
+6 ; STATE - State or status
+7 ; CMLST - List of file IENs to include (optional)
+8 ;
+9 NEW UID,II,RESULT,RIEN
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("BTPWPPAT",UID))
+12 KILL @DATA
+13 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+14 ;
+15 SET II=0
+16 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPPAT D UNWIND^%ZTER"
+17 ;
+18 SET VIEW=$GET(VIEW,"")
SET STATE=$GET(STATE,"")
+19 ;
+20 ;Check for IEN List
+21 IF $GET(CMLST)]""
Begin DoDot:1
+22 NEW I,IEN
+23 FOR I=1:1:$LENGTH(CMLST,$CHAR(29))
SET IEN=$PIECE(CMLST,$CHAR(29),I)
IF IEN]""
SET CMLST(IEN)=""
End DoDot:1
+24 ;
+25 ;Check for VIEW
+26 IF VIEW'="Q"
IF VIEW'="N"
IF VIEW'="T"
SET BMXSEC="View (Parameter) must be passed"
GOTO DONE
+27 ;
+28 SET @DATA@(II)="T00040CATEGORY^T00015STATUS^T00010STAGE^D00015EVNT_DATE^T00060EVENT^"
+29 SET @DATA@(II)=@DATA@(II)_"I00010HIDE_VISIT_IEN^I00010WH_IEN^T00035DATA_FILE^T00030RAD_CASENUM^"
+30 SET @DATA@(II)=@DATA@(II)_"I00010HIDE_CMET_IEN^T00001CMET_HIST"_$CHAR(30)
+31 ;
+32 IF VIEW="T"
DO TR(DFN,STATE)
GOTO DONE
+33 IF VIEW="Q"
DO QU(DFN,STATE)
GOTO DONE
+34 IF VIEW="N"
DO PL(DFN)
GOTO DONE
+35 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
TR(DFN,STATE) ; EP - Loop through and retrieve Tracked Events
+1 ;
+2 NEW RIEN,RESULT
+3 ;
+4 ;Tracked Header
+5 SET @DATA@(II)="I00010HIDE_CMET_IEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^T00060EVENT^D00015EVNT_DATE"
+6 SET @DATA@(II)=@DATA@(II)_"^I00010HIDE_EVENTTYPE_IEN^D00030RESULT^T01024HIDE_RESULT^T00050INTERPRETATION^T00050HIDE_INTERPRETATION^T01024FINDINGS^T01024HIDE_FINDINGS^D00015FINDING_DATE"
+7 SET @DATA@(II)=@DATA@(II)_"^T01024FOLLOW_UPS^T01024HIDE_FOLLOW_UPS^D00015FOLLOW_UP_DATE^T01024NOTIFICATIONS^T01024HIDE_NOTIFICATIONS^D00015NOTIFICATION_DATE"
+8 SET @DATA@(II)=@DATA@(II)_"^T00015STATE^D00030LAST_MODIFIED_DATE^T00035LAST_MODIFIED_BY^T01024FIND_SUMM"_$CHAR(30)
+9 ;
+10 IF STATE'=""
SET RIEN=""
FOR
SET RIEN=$ORDER(^BTPWP("AE",DFN,STATE,RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+11 ;
+12 ;If individual event request, check against list
+13 IF $GET(CMLST)]""
IF '$DATA(CMLST(RIEN))
QUIT
+14 ;
+15 DO TREC(RIEN,.RESULT)
IF RESULT=""
QUIT
+16 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
End DoDot:1
+17 IF STATE=""
SET RIEN=""
FOR
SET RIEN=$ORDER(^BTPWP("AD",DFN,RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+18 ;
+19 ;If individual event request, check against list
+20 IF $GET(CMLST)]""
IF '$DATA(CMLST(RIEN))
QUIT
+21 ;
+22 DO TREC(RIEN,.RESULT)
IF RESULT=""
QUIT
+23 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
End DoDot:1
+24 QUIT
+25 ;
TREC(TIEN,RESULT) ; EP - Get a tracked event record
+1 NEW TDATA,PROC,PROCNM,CAT,VISIT,PRCDT,RES,PEV,FND,FUP,NOT,STATE,WHO,WHEN,FNDDT,FUPDT,NOTDT,QIEN,STATUS
+2 NEW HFND,HFUP,HNOT,HRES,INT,HINT,RIEN,FSUMM
+3 ;
+4 SET RESULT=""
+5 SET TDATA=^BTPWP(TIEN,0)
+6 ;
+7 ;Status Check - Must be Tracked
+8 SET QIEN=$PIECE(TDATA,U,14)
IF QIEN=""
QUIT
+9 SET STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I")
IF STATUS'=""
IF STATUS'="T"
QUIT
+10 ;
+11 SET PROC=$PIECE(TDATA,U,1)
SET PROCNM=$PIECE(^BTPW(90621,PROC,0),U,1)
+12 SET CAT=$$CAT^BTPWPDSP(PROC)
+13 SET VISIT=$PIECE(TDATA,U,4)
IF VISIT="~"
SET VISIT=""
+14 SET PRCDT=$$FMTE^BQIUL1($PIECE(TDATA,U,3))
+15 SET FSUMM=$$FNDS^BTPWPLND(TIEN)
+16 ;
+17 ;Result
+18 SET RES=$$LNK^BTPWPTRG(TIEN,.06)
SET HRES=$PIECE(RES,$CHAR(28),2,3)
SET RES=$PIECE(RES,$CHAR(28))
+19 ;
+20 ;Preceding Event
SET PEV=$PIECE(TDATA,U,11)
IF PEV]""
SET PEV="Y"
+21 ;
+22 ;Latest Finding Date
SET FNDDT=$$FND(TIEN)
+23 ;Latest Follow-up Date
SET FUPDT=$$FOL(TIEN)
+24 ;Latest Notification Date
SET NOTDT=$$NOT(TIEN)
+25 ;
+26 ;Findings
SET FND=$$FND^BTPWPEVT(TIEN)
SET HFND=$PIECE(FND,$CHAR(28),2)
SET FND=$PIECE(FND,$CHAR(28))
+27 ;Follow Ups
SET FUP=$$FUP^BTPWPEVT(TIEN)
SET HFUP=$PIECE(FUP,$CHAR(28),2)
SET FUP=$PIECE(FUP,$CHAR(28))
+28 ;Notifications
SET NOT=$$NOT^BTPWPEVT(TIEN)
SET HNOT=$PIECE(NOT,$CHAR(28),2)
SET NOT=$PIECE(NOT,$CHAR(28))
+29 ;
+30 ;Interpretation
SET INT=$$INTER^BTPWPEVT(TIEN)
SET HINT=$PIECE(INT,$CHAR(26),2)
SET INT=$PIECE(INT,$CHAR(26))
+31 ;
+32 ;STATE
SET STATE=$$GET1^DIQ(90620,TIEN_",",1.01,"E")
+33 ;Do not include Future Events
IF STATE="FUTURE"
QUIT
+34 ;
+35 ;LAST MODIFIED BY
SET WHO=$$GET1^DIQ(90620,TIEN_",",1.1,"E")
+36 ;LAST MODIFIED DATE
SET WHEN=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.09,"I"))
+37 ;
+38 SET RESULT=TIEN_U_VISIT_U_CAT_U_PROCNM_U_PRCDT_U_PROC_U_RES_U_HRES_U_INT_U_HINT_U_FND_U_HFND_U_FNDDT_U_FUP_U_HFUP_U_FUPDT_U_NOT_U_HNOT_U_NOTDT_U_STATE_U_WHEN_U_WHO_U_FSUMM
+39 QUIT
+40 ;
PL(DFN) ; Loop through and retrieve Planned Events
+1 ;
+2 NEW RIEN,RESULT
+3 ;
+4 ;Planned Header
+5 SET @DATA@(II)="I00010HIDE_CMET_IEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^T00060PLANNED_EVENT^D00015PLANNED_EVNT_DATE^I00010HIDE_PREVIOUS_EVENT^D00030PRECEDING_EVENT^T00060HIDE_PRVEVT^T00001ORDERED^T00030HIDE_ORD_NUM^D00030HIDE_ORD_DT"_$CHAR(30)
+6 ;
+7 SET RIEN=""
FOR
SET RIEN=$ORDER(^BTPWP("AE",DFN,"F",RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+8 ;
+9 ;If individual event request, check against list
+10 IF $GET(CMLST)]""
IF '$DATA(CMLST(RIEN))
QUIT
+11 ;
+12 DO PREC(RIEN,.RESULT)
+13 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
End DoDot:1
+14 ;
+15 QUIT
+16 ;
PREC(QIEN,RESULT) ; EP - Get a planned event record
+1 NEW TDATA,PROC,PROCNM,CAT,VISIT,PTNAME,DUE,PRV,PRVEVT,ORD,ORDYN,ORDNM,ORDDT
+2 SET TDATA=$GET(^BTPWP(QIEN,0))
SET ORD=""
+3 SET PROC=$PIECE(TDATA,U,1)
SET PROCNM=$PIECE(^BTPW(90621,PROC,0),U,1)
+4 SET CAT=$$CAT^BTPWPDSP(PROC)
+5 SET VISIT=$PIECE(TDATA,U,4)
IF VISIT="~"
SET VISIT=""
+6 SET DUE=$$FMTE^BQIUL1($PIECE(TDATA,U,13))
+7 ;Previous event
SET PRV=$PIECE(TDATA,U,11)
+8 SET ORD=$$GET1^DIQ(90621,PROC_",",.11,"I")
+9 IF ORD]""
SET ORD=$$ORD(DFN,ORD)
+10 SET ORDYN=$SELECT(ORD]"":"Y",1:"")
+11 SET ORDNM=$PIECE(ORD,U)
+12 SET ORDDT=$$FMTE^BQIUL1($PIECE(ORD,U,2))
+13 ;
+14 ;Prv DT
SET (PRVDT,PRVEVT)=""
IF PRV]""
SET PRVDT=$$GET1^DIQ(90620,PRV_",",".03","I")
SET PRVDT=$$FMTE^BQIUL1(PRVDT)
SET PRVEVT=$$GET1^DIQ(90620,PRV_",",".01","E")
+15 ;
+16 ;
+17 SET RESULT=QIEN_U_VISIT_U_CAT_U_PROCNM_U_DUE_U_PRV_U_PRVDT_U_PRVEVT_U_ORDYN_U_ORDNM_U_ORDDT
+18 ;
+19 QUIT
+20 ;
QU(DFN,STATE) ; EP - Loop through and retrieve Queued Events
+1 ;
+2 NEW RIEN,RESULT
+3 ;
+4 ;Queued Header
+5 SET @DATA@(II)="I00010HIDE_CMET_IEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^T00060EVENT^D00015EVNT_DATE^T01024EXP_EVENT^"
+6 SET @DATA@(II)=@DATA@(II)_"D00030RESULT^T01024HIDE_RESULT^T01024EXP_RESULT^T00015STATUS^T01024STATUS_COMMENT^"
+7 SET @DATA@(II)=@DATA@(II)_"D00030LAST_MODIFIED_DT^T00030LAST_MODIFIED_BY^T00070FINDING^T01024FIND_COMM"_$CHAR(30)
+8 ;
+9 IF STATE'=""
SET RIEN=""
FOR
SET RIEN=$ORDER(^BTPWQ("AE",DFN,STATE,RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+10 ;
+11 ;If individual event request, check against list
+12 IF $GET(CMLST)]""
IF '$DATA(CMLST(RIEN))
QUIT
+13 ;
+14 ;Screen out Tracked records
+15 ;I $$GET1^DIQ(90629,RIEN_",",.08,"I")="T" Q
+16 ;
+17 DO QREC(RIEN,.RESULT)
+18 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
End DoDot:1
+19 IF STATE=""
SET RIEN=""
FOR
SET RIEN=$ORDER(^BTPWQ("AD",DFN,RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+20 ;
+21 ;If individual event request, check against list
+22 IF $GET(CMLST)]""
IF '$DATA(CMLST(RIEN))
QUIT
+23 ;
+24 ;Screen out Tracked records
+25 ;I $$GET1^DIQ(90629,RIEN_",",.08,"I")="T" Q
+26 ;
+27 DO QREC(RIEN,.RESULT)
+28 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
End DoDot:1
+29 QUIT
+30 ;
QREC(QIEN,RESULT) ; EP - Get a queued event record
+1 NEW TDATA,PROC,PROCNM,CAT,VISIT,PRCDT,STAT,PTNAME,SCOMM,LMDT,LMBY,RES,HRES,FCOM,FC
+2 SET TDATA=$GET(^BTPWQ(QIEN,0))
+3 SET PROC=$PIECE(TDATA,U,1)
SET PROCNM=$PIECE(^BTPW(90621,PROC,0),U,1)
+4 SET CAT=$$CAT^BTPWPDSP(PROC)
+5 SET STAT=$$GET1^DIQ(90629,QIEN_",",.08,"E")
+6 SET VISIT=$PIECE(TDATA,U,4)
IF VISIT="~"
SET VISIT=""
+7 SET PRCDT=$$FMTE^BQIUL1($PIECE(TDATA,U,3))
+8 SET LMDT=$$FMTE^BQIUL1($PIECE(TDATA,U,11))
+9 SET LMBY=$PIECE(TDATA,U,12)
+10 SET FIND=$$GET1^DIQ(90629,QIEN_",",1.02,"E")
+11 SET FCOMM=""
SET FC=0
FOR
SET FC=$ORDER(^BTPWQ(QIEN,4,FC))
IF FC=""
QUIT
SET FCOMM=FCOMM_^BTPWQ(QIEN,4,FC,0)_$CHAR(10)_$CHAR(13)
+12 SET FCOMM=$$TKO^BQIUL1(FCOMM,$CHAR(10)_$CHAR(13))
+13 SET TIEN=$PIECE(TDATA,U,14)
SET FULLR=""
+14 SET FULLE="Event obtained from: "_$CHAR(13)_$CHAR(10)
Begin DoDot:1
+15 SET RCIEN=$PIECE(TDATA,U,5)
SET RCFILE=$PIECE(TDATA,U,6)
+16 SET FULLE=FULLE_$PIECE(^BTPW(90621.1,RCFILE,0),"^",1)_" - "
+17 NEW FIL,FLD
+18 SET FIL=$PIECE(^BTPW(90621.1,RCFILE,0),"^",2)
SET FLD=$PIECE(^(0),"^",3)
SET TAB=$PIECE(^(0),"^",8)
+19 SET FULLE=FULLE_$$GET1^DIQ(FIL,RCIEN_",",FLD,"E")
+20 SET LIEN=$$GET1^DIQ(FIL,RCIEN_",",FLD,"I")
+21 IF TAB=80!(TAB=80.1)!(TAB=81)
Begin DoDot:2
End DoDot:2
+22 IF TAB=80
SET FULLE=FULLE_" "_$$ICD9^BQIUL3(LIEN,,4)_$CHAR(13)_$CHAR(10)
QUIT
+23 IF TAB=80.1
SET FULLE=FULLE_" "_$$ICD0^BQIUL3(LIEN,,5)_$CHAR(13)_$CHAR(10)
QUIT
+24 IF TAB=81
SET FULLE=FULLE_" "_$$ICPT^BQIUL3(LIEN,"",3)
End DoDot:1
+25 ;
+26 ;Retrieve Status Comments
+27 SET SCOMM=$$SCOMM^BTPWPDS1(QIEN)
+28 ;
+29 ;Retrieve Result
+30 SET RES=$$QLNK^BTPWPTRG(QIEN,.06)
SET HRES=$PIECE(RES,$CHAR(28),2,3)
SET FULLR=$PIECE(RES,$CHAR(28),4)
SET RES=$PIECE(RES,$CHAR(28))
+31 ;
+32 ;Build Result String
+33 SET RESULT=QIEN_U_VISIT_U_CAT_U_PROCNM_U_PRCDT_U_FULLE_U_RES_U_HRES_U_FULLR_U_STAT_U_SCOMM_U_LMDT_U_LMBY_U_FIND_U_FCOMM
+34 QUIT
+35 ;
FND(TIEN) ;Calculate latest finding date
+1 NEW FDATA,CDT,FDT,FIEN
+2 DO GETS^DIQ(90620,TIEN_",","10*","I","FDATA")
+3 ;
+4 SET FDT=""
SET FIEN=0
FOR
SET FIEN=$ORDER(FDATA(90620.01,FIEN))
IF FIEN=""
QUIT
Begin DoDot:1
+5 ;
+6 ;Skip ENTERED IN ERROR
+7 IF $GET(FDATA(90620.01,FIEN,".08","I"))="Y"
QUIT
+8 ;
+9 SET CDT=$PIECE($GET(FDATA(90620.01,FIEN,".01","I")),".")
IF CDT>FDT
SET FDT=CDT
End DoDot:1
+10 ;
+11 SET FDT=$$FMTE^BQIUL1(FDT)
+12 QUIT FDT
+13 ;
FOL(TIEN) ;Calculate latest follow-up date
+1 ;
+2 NEW FDATA,CDT,FDT,FIEN
+3 DO GETS^DIQ(90620,TIEN_",","12*","I","FDATA")
+4 ;
+5 SET FDT=""
SET FIEN=""
FOR
SET FIEN=$ORDER(FDATA(90620.012,FIEN))
IF FIEN=""
QUIT
Begin DoDot:1
+6 ;
+7 ;Skip ENTERED IN ERROR
+8 IF $GET(FDATA(90620.012,FIEN,".07","I"))="Y"
QUIT
+9 ;
+10 SET CDT=$PIECE($GET(FDATA(90620.012,FIEN,".05","I")),".")
IF CDT>FDT
SET FDT=CDT
End DoDot:1
+11 ;
+12 SET FDT=$$FMTE^BQIUL1(FDT)
+13 QUIT FDT
+14 ;
NOT(TIEN) ;Calculate latest notification date
+1 ;
+2 NEW NDATA,CDT,NDT,NIEN
+3 DO GETS^DIQ(90620,TIEN_",","11*","I","NDATA")
+4 ;
+5 SET NDT=""
SET NIEN=""
FOR
SET NIEN=$ORDER(NDATA(90620.011,NIEN))
IF NIEN=""
QUIT
Begin DoDot:1
+6 ;
+7 ;Skip ENTERED IN ERROR
+8 IF $GET(NDATA(90620.011,NIEN,".09","I"))="Y"
QUIT
+9 ;
+10 SET CDT=$PIECE($GET(NDATA(90620.011,NIEN,".01","I")),".")
IF CDT>NDT
SET NDT=CDT
End DoDot:1
+11 ;
+12 SET NDT=$$FMTE^BQIUL1(NDT)
+13 QUIT NDT
+14 ;
FLG(DFN) ; EP - Return TICKLER INDICATOR for patient
+1 ;
+2 NEW TIEN,FLG
+3 ;
+4 IF DFN=""
QUIT ""
+5 ;
+6 SET (FLG,TIEN)=""
FOR
SET TIEN=$ORDER(^BTPWP("AD",DFN,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+7 SET FLG=$$FLG^BTPWPDSP(TIEN)
IF FLG="T"
QUIT
+8 SET FLG=""
End DoDot:1
IF FLG="T"
QUIT
+9 ;
+10 IF FLG="T"
SET FLG="Y"
+11 QUIT FLG
+12 ;
ORD(DFN,ORDITM) ;EP - Return active order information for selected test
+1 ;
+2 NEW ORDINFO,ORLIST,CNT
+3 ;
+4 ;Pull all active orders
+5 KILL ^TMP("ORR",$JOB)
+6 DO AGET^ORWORR("",DFN,2,"","","","")
+7 ;
+8 ;Look for duplicate order
+9 SET (ORINFO,ORLIST)=""
FOR
SET ORLIST=$ORDER(^TMP("ORR",$JOB,ORLIST))
IF ORLIST=""
QUIT
Begin DoDot:1
+10 SET CNT=.1
FOR
SET CNT=$ORDER(^TMP("ORR",$JOB,ORLIST,CNT))
IF 'CNT
QUIT
Begin DoDot:2
+11 NEW ORD,ORDDT,DTIEN
+12 SET ORD=$PIECE($PIECE($GET(^TMP("ORR",$JOB,ORLIST,CNT)),U),";")
+13 IF '$DATA(^OR(100,ORD,.1,"B",ORDITM))
QUIT
+14 ;
+15 ;Pull Date Desired
+16 SET ORDDT=""
+17 SET ORDDT=$$GET1^DIQ(100,ORD_",",21,"I")
+18 IF ORDDT=""
Begin DoDot:3
+19 SET DTIEN=$ORDER(^OR(100,ORD,4.5,"ID","START",""))
IF DTIEN=""
QUIT
+20 SET ORDDT=$GET(^OR(100,ORD,4.5,DTIEN,1))
End DoDot:3
+21 SET ORINFO=ORD_U_$$FMTE^BQIUL1(ORDDT)
End DoDot:2
IF ORINFO]""
QUIT
End DoDot:1
IF ORINFO]""
QUIT
+22 KILL ^TMP("ORR",$JOB)
+23 QUIT ORINFO
+24 ;
GORD(TIEN) ;EP - Field BTPWFUOR
+1 ;
+2 NEW ORD,DFN,PRC
+3 ;
+4 SET ORD=""
+5 SET DFN=$$GET1^DIQ(90620,TIEN_",",.02,"I")
IF DFN=""
GOTO XGORD
+6 SET PRC=$$GET1^DIQ(90620,TIEN_",",.01,"I")
IF PRC=""
GOTO XGORD
+7 SET PRC=$$GET1^DIQ(90621,PRC_",",.11,"I")
+8 IF PRC]""
SET ORD=$$ORD(DFN,PRC)
+9 ;
+10 ;No order yet
+11 IF ORD=""
GOTO XGORD
+12 ;
+13 ;Have order, return info
+14 SET ORD="Y"_$CHAR(28)_"Order #:"_$PIECE(ORD,U)_" Order Date: "_$PIECE(ORD,U,2)
+15 ;
XGORD QUIT ORD
