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

MMRSCDI1.m

Go to the documentation of this file.
MMRSCDI1 ;LEIDOS/TCK - Print CDI Report Cont. (Contains functions to collect patient labs and swabbing rate) ; 3/8/17 11:39am
 ;;1.0;MDRO TOOLS REPORTS MENU;**4,5,6**;Mar 22, 2009;Build 1
 ;
GETLAB(DFN,MRSA,LRMDRO,LREND,LRDTTYP) ;RETURN YES/NO^RESULT
 N LRRSLT,LRTST,TMPRSLT,NUMB,TSTRSLT
 S LRRSLT="^",NUMB=0
 I $G(DFN)=""!($G(LRMDRO)="")!($G(LREND)="") Q LRRSLT
 ;CHECK FOR MI RSULTS
 I MDROETIO D
 .D GETMI(DFN,LRMDRO,LREND,LRDTTYP,.MRSA)
 .Q:'$D(MRSA)
 ;CHECK FOR CH RESULTS
 I TSTSTP D
 .S LRRSLT="^"
 .S LRTST=0 F  S LRTST=$O(^TMP($J,"MMRSCD","T",LRMDRO,LRTST)) Q:'LRTST  D
 ..S SUBS=$$GET1^DIQ(60,+LRTST,4,"I")
 ..I SUBS="CH" D GETCH(DFN,LRMDRO,+LRTST,LREND,LRDTTYP,.MRSA)
 Q
 ;
GETCH(DFN,LRMDRO,LRTST,LREND,LRDTTYP,MRSA) ;RETURN YES^RESULT
 N LIENS,LOC,LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD
 S LRRSLT="^",CDIVT=""
 S LRDATE=""
 I LRDTTYP="RAD" S LRDATE=0,LRRADEND=LREND,LREND=9999999
 Q:'$D(^PXRMINDX(63,"PI",DFN,+LRTST))
 F  S LRDATE=$O(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE)) Q:'LRDATE  D
 .Q:LRDATE>ENDDT
 .Q:LRDATE<DFLTDT
 .S DAS=0 F  S DAS=$O(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE,DAS)) Q:'DAS  D
 ..S LRDFN=$P(DAS,";")
 ..Q:'$D(^LR(LRDFN,"CH"))
 ..S LRIDT=$P(DAS,";",3)
 ..I LRDTTYP="RAD" S LRRAD=$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,3) I LRRAD<STRTDT!(LRRAD>LRRADEND) Q
 ..Q:LRDATE<DFLTDT
 ..Q:LRDATE>ENDDT
 ..Q:$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,3)=""
 ..S LIEN=LRIDT_","_LRDFN_","
 ..S CDIVT=$$GET1^DIQ(63.04,LIEN,.01,"I")
 ..S LOC=+$$GET1^DIQ(63.04,LIEN,.111,"I")
 ..S LRLOC=$G(LOC)
 ..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")
 ...S LRRSLT=LRRSLT_"^"_LOC
 ...S MRSA(CDIVT)=LRRSLT,LRRSLT="^"
 Q
 ;
GETMI(DFN,LRMDRO,LREND,LRDTTYP,MRSA) ;RETURN YES^RESULT
 N LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD,RSARY
 S LRRSLT="^"
 I '$D(^TMP($J,"MMRSCD","BACT",LRMDRO,"INC_REMARK")),'$D(^TMP($J,"MMRSCD","ETIOL",LRMDRO)) Q LRRSLT
 S LRDFN=$$LRDFN^LR7OR1(DFN)
 Q:'LRDFN LRRSLT
 Q:'$D(^LR(LRDFN,"MI"))
 S LRIDT=(9999999-LREND)-.0000001,COUNT=0
 I LRDTTYP="RAD" S LRIDT=0,LREND=99999999
 F  S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:'LRIDT!(LRIDT>(9999999-STRTDT))  D
 .I LRDTTYP="RAD" S LRRAD=$P($G(^LR(LRDFN,"MI",LRIDT,0)),U,3) I LRRAD<STRTDT!(LRRAD>LREND) Q
 .;CHECK FOR PRELIM
 .S LIEN=LRIDT_","_LRDFN_","
 .Q:$$GET1^DIQ(63.05,LIEN,11.5,"I")="P"
 .;GET LOCATION AND COLLECTION DATE/TIME FROM 63
 .S LOC=+$$GET1^DIQ(63.05,LIEN,.111,"I")
 .S CDIVT=$$GET1^DIQ(63.05,LIEN,.01,"I")
 .Q:$G(CDIVT)<DFLTDT
 .Q:$G(CDIVT)>ENDDT
 .S LRSITE=$P($G(^LR(LRDFN,"MI",LRIDT,0)),U,5)
 .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")
 ..S LRRSLT=LRRSLT_"^"_LOC
 ..S MRSA(CDIVT)=LRRSLT,LRRSLT="^"
 Q
 ;
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,"MMRSCD","T",LRMDRO,LRTST,0)),U,1)
 S LRINDVAL=$P($G(^TMP($J,"MMRSCD","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
 S RESULT=""
 ;Check Etiology
 I $D(^TMP($J,"MMRSCD","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,"MMRSCD","ETIOL",LRMDRO,LRETI,0))) D  Q
 ...I $D(^TMP($J,"MMRSCD","ETIOL",LRMDRO,LRETI)) S RESULT="POS"
 ..S LRANTI=0 F  S LRANTI=$O(^TMP($J,"MMRSCD","ETIOL",LRMDRO,LRETI,LRANTI)) Q:'LRANTI  D
 ...S LRANTIND=$P(^TMP($J,"MMRSCD","ETIOL",LRMDRO,LRETI,LRANTI),U,1)
 ...S LRANTINV=$P(^TMP($J,"MMRSCD","ETIOL",LRMDRO,LRETI,LRANTI),U,2)
 ...;S LRAND=$P($G(^LAB(62.06,LRANTI,0)),U,2) 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($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,"MMRSCD","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,"MMRSCD","TOP",LRMDRO,"INC_TOP"))&$D(^TMP($J,"MMRSCD","TOP",LRMDRO,"EXC_TOP")) Q 0
 I '$D(^TMP($J,"MMRSCD","TOP",LRMDRO,"INC_TOP"))&'$D(^TMP($J,"MMRSCD","TOP",LRMDRO,"EXC_TOP")) Q 0
 I ($D(^TMP($J,"MMRSCD","TOP",LRMDRO,"INC_TOP")))&($D(^TMP($J,"MMRSCD","TOP",LRMDRO,"INC_TOP",LRSITE))) Q 0
 I ($D(^TMP($J,"MMRSCD","TOP",LRMDRO,"EXC_TOP")))&('$D(^TMP($J,"MMRSCD","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,"MMRSCD","BACT",LRMDRO,RPTTYPE,MMRSI)) Q:'MMRSI!(RESULT=1)  D
 .S LRINDVAL=$G(^TMP($J,"MMRSCD","BACT",LRMDRO,RPTTYPE,MMRSI))
 .I ($$UP^XLFSTR(RPTRMRK))[($$UP^XLFSTR(LRINDVAL)) S RESULT=1
 Q RESULT
 ;
END ;
 K CDIVT,COUNT,DFLTDT,ENDDT,LIEN,STRTDT,SUBS,TSTSTP,MDROETIO
 Q