MMRSCRE4.m

MMRSCRE4 ;TCK/LEIDOS - Print CRE Report Cont. (Contains functions to print report) ; 3/31/17 9:48am

 ;;1.0;MDRO PROGRAM TOOLS;**4,5**;JUN 01, 2016;Build 146

 ;

PRINT ;Prints report data

 N PG,MMRSNOW,NUMLOCS,LOCNAME,LN,PREVLOC,INDATE,DFN,OUTDATE,DATA

 S PG=0

 S MMRSNOW=$$NOW^XLFDT()

 S NUMLOCS=0

 S LOCNAME="" F  S LOCNAME=$O(^TMP($J,"MMRSCRE","D",LOCNAME)) Q:LOCNAME=""  S NUMLOCS=NUMLOCS+1

 I PRTSUM S RPTYP="SUMMARY"

 I 'PRTSUM S RPTYP="DETAILED"

 S LOCNAME="" F  S LOCNAME=$O(^TMP($J,"MMRSCRE","D",LOCNAME)) Q:LOCNAME=""  D

 .I '$D(DIVARY(LOCNAME)) K DIVARY(LOCNAME) Q

 .I $D(DIVARY(LOCNAME)) K DIVARY(LOCNAME)

 .Q:$G(LOCNAME)=""

 .D PATDAYS^MMRSCRE

 .D PRTSUMA(LOCNAME)

 S $P(LN,"-",165)=""

 Q:'$D(DIVARY)

 S DVSN=0 F  S DVSN=$O(DIVARY(DVSN)) Q:DVSN=""  D

 .Q:$G(DVSN)=""

 .S LOC=DVSN

 .D PRTHDRD

 .W !!!,"NO RECORDS FOUND FOR REPORTING PERIOD."

 .W !!!

 W !!,"END OF REPORT"

 D END

 Q

PRINTADM(LOC) ; Print cont.

 S $P(LN,"-",165)=""

 D PRTHDRD

 N NODE,IN,WRD,PTN,L4,IND,ADT,MMV,SRC,SC,CC,VAL,INC

 S IN=""

 Q:LOC=""

 I '$D(^TMP($J,"MMRSCRE","DETAIL",LOC)) D  Q

 .W !!!,"NO RECORDS FOUND FOR REPORTING PERIOD."

 F  S IN=$O(^TMP($J,"MMRSCRE","DETAIL",LOC,IN)) Q:IN=""  D

 .S NODE=^TMP($J,"MMRSCRE","DETAIL",LOC,IN)

 .S WRD=$P(NODE,"^"),PTN=$P(NODE,"^",2),L4=$P(NODE,"^",3)

 .S IND=$P(NODE,"^",4),CLDT=$P(NODE,"^",5)

 .S SRC=$P(NODE,"^",6),SRC=$$GET1^DIQ(61,SRC,.01,"E")

 .S SC=$P(NODE,"^",7),CC=$P(NODE,"^",8)

 .S VAL=$P(NODE,"^",9) I VAL="Y" S VAL="POS"

 .S DTTE=$P(IND,"."),TIM=$P(IND,".",2),TIM=$E(TIM,1,4)

 .S IND=DTTE_"."_TIM,IND=$$FMTE^XLFDT(IND)

 .S DTTE=$P(CLDT,"."),TIM=$P(CLDT,".",2),TIM=$E(TIM,1,4)

 .S CLDT=DTTE_"."_TIM,CLDT=$$FMTE^XLFDT(CLDT)

 .S WD="",WD=$O(^DIC(42,"B",WRD,WD))

 .I $G(WD)'="" S SPCTY=$$GET1^DIQ(42,WD,.017,"E")

 .Q:$G(VAL)=""

 .W !,WRD,?21,$G(SPCTY),?46,PTN,?70,L4,?77,IND,?97,CLDT,?122,SRC,?131,SC,?145,CC,?157,VAL

 .I $Y+1>IOSL,LOC'="" D PRTHDRD

 Q

