MMRSCRE3 ;LEIDOS/TCK - Print CRE Report Cont. (Contains functions to collect patient labs and swabbing rate) ; 3/3/17 10:47am
;;1.0;MDRO PROGRAM TOOLS;**4,5**;Jun 01, 2016;Build 146
;
GETLABS ;Gets all lab data for the report.
N LRMDRO,LOC,INDT,DFN,OUTDT,NARES24,NARES48,SURV48,CULT48,MRSA365,CULT365,KNOWMRSA,KNOWCULT,NARES24A,NARES48ASURV48A,NARES48A
N MRSAFR,MRSATO,MRSA365A,CULT365A,SURV48A,NARES24D,NARES48D,SURV48D,MRSACPRD,TRANS,MMRSNOW
N CNTR
S CNTR=0
S MMRSNOW=$$NOW^XLFDT(),LREND=MMRSNOW
S LRMDRO="",LRMDRO=$O(^MMRS(104.2,"B","CRB-R",LRMDRO))
S ^TMP($J,"MMRSCRE","DSUM")="0^0^0^0^0^0^0^0^0"
S LOC="" F S LOC=$O(^TMP($J,"MMRSCRE","D",LOC)) Q:LOC="" D
.S ^TMP($J,"MMRSCRE","DSUM",LOC)="0^0^0^0^0^0^0^0^0"
.S DFN=0 F S DFN=$O(^TMP($J,"MMRSCRE","D",LOC,DFN)) Q:'DFN D
..S INDT="" F S INDT=$O(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT)) Q:'INDT D
...S DIV="",DIV=$O(^DG(40.8,"B",LOC,DIV))
...I DIV'="" S MDIV="",MDIV=$O(^MMRS(104,"B",DIV,MDIV))
...Q:$G(MDIV)'>0
...S (CR,MRSA)=""
...S LOCSUM=$G(^TMP($J,"MMRSCRE","DSUM",LOC))
...S SUM=$G(^TMP($J,"MMRSCRE","DSUM"))
...S DATA=$G(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT))
...S OUTDT=$P(DATA,"^",10)
...S ORDLOC=$P(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT),"^")
...I $G(ORDLOC)'="" S ORDLOC=$$GET1^DIQ(42,ORDLOC,.01,"E")
...I $P(DATA,U,5)=1 D
....S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,1)=$P(LOCSUM,U,1)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,1)=$P(SUM,U,1)+1
...S MRSA=$$GETLAB(DFN,INDT,LRMDRO,LREND,"CD")
...S (CR,I,COLDT)="",DONE=0
...Q:MRSA=""
...S CR=$P($P(MRSA,"^",2),";") I CR="" S CR="NEG"
...Q:CR=""
...S DTA=$P(MRSA,"^",2),LRD=$P(DTA,";",2),LRDT=$P(DTA,";",3),LIEN=LRDT_","_LRD_","
...S LIENS=LRDT_","_LRD_","
...S COLDT=$$GET1^DIQ(63.05,LIEN,.01,"I")
...S SRCE=$P(MRSA,"^",3)
...Q:SRCE=""
...S SVC="N",CC="Y"
...S DATA=$G(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT))
...Q:DATA=""
...S ADMDT=$P(DATA,"^",3),MOVMENT=$P(DATA,"^",4)
...S DTA=$P(MRSA,"^",2),LRD=$P(DTA,";",2),LRDT=$P(DTA,";",3),LRSS=$P(DTA,";",4),NEG=$P(DTA,";")
...S LIENS=LRDT_","_LRD_","
...S COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
...I $G(MOVMENT)>0 D
....S TRNACT=$P(DATA,U,5) ;$$GET1^DIQ(405,MOVMENT,.02,"E")
....I TRNACT'=1 S DONE=1 Q ;"ADMISSION"
....;S DSCHRGE=$$GET1^DIQ(405,MOVMENT,.17,"I")
....S DSCHRGE=OUTDT ;$$GET1^DIQ(405,DSCHRGE,.01,"I")
....I $G(DSCHRGE)'="" D
.....S DTA=$P(MRSA,"^",2),LRD=$P(DTA,";",2),LRDT=$P(DTA,";",3),LRSS=$P(DTA,";",4),NEG=$P(DTA,";")
.....Q:$G(DTA)=""
.....S LIENS=LRDT_","_LRD_","
.....S COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
.....I DSCHRGE<COLDT D
......K ^TMP($J,"MMRSCRE","D",LOC,DFN,INDT)
......K ^TMP($J,"MMRSCRE","DETAIL",LOC,INDT)
......K LIENS S DONE=1
...Q:DONE
...I $D(^MMRS(104,MDIV,61,"B",SRCE)) S SVC="Y",CC="N"
...I $D(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT)) D
....S DATA=$G(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT))
....S ACT=$P(DATA,"^",5)
....Q:$P(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT),"^",13)=""
....S DTA=$P(MRSA,"^",2),LRD=$P(DTA,";",2),LRDT=$P(DTA,";",3),LRSS=$P(DTA,";",4),NEG=$P(DTA,";")
....Q:$G(DTA)=""
....S LIENS=LRDT_","_LRD_","
....S COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
....S X=$$FMDIFF^XLFDT(COLDT,INDT,3),X=$P(X," ")
....I X>2!('CR) D Q
.....K MRSA
.....I $D(^TMP($J,"MMRSCRE","DETAIL",LOC,INDT)) K ^TMP($J,"MMRSCRE","DETAIL",LOC,INDT)
....S SURV=$P(^TMP($J,"MMRSCRE","D",LOC,INDT,DFN),"^",13)
....I SURV=SVC K MRSA(I) Q
....I SURV'=SVC S $P(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT),"^",13)="N",$P(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT),"^",14)="Y" K MRSA(I)
...Q:$G(MRSA)=""
...I CR["POS",'PFLG D
....Q:$D(^TMP($J,"MMRSCRE","DETAIL",LOC,INDT))
....S ^TMP($J,"MMRSCRE","DETAIL",LOC,INDT)=$P(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT),U,6,9)
...I CR["POS",$D(^TMP($J,"MMRSCRE","DETAIL",LOC,INDT)),$P(^TMP($J,"MMRSCRE","DETAIL",LOC,INDT),U,13)="",'PFLG S ^TMP($J,"MMRSCRE","DETAIL",LOC,INDT)=^TMP($J,"MMRSCRE","DETAIL",LOC,INDT)_U_COLDT_U_SRCE_U_SVC_U_CC_U_CR
...S MRSAFR=(INDT-10000) I STRTDT>INDT S MRSAFR=(STRTDT-10000) ;(ADM - 1 year) or (START DT - 1 year) - whichever is later
...D PREV ;Calculate prevalence measures
S X=""
Q
;
PREV ;Calculate prevalence measures (summary report)
N LOCSUM,SUM,DATA,IND
S LOCSUM=$G(^TMP($J,"MMRSCRE","DSUM",LOC))
S SUM=$G(^TMP($J,"MMRSCRE","DSUM"))
S DATA=$G(^TMP($J,"MMRSCRE","D",LOC,DFN,INDT))
I $P(DATA,U,5)'>2 D
.Q:MRSA'[";"
.S DTA=$P(MRSA,"^",2),LRD=$P(DTA,";",2),LRDT=$P(DTA,";",3),LRSS=$P(DTA,";",4),NEG=$P(DTA,";")
.Q:$G(DTA)=""
.S LIENS=LRDT_","_LRD_","
.S COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
.Q:COLDT>ENDDT
.Q:COLDT<INDT
.S X=$$FMDIFF^XLFDT(COLDT,INDT,3),X=$P(X," ")
.I X<3 D
..I SVC="Y" D
...S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,2)=$P(LOCSUM,U,2)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,2)=$P(SUM,U,2)+1
...I NEG="POS",'PFLG D
....S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,3)=$P(LOCSUM,U,3)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,3)=$P(SUM,U,3)+1
....S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,8)=$P(LOCSUM,U,8)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,8)=$P(SUM,U,8)+1
..I SVC="N",NEG="POS",'PFLG D
...S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,4)=$P(LOCSUM,U,4)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,4)=$P(SUM,U,4)+1
...S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,8)=$P(LOCSUM,U,8)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,8)=$P(SUM,U,8)+1
.I X>2 D
..I SVC="Y" D
...S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,5)=$P(LOCSUM,U,5)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,5)=$P(SUM,U,5)+1
...I NEG["POS",'PFLG D
....S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,6)=$P(LOCSUM,U,6)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,6)=$P(SUM,U,6)+1
....S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,8)=$P(LOCSUM,U,8)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,8)=$P(SUM,U,8)+1
..I SVC="N",NEG["POS",'PFLG D
...S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,7)=$P(LOCSUM,U,7)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,7)=$P(SUM,U,7)+1
...S $P(^TMP($J,"MMRSCRE","DSUM",LOC),U,8)=$P(LOCSUM,U,8)+1,$P(^TMP($J,"MMRSCRE","DSUM"),U,8)=$P(SUM,U,8)+1
K MRSA
Q
;
CLNARY(LOC,DFN,MRSA) ;
N D,ST,VAL,XX,OUTDT
;Q:'$D(MRSA(1)
S XX=9999,XX=$O(MRSA(XX),-1)
S D="" F S D=$O(MRSA(D)) Q:D="" D
.S IND=$P(MRSA(D),"^",4)
.S RES=$P($P(MRSA(D),"^",2),";")
.I RES=""!(RES["NEG") K MRSA(D) Q
.Q:'$D(^TMP($J,"MMRSCRE","D",LOC,IND,DFN))
.K ^TMP($J,"MMRSCRE","D",LOC,IND,DFN),MRSA(D)
.S DTA=MRSA(D)
.Q:DTA=""
.S LRD=$P(DTA,";",2),LRDT=$P(DTA,";",3)
.S DATA=$G(^TMP($J,"MMRSCRE","D",LOC,IND,DFN))
.S ADMDT=$P(DATA,"^",3),MOVMENT=$P(DATA,"^",4)
.S OUTDT=$P(DATA,"^",10)
.S DSCHRG=OUTDT ;$$GET1^DIQ(405,MOVMENT,.17,"I")
.;I $G(DSCHRG)>0 S DSCHRG=$$GET1^DIQ(405,MOVMENT,.01,"I")
.I DSCHRG'="" D Q
..S LIENS=LRDT_","_LRD_","
..S COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
..I DSCHRG<COLDT K ^TMP($J,"MMRSCRE","D",LOC,IND,DFN),MRSA(D) S DONE=1 Q
.S A=D-1 I $D(MRSA(A)) K MRSA(D) Q
Q
GETLAB(DFN,LRSTART,LRMDRO,LREND,LRDTTYP) ;RETURN YES/NO^RESULT
N LRRSLT,LRTST,TMPRSLT
S LRRSLT="^",TMPRSLT=""
I $G(DFN)=""!($G(LRMDRO)="")!($G(LRSTART)="")!($G(LREND)="") Q LRRSLT
;GET CH RSLTS
I MDROETIO D
.S TMPRSLT=$$GETMI(DFN,LRMDRO,LRSTART,LREND,LRDTTYP)
I TSTSTP D
.S LRTST=0 F S LRTST=$O(^TMP($J,"MMRSCRE","T",LRMDRO,LRTST)) Q:'LRTST D
.S SUBS=$$GET1^DIQ(60,+LRTST,4,"I")
.I SUBS="CH" S TMPRSLT=$$GETCH(DFN,LRMDRO,LRTST,LRSTART,LREND,LRDTTYP)
Q TMPRSLT
;
GETCH(DFN,LRMDRO,LRTST,LRSTART,LREND,LRDTTYP,MRSA) ;RETURN YES^RESULT
N LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD
S LRRSLT="^"
S LRDFN=$$LRDFN^LR7OR1(DFN)
Q:'LRDFN LRRSLT
S LRDATE=LRSTART-.0000001
I LRDTTYP="RAD" S LRDATE=0,LRRADEND=LREND,LREND=9999999
F S LRDATE=$O(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE)) Q:'LRDATE!(LRDATE>LREND) D
.Q:LRDATE>ENDDT
.Q:LRDATE<STRTDT
.S DAS=0 F S DAS=$O(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE,DAS)) Q:'DAS D
..S LRIDT=$P(DAS,";",3)
..I LRDTTYP="RAD" S LRRAD=$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,3) I LRRAD<LRSTART!(LRRAD>LRRADEND) Q
..Q:LRDATE<STRTDT
..Q:LRDATE>ENDDT
..Q:$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,3)=""
..;GET ORDER NUMBER FROM ORUT MODE
..S LRSITE=$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,5)
..;Q:$$SCRNTOP(LRSITE,LRMDRO)
..;I $D(^LR(LRDFN,"CH",LRIDT,0)),$P(^LR(LRDFN,"CH",LRIDT,0),U,3) D
..S $P(LRRSLT,"^",1)="Y"
..S TSTRSLT=$$CHRSLT(LRDFN,LRIDT,LRMDRO,LRTST)
..I TSTRSLT["POS",(($P(LRRSLT,"^",2)="")!($P($P(LRRSLT,"^",2),";",3)>LRIDT)) D
..I ($P(LRRSLT,"^",2)="")!($P($P(LRRSLT,"^",2),";",3)>LRIDT) D
...S $P(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";CH")
...S LIEN=LRIDT_","_LRDFN_","
...S SRCE=$$GET1^DIQ(63.04,LIEN,.05,"E")
...S LRRSLT=LRRSLT_"^"_$G(SRCE)
Q LRRSLT
;
GETMI(DFN,LRMDRO,LRSTART,LREND,LRDTTYP) ;RETURN YES^RESULT
N LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD,LRIEND,CNTR
S LRRSLT="^",CNTR=0
I '$D(^TMP($J,"MMRSCRE","BACT",ORG,"INC_REMARK")),'$D(^TMP($J,"MMRSCRE","ETIOL",ORG)) Q LRRSLT
S LRDFN=$$LRDFN^LR7OR1(DFN)
Q:'LRDFN LRRSLT
S LRIDT=(9999999-LREND)-.0000001
S LRIEND=9999999-STRTDT
I LRDTTYP="RAD" S LRIDT=0,LRIEND=99999999
S (PFLG,DONE)=0
F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:'LRIDT!(LRIDT>LRIEND) D Q:DONE
.I LRDTTYP="RAD" S LRRAD=$P($G(^LR(LRDFN,"MI",LRIDT,0)),U,3) I LRRAD<LRSTART!(LRRAD>LREND) Q
.S LRSITE=$P($G(^LR(LRDFN,"MI",LRIDT,0)),U,5)
.S $P(LRRSLT,"^",1)="Y"
.S TSTRSLT=$$MIRSLT(LRDFN,LRIDT,ORG)
.I $P($G(^LR(LRDFN,"MI",LRIDT,1)),U,2)="P" S PFLG=1
.I TSTRSLT="",$P(LRRSLT,"^")="Y" D
..S LIEN=LRIDT_","_LRDFN_","
..S SRCE=$$GET1^DIQ(63.05,LIEN,.05,"I")
..S TSTRSLT="NEG",$P(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";MI")
..S LRRSLT=LRRSLT_"^"_$G(SRCE)_"^"_LRSTART,DONE=1 Q
.I TSTRSLT["POS",(($P(LRRSLT,"^",2)="")!($P($P(LRRSLT,"^",2),";",3)>LRIDT)) D
..S $P(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";MI")
..I $G(DATA)'="" S MOVMENT=$P(DATA,U,4)
..S DSCHMOV=$$GET1^DIQ(405,MOVMENT,.17,"I")
..S DSCHRGE=$G(OUTDT) ;$$GET1^DIQ(405,DSCHMOV,.01,"I")
..S LIEN=LRIDT_","_LRDFN_","
..S SRCE=$$GET1^DIQ(63.05,LIEN,.05,"I")
..S COLDT=$$GET1^DIQ(63.05,LIEN,.01,"I")
..I DSCHRGE>INDT,COLDT>DSCHRGE S LRRSLT="^" Q
..S LRRSLT=LRRSLT_"^"_$G(SRCE)_"^"_LRSTART
..I COLDT<LRSTART!(COLDT>ENDDT) S LRRSLT="^",TSTRSLT=LRRSLT Q
..S CNTR=$G(CNTR)+1
..S STOP=0
..S RLOC=$$GET1^DIQ(63.05,LIEN,.111,"I")
..S DIVLOC=$$GET1^DIQ(44,+RLOC,3.5,"E")
..;Q:DIVLOC'=LOC
..;S RLOC=$$GET1^DIQ(44,+RLOC,.01,"E")
..S RLOC=$$GET1^DIQ(63.05,LIEN,.111,"I"),RLOC=+RLOC,RLOC=$$GET1^DIQ(44,RLOC,.01,"E")
..I $G(RLOC)=ORDLOC,$G(CNTR)'>1,'$D(^MMRS(104,MDIV,61,"B",SRCE)) S DONE=1,STOP=1 Q
..I $G(RLOC)=ORDLOC,$G(CNTR)'>1 M TMPDATA(DFN)=LRRSLT S LRRSLT="^" Q
..I $G(RLOC)=ORDLOC,$G(CNTR)>1,'$D(^MMRS(104,MDIV,61,"B",SRCE)) D Q
...K TMPDATA S DONE=1 Q
..Q:STOP
..Q:DONE
..I $G(RLOC)'=ORDLOC S MOVMENT=$P(DATA,"^",4)
..I $G(MOVMENT)>0 D
...S WRDLOC=$$GET1^DIQ(405,MOVMENT,.06,"E")
...I WRDLOC=ORDLOC,$G(CNTR)'>1,'$D(^MMRS(104,MDIV,61,"B",SRCE)) S DONE=1 Q
...I WRDLOC=ORDLOC,$G(CNTR)'>1 M TMPDATA(DFN)=LRRSLT S LRRSLT="^"
...I WRDLOC=ORDLOC,$G(CNTR)>1,'$D(^MMRS(104,MDIV,61,"B",SRCE)) D
....K TMPDATA S DONE=1 Q
...I WRDLOC'=ORDLOC S (TSTRSLT,LRRSLT)="^"
I $D(TMPDATA(DFN)) M LRRSLT=TMPDATA(DFN)
Q LRRSLT
;
CHRSLT(LRDFN,LRIDT,LRMDRO,LRTST) ;RETURNS 'POS' OR NULL STRING (IF NOT POSITIVE)
N RESULT,LRLOC,LRND,LRPC,LRRES,LRIND,LRINDVAL,LRSPEC,LRLOW,LRHIG
S RESULT=""
S LRLOC=$P($G(^LAB(60,+LRTST,0)),U,5)
S LRND=$P(LRLOC,";",2) Q:+LRND'>0 RESULT
S LRPC=$P(LRLOC,";",3) Q:+LRPC'>0 RESULT
S LRRES=$P($G(^LR(LRDFN,"CH",LRIDT,LRND)),U,LRPC) Q:LRRES="" RESULT
S LRIND=$P($G(^TMP($J,"MMRSCRE","T",LRMDRO,LRTST,0)),U,1)
S LRINDVAL=$P($G(^TMP($J,"MMRSCRE","T",LRMDRO,LRTST,0)),U,2)
Q:LRIND="" RESULT
I LRIND=1 D Q RESULT
.Q:'LRRES
.S LRSPEC=$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,5) Q:LRSPEC=""
.Q:'$D(^LAB(60,LRTST,1,LRSPEC,0))
.S LRLOW=$P(^LAB(60,LRTST,1,LRSPEC,0),U,2),LRHIG=$P(^LAB(60,LRTST,1,LRSPEC,0),U,3)
.Q:'LRLOW!('LRHIG)
.I LRRES<LRLOW!(LRRES>LRHIG) S RESULT="POS" Q
I LRINDVAL="" Q RESULT
S LRRES=$$UP^XLFSTR(LRRES),LRINDVAL=$$UP^XLFSTR(LRINDVAL)
I LRIND=2,(LRRES[LRINDVAL) Q "POS"
I LRIND=3,(LRRES>LRINDVAL) Q "POS"
I LRIND=4,(LRRES<LRINDVAL) Q "POS"
I LRIND=5,(LRRES=LRINDVAL) Q "POS"
Q RESULT
MIRSLT(LRDFN,LRIDT,LRMDRO) ;RETURNS 'POS' OR NULL STRING (IF NOT POSITIVE)
N RESULT,LRETND,LRETI,LRANTI,LRANTIND,LRANTINV,LRAND,LRRES,BACTRPT,RPTRMRK,LRANTIEN
S RESULT=""
;Check Etiology
I $D(^TMP($J,"MMRSCRE","ETIOL",LRMDRO)) D Q:RESULT="POS" RESULT
.S LRETND=0 F S LRETND=$O(^LR(LRDFN,"MI",LRIDT,3,LRETND)) Q:'LRETND!(RESULT="POS") D
..S LRETI=$P($G(^LR(LRDFN,"MI",LRIDT,3,LRETND,0)),U)
..Q:+LRETI'>0
..I ('$O(^TMP($J,"MMRSCRE","ETIOL",LRMDRO,LRETI,0))) D Q
...I $D(^TMP($J,"MMRSCRE","ETIOL",LRMDRO,LRETI)) S RESULT="POS"
..S LRANTI=0 F S LRANTI=$O(^TMP($J,"MMRSCRE","ETIOL",LRMDRO,LRETI,LRANTI)) Q:'LRANTI D
...S LRANTIEN=$P(^TMP($J,"MMRSCRE","ETIOL",LRMDRO,LRETI,LRANTI),U,1)
...S LRANTIND=$P(^TMP($J,"MMRSCRE","ETIOL",LRMDRO,LRETI,LRANTI),U,2)
...S LRANTINV=$P(^TMP($J,"MMRSCRE","ETIOL",LRMDRO,LRETI,LRANTI),U,3)
...;S LRAND=$P($G(^LAB(62.06,LRANTI,0)),U,2) Q:LRAND=""
...S LRAND=$$ABDN^LRPXAPIU(LRANTIEN) Q:'LRAND
...Q:$P($G(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2)=""
...Q:$$UP^XLFSTR($E($P($G(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2),1,1))="S"
...I LRANTIND=""!(LRANTINV="") Q
...;S LRRES=$$UP^XLFSTR($E($P($G(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2),1,1))
...S LRRES=$$UP^XLFSTR($P($G(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2))
...S LRANTINV=$$UP^XLFSTR(LRANTINV)
...S LRANTIND=$$UP^XLFSTR(LRANTIND)
...I LRANTIND=1,(LRRES[LRANTINV) S RESULT="POS" Q
...I LRANTIND=2,(LRRES>LRANTINV) S RESULT="POS" Q
...I LRANTIND=3,(LRRES<LRANTINV) S RESULT="POS" Q
...I LRANTIND=4,(LRRES=LRANTINV) S RESULT="POS" Q
Q:RESULT="POS" "POS"
;Check Bacteriology Report Remarks
I '$D(^TMP($J,"MMRSCRE","BACT",LRMDRO,"INC_REMARK")) Q RESULT
S BACTRPT=0 F S BACTRPT=$O(^LR(LRDFN,"MI",LRIDT,4,BACTRPT)) Q:'BACTRPT!(RESULT="POS") D
.S RPTRMRK=$P($G(^LR(LRDFN,"MI",LRIDT,4,BACTRPT,0)),U,1)
.Q:RPTRMRK=""
.I $$BACTRPT(LRMDRO,"INC_REMARK",RPTRMRK)&('$$BACTRPT(LRMDRO,"EXC_REMARK",RPTRMRK)) S RESULT="POS"
Q RESULT
;
SCRNTOP(LRSITE,LRMDRO) ;CHECK TO SEE IF SCREEN ON SITE
Q:+LRSITE'>0 0
I $D(^TMP($J,"MMRSCRE","TOP",LRMDRO,"INC_TOP"))&$D(^TMP($J,"MMRSCRE","TOP",LRMDRO,"EXC_TOP")) Q 0
I '$D(^TMP($J,"MMRSCRE","TOP",LRMDRO,"INC_TOP"))&'$D(^TMP($J,"MMRSCRE","TOP",LRMDRO,"EXC_TOP")) Q 0
I ($D(^TMP($J,"MMRSCRE","TOP",LRMDRO,"INC_TOP")))&($D(^TMP($J,"MMRSCRE","TOP",LRMDRO,"INC_TOP",LRSITE))) Q 0
I ($D(^TMP($J,"MMRSCRE","TOP",LRMDRO,"EXC_TOP")))&('$D(^TMP($J,"MMRSCRE","TOP",LRMDRO,"EXC_TOP",LRSITE))) Q 0
Q 1
BACTRPT(LRMDRO,RPTTYPE,RPTRMRK) ;Is this comment contained in the parameters
N RESULT,MMRSI,LRINDVAL
S RESULT=0
S MMRSI=0 F S MMRSI=$O(^TMP($J,"MMRSCRE","BACT",LRMDRO,RPTTYPE,MMRSI)) Q:'MMRSI!(RESULT=1) D
.S LRINDVAL=$G(^TMP($J,"MMRSCRE","BACT",LRMDRO,RPTTYPE,MMRSI))
.I ($$UP^XLFSTR(RPTRMRK))[($$UP^XLFSTR(LRINDVAL)) S RESULT=1
Q RESULT
;
END ;
K A,ACT,ADMDT,CC,COLDT,CR,DIV,DIVLOC,DONE,DSCHMOV,DSCHRGE,DTA
K ENDDT,I,LIEN,LRD,LRDT,LRSS,MDIV,MDROETIO,MOVEMENT,NEG
K ORDLOC,ORG,PFLG,RES,RLOC,SRCE,STOP,STRTDT,SUBS,SURV,SVC
K TRNACT,TSTSTP,WRDLOC,X,DSCHRG,MOVMENT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMMRSCRE3 15236 printed Dec 13, 2024@02:15:12 Page 2
MMRSCRE3 ;LEIDOS/TCK - Print CRE Report Cont. (Contains functions to collect patient labs and swabbing rate) ; 3/3/17 10:47am
+1 ;;1.0;MDRO PROGRAM TOOLS;**4,5**;Jun 01, 2016;Build 146
+2 ;
GETLABS ;Gets all lab data for the report.
+1 NEW LRMDRO,LOC,INDT,DFN,OUTDT,NARES24,NARES48,SURV48,CULT48,MRSA365,CULT365,KNOWMRSA,KNOWCULT,NARES24A,NARES48ASURV48A,NARES48A
+2 NEW MRSAFR,MRSATO,MRSA365A,CULT365A,SURV48A,NARES24D,NARES48D,SURV48D,MRSACPRD,TRANS,MMRSNOW
+3 NEW CNTR
+4 SET CNTR=0
+5 SET MMRSNOW=$$NOW^XLFDT()
SET LREND=MMRSNOW
+6 SET LRMDRO=""
SET LRMDRO=$ORDER(^MMRS(104.2,"B","CRB-R",LRMDRO))
+7 SET ^TMP($JOB,"MMRSCRE","DSUM")="0^0^0^0^0^0^0^0^0"
+8 SET LOC=""
FOR
SET LOC=$ORDER(^TMP($JOB,"MMRSCRE","D",LOC))
if LOC=""
QUIT
Begin DoDot:1
+9 SET ^TMP($JOB,"MMRSCRE","DSUM",LOC)="0^0^0^0^0^0^0^0^0"
+10 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"MMRSCRE","D",LOC,DFN))
if 'DFN
QUIT
Begin DoDot:2
+11 SET INDT=""
FOR
SET INDT=$ORDER(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT))
if 'INDT
QUIT
Begin DoDot:3
+12 SET DIV=""
SET DIV=$ORDER(^DG(40.8,"B",LOC,DIV))
+13 IF DIV'=""
SET MDIV=""
SET MDIV=$ORDER(^MMRS(104,"B",DIV,MDIV))
+14 if $GET(MDIV)'>0
QUIT
+15 SET (CR,MRSA)=""
+16 SET LOCSUM=$GET(^TMP($JOB,"MMRSCRE","DSUM",LOC))
+17 SET SUM=$GET(^TMP($JOB,"MMRSCRE","DSUM"))
+18 SET DATA=$GET(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT))
+19 SET OUTDT=$PIECE(DATA,"^",10)
+20 SET ORDLOC=$PIECE(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT),"^")
+21 IF $GET(ORDLOC)'=""
SET ORDLOC=$$GET1^DIQ(42,ORDLOC,.01,"E")
+22 IF $PIECE(DATA,U,5)=1
Begin DoDot:4
+23 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,1)=$PIECE(LOCSUM,U,1)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,1)=$PIECE(SUM,U,1)+1
End DoDot:4
+24 SET MRSA=$$GETLAB(DFN,INDT,LRMDRO,LREND,"CD")
+25 SET (CR,I,COLDT)=""
SET DONE=0
+26 if MRSA=""
QUIT
+27 SET CR=$PIECE($PIECE(MRSA,"^",2),";")
IF CR=""
SET CR="NEG"
+28 if CR=""
QUIT
+29 SET DTA=$PIECE(MRSA,"^",2)
SET LRD=$PIECE(DTA,";",2)
SET LRDT=$PIECE(DTA,";",3)
SET LIEN=LRDT_","_LRD_","
+30 SET LIENS=LRDT_","_LRD_","
+31 SET COLDT=$$GET1^DIQ(63.05,LIEN,.01,"I")
+32 SET SRCE=$PIECE(MRSA,"^",3)
+33 if SRCE=""
QUIT
+34 SET SVC="N"
SET CC="Y"
+35 SET DATA=$GET(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT))
+36 if DATA=""
QUIT
+37 SET ADMDT=$PIECE(DATA,"^",3)
SET MOVMENT=$PIECE(DATA,"^",4)
+38 SET DTA=$PIECE(MRSA,"^",2)
SET LRD=$PIECE(DTA,";",2)
SET LRDT=$PIECE(DTA,";",3)
SET LRSS=$PIECE(DTA,";",4)
SET NEG=$PIECE(DTA,";")
+39 SET LIENS=LRDT_","_LRD_","
+40 SET COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
+41 IF $GET(MOVMENT)>0
Begin DoDot:4
+42 ;$$GET1^DIQ(405,MOVMENT,.02,"E")
SET TRNACT=$PIECE(DATA,U,5)
+43 ;"ADMISSION"
IF TRNACT'=1
SET DONE=1
QUIT
+44 ;S DSCHRGE=$$GET1^DIQ(405,MOVMENT,.17,"I")
+45 ;$$GET1^DIQ(405,DSCHRGE,.01,"I")
SET DSCHRGE=OUTDT
+46 IF $GET(DSCHRGE)'=""
Begin DoDot:5
+47 SET DTA=$PIECE(MRSA,"^",2)
SET LRD=$PIECE(DTA,";",2)
SET LRDT=$PIECE(DTA,";",3)
SET LRSS=$PIECE(DTA,";",4)
SET NEG=$PIECE(DTA,";")
+48 if $GET(DTA)=""
QUIT
+49 SET LIENS=LRDT_","_LRD_","
+50 SET COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
+51 IF DSCHRGE<COLDT
Begin DoDot:6
+52 KILL ^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT)
+53 KILL ^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT)
+54 KILL LIENS
SET DONE=1
End DoDot:6
End DoDot:5
End DoDot:4
+55 if DONE
QUIT
+56 IF $DATA(^MMRS(104,MDIV,61,"B",SRCE))
SET SVC="Y"
SET CC="N"
+57 IF $DATA(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT))
Begin DoDot:4
+58 SET DATA=$GET(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT))
+59 SET ACT=$PIECE(DATA,"^",5)
+60 if $PIECE(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT),"^",13)=""
QUIT
+61 SET DTA=$PIECE(MRSA,"^",2)
SET LRD=$PIECE(DTA,";",2)
SET LRDT=$PIECE(DTA,";",3)
SET LRSS=$PIECE(DTA,";",4)
SET NEG=$PIECE(DTA,";")
+62 if $GET(DTA)=""
QUIT
+63 SET LIENS=LRDT_","_LRD_","
+64 SET COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
+65 SET X=$$FMDIFF^XLFDT(COLDT,INDT,3)
SET X=$PIECE(X," ")
+66 IF X>2!('CR)
Begin DoDot:5
+67 KILL MRSA
+68 IF $DATA(^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT))
KILL ^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT)
End DoDot:5
QUIT
+69 SET SURV=$PIECE(^TMP($JOB,"MMRSCRE","D",LOC,INDT,DFN),"^",13)
+70 IF SURV=SVC
KILL MRSA(I)
QUIT
+71 IF SURV'=SVC
SET $PIECE(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT),"^",13)="N"
SET $PIECE(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT),"^",14)="Y"
KILL MRSA(I)
End DoDot:4
+72 if $GET(MRSA)=""
QUIT
+73 IF CR["POS"
IF 'PFLG
Begin DoDot:4
+74 if $DATA(^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT))
QUIT
+75 SET ^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT)=$PIECE(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT),U,6,9)
End DoDot:4
+76 IF CR["POS"
IF $DATA(^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT))
IF $PIECE(^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT),U,13)=""
IF 'PFLG
SET ^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT)=^TMP($JOB,"MMRSCRE","DETAIL",LOC,INDT)_U_COLDT_U_SRCE_U_SVC_U_CC_U_CR
+77 ;(ADM - 1 year) or (START DT - 1 year) - whichever is later
SET MRSAFR=(INDT-10000)
IF STRTDT>INDT
SET MRSAFR=(STRTDT-10000)
+78 ;Calculate prevalence measures
DO PREV
End DoDot:3
End DoDot:2
End DoDot:1
+79 SET X=""
+80 QUIT
+81 ;
PREV ;Calculate prevalence measures (summary report)
+1 NEW LOCSUM,SUM,DATA,IND
+2 SET LOCSUM=$GET(^TMP($JOB,"MMRSCRE","DSUM",LOC))
+3 SET SUM=$GET(^TMP($JOB,"MMRSCRE","DSUM"))
+4 SET DATA=$GET(^TMP($JOB,"MMRSCRE","D",LOC,DFN,INDT))
+5 IF $PIECE(DATA,U,5)'>2
Begin DoDot:1
+6 if MRSA'[";"
QUIT
+7 SET DTA=$PIECE(MRSA,"^",2)
SET LRD=$PIECE(DTA,";",2)
SET LRDT=$PIECE(DTA,";",3)
SET LRSS=$PIECE(DTA,";",4)
SET NEG=$PIECE(DTA,";")
+8 if $GET(DTA)=""
QUIT
+9 SET LIENS=LRDT_","_LRD_","
+10 SET COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
+11 if COLDT>ENDDT
QUIT
+12 if COLDT<INDT
QUIT
+13 SET X=$$FMDIFF^XLFDT(COLDT,INDT,3)
SET X=$PIECE(X," ")
+14 IF X<3
Begin DoDot:2
+15 IF SVC="Y"
Begin DoDot:3
+16 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,2)=$PIECE(LOCSUM,U,2)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,2)=$PIECE(SUM,U,2)+1
+17 IF NEG="POS"
IF 'PFLG
Begin DoDot:4
+18 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,3)=$PIECE(LOCSUM,U,3)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,3)=$PIECE(SUM,U,3)+1
+19 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,8)=$PIECE(LOCSUM,U,8)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,8)=$PIECE(SUM,U,8)+1
End DoDot:4
End DoDot:3
+20 IF SVC="N"
IF NEG="POS"
IF 'PFLG
Begin DoDot:3
+21 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,4)=$PIECE(LOCSUM,U,4)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,4)=$PIECE(SUM,U,4)+1
+22 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,8)=$PIECE(LOCSUM,U,8)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,8)=$PIECE(SUM,U,8)+1
End DoDot:3
End DoDot:2
+23 IF X>2
Begin DoDot:2
+24 IF SVC="Y"
Begin DoDot:3
+25 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,5)=$PIECE(LOCSUM,U,5)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,5)=$PIECE(SUM,U,5)+1
+26 IF NEG["POS"
IF 'PFLG
Begin DoDot:4
+27 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,6)=$PIECE(LOCSUM,U,6)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,6)=$PIECE(SUM,U,6)+1
+28 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,8)=$PIECE(LOCSUM,U,8)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,8)=$PIECE(SUM,U,8)+1
End DoDot:4
End DoDot:3
+29 IF SVC="N"
IF NEG["POS"
IF 'PFLG
Begin DoDot:3
+30 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,7)=$PIECE(LOCSUM,U,7)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,7)=$PIECE(SUM,U,7)+1
+31 SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM",LOC),U,8)=$PIECE(LOCSUM,U,8)+1
SET $PIECE(^TMP($JOB,"MMRSCRE","DSUM"),U,8)=$PIECE(SUM,U,8)+1
End DoDot:3
End DoDot:2
End DoDot:1
+32 KILL MRSA
+33 QUIT
+34 ;
CLNARY(LOC,DFN,MRSA) ;
+1 NEW D,ST,VAL,XX,OUTDT
+2 ;Q:'$D(MRSA(1)
+3 SET XX=9999
SET XX=$ORDER(MRSA(XX),-1)
+4 SET D=""
FOR
SET D=$ORDER(MRSA(D))
if D=""
QUIT
Begin DoDot:1
+5 SET IND=$PIECE(MRSA(D),"^",4)
+6 SET RES=$PIECE($PIECE(MRSA(D),"^",2),";")
+7 IF RES=""!(RES["NEG")
KILL MRSA(D)
QUIT
+8 if '$DATA(^TMP($JOB,"MMRSCRE","D",LOC,IND,DFN))
QUIT
+9 KILL ^TMP($JOB,"MMRSCRE","D",LOC,IND,DFN),MRSA(D)
+10 SET DTA=MRSA(D)
+11 if DTA=""
QUIT
+12 SET LRD=$PIECE(DTA,";",2)
SET LRDT=$PIECE(DTA,";",3)
+13 SET DATA=$GET(^TMP($JOB,"MMRSCRE","D",LOC,IND,DFN))
+14 SET ADMDT=$PIECE(DATA,"^",3)
SET MOVMENT=$PIECE(DATA,"^",4)
+15 SET OUTDT=$PIECE(DATA,"^",10)
+16 ;$$GET1^DIQ(405,MOVMENT,.17,"I")
SET DSCHRG=OUTDT
+17 ;I $G(DSCHRG)>0 S DSCHRG=$$GET1^DIQ(405,MOVMENT,.01,"I")
+18 IF DSCHRG'=""
Begin DoDot:2
+19 SET LIENS=LRDT_","_LRD_","
+20 SET COLDT=$$GET1^DIQ(63.05,LIENS,.01,"I")
+21 IF DSCHRG<COLDT
KILL ^TMP($JOB,"MMRSCRE","D",LOC,IND,DFN),MRSA(D)
SET DONE=1
QUIT
End DoDot:2
QUIT
+22 SET A=D-1
IF $DATA(MRSA(A))
KILL MRSA(D)
QUIT
End DoDot:1
+23 QUIT
GETLAB(DFN,LRSTART,LRMDRO,LREND,LRDTTYP) ;RETURN YES/NO^RESULT
+1 NEW LRRSLT,LRTST,TMPRSLT
+2 SET LRRSLT="^"
SET TMPRSLT=""
+3 IF $GET(DFN)=""!($GET(LRMDRO)="")!($GET(LRSTART)="")!($GET(LREND)="")
QUIT LRRSLT
+4 ;GET CH RSLTS
+5 IF MDROETIO
Begin DoDot:1
+6 SET TMPRSLT=$$GETMI(DFN,LRMDRO,LRSTART,LREND,LRDTTYP)
End DoDot:1
+7 IF TSTSTP
Begin DoDot:1
+8 SET LRTST=0
FOR
SET LRTST=$ORDER(^TMP($JOB,"MMRSCRE","T",LRMDRO,LRTST))
if 'LRTST
QUIT
Begin DoDot:2
End DoDot:2
+9 SET SUBS=$$GET1^DIQ(60,+LRTST,4,"I")
+10 IF SUBS="CH"
SET TMPRSLT=$$GETCH(DFN,LRMDRO,LRTST,LRSTART,LREND,LRDTTYP)
End DoDot:1
+11 QUIT TMPRSLT
+12 ;
GETCH(DFN,LRMDRO,LRTST,LRSTART,LREND,LRDTTYP,MRSA) ;RETURN YES^RESULT
+1 NEW LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD
+2 SET LRRSLT="^"
+3 SET LRDFN=$$LRDFN^LR7OR1(DFN)
+4 if 'LRDFN
QUIT LRRSLT
+5 SET LRDATE=LRSTART-.0000001
+6 IF LRDTTYP="RAD"
SET LRDATE=0
SET LRRADEND=LREND
SET LREND=9999999
+7 FOR
SET LRDATE=$ORDER(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE))
if 'LRDATE!(LRDATE>LREND)
QUIT
Begin DoDot:1
+8 if LRDATE>ENDDT
QUIT
+9 if LRDATE<STRTDT
QUIT
+10 SET DAS=0
FOR
SET DAS=$ORDER(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE,DAS))
if 'DAS
QUIT
Begin DoDot:2
+11 SET LRIDT=$PIECE(DAS,";",3)
+12 IF LRDTTYP="RAD"
SET LRRAD=$PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,3)
IF LRRAD<LRSTART!(LRRAD>LRRADEND)
QUIT
+13 if LRDATE<STRTDT
QUIT
+14 if LRDATE>ENDDT
QUIT
+15 if $PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,3)=""
QUIT
+16 ;GET ORDER NUMBER FROM ORUT MODE
+17 SET LRSITE=$PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,5)
+18 ;Q:$$SCRNTOP(LRSITE,LRMDRO)
+19 ;I $D(^LR(LRDFN,"CH",LRIDT,0)),$P(^LR(LRDFN,"CH",LRIDT,0),U,3) D
+20 SET $PIECE(LRRSLT,"^",1)="Y"
+21 SET TSTRSLT=$$CHRSLT(LRDFN,LRIDT,LRMDRO,LRTST)
+22 IF TSTRSLT["POS"
IF (($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>LRIDT))
Begin DoDot:3
End DoDot:3
+23 IF ($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>LRIDT)
Begin DoDot:3
+24 SET $PIECE(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";CH")
+25 SET LIEN=LRIDT_","_LRDFN_","
+26 SET SRCE=$$GET1^DIQ(63.04,LIEN,.05,"E")
+27 SET LRRSLT=LRRSLT_"^"_$GET(SRCE)
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT LRRSLT
+29 ;
GETMI(DFN,LRMDRO,LRSTART,LREND,LRDTTYP) ;RETURN YES^RESULT
+1 NEW LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD,LRIEND,CNTR
+2 SET LRRSLT="^"
SET CNTR=0
+3 IF '$DATA(^TMP($JOB,"MMRSCRE","BACT",ORG,"INC_REMARK"))
IF '$DATA(^TMP($JOB,"MMRSCRE","ETIOL",ORG))
QUIT LRRSLT
+4 SET LRDFN=$$LRDFN^LR7OR1(DFN)
+5 if 'LRDFN
QUIT LRRSLT
+6 SET LRIDT=(9999999-LREND)-.0000001
+7 SET LRIEND=9999999-STRTDT
+8 IF LRDTTYP="RAD"
SET LRIDT=0
SET LRIEND=99999999
+9 SET (PFLG,DONE)=0
+10 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
if 'LRIDT!(LRIDT>LRIEND)
QUIT
Begin DoDot:1
+11 IF LRDTTYP="RAD"
SET LRRAD=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,0)),U,3)
IF LRRAD<LRSTART!(LRRAD>LREND)
QUIT
+12 SET LRSITE=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,0)),U,5)
+13 SET $PIECE(LRRSLT,"^",1)="Y"
+14 SET TSTRSLT=$$MIRSLT(LRDFN,LRIDT,ORG)
+15 IF $PIECE($GET(^LR(LRDFN,"MI",LRIDT,1)),U,2)="P"
SET PFLG=1
+16 IF TSTRSLT=""
IF $PIECE(LRRSLT,"^")="Y"
Begin DoDot:2
+17 SET LIEN=LRIDT_","_LRDFN_","
+18 SET SRCE=$$GET1^DIQ(63.05,LIEN,.05,"I")
+19 SET TSTRSLT="NEG"
SET $PIECE(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";MI")
+20 SET LRRSLT=LRRSLT_"^"_$GET(SRCE)_"^"_LRSTART
SET DONE=1
QUIT
End DoDot:2
+21 IF TSTRSLT["POS"
IF (($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>LRIDT))
Begin DoDot:2
+22 SET $PIECE(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";MI")
+23 IF $GET(DATA)'=""
SET MOVMENT=$PIECE(DATA,U,4)
+24 SET DSCHMOV=$$GET1^DIQ(405,MOVMENT,.17,"I")
+25 ;$$GET1^DIQ(405,DSCHMOV,.01,"I")
SET DSCHRGE=$GET(OUTDT)
+26 SET LIEN=LRIDT_","_LRDFN_","
+27 SET SRCE=$$GET1^DIQ(63.05,LIEN,.05,"I")
+28 SET COLDT=$$GET1^DIQ(63.05,LIEN,.01,"I")
+29 IF DSCHRGE>INDT
IF COLDT>DSCHRGE
SET LRRSLT="^"
QUIT
+30 SET LRRSLT=LRRSLT_"^"_$GET(SRCE)_"^"_LRSTART
+31 IF COLDT<LRSTART!(COLDT>ENDDT)
SET LRRSLT="^"
SET TSTRSLT=LRRSLT
QUIT
+32 SET CNTR=$GET(CNTR)+1
+33 SET STOP=0
+34 SET RLOC=$$GET1^DIQ(63.05,LIEN,.111,"I")
+35 SET DIVLOC=$$GET1^DIQ(44,+RLOC,3.5,"E")
+36 ;Q:DIVLOC'=LOC
+37 ;S RLOC=$$GET1^DIQ(44,+RLOC,.01,"E")
+38 SET RLOC=$$GET1^DIQ(63.05,LIEN,.111,"I")
SET RLOC=+RLOC
SET RLOC=$$GET1^DIQ(44,RLOC,.01,"E")
+39 IF $GET(RLOC)=ORDLOC
IF $GET(CNTR)'>1
IF '$DATA(^MMRS(104,MDIV,61,"B",SRCE))
SET DONE=1
SET STOP=1
QUIT
+40 IF $GET(RLOC)=ORDLOC
IF $GET(CNTR)'>1
MERGE TMPDATA(DFN)=LRRSLT
SET LRRSLT="^"
QUIT
+41 IF $GET(RLOC)=ORDLOC
IF $GET(CNTR)>1
IF '$DATA(^MMRS(104,MDIV,61,"B",SRCE))
Begin DoDot:3
+42 KILL TMPDATA
SET DONE=1
QUIT
End DoDot:3
QUIT
+43 if STOP
QUIT
+44 if DONE
QUIT
+45 IF $GET(RLOC)'=ORDLOC
SET MOVMENT=$PIECE(DATA,"^",4)
+46 IF $GET(MOVMENT)>0
Begin DoDot:3
+47 SET WRDLOC=$$GET1^DIQ(405,MOVMENT,.06,"E")
+48 IF WRDLOC=ORDLOC
IF $GET(CNTR)'>1
IF '$DATA(^MMRS(104,MDIV,61,"B",SRCE))
SET DONE=1
QUIT
+49 IF WRDLOC=ORDLOC
IF $GET(CNTR)'>1
MERGE TMPDATA(DFN)=LRRSLT
SET LRRSLT="^"
+50 IF WRDLOC=ORDLOC
IF $GET(CNTR)>1
IF '$DATA(^MMRS(104,MDIV,61,"B",SRCE))
Begin DoDot:4
+51 KILL TMPDATA
SET DONE=1
QUIT
End DoDot:4
+52 IF WRDLOC'=ORDLOC
SET (TSTRSLT,LRRSLT)="^"
End DoDot:3
End DoDot:2
End DoDot:1
if DONE
QUIT
+53 IF $DATA(TMPDATA(DFN))
MERGE LRRSLT=TMPDATA(DFN)
+54 QUIT LRRSLT
+55 ;
CHRSLT(LRDFN,LRIDT,LRMDRO,LRTST) ;RETURNS 'POS' OR NULL STRING (IF NOT POSITIVE)
+1 NEW RESULT,LRLOC,LRND,LRPC,LRRES,LRIND,LRINDVAL,LRSPEC,LRLOW,LRHIG
+2 SET RESULT=""
+3 SET LRLOC=$PIECE($GET(^LAB(60,+LRTST,0)),U,5)
+4 SET LRND=$PIECE(LRLOC,";",2)
if +LRND'>0
QUIT RESULT
+5 SET LRPC=$PIECE(LRLOC,";",3)
if +LRPC'>0
QUIT RESULT
+6 SET LRRES=$PIECE($GET(^LR(LRDFN,"CH",LRIDT,LRND)),U,LRPC)
if LRRES=""
QUIT RESULT
+7 SET LRIND=$PIECE($GET(^TMP($JOB,"MMRSCRE","T",LRMDRO,LRTST,0)),U,1)
+8 SET LRINDVAL=$PIECE($GET(^TMP($JOB,"MMRSCRE","T",LRMDRO,LRTST,0)),U,2)
+9 if LRIND=""
QUIT RESULT
+10 IF LRIND=1
Begin DoDot:1
+11 if 'LRRES
QUIT
+12 SET LRSPEC=$PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,5)
if LRSPEC=""
QUIT
+13 if '$DATA(^LAB(60,LRTST,1,LRSPEC,0))
QUIT
+14 SET LRLOW=$PIECE(^LAB(60,LRTST,1,LRSPEC,0),U,2)
SET LRHIG=$PIECE(^LAB(60,LRTST,1,LRSPEC,0),U,3)
+15 if 'LRLOW!('LRHIG)
QUIT
+16 IF LRRES<LRLOW!(LRRES>LRHIG)
SET RESULT="POS"
QUIT
End DoDot:1
QUIT RESULT
+17 IF LRINDVAL=""
QUIT RESULT
+18 SET LRRES=$$UP^XLFSTR(LRRES)
SET LRINDVAL=$$UP^XLFSTR(LRINDVAL)
+19 IF LRIND=2
IF (LRRES[LRINDVAL)
QUIT "POS"
+20 IF LRIND=3
IF (LRRES>LRINDVAL)
QUIT "POS"
+21 IF LRIND=4
IF (LRRES<LRINDVAL)
QUIT "POS"
+22 IF LRIND=5
IF (LRRES=LRINDVAL)
QUIT "POS"
+23 QUIT RESULT
MIRSLT(LRDFN,LRIDT,LRMDRO) ;RETURNS 'POS' OR NULL STRING (IF NOT POSITIVE)
+1 NEW RESULT,LRETND,LRETI,LRANTI,LRANTIND,LRANTINV,LRAND,LRRES,BACTRPT,RPTRMRK,LRANTIEN
+2 SET RESULT=""
+3 ;Check Etiology
+4 IF $DATA(^TMP($JOB,"MMRSCRE","ETIOL",LRMDRO))
Begin DoDot:1
+5 SET LRETND=0
FOR
SET LRETND=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRETND))
if 'LRETND!(RESULT="POS")
QUIT
Begin DoDot:2
+6 SET LRETI=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,3,LRETND,0)),U)
+7 if +LRETI'>0
QUIT
+8 IF ('$ORDER(^TMP($JOB,"MMRSCRE","ETIOL",LRMDRO,LRETI,0)))
Begin DoDot:3
+9 IF $DATA(^TMP($JOB,"MMRSCRE","ETIOL",LRMDRO,LRETI))
SET RESULT="POS"
End DoDot:3
QUIT
+10 SET LRANTI=0
FOR
SET LRANTI=$ORDER(^TMP($JOB,"MMRSCRE","ETIOL",LRMDRO,LRETI,LRANTI))
if 'LRANTI
QUIT
Begin DoDot:3
+11 SET LRANTIEN=$PIECE(^TMP($JOB,"MMRSCRE","ETIOL",LRMDRO,LRETI,LRANTI),U,1)
+12 SET LRANTIND=$PIECE(^TMP($JOB,"MMRSCRE","ETIOL",LRMDRO,LRETI,LRANTI),U,2)
+13 SET LRANTINV=$PIECE(^TMP($JOB,"MMRSCRE","ETIOL",LRMDRO,LRETI,LRANTI),U,3)
+14 ;S LRAND=$P($G(^LAB(62.06,LRANTI,0)),U,2) Q:LRAND=""
+15 SET LRAND=$$ABDN^LRPXAPIU(LRANTIEN)
if 'LRAND
QUIT
+16 if $PIECE($GET(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2)=""
QUIT
+17 if $$UP^XLFSTR($EXTRACT($PIECE($GET(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2),1,1))="S"
QUIT
+18 IF LRANTIND=""!(LRANTINV="")
QUIT
+19 ;S LRRES=$$UP^XLFSTR($E($P($G(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2),1,1))
+20 SET LRRES=$$UP^XLFSTR($PIECE($GET(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2))
+21 SET LRANTINV=$$UP^XLFSTR(LRANTINV)
+22 SET LRANTIND=$$UP^XLFSTR(LRANTIND)
+23 IF LRANTIND=1
IF (LRRES[LRANTINV)
SET RESULT="POS"
QUIT
+24 IF LRANTIND=2
IF (LRRES>LRANTINV)
SET RESULT="POS"
QUIT
+25 IF LRANTIND=3
IF (LRRES<LRANTINV)
SET RESULT="POS"
QUIT
+26 IF LRANTIND=4
IF (LRRES=LRANTINV)
SET RESULT="POS"
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
if RESULT="POS"
QUIT RESULT
+27 if RESULT="POS"
QUIT "POS"
+28 ;Check Bacteriology Report Remarks
+29 IF '$DATA(^TMP($JOB,"MMRSCRE","BACT",LRMDRO,"INC_REMARK"))
QUIT RESULT
+30 SET BACTRPT=0
FOR
SET BACTRPT=$ORDER(^LR(LRDFN,"MI",LRIDT,4,BACTRPT))
if 'BACTRPT!(RESULT="POS")
QUIT
Begin DoDot:1
+31 SET RPTRMRK=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,4,BACTRPT,0)),U,1)
+32 if RPTRMRK=""
QUIT
+33 IF $$BACTRPT(LRMDRO,"INC_REMARK",RPTRMRK)&('$$BACTRPT(LRMDRO,"EXC_REMARK",RPTRMRK))
SET RESULT="POS"
End DoDot:1
+34 QUIT RESULT
+35 ;
SCRNTOP(LRSITE,LRMDRO) ;CHECK TO SEE IF SCREEN ON SITE
+1 if +LRSITE'>0
QUIT 0
+2 IF $DATA(^TMP($JOB,"MMRSCRE","TOP",LRMDRO,"INC_TOP"))&$DATA(^TMP($JOB,"MMRSCRE","TOP",LRMDRO,"EXC_TOP"))
QUIT 0
+3 IF '$DATA(^TMP($JOB,"MMRSCRE","TOP",LRMDRO,"INC_TOP"))&'$DATA(^TMP($JOB,"MMRSCRE","TOP",LRMDRO,"EXC_TOP"))
QUIT 0
+4 IF ($DATA(^TMP($JOB,"MMRSCRE","TOP",LRMDRO,"INC_TOP")))&($DATA(^TMP($JOB,"MMRSCRE","TOP",LRMDRO,"INC_TOP",LRSITE)))
QUIT 0
+5 IF ($DATA(^TMP($JOB,"MMRSCRE","TOP",LRMDRO,"EXC_TOP")))&('$DATA(^TMP($JOB,"MMRSCRE","TOP",LRMDRO,"EXC_TOP",LRSITE)))
QUIT 0
+6 QUIT 1
BACTRPT(LRMDRO,RPTTYPE,RPTRMRK) ;Is this comment contained in the parameters
+1 NEW RESULT,MMRSI,LRINDVAL
+2 SET RESULT=0
+3 SET MMRSI=0
FOR
SET MMRSI=$ORDER(^TMP($JOB,"MMRSCRE","BACT",LRMDRO,RPTTYPE,MMRSI))
if 'MMRSI!(RESULT=1)
QUIT
Begin DoDot:1
+4 SET LRINDVAL=$GET(^TMP($JOB,"MMRSCRE","BACT",LRMDRO,RPTTYPE,MMRSI))
+5 IF ($$UP^XLFSTR(RPTRMRK))[($$UP^XLFSTR(LRINDVAL))
SET RESULT=1
End DoDot:1
+6 QUIT RESULT
+7 ;
END ;
+1 KILL A,ACT,ADMDT,CC,COLDT,CR,DIV,DIVLOC,DONE,DSCHMOV,DSCHRGE,DTA
+2 KILL ENDDT,I,LIEN,LRD,LRDT,LRSS,MDIV,MDROETIO,MOVEMENT,NEG
+3 KILL ORDLOC,ORG,PFLG,RES,RLOC,SRCE,STOP,STRTDT,SUBS,SURV,SVC
+4 KILL TRNACT,TSTSTP,WRDLOC,X,DSCHRG,MOVMENT
+5 QUIT
+6 ;
