BTPWPEVT ;VNGT/HS/BEE-Get the tracked events ; 21 Sep 2009 12:00 PM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
GET(DATA,CNT,SRC,PARMS) ; EP - BTPW GET TRACKED EVENTS
; Input parms
; CNT - Count of # of records to return
; SRC - Values to continue search
; PARMS - Delimited list of input vars
; -> STATE - State List (O - Open, C - Closed)
; -> TMFRAME - Time frame
; -> CAT - Cat
; -> COMM - Comm
; -> COMMTX - Comm Tax
; -> CMIEN - List of Event IENs to Return
;
NEW UID,II,COMM,BJ,CIN,RESULT,QFL,CT,VALUE,WHEN,WHO,TRN,STAGE,HDR,CLOSE,STATE,CATLST
NEW FDUE,NDUE,PCOM,PREV,PRVIEN,RDUE,OSTATE,CMIEN,TMFRAME,BDT,EDT,CAT,COMM,COMMTX
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPEVT",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPEVT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
;Re-Assemble parm list
S PARMS=$G(PARMS,"")
I PARMS="" D
. N LIST,BN
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
;
;Set incoming var
S (CAT,STATE,TMFRAME,COMM,COMMTX,CMIEN)=""
F BJ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
.N PDATA,NAME,VALUE,BP,BV
.S PDATA=$P(PARMS,$C(28),BJ) Q:PDATA=""
.S NAME=$P(PDATA,"=",1) Q:NAME=""
.S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
.F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=@NAME_$S(BP=1:"",1:$C(29))_BV
;
;Init/save orig val
S OSTATE=STATE
S SRC=$G(SRC,"")
S CNT=+$G(CNT)
;
;Handle blank state
S:STATE="" STATE="O"
;
;Set search beg/end dates
S (BDT,EDT)=""
I TMFRAME'="" D
. I $E(TMFRAME,1)=">" S TMFRAME=$E(TMFRAME,2,99),EDT=$$DATE^BQIUL1(TMFRAME) Q
. S BDT=$$DATE^BQIUL1(TMFRAME)
;
;Set Cat List Array
I CAT'="",CAT'=0 D
. F BJ=1:1:$L(CAT,$C(29)) S CIN=$P(CAT,$C(29),BJ),CATLST(CIN)=""
;
;Set Community Tax
I COMMTX'="" D CMTX^BTPWPEV1
;
;Set Comm List Array
I COMM'="" D
. F BJ=1:1:$L(COMM,$C(29)) S CIN=$P(COMM,$C(29),BJ),COMM(CIN)=$P(^AUTTCOM(CIN,0),U,1)
;
;Header
D HDR^BTPWPEV1
S @DATA@(0)=HDR_$C(30)
;
S QFL=0
;
;Search 1 - CMIEN list
I $G(CMIEN)'="" D CMIEN(CMIEN,.COMM,SRC) G DONE
;
;Search 3 - CATEGORY, STATE, VISIT DATE
I CAT'="",TMFRAME'="" D CSVD(CAT,STATE,.COMM,BDT,EDT,SRC) G DONE
;
;Search 4 - STATE, VISIT DATE
I OSTATE'="",TMFRAME'="" D SV(STATE,.COMM,BDT,EDT,SRC) G DONE
;
;Search 5 - VISIT DATE
I TMFRAME'="" D VD(.COMM,BDT,EDT,SRC) G DONE
;
;Search 6 - CATEGORY, STATE
I STATE'="",CAT'="" D STCT(.COMM,.CATLST,STATE,CAT,SRC) G DONE
;
;Search 7 - Default search on STATUS
D ST(.COMM,STATE,SRC)
;
DONE ;
I II=0,'$D(@DATA@(II)) S:$E(HDR,$L(HDR))="^" HDR=$E(HDR,1,$L(HDR)-1) S @DATA@(II)=HDR_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
CMIEN(CMIEN,COMM,OSRC) ; EP - Search 1 - List of IENs
N IEN,CT,LII,ISTRT,IFND,ILST,ITSP,RESULT,SRC
;
;Last record info
S IEN=$G(OSRC)
;
S CT=0
;FSTR
;Loop through CMIEN list (at selected point) and retrieve records
S ISTRT=1 I IEN]"" F IFND=1:1:$L(CMIEN,$C(29)) I $P(CMIEN,$C(29),IFND)=IEN S ISTRT=IFND
F ITSP=ISTRT:1:$L(CMIEN,$C(29)) S IEN=$P(CMIEN,$C(29),ITSP) D Q:QFL
. ;
. S SRC=IEN
. ;
. ;Get Event Info
. D SNG(IEN,.COMM,.RESULT) I RESULT="" Q
. S CT=CT+1 I CNT,CT=CNT S QFL=1
. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
Q
;
CSVD(CAT,STATE,COMM,BDT,EDT,OSRC) ; EP - Search 3 - CATEGORY, STATE, VISIT DATE
N CMIEN,SBDT,CT,CATP,CT,CSTRT,CFND,STSP,ST,SRC,SFND,SSTRT,CTG
;
;Last record info
S CSTRT=1,CTG=$P(OSRC,$C(29),4) I CTG]"" F CFND=1:1:$L(CAT,$C(29)) I $P(CAT,$C(29),CFND)=CTG S CSTRT=CFND
S SSTRT=1,ST=$P(OSRC,$C(29),3) I ST]"" F SFND=1:1:$L(STATE,$C(29)) I $P(STATE,$C(29),SFND)=ST S SSTRT=SFND
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S CMIEN=$P(OSRC,$C(29),1)
;
S CT=0
;
;Loop through index (at selected point) and retrieve records
S SBDT=$S($G(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
F CATP=CSTRT:1:$L(CAT,$C(29)) S CTG=$P(CAT,$C(29),CATP) D Q:QFL
. F STSP=SSTRT:1:$L(STATE,$C(29)) S ST=$P(STATE,$C(29),STSP) D Q:QFL
..F S SBDT=$O(^BTPWP("AI",CTG,ST,SBDT)) Q:(SBDT="")!((EDT]"")&(SBDT'<EDT)) D Q:QFL
... F S CMIEN=$O(^BTPWP("AI",CTG,ST,SBDT,CMIEN)) Q:CMIEN="" D Q:QFL
.... S SRC=CMIEN_$C(29)_SBDT_$C(29)_ST_$C(29)_CTG
.... ;
.... ;Get Event Info
.... D SNG(CMIEN,.COMM,.RESULT) I RESULT="" Q
.... S CT=CT+1 I CNT,CT=CNT S QFL=1
.... S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
.. S SBDT=$S(BDT]"":BDT-.001,1:"")
. S SSTRT=1
Q
;
SV(STATE,COMM,BDT,EDT,OSRC) ; EP - Search 4 - STATE, VISIT DATE
N CMIEN,SBDT,CT,STSP,SRC,SFND,ST,SSTRT
;
;Last record info
S SSTRT=1,ST=$P(OSRC,$C(29),3) I ST]"" F SFND=1:1:$L(STATE,$C(29)) I $P(STATE,$C(29),SFND)=ST S SSTRT=SFND
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S CMIEN=$P(OSRC,$C(29),1)
;
S CT=0
;
;Loop through index (at selected point) and retrieve records
S SBDT=$S($G(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
F STSP=SSTRT:1:$L(STATE,$C(29)) S ST=$P(STATE,$C(29),STSP) D Q:QFL
. F S SBDT=$O(^BTPWP("AL",ST,SBDT)) Q:(SBDT="")!((EDT]"")&(SBDT'<EDT)) D Q:QFL
.. F S CMIEN=$O(^BTPWP("AL",ST,SBDT,CMIEN)) Q:CMIEN="" D Q:QFL
... S SRC=CMIEN_$C(29)_SBDT_$C(29)_ST
... ;
... ;Get Event Info
... D SNG(CMIEN,.COMM,.RESULT) I RESULT="" Q
... S CT=CT+1 I CNT,CT=CNT S QFL=1
... S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
. S SBDT=$S(BDT]"":BDT-.001,1:"")
Q
;
;
VD(COMM,BDT,EDT,OSRC) ; EP - Search 5 - VISIT DATE
N CMIEN,SBDT,CT
;
;Last record info
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S CMIEN=$P(OSRC,$C(29),1)
;
S CT=0
;
;Loop through index (at selected point) and retrieve records
S SBDT=$S($G(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
F S SBDT=$O(^BTPWP("AH",SBDT)) Q:(SBDT="")!((EDT]"")&(SBDT'<EDT)) D Q:QFL
. F S CMIEN=$O(^BTPWP("AH",SBDT,CMIEN)) Q:CMIEN="" D Q:QFL
.. S SRC=CMIEN_$C(29)_SBDT
.. ;
.. ;Get Event Info
.. D SNG(CMIEN,.COMM,.RESULT) I RESULT="" Q
.. S CT=CT+1 I CNT,CT=CNT S QFL=1
.. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
Q
;
STCT(COMM,CTLST,STATE,CAT,OSRC) ;EP - Search 6 - CATEGORY, STATE
N ST,STSP,SRC,SFND,SSTRT,CSTRT,CFND,CATP,CT,CTG
;
;Last record info
S CSTRT=1,CTG=$P(OSRC,$C(29),3) I CTG]"" F CFND=1:1:$L(CAT,$C(29)) I $P(CAT,$C(29),CFND)=CTG S CSTRT=CFND
S SSTRT=1,ST=$P(OSRC,$C(29),2) I ST]"" F SFND=1:1:$L(STATE,$C(29)) I $P(STATE,$C(29),SFND)=ST S SSTRT=SFND
S CMIEN=$P(OSRC,$C(29),1)
;
S CT=0,QFL=0
;
;Loop through index (at selected point) and retrieve records
F CATP=CSTRT:1:$L(CAT,$C(29)) S CTG=$P(CAT,$C(29),CATP) D Q:QFL
. F STSP=SSTRT:1:$L(STATE,$C(29)) S ST=$P(STATE,$C(29),STSP) D Q:QFL
.. F S CMIEN=$O(^BTPWP("AF",CTG,ST,CMIEN)) Q:CMIEN="" D Q:QFL
... ;
... ;Get Event Info
... D SNG(CMIEN,.COMM,.RESULT) I RESULT="" Q
... S SRC=CMIEN_$C(29)_ST_$C(29)_CTG
... S CT=CT+1 I CNT'=0,CT=CNT S QFL=1
... S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
. S SSTRT=1
Q
;
ST(COMM,STATE,OSRC) ;EP - Search 7 - Default search on STATUS
N ST,STSP,SRC,SFND,SSTRT
;
;Last record info
S SSTRT=1,ST=$P(OSRC,$C(29),2) I ST]"" F SFND=1:1:$L(STATE,$C(29)) I $P(STATE,$C(29),SFND)=ST S SSTRT=SFND
S CMIEN=$P(OSRC,$C(29),1)
;
S CT=0,QFL=0
;
;Loop through index (at selected point) and retrieve records
F STSP=SSTRT:1:$L(STATE,$C(29)) S ST=$P(STATE,$C(29),STSP) D Q:QFL
. F S CMIEN=$O(^BTPWP("AC",ST,CMIEN)) Q:CMIEN="" D Q:QFL
.. D SNG(CMIEN,.COMM,.RESULT) I RESULT="" Q
.. S SRC=CMIEN_$C(29)_ST
.. S CT=CT+1 I CNT'=0,CT=CNT S QFL=1
.. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
Q
;
INTER(TIEN,WHIEN) ;EP - BTPWTINT - Return interpretation value for the event
N WHRES,WHDT,IEN
;
S (WHDT,WHRES)=""
I $G(TIEN)'="",$G(WHIEN)="" S WHIEN=$$GET1^DIQ(90620,TIEN_",",.09,"I")
I WHIEN]"" D Q:WHRES["Abnormal" WHRES
. S WHRES=$$GET1^DIQ(9002086.1,WHIEN_",",.05,"I")
. S:WHRES'="" WHRES=$$GET1^DIQ(9002086.31,WHRES_",",.21,"E")
. S WHRES=$S(WHRES="NORMAL":"Normal",WHRES="ABNORMAL":"Abnormal",WHRES="NO RESULT":"N/A",1:"")_$C(26)_"WH RECORD"
. S WHDT=$$GET1^DIQ(9002086.1,WHIEN_",",.03,"I")
;
;Loop through current findings
I $G(TIEN)'="" D
. S IEN=0 F S IEN=$O(^BTPWP(TIEN,10,IEN)) Q:'IEN D Q:WHRES["Abnormal"
.. N FDT,INT
.. ;
.. ;Skip ENTERED IN ERROR
.. I $$GET1^DIQ(90620.01,IEN_","_TIEN_",",.08,"I")="Y" Q
.. ;
.. S FDT=$$GET1^DIQ(90620.01,IEN_","_TIEN_",",.01,"I")
.. S INT=$$GET1^DIQ(90620.01,IEN_","_TIEN_",",.03,"E")
.. I INT="Abnormal" S WHRES=INT_$C(26)_"CMET" Q
.. I INT]"",FDT>WHDT S WHRES=INT_$C(26)_"CMET"
;
Q WHRES
;
SNG(CMIEN,COMM,RESULT) ; Get the basic record information for a single record
NEW DFN,PNAM,PCOM,TDATA,PROC,PROCNM,CAT,STATUS,HRN,DOB,AGE,SEX,PRCDT,RES,PEV,FND,FUP,NOT,STATE,TWHO,TWHEN,WHIEN,WHRES
NEW FNDT,FLDT,NODT,VISIT,QIEN,DPCP,HFND,HFUP,HNOT,HRES,FSUMM
;
S TDATA=$G(^BTPWP(CMIEN,0)),DFN=$P(TDATA,U,2),PCOM="",PNAM=$P(^DPT(DFN,0),"^",1)
S FSUMM=$$FNDS^BTPWPLND(CMIEN)
;
;Status Check - Must be Tracked
S QIEN=$P(TDATA,U,14)
I QIEN]"" S STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I") I STATUS'="",STATUS'="T" S RESULT="" Q
;
;Community check
S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
I COMM'="",PCOM'="",'$D(COMM(PCOM)) S RESULT="" Q
I PCOM'="" S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E") ;Comm
;
S PROC=$P(TDATA,U,1),PROCNM=$P(^BTPW(90621,PROC,0),U,1) ;Procedure/Name (Event)
S CAT=$$CAT^BTPWPDSP(PROC) ;Cat
S HRN=$TR($$HRNL^BQIULPT(DFN),";",$C(10)) ;HRN
S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I")) ;DOB
S AGE=$$AGE^BQIAGE(DFN,,1) ;Age
S SEX=$$GET1^DIQ(2,DFN_",",.02,"I") ;Sex
S PRCDT=$$FMTE^BQIUL1($P(TDATA,U,3)) ;Event Date
S VISIT=$P(TDATA,U,4)
S DPCP=$P($$DPCP^BQIULPT(DFN),U,2)
S INT=$$INTER^BTPWPEVT(CMIEN),HINT=$P(INT,$C(26),2),INT=$P(INT,$C(26))
;
;Result
S RES=$$LNK^BTPWPTRG(CMIEN,.06)
S HRES=$P(RES,$C(28),2,3),RES=$P(RES,$C(28))
;
S FND=$$FND(CMIEN),HFND=$P(FND,$C(28),2),FND=$P(FND,$C(28)) ;Findings
S FUP=$$FUP(CMIEN),HFUP=$P(FUP,$C(28),2),FUP=$P(FUP,$C(28)) ;Follow Ups
S NOT=$$NOT(CMIEN),HNOT=$P(NOT,$C(28),2),NOT=$P(NOT,$C(28)) ;Notifications
;
S STATE=$$GET1^DIQ(90620,CMIEN_",",1.01,"E") ;STATE
S TWHO=$$GET1^DIQ(90620,CMIEN_",",1.03,"E") ;TRACKED BY
S TWHEN=$$FMTE^BQIUL1($$GET1^DIQ(90620,CMIEN_",",1.02,"I")) ;TRACKED DATE/TIME
;
S RESULT=CMIEN_U_DFN_U_$$SENS^BQIULPT(DFN)_U_VISIT_U_PROC_U_HRN_U_DOB_U_$$CALR^BQIULPT(DFN)_U_CAT_U_PNAM_U_AGE_U_SEX_U_PCOM_U_DPCP_U_PROCNM_U_PRCDT_U_FND_U_HFND_U_FUP_U_HFUP_U_NOT_U_HNOT_U_STATE_U_TWHO_U_TWHEN_U_INT_U_HINT_U_RES_U_HRES_U_FSUMM
Q
;
FND(TIEN) ;EP - Calc Findings
N FND,FNDT
S FND="",FNDT=$$GET1^DIQ(90620,TIEN_",",1.05,"I") D
. N FIEN,FNODE,FVAL,FFLG,FSTR
. ;
. ;Look for findings
. S (FFLG,FIEN)=0,FSTR="" F S FIEN=$O(^BTPWP(TIEN,10,FIEN)) Q:'FIEN D
.. N FD,FV
.. ;
.. ;Skip ENTERED IN ERROR
.. I $$GET1^DIQ(90620.01,FIEN_","_TIEN_",",.08,"I")="Y" Q
.. ;
.. ;S FD=$E($$FMTE^BQIUL1($P($$GET1^DIQ(90620.01,FIEN_","_TIEN_",",.01,"I"),".")),1,11)
.. S FD=$$FMTE^BQIUL1($$GET1^DIQ(90620.01,FIEN_","_TIEN_",",.01,"I")\1)
.. S FV=$$GET1^DIQ(90620.01,FIEN_","_TIEN_",",.02,"E")
.. I FD="",FV="" Q
.. S FVAL="Finding Date: "_FD
.. S FVAL=FVAL_" Finding: "_FV,FFLG=1
.. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
. I FFLG=1 S FND="CHECK"_$C(28)_FSTR Q
. ;
. ;If no findings, check for past due
. I FFLG=0 D
.. I FNDT]"",FNDT<DT S FND="TICKLER"_$C(28)_"Entry of Finding is overdue. Due Date: "_$P($$GET1^DIQ(90620,TIEN_",",1.05,"E"),"@")
;
Q FND
;
FUP(TIEN) ;EP - Calc Follow Ups
N FUP,FNDT,FLUN
;
;Look for follow-up needed
S FLUN=$$GET1^DIQ(90620,TIEN_",",1.11,"I") I FLUN="N" Q "N/A"_$C(28)_"Follow-up Not Recommended"
;
S FUP="",FNDT=$$GET1^DIQ(90620,TIEN_",",1.06,"I") D
. N FIEN,FNODE,FVAL,FFLG,FSTR
. ;
. ;Look for follow ups
. S (FFLG,FIEN)=0,FSTR="" F S FIEN=$O(^BTPWP(TIEN,12,FIEN)) Q:'FIEN D
.. N FD,FV
.. ;
.. ;Skip ENTERED IN ERROR
.. I $$GET1^DIQ(90620.012,FIEN_","_TIEN_",",.07,"I")="Y" Q
.. ;
.. ;S FD=$E($$FMTE^BQIUL1($$GET1^DIQ(90620.012,FIEN_","_TIEN_",",.05,"I")),1,11)
.. S FD=$$FMTE^BQIUL1($$GET1^DIQ(90620.012,FIEN_","_TIEN_",",.05,"I")\1)
.. S FV=$$GET1^DIQ(90620.012,FIEN_","_TIEN_",",.02,"E")
.. I FD="",FV="" Q
.. S FVAL="Follow-Up Date: "_FD
.. S FVAL=FVAL_" Follow-Up: "_FV,FFLG=1
.. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
. I FFLG=1 S FUP="CHECK"_$C(28)_FSTR Q
. ;
. ;If no follow ups, check for past due
. I FFLG=0 D
.. I FNDT]"",FNDT<DT S FUP="TICKLER"_$C(28)_"Entry of recommended follow-up is overdue. Due Date: "_$P($$GET1^DIQ(90620,TIEN_",",1.06,"E"),"@")
;
Q FUP
;
NOT(TIEN) ;EP - Calc Notifications
N NOT,FNDT
S NOT="",FNDT=$$GET1^DIQ(90620,TIEN_",",1.07,"I") D
. N FIEN,FNODE,FVAL,FFLG,FSTR
. ;
. ;Look for notifications
. S (FFLG,FIEN)=0,FSTR="" F S FIEN=$O(^BTPWP(TIEN,11,FIEN)) Q:'FIEN D
.. N ND,NV
.. ;
.. ;Skip ENTERED IN ERROR
.. I $$GET1^DIQ(90620.011,FIEN_","_TIEN_",",.09,"I")="Y" Q
.. ;
.. ;S ND=$E($$FMTE^BQIUL1($$GET1^DIQ(90620.011,FIEN_","_TIEN_",",.01,"I")),1,11)
.. S ND=$$FMTE^BQIUL1($$GET1^DIQ(90620.011,FIEN_","_TIEN_",",.01,"I")\1)
.. S NV=$$GET1^DIQ(90620.011,FIEN_","_TIEN_",",.02,"E")
.. I ND="",NV="" Q
.. S FVAL="Notification Date: "_ND
.. S FVAL=FVAL_" Notification: "_NV,FFLG=1
.. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
. I FFLG=1 S NOT="CHECK"_$C(28)_FSTR Q
. ;
. ;If no notifications, check for past due
. I FFLG=0 D
.. I FNDT]"",FNDT<DT S NOT="TICKLER"_$C(28)_"Entry of the type of Patient Notification is overdue. Due Date: "_$P($$GET1^DIQ(90620,TIEN_",",1.07,"E"),"@")
;
Q NOT
;
STACOM(QIEN) ;EP - Get State Comments
N SIEN,SCOMM
S SCOMM=""
S SIEN=0
F S SIEN=$O(^BTPWP(QIEN,3,SIEN)) Q:'SIEN D
. S SCOMM=SCOMM_$S(SCOMM]"":" ",1:"")_$G(^BTPWP(QIEN,3,SIEN,0))
Q SCOMM
;
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
BTPWPEVT ;VNGT/HS/BEE-Get the tracked events ; 21 Sep 2009 12:00 PM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
GET(DATA,CNT,SRC,PARMS) ; EP - BTPW GET TRACKED EVENTS
+1 ; Input parms
+2 ; CNT - Count of # of records to return
+3 ; SRC - Values to continue search
+4 ; PARMS - Delimited list of input vars
+5 ; -> STATE - State List (O - Open, C - Closed)
+6 ; -> TMFRAME - Time frame
+7 ; -> CAT - Cat
+8 ; -> COMM - Comm
+9 ; -> COMMTX - Comm Tax
+10 ; -> CMIEN - List of Event IENs to Return
+11 ;
+12 NEW UID,II,COMM,BJ,CIN,RESULT,QFL,CT,VALUE,WHEN,WHO,TRN,STAGE,HDR,CLOSE,STATE,CATLST
+13 NEW FDUE,NDUE,PCOM,PREV,PRVIEN,RDUE,OSTATE,CMIEN,TMFRAME,BDT,EDT,CAT,COMM,COMMTX
+14 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+15 SET DATA=$NAME(^TMP("BTPWPEVT",UID))
+16 KILL @DATA
+17 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+18 ;
+19 SET II=0
+20 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPEVT D UNWIND^%ZTER"
+21 ;
+22 ;Re-Assemble parm list
+23 SET PARMS=$GET(PARMS,"")
+24 IF PARMS=""
Begin DoDot:1
+25 NEW LIST,BN
+26 SET LIST=""
SET BN=""
+27 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+28 KILL PARMS
+29 SET PARMS=LIST
+30 KILL LIST
End DoDot:1
+31 ;
+32 ;Set incoming var
+33 SET (CAT,STATE,TMFRAME,COMM,COMMTX,CMIEN)=""
+34 FOR BJ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+35 NEW PDATA,NAME,VALUE,BP,BV
+36 SET PDATA=$PIECE(PARMS,$CHAR(28),BJ)
IF PDATA=""
QUIT
+37 SET NAME=$PIECE(PDATA,"=",1)
IF NAME=""
QUIT
+38 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+39 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET BV=$PIECE(VALUE,$CHAR(29),BP)
SET @NAME=@NAME_$SELECT(BP=1:"",1:$CHAR(29))_BV
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+40 ;
+41 ;Init/save orig val
+42 SET OSTATE=STATE
+43 SET SRC=$GET(SRC,"")
+44 SET CNT=+$GET(CNT)
+45 ;
+46 ;Handle blank state
+47 IF STATE=""
SET STATE="O"
+48 ;
+49 ;Set search beg/end dates
+50 SET (BDT,EDT)=""
+51 IF TMFRAME'=""
Begin DoDot:1
+52 IF $EXTRACT(TMFRAME,1)=">"
SET TMFRAME=$EXTRACT(TMFRAME,2,99)
SET EDT=$$DATE^BQIUL1(TMFRAME)
QUIT
+53 SET BDT=$$DATE^BQIUL1(TMFRAME)
End DoDot:1
+54 ;
+55 ;Set Cat List Array
+56 IF CAT'=""
IF CAT'=0
Begin DoDot:1
+57 FOR BJ=1:1:$LENGTH(CAT,$CHAR(29))
SET CIN=$PIECE(CAT,$CHAR(29),BJ)
SET CATLST(CIN)=""
End DoDot:1
+58 ;
+59 ;Set Community Tax
+60 IF COMMTX'=""
DO CMTX^BTPWPEV1
+61 ;
+62 ;Set Comm List Array
+63 IF COMM'=""
Begin DoDot:1
+64 FOR BJ=1:1:$LENGTH(COMM,$CHAR(29))
SET CIN=$PIECE(COMM,$CHAR(29),BJ)
SET COMM(CIN)=$PIECE(^AUTTCOM(CIN,0),U,1)
End DoDot:1
+65 ;
+66 ;Header
+67 DO HDR^BTPWPEV1
+68 SET @DATA@(0)=HDR_$CHAR(30)
+69 ;
+70 SET QFL=0
+71 ;
+72 ;Search 1 - CMIEN list
+73 IF $GET(CMIEN)'=""
DO CMIEN(CMIEN,.COMM,SRC)
GOTO DONE
+74 ;
+75 ;Search 3 - CATEGORY, STATE, VISIT DATE
+76 IF CAT'=""
IF TMFRAME'=""
DO CSVD(CAT,STATE,.COMM,BDT,EDT,SRC)
GOTO DONE
+77 ;
+78 ;Search 4 - STATE, VISIT DATE
+79 IF OSTATE'=""
IF TMFRAME'=""
DO SV(STATE,.COMM,BDT,EDT,SRC)
GOTO DONE
+80 ;
+81 ;Search 5 - VISIT DATE
+82 IF TMFRAME'=""
DO VD(.COMM,BDT,EDT,SRC)
GOTO DONE
+83 ;
+84 ;Search 6 - CATEGORY, STATE
+85 IF STATE'=""
IF CAT'=""
DO STCT(.COMM,.CATLST,STATE,CAT,SRC)
GOTO DONE
+86 ;
+87 ;Search 7 - Default search on STATUS
+88 DO ST(.COMM,STATE,SRC)
+89 ;
DONE ;
+1 IF II=0
IF '$DATA(@DATA@(II))
IF $EXTRACT(HDR,$LENGTH(HDR))="^"
SET HDR=$EXTRACT(HDR,1,$LENGTH(HDR)-1)
SET @DATA@(II)=HDR_$CHAR(30)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
CMIEN(CMIEN,COMM,OSRC) ; EP - Search 1 - List of IENs
+1 NEW IEN,CT,LII,ISTRT,IFND,ILST,ITSP,RESULT,SRC
+2 ;
+3 ;Last record info
+4 SET IEN=$GET(OSRC)
+5 ;
+6 SET CT=0
+7 ;FSTR
+8 ;Loop through CMIEN list (at selected point) and retrieve records
+9 SET ISTRT=1
IF IEN]""
FOR IFND=1:1:$LENGTH(CMIEN,$CHAR(29))
IF $PIECE(CMIEN,$CHAR(29),IFND)=IEN
SET ISTRT=IFND
+10 FOR ITSP=ISTRT:1:$LENGTH(CMIEN,$CHAR(29))
SET IEN=$PIECE(CMIEN,$CHAR(29),ITSP)
Begin DoDot:1
+11 ;
+12 SET SRC=IEN
+13 ;
+14 ;Get Event Info
+15 DO SNG(IEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+16 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
+17 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:1
IF QFL
QUIT
+18 QUIT
+19 ;
CSVD(CAT,STATE,COMM,BDT,EDT,OSRC) ; EP - Search 3 - CATEGORY, STATE, VISIT DATE
+1 NEW CMIEN,SBDT,CT,CATP,CT,CSTRT,CFND,STSP,ST,SRC,SFND,SSTRT,CTG
+2 ;
+3 ;Last record info
+4 SET CSTRT=1
SET CTG=$PIECE(OSRC,$CHAR(29),4)
IF CTG]""
FOR CFND=1:1:$LENGTH(CAT,$CHAR(29))
IF $PIECE(CAT,$CHAR(29),CFND)=CTG
SET CSTRT=CFND
+5 SET SSTRT=1
SET ST=$PIECE(OSRC,$CHAR(29),3)
IF ST]""
FOR SFND=1:1:$LENGTH(STATE,$CHAR(29))
IF $PIECE(STATE,$CHAR(29),SFND)=ST
SET SSTRT=SFND
+6 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+7 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
+8 ;
+9 SET CT=0
+10 ;
+11 ;Loop through index (at selected point) and retrieve records
+12 SET SBDT=$SELECT($GET(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
+13 FOR CATP=CSTRT:1:$LENGTH(CAT,$CHAR(29))
SET CTG=$PIECE(CAT,$CHAR(29),CATP)
Begin DoDot:1
+14 FOR STSP=SSTRT:1:$LENGTH(STATE,$CHAR(29))
SET ST=$PIECE(STATE,$CHAR(29),STSP)
Begin DoDot:2
+15 FOR
SET SBDT=$ORDER(^BTPWP("AI",CTG,ST,SBDT))
IF (SBDT="")!((EDT]"")&(SBDT'<EDT))
QUIT
Begin DoDot:3
+16 FOR
SET CMIEN=$ORDER(^BTPWP("AI",CTG,ST,SBDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:4
+17 SET SRC=CMIEN_$CHAR(29)_SBDT_$CHAR(29)_ST_$CHAR(29)_CTG
+18 ;
+19 ;Get Event Info
+20 DO SNG(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+21 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
+22 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:4
IF QFL
QUIT
End DoDot:3
IF QFL
QUIT
+23 SET SBDT=$SELECT(BDT]"":BDT-.001,1:"")
End DoDot:2
IF QFL
QUIT
+24 SET SSTRT=1
End DoDot:1
IF QFL
QUIT
+25 QUIT
+26 ;
SV(STATE,COMM,BDT,EDT,OSRC) ; EP - Search 4 - STATE, VISIT DATE
+1 NEW CMIEN,SBDT,CT,STSP,SRC,SFND,ST,SSTRT
+2 ;
+3 ;Last record info
+4 SET SSTRT=1
SET ST=$PIECE(OSRC,$CHAR(29),3)
IF ST]""
FOR SFND=1:1:$LENGTH(STATE,$CHAR(29))
IF $PIECE(STATE,$CHAR(29),SFND)=ST
SET SSTRT=SFND
+5 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+6 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
+7 ;
+8 SET CT=0
+9 ;
+10 ;Loop through index (at selected point) and retrieve records
+11 SET SBDT=$SELECT($GET(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
+12 FOR STSP=SSTRT:1:$LENGTH(STATE,$CHAR(29))
SET ST=$PIECE(STATE,$CHAR(29),STSP)
Begin DoDot:1
+13 FOR
SET SBDT=$ORDER(^BTPWP("AL",ST,SBDT))
IF (SBDT="")!((EDT]"")&(SBDT'<EDT))
QUIT
Begin DoDot:2
+14 FOR
SET CMIEN=$ORDER(^BTPWP("AL",ST,SBDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:3
+15 SET SRC=CMIEN_$CHAR(29)_SBDT_$CHAR(29)_ST
+16 ;
+17 ;Get Event Info
+18 DO SNG(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+19 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
+20 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
+21 SET SBDT=$SELECT(BDT]"":BDT-.001,1:"")
End DoDot:1
IF QFL
QUIT
+22 QUIT
+23 ;
+24 ;
VD(COMM,BDT,EDT,OSRC) ; EP - Search 5 - VISIT DATE
+1 NEW CMIEN,SBDT,CT
+2 ;
+3 ;Last record info
+4 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+5 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
+6 ;
+7 SET CT=0
+8 ;
+9 ;Loop through index (at selected point) and retrieve records
+10 SET SBDT=$SELECT($GET(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
+11 FOR
SET SBDT=$ORDER(^BTPWP("AH",SBDT))
IF (SBDT="")!((EDT]"")&(SBDT'<EDT))
QUIT
Begin DoDot:1
+12 FOR
SET CMIEN=$ORDER(^BTPWP("AH",SBDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:2
+13 SET SRC=CMIEN_$CHAR(29)_SBDT
+14 ;
+15 ;Get Event Info
+16 DO SNG(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+17 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
+18 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+19 QUIT
+20 ;
STCT(COMM,CTLST,STATE,CAT,OSRC) ;EP - Search 6 - CATEGORY, STATE
+1 NEW ST,STSP,SRC,SFND,SSTRT,CSTRT,CFND,CATP,CT,CTG
+2 ;
+3 ;Last record info
+4 SET CSTRT=1
SET CTG=$PIECE(OSRC,$CHAR(29),3)
IF CTG]""
FOR CFND=1:1:$LENGTH(CAT,$CHAR(29))
IF $PIECE(CAT,$CHAR(29),CFND)=CTG
SET CSTRT=CFND
+5 SET SSTRT=1
SET ST=$PIECE(OSRC,$CHAR(29),2)
IF ST]""
FOR SFND=1:1:$LENGTH(STATE,$CHAR(29))
IF $PIECE(STATE,$CHAR(29),SFND)=ST
SET SSTRT=SFND
+6 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
+7 ;
+8 SET CT=0
SET QFL=0
+9 ;
+10 ;Loop through index (at selected point) and retrieve records
+11 FOR CATP=CSTRT:1:$LENGTH(CAT,$CHAR(29))
SET CTG=$PIECE(CAT,$CHAR(29),CATP)
Begin DoDot:1
+12 FOR STSP=SSTRT:1:$LENGTH(STATE,$CHAR(29))
SET ST=$PIECE(STATE,$CHAR(29),STSP)
Begin DoDot:2
+13 FOR
SET CMIEN=$ORDER(^BTPWP("AF",CTG,ST,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:3
+14 ;
+15 ;Get Event Info
+16 DO SNG(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+17 SET SRC=CMIEN_$CHAR(29)_ST_$CHAR(29)_CTG
+18 SET CT=CT+1
IF CNT'=0
IF CT=CNT
SET QFL=1
+19 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
+20 SET SSTRT=1
End DoDot:1
IF QFL
QUIT
+21 QUIT
+22 ;
ST(COMM,STATE,OSRC) ;EP - Search 7 - Default search on STATUS
+1 NEW ST,STSP,SRC,SFND,SSTRT
+2 ;
+3 ;Last record info
+4 SET SSTRT=1
SET ST=$PIECE(OSRC,$CHAR(29),2)
IF ST]""
FOR SFND=1:1:$LENGTH(STATE,$CHAR(29))
IF $PIECE(STATE,$CHAR(29),SFND)=ST
SET SSTRT=SFND
+5 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
+6 ;
+7 SET CT=0
SET QFL=0
+8 ;
+9 ;Loop through index (at selected point) and retrieve records
+10 FOR STSP=SSTRT:1:$LENGTH(STATE,$CHAR(29))
SET ST=$PIECE(STATE,$CHAR(29),STSP)
Begin DoDot:1
+11 FOR
SET CMIEN=$ORDER(^BTPWP("AC",ST,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:2
+12 DO SNG(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+13 SET SRC=CMIEN_$CHAR(29)_ST
+14 SET CT=CT+1
IF CNT'=0
IF CT=CNT
SET QFL=1
+15 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+16 QUIT
+17 ;
INTER(TIEN,WHIEN) ;EP - BTPWTINT - Return interpretation value for the event
+1 NEW WHRES,WHDT,IEN
+2 ;
+3 SET (WHDT,WHRES)=""
+4 IF $GET(TIEN)'=""
IF $GET(WHIEN)=""
SET WHIEN=$$GET1^DIQ(90620,TIEN_",",.09,"I")
+5 IF WHIEN]""
Begin DoDot:1
+6 SET WHRES=$$GET1^DIQ(9002086.1,WHIEN_",",.05,"I")
+7 IF WHRES'=""
SET WHRES=$$GET1^DIQ(9002086.31,WHRES_",",.21,"E")
+8 SET WHRES=$SELECT(WHRES="NORMAL":"Normal",WHRES="ABNORMAL":"Abnormal",WHRES="NO RESULT":"N/A",1:"")_$CHAR(26)_"WH RECORD"
+9 SET WHDT=$$GET1^DIQ(9002086.1,WHIEN_",",.03,"I")
End DoDot:1
IF WHRES["Abnormal"
QUIT WHRES
+10 ;
+11 ;Loop through current findings
+12 IF $GET(TIEN)'=""
Begin DoDot:1
+13 SET IEN=0
FOR
SET IEN=$ORDER(^BTPWP(TIEN,10,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+14 NEW FDT,INT
+15 ;
+16 ;Skip ENTERED IN ERROR
+17 IF $$GET1^DIQ(90620.01,IEN_","_TIEN_",",.08,"I")="Y"
QUIT
+18 ;
+19 SET FDT=$$GET1^DIQ(90620.01,IEN_","_TIEN_",",.01,"I")
+20 SET INT=$$GET1^DIQ(90620.01,IEN_","_TIEN_",",.03,"E")
+21 IF INT="Abnormal"
SET WHRES=INT_$CHAR(26)_"CMET"
QUIT
+22 IF INT]""
IF FDT>WHDT
SET WHRES=INT_$CHAR(26)_"CMET"
End DoDot:2
IF WHRES["Abnormal"
QUIT
End DoDot:1
+23 ;
+24 QUIT WHRES
+25 ;
SNG(CMIEN,COMM,RESULT) ; Get the basic record information for a single record
+1 NEW DFN,PNAM,PCOM,TDATA,PROC,PROCNM,CAT,STATUS,HRN,DOB,AGE,SEX,PRCDT,RES,PEV,FND,FUP,NOT,STATE,TWHO,TWHEN,WHIEN,WHRES
+2 NEW FNDT,FLDT,NODT,VISIT,QIEN,DPCP,HFND,HFUP,HNOT,HRES,FSUMM
+3 ;
+4 SET TDATA=$GET(^BTPWP(CMIEN,0))
SET DFN=$PIECE(TDATA,U,2)
SET PCOM=""
SET PNAM=$PIECE(^DPT(DFN,0),"^",1)
+5 SET FSUMM=$$FNDS^BTPWPLND(CMIEN)
+6 ;
+7 ;Status Check - Must be Tracked
+8 SET QIEN=$PIECE(TDATA,U,14)
+9 IF QIEN]""
SET STATUS=$$GET1^DIQ(90629,QIEN_",",.08,"I")
IF STATUS'=""
IF STATUS'="T"
SET RESULT=""
QUIT
+10 ;
+11 ;Community check
+12 SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
+13 IF COMM'=""
IF PCOM'=""
IF '$DATA(COMM(PCOM))
SET RESULT=""
QUIT
+14 ;Comm
IF PCOM'=""
SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E")
+15 ;
+16 ;Procedure/Name (Event)
SET PROC=$PIECE(TDATA,U,1)
SET PROCNM=$PIECE(^BTPW(90621,PROC,0),U,1)
+17 ;Cat
SET CAT=$$CAT^BTPWPDSP(PROC)
+18 ;HRN
SET HRN=$TRANSLATE($$HRNL^BQIULPT(DFN),";",$CHAR(10))
+19 ;DOB
SET DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
+20 ;Age
SET AGE=$$AGE^BQIAGE(DFN,,1)
+21 ;Sex
SET SEX=$$GET1^DIQ(2,DFN_",",.02,"I")
+22 ;Event Date
SET PRCDT=$$FMTE^BQIUL1($PIECE(TDATA,U,3))
+23 SET VISIT=$PIECE(TDATA,U,4)
+24 SET DPCP=$PIECE($$DPCP^BQIULPT(DFN),U,2)
+25 SET INT=$$INTER^BTPWPEVT(CMIEN)
SET HINT=$PIECE(INT,$CHAR(26),2)
SET INT=$PIECE(INT,$CHAR(26))
+26 ;
+27 ;Result
+28 SET RES=$$LNK^BTPWPTRG(CMIEN,.06)
+29 SET HRES=$PIECE(RES,$CHAR(28),2,3)
SET RES=$PIECE(RES,$CHAR(28))
+30 ;
+31 ;Findings
SET FND=$$FND(CMIEN)
SET HFND=$PIECE(FND,$CHAR(28),2)
SET FND=$PIECE(FND,$CHAR(28))
+32 ;Follow Ups
SET FUP=$$FUP(CMIEN)
SET HFUP=$PIECE(FUP,$CHAR(28),2)
SET FUP=$PIECE(FUP,$CHAR(28))
+33 ;Notifications
SET NOT=$$NOT(CMIEN)
SET HNOT=$PIECE(NOT,$CHAR(28),2)
SET NOT=$PIECE(NOT,$CHAR(28))
+34 ;
+35 ;STATE
SET STATE=$$GET1^DIQ(90620,CMIEN_",",1.01,"E")
+36 ;TRACKED BY
SET TWHO=$$GET1^DIQ(90620,CMIEN_",",1.03,"E")
+37 ;TRACKED DATE/TIME
SET TWHEN=$$FMTE^BQIUL1($$GET1^DIQ(90620,CMIEN_",",1.02,"I"))
+38 ;
+39 SET RESULT=CMIEN_U_DFN_U_$$SENS^BQIULPT(DFN)_U_VISIT_U_PROC_U_HRN_U_DOB_U_$$CALR^BQIULPT(DFN)_U_CAT_U_PNAM_U_AGE_U_SEX_U_PCOM_U_DPCP_U_PROCNM_U_PRCDT_U_FND_U_HFND_U_FUP_U_HFUP_U_NOT_U_HNOT_U_STATE_U_TWHO_U_TWHEN_U_INT_U_HINT_U_RES_U_HRES_U_FSUM
M
+40 QUIT
+41 ;
FND(TIEN) ;EP - Calc Findings
+1 NEW FND,FNDT
+2 SET FND=""
SET FNDT=$$GET1^DIQ(90620,TIEN_",",1.05,"I")
Begin DoDot:1
+3 NEW FIEN,FNODE,FVAL,FFLG,FSTR
+4 ;
+5 ;Look for findings
+6 SET (FFLG,FIEN)=0
SET FSTR=""
FOR
SET FIEN=$ORDER(^BTPWP(TIEN,10,FIEN))
IF 'FIEN
QUIT
Begin DoDot:2
+7 NEW FD,FV
+8 ;
+9 ;Skip ENTERED IN ERROR
+10 IF $$GET1^DIQ(90620.01,FIEN_","_TIEN_",",.08,"I")="Y"
QUIT
+11 ;
+12 ;S FD=$E($$FMTE^BQIUL1($P($$GET1^DIQ(90620.01,FIEN_","_TIEN_",",.01,"I"),".")),1,11)
+13 SET FD=$$FMTE^BQIUL1($$GET1^DIQ(90620.01,FIEN_","_TIEN_",",.01,"I")\1)
+14 SET FV=$$GET1^DIQ(90620.01,FIEN_","_TIEN_",",.02,"E")
+15 IF FD=""
IF FV=""
QUIT
+16 SET FVAL="Finding Date: "_FD
+17 SET FVAL=FVAL_" Finding: "_FV
SET FFLG=1
+18 SET FSTR=FSTR_$SELECT(FSTR]"":$CHAR(13)_$CHAR(10),1:"")_FVAL
End DoDot:2
+19 IF FFLG=1
SET FND="CHECK"_$CHAR(28)_FSTR
QUIT
+20 ;
+21 ;If no findings, check for past due
+22 IF FFLG=0
Begin DoDot:2
+23 IF FNDT]""
IF FNDT<DT
SET FND="TICKLER"_$CHAR(28)_"Entry of Finding is overdue. Due Date: "_$PIECE($$GET1^DIQ(90620,TIEN_",",1.05,"E"),"@")
End DoDot:2
End DoDot:1
+24 ;
+25 QUIT FND
+26 ;
FUP(TIEN) ;EP - Calc Follow Ups
+1 NEW FUP,FNDT,FLUN
+2 ;
+3 ;Look for follow-up needed
+4 SET FLUN=$$GET1^DIQ(90620,TIEN_",",1.11,"I")
IF FLUN="N"
QUIT "N/A"_$CHAR(28)_"Follow-up Not Recommended"
+5 ;
+6 SET FUP=""
SET FNDT=$$GET1^DIQ(90620,TIEN_",",1.06,"I")
Begin DoDot:1
+7 NEW FIEN,FNODE,FVAL,FFLG,FSTR
+8 ;
+9 ;Look for follow ups
+10 SET (FFLG,FIEN)=0
SET FSTR=""
FOR
SET FIEN=$ORDER(^BTPWP(TIEN,12,FIEN))
IF 'FIEN
QUIT
Begin DoDot:2
+11 NEW FD,FV
+12 ;
+13 ;Skip ENTERED IN ERROR
+14 IF $$GET1^DIQ(90620.012,FIEN_","_TIEN_",",.07,"I")="Y"
QUIT
+15 ;
+16 ;S FD=$E($$FMTE^BQIUL1($$GET1^DIQ(90620.012,FIEN_","_TIEN_",",.05,"I")),1,11)
+17 SET FD=$$FMTE^BQIUL1($$GET1^DIQ(90620.012,FIEN_","_TIEN_",",.05,"I")\1)
+18 SET FV=$$GET1^DIQ(90620.012,FIEN_","_TIEN_",",.02,"E")
+19 IF FD=""
IF FV=""
QUIT
+20 SET FVAL="Follow-Up Date: "_FD
+21 SET FVAL=FVAL_" Follow-Up: "_FV
SET FFLG=1
+22 SET FSTR=FSTR_$SELECT(FSTR]"":$CHAR(13)_$CHAR(10),1:"")_FVAL
End DoDot:2
+23 IF FFLG=1
SET FUP="CHECK"_$CHAR(28)_FSTR
QUIT
+24 ;
+25 ;If no follow ups, check for past due
+26 IF FFLG=0
Begin DoDot:2
+27 IF FNDT]""
IF FNDT<DT
SET FUP="TICKLER"_$CHAR(28)_"Entry of recommended follow-up is overdue. Due Date: "_$PIECE($$GET1^DIQ(90620,TIEN_",",1.06,"E"),"@")
End DoDot:2
End DoDot:1
+28 ;
+29 QUIT FUP
+30 ;
NOT(TIEN) ;EP - Calc Notifications
+1 NEW NOT,FNDT
+2 SET NOT=""
SET FNDT=$$GET1^DIQ(90620,TIEN_",",1.07,"I")
Begin DoDot:1
+3 NEW FIEN,FNODE,FVAL,FFLG,FSTR
+4 ;
+5 ;Look for notifications
+6 SET (FFLG,FIEN)=0
SET FSTR=""
FOR
SET FIEN=$ORDER(^BTPWP(TIEN,11,FIEN))
IF 'FIEN
QUIT
Begin DoDot:2
+7 NEW ND,NV
+8 ;
+9 ;Skip ENTERED IN ERROR
+10 IF $$GET1^DIQ(90620.011,FIEN_","_TIEN_",",.09,"I")="Y"
QUIT
+11 ;
+12 ;S ND=$E($$FMTE^BQIUL1($$GET1^DIQ(90620.011,FIEN_","_TIEN_",",.01,"I")),1,11)
+13 SET ND=$$FMTE^BQIUL1($$GET1^DIQ(90620.011,FIEN_","_TIEN_",",.01,"I")\1)
+14 SET NV=$$GET1^DIQ(90620.011,FIEN_","_TIEN_",",.02,"E")
+15 IF ND=""
IF NV=""
QUIT
+16 SET FVAL="Notification Date: "_ND
+17 SET FVAL=FVAL_" Notification: "_NV
SET FFLG=1
+18 SET FSTR=FSTR_$SELECT(FSTR]"":$CHAR(13)_$CHAR(10),1:"")_FVAL
End DoDot:2
+19 IF FFLG=1
SET NOT="CHECK"_$CHAR(28)_FSTR
QUIT
+20 ;
+21 ;If no notifications, check for past due
+22 IF FFLG=0
Begin DoDot:2
+23 IF FNDT]""
IF FNDT<DT
SET NOT="TICKLER"_$CHAR(28)_"Entry of the type of Patient Notification is overdue. Due Date: "_$PIECE($$GET1^DIQ(90620,TIEN_",",1.07,"E"),"@")
End DoDot:2
End DoDot:1
+24 ;
+25 QUIT NOT
+26 ;
STACOM(QIEN) ;EP - Get State Comments
+1 NEW SIEN,SCOMM
+2 SET SCOMM=""
+3 SET SIEN=0
+4 FOR
SET SIEN=$ORDER(^BTPWP(QIEN,3,SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+5 SET SCOMM=SCOMM_$SELECT(SCOMM]"":" ",1:"")_$GET(^BTPWP(QIEN,3,SIEN,0))
End DoDot:1
+6 QUIT SCOMM
+7 ;
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
