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

MMRSCDI2.m

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