MMRSIPC3 ;MIA/LMT - Print MRSA Report Cont. (Contains functions to collect patient labs and swabbing rate) ; 1/23/14 11:07am
;;1.0;MRSA PROGRAM TOOLS;**1,3**;Mar 22, 2009;Build 4
;
GETLABS ;Gets all lab data for the report.
N MRSAMDRO,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
S MRSAMDRO=$O(^MMRS(104.2,"B","MRSA",0))
S ^TMP($J,"MMRSIPC","DSUM")="0^0^0^0^0^0^0^0^0"
S LOC="" F S LOC=$O(^TMP($J,"MMRSIPC","D",LOC)) Q:LOC="" D
.S ^TMP($J,"MMRSIPC","DSUM",LOC)="0^0^0^0^0^0^0^0^0"
.S INDT=0 F S INDT=$O(^TMP($J,"MMRSIPC","D",LOC,INDT)) Q:'INDT D
..S DFN=0 F S DFN=$O(^TMP($J,"MMRSIPC","D",LOC,INDT,DFN)) Q:'DFN D
...S OUTDT=0 F S OUTDT=$O(^TMP($J,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)) Q:OUTDT="" D
....I BYADM D
.....S NARES24=$P($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(INDT,0,-24),$$FMADD^XLFDT(INDT,0,24),"CD"),U,1)
.....S NARES48=$P($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
.....S SURV48=$P($$GETLAB(DFN,"MRSA_SURV",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
.....I NARES48'["POS",SURV48["POS" S NARES48=SURV48
.....S CULT48=$P($$GETLAB(DFN,"MRSA_CULTURE",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2) ;$$GETMCULT(DFN,$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD")
.....S MRSA365=$P($$GETLAB(DFN,MRSAMDRO,$$FMADD^XLFDT(INDT,-365),INDT,"CD"),U,2)
.....I $P($G(^MMRS(104,MMRSDIV,0)),U,4)=0 D
......S KNOWMRSA=$P($$GETLAB(DFN,MRSAMDRO,$$FMADD^XLFDT(INDT,-365),INDT,"RAD"),U,2)
.....S ^TMP($J,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)=^TMP($J,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)_U_NARES24_U_NARES48_U_CULT48_U_MRSA365
....I 'BYADM D
.....S NARES24A=$P($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(INDT,0,-24),$$FMADD^XLFDT(INDT,0,24),"CD"),U,1)
.....S NARES48A=$P($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
.....S SURV48A=$P($$GETLAB(DFN,"MRSA_SURV",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
.....I NARES48A'["POS",SURV48A["POS" S NARES48A=SURV48A
.....S MRSAFR=(INDT-10000) I STRTDT>INDT S MRSAFR=(STRTDT-10000) ;(ADM - 1 year) or (START DT - 1 year) - whichever is later
.....S MRSATO=$$FMADD^XLFDT(INDT,0,48,0,0) I STRTDT>MRSATO S MRSATO=STRTDT ;(ADM + 48 HRS) OR (START DT) - WHICHEVER IS GREATER
.....S MRSA365A=$P($$GETLAB(DFN,MRSAMDRO,MRSAFR,MRSATO,"CD"),U,2)
.....S (NARES24D,NARES48D,SURV48D)=""
.....I OUTDT D
......S NARES24D=$P($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(OUTDT,0,-24),$$FMADD^XLFDT(OUTDT,0,24),"CD"),U,1)
......S NARES48D=$P($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(OUTDT,0,-48),$$FMADD^XLFDT(OUTDT,0,48),"CD"),U,2)
......S SURV48D=$P($$GETLAB(DFN,"MRSA_SURV",$$FMADD^XLFDT(OUTDT,0,-48),$$FMADD^XLFDT(OUTDT,0,48),"CD"),U,2)
......I NARES48D'["POS",SURV48D["POS" S NARES48D=SURV48D
.....S MRSAFR=$$FMADD^XLFDT(INDT,0,48,0,0) I STRTDT>MRSAFR S MRSAFR=STRTDT ;(ADM + 48 HRS) OR (START DT) - WHICHEVER IS LATER
.....S MRSATO=ENDDT I +OUTDT S MRSATO=$$FMADD^XLFDT(OUTDT,0,48,0,0) ;(DIS + 48 HRS) OR (END DT) - WHICHEVER IS EARLIER
.....S MRSACPRD=$P($$GETLAB(DFN,MRSAMDRO,MRSAFR,MRSATO,"CD"),U,2)
.....I $P($G(^MMRS(104,MMRSDIV,0)),U,5)=0,OUTDT D
......S KNOWMRSA=$P($$GETLAB(DFN,MRSAMDRO,$$FMADD^XLFDT(OUTDT,-365),OUTDT,"RAD"),U,2)
.....S TRANS=""
.....I NARES48A'["POS",MRSA365A'["POS",(($G(NARES48D)["POS")!(MRSACPRD["POS")) S TRANS="T"
.....S ^TMP($J,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)=^TMP($J,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)_U_NARES24A_U_NARES48A_U_MRSA365A_U_$G(NARES24D)_U_$G(NARES48D)_U_MRSACPRD_U_TRANS
....D PREV ;Calculate prevalence measures
Q
PREV ;Calculate prevalence measures (summary report)
N LOCSUM,SUM,DATA,IND
S LOCSUM=$G(^TMP($J,"MMRSIPC","DSUM",LOC))
S SUM=$G(^TMP($J,"MMRSIPC","DSUM"))
S DATA=$G(^TMP($J,"MMRSIPC","D",LOC,INDT,DFN,OUTDT))
I BYADM D
.I $P(DATA,U,5)=1 D
..S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,1)=$P(LOCSUM,U,1)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,1)=$P(SUM,U,1)+1
..I NARES24["Y" S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,2)=$P(LOCSUM,U,2)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,2)=$P(SUM,U,2)+1
..I (NARES48["POS"!(MRSA365["POS")),CULT48'["POS" S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,3)=$P(LOCSUM,U,3)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,3)=$P(SUM,U,3)+1
..I CULT48["POS" S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,4)=$P(LOCSUM,U,4)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,4)=$P(SUM,U,4)+1
.S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,5)=$P(LOCSUM,U,5)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,5)=$P(SUM,U,5)+1
.S IND=0
.I $P($G(^MMRS(104,MMRSDIV,0)),U,2)=1,$P($G(^MMRS(104,MMRSDIV,0)),U,4)=1 S IND=1
.I $P($G(^MMRS(104,MMRSDIV,0)),U,2)=1,$P($G(^MMRS(104,MMRSDIV,0)),U,4)=0,($P(DATA,U,5)=1!(KNOWMRSA'["POS")) S IND=1
.I $P($G(^MMRS(104,MMRSDIV,0)),U,2)=0,$P(DATA,U,5)=1 S IND=1
.S $P(^TMP($J,"MMRSIPC","D",LOC,INDT,DFN,OUTDT),U,13)=IND ;MIA/LMT - Add if patient was indicated ;3/16/10
.I IND D
..S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,6)=$P(LOCSUM,U,6)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,6)=$P(SUM,U,6)+1
..I NARES24["Y" S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,7)=$P(LOCSUM,U,7)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,7)=$P(SUM,U,7)+1
.I (NARES48["POS"!(MRSA365["POS")),CULT48'["POS" S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,8)=$P(LOCSUM,U,8)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,8)=$P(SUM,U,8)+1
.I CULT48["POS" S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,9)=$P(LOCSUM,U,9)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,9)=$P(SUM,U,9)+1
I 'BYADM D
.I $P(DATA,U,8)=3!($P(DATA,U,8)=2) D
..S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,2)=$P(LOCSUM,U,2)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,2)=$P(SUM,U,2)+1
..S IND=0
..I $P($G(^MMRS(104,MMRSDIV,0)),U,3)=1,$P($G(^MMRS(104,MMRSDIV,0)),U,5)=1 S IND=1
..I $P($G(^MMRS(104,MMRSDIV,0)),U,3)=1,$P($G(^MMRS(104,MMRSDIV,0)),U,5)=0,KNOWMRSA'["POS" S IND=1
..I $P($G(^MMRS(104,MMRSDIV,0)),U,3)=0,$P($G(^MMRS(104,MMRSDIV,0)),U,5)=0,$P(DATA,U,8)=3,KNOWMRSA'["POS" S IND=1
..I $P($G(^MMRS(104,MMRSDIV,0)),U,3)=0,$P($G(^MMRS(104,MMRSDIV,0)),U,5)=1,$P(DATA,U,8)=3 S IND=1
..S $P(^TMP($J,"MMRSIPC","D",LOC,INDT,DFN,OUTDT),U,16)=IND ;MIA/LMT - Add if patient was indicated ;3/16/10
..I IND=1 D
...S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,3)=$P(LOCSUM,U,3)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,3)=$P(SUM,U,3)+1
...I NARES24D["Y" S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,4)=$P(LOCSUM,U,4)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,4)=$P(SUM,U,4)+1
.I TRANS="T" S $P(^TMP($J,"MMRSIPC","DSUM",LOC),U,5)=$P(LOCSUM,U,5)+1,$P(^TMP($J,"MMRSIPC","DSUM"),U,5)=$P(SUM,U,5)+1
Q
GETLAB(DFN,LRMDRO,LRSTART,LREND,LRDTTYP) ;RETURN YES/NO^RESULT
N LRRSLT,LRTST,TMPRSLT
S LRRSLT="^"
I $G(DFN)=""!($G(LRMDRO)="")!($G(LRSTART)="")!($G(LREND)="") Q LRRSLT
;GET CH RSLTS
S LRTST=0 F S LRTST=$O(^TMP($J,"MMRSIPC","T",LRMDRO,LRTST)) Q:'LRTST D
.S TMPRSLT=$$GETCH(DFN,LRMDRO,LRTST,LRSTART,LREND,LRDTTYP)
.I $P(LRRSLT,U)'="Y" S LRRSLT=TMPRSLT
.I $P(TMPRSLT,U,2)["POS",(($P(LRRSLT,"^",2)="")!($P($P(LRRSLT,"^",2),";",3)>$P($P(TMPRSLT,"^",2),";",3))) D
..S LRRSLT=TMPRSLT
;GET MI RSLTS
S TMPRSLT=$$GETMI(DFN,LRMDRO,LRSTART,LREND,LRDTTYP)
I $P(LRRSLT,U)'="Y" S LRRSLT=TMPRSLT
I $P(TMPRSLT,U,2)["POS",(($P(LRRSLT,"^",2)="")!($P($P(LRRSLT,"^",2),";",3)>$P($P(TMPRSLT,"^",2),";",3))) D
.S LRRSLT=TMPRSLT
Q LRRSLT
GETCH(DFN,LRMDRO,LRTST,LRSTART,LREND,LRDTTYP) ;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
.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:$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,3)=""
..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
...S $P(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";CH")
Q LRRSLT
GETMI(DFN,LRMDRO,LRSTART,LREND,LRDTTYP) ;RETURN YES^RESULT
N LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD,LRIEND
S LRRSLT="^"
I '$D(^TMP($J,"MMRSIPC","BACT",LRMDRO,"INC_REMARK")),'$D(^TMP($J,"MMRSIPC","ETIOL",LRMDRO)) Q LRRSLT
S LRDFN=$$LRDFN^LR7OR1(DFN)
Q:'LRDFN LRRSLT
S LRIDT=(9999999-LREND)-.0000001
S LRIEND=9999999-LRSTART
I LRDTTYP="RAD" S LRIDT=0,LRIEND=99999999
F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:'LRIDT!(LRIDT>LRIEND) D
.I LRDTTYP="RAD" S LRRAD=$P($G(^LR(LRDFN,"MI",LRIDT,0)),U,3) I LRRAD<LRSTART!(LRRAD>LREND) Q
.;Q:$P($G(^LR(LRDFN,"MI",LRIDT,1)),U,2)'="F"
.S LRSITE=$P($G(^LR(LRDFN,"MI",LRIDT,0)),U,5)
.;Q:$$SCRNTOP(LRSITE,LRMDRO)
.;I $D(^LR(LRDFN,"MI",LRIDT,0)),$P(^LR(LRDFN,"MI",LRIDT,1),U) D
.S $P(LRRSLT,"^",1)="Y"
.S TSTRSLT=$$MIRSLT(LRDFN,LRIDT,LRMDRO)
.I TSTRSLT["POS",(($P(LRRSLT,"^",2)="")!($P($P(LRRSLT,"^",2),";",3)>LRIDT)) D
..S $P(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";MI")
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,"MMRSIPC","T",LRMDRO,LRTST,0)),U,1)
S LRINDVAL=$P($G(^TMP($J,"MMRSIPC","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,"MMRSIPC","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,"MMRSIPC","ETIOL",LRMDRO,LRETI,0))) D Q
...I $D(^TMP($J,"MMRSIPC","ETIOL",LRMDRO,LRETI)) S RESULT="POS"
..S LRANTI=0 F S LRANTI=$O(^TMP($J,"MMRSIPC","ETIOL",LRMDRO,LRETI,LRANTI)) Q:'LRANTI D
...S LRANTIEN=$P(^TMP($J,"MMRSIPC","ETIOL",LRMDRO,LRETI,LRANTI),U,1)
...S LRANTIND=$P(^TMP($J,"MMRSIPC","ETIOL",LRMDRO,LRETI,LRANTI),U,2)
...S LRANTINV=$P(^TMP($J,"MMRSIPC","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,"MMRSIPC","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,"MMRSIPC","TOP",LRMDRO,"INC_TOP"))&$D(^TMP($J,"MMRSIPC","TOP",LRMDRO,"EXC_TOP")) Q 0
I '$D(^TMP($J,"MMRSIPC","TOP",LRMDRO,"INC_TOP"))&'$D(^TMP($J,"MMRSIPC","TOP",LRMDRO,"EXC_TOP")) Q 0
I ($D(^TMP($J,"MMRSIPC","TOP",LRMDRO,"INC_TOP")))&($D(^TMP($J,"MMRSIPC","TOP",LRMDRO,"INC_TOP",LRSITE))) Q 0
I ($D(^TMP($J,"MMRSIPC","TOP",LRMDRO,"EXC_TOP")))&('$D(^TMP($J,"MMRSIPC","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,"MMRSIPC","BACT",LRMDRO,RPTTYPE,MMRSI)) Q:'MMRSI!(RESULT=1) D
.S LRINDVAL=$G(^TMP($J,"MMRSIPC","BACT",LRMDRO,RPTTYPE,MMRSI))
.I ($$UP^XLFSTR(RPTRMRK))[($$UP^XLFSTR(LRINDVAL)) S RESULT=1
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMMRSIPC3 13181 printed Oct 16, 2024@18:15:59 Page 2
MMRSIPC3 ;MIA/LMT - Print MRSA Report Cont. (Contains functions to collect patient labs and swabbing rate) ; 1/23/14 11:07am
+1 ;;1.0;MRSA PROGRAM TOOLS;**1,3**;Mar 22, 2009;Build 4
+2 ;
GETLABS ;Gets all lab data for the report.
+1 NEW MRSAMDRO,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
+3 SET MRSAMDRO=$ORDER(^MMRS(104.2,"B","MRSA",0))
+4 SET ^TMP($JOB,"MMRSIPC","DSUM")="0^0^0^0^0^0^0^0^0"
+5 SET LOC=""
FOR
SET LOC=$ORDER(^TMP($JOB,"MMRSIPC","D",LOC))
if LOC=""
QUIT
Begin DoDot:1
+6 SET ^TMP($JOB,"MMRSIPC","DSUM",LOC)="0^0^0^0^0^0^0^0^0"
+7 SET INDT=0
FOR
SET INDT=$ORDER(^TMP($JOB,"MMRSIPC","D",LOC,INDT))
if 'INDT
QUIT
Begin DoDot:2
+8 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN))
if 'DFN
QUIT
Begin DoDot:3
+9 SET OUTDT=0
FOR
SET OUTDT=$ORDER(^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN,OUTDT))
if OUTDT=""
QUIT
Begin DoDot:4
+10 IF BYADM
Begin DoDot:5
+11 SET NARES24=$PIECE($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(INDT,0,-24),$$FMADD^XLFDT(INDT,0,24),"CD"),U,1)
+12 SET NARES48=$PIECE($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
+13 SET SURV48=$PIECE($$GETLAB(DFN,"MRSA_SURV",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
+14 IF NARES48'["POS"
IF SURV48["POS"
SET NARES48=SURV48
+15 ;$$GETMCULT(DFN,$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD")
SET CULT48=$PIECE($$GETLAB(DFN,"MRSA_CULTURE",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
+16 SET MRSA365=$PIECE($$GETLAB(DFN,MRSAMDRO,$$FMADD^XLFDT(INDT,-365),INDT,"CD"),U,2)
+17 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,4)=0
Begin DoDot:6
+18 SET KNOWMRSA=$PIECE($$GETLAB(DFN,MRSAMDRO,$$FMADD^XLFDT(INDT,-365),INDT,"RAD"),U,2)
End DoDot:6
+19 SET ^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)=^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)_U_NARES24_U_NARES48_U_CULT48_U_MRSA365
End DoDot:5
+20 IF 'BYADM
Begin DoDot:5
+21 SET NARES24A=$PIECE($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(INDT,0,-24),$$FMADD^XLFDT(INDT,0,24),"CD"),U,1)
+22 SET NARES48A=$PIECE($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
+23 SET SURV48A=$PIECE($$GETLAB(DFN,"MRSA_SURV",$$FMADD^XLFDT(INDT,0,-48),$$FMADD^XLFDT(INDT,0,48),"CD"),U,2)
+24 IF NARES48A'["POS"
IF SURV48A["POS"
SET NARES48A=SURV48A
+25 ;(ADM - 1 year) or (START DT - 1 year) - whichever is later
SET MRSAFR=(INDT-10000)
IF STRTDT>INDT
SET MRSAFR=(STRTDT-10000)
+26 ;(ADM + 48 HRS) OR (START DT) - WHICHEVER IS GREATER
SET MRSATO=$$FMADD^XLFDT(INDT,0,48,0,0)
IF STRTDT>MRSATO
SET MRSATO=STRTDT
+27 SET MRSA365A=$PIECE($$GETLAB(DFN,MRSAMDRO,MRSAFR,MRSATO,"CD"),U,2)
+28 SET (NARES24D,NARES48D,SURV48D)=""
+29 IF OUTDT
Begin DoDot:6
+30 SET NARES24D=$PIECE($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(OUTDT,0,-24),$$FMADD^XLFDT(OUTDT,0,24),"CD"),U,1)
+31 SET NARES48D=$PIECE($$GETLAB(DFN,"MRSA_SCREEN",$$FMADD^XLFDT(OUTDT,0,-48),$$FMADD^XLFDT(OUTDT,0,48),"CD"),U,2)
+32 SET SURV48D=$PIECE($$GETLAB(DFN,"MRSA_SURV",$$FMADD^XLFDT(OUTDT,0,-48),$$FMADD^XLFDT(OUTDT,0,48),"CD"),U,2)
+33 IF NARES48D'["POS"
IF SURV48D["POS"
SET NARES48D=SURV48D
End DoDot:6
+34 ;(ADM + 48 HRS) OR (START DT) - WHICHEVER IS LATER
SET MRSAFR=$$FMADD^XLFDT(INDT,0,48,0,0)
IF STRTDT>MRSAFR
SET MRSAFR=STRTDT
+35 ;(DIS + 48 HRS) OR (END DT) - WHICHEVER IS EARLIER
SET MRSATO=ENDDT
IF +OUTDT
SET MRSATO=$$FMADD^XLFDT(OUTDT,0,48,0,0)
+36 SET MRSACPRD=$PIECE($$GETLAB(DFN,MRSAMDRO,MRSAFR,MRSATO,"CD"),U,2)
+37 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,5)=0
IF OUTDT
Begin DoDot:6
+38 SET KNOWMRSA=$PIECE($$GETLAB(DFN,MRSAMDRO,$$FMADD^XLFDT(OUTDT,-365),OUTDT,"RAD"),U,2)
End DoDot:6
+39 SET TRANS=""
+40 IF NARES48A'["POS"
IF MRSA365A'["POS"
IF (($GET(NARES48D)["POS")!(MRSACPRD["POS"))
SET TRANS="T"
+41 SET ^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)=^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN,OUTDT)_U_NARES24A_U_NARES48A_U_MRSA365A_U_$GET(NARES24D)_U_$GET(NARES48D)_U_MRSACPRD_U_TRANS
End DoDot:5
+42 ;Calculate prevalence measures
DO PREV
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 QUIT
PREV ;Calculate prevalence measures (summary report)
+1 NEW LOCSUM,SUM,DATA,IND
+2 SET LOCSUM=$GET(^TMP($JOB,"MMRSIPC","DSUM",LOC))
+3 SET SUM=$GET(^TMP($JOB,"MMRSIPC","DSUM"))
+4 SET DATA=$GET(^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN,OUTDT))
+5 IF BYADM
Begin DoDot:1
+6 IF $PIECE(DATA,U,5)=1
Begin DoDot:2
+7 SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,1)=$PIECE(LOCSUM,U,1)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,1)=$PIECE(SUM,U,1)+1
+8 IF NARES24["Y"
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,2)=$PIECE(LOCSUM,U,2)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,2)=$PIECE(SUM,U,2)+1
+9 IF (NARES48["POS"!(MRSA365["POS"))
IF CULT48'["POS"
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,3)=$PIECE(LOCSUM,U,3)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,3)=$PIECE(SUM,U,3)+1
+10 IF CULT48["POS"
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,4)=$PIECE(LOCSUM,U,4)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,4)=$PIECE(SUM,U,4)+1
End DoDot:2
+11 SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,5)=$PIECE(LOCSUM,U,5)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,5)=$PIECE(SUM,U,5)+1
+12 SET IND=0
+13 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,2)=1
IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,4)=1
SET IND=1
+14 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,2)=1
IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,4)=0
IF ($PIECE(DATA,U,5)=1!(KNOWMRSA'["POS"))
SET IND=1
+15 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,2)=0
IF $PIECE(DATA,U,5)=1
SET IND=1
+16 ;MIA/LMT - Add if patient was indicated ;3/16/10
SET $PIECE(^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN,OUTDT),U,13)=IND
+17 IF IND
Begin DoDot:2
+18 SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,6)=$PIECE(LOCSUM,U,6)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,6)=$PIECE(SUM,U,6)+1
+19 IF NARES24["Y"
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,7)=$PIECE(LOCSUM,U,7)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,7)=$PIECE(SUM,U,7)+1
End DoDot:2
+20 IF (NARES48["POS"!(MRSA365["POS"))
IF CULT48'["POS"
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,8)=$PIECE(LOCSUM,U,8)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,8)=$PIECE(SUM,U,8)+1
+21 IF CULT48["POS"
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,9)=$PIECE(LOCSUM,U,9)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,9)=$PIECE(SUM,U,9)+1
End DoDot:1
+22 IF 'BYADM
Begin DoDot:1
+23 IF $PIECE(DATA,U,8)=3!($PIECE(DATA,U,8)=2)
Begin DoDot:2
+24 SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,2)=$PIECE(LOCSUM,U,2)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,2)=$PIECE(SUM,U,2)+1
+25 SET IND=0
+26 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,3)=1
IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,5)=1
SET IND=1
+27 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,3)=1
IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,5)=0
IF KNOWMRSA'["POS"
SET IND=1
+28 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,3)=0
IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,5)=0
IF $PIECE(DATA,U,8)=3
IF KNOWMRSA'["POS"
SET IND=1
+29 IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,3)=0
IF $PIECE($GET(^MMRS(104,MMRSDIV,0)),U,5)=1
IF $PIECE(DATA,U,8)=3
SET IND=1
+30 ;MIA/LMT - Add if patient was indicated ;3/16/10
SET $PIECE(^TMP($JOB,"MMRSIPC","D",LOC,INDT,DFN,OUTDT),U,16)=IND
+31 IF IND=1
Begin DoDot:3
+32 SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,3)=$PIECE(LOCSUM,U,3)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,3)=$PIECE(SUM,U,3)+1
+33 IF NARES24D["Y"
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,4)=$PIECE(LOCSUM,U,4)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,4)=$PIECE(SUM,U,4)+1
End DoDot:3
End DoDot:2
+34 IF TRANS="T"
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM",LOC),U,5)=$PIECE(LOCSUM,U,5)+1
SET $PIECE(^TMP($JOB,"MMRSIPC","DSUM"),U,5)=$PIECE(SUM,U,5)+1
End DoDot:1
+35 QUIT
GETLAB(DFN,LRMDRO,LRSTART,LREND,LRDTTYP) ;RETURN YES/NO^RESULT
+1 NEW LRRSLT,LRTST,TMPRSLT
+2 SET LRRSLT="^"
+3 IF $GET(DFN)=""!($GET(LRMDRO)="")!($GET(LRSTART)="")!($GET(LREND)="")
QUIT LRRSLT
+4 ;GET CH RSLTS
+5 SET LRTST=0
FOR
SET LRTST=$ORDER(^TMP($JOB,"MMRSIPC","T",LRMDRO,LRTST))
if 'LRTST
QUIT
Begin DoDot:1
+6 SET TMPRSLT=$$GETCH(DFN,LRMDRO,LRTST,LRSTART,LREND,LRDTTYP)
+7 IF $PIECE(LRRSLT,U)'="Y"
SET LRRSLT=TMPRSLT
+8 IF $PIECE(TMPRSLT,U,2)["POS"
IF (($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>$PIECE($PIECE(TMPRSLT,"^",2),";",3)))
Begin DoDot:2
+9 SET LRRSLT=TMPRSLT
End DoDot:2
End DoDot:1
+10 ;GET MI RSLTS
+11 SET TMPRSLT=$$GETMI(DFN,LRMDRO,LRSTART,LREND,LRDTTYP)
+12 IF $PIECE(LRRSLT,U)'="Y"
SET LRRSLT=TMPRSLT
+13 IF $PIECE(TMPRSLT,U,2)["POS"
IF (($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>$PIECE($PIECE(TMPRSLT,"^",2),";",3)))
Begin DoDot:1
+14 SET LRRSLT=TMPRSLT
End DoDot:1
+15 QUIT LRRSLT
GETCH(DFN,LRMDRO,LRTST,LRSTART,LREND,LRDTTYP) ;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 SET DAS=0
FOR
SET DAS=$ORDER(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE,DAS))
if 'DAS
QUIT
Begin DoDot:2
+9 SET LRIDT=$PIECE(DAS,";",3)
+10 IF LRDTTYP="RAD"
SET LRRAD=$PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,3)
IF LRRAD<LRSTART!(LRRAD>LRRADEND)
QUIT
+11 if $PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,3)=""
QUIT
+12 SET LRSITE=$PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,5)
+13 ;Q:$$SCRNTOP(LRSITE,LRMDRO)
+14 ;I $D(^LR(LRDFN,"CH",LRIDT,0)),$P(^LR(LRDFN,"CH",LRIDT,0),U,3) D
+15 SET $PIECE(LRRSLT,"^",1)="Y"
+16 SET TSTRSLT=$$CHRSLT(LRDFN,LRIDT,LRMDRO,LRTST)
+17 IF TSTRSLT["POS"
IF (($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>LRIDT))
Begin DoDot:3
+18 SET $PIECE(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";CH")
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT LRRSLT
GETMI(DFN,LRMDRO,LRSTART,LREND,LRDTTYP) ;RETURN YES^RESULT
+1 NEW LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD,LRIEND
+2 SET LRRSLT="^"
+3 IF '$DATA(^TMP($JOB,"MMRSIPC","BACT",LRMDRO,"INC_REMARK"))
IF '$DATA(^TMP($JOB,"MMRSIPC","ETIOL",LRMDRO))
QUIT LRRSLT
+4 SET LRDFN=$$LRDFN^LR7OR1(DFN)
+5 if 'LRDFN
QUIT LRRSLT
+6 SET LRIDT=(9999999-LREND)-.0000001
+7 SET LRIEND=9999999-LRSTART
+8 IF LRDTTYP="RAD"
SET LRIDT=0
SET LRIEND=99999999
+9 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
if 'LRIDT!(LRIDT>LRIEND)
QUIT
Begin DoDot:1
+10 IF LRDTTYP="RAD"
SET LRRAD=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,0)),U,3)
IF LRRAD<LRSTART!(LRRAD>LREND)
QUIT
+11 ;Q:$P($G(^LR(LRDFN,"MI",LRIDT,1)),U,2)'="F"
+12 SET LRSITE=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,0)),U,5)
+13 ;Q:$$SCRNTOP(LRSITE,LRMDRO)
+14 ;I $D(^LR(LRDFN,"MI",LRIDT,0)),$P(^LR(LRDFN,"MI",LRIDT,1),U) D
+15 SET $PIECE(LRRSLT,"^",1)="Y"
+16 SET TSTRSLT=$$MIRSLT(LRDFN,LRIDT,LRMDRO)
+17 IF TSTRSLT["POS"
IF (($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>LRIDT))
Begin DoDot:2
+18 SET $PIECE(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";MI")
End DoDot:2
End DoDot:1
+19 QUIT LRRSLT
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,"MMRSIPC","T",LRMDRO,LRTST,0)),U,1)
+8 SET LRINDVAL=$PIECE($GET(^TMP($JOB,"MMRSIPC","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,"MMRSIPC","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,"MMRSIPC","ETIOL",LRMDRO,LRETI,0)))
Begin DoDot:3
+9 IF $DATA(^TMP($JOB,"MMRSIPC","ETIOL",LRMDRO,LRETI))
SET RESULT="POS"
End DoDot:3
QUIT
+10 SET LRANTI=0
FOR
SET LRANTI=$ORDER(^TMP($JOB,"MMRSIPC","ETIOL",LRMDRO,LRETI,LRANTI))
if 'LRANTI
QUIT
Begin DoDot:3
+11 SET LRANTIEN=$PIECE(^TMP($JOB,"MMRSIPC","ETIOL",LRMDRO,LRETI,LRANTI),U,1)
+12 SET LRANTIND=$PIECE(^TMP($JOB,"MMRSIPC","ETIOL",LRMDRO,LRETI,LRANTI),U,2)
+13 SET LRANTINV=$PIECE(^TMP($JOB,"MMRSIPC","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,"MMRSIPC","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
SCRNTOP(LRSITE,LRMDRO) ;CHECK TO SEE IF SCREEN ON SITE
+1 if +LRSITE'>0
QUIT 0
+2 IF $DATA(^TMP($JOB,"MMRSIPC","TOP",LRMDRO,"INC_TOP"))&$DATA(^TMP($JOB,"MMRSIPC","TOP",LRMDRO,"EXC_TOP"))
QUIT 0
+3 IF '$DATA(^TMP($JOB,"MMRSIPC","TOP",LRMDRO,"INC_TOP"))&'$DATA(^TMP($JOB,"MMRSIPC","TOP",LRMDRO,"EXC_TOP"))
QUIT 0
+4 IF ($DATA(^TMP($JOB,"MMRSIPC","TOP",LRMDRO,"INC_TOP")))&($DATA(^TMP($JOB,"MMRSIPC","TOP",LRMDRO,"INC_TOP",LRSITE)))
QUIT 0
+5 IF ($DATA(^TMP($JOB,"MMRSIPC","TOP",LRMDRO,"EXC_TOP")))&('$DATA(^TMP($JOB,"MMRSIPC","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,"MMRSIPC","BACT",LRMDRO,RPTTYPE,MMRSI))
if 'MMRSI!(RESULT=1)
QUIT
Begin DoDot:1
+4 SET LRINDVAL=$GET(^TMP($JOB,"MMRSIPC","BACT",LRMDRO,RPTTYPE,MMRSI))
+5 IF ($$UP^XLFSTR(RPTRMRK))[($$UP^XLFSTR(LRINDVAL))
SET RESULT=1
End DoDot:1
+6 QUIT RESULT
