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

MMRSISL.m

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