BTPWPDSP ;VNGT/HS/BEE - Display CMET Queued Records ; 17 Jul 2008 1:24 PM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
;
RET(DATA,CNT,SRC,PARMS) ; EP - BTPW GET QUEUED EVENTS
; Input parameters
; CNT - Count of # of records to return
; SRC - Values to continue search on
; PARMS - Delimited list of input variables
; -> STATUS - Status
; -> TMFRAME - Time frame
; -> CAT - Category
; -> COMM - Community
; -> COMMTX - Community Taxonomy
;
NEW UID,CII,STATUS,TMFRAME,CAT,COMM,COMMTX,BQ,CIN,BDT,QFL,CATLST,EDT,OSTAT,CMIEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPDSP",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S CII=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPDSP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
;Re-Assemble parameter list if in an array
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 up incoming variables
S (CAT,STATUS,TMFRAME,COMM,COMMTX,CMIEN)=""
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
.N PDATA,NAME,VALUE,BP,BV
.S PDATA=$P(PARMS,$C(28),BQ) 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
;
;Initialize/save original values
S OSTAT=STATUS
S SRC=$G(SRC,"")
S CNT=+$G(CNT)
;
;Handle blank status
S:STATUS="" STATUS="P"_$C(29)_"N"_$C(29)_"S"_$C(29)_"T"
;
;Set up search beginning/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 up Community Taxonomy
I COMMTX'="" D
. N CM,TREF
. S TREF="COMM" K @TREF
. D BLD^BQITUTL(COMMTX,TREF)
. S CM="" F S CM=$O(COMM(CM)) Q:CM="" S COMM=$G(COMM)_$S($G(COMM)]"":$C(29),1:"")_CM K COMM(CM)
;
;Set up Category List Array
I CAT'="",CAT'=0 D
. F BQ=1:1:$L(CAT,$C(29)) S CIN=$P(CAT,$C(29),BQ),CATLST(CIN)=""
;
;Set up Community List Array
S:'$D(COMM) COMM=""
I COMM'="",COMM'=0 D
. F BQ=1:1:$L(COMM,$C(29)) S CIN=+$P(COMM,$C(29),BQ),COMM(CIN)=$P(^AUTTCOM(CIN,0),U,1)
;
S @DATA@(CII)="I00010HIDE_DFN^T00001SENS_FLAG^T00035PATIENT_NAME^T00030HRN^D00015DOB^T00001SEX^"
S @DATA@(CII)=@DATA@(CII)_"T00040CATEGORY^I00010HIDE_CMET_IEN^T00010STATUS^I00010HIDE_EVENTTYPE_IEN^T00060EVENT^D00015EVNT_DATE^I00010HIDE_VISIT_IEN^T01024EXP_EVENT^"
S @DATA@(CII)=@DATA@(CII)_"T00001COMM_FLAG^D00030RESULT^T01024HIDE_RESULT^T00050COMMUNITY^T00035DPCP^T00120DCAT^T00070FINDING^T01024FIND_COMM^"
S @DATA@(CII)=@DATA@(CII)_"T00010AGE^D00030LAST_MODIFIED_DT^T00030LAST_MODIFIED_BY^T01024STATUS_COMMENT^T01024HIDE_SEARCH^T01024EXP_RESULT"_$C(30)
;
S QFL=0
;
;Search 0 - List of CMIENs
I $G(CMIEN)'="" D CMIEN(CMIEN,.COMM,SRC) G DONE
;
;Search 2 - CATEGORY, STATUS, VISIT DATE
I CAT'="",TMFRAME'="" D CSVD(CAT,STATUS,.COMM,BDT,EDT,SRC) G DONE
;
;Search 3 - STATUS, VISIT DATE
I OSTAT'="",TMFRAME'="" D SV(STATUS,.COMM,BDT,EDT,SRC) G DONE
;
;Search 4 - VISIT DATE
I TMFRAME'="" D VD(.COMM,BDT,EDT,SRC) G DONE
;
;Search 5 - Default search on STATUS
D ST(.COMM,.CATLST,STATUS,SRC)
;
DONE ;
S CII=CII+1,@DATA@(CII)=$C(31)
Q
;
CAT(PIEN,TYP) ; EP - Get Procedure Category
NEW PCAT
S TYP=$G(TYP,0)
I 'TYP S PCAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
I TYP S PCAT=$$GET1^DIQ(90621,PIEN_",",.1,"I")
Q PCAT
;
REC(SQIEN,COMM) ; EP - Assemble Single Record
NEW TDATA,PROC,PROCNM,ECAT,VISIT,PRCDT,STAT,DFN,PTNAME,DOB,HRN,PCOM,PTAGE,LMDT,LMBY,SCOMM
NEW SIEN,SEX,TIEN,RES,DPCP,DXTG,HRES,FULLR,RCIEN,RCFILE,FULLE,TAB,LIEN,FCOMM,FC
S TDATA=^BTPWQ(SQIEN,0)
S DFN=$P(TDATA,U,2)
;
;Community Check
S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
I COMM'="",PCOM'="",'$D(COMM(PCOM)) Q
I PCOM'="" S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E")
;
S PROC=$P(TDATA,U,1),PROCNM=$P(^BTPW(90621,PROC,0),U,1)
S ECAT=$$CAT(PROC)
S VISIT=$P(TDATA,U,4)
S PRCDT=$$FMTE^BQIUL1($P(TDATA,U,3))
S STAT=$$GET1^DIQ(90629,SQIEN_",",.08,"E")
S HRN=$TR($$HRNL^BQIULPT(DFN),";",$C(10))
S PTNAME=$$GET1^DIQ(2,DFN_",",.01,"E")
S SEX=$$GET1^DIQ(2,DFN_",",.02,"I")
S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
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)
;
;Result
S RES=$$QLNK^BTPWPTRG(SQIEN,.06),HRES=$P(RES,$C(28),2,3),FULLR=$P(RES,$C(28),4),RES=$P(RES,$C(28))
;
;DPCP/Active DX Tags
S DPCP=$P($$DPCP^BQIULPT(DFN),U,2)
S DXTG=$$DCAT^BQIULPT(DFN)
;
S PTAGE=$$AGE^BQIAGE(DFN,,1)
S LMDT=$$FMTE^BQIUL1($P(TDATA,U,11))
S LMBY=$P(TDATA,U,12)
S FIND=$$GET1^DIQ(90629,SQIEN_",",1.02,"E")
S FCOMM="",FC=0 F S FC=$O(^BTPWQ(SQIEN,4,FC)) Q:FC="" S FCOMM=FCOMM_^BTPWQ(SQIEN,4,FC,0)_$C(10)_$C(13)
S FCOMM=$$TKO^BQIUL1(FCOMM,$C(10)_$C(13))
;
;Retrieve Status Comments
S SCOMM=$$SCOMM^BTPWPDS1(SQIEN)
;
S CII=CII+1,@DATA@(CII)=DFN_U_$$SENS^BQIULPT(DFN)_U_PTNAME_U_HRN_U_DOB_U_SEX_U_ECAT_U_SQIEN_U_STAT_U_PROC_U_PROCNM_U_PRCDT_U_VISIT_U
S @DATA@(CII)=@DATA@(CII)_FULLE_U_$$CALR^BQIULPT(DFN)_U_RES_U_HRES_U_PCOM_U_DPCP_U_DXTG_U_FIND_U_FCOMM_U_PTAGE_U_LMDT_U_LMBY_U
S @DATA@(CII)=@DATA@(CII)_SCOMM_U_SRC_U_FULLR_$C(30)
Q
;
ST(COMM,CTLST,STATUS,OSRC) ;EP - Search 5 - Default search on STATUS
N IEN,CT,LII,STS,STSP,SRC,SFND,SSTRT
;
;Pull the last record info
S SSTRT=1,STS=$P(OSRC,$C(29),2) I STS]"" F SFND=1:1:$L(STATUS,$C(29)) I $P(STATUS,$C(29),SFND)=STS S SSTRT=SFND
S IEN=$P(OSRC,$C(29),1)
;
S CT=0
;
;Loop through index (at selected point) and retrieve records
F STSP=SSTRT:1:$L(STATUS,$C(29)) S STS=$P(STATUS,$C(29),STSP) D Q:QFL
. F S IEN=$O(^BTPWQ("AC",STS,IEN)) Q:IEN="" D Q:QFL
.. S LII=CII,SRC=IEN_$C(29)_STS
.. ;
.. ;Check for CATEGORY - if passed
.. N CTG,CTGCHK S CTGCHK=1
.. I $D(CTLST) D Q:'CTGCHK
... S CTG=$$GET1^DIQ(90629,IEN_",",.13,"I")
... I CTG]"",$D(CTLST(CTG)) Q
... S CTGCHK=0
.. K CTG,CTGCHK
.. ;
.. D REC(IEN,.COMM)
.. I LII=CII Q
.. S CT=CT+1 I CNT,CT=CNT S QFL=1 Q
Q
;
CMIEN(CMIEN,COMM,OSRC) ; EP - Search 0 - List of IENs
N IEN,CT,LII,ISTRT,IFND,ILST,ITSP,SRC
;
;Pull the last record info
S IEN=$G(OSRC)
;
S CT=0
;
;Loop through the 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 LII=CII,SRC=IEN
. D REC(IEN,.COMM)
. I LII=CII Q
. S CT=CT+1 I CNT,CT=CNT S QFL=1 Q
Q
;
VD(COMM,BDT,EDT,OSRC) ; EP - Search 4 - VISIT DATE
N IEN,SBDT,CT,LII,SRC
;
;Pull the last record info
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S IEN=$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(^BTPWQ("AH",SBDT)) Q:(SBDT="")!((EDT]"")&(SBDT'<EDT)) D Q:QFL
. F S IEN=$O(^BTPWQ("AH",SBDT,IEN)) Q:IEN="" D Q:QFL
.. S LII=CII,SRC=IEN_$C(29)_SBDT
.. D REC(IEN,.COMM)
.. I LII=CII Q
.. S CT=CT+1 I CNT,CT=CNT S QFL=1 Q
Q
;
SV(STATUS,COMM,BDT,EDT,OSRC) ; EP - Search 3 - STATUS, VISIT DATE
N IEN,SBDT,CT,LII,STSP,SRC,SFND,STS,SSTRT
;
;Pull the last record info
S SSTRT=1,STS=$P(OSRC,$C(29),3) I STS]"" F SFND=1:1:$L(STATUS,$C(29)) I $P(STATUS,$C(29),SFND)=STS S SSTRT=SFND
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S IEN=$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(STATUS,$C(29)) S STS=$P(STATUS,$C(29),STSP) D Q:QFL
. F S SBDT=$O(^BTPWQ("AF",STS,SBDT)) Q:(SBDT="")!((EDT]"")&(SBDT'<EDT)) D Q:QFL
.. F S IEN=$O(^BTPWQ("AF",STS,SBDT,IEN)) Q:IEN="" D Q:QFL
... S LII=CII,SRC=IEN_$C(29)_SBDT_$C(29)_STS
... D REC(IEN,.COMM)
... I CII=LII Q
... S CT=CT+1 I CNT,CT=CNT S QFL=1 Q
. S SBDT=$S(BDT]"":BDT-.001,1:"") ;Reset to original start date
Q
;
CSVD(CATS,STATUS,COMM,BDT,EDT,OSRC) ; EP - Search 2 - CATEGORY, STATUS, VISIT DATE
N IEN,SBDT,CT,LII,CATP,CAT,CSTRT,CFND,STSP,STS,SRC,SFND,SSTRT,SQIEN
;
;Pull the last record info
S CSTRT=1,CAT=$P(OSRC,$C(29),4) I CAT]"" F CFND=1:1:$L(CATS,$C(29)) I $P(CATS,$C(29),CFND)=CAT S CSTRT=CFND
S SSTRT=1,STS=$P(OSRC,$C(29),3) I STS]"" F SFND=1:1:$L(STATUS,$C(29)) I $P(STATUS,$C(29),SFND)=STS S SSTRT=SFND
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S SQIEN=$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(CATS,$C(29)) S CAT=$P(CATS,$C(29),CATP) D Q:QFL
. F STSP=SSTRT:1:$L(STATUS,$C(29)) S STS=$P(STATUS,$C(29),STSP) D Q:QFL
..F S SBDT=$O(^BTPWQ("AG",CAT,STS,SBDT)) Q:(SBDT="")!((EDT]"")&(SBDT'<EDT)) D Q:QFL
... F S SQIEN=$O(^BTPWQ("AG",CAT,STS,SBDT,SQIEN)) Q:SQIEN="" D Q:QFL
.... S LII=CII,SRC=SQIEN_$C(29)_SBDT_$C(29)_STS_$C(29)_CAT
.... D REC(SQIEN,.COMM)
.... I CII=LII Q
.... S CT=CT+1 I CNT,CT=CNT S QFL=1 Q
.. S SBDT=$S(BDT]"":BDT-.001,1:"") ;Reset to original start date
. S SSTRT=1 ;Reset to 1 for later categories
Q
;
CMSTVD(STATUS,BDT,EDT,COMM,CTLST,OSRC) ; EP - Search 1 - COMMUNITY, STATUS, VISIT DATE - Now INACTIVE
N CM,IEN,SBDT,CT,LII,COMP,CSTRT,CFND,STSP,STS,SRC,SFND,SSTRT
;
;Pull the last record info
S CSTRT=1,CM=$P(OSRC,$C(29),4) I CM]"" F CFND=1:1:$L(COMM,$C(29)) I $P(COMM,$C(29),CFND)=CM S CSTRT=CFND
S SSTRT=1,STS=$P(OSRC,$C(29),3) I STS]"" F SFND=1:1:$L(STATUS,$C(29)) I $P(STATUS,$C(29),SFND)=STS S SSTRT=SFND
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S IEN=$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 COMP=CSTRT:1:$L(COMM,$C(29)) S CM=$P(COMM,$C(29),COMP) D Q:QFL
. F STSP=SSTRT:1:$L(STATUS,$C(29)) S STS=$P(STATUS,$C(29),STSP) D Q:QFL
.. F S SBDT=$O(^BTPWQ("AI",CM,STS,SBDT)) Q:(SBDT="")!((EDT]"")&(SBDT'<EDT)) D Q:QFL
... F S IEN=$O(^BTPWQ("AI",CM,STS,SBDT,IEN)) Q:IEN="" D Q:QFL
.... S LII=CII,SRC=IEN_$C(29)_SBDT_$C(29)_STS_$C(29)_CM
.... ;
.... ;Check for CATEGORY - if passed
.... N CTG,CTGCHK S CTGCHK=1
.... I $D(CTLST) D Q:'CTGCHK
..... S CTG=$$GET1^DIQ(90629,IEN_",",.13,"I")
..... I CTG]"",$D(CTLST(CTG)) Q
..... S CTGCHK=0
.... K CTG,CTGCHK
.... ;
.... D REC(IEN,.COMM)
.... I CII=LII Q
.... S CT=CT+1 I CNT,CT=CNT S QFL=1 Q
.. S SBDT=$S(BDT]"":BDT-.001,1:"") ;Reset to original start date
. S SSTRT=1 ;Reset to 1 for later communities
Q
;
EVTCOM(TIEN) ;EP - Get Event Comments - called by 90506.1 - BTPWQECM
N SIEN,SCOMM
S SCOMM=""
S SIEN=0
F S SIEN=$O(^BTPWP(TIEN,4,SIEN)) Q:'SIEN D
. S SCOMM=SCOMM_$S(SCOMM]"":" ",1:"")_$G(^BTPWP(TIEN,4,SIEN,0))
Q SCOMM
;
FNDCMT(TIEN) ;EP - Get Findings Comments - 90506.1 code BTPWTFNC
N COM,CIEN,CLN,FCOM,FDATA,FIEN
S COM=""
;
D GETS^DIQ(90620,TIEN_",","10*","IE","FDATA")
;
S 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
. ;
. I COM'="" S COM=COM_$C(13)_$C(10)
. ;
. S CIEN=0 F CLN=1:1 S CIEN=$O(FDATA(90620.01,FIEN,1,CIEN)) Q:'CIEN D
.. S FCOM=$G(FDATA(90620.01,FIEN,1,CIEN))
.. I COM'="" S COM=COM_$C(13)_$C(10)
.. S COM=COM_FCOM
;
Q COM
;
FUPCMT(TIEN) ;EP - Get Followup Comments - 90506.1 code BTPWTFUC
N COM,CIEN,CLN,FCOM,FDATA,FIEN
S COM=""
;
D GETS^DIQ(90620,TIEN_",","12*","IE","FDATA")
;
S FIEN=0 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
. ;
. I COM'="" S COM=COM_$C(13)_$C(10)
. ;
. S CIEN=0 F CLN=1:1 S CIEN=$O(FDATA(90620.012,FIEN,1,CIEN)) Q:'CIEN D
.. S FCOM=$G(FDATA(90620.012,FIEN,1,CIEN))
.. I COM'="" S COM=COM_$C(13)_$C(10)
.. S COM=COM_FCOM
;
Q COM
;
NOTCMT(TIEN) ;EP - Get Notification Comments - 90506.1 code BTPWTNOC
N COM,CIEN,CLN,FCOM,FDATA,FIEN
S COM=""
;
D GETS^DIQ(90620,TIEN_",","11*","IE","FDATA")
;
S FIEN=0 F S FIEN=$O(FDATA(90620.011,FIEN)) Q:FIEN="" D
. ;
. ;Skip ENTERED IN ERROR
. I $G(FDATA(90620.011,FIEN,".09","I"))="Y" Q
. ;
. I COM'="" S COM=COM_$C(13)_$C(10)
. ;
. S CIEN=0 F CLN=1:1 S CIEN=$O(FDATA(90620.011,FIEN,1,CIEN)) Q:'CIEN D
.. S FCOM=$G(FDATA(90620.011,FIEN,1,CIEN))
.. I COM'="" S COM=COM_$C(13)_$C(10)
.. S COM=COM_FCOM
;
Q COM
;
;
FLG(TIEN) ;EP - Determine if Panel View Flag Indicator should be set
;
;Check for IEN
Q:$G(TIEN)="" ""
;
;Ignore Closed Events
I $$GET1^DIQ(90620,TIEN_",",1.01,"I")="C" Q ""
;
N FLG,FDATA,FND,FNDT,FIEN
D GETS^DIQ(90620,TIEN_",","**","IE","FDATA")
;
;Set initial Flag Value to Null
S FLG=""
;
;First Check Findings
S FND=0 I $P($$FND^BTPWPCLO(TIEN),U)=1 S FND=1,FLG="C"
I FND=0 S FNDT=FDATA(90620,TIEN_",",1.05,"I") I FNDT]"",FNDT<DT S FLG="T" Q FLG
I FND=0 Q FLG
;
;Now Check Follow-ups
S FND=0 I $P($$FOL^BTPWPCLO(TIEN),U)=1 S FND=1,FLG="C"
I FND=0 S FNDT=FDATA(90620,TIEN_",",1.06,"I") I FNDT]"",FNDT<DT S FLG="T" Q FLG
I FND=0 Q FLG
;
;Last - Check Notifications
S FND=0 I $P($$NOT^BTPWPCLO(TIEN),U)=1 S FND=1,FLG="C"
I FND=0 S FNDT=FDATA(90620,TIEN_",",1.07,"I") I FNDT]"",FNDT<DT S FLG="T" Q FLG
;
Q FLG
;
PAD(X,LEN) ;Truncate or Pad the variable with spaces
N SPACE
S $P(SPACE," ",LEN)=" "
Q $E(X_SPACE,1,LEN)
;
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 CII=CII+1,@DATA@(CII)=$C(31)
Q
BTPWPDSP ;VNGT/HS/BEE - Display CMET Queued Records ; 17 Jul 2008 1:24 PM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
+3 ;
RET(DATA,CNT,SRC,PARMS) ; EP - BTPW GET QUEUED EVENTS
+1 ; Input parameters
+2 ; CNT - Count of # of records to return
+3 ; SRC - Values to continue search on
+4 ; PARMS - Delimited list of input variables
+5 ; -> STATUS - Status
+6 ; -> TMFRAME - Time frame
+7 ; -> CAT - Category
+8 ; -> COMM - Community
+9 ; -> COMMTX - Community Taxonomy
+10 ;
+11 NEW UID,CII,STATUS,TMFRAME,CAT,COMM,COMMTX,BQ,CIN,BDT,QFL,CATLST,EDT,OSTAT,CMIEN
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("BTPWPDSP",UID))
+14 KILL @DATA
+15 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+16 ;
+17 SET CII=0
+18 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPDSP D UNWIND^%ZTER"
+19 ;
+20 ;Re-Assemble parameter list if in an array
+21 SET PARMS=$GET(PARMS,"")
+22 IF PARMS=""
Begin DoDot:1
+23 NEW LIST,BN
+24 SET LIST=""
SET BN=""
+25 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+26 KILL PARMS
+27 SET PARMS=LIST
+28 KILL LIST
End DoDot:1
+29 ;
+30 ;Set up incoming variables
+31 SET (CAT,STATUS,TMFRAME,COMM,COMMTX,CMIEN)=""
+32 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+33 NEW PDATA,NAME,VALUE,BP,BV
+34 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+35 SET NAME=$PIECE(PDATA,"=",1)
IF NAME=""
QUIT
+36 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+37 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
+38 ;
+39 ;Initialize/save original values
+40 SET OSTAT=STATUS
+41 SET SRC=$GET(SRC,"")
+42 SET CNT=+$GET(CNT)
+43 ;
+44 ;Handle blank status
+45 IF STATUS=""
SET STATUS="P"_$CHAR(29)_"N"_$CHAR(29)_"S"_$CHAR(29)_"T"
+46 ;
+47 ;Set up search beginning/end dates
+48 SET (BDT,EDT)=""
+49 IF TMFRAME'=""
Begin DoDot:1
+50 IF $EXTRACT(TMFRAME,1)=">"
SET TMFRAME=$EXTRACT(TMFRAME,2,99)
SET EDT=$$DATE^BQIUL1(TMFRAME)
QUIT
+51 SET BDT=$$DATE^BQIUL1(TMFRAME)
End DoDot:1
+52 ;
+53 ;Set up Community Taxonomy
+54 IF COMMTX'=""
Begin DoDot:1
+55 NEW CM,TREF
+56 SET TREF="COMM"
KILL @TREF
+57 DO BLD^BQITUTL(COMMTX,TREF)
+58 SET CM=""
FOR
SET CM=$ORDER(COMM(CM))
IF CM=""
QUIT
SET COMM=$GET(COMM)_$SELECT($GET(COMM)]"":$CHAR(29),1:"")_CM
KILL COMM(CM)
End DoDot:1
+59 ;
+60 ;Set up Category List Array
+61 IF CAT'=""
IF CAT'=0
Begin DoDot:1
+62 FOR BQ=1:1:$LENGTH(CAT,$CHAR(29))
SET CIN=$PIECE(CAT,$CHAR(29),BQ)
SET CATLST(CIN)=""
End DoDot:1
+63 ;
+64 ;Set up Community List Array
+65 IF '$DATA(COMM)
SET COMM=""
+66 IF COMM'=""
IF COMM'=0
Begin DoDot:1
+67 FOR BQ=1:1:$LENGTH(COMM,$CHAR(29))
SET CIN=+$PIECE(COMM,$CHAR(29),BQ)
SET COMM(CIN)=$PIECE(^AUTTCOM(CIN,0),U,1)
End DoDot:1
+68 ;
+69 SET @DATA@(CII)="I00010HIDE_DFN^T00001SENS_FLAG^T00035PATIENT_NAME^T00030HRN^D00015DOB^T00001SEX^"
+70 SET @DATA@(CII)=@DATA@(CII)_"T00040CATEGORY^I00010HIDE_CMET_IEN^T00010STATUS^I00010HIDE_EVENTTYPE_IEN^T00060EVENT^D00015EVNT_DATE^I00010HIDE_VISIT_IEN^T01024EXP_EVENT^"
+71 SET @DATA@(CII)=@DATA@(CII)_"T00001COMM_FLAG^D00030RESULT^T01024HIDE_RESULT^T00050COMMUNITY^T00035DPCP^T00120DCAT^T00070FINDING^T01024FIND_COMM^"
+72 SET @DATA@(CII)=@DATA@(CII)_"T00010AGE^D00030LAST_MODIFIED_DT^T00030LAST_MODIFIED_BY^T01024STATUS_COMMENT^T01024HIDE_SEARCH^T01024EXP_RESULT"_$CHAR(30)
+73 ;
+74 SET QFL=0
+75 ;
+76 ;Search 0 - List of CMIENs
+77 IF $GET(CMIEN)'=""
DO CMIEN(CMIEN,.COMM,SRC)
GOTO DONE
+78 ;
+79 ;Search 2 - CATEGORY, STATUS, VISIT DATE
+80 IF CAT'=""
IF TMFRAME'=""
DO CSVD(CAT,STATUS,.COMM,BDT,EDT,SRC)
GOTO DONE
+81 ;
+82 ;Search 3 - STATUS, VISIT DATE
+83 IF OSTAT'=""
IF TMFRAME'=""
DO SV(STATUS,.COMM,BDT,EDT,SRC)
GOTO DONE
+84 ;
+85 ;Search 4 - VISIT DATE
+86 IF TMFRAME'=""
DO VD(.COMM,BDT,EDT,SRC)
GOTO DONE
+87 ;
+88 ;Search 5 - Default search on STATUS
+89 DO ST(.COMM,.CATLST,STATUS,SRC)
+90 ;
DONE ;
+1 SET CII=CII+1
SET @DATA@(CII)=$CHAR(31)
+2 QUIT
+3 ;
CAT(PIEN,TYP) ; EP - Get Procedure Category
+1 NEW PCAT
+2 SET TYP=$GET(TYP,0)
+3 IF 'TYP
SET PCAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
+4 IF TYP
SET PCAT=$$GET1^DIQ(90621,PIEN_",",.1,"I")
+5 QUIT PCAT
+6 ;
REC(SQIEN,COMM) ; EP - Assemble Single Record
+1 NEW TDATA,PROC,PROCNM,ECAT,VISIT,PRCDT,STAT,DFN,PTNAME,DOB,HRN,PCOM,PTAGE,LMDT,LMBY,SCOMM
+2 NEW SIEN,SEX,TIEN,RES,DPCP,DXTG,HRES,FULLR,RCIEN,RCFILE,FULLE,TAB,LIEN,FCOMM,FC
+3 SET TDATA=^BTPWQ(SQIEN,0)
+4 SET DFN=$PIECE(TDATA,U,2)
+5 ;
+6 ;Community Check
+7 SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
+8 IF COMM'=""
IF PCOM'=""
IF '$DATA(COMM(PCOM))
QUIT
+9 IF PCOM'=""
SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E")
+10 ;
+11 SET PROC=$PIECE(TDATA,U,1)
SET PROCNM=$PIECE(^BTPW(90621,PROC,0),U,1)
+12 SET ECAT=$$CAT(PROC)
+13 SET VISIT=$PIECE(TDATA,U,4)
+14 SET PRCDT=$$FMTE^BQIUL1($PIECE(TDATA,U,3))
+15 SET STAT=$$GET1^DIQ(90629,SQIEN_",",.08,"E")
+16 SET HRN=$TRANSLATE($$HRNL^BQIULPT(DFN),";",$CHAR(10))
+17 SET PTNAME=$$GET1^DIQ(2,DFN_",",.01,"E")
+18 SET SEX=$$GET1^DIQ(2,DFN_",",.02,"I")
+19 SET DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
+20 SET TIEN=$PIECE(TDATA,U,14)
SET FULLR=""
+21 SET FULLE="Event obtained from: "_$CHAR(13)_$CHAR(10)
Begin DoDot:1
+22 SET RCIEN=$PIECE(TDATA,U,5)
SET RCFILE=$PIECE(TDATA,U,6)
+23 SET FULLE=FULLE_$PIECE(^BTPW(90621.1,RCFILE,0),"^",1)_" - "
+24 NEW FIL,FLD
+25 SET FIL=$PIECE(^BTPW(90621.1,RCFILE,0),"^",2)
SET FLD=$PIECE(^(0),"^",3)
SET TAB=$PIECE(^(0),"^",8)
+26 SET FULLE=FULLE_$$GET1^DIQ(FIL,RCIEN_",",FLD,"E")
+27 SET LIEN=$$GET1^DIQ(FIL,RCIEN_",",FLD,"I")
+28 IF TAB=80!(TAB=80.1)!(TAB=81)
Begin DoDot:2
End DoDot:2
+29 IF TAB=80
SET FULLE=FULLE_" "_$$ICD9^BQIUL3(LIEN,,4)_$CHAR(13)_$CHAR(10)
QUIT
+30 IF TAB=80.1
SET FULLE=FULLE_" "_$$ICD0^BQIUL3(LIEN,,5)_$CHAR(13)_$CHAR(10)
QUIT
+31 IF TAB=81
SET FULLE=FULLE_" "_$$ICPT^BQIUL3(LIEN,"",3)
End DoDot:1
+32 ;
+33 ;Result
+34 SET RES=$$QLNK^BTPWPTRG(SQIEN,.06)
SET HRES=$PIECE(RES,$CHAR(28),2,3)
SET FULLR=$PIECE(RES,$CHAR(28),4)
SET RES=$PIECE(RES,$CHAR(28))
+35 ;
+36 ;DPCP/Active DX Tags
+37 SET DPCP=$PIECE($$DPCP^BQIULPT(DFN),U,2)
+38 SET DXTG=$$DCAT^BQIULPT(DFN)
+39 ;
+40 SET PTAGE=$$AGE^BQIAGE(DFN,,1)
+41 SET LMDT=$$FMTE^BQIUL1($PIECE(TDATA,U,11))
+42 SET LMBY=$PIECE(TDATA,U,12)
+43 SET FIND=$$GET1^DIQ(90629,SQIEN_",",1.02,"E")
+44 SET FCOMM=""
SET FC=0
FOR
SET FC=$ORDER(^BTPWQ(SQIEN,4,FC))
IF FC=""
QUIT
SET FCOMM=FCOMM_^BTPWQ(SQIEN,4,FC,0)_$CHAR(10)_$CHAR(13)
+45 SET FCOMM=$$TKO^BQIUL1(FCOMM,$CHAR(10)_$CHAR(13))
+46 ;
+47 ;Retrieve Status Comments
+48 SET SCOMM=$$SCOMM^BTPWPDS1(SQIEN)
+49 ;
+50 SET CII=CII+1
SET @DATA@(CII)=DFN_U_$$SENS^BQIULPT(DFN)_U_PTNAME_U_HRN_U_DOB_U_SEX_U_ECAT_U_SQIEN_U_STAT_U_PROC_U_PROCNM_U_PRCDT_U_VISIT_U
+51 SET @DATA@(CII)=@DATA@(CII)_FULLE_U_$$CALR^BQIULPT(DFN)_U_RES_U_HRES_U_PCOM_U_DPCP_U_DXTG_U_FIND_U_FCOMM_U_PTAGE_U_LMDT_U_LMBY_U
+52 SET @DATA@(CII)=@DATA@(CII)_SCOMM_U_SRC_U_FULLR_$CHAR(30)
+53 QUIT
+54 ;
ST(COMM,CTLST,STATUS,OSRC) ;EP - Search 5 - Default search on STATUS
+1 NEW IEN,CT,LII,STS,STSP,SRC,SFND,SSTRT
+2 ;
+3 ;Pull the last record info
+4 SET SSTRT=1
SET STS=$PIECE(OSRC,$CHAR(29),2)
IF STS]""
FOR SFND=1:1:$LENGTH(STATUS,$CHAR(29))
IF $PIECE(STATUS,$CHAR(29),SFND)=STS
SET SSTRT=SFND
+5 SET IEN=$PIECE(OSRC,$CHAR(29),1)
+6 ;
+7 SET CT=0
+8 ;
+9 ;Loop through index (at selected point) and retrieve records
+10 FOR STSP=SSTRT:1:$LENGTH(STATUS,$CHAR(29))
SET STS=$PIECE(STATUS,$CHAR(29),STSP)
Begin DoDot:1
+11 FOR
SET IEN=$ORDER(^BTPWQ("AC",STS,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+12 SET LII=CII
SET SRC=IEN_$CHAR(29)_STS
+13 ;
+14 ;Check for CATEGORY - if passed
+15 NEW CTG,CTGCHK
SET CTGCHK=1
+16 IF $DATA(CTLST)
Begin DoDot:3
+17 SET CTG=$$GET1^DIQ(90629,IEN_",",.13,"I")
+18 IF CTG]""
IF $DATA(CTLST(CTG))
QUIT
+19 SET CTGCHK=0
End DoDot:3
IF 'CTGCHK
QUIT
+20 KILL CTG,CTGCHK
+21 ;
+22 DO REC(IEN,.COMM)
+23 IF LII=CII
QUIT
+24 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+25 QUIT
+26 ;
CMIEN(CMIEN,COMM,OSRC) ; EP - Search 0 - List of IENs
+1 NEW IEN,CT,LII,ISTRT,IFND,ILST,ITSP,SRC
+2 ;
+3 ;Pull the last record info
+4 SET IEN=$GET(OSRC)
+5 ;
+6 SET CT=0
+7 ;
+8 ;Loop through the 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 SET LII=CII
SET SRC=IEN
+12 DO REC(IEN,.COMM)
+13 IF LII=CII
QUIT
+14 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
QUIT
End DoDot:1
IF QFL
QUIT
+15 QUIT
+16 ;
VD(COMM,BDT,EDT,OSRC) ; EP - Search 4 - VISIT DATE
+1 NEW IEN,SBDT,CT,LII,SRC
+2 ;
+3 ;Pull the last record info
+4 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+5 SET IEN=$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(^BTPWQ("AH",SBDT))
IF (SBDT="")!((EDT]"")&(SBDT'<EDT))
QUIT
Begin DoDot:1
+12 FOR
SET IEN=$ORDER(^BTPWQ("AH",SBDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+13 SET LII=CII
SET SRC=IEN_$CHAR(29)_SBDT
+14 DO REC(IEN,.COMM)
+15 IF LII=CII
QUIT
+16 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+17 QUIT
+18 ;
SV(STATUS,COMM,BDT,EDT,OSRC) ; EP - Search 3 - STATUS, VISIT DATE
+1 NEW IEN,SBDT,CT,LII,STSP,SRC,SFND,STS,SSTRT
+2 ;
+3 ;Pull the last record info
+4 SET SSTRT=1
SET STS=$PIECE(OSRC,$CHAR(29),3)
IF STS]""
FOR SFND=1:1:$LENGTH(STATUS,$CHAR(29))
IF $PIECE(STATUS,$CHAR(29),SFND)=STS
SET SSTRT=SFND
+5 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+6 SET IEN=$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(STATUS,$CHAR(29))
SET STS=$PIECE(STATUS,$CHAR(29),STSP)
Begin DoDot:1
+13 FOR
SET SBDT=$ORDER(^BTPWQ("AF",STS,SBDT))
IF (SBDT="")!((EDT]"")&(SBDT'<EDT))
QUIT
Begin DoDot:2
+14 FOR
SET IEN=$ORDER(^BTPWQ("AF",STS,SBDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+15 SET LII=CII
SET SRC=IEN_$CHAR(29)_SBDT_$CHAR(29)_STS
+16 DO REC(IEN,.COMM)
+17 IF CII=LII
QUIT
+18 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
QUIT
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
+19 ;Reset to original start date
SET SBDT=$SELECT(BDT]"":BDT-.001,1:"")
End DoDot:1
IF QFL
QUIT
+20 QUIT
+21 ;
CSVD(CATS,STATUS,COMM,BDT,EDT,OSRC) ; EP - Search 2 - CATEGORY, STATUS, VISIT DATE
+1 NEW IEN,SBDT,CT,LII,CATP,CAT,CSTRT,CFND,STSP,STS,SRC,SFND,SSTRT,SQIEN
+2 ;
+3 ;Pull the last record info
+4 SET CSTRT=1
SET CAT=$PIECE(OSRC,$CHAR(29),4)
IF CAT]""
FOR CFND=1:1:$LENGTH(CATS,$CHAR(29))
IF $PIECE(CATS,$CHAR(29),CFND)=CAT
SET CSTRT=CFND
+5 SET SSTRT=1
SET STS=$PIECE(OSRC,$CHAR(29),3)
IF STS]""
FOR SFND=1:1:$LENGTH(STATUS,$CHAR(29))
IF $PIECE(STATUS,$CHAR(29),SFND)=STS
SET SSTRT=SFND
+6 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+7 SET SQIEN=$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(CATS,$CHAR(29))
SET CAT=$PIECE(CATS,$CHAR(29),CATP)
Begin DoDot:1
+14 FOR STSP=SSTRT:1:$LENGTH(STATUS,$CHAR(29))
SET STS=$PIECE(STATUS,$CHAR(29),STSP)
Begin DoDot:2
+15 FOR
SET SBDT=$ORDER(^BTPWQ("AG",CAT,STS,SBDT))
IF (SBDT="")!((EDT]"")&(SBDT'<EDT))
QUIT
Begin DoDot:3
+16 FOR
SET SQIEN=$ORDER(^BTPWQ("AG",CAT,STS,SBDT,SQIEN))
IF SQIEN=""
QUIT
Begin DoDot:4
+17 SET LII=CII
SET SRC=SQIEN_$CHAR(29)_SBDT_$CHAR(29)_STS_$CHAR(29)_CAT
+18 DO REC(SQIEN,.COMM)
+19 IF CII=LII
QUIT
+20 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
QUIT
End DoDot:4
IF QFL
QUIT
End DoDot:3
IF QFL
QUIT
+21 ;Reset to original start date
SET SBDT=$SELECT(BDT]"":BDT-.001,1:"")
End DoDot:2
IF QFL
QUIT
+22 ;Reset to 1 for later categories
SET SSTRT=1
End DoDot:1
IF QFL
QUIT
+23 QUIT
+24 ;
CMSTVD(STATUS,BDT,EDT,COMM,CTLST,OSRC) ; EP - Search 1 - COMMUNITY, STATUS, VISIT DATE - Now INACTIVE
+1 NEW CM,IEN,SBDT,CT,LII,COMP,CSTRT,CFND,STSP,STS,SRC,SFND,SSTRT
+2 ;
+3 ;Pull the last record info
+4 SET CSTRT=1
SET CM=$PIECE(OSRC,$CHAR(29),4)
IF CM]""
FOR CFND=1:1:$LENGTH(COMM,$CHAR(29))
IF $PIECE(COMM,$CHAR(29),CFND)=CM
SET CSTRT=CFND
+5 SET SSTRT=1
SET STS=$PIECE(OSRC,$CHAR(29),3)
IF STS]""
FOR SFND=1:1:$LENGTH(STATUS,$CHAR(29))
IF $PIECE(STATUS,$CHAR(29),SFND)=STS
SET SSTRT=SFND
+6 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+7 SET IEN=$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 COMP=CSTRT:1:$LENGTH(COMM,$CHAR(29))
SET CM=$PIECE(COMM,$CHAR(29),COMP)
Begin DoDot:1
+14 FOR STSP=SSTRT:1:$LENGTH(STATUS,$CHAR(29))
SET STS=$PIECE(STATUS,$CHAR(29),STSP)
Begin DoDot:2
+15 FOR
SET SBDT=$ORDER(^BTPWQ("AI",CM,STS,SBDT))
IF (SBDT="")!((EDT]"")&(SBDT'<EDT))
QUIT
Begin DoDot:3
+16 FOR
SET IEN=$ORDER(^BTPWQ("AI",CM,STS,SBDT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+17 SET LII=CII
SET SRC=IEN_$CHAR(29)_SBDT_$CHAR(29)_STS_$CHAR(29)_CM
+18 ;
+19 ;Check for CATEGORY - if passed
+20 NEW CTG,CTGCHK
SET CTGCHK=1
+21 IF $DATA(CTLST)
Begin DoDot:5
+22 SET CTG=$$GET1^DIQ(90629,IEN_",",.13,"I")
+23 IF CTG]""
IF $DATA(CTLST(CTG))
QUIT
+24 SET CTGCHK=0
End DoDot:5
IF 'CTGCHK
QUIT
+25 KILL CTG,CTGCHK
+26 ;
+27 DO REC(IEN,.COMM)
+28 IF CII=LII
QUIT
+29 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
QUIT
End DoDot:4
IF QFL
QUIT
End DoDot:3
IF QFL
QUIT
+30 ;Reset to original start date
SET SBDT=$SELECT(BDT]"":BDT-.001,1:"")
End DoDot:2
IF QFL
QUIT
+31 ;Reset to 1 for later communities
SET SSTRT=1
End DoDot:1
IF QFL
QUIT
+32 QUIT
+33 ;
EVTCOM(TIEN) ;EP - Get Event Comments - called by 90506.1 - BTPWQECM
+1 NEW SIEN,SCOMM
+2 SET SCOMM=""
+3 SET SIEN=0
+4 FOR
SET SIEN=$ORDER(^BTPWP(TIEN,4,SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+5 SET SCOMM=SCOMM_$SELECT(SCOMM]"":" ",1:"")_$GET(^BTPWP(TIEN,4,SIEN,0))
End DoDot:1
+6 QUIT SCOMM
+7 ;
FNDCMT(TIEN) ;EP - Get Findings Comments - 90506.1 code BTPWTFNC
+1 NEW COM,CIEN,CLN,FCOM,FDATA,FIEN
+2 SET COM=""
+3 ;
+4 DO GETS^DIQ(90620,TIEN_",","10*","IE","FDATA")
+5 ;
+6 SET FIEN=0
FOR
SET FIEN=$ORDER(FDATA(90620.01,FIEN))
IF FIEN=""
QUIT
Begin DoDot:1
+7 ;
+8 ;Skip ENTERED IN ERROR
+9 IF $GET(FDATA(90620.01,FIEN,".08","I"))="Y"
QUIT
+10 ;
+11 IF COM'=""
SET COM=COM_$CHAR(13)_$CHAR(10)
+12 ;
+13 SET CIEN=0
FOR CLN=1:1
SET CIEN=$ORDER(FDATA(90620.01,FIEN,1,CIEN))
IF 'CIEN
QUIT
Begin DoDot:2
+14 SET FCOM=$GET(FDATA(90620.01,FIEN,1,CIEN))
+15 IF COM'=""
SET COM=COM_$CHAR(13)_$CHAR(10)
+16 SET COM=COM_FCOM
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT COM
+19 ;
FUPCMT(TIEN) ;EP - Get Followup Comments - 90506.1 code BTPWTFUC
+1 NEW COM,CIEN,CLN,FCOM,FDATA,FIEN
+2 SET COM=""
+3 ;
+4 DO GETS^DIQ(90620,TIEN_",","12*","IE","FDATA")
+5 ;
+6 SET FIEN=0
FOR
SET FIEN=$ORDER(FDATA(90620.012,FIEN))
IF FIEN=""
QUIT
Begin DoDot:1
+7 ;
+8 ;Skip ENTERED IN ERROR
+9 IF $GET(FDATA(90620.012,FIEN,".07","I"))="Y"
QUIT
+10 ;
+11 IF COM'=""
SET COM=COM_$CHAR(13)_$CHAR(10)
+12 ;
+13 SET CIEN=0
FOR CLN=1:1
SET CIEN=$ORDER(FDATA(90620.012,FIEN,1,CIEN))
IF 'CIEN
QUIT
Begin DoDot:2
+14 SET FCOM=$GET(FDATA(90620.012,FIEN,1,CIEN))
+15 IF COM'=""
SET COM=COM_$CHAR(13)_$CHAR(10)
+16 SET COM=COM_FCOM
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT COM
+19 ;
NOTCMT(TIEN) ;EP - Get Notification Comments - 90506.1 code BTPWTNOC
+1 NEW COM,CIEN,CLN,FCOM,FDATA,FIEN
+2 SET COM=""
+3 ;
+4 DO GETS^DIQ(90620,TIEN_",","11*","IE","FDATA")
+5 ;
+6 SET FIEN=0
FOR
SET FIEN=$ORDER(FDATA(90620.011,FIEN))
IF FIEN=""
QUIT
Begin DoDot:1
+7 ;
+8 ;Skip ENTERED IN ERROR
+9 IF $GET(FDATA(90620.011,FIEN,".09","I"))="Y"
QUIT
+10 ;
+11 IF COM'=""
SET COM=COM_$CHAR(13)_$CHAR(10)
+12 ;
+13 SET CIEN=0
FOR CLN=1:1
SET CIEN=$ORDER(FDATA(90620.011,FIEN,1,CIEN))
IF 'CIEN
QUIT
Begin DoDot:2
+14 SET FCOM=$GET(FDATA(90620.011,FIEN,1,CIEN))
+15 IF COM'=""
SET COM=COM_$CHAR(13)_$CHAR(10)
+16 SET COM=COM_FCOM
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT COM
+19 ;
+20 ;
FLG(TIEN) ;EP - Determine if Panel View Flag Indicator should be set
+1 ;
+2 ;Check for IEN
+3 IF $GET(TIEN)=""
QUIT ""
+4 ;
+5 ;Ignore Closed Events
+6 IF $$GET1^DIQ(90620,TIEN_",",1.01,"I")="C"
QUIT ""
+7 ;
+8 NEW FLG,FDATA,FND,FNDT,FIEN
+9 DO GETS^DIQ(90620,TIEN_",","**","IE","FDATA")
+10 ;
+11 ;Set initial Flag Value to Null
+12 SET FLG=""
+13 ;
+14 ;First Check Findings
+15 SET FND=0
IF $PIECE($$FND^BTPWPCLO(TIEN),U)=1
SET FND=1
SET FLG="C"
+16 IF FND=0
SET FNDT=FDATA(90620,TIEN_",",1.05,"I")
IF FNDT]""
IF FNDT<DT
SET FLG="T"
QUIT FLG
+17 IF FND=0
QUIT FLG
+18 ;
+19 ;Now Check Follow-ups
+20 SET FND=0
IF $PIECE($$FOL^BTPWPCLO(TIEN),U)=1
SET FND=1
SET FLG="C"
+21 IF FND=0
SET FNDT=FDATA(90620,TIEN_",",1.06,"I")
IF FNDT]""
IF FNDT<DT
SET FLG="T"
QUIT FLG
+22 IF FND=0
QUIT FLG
+23 ;
+24 ;Last - Check Notifications
+25 SET FND=0
IF $PIECE($$NOT^BTPWPCLO(TIEN),U)=1
SET FND=1
SET FLG="C"
+26 IF FND=0
SET FNDT=FDATA(90620,TIEN_",",1.07,"I")
IF FNDT]""
IF FNDT<DT
SET FLG="T"
QUIT FLG
+27 ;
+28 QUIT FLG
+29 ;
PAD(X,LEN) ;Truncate or Pad the variable with spaces
+1 NEW SPACE
+2 SET $PIECE(SPACE," ",LEN)=" "
+3 QUIT $EXTRACT(X_SPACE,1,LEN)
+4 ;
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 CII=CII+1
SET @DATA@(CII)=$CHAR(31)
+6 QUIT
