BGP9DP ; IHS/CMI/LAB - IHS gpra print 03 Jul 2008 6:26 AM ;
;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
;
;
PRINT ;
K ^TMP($J)
K BGPDELIM
S BGPIOSL=$S($G(BGPGUI):55,1:$G(IOSL))
I $G(BGPAREAA) D SETEXCEL
S BGPIFTR=""
I BGPROT="D" G DEL
S BGPQHDR=0
D ^BGP9DH
I BGPQHDR D KITM Q
S BGPGPG=0
S BGPQUIT=""
D PRINT1
K ^TMP($J)
I BGPROT="P" D KITM Q
;
DEL ;create delimited output file
I '$D(BGPGUI) D ^%ZISC ;close printer device
K ^TMP($J)
D ^BGP9PDL ;create ^tmp of delimited report
S BGPIFTR=1
K ^XTMP("BGP9D",BGPJ,BGPH)
K ^XTMP("BGP9DNP",BGPJ,BGPH)
K ^XTMP("BGP08CPL",BGPJ,BGPH)
K ^TMP($J)
Q
;
WTITLE ;EP - write title line
NEW T,X,Y,S
S T=$P(^BGPINDN(BGPIC,0),U,3)
I $L(T)<81 W !,T,! Q
F X=$E(T,1,80)
S S=""
F Y=80:-1:1 Q:S S I=$E(X,Y) I I=" " S S=Y
W !,$E(T,1,S)
W !,$E(T,(S+1),$L(T)),!
Q
PRINT1 ;EP
S BGPIC=0 F S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC=""!(BGPQUIT) D
.I $G(BGPSUMON) G CALC
.D HEADER^BGP9DPH ;header for all measures
.I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
.D WTITLE
.;W !,$P(^BGPINDN(BGPIC,0),U,3),!
.I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
.W !,"Denominator(s):"
.S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,61,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPINDN(BGPIC,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...I '$D(^BGPINDN(BGPIC,61,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
...I BGPRTYPE=4,'$D(^BGPINDN(BGPIC,61,BGPY,12,"B",BGPINDT)) Q ;not this measure type on selected
...S BGPZ=0 F S BGPZ=$O(^BGPINDN(BGPIC,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
....I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
....W !,^BGPINDN(BGPIC,61,BGPY,1,BGPZ,0)
....Q
...;W !
...Q
..Q
.I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
.W !!,"Numerator(s):"
.S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,62,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPINDN(BGPIC,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...I '$D(^BGPINDN(BGPIC,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
...I BGPRTYPE=4,'$D(^BGPINDN(BGPIC,62,BGPY,12,"B",BGPINDT)) Q ;not this measure type on selected
...S BGPZ=0 F S BGPZ=$O(^BGPINDN(BGPIC,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
....I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
....W !,^BGPINDN(BGPIC,62,BGPY,1,BGPZ,0)
....Q
...;W !
...Q
..Q
.S BGPNODE=11
.I BGPRTYPE=1,$O(^BGPINDN(BGPIC,54,0)) S BGPNODE=54
.I BGPRTYPE=7,$O(^BGPINDN(BGPIC,56,0)) S BGPNODE=56
.W !!,"Logic:" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
..W !,^BGPINDN(BGPIC,BGPNODE,BGPX,0)
.W !!,"Performance Measure Description:" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,$S($G(BGPNGR09):57,1:51),BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
..W !,^BGPINDN(BGPIC,$S($G(BGPNGR09):57,1:51),BGPX,0)
.I $O(^BGPINDN(BGPIC,52,0)) W !!,"Past Performance and/or Target:" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,52,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
..W !,^BGPINDN(BGPIC,52,BGPX,0)
.I $O(^BGPINDN(BGPIC,55,0)) W !!,"Source:" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,55,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP9DPH Q:BGPQUIT
..W !,^BGPINDN(BGPIC,55,BGPX,0)
.I '$O(^BGPINDN(BGPIC,55,0)) W !
CALC .X ^BGPINDN(BGPIC,3) W !
.I $G(BGPNPL),$D(BGPINDL(BGPIC)),'$D(BGP9NPLT) S BGPINDN=BGPIC D NPL1^BGP9NPLP ;printed nat gpra list
.I $G(BGPNPL),$D(BGPINDL(BGPIC)),$D(BGP9NPLT) S BGPINDN=BGPIC D CT^BGP9DSTM ;printed nat gpra SEARCH TEMPLATE
;
I BGPIC="" S BGPIFTR=1
I BGPRTYPE=1 D ^BGP9DSPN ;NON GPRA
I BGPRTYPE=1 D ^BGP9DSPD ;DEVELOPMENTAL
I BGPRTYPE=1 D ^BGP9DSP ;GPRA
I BGPRTYPE=1 D ^BGP9SDPN
I BGPRTYPE=1 D ^BGP9SDPD
I BGPRTYPE=1 D ^BGP9SDP
I BGPRTYPE=7 D ^BGP9DSPO
I BGPRTYPE=7 D ^BGP9SDPO
D ^BGP9DS
I $G(BGPCPPL) D CPPL1^BGP9DCLP ;print comp pt list
D EXIT
Q
KITM ;
K ^TMP($J)
K ^XTMP("BGP9D",BGPJ,BGPH)
K ^XTMP("BGP9DNP",BGPJ,BGPH)
K ^XTMP("BGP08CPL",BGPJ,BGPH)
Q
SETEXCEL ;EP
I $G(BGPAREAA) D Q
.S X=0 F S X=$O(BGPSUL(X)) Q:X'=+X D
..S N=^BGPGPDCN(X,0)
..S (D,L)=""
..S L=$P(N,U,9) I L S L=$O(^AUTTLOC("C",L,0)) I L S D=$P($G(^AUTTLOC(L,1)),U,3),L=$S(L:$P(^DIC(4,L,0),U),1:"?????")
..S BGPEI(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
..S BGPEI2(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI2(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
..S BGPEI3(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI3(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
..S BGPEI4(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI4(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
..S BGPONN1(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPONN1(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
..S BGPONN2(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPONN2(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
..S BGPONN3(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPONN3(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
..Q
.Q
;S X=BGPRPT
;S N=^BGPGPDCN(X,0)
;S L=$P(N,U,9),L=$O(^AUTTLOC("C",L,0)) S D=$P($G(^AUTTLOC(L,1)),U,3),L=$S(L:$P(^DIC(4,L,0),U),1:"?????")
;S BGPEI(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
Q
EXIT ;
I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO",DIR("A")="End of report. Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
BGP9DP ; IHS/CMI/LAB - IHS gpra print 03 Jul 2008 6:26 AM ;
+1 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
+2 ;
+3 ;
PRINT ;
+1 KILL ^TMP($JOB)
+2 KILL BGPDELIM
+3 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:$GET(IOSL))
+4 IF $GET(BGPAREAA)
DO SETEXCEL
+5 SET BGPIFTR=""
+6 IF BGPROT="D"
GOTO DEL
+7 SET BGPQHDR=0
+8 DO ^BGP9DH
+9 IF BGPQHDR
DO KITM
QUIT
+10 SET BGPGPG=0
+11 SET BGPQUIT=""
+12 DO PRINT1
+13 KILL ^TMP($JOB)
+14 IF BGPROT="P"
DO KITM
QUIT
+15 ;
DEL ;create delimited output file
+1 ;close printer device
IF '$DATA(BGPGUI)
DO ^%ZISC
+2 KILL ^TMP($JOB)
+3 ;create ^tmp of delimited report
DO ^BGP9PDL
+4 SET BGPIFTR=1
+5 KILL ^XTMP("BGP9D",BGPJ,BGPH)
+6 KILL ^XTMP("BGP9DNP",BGPJ,BGPH)
+7 KILL ^XTMP("BGP08CPL",BGPJ,BGPH)
+8 KILL ^TMP($JOB)
+9 QUIT
+10 ;
WTITLE ;EP - write title line
+1 NEW T,X,Y,S
+2 SET T=$PIECE(^BGPINDN(BGPIC,0),U,3)
+3 IF $LENGTH(T)<81
WRITE !,T,!
QUIT
+4 FOR X=$EXTRACT(T,1,80)
+5 SET S=""
+6 FOR Y=80:-1:1
IF S
QUIT
SET I=$EXTRACT(X,Y)
IF I=" "
SET S=Y
+7 WRITE !,$EXTRACT(T,1,S)
+8 WRITE !,$EXTRACT(T,(S+1),$LENGTH(T)),!
+9 QUIT
PRINT1 ;EP
+1 SET BGPIC=0
FOR
SET BGPIC=$ORDER(BGPIND(BGPIC))
IF BGPIC=""!(BGPQUIT)
QUIT
Begin DoDot:1
+2 IF $GET(BGPSUMON)
GOTO CALC
+3 ;header for all measures
DO HEADER^BGP9DPH
+4 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+5 DO WTITLE
+6 ;W !,$P(^BGPINDN(BGPIC,0),U,3),!
+7 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+8 WRITE !,"Denominator(s):"
+9 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,61,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+10 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDN(BGPIC,61,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+11 ;not this report type
IF '$DATA(^BGPINDN(BGPIC,61,BGPY,11,"B",BGPRTYPE))
QUIT
+12 ;not this measure type on selected
IF BGPRTYPE=4
IF '$DATA(^BGPINDN(BGPIC,61,BGPY,12,"B",BGPINDT))
QUIT
+13 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDN(BGPIC,61,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ!(BGPQUIT)
QUIT
Begin DoDot:4
+14 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+15 WRITE !,^BGPINDN(BGPIC,61,BGPY,1,BGPZ,0)
+16 QUIT
End DoDot:4
+17 ;W !
+18 QUIT
End DoDot:3
+19 QUIT
End DoDot:2
+20 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+21 WRITE !!,"Numerator(s):"
+22 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,62,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+23 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDN(BGPIC,62,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+24 ;not this report type
IF '$DATA(^BGPINDN(BGPIC,62,BGPY,11,"B",BGPRTYPE))
QUIT
+25 ;not this measure type on selected
IF BGPRTYPE=4
IF '$DATA(^BGPINDN(BGPIC,62,BGPY,12,"B",BGPINDT))
QUIT
+26 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDN(BGPIC,62,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ!(BGPQUIT)
QUIT
Begin DoDot:4
+27 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+28 WRITE !,^BGPINDN(BGPIC,62,BGPY,1,BGPZ,0)
+29 QUIT
End DoDot:4
+30 ;W !
+31 QUIT
End DoDot:3
+32 QUIT
End DoDot:2
+33 SET BGPNODE=11
+34 IF BGPRTYPE=1
IF $ORDER(^BGPINDN(BGPIC,54,0))
SET BGPNODE=54
+35 IF BGPRTYPE=7
IF $ORDER(^BGPINDN(BGPIC,56,0))
SET BGPNODE=56
+36 WRITE !!,"Logic:"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,BGPNODE,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+37 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+38 WRITE !,^BGPINDN(BGPIC,BGPNODE,BGPX,0)
End DoDot:2
+39 WRITE !!,"Performance Measure Description:"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,$SELECT($GET(BGPNGR09):57,1:51),BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+40 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+41 WRITE !,^BGPINDN(BGPIC,$SELECT($GET(BGPNGR09):57,1:51),BGPX,0)
End DoDot:2
+42 IF $ORDER(^BGPINDN(BGPIC,52,0))
WRITE !!,"Past Performance and/or Target:"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,52,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+43 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+44 WRITE !,^BGPINDN(BGPIC,52,BGPX,0)
End DoDot:2
+45 IF $ORDER(^BGPINDN(BGPIC,55,0))
WRITE !!,"Source:"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,55,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+46 IF $Y>(BGPIOSL-3)
DO HEADER^BGP9DPH
IF BGPQUIT
QUIT
+47 WRITE !,^BGPINDN(BGPIC,55,BGPX,0)
End DoDot:2
+48 IF '$ORDER(^BGPINDN(BGPIC,55,0))
WRITE !
CALC XECUTE ^BGPINDN(BGPIC,3)
WRITE !
+1 ;printed nat gpra list
IF $GET(BGPNPL)
IF $DATA(BGPINDL(BGPIC))
IF '$DATA(BGP9NPLT)
SET BGPINDN=BGPIC
DO NPL1^BGP9NPLP
+2 ;printed nat gpra SEARCH TEMPLATE
IF $GET(BGPNPL)
IF $DATA(BGPINDL(BGPIC))
IF $DATA(BGP9NPLT)
SET BGPINDN=BGPIC
DO CT^BGP9DSTM
End DoDot:1
+3 ;
+4 IF BGPIC=""
SET BGPIFTR=1
+5 ;NON GPRA
IF BGPRTYPE=1
DO ^BGP9DSPN
+6 ;DEVELOPMENTAL
IF BGPRTYPE=1
DO ^BGP9DSPD
+7 ;GPRA
IF BGPRTYPE=1
DO ^BGP9DSP
+8 IF BGPRTYPE=1
DO ^BGP9SDPN
+9 IF BGPRTYPE=1
DO ^BGP9SDPD
+10 IF BGPRTYPE=1
DO ^BGP9SDP
+11 IF BGPRTYPE=7
DO ^BGP9DSPO
+12 IF BGPRTYPE=7
DO ^BGP9SDPO
+13 DO ^BGP9DS
+14 ;print comp pt list
IF $GET(BGPCPPL)
DO CPPL1^BGP9DCLP
+15 DO EXIT
+16 QUIT
KITM ;
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("BGP9D",BGPJ,BGPH)
+3 KILL ^XTMP("BGP9DNP",BGPJ,BGPH)
+4 KILL ^XTMP("BGP08CPL",BGPJ,BGPH)
+5 QUIT
SETEXCEL ;EP
+1 IF $GET(BGPAREAA)
Begin DoDot:1
+2 SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
Begin DoDot:2
+3 SET N=^BGPGPDCN(X,0)
+4 SET (D,L)=""
+5 SET L=$PIECE(N,U,9)
IF L
SET L=$ORDER(^AUTTLOC("C",L,0))
IF L
SET D=$PIECE($GET(^AUTTLOC(L,1)),U,3)
SET L=$SELECT(L:$PIECE(^DIC(4,L,0),U),1:"?????")
+6 SET BGPEI(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP9UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPEI(X),U,P)=$$DATE^BGP9UTL($PIECE(N,U,Y))
SET P=P+1
+7 SET BGPEI2(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP9UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPEI2(X),U,P)=$$DATE^BGP9UTL($PIECE(N,U,Y))
SET P=P+1
+8 SET BGPEI3(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP9UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPEI3(X),U,P)=$$DATE^BGP9UTL($PIECE(N,U,Y))
SET P=P+1
+9 SET BGPEI4(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP9UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPEI4(X),U,P)=$$DATE^BGP9UTL($PIECE(N,U,Y))
SET P=P+1
+10 SET BGPONN1(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP9UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPONN1(X),U,P)=$$DATE^BGP9UTL($PIECE(N,U,Y))
SET P=P+1
+11 SET BGPONN2(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP9UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPONN2(X),U,P)=$$DATE^BGP9UTL($PIECE(N,U,Y))
SET P=P+1
+12 SET BGPONN3(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP9UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPONN3(X),U,P)=$$DATE^BGP9UTL($PIECE(N,U,Y))
SET P=P+1
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
QUIT
+15 ;S X=BGPRPT
+16 ;S N=^BGPGPDCN(X,0)
+17 ;S L=$P(N,U,9),L=$O(^AUTTLOC("C",L,0)) S D=$P($G(^AUTTLOC(L,1)),U,3),L=$S(L:$P(^DIC(4,L,0),U),1:"?????")
+18 ;S BGPEI(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP9UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI(X),U,P)=$$DATE^BGP9UTL($P(N,U,Y)),P=P+1
+19 QUIT
EXIT ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
SET DIR("A")="End of report. Press ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
