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

MMRSCDI.m

Go to the documentation of this file.
  1. MMRSCDI ;LEIDOS/TCK - Print CDI report ; 4/10/17 2:08pm
  1. ;;1.0;MRSA TOOLS REPORTS MENU;**4,5**;Mar 22, 2009;Build 146
  1. ;
  1. MAIN ;
  1. N EXTFLG,MMRSDIV,MMRSLOC
  1. ;check if parameters are setup.
  1. D CLEAN
  1. D CHECK^MMRSIPC Q:$D(EXTFLG)
  1. S NUMDIV=1
  1. D CHECK Q:$D(EXTFLG)
  1. D PROMPT
  1. I $D(EXTFLG) D CLEAN K MMRSSUM,DIVARY,DVSN,MDIV Q
  1. Q:'CHK
  1. K EXTFLG
  1. Q:'CHK
  1. D ASKDVC Q:$D(EXTFLG)
  1. S MMRSNOW=$$NOW^XLFDT()
  1. D CLEAN
  1. D END^MMRSCDI1
  1. D QUIT
  1. Q
  1. ;
  1. PROMPT ;Prompt for division
  1. N STID,STNM,SIEN
  1. S (STP,ALL)=0
  1. I $G(MDROETIO)'>0 S MDROETIO=""
  1. S MMRSMDRO="",MMRSMDRO=$O(^MMRS(104.2,"B","C. diff",0))
  1. W !
  1. S DIR(0)="YA",DIR("A")="Do you want to select all divisions: ",DIR("B")="NO"
  1. D ^DIR K DIR
  1. I $D(DIRUT) S EXTFLG=1 Q
  1. I Y=1 S ALL=1 D Q:'CHK
  1. .S CHK=1
  1. .S DIV=0 F S DIV=$O(^MMRS(104,DIV)) Q:DIV'>0 D Q:STP!('CHK)
  1. ..S WR=$$GET1^DIQ(104,+DIV,.01,"I")
  1. ..S IEN="",IEN=$O(^MMRS(104.1,"C",+DIV,MMRSMDRO,IEN))
  1. ..Q:$G(IEN)'>0
  1. ..S ORGP=$$GET1^DIQ(104.1,IEN,.01,"I")
  1. ..D CHKPAR(ORGP,+DIV,.CHK)
  1. ..I 'CHK S (MDROETIO,TSTSTP)=0 D ERROR Q
  1. ..S FID=$$GET1^DIQ(40.8,WR,1,"E"),STID=$$GET1^DIQ(40.8,WR,.01,"E")
  1. ..S MMRSLOC(FID)=STID,DIVARY(STID)=+DIV
  1. ..I $G(NUMDIV)'>0 S STP=1 Q
  1. ..;I $G(SPCM)'>0 S STP=1 Q
  1. Q:STP
  1. I 'Y D Q:'CHK
  1. .N DLAYGO,DTOUT,DUOUT
  1. .S CHK=1
  1. .W !
  1. .S DIC("A")="Select Division: "
  1. .S DIC="^MMRS(104,",DIC(0)="QEAM" D ^DIC
  1. .I (Y=-1)!($D(DTOUT))!($D(DUOUT)) S EXTFLG=1 Q
  1. .S IEN="",IEN=$O(^MMRS(104.1,"C",+Y,MMRSMDRO,IEN))
  1. .Q:$G(IEN)'>0
  1. .S ORGP=$$GET1^DIQ(104.1,IEN,.01,"I")
  1. .D CHKPAR(ORGP,+Y,.CHK)
  1. .I 'CHK S (MDROETIO,TSTSTP)=0 D ERROR Q
  1. .S STID=$$GET1^DIQ(104,+Y,.01,"E"),FID=$$GET1^DIQ(104,+Y,1,"E")
  1. .S MMRSLOC(FID)=STID,DIVARY(STID)=+Y
  1. .S CHK=1
  1. .S Y=""
  1. .S DIC("A")="Select another Division: " F D ^DIC Q:Y=-1 D Q:'CHK
  1. ..S IEN="",IEN=$O(^MMRS(104.1,"C",+Y,MMRSMDRO,IEN))
  1. ..Q:$G(IEN)'>0
  1. ..S ORGP=$$GET1^DIQ(104.1,IEN,.01,"I")
  1. ..D CHKPAR(ORGP,Y,.CHK)
  1. ..I 'CHK S (MDROETIO,TSTSTP)=0 D ERROR Q
  1. ..S STID=$$GET1^DIQ(104,+Y,.01,"E")
  1. ..S FID=$$GET1^DIQ(104,+Y,1,"E"),MMRSLOC(FID)=STID,DIVARY(STID)=+Y
  1. ..I $G(NUMDIV)'>0 S STP=1 Q
  1. .I ($D(DTOUT))!($D(DUOUT)) S EXTFLG=1 Q
  1. K DIC
  1. Q:$G(NUMDIV)'>0
  1. ;Q:$G(SPCM)'>0
  1. Q:$D(EXTFLG)
  1. I ($D(DTOUT))!($D(DUOUT)) S EXTFLG=1 Q
  1. DATE ;
  1. N DATE,%DT
  1. S DATE=$$FMADD^XLFDT(DT,-364),%DT("B")=$$FMTE^XLFDT(DATE,"L")
  1. W ! S %DT="AEPX",%DT("A")="Beginning POS CDI Lab ID Event (Collection) Date: " D ^%DT
  1. I Y<0 S EXTFLG=1 Q
  1. S STRTDT=Y
  1. I STRTDT<DATE W !!,"The start date of the range cannot be greater than one year from today." G DATE
  1. S DFLTDT=$$FMADD^XLFDT(STRTDT,-56)
  1. DATE1 ;
  1. S %DT("A")="Ending POS CDI Lab ID Event (Collection) Date: " K %DT("B") D ^%DT
  1. I Y<0 S EXTFLG=1 Q
  1. S ENDDT=Y
  1. I '$P(ENDDT,".",2) S ENDDT=Y+.24
  1. I ENDDT<STRTDT W !!,"The end date of the range must be later than the starting date." G DATE1
  1. Q
  1. ;
  1. CHKPAR(ORG,Y,CHK) ;
  1. ;
  1. N I,TST,ETI
  1. S (TSTSTP,MDROETIO)=0
  1. I '$D(^MMRS(104.1,"C",+Y,ORG)) S CHK=0 Q
  1. S I="",I=$O(^MMRS(104.1,"C",+Y,ORG,I))
  1. S LIEN=1_","_I_","
  1. S TST=$$GET1^DIQ(104.15,LIEN,.01,"I")
  1. I $G(TST)>0 S TSTSTP=1 Q
  1. S ETI=$$GET1^DIQ(104.109,LIEN,.01,"I")
  1. I $G(ETI)>0 S MDROETIO=1 Q
  1. S CHK=0
  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. ....I $G(TST)'="" 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. Q
  1. ;
  1. ERROR ;
  1. I 'TSTSTP&'MDROETIO D
  1. .S EXTFLG=1
  1. .W !!," >>>The report cannot be run because the Laboratory Test(s) or"
  1. .W !," the Etiology is not configured in the MDRO TOOLS LAB "
  1. .W !," SEARCH/EXTRACT file, (104.1). Use the MDRO Tools "
  1. .W !," Lab Parameter Setup option to configure."
  1. Q
  1. ;
  1. MAIN2 ;
  1. S MMRSNOW=$$NOW^XLFDT()
  1. D GETPARAM ; Load parameters in temp global
  1. D PRT
  1. Q
  1. CLEAN ;
  1. K ^TMP($J,"MMRSCDI")
  1. K ^TMP($J,"MMRS")
  1. K ^TMP($J,"MMRSCD"),DIVARY,DVSN
  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(DIVARY)
  1. S (TSTSTP,MMRSETIO,MMRSDIV)=0,DIVSN=""
  1. S MMRSMDRO=$O(^MMRS(104.2,"B","C. diff",0))
  1. F S DIVSN=$O(DIVARY(DIVSN)) Q:DIVSN="" D
  1. .K ^TMP($J,"MMRSCD")
  1. .S Y=DIVARY(DIVSN)
  1. .S IEN="",IEN=$O(^MMRS(104.1,"C",Y,MMRSMDRO,IEN))
  1. .Q:$G(IEN)'>0
  1. .S (FND,TST,INC)=0
  1. .;I $G(TSTSTP)'>0 S TSTSTP=1
  1. .;I TSTSTP D
  1. .S MDRO=MMRSMDRO
  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 TSTSTP=1
  1. ..S ^TMP($J,"MMRSCD","T",MDRO,TEST,0)=$P($G(^MMRS(104.1,IEN,3,TIEN,0)),U,2,3)
  1. .S IBACT=0 F S IBACT=$O(^MMRS(104.1,IEN,4,IBACT)) Q:'IBACT D
  1. ..S BACT=$G(^MMRS(104.1,IEN,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,IEN,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. ..Q:'ETIOLOGY
  1. ..S ^TMP($J,"MMRSCD","ETIOL",MDRO,+ETIOLOGY)=""
  1. ..S ANTI=0 F S ANTI=$O(^MMRS(104.1,IEN,6,ETIOL,1,ANTI)) Q:'ANTI D
  1. ...S ANTIM=$P($G(^MMRS(104.1,IEN,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)="",MDROETIO=1
  1. .K MMRSET
  1. .D SETDATA
  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. .Q:'$D(DIVARY(DVSN))
  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",DVSN,WARDNAME,PATNM,DFN,CDIVT))
  1. .I $D(^TMP($J,"MMRSCDI",DVSN,WARDNAME,PATNM,DFN)) D
  1. ..S PCD=999999999999999
  1. ..S PCD=$O(^TMP($J,"MMRSCDI",DVSN,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",DVSN,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. 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
  1. S DVS=""
  1. F S DVS=$O(DIVARY(DVS)) Q:DVS="" D
  1. .I '$D(^TMP($J,"MMRSCDI",DVS)) 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",DVS,WARDNAME)) Q:WARDNAME="" D Q:QUIT
  1. ..I WARDNAME="" S QUIT=1 Q
  1. ..Q:'$D(^TMP($J,"MMRSCDI",DVS,WARDNAME))
  1. ..D PRTHDRS
  1. ..S PATNM="" F S PATNM=$O(^TMP($J,"MMRSCDI",DVS,WARDNAME,PATNM)) Q:PATNM="" D
  1. ...I PATNM?.N K ^TMP($J,"MMRSCDI",DVS,WARDNAME,PATNM) Q
  1. ...S DFN=0 F S DFN=$O(^TMP($J,"MMRSCDI",DVS,WARDNAME,PATNM,DFN)) Q:'DFN D Q:'DFN
  1. ....S CD=0 F S CD=$O(^TMP($J,"MMRSCDI",DVS,WARDNAME,PATNM,DFN,CD)) Q:'CD D
  1. .....S NODE=$G(^TMP($J,"MMRSCDI",DVS,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 ^TMP($J,"MMRS",COUNT)=PATNM_DL_LAST4_DL_DOB_DL_$G(CDIVT)_DL_$G(INDATE)_DL_$G(WARDNAME)_DL_$G(TYPE)_DL_$G(SERV)_DL_$G(STPCD)_DL_$G(DCDT)_DL_$G(PRVCDI)
  1. ....S PRVCDI=""
  1. I '$D(ZTSK)&($G(ION)'["P-MESS") D
  1. .D PRINTCDI
  1. W !!,"END OF REPORT."
  1. Q
  1. ;
  1. PRINTCDI ;
  1. W !!
  1. I '$D(^TMP($J,"MMRS")) W !!!,"No CDI cases found during specified date range" Q
  1. N DIR,DUOUT,DTOUT,DIRUT,Y
  1. S PRINT=0
  1. S DIR("A")="Print a delimited report to the screen? (Y/N): "
  1. S DIR(0)="YA" D ^DIR
  1. I $D(DIRUT)!($D(DUOUT)!$D(DTOUT)) S PRINT=0
  1. I Y>0 S PRINT=1
  1. S CDI=1
  1. Q:'PRINT
  1. W !!,"Delimited Report will now be printed to the screen..." H 3
  1. D ^%ZIS
  1. W @IOF
  1. N C,I,DL
  1. S (C,I)="",DL="^",CNT=0
  1. F S C=$O(^TMP($J,"MMRS",C)) Q:C="" D
  1. .S X1=$P(^TMP($J,"MMRS",C),DL)
  1. .S X2=$P(^TMP($J,"MMRS",C),DL,2)
  1. .S X3=$P(^TMP($J,"MMRS",C),DL,3)
  1. .S X4=$P(^TMP($J,"MMRS",C),DL,4)
  1. .S X5=$P(^TMP($J,"MMRS",C),DL,5)
  1. .S X6=$P(^TMP($J,"MMRS",C),DL,6)
  1. .S X7=$P(^TMP($J,"MMRS",C),DL,7)
  1. .S X8=$P(^TMP($J,"MMRS",C),DL,8)
  1. .S X9=$P(^TMP($J,"MMRS",C),DL,9)
  1. .S X10=""
  1. .S X11=$P(^TMP($J,"MMRS",C),DL,10)
  1. .S X12=$P(^TMP($J,"MMRS",C),DL,11)
  1. .W !,X1_DL_X2_DL_X3_DL_X4_DL_X5_DL_X6_DL_X7_DL_X8_DL_X9_DL_X10_DL_X11_DL_X12
  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: ",DVS
  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
  1. W !!!,"This report is designed for a 132 column format (compressed).",!
  1. S MMRSVAR("MMRSLOC")="",MMRS("MMRSLOC(")="",MMRSVAR("MMRSDIV")="",MMRSVAR("STRTDT")=""
  1. S MMRSVAR("ENDDT")="",MMRSVAR("TSTSTP")="",MMRSVAR("MDROETIO")="",MMRSVAR("DFLTDT")="",MMRSVAR("DIVARY")="",MMRSVAR("DIVARY(")=""
  1. D EN^XUTMDEVQ("MAIN2^MMRSCDI","Print CDI report (MMRSCDI)",.MMRSVAR,"QM",1)
  1. W:$D(ZTSK) !,"Report Queued to Print ("_ZTSK_").",!
  1. Q
  1. ;
  1. QUIT ;
  1. K ALL,DFLDT,DIV,DIVSN,DVS,FID,IXI,LIEN,LOCNME,MMRS
  1. K MMRSETIO,NUMDIV,STP,TSTSTP,TT,WR,WRD,DFLTDT
  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,ZTSK,DVSN,DIVARY
  1. Q
  1. ;