MMRSORD ;MIA/LMT - Print ward census showing which patients need a nares swab ;02/15/17 08:34
;;1.0;MRSA PROGRAM TOOLS;**1,5**;Mar 22, 2009;Build 146
;
MAIN ;
N EXTFLG,MMRSDIV,MMRSLOC
D CHECK^MMRSIPC
D CHECK2^MMRSIPC
I $D(EXTFLG) W ! H 2 Q
W !
S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
W !
D CHECK3^MMRSIPC
I $D(EXTFLG) W ! H 2 Q
D PROMPT^MMRSISL Q:$D(EXTFLG)
D ASKDVC Q:$D(EXTFLG)
Q
MAIN2 ;
N MMRSNOW
D CLEAN
Q:'$D(MMRSDIV)!('$D(MMRSLOC))
S MMRSNOW=$$NOW^XLFDT()
D GETPARAM^MMRSIPC ; Load parameters in temp global
D SETDATA
D PRT
D CLEAN
Q
CLEAN ;
K ^TMP($J,"MMRSIPC")
K ^TMP($J,"MMRSORD")
Q
SETDATA ;
N LOCATION,LOCNAME,DFN,LOCTYPE,MMRSI,SDRESULT,Y,WLOC,WARD,WARDNAME,VAIP
I $G(MMRSLOC)="ALL" D Q
.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
..S LOCNAME=$P($G(^MMRS(104.3,LOCATION,0)),U,1)
..S WLOC=0 F S WLOC=$O(^MMRS(104.3,LOCATION,1,WLOC)) Q:'WLOC D
...S WARD=$P($G(^MMRS(104.3,LOCATION,1,WLOC,0)),U,1)
...Q:'WARD
...;S WARDNAME=$P($G(^DIC(42,WARD,44)),U,1)
...;S WARDNAME=$P($G(^SC(+WARDNAME,0)),U,1)
...S WARDNAME=$P($G(^DIC(42,WARD,0)),U,1)
...Q:WARDNAME=""
...S DFN=0 F S DFN=$O(^DPT("CN",WARDNAME,DFN)) Q:'DFN D SETDATA2(DFN,LOCATION,LOCNAME)
S LOCATION=0 F S LOCATION=$O(MMRSLOC(LOCATION)) Q:'LOCATION D
.S LOCNAME=$P($G(^MMRS(104.3,LOCATION,0)),U,1)
.S WLOC=0 F S WLOC=$O(^MMRS(104.3,LOCATION,1,WLOC)) Q:'WLOC D
..S WARD=$P($G(^MMRS(104.3,LOCATION,1,WLOC,0)),U,1)
..Q:'WARD
..;S WARDNAME=$P($G(^DIC(42,WARD,44)),U,1)
..;S WARDNAME=$P($G(^SC(+WARDNAME,0)),U,1)
..S WARDNAME=$P($G(^DIC(42,WARD,0)),U,1)
..Q:WARDNAME=""
..S DFN=0 F S DFN=$O(^DPT("CN",WARDNAME,DFN)) Q:'DFN D SETDATA2(DFN,LOCATION,LOCNAME)
Q
SETDATA2(DFN,LOC,LOCNAME) ;
N INTT,IEN,INDATE,INIFN,MRSAMDRO,MRSA,MRSACULT,LABORDER,TSTNM,LABTEST,ORDITM,ORDTEMP,PATNM,VADM
N PREVIEN,PREVWARD
;Get unit admission date and Transaction Type
D KVA^VADPT
S VAIP("D")=MMRSNOW
D IN5^VADPT
I 'VAIP(1) Q
S INTT=$$TRANTYPE^MMRSIPC2(+VAIP(4),+VAIP(2),VAIP(1),DFN)
S PREVWARD=$P(INTT,U,2)
S PREVIEN=$P(INTT,U,4)
S INTT=$P(INTT,U,1)
I PREVWARD="" S PREVWARD=+VAIP(15,4)
I PREVIEN="" S PREVIEN=VAIP(15)
F Q:(INTT=1)!(INTT=2&$$CNGWARD^MMRSIPC2(LOC,+VAIP(5),PREVWARD))!(PREVIEN="") D
.S IEN=+PREVIEN
.D KVA^VADPT
.S VAIP("E")=IEN
.D IN5^VADPT
.S INTT=$$TRANTYPE^MMRSIPC2(+VAIP(4),+VAIP(2),VAIP(1),DFN)
.S PREVWARD=$P(INTT,U,2)
.S PREVIEN=$P(INTT,U,4)
.S INTT=$P(INTT,U,1)
.I PREVWARD="" S PREVWARD=+VAIP(15,4)
.I PREVIEN="" S PREVIEN=VAIP(15)
I INTT<1!(INTT>2) Q
S INDATE=+VAIP(3)
S INIFN=+VAIP(1)
I '$G(INIFN) Q
;Get MRSA history
S MRSAMDRO=1
S MRSA=$P($$GETLAB^MMRSIPC3(DFN,MRSAMDRO,$$FMADD^XLFDT(MMRSNOW,-365),MMRSNOW,"CD"),U,2)
;Get Order info
S LABORDER="^^"
S TSTNM="MRSA SURVL NARES DN"
F S TSTNM=$O(^LAB(60,"B",TSTNM)) Q:TSTNM=""!(TSTNM]"MRSA SURVL NARES DNA~zzz") D
.I TSTNM'["MRSA SURVL NARES DNA" Q
.S LABTEST=0 F S LABTEST=$O(^LAB(60,"B",TSTNM,LABTEST)) Q:'LABTEST D
..N TESTS D GORDITM(LABTEST,.LABORDER,.TESTS) ;MIA/LMT - Added with patch MMRS*1*1
S TSTNM="MRSA SURVL NARES AGA"
F S TSTNM=$O(^LAB(60,"B",TSTNM)) Q:TSTNM=""!(TSTNM]"MRSA SURVL NARES AGAR~zzz") D
.I TSTNM'["MRSA SURVL NARES AGAR" Q
.S LABTEST=0 F S LABTEST=$O(^LAB(60,"B",TSTNM,LABTEST)) Q:'LABTEST D
..N TESTS D GORDITM(LABTEST,.LABORDER,.TESTS) ;MIA/LMT - Added with patch MMRS*1*1
D KVA^VADPT
D DEM^VADPT
S PATNM=VADM(1)
D KVA^VADPT
S ^TMP($J,"MMRSORD",LOCNAME,PATNM,DFN)=INDATE_U_INTT_U_MRSA_U_LABORDER
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 ;
N LN,PG,LOCNAME,PATNM,DFN,NODE,LAST4,INTT,ADT,ORDDATE,VADM
;^TMP($J,"MMRSORD",LOCNAME,PATNM,DFN)=INDATE_U_INTT_U_MRSA_U_LAB
S $P(LN,"-",101)=""
S PG=1
S LOCNAME="" F S LOCNAME=$O(^TMP($J,"MMRSORD",LOCNAME)) Q:LOCNAME="" D
.D PRTHDRS S PATNM="" F S PATNM=$O(^TMP($J,"MMRSORD",LOCNAME,PATNM)) Q:PATNM="" D
..S DFN=0 F S DFN=$O(^TMP($J,"MMRSORD",LOCNAME,PATNM,DFN)) Q:'DFN D
...S NODE=$G(^TMP($J,"MMRSORD",LOCNAME,PATNM,DFN))
...D KVA^VADPT
...D DEM^VADPT
...S LAST4=$E($P(VADM(2),U),6,9)
...D KVA^VADPT
...S INTT=$P(NODE,U,2)
...S ADT=$S(INTT=1:"A",INTT=2:"T",1:"")
...S ORDDATE=$P(NODE,"^",5)
...I ORDDATE S ORDDATE=$$FMTE^XLFDT(ORDDATE,"2M")
...W !,$E(PATNM,1,23),?25,LAST4,?32,$$FMTE^XLFDT($P(NODE,"^",1),"2M"),?48,ADT,?53,$P($P(NODE,"^",3),";",1),?65,$P(NODE,"^",4)
...W ?75,ORDDATE,?91,$P(NODE,"^",6)
...I $Y+2>IOSL D PRTHDRS
Q
PRTHDRS ; Helper Function for PRT - Prints report headers
W @IOF
W ?13,"NARES SWAB ORDER LIST"
W !,?13,"Geographical Location: ",LOCNAME
W !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?75,"PAGE: ",PG
W !!,?32,"DATE",?53,"MRSA IN",?65,"NARES",?91,"LAB"
W !,"PATIENT",?25,"SSN",?32,"ENTERED WARD",?48,"ADT",?53,"PAST YEAR",?65,"ORDERED",?75,"ORDER DATE",?91,"RECEIVED"
W !,LN
S PG=PG+1
Q
ASKDVC ;Prompts user for device of output (allows queuing)
N MMRSVAR,ZTSK
W !!!,"This report is designed for a 132 column format (compressed).",!
S MMRSVAR("MMRSLOC")="",MMRSVAR("MMRSLOC(")="",MMRSVAR("MMRSDIV")=""
D EN^XUTMDEVQ("MAIN2^MMRSORD","Print nares swab order list (MMRSORD)",.MMRSVAR,"QM",1)
W:$D(ZTSK) !,"Report Queued to Print ("_ZTSK_").",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMMRSORD 6642 printed Nov 22, 2024@17:25:25 Page 2
MMRSORD ;MIA/LMT - Print ward census showing which patients need a nares swab ;02/15/17 08:34
+1 ;;1.0;MRSA PROGRAM TOOLS;**1,5**;Mar 22, 2009;Build 146
+2 ;
MAIN ;
+1 NEW EXTFLG,MMRSDIV,MMRSLOC
+2 DO CHECK^MMRSIPC
+3 DO CHECK2^MMRSIPC
+4 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+5 WRITE !
+6 SET MMRSDIV=$$GETDIV^MMRSIPC
if $DATA(EXTFLG)!(MMRSDIV="")
QUIT
+7 WRITE !
+8 DO CHECK3^MMRSIPC
+9 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+10 DO PROMPT^MMRSISL
if $DATA(EXTFLG)
QUIT
+11 DO ASKDVC
if $DATA(EXTFLG)
QUIT
+12 QUIT
MAIN2 ;
+1 NEW MMRSNOW
+2 DO CLEAN
+3 if '$DATA(MMRSDIV)!('$DATA(MMRSLOC))
QUIT
+4 SET MMRSNOW=$$NOW^XLFDT()
+5 ; Load parameters in temp global
DO GETPARAM^MMRSIPC
+6 DO SETDATA
+7 DO PRT
+8 DO CLEAN
+9 QUIT
CLEAN ;
+1 KILL ^TMP($JOB,"MMRSIPC")
+2 KILL ^TMP($JOB,"MMRSORD")
+3 QUIT
SETDATA ;
+1 NEW LOCATION,LOCNAME,DFN,LOCTYPE,MMRSI,SDRESULT,Y,WLOC,WARD,WARDNAME,VAIP
+2 IF $GET(MMRSLOC)="ALL"
Begin DoDot:1
+3 SET LOCATION=0
FOR
SET LOCATION=$ORDER(^MMRS(104.3,LOCATION))
if 'LOCATION
QUIT
IF $PIECE($GET(^MMRS(104.3,LOCATION,0)),U,2)=MMRSDIV
Begin DoDot:2
+4 SET LOCNAME=$PIECE($GET(^MMRS(104.3,LOCATION,0)),U,1)
+5 SET WLOC=0
FOR
SET WLOC=$ORDER(^MMRS(104.3,LOCATION,1,WLOC))
if 'WLOC
QUIT
Begin DoDot:3
+6 SET WARD=$PIECE($GET(^MMRS(104.3,LOCATION,1,WLOC,0)),U,1)
+7 if 'WARD
QUIT
+8 ;S WARDNAME=$P($G(^DIC(42,WARD,44)),U,1)
+9 ;S WARDNAME=$P($G(^SC(+WARDNAME,0)),U,1)
+10 SET WARDNAME=$PIECE($GET(^DIC(42,WARD,0)),U,1)
+11 if WARDNAME=""
QUIT
+12 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",WARDNAME,DFN))
if 'DFN
QUIT
DO SETDATA2(DFN,LOCATION,LOCNAME)
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+13 SET LOCATION=0
FOR
SET LOCATION=$ORDER(MMRSLOC(LOCATION))
if 'LOCATION
QUIT
Begin DoDot:1
+14 SET LOCNAME=$PIECE($GET(^MMRS(104.3,LOCATION,0)),U,1)
+15 SET WLOC=0
FOR
SET WLOC=$ORDER(^MMRS(104.3,LOCATION,1,WLOC))
if 'WLOC
QUIT
Begin DoDot:2
+16 SET WARD=$PIECE($GET(^MMRS(104.3,LOCATION,1,WLOC,0)),U,1)
+17 if 'WARD
QUIT
+18 ;S WARDNAME=$P($G(^DIC(42,WARD,44)),U,1)
+19 ;S WARDNAME=$P($G(^SC(+WARDNAME,0)),U,1)
+20 SET WARDNAME=$PIECE($GET(^DIC(42,WARD,0)),U,1)
+21 if WARDNAME=""
QUIT
+22 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",WARDNAME,DFN))
if 'DFN
QUIT
DO SETDATA2(DFN,LOCATION,LOCNAME)
End DoDot:2
End DoDot:1
+23 QUIT
SETDATA2(DFN,LOC,LOCNAME) ;
+1 NEW INTT,IEN,INDATE,INIFN,MRSAMDRO,MRSA,MRSACULT,LABORDER,TSTNM,LABTEST,ORDITM,ORDTEMP,PATNM,VADM
+2 NEW PREVIEN,PREVWARD
+3 ;Get unit admission date and Transaction Type
+4 DO KVA^VADPT
+5 SET VAIP("D")=MMRSNOW
+6 DO IN5^VADPT
+7 IF 'VAIP(1)
QUIT
+8 SET INTT=$$TRANTYPE^MMRSIPC2(+VAIP(4),+VAIP(2),VAIP(1),DFN)
+9 SET PREVWARD=$PIECE(INTT,U,2)
+10 SET PREVIEN=$PIECE(INTT,U,4)
+11 SET INTT=$PIECE(INTT,U,1)
+12 IF PREVWARD=""
SET PREVWARD=+VAIP(15,4)
+13 IF PREVIEN=""
SET PREVIEN=VAIP(15)
+14 FOR
if (INTT=1)!(INTT=2&$$CNGWARD^MMRSIPC2(LOC,+VAIP(5),PREVWARD))!(PREVIEN="")
QUIT
Begin DoDot:1
+15 SET IEN=+PREVIEN
+16 DO KVA^VADPT
+17 SET VAIP("E")=IEN
+18 DO IN5^VADPT
+19 SET INTT=$$TRANTYPE^MMRSIPC2(+VAIP(4),+VAIP(2),VAIP(1),DFN)
+20 SET PREVWARD=$PIECE(INTT,U,2)
+21 SET PREVIEN=$PIECE(INTT,U,4)
+22 SET INTT=$PIECE(INTT,U,1)
+23 IF PREVWARD=""
SET PREVWARD=+VAIP(15,4)
+24 IF PREVIEN=""
SET PREVIEN=VAIP(15)
End DoDot:1
+25 IF INTT<1!(INTT>2)
QUIT
+26 SET INDATE=+VAIP(3)
+27 SET INIFN=+VAIP(1)
+28 IF '$GET(INIFN)
QUIT
+29 ;Get MRSA history
+30 SET MRSAMDRO=1
+31 SET MRSA=$PIECE($$GETLAB^MMRSIPC3(DFN,MRSAMDRO,$$FMADD^XLFDT(MMRSNOW,-365),MMRSNOW,"CD"),U,2)
+32 ;Get Order info
+33 SET LABORDER="^^"
+34 SET TSTNM="MRSA SURVL NARES DN"
+35 FOR
SET TSTNM=$ORDER(^LAB(60,"B",TSTNM))
if TSTNM=""!(TSTNM]"MRSA SURVL NARES DNA~zzz")
QUIT
Begin DoDot:1
+36 IF TSTNM'["MRSA SURVL NARES DNA"
QUIT
+37 SET LABTEST=0
FOR
SET LABTEST=$ORDER(^LAB(60,"B",TSTNM,LABTEST))
if 'LABTEST
QUIT
Begin DoDot:2
+38 ;MIA/LMT - Added with patch MMRS*1*1
NEW TESTS
DO GORDITM(LABTEST,.LABORDER,.TESTS)
End DoDot:2
End DoDot:1
+39 SET TSTNM="MRSA SURVL NARES AGA"
+40 FOR
SET TSTNM=$ORDER(^LAB(60,"B",TSTNM))
if TSTNM=""!(TSTNM]"MRSA SURVL NARES AGAR~zzz")
QUIT
Begin DoDot:1
+41 IF TSTNM'["MRSA SURVL NARES AGAR"
QUIT
+42 SET LABTEST=0
FOR
SET LABTEST=$ORDER(^LAB(60,"B",TSTNM,LABTEST))
if 'LABTEST
QUIT
Begin DoDot:2
+43 ;MIA/LMT - Added with patch MMRS*1*1
NEW TESTS
DO GORDITM(LABTEST,.LABORDER,.TESTS)
End DoDot:2
End DoDot:1
+44 DO KVA^VADPT
+45 DO DEM^VADPT
+46 SET PATNM=VADM(1)
+47 DO KVA^VADPT
+48 SET ^TMP($JOB,"MMRSORD",LOCNAME,PATNM,DFN)=INDATE_U_INTT_U_MRSA_U_LABORDER
+49 QUIT
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 NEW LN,PG,LOCNAME,PATNM,DFN,NODE,LAST4,INTT,ADT,ORDDATE,VADM
+2 ;^TMP($J,"MMRSORD",LOCNAME,PATNM,DFN)=INDATE_U_INTT_U_MRSA_U_LAB
+3 SET $PIECE(LN,"-",101)=""
+4 SET PG=1
+5 SET LOCNAME=""
FOR
SET LOCNAME=$ORDER(^TMP($JOB,"MMRSORD",LOCNAME))
if LOCNAME=""
QUIT
Begin DoDot:1
+6 DO PRTHDRS
SET PATNM=""
FOR
SET PATNM=$ORDER(^TMP($JOB,"MMRSORD",LOCNAME,PATNM))
if PATNM=""
QUIT
Begin DoDot:2
+7 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"MMRSORD",LOCNAME,PATNM,DFN))
if 'DFN
QUIT
Begin DoDot:3
+8 SET NODE=$GET(^TMP($JOB,"MMRSORD",LOCNAME,PATNM,DFN))
+9 DO KVA^VADPT
+10 DO DEM^VADPT
+11 SET LAST4=$EXTRACT($PIECE(VADM(2),U),6,9)
+12 DO KVA^VADPT
+13 SET INTT=$PIECE(NODE,U,2)
+14 SET ADT=$SELECT(INTT=1:"A",INTT=2:"T",1:"")
+15 SET ORDDATE=$PIECE(NODE,"^",5)
+16 IF ORDDATE
SET ORDDATE=$$FMTE^XLFDT(ORDDATE,"2M")
+17 WRITE !,$EXTRACT(PATNM,1,23),?25,LAST4,?32,$$FMTE^XLFDT($PIECE(NODE,"^",1),"2M"),?48,ADT,?53,$PIECE($PIECE(NODE,"^",3),";",1),?65,$PIECE(NODE,"^",4)
+18 WRITE ?75,ORDDATE,?91,$PIECE(NODE,"^",6)
+19 IF $Y+2>IOSL
DO PRTHDRS
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
PRTHDRS ; Helper Function for PRT - Prints report headers
+1 WRITE @IOF
+2 WRITE ?13,"NARES SWAB ORDER LIST"
+3 WRITE !,?13,"Geographical Location: ",LOCNAME
+4 WRITE !,?13,"Report printed on: ",$$FMTE^XLFDT(MMRSNOW),?75,"PAGE: ",PG
+5 WRITE !!,?32,"DATE",?53,"MRSA IN",?65,"NARES",?91,"LAB"
+6 WRITE !,"PATIENT",?25,"SSN",?32,"ENTERED WARD",?48,"ADT",?53,"PAST YEAR",?65,"ORDERED",?75,"ORDER DATE",?91,"RECEIVED"
+7 WRITE !,LN
+8 SET PG=PG+1
+9 QUIT
ASKDVC ;Prompts user for device of output (allows queuing)
+1 NEW MMRSVAR,ZTSK
+2 WRITE !!!,"This report is designed for a 132 column format (compressed).",!
+3 SET MMRSVAR("MMRSLOC")=""
SET MMRSVAR("MMRSLOC(")=""
SET MMRSVAR("MMRSDIV")=""
+4 DO EN^XUTMDEVQ("MAIN2^MMRSORD","Print nares swab order list (MMRSORD)",.MMRSVAR,"QM",1)
+5 if $DATA(ZTSK)
WRITE !,"Report Queued to Print ("_ZTSK_").",!
+6 QUIT
