MMRSISL ;MIA/LMT - Print census list and MDRO history ;02-01-07
;;1.0;MRSA PROGRAM TOOLS;;Mar 22, 2009;Build 35
;
MAIN ;
N EXTFLG,MMRSLOC,MMRSDIV
D CHECK^MMRSIPC
D CHECK2^MMRSIPC
I $D(EXTFLG) W ! H 2 Q
W !
S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
W !
D CHECK3^MMRSIPC
I $D(EXTFLG) W ! H 2 Q
D PROMPT Q:$D(EXTFLG)
D ASKDVC Q:$D(EXTFLG)
Q
MAIN2 ; Entry for queuing
N USEISLT,MRSAMDRO,MRSADIV,MRSADAYS,IMPMDRO,IMPDIV,IMPDAYS,VREMDRO,VREDIV,VREDAYS,CDIFMDRO,CDIFDIV,CDIFDAYS
N ESBLMDRO,ESBLDIV,ESBLDAYS
D CLEAN
Q:'$D(MMRSDIV)!('$D(MMRSLOC))
D GETPARAM^MMRSIPC ; Load parameters in temp global
S USEISLT=+$O(^MMRS(104,MMRSDIV,1,0))
S MRSAMDRO=1
S MRSADIV=$O(^MMRS(104.2,MRSAMDRO,1,"B",MMRSDIV,0))
S MRSADAYS=$P($G(^MMRS(104.2,MRSAMDRO,1,+MRSADIV,0)),U,2)
S IMPMDRO=2
S IMPDIV=$O(^MMRS(104.2,IMPMDRO,1,"B",MMRSDIV,0))
S IMPDAYS=$P($G(^MMRS(104.2,IMPMDRO,1,+IMPDIV,0)),U,2)
S VREMDRO=3
S VREDIV=$O(^MMRS(104.2,VREMDRO,1,"B",MMRSDIV,0))
S VREDAYS=$P($G(^MMRS(104.2,VREMDRO,1,+VREDIV,0)),U,2)
S CDIFMDRO=4
S CDIFDIV=$O(^MMRS(104.2,CDIFMDRO,1,"B",MMRSDIV,0))
S CDIFDAYS=$P($G(^MMRS(104.2,CDIFMDRO,1,+CDIFDIV,0)),U,2)
S ESBLMDRO=5
S ESBLDIV=$O(^MMRS(104.2,ESBLMDRO,1,"B",MMRSDIV,0))
S ESBLDAYS=$P($G(^MMRS(104.2,ESBLMDRO,1,+ESBLDIV,0)),U,2)
D SETDATA
D PRT
D CLEAN
Q
CLEAN ;
K ^TMP($J,"MMRSIPC")
K ^TMP($J,"MMRSISL")
Q
PROMPT ;
N DIR,Y,DIRUT
S DIR(0)="YA",DIR("A")="Do you want to select all locations? ",DIR("B")="NO"
D ^DIR
I $D(DIRUT) S EXTFLG=1 Q
I Y=1 S MMRSLOC="ALL" Q
;PROMPT FOR WARDS
N DIC,DLAYGO,Y,DTOUT,DUOUT
W !
S DIC("A")="Select Geographical Location: "
S DIC("S")="I $P($G(^MMRS(104.3,Y,0)),U,2)="_MMRSDIV
S DIC="^MMRS(104.3,",DIC(0)="QEAM" D ^DIC
I (Y=-1)!($D(DTOUT))!($D(DUOUT)) S EXTFLG=1 Q
S MMRSLOC(+Y)=""
S DIC("A")="Select another Location: " F D ^DIC Q:Y=-1 S MMRSLOC(+Y)=""
K DIC
I ($D(DTOUT))!($D(DUOUT)) S EXTFLG=1 Q
Q
ASKDVC ;Prompts user for device of output (allows queuing)
N MMRSVAR,ZTSK
W !!!,"This report is designed for a 176 column format (landscape).",!
S MMRSVAR("MMRSLOC")="",MMRSVAR("MMRSLOC(")="",MMRSVAR("MMRSDIV")=""
D EN^XUTMDEVQ("MAIN2^MMRSISL","Print isolation report (MMRSISL)",.MMRSVAR,"QM",1)
W:$D(ZTSK) !,"Report Queued to Print ("_ZTSK_").",!
Q
SETDATA ;
N LOCATION,LOCNAME,DFN,LOCTYPE,MMRSI,SDRESULT,Y,WLOC,WARD,WARDNAME
I $G(MMRSLOC)="ALL" D Q
.S LOCATION=0 F S LOCATION=$O(^MMRS(104.3,LOCATION)) Q:'LOCATION I $P($G(^MMRS(104.3,LOCATION,0)),U,2)=MMRSDIV D
..S LOCNAME=$P($G(^MMRS(104.3,LOCATION,0)),U,1)
..S WLOC=0 F S WLOC=$O(^MMRS(104.3,LOCATION,1,WLOC)) Q:'WLOC D
...S WARD=$P($G(^MMRS(104.3,LOCATION,1,WLOC,0)),U,1)
...Q:'WARD
...;S WARDNAME=$P($G(^DIC(42,WARD,44)),U,1)
...;S WARDNAME=$P($G(^SC(+WARDNAME,0)),U,1)
...S WARDNAME=$P($G(^DIC(42,WARD,0)),U,1)
...Q:WARDNAME=""
...;S LOCNAME="" F S LOCNAME=$O(^DPT("CN",LOCNAME)) Q:LOCNAME="" D
...S DFN=0 F S DFN=$O(^DPT("CN",WARDNAME,DFN)) Q:'DFN D SETDATA2(DFN,LOCNAME)
S LOCATION=0 F S LOCATION=$O(MMRSLOC(LOCATION)) Q:'LOCATION D
.S LOCNAME=$P($G(^MMRS(104.3,LOCATION,0)),U,1) ;$P($G(^SC(LOCATION,0)),U,1)
.;S LOCTYPE=$P($G(^SC(LOCATION,0)),U,3)
.;I LOCTYPE="W" D
.S WLOC=0 F S WLOC=$O(^MMRS(104.3,LOCATION,1,WLOC)) Q:'WLOC D
..S WARD=$P($G(^MMRS(104.3,LOCATION,1,WLOC,0)),U,1)
..Q:'WARD
..;S WARDNAME=$P($G(^DIC(42,WARD,44)),U,1)
..;S WARDNAME=$P($G(^SC(+WARDNAME,0)),U,1)
..S WARDNAME=$P($G(^DIC(42,WARD,0)),U,1)
..Q:WARDNAME=""
..S DFN=0 F S DFN=$O(^DPT("CN",WARDNAME,DFN)) Q:'DFN D SETDATA2(DFN,LOCNAME)
.;I LOCTYPE'="W" D
.;.K ^TMP($J,"SDAMA202")
.;.D GETPLIST^SDAMA202(LOCATION,"4",,DT,DT_".24",.SDRESULT)
.;.S MMRSI=0 F S MMRSI=$O(^TMP($J,"SDAMA202","GETPLIST",MMRSI)) Q:'MMRSI D
.;..S DFN=+$G(^TMP($J,"SDAMA202","GETPLIST",MMRSI,4))
.;..I DFN D SETDATA2(DFN,LOCNAME)
.;.K ^TMP($J,"SDAMA202")
Q
SETDATA2(DFN,LOCNAME) ;
N NOW,PATNM,MRSA,MRSACULT,IMP,VRE,CDIF,ESBL,VADM,LAST4
S NOW=$$NOW^XLFDT
D KVA^VADPT
D DEM^VADPT
S PATNM=VADM(1)
S LAST4=$E($P(VADM(2),U),6,9)
D KVA^VADPT
S (MRSA,IMP,VRE,CDIF,ESBL)=""
I MRSADAYS D
.S MRSA=$P($$GETLAB^MMRSIPC3(DFN,MRSAMDRO,$$FMADD^XLFDT(NOW,-MRSADAYS),NOW,"CD"),U,2)
I IMPDAYS S IMP=$P($$GETLAB^MMRSIPC3(DFN,IMPMDRO,$$FMADD^XLFDT(NOW,-IMPDAYS),NOW,"CD"),U,2)
I VREDAYS S VRE=$P($$GETLAB^MMRSIPC3(DFN,VREMDRO,$$FMADD^XLFDT(NOW,-VREDAYS),NOW,"CD"),U,2)
I CDIFDAYS S CDIF=$P($$GETLAB^MMRSIPC3(DFN,CDIFMDRO,$$FMADD^XLFDT(NOW,-CDIFDAYS),NOW,"CD"),U,2)
I ESBLDAYS S ESBL=$P($$GETLAB^MMRSIPC3(DFN,ESBLMDRO,$$FMADD^XLFDT(NOW,-ESBLDAYS),NOW,"CD"),U,2)
S ^TMP($J,"MMRSISL",LOCNAME,PATNM,DFN)=MRSA_"^"_LAST4_"^"_IMP_"^"_ESBL_"^"_VRE_"^"_CDIF
I USEISLT D SETISLT(DFN) ;GET ISOLATION ORDERS
Q
PRT ;
N LN,PG,LOCNAME,PATNM,DFN,NODE,MRSA,IMP,ESBL,VRE,CDIFF,MMRSNOW
S $P(LN,"-",158)=""
S MMRSNOW=$$NOW^XLFDT()
S PG=1
S LOCNAME="" F S LOCNAME=$O(^TMP($J,"MMRSISL",LOCNAME)) Q:LOCNAME="" D
.D PRTHDRS S PATNM="" F S PATNM=$O(^TMP($J,"MMRSISL",LOCNAME,PATNM)) Q:PATNM="" D
..S DFN=0 F S DFN=$O(^TMP($J,"MMRSISL",LOCNAME,PATNM,DFN)) Q:'DFN D
...S NODE=$G(^TMP($J,"MMRSISL",LOCNAME,PATNM,DFN))
...S MRSA=$S($P($P(NODE,"^",1),";",1)["POS":$$FMTE^XLFDT(9999999-$P($P(NODE,"^",1),";",3),"2M"),1:"")
...S IMP=$S($P($P(NODE,"^",3),";",1)["POS":$$FMTE^XLFDT(9999999-$P($P(NODE,"^",3),";",3),"2M"),1:"")
...S ESBL=$S($P($P(NODE,"^",4),";",1)["POS":$$FMTE^XLFDT(9999999-$P($P(NODE,"^",4),";",3),"2M"),1:"")
...S VRE=$S($P($P(NODE,"^",5),";",1)["POS":$$FMTE^XLFDT(9999999-$P($P(NODE,"^",5),";",3),"2M"),1:"")
...S CDIFF=$S($P($P(NODE,"^",6),";",1)["POS":$$FMTE^XLFDT(9999999-$P($P(NODE,"^",6),";",3),"2M"),1:"")
...W !,$E(PATNM,1,24),?25,$P(NODE,"^",2),?32,MRSA,?48,IMP,?64,ESBL,?80,VRE,?96,CDIFF
...I $Y+2>IOSL D PRTHDRS
...I USEISLT D PRTISLT
Q
PRTISLT ;Print report
N MMRSI,ISLTNODE
S MMRSI=0 F S MMRSI=$O(^TMP($J,"MMRSISL",LOCNAME,PATNM,DFN,MMRSI)) Q:'MMRSI D
.I MMRSI>1 W !,$E(PATNM,1,24),?25,$P(NODE,"^",2),?32,MRSA,?48,IMP,?64,ESBL,?80,VRE,?96,CDIFF
.S ISLTNODE=$G(^TMP($J,"MMRSISL",LOCNAME,PATNM,DFN,MMRSI))
.W ?112,$P(ISLTNODE,U,1),?142,$P(ISLTNODE,U,2)
.I $Y+2>IOSL D PRTHDRS
Q
PRTHDRS ; Helper Function for PRT - Prints report headers
W @IOF
W ?13,"CENSUS LIST AND MDRO HISTORY"
W !,?13,"Geographical Location: ",LOCNAME
W !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?110,"PAGE: ",PG
W !!
W:MRSADAYS ?32,"LAST MRSA POS"
W:IMPDAYS ?48,"LAST CRB-R POS"
W:ESBLDAYS ?64,"LAST ESBL POS"
W:VREDAYS ?80,"LAST VRE POS"
W:CDIFDAYS ?96,"LAST CDF POS"
W !,"PATIENT",?25,"SSN"
W:MRSADAYS ?32,"IN "_MRSADAYS_" DAYS"
W:IMPDAYS ?48,"IN "_IMPDAYS_" DAYS"
W:ESBLDAYS ?64,"IN "_ESBLDAYS_" DAYS"
W:VREDAYS ?80,"IN "_VREDAYS_" DAYS"
W:CDIFDAYS ?96,"IN "_CDIFDAYS_" DAYS"
W:USEISLT ?112,"ISOLATION ORDER",?142,"START DATE"
W !,LN
S PG=PG+1
Q
SETISLT(DFN) ;
N MMRSI,ISLTIEN,ISLTORD,PRECTYPE
S MMRSI=1
S ISLTIEN=0 F S ISLTIEN=$O(^MMRS(104,MMRSDIV,1,ISLTIEN)) Q:'ISLTIEN D
.S ISLTORD=$P($G(^MMRS(104,MMRSDIV,1,ISLTIEN,0)),U,1)
.S PRECTYPE=$P($G(^MMRS(104,MMRSDIV,1,ISLTIEN,0)),U,2)
.S PRECTYPE=$$EXTERNAL^DILFD("104.05","1",,PRECTYPE)
.D SETISLT2(DFN,ISLTORD,PRECTYPE)
Q
SETISLT2(DFN,ISLTORD,PRECTYPE) ;
N ODATE,ORDNUM
Q:'$D(^OR(100,"AOI",ISLTORD,DFN_";DPT("))
S ODATE="" F S ODATE=$O(^OR(100,"AOI",ISLTORD,DFN_";DPT(",ODATE)) Q:ODATE="" D
.S ORDNUM="" F S ORDNUM=$O(^OR(100,"AOI",ISLTORD,DFN_";DPT(",ODATE,ORDNUM)) Q:ORDNUM="" D
..I $P($G(^OR(100,ORDNUM,3)),"^",3)=6 D
...S ^TMP($J,"MMRSISL",LOCNAME,PATNM,DFN,MMRSI)=PRECTYPE_U_$$FMTE^XLFDT($P($G(^OR(100,ORDNUM,0)),"^",8),"2D")
...S MMRSI=MMRSI+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMMRSISL 7713 printed Nov 22, 2024@17:25:24 Page 2
MMRSISL ;MIA/LMT - Print census list and MDRO history ;02-01-07
+1 ;;1.0;MRSA PROGRAM TOOLS;;Mar 22, 2009;Build 35
+2 ;
MAIN ;
+1 NEW EXTFLG,MMRSLOC,MMRSDIV
+2 DO CHECK^MMRSIPC
+3 DO CHECK2^MMRSIPC
+4 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+5 WRITE !
+6 SET MMRSDIV=$$GETDIV^MMRSIPC
if $DATA(EXTFLG)!(MMRSDIV="")
QUIT
+7 WRITE !
+8 DO CHECK3^MMRSIPC
+9 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+10 DO PROMPT
if $DATA(EXTFLG)
QUIT
+11 DO ASKDVC
if $DATA(EXTFLG)
QUIT
+12 QUIT
MAIN2 ; Entry for queuing
+1 NEW USEISLT,MRSAMDRO,MRSADIV,MRSADAYS,IMPMDRO,IMPDIV,IMPDAYS,VREMDRO,VREDIV,VREDAYS,CDIFMDRO,CDIFDIV,CDIFDAYS
+2 NEW ESBLMDRO,ESBLDIV,ESBLDAYS
+3 DO CLEAN
+4 if '$DATA(MMRSDIV)!('$DATA(MMRSLOC))
QUIT
+5 ; Load parameters in temp global
DO GETPARAM^MMRSIPC
+6 SET USEISLT=+$ORDER(^MMRS(104,MMRSDIV,1,0))
+7 SET MRSAMDRO=1
+8 SET MRSADIV=$ORDER(^MMRS(104.2,MRSAMDRO,1,"B",MMRSDIV,0))
+9 SET MRSADAYS=$PIECE($GET(^MMRS(104.2,MRSAMDRO,1,+MRSADIV,0)),U,2)
+10 SET IMPMDRO=2
+11 SET IMPDIV=$ORDER(^MMRS(104.2,IMPMDRO,1,"B",MMRSDIV,0))
+12 SET IMPDAYS=$PIECE($GET(^MMRS(104.2,IMPMDRO,1,+IMPDIV,0)),U,2)
+13 SET VREMDRO=3
+14 SET VREDIV=$ORDER(^MMRS(104.2,VREMDRO,1,"B",MMRSDIV,0))
+15 SET VREDAYS=$PIECE($GET(^MMRS(104.2,VREMDRO,1,+VREDIV,0)),U,2)
+16 SET CDIFMDRO=4
+17 SET CDIFDIV=$ORDER(^MMRS(104.2,CDIFMDRO,1,"B",MMRSDIV,0))
+18 SET CDIFDAYS=$PIECE($GET(^MMRS(104.2,CDIFMDRO,1,+CDIFDIV,0)),U,2)
+19 SET ESBLMDRO=5
+20 SET ESBLDIV=$ORDER(^MMRS(104.2,ESBLMDRO,1,"B",MMRSDIV,0))
+21 SET ESBLDAYS=$PIECE($GET(^MMRS(104.2,ESBLMDRO,1,+ESBLDIV,0)),U,2)
+22 DO SETDATA
+23 DO PRT
+24 DO CLEAN
+25 QUIT
CLEAN ;
+1 KILL ^TMP($JOB,"MMRSIPC")
+2 KILL ^TMP($JOB,"MMRSISL")
+3 QUIT
PROMPT ;
+1 NEW DIR,Y,DIRUT
+2 SET DIR(0)="YA"
SET DIR("A")="Do you want to select all locations? "
SET DIR("B")="NO"
+3 DO ^DIR
+4 IF $DATA(DIRUT)
SET EXTFLG=1
QUIT
+5 IF Y=1
SET MMRSLOC="ALL"
QUIT
+6 ;PROMPT FOR WARDS
+7 NEW DIC,DLAYGO,Y,DTOUT,DUOUT
+8 WRITE !
+9 SET DIC("A")="Select Geographical Location: "
+10 SET DIC("S")="I $P($G(^MMRS(104.3,Y,0)),U,2)="_MMRSDIV
+11 SET DIC="^MMRS(104.3,"
SET DIC(0)="QEAM"
DO ^DIC
+12 IF (Y=-1)!($DATA(DTOUT))!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+13 SET MMRSLOC(+Y)=""
+14 SET DIC("A")="Select another Location: "
FOR
DO ^DIC
if Y=-1
QUIT
SET MMRSLOC(+Y)=""
+15 KILL DIC
+16 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+17 QUIT
ASKDVC ;Prompts user for device of output (allows queuing)
+1 NEW MMRSVAR,ZTSK
+2 WRITE !!!,"This report is designed for a 176 column format (landscape).",!
+3 SET MMRSVAR("MMRSLOC")=""
SET MMRSVAR("MMRSLOC(")=""
SET MMRSVAR("MMRSDIV")=""
+4 DO EN^XUTMDEVQ("MAIN2^MMRSISL","Print isolation report (MMRSISL)",.MMRSVAR,"QM",1)
+5 if $DATA(ZTSK)
WRITE !,"Report Queued to Print ("_ZTSK_").",!
+6 QUIT
SETDATA ;
+1 NEW LOCATION,LOCNAME,DFN,LOCTYPE,MMRSI,SDRESULT,Y,WLOC,WARD,WARDNAME
+2 IF $GET(MMRSLOC)="ALL"
Begin DoDot:1
+3 SET LOCATION=0
FOR
SET LOCATION=$ORDER(^MMRS(104.3,LOCATION))
if 'LOCATION
QUIT
IF $PIECE($GET(^MMRS(104.3,LOCATION,0)),U,2)=MMRSDIV
Begin DoDot:2
+4 SET LOCNAME=$PIECE($GET(^MMRS(104.3,LOCATION,0)),U,1)
+5 SET WLOC=0
FOR
SET WLOC=$ORDER(^MMRS(104.3,LOCATION,1,WLOC))
if 'WLOC
QUIT
Begin DoDot:3
+6 SET WARD=$PIECE($GET(^MMRS(104.3,LOCATION,1,WLOC,0)),U,1)
+7 if 'WARD
QUIT
+8 ;S WARDNAME=$P($G(^DIC(42,WARD,44)),U,1)
+9 ;S WARDNAME=$P($G(^SC(+WARDNAME,0)),U,1)
+10 SET WARDNAME=$PIECE($GET(^DIC(42,WARD,0)),U,1)
+11 if WARDNAME=""
QUIT
+12 ;S LOCNAME="" F S LOCNAME=$O(^DPT("CN",LOCNAME)) Q:LOCNAME="" D
+13 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",WARDNAME,DFN))
if 'DFN
QUIT
DO SETDATA2(DFN,LOCNAME)
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+14 SET LOCATION=0
FOR
SET LOCATION=$ORDER(MMRSLOC(LOCATION))
if 'LOCATION
QUIT
Begin DoDot:1
+15 ;$P($G(^SC(LOCATION,0)),U,1)
SET LOCNAME=$PIECE($GET(^MMRS(104.3,LOCATION,0)),U,1)
+16 ;S LOCTYPE=$P($G(^SC(LOCATION,0)),U,3)
+17 ;I LOCTYPE="W" D
+18 SET WLOC=0
FOR
SET WLOC=$ORDER(^MMRS(104.3,LOCATION,1,WLOC))
if 'WLOC
QUIT
Begin DoDot:2
+19 SET WARD=$PIECE($GET(^MMRS(104.3,LOCATION,1,WLOC,0)),U,1)
+20 if 'WARD
QUIT
+21 ;S WARDNAME=$P($G(^DIC(42,WARD,44)),U,1)
+22 ;S WARDNAME=$P($G(^SC(+WARDNAME,0)),U,1)
+23 SET WARDNAME=$PIECE($GET(^DIC(42,WARD,0)),U,1)
+24 if WARDNAME=""
QUIT
+25 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",WARDNAME,DFN))
if 'DFN
QUIT
DO SETDATA2(DFN,LOCNAME)
End DoDot:2
+26 ;I LOCTYPE'="W" D
+27 ;.K ^TMP($J,"SDAMA202")
+28 ;.D GETPLIST^SDAMA202(LOCATION,"4",,DT,DT_".24",.SDRESULT)
+29 ;.S MMRSI=0 F S MMRSI=$O(^TMP($J,"SDAMA202","GETPLIST",MMRSI)) Q:'MMRSI D
+30 ;..S DFN=+$G(^TMP($J,"SDAMA202","GETPLIST",MMRSI,4))
+31 ;..I DFN D SETDATA2(DFN,LOCNAME)
+32 ;.K ^TMP($J,"SDAMA202")
End DoDot:1
+33 QUIT
SETDATA2(DFN,LOCNAME) ;
+1 NEW NOW,PATNM,MRSA,MRSACULT,IMP,VRE,CDIF,ESBL,VADM,LAST4
+2 SET NOW=$$NOW^XLFDT
+3 DO KVA^VADPT
+4 DO DEM^VADPT
+5 SET PATNM=VADM(1)
+6 SET LAST4=$EXTRACT($PIECE(VADM(2),U),6,9)
+7 DO KVA^VADPT
+8 SET (MRSA,IMP,VRE,CDIF,ESBL)=""
+9 IF MRSADAYS
Begin DoDot:1
+10 SET MRSA=$PIECE($$GETLAB^MMRSIPC3(DFN,MRSAMDRO,$$FMADD^XLFDT(NOW,-MRSADAYS),NOW,"CD"),U,2)
End DoDot:1
+11 IF IMPDAYS
SET IMP=$PIECE($$GETLAB^MMRSIPC3(DFN,IMPMDRO,$$FMADD^XLFDT(NOW,-IMPDAYS),NOW,"CD"),U,2)
+12 IF VREDAYS
SET VRE=$PIECE($$GETLAB^MMRSIPC3(DFN,VREMDRO,$$FMADD^XLFDT(NOW,-VREDAYS),NOW,"CD"),U,2)
+13 IF CDIFDAYS
SET CDIF=$PIECE($$GETLAB^MMRSIPC3(DFN,CDIFMDRO,$$FMADD^XLFDT(NOW,-CDIFDAYS),NOW,"CD"),U,2)
+14 IF ESBLDAYS
SET ESBL=$PIECE($$GETLAB^MMRSIPC3(DFN,ESBLMDRO,$$FMADD^XLFDT(NOW,-ESBLDAYS),NOW,"CD"),U,2)
+15 SET ^TMP($JOB,"MMRSISL",LOCNAME,PATNM,DFN)=MRSA_"^"_LAST4_"^"_IMP_"^"_ESBL_"^"_VRE_"^"_CDIF
+16 ;GET ISOLATION ORDERS
IF USEISLT
DO SETISLT(DFN)
+17 QUIT
PRT ;
+1 NEW LN,PG,LOCNAME,PATNM,DFN,NODE,MRSA,IMP,ESBL,VRE,CDIFF,MMRSNOW
+2 SET $PIECE(LN,"-",158)=""
+3 SET MMRSNOW=$$NOW^XLFDT()
+4 SET PG=1
+5 SET LOCNAME=""
FOR
SET LOCNAME=$ORDER(^TMP($JOB,"MMRSISL",LOCNAME))
if LOCNAME=""
QUIT
Begin DoDot:1
+6 DO PRTHDRS
SET PATNM=""
FOR
SET PATNM=$ORDER(^TMP($JOB,"MMRSISL",LOCNAME,PATNM))
if PATNM=""
QUIT
Begin DoDot:2
+7 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"MMRSISL",LOCNAME,PATNM,DFN))
if 'DFN
QUIT
Begin DoDot:3
+8 SET NODE=$GET(^TMP($JOB,"MMRSISL",LOCNAME,PATNM,DFN))
+9 SET MRSA=$SELECT($PIECE($PIECE(NODE,"^",1),";",1)["POS":$$FMTE^XLFDT(9999999-$PIECE($PIECE(NODE,"^",1),";",3),"2M"),1:"")
+10 SET IMP=$SELECT($PIECE($PIECE(NODE,"^",3),";",1)["POS":$$FMTE^XLFDT(9999999-$PIECE($PIECE(NODE,"^",3),";",3),"2M"),1:"")
+11 SET ESBL=$SELECT($PIECE($PIECE(NODE,"^",4),";",1)["POS":$$FMTE^XLFDT(9999999-$PIECE($PIECE(NODE,"^",4),";",3),"2M"),1:"")
+12 SET VRE=$SELECT($PIECE($PIECE(NODE,"^",5),";",1)["POS":$$FMTE^XLFDT(9999999-$PIECE($PIECE(NODE,"^",5),";",3),"2M"),1:"")
+13 SET CDIFF=$SELECT($PIECE($PIECE(NODE,"^",6),";",1)["POS":$$FMTE^XLFDT(9999999-$PIECE($PIECE(NODE,"^",6),";",3),"2M"),1:"")
+14 WRITE !,$EXTRACT(PATNM,1,24),?25,$PIECE(NODE,"^",2),?32,MRSA,?48,IMP,?64,ESBL,?80,VRE,?96,CDIFF
+15 IF $Y+2>IOSL
DO PRTHDRS
+16 IF USEISLT
DO PRTISLT
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
PRTISLT ;Print report
+1 NEW MMRSI,ISLTNODE
+2 SET MMRSI=0
FOR
SET MMRSI=$ORDER(^TMP($JOB,"MMRSISL",LOCNAME,PATNM,DFN,MMRSI))
if 'MMRSI
QUIT
Begin DoDot:1
+3 IF MMRSI>1
WRITE !,$EXTRACT(PATNM,1,24),?25,$PIECE(NODE,"^",2),?32,MRSA,?48,IMP,?64,ESBL,?80,VRE,?96,CDIFF
+4 SET ISLTNODE=$GET(^TMP($JOB,"MMRSISL",LOCNAME,PATNM,DFN,MMRSI))
+5 WRITE ?112,$PIECE(ISLTNODE,U,1),?142,$PIECE(ISLTNODE,U,2)
+6 IF $Y+2>IOSL
DO PRTHDRS
End DoDot:1
+7 QUIT
PRTHDRS ; Helper Function for PRT - Prints report headers
+1 WRITE @IOF
+2 WRITE ?13,"CENSUS LIST AND MDRO HISTORY"
+3 WRITE !,?13,"Geographical Location: ",LOCNAME
+4 WRITE !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?110,"PAGE: ",PG
+5 WRITE !!
+6 if MRSADAYS
WRITE ?32,"LAST MRSA POS"
+7 if IMPDAYS
WRITE ?48,"LAST CRB-R POS"
+8 if ESBLDAYS
WRITE ?64,"LAST ESBL POS"
+9 if VREDAYS
WRITE ?80,"LAST VRE POS"
+10 if CDIFDAYS
WRITE ?96,"LAST CDF POS"
+11 WRITE !,"PATIENT",?25,"SSN"
+12 if MRSADAYS
WRITE ?32,"IN "_MRSADAYS_" DAYS"
+13 if IMPDAYS
WRITE ?48,"IN "_IMPDAYS_" DAYS"
+14 if ESBLDAYS
WRITE ?64,"IN "_ESBLDAYS_" DAYS"
+15 if VREDAYS
WRITE ?80,"IN "_VREDAYS_" DAYS"
+16 if CDIFDAYS
WRITE ?96,"IN "_CDIFDAYS_" DAYS"
+17 if USEISLT
WRITE ?112,"ISOLATION ORDER",?142,"START DATE"
+18 WRITE !,LN
+19 SET PG=PG+1
+20 QUIT
SETISLT(DFN) ;
+1 NEW MMRSI,ISLTIEN,ISLTORD,PRECTYPE
+2 SET MMRSI=1
+3 SET ISLTIEN=0
FOR
SET ISLTIEN=$ORDER(^MMRS(104,MMRSDIV,1,ISLTIEN))
if 'ISLTIEN
QUIT
Begin DoDot:1
+4 SET ISLTORD=$PIECE($GET(^MMRS(104,MMRSDIV,1,ISLTIEN,0)),U,1)
+5 SET PRECTYPE=$PIECE($GET(^MMRS(104,MMRSDIV,1,ISLTIEN,0)),U,2)
+6 SET PRECTYPE=$$EXTERNAL^DILFD("104.05","1",,PRECTYPE)
+7 DO SETISLT2(DFN,ISLTORD,PRECTYPE)
End DoDot:1
+8 QUIT
SETISLT2(DFN,ISLTORD,PRECTYPE) ;
+1 NEW ODATE,ORDNUM
+2 if '$DATA(^OR(100,"AOI",ISLTORD,DFN_";DPT("))
QUIT
+3 SET ODATE=""
FOR
SET ODATE=$ORDER(^OR(100,"AOI",ISLTORD,DFN_";DPT(",ODATE))
if ODATE=""
QUIT
Begin DoDot:1
+4 SET ORDNUM=""
FOR
SET ORDNUM=$ORDER(^OR(100,"AOI",ISLTORD,DFN_";DPT(",ODATE,ORDNUM))
if ORDNUM=""
QUIT
Begin DoDot:2
+5 IF $PIECE($GET(^OR(100,ORDNUM,3)),"^",3)=6
Begin DoDot:3
+6 SET ^TMP($JOB,"MMRSISL",LOCNAME,PATNM,DFN,MMRSI)=PRECTYPE_U_$$FMTE^XLFDT($PIECE($GET(^OR(100,ORDNUM,0)),"^",8),"2D")
+7 SET MMRSI=MMRSI+1
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
