- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMMRSCDI1 6736 printed Feb 18, 2025@23:41:18 Page 2
- 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
- +2 ;
- GETLAB(DFN,MRSA,LRMDRO,LREND,LRDTTYP) ;RETURN YES/NO^RESULT
- +1 NEW LRRSLT,LRTST,TMPRSLT,NUMB,TSTRSLT
- +2 SET LRRSLT="^"
- SET NUMB=0
- +3 IF $GET(DFN)=""!($GET(LRMDRO)="")!($GET(LREND)="")
- QUIT LRRSLT
- +4 ;CHECK FOR MI RSULTS
- +5 IF MDROETIO
- Begin DoDot:1
- +6 DO GETMI(DFN,LRMDRO,LREND,LRDTTYP,.MRSA)
- +7 if '$DATA(MRSA)
- QUIT
- End DoDot:1
- +8 ;CHECK FOR CH RESULTS
- +9 IF TSTSTP
- Begin DoDot:1
- +10 SET LRRSLT="^"
- +11 SET LRTST=0
- FOR
- SET LRTST=$ORDER(^TMP($JOB,"MMRSCD","T",LRMDRO,LRTST))
- if 'LRTST
- QUIT
- Begin DoDot:2
- +12 SET SUBS=$$GET1^DIQ(60,+LRTST,4,"I")
- +13 IF SUBS="CH"
- DO GETCH(DFN,LRMDRO,+LRTST,LREND,LRDTTYP,.MRSA)
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- GETCH(DFN,LRMDRO,LRTST,LREND,LRDTTYP,MRSA) ;RETURN YES^RESULT
- +1 NEW LIENS,LOC,LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD
- +2 SET LRRSLT="^"
- SET CDIVT=""
- +3 SET LRDATE=""
- +4 IF LRDTTYP="RAD"
- SET LRDATE=0
- SET LRRADEND=LREND
- SET LREND=9999999
- +5 if '$DATA(^PXRMINDX(63,"PI",DFN,+LRTST))
- QUIT
- +6 FOR
- SET LRDATE=$ORDER(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE))
- if 'LRDATE
- QUIT
- Begin DoDot:1
- +7 if LRDATE>ENDDT
- QUIT
- +8 if LRDATE<DFLTDT
- QUIT
- +9 SET DAS=0
- FOR
- SET DAS=$ORDER(^PXRMINDX(63,"PI",DFN,+LRTST,LRDATE,DAS))
- if 'DAS
- QUIT
- Begin DoDot:2
- +10 SET LRDFN=$PIECE(DAS,";")
- +11 if '$DATA(^LR(LRDFN,"CH"))
- QUIT
- +12 SET LRIDT=$PIECE(DAS,";",3)
- +13 IF LRDTTYP="RAD"
- SET LRRAD=$PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,3)
- IF LRRAD<STRTDT!(LRRAD>LRRADEND)
- QUIT
- +14 if LRDATE<DFLTDT
- QUIT
- +15 if LRDATE>ENDDT
- QUIT
- +16 if $PIECE($GET(^LR(LRDFN,"CH",LRIDT,0)),U,3)=""
- QUIT
- +17 SET LIEN=LRIDT_","_LRDFN_","
- +18 SET CDIVT=$$GET1^DIQ(63.04,LIEN,.01,"I")
- +19 SET LOC=+$$GET1^DIQ(63.04,LIEN,.111,"I")
- +20 SET LRLOC=$GET(LOC)
- +21 SET $PIECE(LRRSLT,"^",1)="Y"
- +22 SET TSTRSLT=$$CHRSLT(LRDFN,LRIDT,LRMDRO,LRTST)
- +23 IF TSTRSLT["POS"
- IF (($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>LRIDT))
- Begin DoDot:3
- +24 SET $PIECE(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";CH")
- +25 SET LRRSLT=LRRSLT_"^"_LOC
- +26 SET MRSA(CDIVT)=LRRSLT
- SET LRRSLT="^"
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +27 QUIT
- +28 ;
- GETMI(DFN,LRMDRO,LREND,LRDTTYP,MRSA) ;RETURN YES^RESULT
- +1 NEW LRRSLT,LRDFN,LRDATE,LRRADEND,DAS,LRIDT,LRSITE,TSTRSLT,LRRAD,RSARY
- +2 SET LRRSLT="^"
- +3 IF '$DATA(^TMP($JOB,"MMRSCD","BACT",LRMDRO,"INC_REMARK"))
- IF '$DATA(^TMP($JOB,"MMRSCD","ETIOL",LRMDRO))
- QUIT LRRSLT
- +4 SET LRDFN=$$LRDFN^LR7OR1(DFN)
- +5 if 'LRDFN
- QUIT LRRSLT
- +6 if '$DATA(^LR(LRDFN,"MI"))
- QUIT
- +7 SET LRIDT=(9999999-LREND)-.0000001
- SET COUNT=0
- +8 IF LRDTTYP="RAD"
- SET LRIDT=0
- SET LREND=99999999
- +9 FOR
- SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
- if 'LRIDT!(LRIDT>(9999999-STRTDT))
- QUIT
- Begin DoDot:1
- +10 IF LRDTTYP="RAD"
- SET LRRAD=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,0)),U,3)
- IF LRRAD<STRTDT!(LRRAD>LREND)
- QUIT
- +11 ;CHECK FOR PRELIM
- +12 SET LIEN=LRIDT_","_LRDFN_","
- +13 if $$GET1^DIQ(63.05,LIEN,11.5,"I")="P"
- QUIT
- +14 ;GET LOCATION AND COLLECTION DATE/TIME FROM 63
- +15 SET LOC=+$$GET1^DIQ(63.05,LIEN,.111,"I")
- +16 SET CDIVT=$$GET1^DIQ(63.05,LIEN,.01,"I")
- +17 if $GET(CDIVT)<DFLTDT
- QUIT
- +18 if $GET(CDIVT)>ENDDT
- QUIT
- +19 SET LRSITE=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,0)),U,5)
- +20 SET $PIECE(LRRSLT,"^",1)="Y"
- +21 SET TSTRSLT=$$MIRSLT(LRDFN,LRIDT,LRMDRO)
- +22 IF TSTRSLT["POS"
- IF (($PIECE(LRRSLT,"^",2)="")!($PIECE($PIECE(LRRSLT,"^",2),";",3)>LRIDT))
- Begin DoDot:2
- +23 SET $PIECE(LRRSLT,"^",2)=(TSTRSLT_";"_LRDFN_";"_LRIDT_";MI")
- +24 SET LRRSLT=LRRSLT_"^"_LOC
- +25 SET MRSA(CDIVT)=LRRSLT
- SET LRRSLT="^"
- End DoDot:2
- End DoDot:1
- +26 QUIT
- +27 ;
- 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,"MMRSCD","T",LRMDRO,LRTST,0)),U,1)
- +8 SET LRINDVAL=$PIECE($GET(^TMP($JOB,"MMRSCD","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
- +24 ;
- MIRSLT(LRDFN,LRIDT,LRMDRO) ;RETURNS 'POS' OR NULL STRING (IF NOT POSITIVE)
- +1 NEW RESULT,LRETND,LRETI,LRANTI,LRANTIND,LRANTINV,LRAND,LRRES,BACTRPT,RPTRMRK
- +2 SET RESULT=""
- +3 ;Check Etiology
- +4 IF $DATA(^TMP($JOB,"MMRSCD","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,"MMRSCD","ETIOL",LRMDRO,LRETI,0)))
- Begin DoDot:3
- +9 IF $DATA(^TMP($JOB,"MMRSCD","ETIOL",LRMDRO,LRETI))
- SET RESULT="POS"
- End DoDot:3
- QUIT
- +10 SET LRANTI=0
- FOR
- SET LRANTI=$ORDER(^TMP($JOB,"MMRSCD","ETIOL",LRMDRO,LRETI,LRANTI))
- if 'LRANTI
- QUIT
- Begin DoDot:3
- +11 SET LRANTIND=$PIECE(^TMP($JOB,"MMRSCD","ETIOL",LRMDRO,LRETI,LRANTI),U,1)
- +12 SET LRANTINV=$PIECE(^TMP($JOB,"MMRSCD","ETIOL",LRMDRO,LRETI,LRANTI),U,2)
- +13 ;S LRAND=$P($G(^LAB(62.06,LRANTI,0)),U,2) Q:LRAND=""
- +14 if $PIECE($GET(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2)=""
- QUIT
- +15 if $$UP^XLFSTR($EXTRACT($PIECE($GET(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2),1,1))="S"
- QUIT
- +16 IF LRANTIND=""!(LRANTINV="")
- QUIT
- +17 SET LRRES=$$UP^XLFSTR($PIECE($GET(^LR(LRDFN,"MI",LRIDT,3,LRETND,LRAND)),U,2))
- +18 SET LRANTINV=$$UP^XLFSTR(LRANTINV)
- +19 SET LRANTIND=$$UP^XLFSTR(LRANTIND)
- +20 IF LRANTIND=1
- IF (LRRES[LRANTINV)
- SET RESULT="POS"
- QUIT
- +21 IF LRANTIND=2
- IF (LRRES>LRANTINV)
- SET RESULT="POS"
- QUIT
- +22 IF LRANTIND=3
- IF (LRRES<LRANTINV)
- SET RESULT="POS"
- QUIT
- +23 IF LRANTIND=4
- IF (LRRES=LRANTINV)
- SET RESULT="POS"
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if RESULT="POS"
- QUIT RESULT
- +24 if RESULT="POS"
- QUIT "POS"
- +25 ;Check Bacteriology Report Remarks
- +26 IF '$DATA(^TMP($JOB,"MMRSCD","BACT",LRMDRO,"INC_REMARK"))
- QUIT RESULT
- +27 SET BACTRPT=0
- FOR
- SET BACTRPT=$ORDER(^LR(LRDFN,"MI",LRIDT,4,BACTRPT))
- if 'BACTRPT!(RESULT="POS")
- QUIT
- Begin DoDot:1
- +28 SET RPTRMRK=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,4,BACTRPT,0)),U,1)
- +29 if RPTRMRK=""
- QUIT
- +30 IF $$BACTRPT(LRMDRO,"INC_REMARK",RPTRMRK)&('$$BACTRPT(LRMDRO,"EXC_REMARK",RPTRMRK))
- SET RESULT="POS"
- End DoDot:1
- +31 QUIT RESULT
- +32 ;
- SCRNTOP(LRSITE,LRMDRO) ;CHECK TO SEE IF SCREEN ON SITE
- +1 if +LRSITE'>0
- QUIT 0
- +2 IF $DATA(^TMP($JOB,"MMRSCD","TOP",LRMDRO,"INC_TOP"))&$DATA(^TMP($JOB,"MMRSCD","TOP",LRMDRO,"EXC_TOP"))
- QUIT 0
- +3 IF '$DATA(^TMP($JOB,"MMRSCD","TOP",LRMDRO,"INC_TOP"))&'$DATA(^TMP($JOB,"MMRSCD","TOP",LRMDRO,"EXC_TOP"))
- QUIT 0
- +4 IF ($DATA(^TMP($JOB,"MMRSCD","TOP",LRMDRO,"INC_TOP")))&($DATA(^TMP($JOB,"MMRSCD","TOP",LRMDRO,"INC_TOP",LRSITE)))
- QUIT 0
- +5 IF ($DATA(^TMP($JOB,"MMRSCD","TOP",LRMDRO,"EXC_TOP")))&('$DATA(^TMP($JOB,"MMRSCD","TOP",LRMDRO,"EXC_TOP",LRSITE)))
- QUIT 0
- +6 QUIT 1
- +7 ;
- 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,"MMRSCD","BACT",LRMDRO,RPTTYPE,MMRSI))
- if 'MMRSI!(RESULT=1)
- QUIT
- Begin DoDot:1
- +4 SET LRINDVAL=$GET(^TMP($JOB,"MMRSCD","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 CDIVT,COUNT,DFLTDT,ENDDT,LIEN,STRTDT,SUBS,TSTSTP,MDROETIO
- +2 QUIT