MMRSCDI2 ;LEIDOS/TCK - Print CDI report ; 4/12/17 11:57am
;;1.0;MRSA TOOLS REPORTS MENU;**4,5**;Mar 22, 2009;Build 146
;
MAIN ;
N EXTFLG,MMRSLOC
S NOCONF=0
;check if parameters are setup.
I '$D(ZTQUEUED) D Q
.W !!,"This option can only be run via TaskMan"
.W !
D CLEAN
D CHECK^MMRSIPC
D CHECK
I $D(EXTFLG) W ! H 2 Q
S NOW=$$NOW^XLFDT(),MMRSNOW=NOW
S FIRST=$E(NOW,1,5)_"01"
S ENDDT=$$FMADD^XLFDT(FIRST,-1,0,0,0)_".24"
S STRTDT=$E(ENDDT,1,5)_"01",DFLTDT=STRTDT
S DFLTDT=STRTDT
K EXTFLG
S MMRSNOW=$$NOW^XLFDT()
D MAIN2
D QUIT
Q
;
CHECK ; Check if lab tests and etiologies are setup
N II,XX,TST,MRSASTAP,ORG,ETIONAME,MMRSET,MMRSI
S (MDROETIO,TSTSTP)=0
I $D(^MMRS(104.1)) D
.S II=0 F S II=$O(^MMRS(104.1,II)) Q:II'>0 D Q:MDROETIO!(TSTSTP)
..Q:'$D(^MMRS(104.1,II,0))
..S ORGP=$P(^MMRS(104.1,II,0),"^")
..Q:$G(ORGP)'>0
..S ETIO=$$GET1^DIQ(104.2,ORGP,.01,"E")
..S ETIO=$$UPPER^DGUTL(ETIO)
..Q:ETIO'["DIFF"
..S IX=0
..F S IX=$O(^MMRS(104.1,II,3,IX)) Q:IX'>0 D Q:TSTSTP
...I $G(IX)>0 D
....Q:'$D(^MMRS(104.1,II,3,IX,0))
....S III=IX_","_II_","
....Q:III=""
....S TST=$$GET1^DIQ(104.15,III,.01,"E")
....I $G(TST)'=""&(TST["DIFF") S TSTSTP=1
....Q:$G(TST)'["DIFF"
....S TSTSTP=1
..I $D(^MMRS(104.1,II,6)) D
...S IXI=0 F S IXI=$O(^MMRS(104.1,II,6,IXI)) Q:IXI'>0 D Q:MDROETIO
....Q:IXI=""
....Q:'IXI
....S III=IXI_","_II_","
....S XX=$$GET1^DIQ(104.109,III,.01,"E")
....Q:XX'["CLOSTRIDIUM"
....S ETIONAME=XX,ORG=II,MDROETIO=ORG
;
ERROR ;
I 'TSTSTP&'MDROETIO D
.S EXTFLG=1
.W !!," >>>The report cannot be run because either the Laboratory Test(s) "
.W !," or the 'CLOSTRIDIUM DIFFICLE' Etiology are not setup "
.W !," in the LAB SEARCH/EXTRACT parameters file, (104.1)."
Q
;
MAIN2 ; Entry for queuing
S MMRSNOW=$$NOW^XLFDT()
I '$D(MMRSDIV) D PRT Q
D GETPARAM ; Load parameters in temp global
D PRT
Q
;
GTDIV(MMRSDIV) ;
N I,TST,ETI,DPTR,STAID,DIV,DPTR
S I=0
F S I=$O(^MMRS(104.1,I)) Q:$G(I)'>0 D Q:$G(I)'>0
.I $P(^MMRS(104.1,I,3,0),"^",3)>0 D
..S LIEN=1_","_I_","
..S TST=$$GET1^DIQ(104.15,LIEN,.01,"I")
.I $P(^MMRS(104.1,I,6,0),"^",3)>0 D
..S LIEN=1_","_I_","
..S ETI=$$GET1^DIQ(104.109,LIEN,.01,"I")
.I $G(TST)'>0&($G(ETI)'>0) K LIEN Q
.S DPTR=$$GET1^DIQ(104.1,I,1,"I") Q:DPTR=""
.S DIV=$$GET1^DIQ(104,DPTR,.01,"I") Q:DIV=""
.S STAID=$$GET1^DIQ(40.8,DIV,.01,"E") Q:STAID=""
.S MMRSDIV(STAID)=DIV
.S (STAID,DIV,DPTR)=""
Q
;
CLEAN ;
K ^TMP($J,"MMRSCDI")
K ^TMP($J,"MMRS")
K ^TMP($J,"MMRSCD")
Q
;
GETPARAM ; Loads lab search/extract parameters from file 104.1
N TSTNM,TST,TEST,IEN,TIEN,ITOP,TOP,ETOP,IBACT,BACT,EBACT
N ETIOL,ETIOLOGY,ANTI,ANTIM,INC,MRSASTAP,ETIONAME,MMRSI,MMRSET,ORG
N MDRO
Q:'$D(MMRSDIV)
S DIVN="",CHK=1,NOCONF=0
S MMRSMDRO=$O(^MMRS(104.2,"B","C. diff",0))
I $G(MMRSDIV)="ALL" D GETDIV(.MMRSDIV)
F S DIVN=$O(MMRSDIV(DIVN)) Q:DIVN'?.N D Q:NOCONF
.Q:DIVN=""
.S PTR=$$GET1^DIQ(104,DIVN,.01,"I")
.S DIVSN=$$GET1^DIQ(40.8,PTR,.01,"E")
.I $G(DIVSN)="" S NOCONF=1 Q
.K MMRSDIV(DIVN)
.S MMRSDIV(DIVSN)=DIVN
S DIVSN=""
F S DIVSN=$O(MMRSDIV(DIVSN)) Q:DIVSN=""!(NOCONF) D Q:NOCONF
.K ^TMP($J,"MMRSCD")
.S MDRO=MMRSMDRO
.S DIVN=MMRSDIV(DIVSN)
.I $G(DIVN)'>0 S DIVSN="" S NOCONF=1 Q
.S IEN="",IEN=$O(^MMRS(104.1,"C",DIVN,MMRSMDRO,IEN))
.Q:$G(IEN)'>0
.S ORGP=$$GET1^DIQ(104.1,IEN,.01,"I")
.D CHKPAR^MMRSCDI(ORGP,DIVN,.CHK)
.I 'CHK S NOCONF=1 Q
.S (FND,TST,INC)=0
.I TSTSTP D
..S TIEN=0 F S TIEN=$O(^MMRS(104.1,IEN,3,TIEN)) Q:'TIEN D
...S TEST=$P($G(^MMRS(104.1,IEN,3,TIEN,0)),U,1)
...Q:'TEST
...S INC=INC+1
...S ^TMP($J,"MMRSCD","T",MDRO,TEST,0)=$P($G(^MMRS(104.1,IEN,3,TIEN,0)),U,2,3)
.I MDROETIO D
..S IBACT=0 F S IBACT=$O(^MMRS(104.1,MMRSMDRO,4,IBACT)) Q:'IBACT D
...S BACT=$G(^MMRS(104.1,MMRSMDRO,4,IBACT,0))
...I BACT'="" S ^TMP($J,"MMRSCD","BACT",MDRO,"INC_REMARK",IBACT)=BACT
..S EBACT=0 F S EBACT=$O(^MMRS(104.1,MMRSMDRO,5,EBACT)) Q:'EBACT D
...S BACT=$G(^MMRS(104.1,MMRSMDRO,5,EBACT,0))
...I BACT'="" S ^TMP($J,"MMRSCD","BACT",MDRO,"EXC_REMARK",EBACT)=BACT
..S ETIOL=0 F S ETIOL=$O(^MMRS(104.1,IEN,6,ETIOL)) Q:'ETIOL D
...S ETIOLOGY=$G(^MMRS(104.1,IEN,6,ETIOL,0))
...I 'ETIOLOGY K ^TMP($J,"MMRSCD","ETIOL")
...S ^TMP($J,"MMRSCD","ETIOL",MDRO,+ETIOLOGY)=""
...S ANTI=0 F S ANTI=$O(^MMRS(104.1,MMRSMDRO,6,ETIOL,1,ANTI)) Q:'ANTI D
....S ANTIM=$P($G(^MMRS(104.1,MMRSMDRO,6,ETIOL,1,ANTI,0)),U)
....I ANTIM S ^TMP($J,"MMRSCD","ETIOL",MDRO,ETIOLOGY,ANTI)=$G(^MMRS(104.1,IEN,6,ETIOL,1,ANTI,0))
...I $G(ETIOLOGY)'="" D
....D FIND^DIC(61.2,,".01E;@","PM","CLOSTRIDIUM DIFFICILE",,"B",,,"MMRSET")
..S MMRSI="" F S MMRSI=$O(MMRSET("DILIST",MMRSI)) Q:MMRSI="" I +MMRSI>0 D
...S ETIONAME=$P($G(MMRSET("DILIST",MMRSI,0)),U,2)
...S ORG=$P($G(MMRSET("DILIST",MMRSI,0)),U,1)
...I ETIONAME'["CLOSTRIDIUM DIFFICILE" Q
...K ^TMP($J,"MMRSCD","ETIOL",MMRSMDRO,ORG)
...S ^TMP($J,"MMRSCD","ETIOL",MMRSMDRO,ORG)=""
.D SETDATA
Q
;
GETDIV(MMRSDIV) ;
N I,TST,ETI,DPTR,STAID,DIV,DPTR
S I=0
F S I=$O(^MMRS(104,I)) Q:$G(I)'>0 D Q:$G(I)'>0
.S MMRSDIV(I)=""
Q
;
SETDATA ;
N LOCATION,LOCNAME,DFN,LOCTYPE,MMRSI,SDRESULT,Y,WLOC,WARD,WARDNAME,VAIP,WRDNME
S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
.Q:'$D(^PXRMINDX(63,"PI",DFN))
.Q:$G(DFN)'>0
.D SETDATA2(DFN)
Q
;
SETDATA2(DFN) ;
N INTT,IEN,INDATE,INIFN,MRSA,MRSACULT,LABORDER,TSTNM,LABTEST,ORDITM,ORDTEMP,PATNM,VADM,DCDATE
S LOC=""
S (CDIVT,PCD)=""
;Get MRSA history
D GETLAB^MMRSCDI1(DFN,.MRSA,MMRSMDRO,MMRSNOW,"CD")
Q:'$D(MRSA)
S I="" F S I=$O(MRSA(I)) Q:I="" D
.Q:I=""
.S CDIVT=I
.S MRSA=$P(MRSA(I),"^",1,2)
.S LOC=+$P(MRSA(I),"^",3)
.S DVSN=$$GET1^DIQ(44,+LOC,3.5,"E")
.Q:DVSN'=DIVSN
.S WARDNAME=$$GET1^DIQ(44,+LOC,.01,"E")
.;Get Order info
.S LABORDER="^^"
.Q:'CDIVT
.S MRSA=$P(MRSA(I),"^",2)
.S LRFILE=44
.S STPCD=$$GET1^DIQ(LRFILE,+LOC,8,"I")
.S TYPE=$$GET1^DIQ(LRFILE,+LOC,2,"E")
.S SERV=$$GET1^DIQ(LRFILE,+LOC,9,"E")
.D GTDATE(DFN,CDIVT,.INDATE,.DCDATE)
.I $G(TYPE)'="",TYPE'="WARD" S (INDATE,DCDATE)=""
.I $D(^TMP($J,"MMRSCD","T")) D
..S MDRO="" F S MDRO=$O(^TMP($J,"MMRSCD","T",MDRO)) Q:MDRO="" D
...Q:$G(MDRO)'>0
...S TST="" F S TST=$O(^TMP($J,"MMRSCD","T",MDRO,TST)) Q:TST="" D
....N TESTS D GORDITM(TST,.LABORDER,.TESTS) ;MIA/LMT - Added with patch MMRS*1*1
.S PCD="",PATNM=$$GET1^DIQ(2,DFN,.01,"E")
.Q:$D(^TMP($J,"MMRSCDI",WARDNAME,PATNM,DFN,CDIVT))
.I $D(^TMP($J,"MMRSCDI",WARDNAME,PATNM,DFN)) D
..S PCD=999999999999999
..S PCD=$O(^TMP($J,"MMRSCDI",WARDNAME,PATNM,DFN,PCD),-1)
.S CD=CDIVT,CD=$O(MRSA(CD),-1)
.I $G(CD)>0,CD<CDIVT S PCD=CD
.Q:CDIVT<STRTDT
.S ^TMP($J,"MMRSCDI",DIVSN,WARDNAME,PATNM,DFN,CDIVT)=$G(TYPE)_U_$G(SERV)_U_$G(STPCD)_U_$G(CDIVT)_U_$G(INDATE)_U_$G(DCDATE)_U_$G(MRSA)_U_$G(PCD),PCD=""
K MRSA
Q
;
GTDATE(DFN,CDIVT,IND,DCDT) ;
N DATE,IEN
S (IND,DCDT)="",FND=0
Q:$G(CDIVT)=""
Q:'$D(^DGPM("APTT1",DFN))
S DATE=9999999999,TT=1
F S DATE=$O(^DGPM("APTT"_TT,DFN,DATE),-1) Q:DATE="" D Q:FND
.Q:DATE=""
.I CDIVT<DATE Q
.S IEN="",IEN=$O(^DGPM("APTT"_TT,DFN,DATE,IEN))
.Q:$G(IEN)'>0
.I $G(IEN)>0 D
..S IND=$$GET1^DIQ(405,IEN,.01,"I")
..S WRD=$$GET1^DIQ(405,IEN,.06,"E")
..S LOCNME="",LOCNME=$$GET1^DIQ(44,LOC,.01,"E")
.I WRD=LOCNME S FND=1
.S NXDT=$O(^DGPM("APTT"_TT,DFN,DATE),-1)
.I $G(NXDT)'>0 K NXDT S FND=1
.I $G(NXDT)>0 S DATE=NXDT,NXDT=""
.Q:$G(DATE)'>0
.S IEN="",IEN=$O(^DGPM("APTT"_TT,DFN,DATE,IEN))
.S TIEN=$$GET1^DIQ(405,IEN,.17,"I")
.I $G(TIEN)'>0 Q
.S DCDT=$$GET1^DIQ(405,TIEN,.01,"I")
.I DCDT>CDIVT S FND=1,DCDT="" Q
.I DCDT'="" S FND=1 Q
Q
;
GORDITM(LABTEST,LABORDER,TESTS) ;MIA/LMT - Added with patch MMRS*1*1 - Include panels in search
N ORDITM,ORDTEMP,LABPANEL
I $D(TESTS(LABTEST)) Q ;prevent infinite recursion; if site has Panel A within Panel B, and Panel B within Panel A
S TESTS(LABTEST)=1 ;mark that we have searched this test (to prevent infinite recursion)
S ORDITM=0 F S ORDITM=$O(^ORD(101.43,"ID",LABTEST_";99LRT",ORDITM)) Q:'ORDITM D
.S ORDTEMP=$$GETORD(DFN,ORDITM,INDATE)
.I $P(LABORDER,U,1)'="YES"!(($P(LABORDER,U,3)'="YES")&($P(ORDTEMP,U,3)="YES")) S LABORDER=ORDTEMP
S LABPANEL=0 F S LABPANEL=$O(^LAB(60,"AB",LABTEST,LABPANEL)) Q:'LABPANEL D
.D GORDITM(LABPANEL,.LABORDER,.TESTS) ;Recursive call to check for tests within panels
Q
GETORD(DFN,ORDITM,INDATE) ;
N RESULT,START,STOP,DAS,STATUS,ORUPCHUK,LABREC
S RESULT="^^"
S START=$$FMADD^XLFDT(INDATE,-1)-.0000001
F S START=$O(^PXRMINDX(100,"PI",DFN,ORDITM,START)) Q:'START D
.S STOP="" F S STOP=$O(^PXRMINDX(100,"PI",DFN,ORDITM,START,STOP)) Q:STOP="" D
..S DAS="" F S DAS=$O(^PXRMINDX(100,"PI",DFN,ORDITM,START,STOP,DAS)) Q:DAS="" D
...D EN^ORX8(+DAS)
...S STATUS=$P(ORUPCHUK("ORSTS"),U,1)
...I STATUS'=2,STATUS'=5,STATUS'=6 Q
...S LABREC="NO"
...I STATUS=6!(STATUS=2) S LABREC="YES"
...I $P(RESULT,U,3)'="YES" S RESULT="YES^"_START_U_LABREC
Q RESULT
PRT ;
I '$D(MMRSDIV) D Q
.W !!," >>>Divisions are not setup in Taskman. You must configure the"
.W !," the Divisions for this report in TaskMan in order for the "
.W !," report to run."
.W !!
I NOCONF D Q
.W !!," >>>The report cannot be run because either the Laboratory Tests "
.W !," or the 'CLOSTRIDIUM DIFFICILE' Etiology are not setup "
.W !," in the LAB SEARCH/EXTRACT parameters file, (104.1)."
.W !!
N LN,PG,LOCNAME,PATNM,DFN,NODE,LAST4,INTT,ADT,ORDDATE,VADM,QUIT,COUNT,DOB,PRVCDI
K ^TMP($J,"MMRSCDI","T")
K ^TMP($J,"MMRSCDI","ETIOL")
S $P(LN,"-",160)=""
S PG=1,QUIT=0,DVS=""
F S DVS=$O(MMRSDIV(DVS)) Q:DVS="" D
.S DIVSN=DVS
.I '$D(^TMP($J,"MMRSCDI",DIVSN)) D Q
..S WARDNAME=""
..D PRTHDRS
..W !!,"NO RECORDS FOUND FOR REPORTING PERIOD."
.S WARDNAME="" F S WARDNAME=$O(^TMP($J,"MMRSCDI",DIVSN,WARDNAME)) Q:WARDNAME="" D Q:QUIT
..I WARDNAME="" S QUIT=1 Q
..Q:'$D(^TMP($J,"MMRSCDI",DIVSN,WARDNAME))
..D PRTHDRS
..S PATNM="" F S PATNM=$O(^TMP($J,"MMRSCDI",DIVSN,WARDNAME,PATNM)) Q:PATNM="" D
...I PATNM?.N K ^TMP($J,"MMRSCDI",DIVSN,WARDNAME,PATNM) Q
...S DFN=0 F S DFN=$O(^TMP($J,"MMRSCDI",DIVSN,WARDNAME,PATNM,DFN)) Q:'DFN D Q:'DFN
....S CD=0 F S CD=$O(^TMP($J,"MMRSCDI",DIVSN,WARDNAME,PATNM,DFN,CD)) Q:'CD D
.....S NODE=$G(^TMP($J,"MMRSCDI",DIVSN,WARDNAME,PATNM,DFN,CD))
.....S TYPE=$P(NODE,"^")
.....S SERV=$P(NODE,"^",2)
.....S STPCD=$P(NODE,"^",3)
.....S CDIVT=$P(NODE,"^",4) I $G(CDIVT)>0 D
......S CDIVT=$$FMTE^XLFDT(CDIVT,2)
......I CDIVT["@" S CDIVT=$TR(CDIVT,"@"," ")
.....S INDATE=$P(NODE,"^",5) I $G(INDATE)>0 D
......S INDATE=$$FMTE^XLFDT(INDATE,2)
......I INDATE["@" S INDATE=$TR(INDATE,"@"," ")
.....S DCDT=$P(NODE,U,6) I $G(DCDT)>0 D
......S DCDT=$$FMTE^XLFDT(DCDT,2)
......I DCDT["@" S DCDT=$TR(DCDT,"@"," ")
.....S PRVCDI=$P(NODE,U,8) I $G(PRVCDI)>0 D
......S PRVCDI=$$FMTE^XLFDT(PRVCDI,2)
......I PRVCDI["@" S PRVCDI=$TR(PRVCDI,"@"," ")
.....D KVA^VADPT
.....D DEM^VADPT
.....S LAST4=$E($P(VADM(2),U),6,9)
.....D KVA^VADPT
.....S ORDDATE=$P(NODE,"^",5)
.....I ORDDATE S ORDDATE=$$FMTE^XLFDT(ORDDATE,"2M")
.....S DOB=$$GET1^DIQ(2,DFN,.03,"E")
.....W !,$E(PATNM,1,30),?25,LAST4,?30,DOB,?42,$G(CDIVT),?70,$G(INDATE),?90,$G(WARDNAME),?106,$G(DCDT),?130,$G(PRVCDI)
.....S COUNT=$G(COUNT)+1
.....S DL="^"
....S PRVCDI=""
....I $Y+2>IOSL D PRTHDRS
W !!,"END OF REPORT"
Q
;
PRTHDRS ; Helper Function for PRT - Prints report headers
W @IOF
W ?13,"FACILITY CDI CASES REPORT"
W !,?13,"Division: ",DIVSN
W !,?13,"Geographical Location: ",WARDNAME
W !,?13,"Report period: ",$$FMTE^XLFDT(STRTDT)," to ",$$FMTE^XLFDT(ENDDT)
W !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?75,"PAGE: ",PG
W !,"PATIENT",?25,"SSN",?30,"DOB",?42,"CDI Event D/T",?70,"ADM D/T",?90,"LOCATION",?105,"DC D/T",?130,"PREV CDI Event D/T"
W !,LN
S PG=PG+1
Q
ASKDVC ;Prompts user for device of output (allows queuing)
W !!
N MMRSVAR,ZTSK
W !!!,"This report is designed for a 132 column format (compressed).",!
S MMRSVAR("STRTDT")="",MMRSVAR("DFLTDT")="",MMRSVAR("ENDDT")=""
S MMRSVAR("MMRSNOW")="",MMRSVAR("TSTSTP")="",MMRSVAR("MDROETIO")=""
S MMRSVAR("MMRSDIV")="",MMRSVAR("MMRSDIV(")=""
D EN^XUTMDEVQ("MAIN2^MMRSCDI2","Print CDI report (MMRSCDI2)",.MMRSVAR,"QM",1)
W:$D(ZTSK) !,"Report Queued to Print ("_ZTSK_").",!
Q
;
QUIT ;
K ENDDT,FND,CDI,LCPTR,LRFILE,MMRSMDRO,PCDIVT,PRINT,PCDIVT,SERV
K STPCD,STRTDT,TYPE,WPTR,WRDPTR,X2,X10,X12,X2,X3,X4,X5,X6,X7,X8,X9
K X1,X11,MRSA,^TMP($J),ORGP,MDROETIO,CNT,PCD,CD,ETIO,III,IX,I
K LOC,MMRSNOW,PTR,TSTSTP,MMRSDIV,NOCONF,CHK,DFLTDT,DIVN,DIVSN,DL
K DVS,DVSN,FIRST,IXI,LOCNME,NOW,TT,WRD,ZTQUEUED
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMMRSCDI2 12788 printed Oct 16, 2024@18:15:53 Page 2
MMRSCDI2 ;LEIDOS/TCK - Print CDI report ; 4/12/17 11:57am
+1 ;;1.0;MRSA TOOLS REPORTS MENU;**4,5**;Mar 22, 2009;Build 146
+2 ;
MAIN ;
+1 NEW EXTFLG,MMRSLOC
+2 SET NOCONF=0
+3 ;check if parameters are setup.
+4 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+5 WRITE !!,"This option can only be run via TaskMan"
+6 WRITE !
End DoDot:1
QUIT
+7 DO CLEAN
+8 DO CHECK^MMRSIPC
+9 DO CHECK
+10 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+11 SET NOW=$$NOW^XLFDT()
SET MMRSNOW=NOW
+12 SET FIRST=$EXTRACT(NOW,1,5)_"01"
+13 SET ENDDT=$$FMADD^XLFDT(FIRST,-1,0,0,0)_".24"
+14 SET STRTDT=$EXTRACT(ENDDT,1,5)_"01"
SET DFLTDT=STRTDT
+15 SET DFLTDT=STRTDT
+16 KILL EXTFLG
+17 SET MMRSNOW=$$NOW^XLFDT()
+18 DO MAIN2
+19 DO QUIT
+20 QUIT
+21 ;
CHECK ; Check if lab tests and etiologies are setup
+1 NEW II,XX,TST,MRSASTAP,ORG,ETIONAME,MMRSET,MMRSI
+2 SET (MDROETIO,TSTSTP)=0
+3 IF $DATA(^MMRS(104.1))
Begin DoDot:1
+4 SET II=0
FOR
SET II=$ORDER(^MMRS(104.1,II))
if II'>0
QUIT
Begin DoDot:2
+5 if '$DATA(^MMRS(104.1,II,0))
QUIT
+6 SET ORGP=$PIECE(^MMRS(104.1,II,0),"^")
+7 if $GET(ORGP)'>0
QUIT
+8 SET ETIO=$$GET1^DIQ(104.2,ORGP,.01,"E")
+9 SET ETIO=$$UPPER^DGUTL(ETIO)
+10 if ETIO'["DIFF"
QUIT
+11 SET IX=0
+12 FOR
SET IX=$ORDER(^MMRS(104.1,II,3,IX))
if IX'>0
QUIT
Begin DoDot:3
+13 IF $GET(IX)>0
Begin DoDot:4
+14 if '$DATA(^MMRS(104.1,II,3,IX,0))
QUIT
+15 SET III=IX_","_II_","
+16 if III=""
QUIT
+17 SET TST=$$GET1^DIQ(104.15,III,.01,"E")
+18 IF $GET(TST)'=""&(TST["DIFF")
SET TSTSTP=1
+19 if $GET(TST)'["DIFF"
QUIT
+20 SET TSTSTP=1
End DoDot:4
End DoDot:3
if TSTSTP
QUIT
+21 IF $DATA(^MMRS(104.1,II,6))
Begin DoDot:3
+22 SET IXI=0
FOR
SET IXI=$ORDER(^MMRS(104.1,II,6,IXI))
if IXI'>0
QUIT
Begin DoDot:4
+23 if IXI=""
QUIT
+24 if 'IXI
QUIT
+25 SET III=IXI_","_II_","
+26 SET XX=$$GET1^DIQ(104.109,III,.01,"E")
+27 if XX'["CLOSTRIDIUM"
QUIT
+28 SET ETIONAME=XX
SET ORG=II
SET MDROETIO=ORG
End DoDot:4
if MDROETIO
QUIT
End DoDot:3
End DoDot:2
if MDROETIO!(TSTSTP)
QUIT
End DoDot:1
+29 ;
ERROR ;
+1 IF 'TSTSTP&'MDROETIO
Begin DoDot:1
+2 SET EXTFLG=1
+3 WRITE !!," >>>The report cannot be run because either the Laboratory Test(s) "
+4 WRITE !," or the 'CLOSTRIDIUM DIFFICLE' Etiology are not setup "
+5 WRITE !," in the LAB SEARCH/EXTRACT parameters file, (104.1)."
End DoDot:1
+6 QUIT
+7 ;
MAIN2 ; Entry for queuing
+1 SET MMRSNOW=$$NOW^XLFDT()
+2 IF '$DATA(MMRSDIV)
DO PRT
QUIT
+3 ; Load parameters in temp global
DO GETPARAM
+4 DO PRT
+5 QUIT
+6 ;
GTDIV(MMRSDIV) ;
+1 NEW I,TST,ETI,DPTR,STAID,DIV,DPTR
+2 SET I=0
+3 FOR
SET I=$ORDER(^MMRS(104.1,I))
if $GET(I)'>0
QUIT
Begin DoDot:1
+4 IF $PIECE(^MMRS(104.1,I,3,0),"^",3)>0
Begin DoDot:2
+5 SET LIEN=1_","_I_","
+6 SET TST=$$GET1^DIQ(104.15,LIEN,.01,"I")
End DoDot:2
+7 IF $PIECE(^MMRS(104.1,I,6,0),"^",3)>0
Begin DoDot:2
+8 SET LIEN=1_","_I_","
+9 SET ETI=$$GET1^DIQ(104.109,LIEN,.01,"I")
End DoDot:2
+10 IF $GET(TST)'>0&($GET(ETI)'>0)
KILL LIEN
QUIT
+11 SET DPTR=$$GET1^DIQ(104.1,I,1,"I")
if DPTR=""
QUIT
+12 SET DIV=$$GET1^DIQ(104,DPTR,.01,"I")
if DIV=""
QUIT
+13 SET STAID=$$GET1^DIQ(40.8,DIV,.01,"E")
if STAID=""
QUIT
+14 SET MMRSDIV(STAID)=DIV
+15 SET (STAID,DIV,DPTR)=""
End DoDot:1
if $GET(I)'>0
QUIT
+16 QUIT
+17 ;
CLEAN ;
+1 KILL ^TMP($JOB,"MMRSCDI")
+2 KILL ^TMP($JOB,"MMRS")
+3 KILL ^TMP($JOB,"MMRSCD")
+4 QUIT
+5 ;
GETPARAM ; Loads lab search/extract parameters from file 104.1
+1 NEW TSTNM,TST,TEST,IEN,TIEN,ITOP,TOP,ETOP,IBACT,BACT,EBACT
+2 NEW ETIOL,ETIOLOGY,ANTI,ANTIM,INC,MRSASTAP,ETIONAME,MMRSI,MMRSET,ORG
+3 NEW MDRO
+4 if '$DATA(MMRSDIV)
QUIT
+5 SET DIVN=""
SET CHK=1
SET NOCONF=0
+6 SET MMRSMDRO=$ORDER(^MMRS(104.2,"B","C. diff",0))
+7 IF $GET(MMRSDIV)="ALL"
DO GETDIV(.MMRSDIV)
+8 FOR
SET DIVN=$ORDER(MMRSDIV(DIVN))
if DIVN'?.N
QUIT
Begin DoDot:1
+9 if DIVN=""
QUIT
+10 SET PTR=$$GET1^DIQ(104,DIVN,.01,"I")
+11 SET DIVSN=$$GET1^DIQ(40.8,PTR,.01,"E")
+12 IF $GET(DIVSN)=""
SET NOCONF=1
QUIT
+13 KILL MMRSDIV(DIVN)
+14 SET MMRSDIV(DIVSN)=DIVN
End DoDot:1
if NOCONF
QUIT
+15 SET DIVSN=""
+16 FOR
SET DIVSN=$ORDER(MMRSDIV(DIVSN))
if DIVSN=""!(NOCONF)
QUIT
Begin DoDot:1
+17 KILL ^TMP($JOB,"MMRSCD")
+18 SET MDRO=MMRSMDRO
+19 SET DIVN=MMRSDIV(DIVSN)
+20 IF $GET(DIVN)'>0
SET DIVSN=""
SET NOCONF=1
QUIT
+21 SET IEN=""
SET IEN=$ORDER(^MMRS(104.1,"C",DIVN,MMRSMDRO,IEN))
+22 if $GET(IEN)'>0
QUIT
+23 SET ORGP=$$GET1^DIQ(104.1,IEN,.01,"I")
+24 DO CHKPAR^MMRSCDI(ORGP,DIVN,.CHK)
+25 IF 'CHK
SET NOCONF=1
QUIT
+26 SET (FND,TST,INC)=0
+27 IF TSTSTP
Begin DoDot:2
+28 SET TIEN=0
FOR
SET TIEN=$ORDER(^MMRS(104.1,IEN,3,TIEN))
if 'TIEN
QUIT
Begin DoDot:3
+29 SET TEST=$PIECE($GET(^MMRS(104.1,IEN,3,TIEN,0)),U,1)
+30 if 'TEST
QUIT
+31 SET INC=INC+1
+32 SET ^TMP($JOB,"MMRSCD","T",MDRO,TEST,0)=$PIECE($GET(^MMRS(104.1,IEN,3,TIEN,0)),U,2,3)
End DoDot:3
End DoDot:2
+33 IF MDROETIO
Begin DoDot:2
+34 SET IBACT=0
FOR
SET IBACT=$ORDER(^MMRS(104.1,MMRSMDRO,4,IBACT))
if 'IBACT
QUIT
Begin DoDot:3
+35 SET BACT=$GET(^MMRS(104.1,MMRSMDRO,4,IBACT,0))
+36 IF BACT'=""
SET ^TMP($JOB,"MMRSCD","BACT",MDRO,"INC_REMARK",IBACT)=BACT
End DoDot:3
+37 SET EBACT=0
FOR
SET EBACT=$ORDER(^MMRS(104.1,MMRSMDRO,5,EBACT))
if 'EBACT
QUIT
Begin DoDot:3
+38 SET BACT=$GET(^MMRS(104.1,MMRSMDRO,5,EBACT,0))
+39 IF BACT'=""
SET ^TMP($JOB,"MMRSCD","BACT",MDRO,"EXC_REMARK",EBACT)=BACT
End DoDot:3
+40 SET ETIOL=0
FOR
SET ETIOL=$ORDER(^MMRS(104.1,IEN,6,ETIOL))
if 'ETIOL
QUIT
Begin DoDot:3
+41 SET ETIOLOGY=$GET(^MMRS(104.1,IEN,6,ETIOL,0))
+42 IF 'ETIOLOGY
KILL ^TMP($JOB,"MMRSCD","ETIOL")
+43 SET ^TMP($JOB,"MMRSCD","ETIOL",MDRO,+ETIOLOGY)=""
+44 SET ANTI=0
FOR
SET ANTI=$ORDER(^MMRS(104.1,MMRSMDRO,6,ETIOL,1,ANTI))
if 'ANTI
QUIT
Begin DoDot:4
+45 SET ANTIM=$PIECE($GET(^MMRS(104.1,MMRSMDRO,6,ETIOL,1,ANTI,0)),U)
+46 IF ANTIM
SET ^TMP($JOB,"MMRSCD","ETIOL",MDRO,ETIOLOGY,ANTI)=$GET(^MMRS(104.1,IEN,6,ETIOL,1,ANTI,0))
End DoDot:4
+47 IF $GET(ETIOLOGY)'=""
Begin DoDot:4
+48 DO FIND^DIC(61.2,,".01E;@","PM","CLOSTRIDIUM DIFFICILE",,"B",,,"MMRSET")
End DoDot:4
End DoDot:3
+49 SET MMRSI=""
FOR
SET MMRSI=$ORDER(MMRSET("DILIST",MMRSI))
if MMRSI=""
QUIT
IF +MMRSI>0
Begin DoDot:3
+50 SET ETIONAME=$PIECE($GET(MMRSET("DILIST",MMRSI,0)),U,2)
+51 SET ORG=$PIECE($GET(MMRSET("DILIST",MMRSI,0)),U,1)
+52 IF ETIONAME'["CLOSTRIDIUM DIFFICILE"
QUIT
+53 KILL ^TMP($JOB,"MMRSCD","ETIOL",MMRSMDRO,ORG)
+54 SET ^TMP($JOB,"MMRSCD","ETIOL",MMRSMDRO,ORG)=""
End DoDot:3
End DoDot:2
+55 DO SETDATA
End DoDot:1
if NOCONF
QUIT
+56 QUIT
+57 ;
GETDIV(MMRSDIV) ;
+1 NEW I,TST,ETI,DPTR,STAID,DIV,DPTR
+2 SET I=0
+3 FOR
SET I=$ORDER(^MMRS(104,I))
if $GET(I)'>0
QUIT
Begin DoDot:1
+4 SET MMRSDIV(I)=""
End DoDot:1
if $GET(I)'>0
QUIT
+5 QUIT
+6 ;
SETDATA ;
+1 NEW LOCATION,LOCNAME,DFN,LOCTYPE,MMRSI,SDRESULT,Y,WLOC,WARD,WARDNAME,VAIP,WRDNME
+2 SET DFN=0
FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+3 if '$DATA(^PXRMINDX(63,"PI",DFN))
QUIT
+4 if $GET(DFN)'>0
QUIT
+5 DO SETDATA2(DFN)
End DoDot:1
+6 QUIT
+7 ;
SETDATA2(DFN) ;
+1 NEW INTT,IEN,INDATE,INIFN,MRSA,MRSACULT,LABORDER,TSTNM,LABTEST,ORDITM,ORDTEMP,PATNM,VADM,DCDATE
+2 SET LOC=""
+3 SET (CDIVT,PCD)=""
+4 ;Get MRSA history
+5 DO GETLAB^MMRSCDI1(DFN,.MRSA,MMRSMDRO,MMRSNOW,"CD")
+6 if '$DATA(MRSA)
QUIT
+7 SET I=""
FOR
SET I=$ORDER(MRSA(I))
if I=""
QUIT
Begin DoDot:1
+8 if I=""
QUIT
+9 SET CDIVT=I
+10 SET MRSA=$PIECE(MRSA(I),"^",1,2)
+11 SET LOC=+$PIECE(MRSA(I),"^",3)
+12 SET DVSN=$$GET1^DIQ(44,+LOC,3.5,"E")
+13 if DVSN'=DIVSN
QUIT
+14 SET WARDNAME=$$GET1^DIQ(44,+LOC,.01,"E")
+15 ;Get Order info
+16 SET LABORDER="^^"
+17 if 'CDIVT
QUIT
+18 SET MRSA=$PIECE(MRSA(I),"^",2)
+19 SET LRFILE=44
+20 SET STPCD=$$GET1^DIQ(LRFILE,+LOC,8,"I")
+21 SET TYPE=$$GET1^DIQ(LRFILE,+LOC,2,"E")
+22 SET SERV=$$GET1^DIQ(LRFILE,+LOC,9,"E")
+23 DO GTDATE(DFN,CDIVT,.INDATE,.DCDATE)
+24 IF $GET(TYPE)'=""
IF TYPE'="WARD"
SET (INDATE,DCDATE)=""
+25 IF $DATA(^TMP($JOB,"MMRSCD","T"))
Begin DoDot:2
+26 SET MDRO=""
FOR
SET MDRO=$ORDER(^TMP($JOB,"MMRSCD","T",MDRO))
if MDRO=""
QUIT
Begin DoDot:3
+27 if $GET(MDRO)'>0
QUIT
+28 SET TST=""
FOR
SET TST=$ORDER(^TMP($JOB,"MMRSCD","T",MDRO,TST))
if TST=""
QUIT
Begin DoDot:4
+29 ;MIA/LMT - Added with patch MMRS*1*1
NEW TESTS
DO GORDITM(TST,.LABORDER,.TESTS)
End DoDot:4
End DoDot:3
End DoDot:2
+30 SET PCD=""
SET PATNM=$$GET1^DIQ(2,DFN,.01,"E")
+31 if $DATA(^TMP($JOB,"MMRSCDI",WARDNAME,PATNM,DFN,CDIVT))
QUIT
+32 IF $DATA(^TMP($JOB,"MMRSCDI",WARDNAME,PATNM,DFN))
Begin DoDot:2
+33 SET PCD=999999999999999
+34 SET PCD=$ORDER(^TMP($JOB,"MMRSCDI",WARDNAME,PATNM,DFN,PCD),-1)
End DoDot:2
+35 SET CD=CDIVT
SET CD=$ORDER(MRSA(CD),-1)
+36 IF $GET(CD)>0
IF CD<CDIVT
SET PCD=CD
+37 if CDIVT<STRTDT
QUIT
+38 SET ^TMP($JOB,"MMRSCDI",DIVSN,WARDNAME,PATNM,DFN,CDIVT)=$GET(TYPE)_U_$GET(SERV)_U_$GET(STPCD)_U_$GET(CDIVT)_U_$GET(INDATE)_U_$GET(DCDATE)_U_$GET(MRSA)_U_$GET(PCD)
SET PCD=""
End DoDot:1
+39 KILL MRSA
+40 QUIT
+41 ;
GTDATE(DFN,CDIVT,IND,DCDT) ;
+1 NEW DATE,IEN
+2 SET (IND,DCDT)=""
SET FND=0
+3 if $GET(CDIVT)=""
QUIT
+4 if '$DATA(^DGPM("APTT1",DFN))
QUIT
+5 SET DATE=9999999999
SET TT=1
+6 FOR
SET DATE=$ORDER(^DGPM("APTT"_TT,DFN,DATE),-1)
if DATE=""
QUIT
Begin DoDot:1
+7 if DATE=""
QUIT
+8 IF CDIVT<DATE
QUIT
+9 SET IEN=""
SET IEN=$ORDER(^DGPM("APTT"_TT,DFN,DATE,IEN))
+10 if $GET(IEN)'>0
QUIT
+11 IF $GET(IEN)>0
Begin DoDot:2
+12 SET IND=$$GET1^DIQ(405,IEN,.01,"I")
+13 SET WRD=$$GET1^DIQ(405,IEN,.06,"E")
+14 SET LOCNME=""
SET LOCNME=$$GET1^DIQ(44,LOC,.01,"E")
End DoDot:2
+15 IF WRD=LOCNME
SET FND=1
+16 SET NXDT=$ORDER(^DGPM("APTT"_TT,DFN,DATE),-1)
+17 IF $GET(NXDT)'>0
KILL NXDT
SET FND=1
+18 IF $GET(NXDT)>0
SET DATE=NXDT
SET NXDT=""
+19 if $GET(DATE)'>0
QUIT
+20 SET IEN=""
SET IEN=$ORDER(^DGPM("APTT"_TT,DFN,DATE,IEN))
+21 SET TIEN=$$GET1^DIQ(405,IEN,.17,"I")
+22 IF $GET(TIEN)'>0
QUIT
+23 SET DCDT=$$GET1^DIQ(405,TIEN,.01,"I")
+24 IF DCDT>CDIVT
SET FND=1
SET DCDT=""
QUIT
+25 IF DCDT'=""
SET FND=1
QUIT
End DoDot:1
if FND
QUIT
+26 QUIT
+27 ;
GORDITM(LABTEST,LABORDER,TESTS) ;MIA/LMT - Added with patch MMRS*1*1 - Include panels in search
+1 NEW ORDITM,ORDTEMP,LABPANEL
+2 ;prevent infinite recursion; if site has Panel A within Panel B, and Panel B within Panel A
IF $DATA(TESTS(LABTEST))
QUIT
+3 ;mark that we have searched this test (to prevent infinite recursion)
SET TESTS(LABTEST)=1
+4 SET ORDITM=0
FOR
SET ORDITM=$ORDER(^ORD(101.43,"ID",LABTEST_";99LRT",ORDITM))
if 'ORDITM
QUIT
Begin DoDot:1
+5 SET ORDTEMP=$$GETORD(DFN,ORDITM,INDATE)
+6 IF $PIECE(LABORDER,U,1)'="YES"!(($PIECE(LABORDER,U,3)'="YES")&($PIECE(ORDTEMP,U,3)="YES"))
SET LABORDER=ORDTEMP
End DoDot:1
+7 SET LABPANEL=0
FOR
SET LABPANEL=$ORDER(^LAB(60,"AB",LABTEST,LABPANEL))
if 'LABPANEL
QUIT
Begin DoDot:1
+8 ;Recursive call to check for tests within panels
DO GORDITM(LABPANEL,.LABORDER,.TESTS)
End DoDot:1
+9 QUIT
GETORD(DFN,ORDITM,INDATE) ;
+1 NEW RESULT,START,STOP,DAS,STATUS,ORUPCHUK,LABREC
+2 SET RESULT="^^"
+3 SET START=$$FMADD^XLFDT(INDATE,-1)-.0000001
+4 FOR
SET START=$ORDER(^PXRMINDX(100,"PI",DFN,ORDITM,START))
if 'START
QUIT
Begin DoDot:1
+5 SET STOP=""
FOR
SET STOP=$ORDER(^PXRMINDX(100,"PI",DFN,ORDITM,START,STOP))
if STOP=""
QUIT
Begin DoDot:2
+6 SET DAS=""
FOR
SET DAS=$ORDER(^PXRMINDX(100,"PI",DFN,ORDITM,START,STOP,DAS))
if DAS=""
QUIT
Begin DoDot:3
+7 DO EN^ORX8(+DAS)
+8 SET STATUS=$PIECE(ORUPCHUK("ORSTS"),U,1)
+9 IF STATUS'=2
IF STATUS'=5
IF STATUS'=6
QUIT
+10 SET LABREC="NO"
+11 IF STATUS=6!(STATUS=2)
SET LABREC="YES"
+12 IF $PIECE(RESULT,U,3)'="YES"
SET RESULT="YES^"_START_U_LABREC
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT RESULT
PRT ;
+1 IF '$DATA(MMRSDIV)
Begin DoDot:1
+2 WRITE !!," >>>Divisions are not setup in Taskman. You must configure the"
+3 WRITE !," the Divisions for this report in TaskMan in order for the "
+4 WRITE !," report to run."
+5 WRITE !!
End DoDot:1
QUIT
+6 IF NOCONF
Begin DoDot:1
+7 WRITE !!," >>>The report cannot be run because either the Laboratory Tests "
+8 WRITE !," or the 'CLOSTRIDIUM DIFFICILE' Etiology are not setup "
+9 WRITE !," in the LAB SEARCH/EXTRACT parameters file, (104.1)."
+10 WRITE !!
End DoDot:1
QUIT
+11 NEW LN,PG,LOCNAME,PATNM,DFN,NODE,LAST4,INTT,ADT,ORDDATE,VADM,QUIT,COUNT,DOB,PRVCDI
+12 KILL ^TMP($JOB,"MMRSCDI","T")
+13 KILL ^TMP($JOB,"MMRSCDI","ETIOL")
+14 SET $PIECE(LN,"-",160)=""
+15 SET PG=1
SET QUIT=0
SET DVS=""
+16 FOR
SET DVS=$ORDER(MMRSDIV(DVS))
if DVS=""
QUIT
Begin DoDot:1
+17 SET DIVSN=DVS
+18 IF '$DATA(^TMP($JOB,"MMRSCDI",DIVSN))
Begin DoDot:2
+19 SET WARDNAME=""
+20 DO PRTHDRS
+21 WRITE !!,"NO RECORDS FOUND FOR REPORTING PERIOD."
End DoDot:2
QUIT
+22 SET WARDNAME=""
FOR
SET WARDNAME=$ORDER(^TMP($JOB,"MMRSCDI",DIVSN,WARDNAME))
if WARDNAME=""
QUIT
Begin DoDot:2
+23 IF WARDNAME=""
SET QUIT=1
QUIT
+24 if '$DATA(^TMP($JOB,"MMRSCDI",DIVSN,WARDNAME))
QUIT
+25 DO PRTHDRS
+26 SET PATNM=""
FOR
SET PATNM=$ORDER(^TMP($JOB,"MMRSCDI",DIVSN,WARDNAME,PATNM))
if PATNM=""
QUIT
Begin DoDot:3
+27 IF PATNM?.N
KILL ^TMP($JOB,"MMRSCDI",DIVSN,WARDNAME,PATNM)
QUIT
+28 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"MMRSCDI",DIVSN,WARDNAME,PATNM,DFN))
if 'DFN
QUIT
Begin DoDot:4
+29 SET CD=0
FOR
SET CD=$ORDER(^TMP($JOB,"MMRSCDI",DIVSN,WARDNAME,PATNM,DFN,CD))
if 'CD
QUIT
Begin DoDot:5
+30 SET NODE=$GET(^TMP($JOB,"MMRSCDI",DIVSN,WARDNAME,PATNM,DFN,CD))
+31 SET TYPE=$PIECE(NODE,"^")
+32 SET SERV=$PIECE(NODE,"^",2)
+33 SET STPCD=$PIECE(NODE,"^",3)
+34 SET CDIVT=$PIECE(NODE,"^",4)
IF $GET(CDIVT)>0
Begin DoDot:6
+35 SET CDIVT=$$FMTE^XLFDT(CDIVT,2)
+36 IF CDIVT["@"
SET CDIVT=$TRANSLATE(CDIVT,"@"," ")
End DoDot:6
+37 SET INDATE=$PIECE(NODE,"^",5)
IF $GET(INDATE)>0
Begin DoDot:6
+38 SET INDATE=$$FMTE^XLFDT(INDATE,2)
+39 IF INDATE["@"
SET INDATE=$TRANSLATE(INDATE,"@"," ")
End DoDot:6
+40 SET DCDT=$PIECE(NODE,U,6)
IF $GET(DCDT)>0
Begin DoDot:6
+41 SET DCDT=$$FMTE^XLFDT(DCDT,2)
+42 IF DCDT["@"
SET DCDT=$TRANSLATE(DCDT,"@"," ")
End DoDot:6
+43 SET PRVCDI=$PIECE(NODE,U,8)
IF $GET(PRVCDI)>0
Begin DoDot:6
+44 SET PRVCDI=$$FMTE^XLFDT(PRVCDI,2)
+45 IF PRVCDI["@"
SET PRVCDI=$TRANSLATE(PRVCDI,"@"," ")
End DoDot:6
+46 DO KVA^VADPT
+47 DO DEM^VADPT
+48 SET LAST4=$EXTRACT($PIECE(VADM(2),U),6,9)
+49 DO KVA^VADPT
+50 SET ORDDATE=$PIECE(NODE,"^",5)
+51 IF ORDDATE
SET ORDDATE=$$FMTE^XLFDT(ORDDATE,"2M")
+52 SET DOB=$$GET1^DIQ(2,DFN,.03,"E")
+53 WRITE !,$EXTRACT(PATNM,1,30),?25,LAST4,?30,DOB,?42,$GET(CDIVT),?70,$GET(INDATE),?90,$GET(WARDNAME),?106,$GET(DCDT),?130,$GET(PRVCDI)
+54 SET COUNT=$GET(COUNT)+1
+55 SET DL="^"
End DoDot:5
+56 SET PRVCDI=""
+57 IF $Y+2>IOSL
DO PRTHDRS
End DoDot:4
if 'DFN
QUIT
End DoDot:3
End DoDot:2
if QUIT
QUIT
End DoDot:1
+58 WRITE !!,"END OF REPORT"
+59 QUIT
+60 ;
PRTHDRS ; Helper Function for PRT - Prints report headers
+1 WRITE @IOF
+2 WRITE ?13,"FACILITY CDI CASES REPORT"
+3 WRITE !,?13,"Division: ",DIVSN
+4 WRITE !,?13,"Geographical Location: ",WARDNAME
+5 WRITE !,?13,"Report period: ",$$FMTE^XLFDT(STRTDT)," to ",$$FMTE^XLFDT(ENDDT)
+6 WRITE !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?75,"PAGE: ",PG
+7 WRITE !,"PATIENT",?25,"SSN",?30,"DOB",?42,"CDI Event D/T",?70,"ADM D/T",?90,"LOCATION",?105,"DC D/T",?130,"PREV CDI Event D/T"
+8 WRITE !,LN
+9 SET PG=PG+1
+10 QUIT
ASKDVC ;Prompts user for device of output (allows queuing)
+1 WRITE !!
+2 NEW MMRSVAR,ZTSK
+3 WRITE !!!,"This report is designed for a 132 column format (compressed).",!
+4 SET MMRSVAR("STRTDT")=""
SET MMRSVAR("DFLTDT")=""
SET MMRSVAR("ENDDT")=""
+5 SET MMRSVAR("MMRSNOW")=""
SET MMRSVAR("TSTSTP")=""
SET MMRSVAR("MDROETIO")=""
+6 SET MMRSVAR("MMRSDIV")=""
SET MMRSVAR("MMRSDIV(")=""
+7 DO EN^XUTMDEVQ("MAIN2^MMRSCDI2","Print CDI report (MMRSCDI2)",.MMRSVAR,"QM",1)
+8 if $DATA(ZTSK)
WRITE !,"Report Queued to Print ("_ZTSK_").",!
+9 QUIT
+10 ;
QUIT ;
+1 KILL ENDDT,FND,CDI,LCPTR,LRFILE,MMRSMDRO,PCDIVT,PRINT,PCDIVT,SERV
+2 KILL STPCD,STRTDT,TYPE,WPTR,WRDPTR,X2,X10,X12,X2,X3,X4,X5,X6,X7,X8,X9
+3 KILL X1,X11,MRSA,^TMP($JOB),ORGP,MDROETIO,CNT,PCD,CD,ETIO,III,IX,I
+4 KILL LOC,MMRSNOW,PTR,TSTSTP,MMRSDIV,NOCONF,CHK,DFLTDT,DIVN,DIVSN,DL
+5 KILL DVS,DVSN,FIRST,IXI,LOCNME,NOW,TT,WRD,ZTQUEUED
+6 QUIT
+7 ;