PRTHDRD ;

 S PG=PG+1

 W @IOF

 S $P(LN,"-",165)=""

 W ?13,"CRE ACUTE CARE IPEC REPORT - "_RPTYP

 W !,?13,"Division: ",LOC

 W !,?13,"Report period: ",$$FMTE^XLFDT(STRTDT)," to ",$$FMTE^XLFDT(ENDDT)

 W !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?70,"PAGE: ",PG

 W !!

 Q:PRTSUM

 W ?77,"DATE",?97,"SPECIMEN COLLECTION",?131,"SURVEILLANCE",?145,"CLINICAL",?157,"CULTURE"

 W !,"WARD",?21,"SERVICE",?46,"PATIENT",?70,"LAST4",?77,"ENTERED WARD",?97,"DATE/TIME",?122,"SOURCE",?131,"CULTURE",?145,"CULTURE",?157,"RESULT"

 W !,LN

 ;S PG=PG+1

 Q

PRTSUMA(LOC) ;

 N II,L

 W @IOF

 S PG=$G(PG)+1

 W ?13,"CRE ACUTE CARE IPEC REPORT - "_RPTYP

 I $G(LOC)'="" W !,?13,"Division: ",LOC

 I $G(LOC)="" W !,?13,"Divisions: " D  Q

 .S II=1 S L="" F  S L=$O(^TMP($J,"MMRSCRE","DSUM",L)) Q:L=""  W:II>1&($X>37) ", " W L_"," S II=II+1 I $X>110 W !,?37

 W !,?13,"Report period: ",$$FMTE^XLFDT(STRTDT)," to ",$$FMTE^XLFDT(ENDDT)

 W !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?70,"PAGE: ",PG

 I $G(LOC)'="" S DATA=$G(^TMP($J,"MMRSCRE","DSUM",LOC))

 I $G(LOC)="" S DATA=$G(^TMP($J,"MMRSCRE","DSUM"))

 I $G(LOC)'="" S DATA1=$G(^TMP($J,"MMRSCREPD","DSUM",LOC))

 I $G(LOC)="" S DATA1=$G(^TMP($J,"MMRSCREPD","DSUM"))

 W !!,"Basic Measures and Device Days of Care"

 W !,?3,"01 Total # of admissions to the acute care inpatient facility for the period: ",$P(DATA,"^")

 W !,?3,"02 Total # of bed days of care for acute care for the period: ",DATA1

 W !!,"Admission Prevalence Measures (Facility/Division Wide)"

 W !,?3,"07 # of (01) with surveillance screens for CRE/CPE collected upon admission: ",$P(DATA,U,2)

 W !,?3,"08 # of (07) that were positive for CRE/CPE based on surveillance screen: ",$P(DATA,U,3)

 W !,?3,"09 # of (01) that were positive for CRE/CPE based on clinical cultures: ",$P(DATA,"^",4)

 S (POS,CC,SC,SCPCT,CCPCT)=0

 S TOTAL=$P(DATA,"^")

 S TSC=$P(DATA,"^",2)

 S SCPOS=$P(DATA,"^",3)

 S CC=$P(DATA,"^",4)

 I SCPOS=0 S SCPCT=0

 I SCPOS>0 D

 .I SCPOS=TSC S SCPCT=100 Q

 .I SCPOS<TOTAL S SCPCT=(SCPOS/TSC)*100

 .I SCPCT>0 D

 ..I SCPCT["." D

 ...S SPCT=$P(SCPCT,"."),SCDEC=$P(SCPCT,".",2),SCDEC=$E(SCDEC,1,2)

 ...S SCPCT=SPCT_"."_SCDEC

 ;I CC<TOTAL S CCPCT=(CC/TOTAL)*100

 I CC=0 S CCPCT=0

 I CC>0 D

 .I CC=TOTAL S CCPCT=100 Q

 .I CC<TOTAL S CCPCT=(CC/TOTAL)*100

 .I CCPCT["." D

 ..S PCT=$P(CCPCT,"."),CCDEC=$P(CCPCT,".",2),CCDEC=$E(CCDEC,1,2)

 ..S CCPCT=PCT_"."_CCDEC

 W !,?3,"10 % of (01) that were positive for CRE/CPE based on surveillance screening: ",$G(SCPCT)_"%"

 W !,?3,"11 % of (01) that were positive for CRE/CPE based on clinical cultures: ",$G(CCPCT)_"%"

 W !!,"Incidence Measures: Healthcare-Associated Colonized Cases"

 W !,?3,"12 # of patients with screens for CRE/CPE collected 3 or more days after admission: ",$P(DATA,U,5)

 W !,?3,"13 # of (12) that were positive for CRE/CPE based on surveillance screen collected 3 or more days after admission: ",$P(DATA,U,6)

 W !,?3,"14 # of patients with clinical cultures positive for CRE/CPE 3 or more days after admission: ",$P(DATA,U,7)

 S RATE=0

 I DATA1>0 D

 .S T=$P(DATA,U,6)+$P(DATA,U,7)

 .I T>0 S RATE=(T/DATA1)*1000

 .I RATE>0&(RATE[".") D

 ..S RTE=$P(RATE,"."),RTDEC=$P(RATE,".",2),RTDEC=$E(RTDEC,1,2)

 ..S RATE=RTE_"."_RTDEC

 ;I $L(RATE)=1 S RA

 W !,?3,"15 Rate of healthcare-associated colonized cases: ",$G(RATE)

 W !!,"Infection Prevention and Control Measures"

 W !,?3,"33 # of cases with CRE/CPE for the period: ",$P(DATA,U,8)

 ;I PRTSUM W !!!,"END OF REPORT." Q

 I 'PRTSUM D PRINTADM(LOCNAME)

 I '$D(DIVARY) W !!!,"END OF REPORT"

 Q

 ;

END ;

 K CCDEC,CCPCT,CLDT,DATA1,DIVARY,DTTE,DVSN,ENDDT,PCT,POS,PRTSUM

 K RATE,RPTYP,RTDEC,RTE,SCDEC,SCPCT,SCPOS,SPCT,SPCTY,STRTDT,T

 K TIM,TOTAL,TSC,WD

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MMRSCRE4   5686     printed  Mar 13, 2025@21:19:49                                                                                                                                                                                                    Page 2

MMRSCRE4  ;TCK/LEIDOS - Print CRE Report Cont. (Contains functions to print report) ; 3/31/17 9:48am

 +1       ;;1.0;MDRO PROGRAM TOOLS;**4,5**;JUN 01, 2016;Build 146

 +2       ;

PRINT     ;Prints report data

 +1        NEW PG,MMRSNOW,NUMLOCS,LOCNAME,LN,PREVLOC,INDATE,DFN,OUTDATE,DATA

 +2        SET PG=0

 +3        SET MMRSNOW=$$NOW^XLFDT()

 +4        SET NUMLOCS=0

 +5        SET LOCNAME=""

           FOR 

               SET LOCNAME=$ORDER(^TMP($JOB,"MMRSCRE","D",LOCNAME))

               if LOCNAME=""

                   QUIT 

               SET NUMLOCS=NUMLOCS+1

 +6        IF PRTSUM

               SET RPTYP="SUMMARY"

 +7        IF 'PRTSUM

               SET RPTYP="DETAILED"

 +8        SET LOCNAME=""

           FOR 

               SET LOCNAME=$ORDER(^TMP($JOB,"MMRSCRE","D",LOCNAME))

               if LOCNAME=""

                   QUIT 

               Begin DoDot:1

 +9                IF '$DATA(DIVARY(LOCNAME))

                       KILL DIVARY(LOCNAME)

                       QUIT 

 +10               IF $DATA(DIVARY(LOCNAME))

                       KILL DIVARY(LOCNAME)

 +11               if $GET(LOCNAME)=""

                       QUIT 

 +12               DO PATDAYS^MMRSCRE

 +13               DO PRTSUMA(LOCNAME)

               End DoDot:1

 +14       SET $PIECE(LN,"-",165)=""

 +15       if '$DATA(DIVARY)

               QUIT 

 +16       SET DVSN=0

           FOR 

               SET DVSN=$ORDER(DIVARY(DVSN))

               if DVSN=""

                   QUIT 

               Begin DoDot:1

 +17               if $GET(DVSN)=""

                       QUIT 

 +18               SET LOC=DVSN

 +19               DO PRTHDRD

 +20               WRITE !!!,"NO RECORDS FOUND FOR REPORTING PERIOD."

 +21               WRITE !!!

               End DoDot:1

 +22       WRITE !!,"END OF REPORT"

 +23       DO END

 +24       QUIT 

PRINTADM(LOC) ; Print cont.

 +1        SET $PIECE(LN,"-",165)=""

 +2        DO PRTHDRD

 +3        NEW NODE,IN,WRD,PTN,L4,IND,ADT,MMV,SRC,SC,CC,VAL,INC

 +4        SET IN=""

 +5        if LOC=""

               QUIT 

 +6        IF '$DATA(^TMP($JOB,"MMRSCRE","DETAIL",LOC))

               Begin DoDot:1

 +7                WRITE !!!,"NO RECORDS FOUND FOR REPORTING PERIOD."

               End DoDot:1

               QUIT 

 +8        FOR 

               SET IN=$ORDER(^TMP($JOB,"MMRSCRE","DETAIL",LOC,IN))

               if IN=""

                   QUIT 

               Begin DoDot:1

 +9                SET NODE=^TMP($JOB,"MMRSCRE","DETAIL",LOC,IN)

 +10               SET WRD=$PIECE(NODE,"^")

                   SET PTN=$PIECE(NODE,"^",2)

                   SET L4=$PIECE(NODE,"^",3)

 +11               SET IND=$PIECE(NODE,"^",4)

                   SET CLDT=$PIECE(NODE,"^",5)

 +12               SET SRC=$PIECE(NODE,"^",6)

                   SET SRC=$$GET1^DIQ(61,SRC,.01,"E")

 +13               SET SC=$PIECE(NODE,"^",7)

                   SET CC=$PIECE(NODE,"^",8)

 +14               SET VAL=$PIECE(NODE,"^",9)

                   IF VAL="Y"

                       SET VAL="POS"

 +15               SET DTTE=$PIECE(IND,".")

                   SET TIM=$PIECE(IND,".",2)

                   SET TIM=$EXTRACT(TIM,1,4)

 +16               SET IND=DTTE_"."_TIM

                   SET IND=$$FMTE^XLFDT(IND)

 +17               SET DTTE=$PIECE(CLDT,".")

                   SET TIM=$PIECE(CLDT,".",2)

                   SET TIM=$EXTRACT(TIM,1,4)

 +18               SET CLDT=DTTE_"."_TIM

                   SET CLDT=$$FMTE^XLFDT(CLDT)

 +19               SET WD=""

                   SET WD=$ORDER(^DIC(42,"B",WRD,WD))

 +20               IF $GET(WD)'=""

                       SET SPCTY=$$GET1^DIQ(42,WD,.017,"E")

 +21               if $GET(VAL)=""

                       QUIT 

 +22               WRITE !,WRD,?21,$GET(SPCTY),?46,PTN,?70,L4,?77,IND,?97,CLDT,?122,SRC,?131,SC,?145,CC,?157,VAL

 +23               IF $Y+1>IOSL

                       IF LOC'=""

                           DO PRTHDRD

               End DoDot:1

 +24       QUIT 

PRTHDRD   ;

 +1        SET PG=PG+1

 +2        WRITE @IOF

 +3        SET $PIECE(LN,"-",165)=""

 +4        WRITE ?13,"CRE ACUTE CARE IPEC REPORT - "_RPTYP

 +5        WRITE !,?13,"Division: ",LOC

 +6        WRITE !,?13,"Report period: ",$$FMTE^XLFDT(STRTDT)," to ",$$FMTE^XLFDT(ENDDT)

 +7        WRITE !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?70,"PAGE: ",PG

 +8        WRITE !!

 +9        if PRTSUM

               QUIT 

 +10       WRITE ?77,"DATE",?97,"SPECIMEN COLLECTION",?131,"SURVEILLANCE",?145,"CLINICAL",?157,"CULTURE"

 +11       WRITE !,"WARD",?21,"SERVICE",?46,"PATIENT",?70,"LAST4",?77,"ENTERED WARD",?97,"DATE/TIME",?122,"SOURCE",?131,"CULTURE",?145,"CULTURE",?157,"RESULT"

 +12       WRITE !,LN

 +13      ;S PG=PG+1

 +14       QUIT 

PRTSUMA(LOC) ;

 +1        NEW II,L

 +2        WRITE @IOF

 +3        SET PG=$GET(PG)+1

 +4        WRITE ?13,"CRE ACUTE CARE IPEC REPORT - "_RPTYP

 +5        IF $GET(LOC)'=""

               WRITE !,?13,"Division: ",LOC

 +6        IF $GET(LOC)=""

               WRITE !,?13,"Divisions: "

               Begin DoDot:1

 +7                SET II=1

                   SET L=""

                   FOR 

                       SET L=$ORDER(^TMP($JOB,"MMRSCRE","DSUM",L))

                       if L=""

                           QUIT 

                       if II>1&($X>37)

                           WRITE ", "

                       WRITE L_","

                       SET II=II+1

                       IF $X>110

                           WRITE !,?37

               End DoDot:1

               QUIT 

 +8        WRITE !,?13,"Report period: ",$$FMTE^XLFDT(STRTDT)," to ",$$FMTE^XLFDT(ENDDT)

 +9        WRITE !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?70,"PAGE: ",PG

 +10       IF $GET(LOC)'=""

               SET DATA=$GET(^TMP($JOB,"MMRSCRE","DSUM",LOC))

 +11       IF $GET(LOC)=""

               SET DATA=$GET(^TMP($JOB,"MMRSCRE","DSUM"))

 +12       IF $GET(LOC)'=""

               SET DATA1=$GET(^TMP($JOB,"MMRSCREPD","DSUM",LOC))

 +13       IF $GET(LOC)=""

               SET DATA1=$GET(^TMP($JOB,"MMRSCREPD","DSUM"))

 +14       WRITE !!,"Basic Measures and Device Days of Care"

 +15       WRITE !,?3,"01 Total # of admissions to the acute care inpatient facility for the period: ",$PIECE(DATA,"^")

 +16       WRITE !,?3,"02 Total # of bed days of care for acute care for the period: ",DATA1

 +17       WRITE !!,"Admission Prevalence Measures (Facility/Division Wide)"

 +18       WRITE !,?3,"07 # of (01) with surveillance screens for CRE/CPE collected upon admission: ",$PIECE(DATA,U,2)

 +19       WRITE !,?3,"08 # of (07) that were positive for CRE/CPE based on surveillance screen: ",$PIECE(DATA,U,3)

 +20       WRITE !,?3,"09 # of (01) that were positive for CRE/CPE based on clinical cultures: ",$PIECE(DATA,"^",4)

 +21       SET (POS,CC,SC,SCPCT,CCPCT)=0

 +22       SET TOTAL=$PIECE(DATA,"^")

 +23       SET TSC=$PIECE(DATA,"^",2)

 +24       SET SCPOS=$PIECE(DATA,"^",3)

 +25       SET CC=$PIECE(DATA,"^",4)

 +26       IF SCPOS=0

               SET SCPCT=0

 +27       IF SCPOS>0

               Begin DoDot:1

 +28               IF SCPOS=TSC

                       SET SCPCT=100

                       QUIT 

 +29               IF SCPOS<TOTAL

                       SET SCPCT=(SCPOS/TSC)*100

 +30               IF SCPCT>0

                       Begin DoDot:2

 +31                       IF SCPCT["."

                               Begin DoDot:3

 +32                               SET SPCT=$PIECE(SCPCT,".")

                                   SET SCDEC=$PIECE(SCPCT,".",2)

                                   SET SCDEC=$EXTRACT(SCDEC,1,2)

 +33                               SET SCPCT=SPCT_"."_SCDEC

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +34      ;I CC<TOTAL S CCPCT=(CC/TOTAL)*100

 +35       IF CC=0

               SET CCPCT=0

 +36       IF CC>0

               Begin DoDot:1

 +37               IF CC=TOTAL

                       SET CCPCT=100

                       QUIT 

 +38               IF CC<TOTAL

                       SET CCPCT=(CC/TOTAL)*100

 +39               IF CCPCT["."

                       Begin DoDot:2

 +40                       SET PCT=$PIECE(CCPCT,".")

                           SET CCDEC=$PIECE(CCPCT,".",2)

                           SET CCDEC=$EXTRACT(CCDEC,1,2)

 +41                       SET CCPCT=PCT_"."_CCDEC

                       End DoDot:2

               End DoDot:1

 +42       WRITE !,?3,"10 % of (01) that were positive for CRE/CPE based on surveillance screening: ",$GET(SCPCT)_"%"

 +43       WRITE !,?3,"11 % of (01) that were positive for CRE/CPE based on clinical cultures: ",$GET(CCPCT)_"%"

 +44       WRITE !!,"Incidence Measures: Healthcare-Associated Colonized Cases"

 +45       WRITE !,?3,"12 # of patients with screens for CRE/CPE collected 3 or more days after admission: ",$PIECE(DATA,U,5)

 +46       WRITE !,?3,"13 # of (12) that were positive for CRE/CPE based on surveillance screen collected 3 or more days after admission: ",$PIECE(DATA,U,6)

 +47       WRITE !,?3,"14 # of patients with clinical cultures positive for CRE/CPE 3 or more days after admission: ",$PIECE(DATA,U,7)

 +48       SET RATE=0

 +49       IF DATA1>0

               Begin DoDot:1

 +50               SET T=$PIECE(DATA,U,6)+$PIECE(DATA,U,7)

 +51               IF T>0

                       SET RATE=(T/DATA1)*1000

 +52               IF RATE>0&(RATE[".")

                       Begin DoDot:2

 +53                       SET RTE=$PIECE(RATE,".")

                           SET RTDEC=$PIECE(RATE,".",2)

                           SET RTDEC=$EXTRACT(RTDEC,1,2)

 +54                       SET RATE=RTE_"."_RTDEC

                       End DoDot:2

               End DoDot:1

 +55      ;I $L(RATE)=1 S RA

 +56       WRITE !,?3,"15 Rate of healthcare-associated colonized cases: ",$GET(RATE)

 +57       WRITE !!,"Infection Prevention and Control Measures"

 +58       WRITE !,?3,"33 # of cases with CRE/CPE for the period: ",$PIECE(DATA,U,8)

 +59      ;I PRTSUM W !!!,"END OF REPORT." Q

 +60       IF 'PRTSUM

               DO PRINTADM(LOCNAME)

 +61       IF '$DATA(DIVARY)

               WRITE !!!,"END OF REPORT"

 +62       QUIT 

 +63      ;

END       ;

 +1        KILL CCDEC,CCPCT,CLDT,DATA1,DIVARY,DTTE,DVSN,ENDDT,PCT,POS,PRTSUM

 +2        KILL RATE,RPTYP,RTDEC,RTE,SCDEC,SCPCT,SCPOS,SPCT,SPCTY,STRTDT,T

 +3        KILL TIM,TOTAL,TSC,WD

 +4        QUIT 

 +5       ;