Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTPWPPAT

BTPWPPAT.m

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