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