BGP8CP ; IHS/CMI/LAB - IHS gpra print ; 02 Jul 2008 9:06 AM
;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
;
;
PRINT ;
K ^TMP($J)
S BGPIOSL=$S($G(BGPGUI):55,1:IOSL)
S BGPGPG=0
S BGPQUIT=""
D HEADER
I BGPQUIT G END
D PRINT1
END ;
K ^XTMP("BGP8C1",BGPJ,BGPH)
K ^TMP($J)
D EXIT
Q
;
PRINT1 ;EP
S BGPIND=0 F S BGPIND=$O(BGPPLSTL(BGPIND)) Q:BGPIND'=+BGPIND!(BGPQUIT) D
.S BGPPLSTL=0 F S BGPPLSTL=$O(BGPPLSTL(BGPIND,BGPPLSTL)) Q:BGPPLSTL'=+BGPPLSTL!(BGPQUIT) D
..S BGPL1P1=1
..D HDR
..Q:BGPQUIT
..D HDR1
..Q:BGPQUIT
..S BGPL1P1=0
..D LIST1
Q
HDR1 ;
Q:'BGPTEXD
S BGPX=0 F S BGPX=$O(^BGPCMSME(BGPPLSTL,21,BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
.I $Y>(BGPIOSL-3) D HDR Q:BGPQUIT
.W !,^BGPCMSME(BGPPLSTL,21,BGPX,0)
Q
LIST1 ;DISPLAY LIST 1
K BGPL2
I $O(^BGPCMSME(BGPPLSTL,73,0)) D:BGPTEXD HDR D ;if there is a first page header
.S BGPX=0 F S BGPX=$O(^BGPCMSME(BGPPLSTL,73,BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..I $Y>(BGPIOSL-3) D HDR Q:BGPQUIT
..W !,^BGPCMSME(BGPPLSTL,73,BGPX,0)
I $O(^BGPCMSME(BGPPLSTL,73,0)) W !,$TR($J("",80)," ","-")
Q:BGPQUIT
D L1H
Q:BGPQUIT
S BGPAST=0
I '$D(^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL)) W !!,"No Visits to report" Q
S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,BGPNAME)) Q:BGPNAME=""!(BGPQUIT) D
.S DFN=0 F S DFN=$O(^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,BGPNAME,DFN)) Q:DFN'=+DFN!(BGPQUIT) D
..S BGPVSIT=0 F S BGPVSIT=$O(^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,BGPNAME,DFN,BGPVSIT)) Q:BGPVSIT'=+BGPVSIT!(BGPQUIT) D
...S BGPVSIT0=$G(^AUPNVSIT(BGPVSIT,0))
...S BGPVINP=$O(^AUPNVINP("AD",BGPVSIT,0))
...I $Y>(BGPIOSL-4) D HDR Q:BGPQUIT D L1H
...W !!
...S BGPPEX=^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,BGPNAME,DFN,BGPVSIT)
...I BGPPEX]"" W "*" S BGPEXCP(BGPIND,BGPPLSTL)=$G(BGPEXCP(BGPIND,BGPPLSTL))+1
...W $E(BGPNAME,1,25),?27,$$HRN^AUPNPAT(DFN,DUZ(2)),?35,$P(^DPT(DFN,0),U,2),?38,$$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))
...I '$P(^BGPCMSME(BGPPLSTL,0),U,6) D
....W ?42,$$DATE^BGP8UTL($P($P(BGPVSIT0,U),"."))_"-"_$$DATE^BGP8UTL($$DSCH^BGP8CU(BGPVINP)) I BGPIND=1!(BGPIND=3) W $S(BGPPEX[2!(BGPPEX[1):"*",1:"")
....W ?62,$E($$VAL^XBDIQ1(9000010.02,BGPVINP,.07),1,18)
...I $P(^BGPCMSME(BGPPLSTL,0),U,6) D
....W ?42,$E($$VAL^XBDIQ1(9000001,DFN,1111),1,19)
....W ?62,$$DATE^BGP8UTL($P($P(BGPVSIT0,U),"."))_"-"_$$DATE^BGP8UTL($$DSCH^BGP8CU(BGPVINP))
...S BGPCOUNT(BGPIND,BGPPLSTL)=$G(BGPCOUNT(BGPIND,BGPPLSTL))+1
...X ^BGPCMSME(BGPPLSTL,1)
Q:BGPQUIT
I $Y>(BGPIOSL-4) D HDR Q:BGPQUIT D L1H
W !!,"TOTAL VISITS: ",+$G(BGPCOUNT(BGPIND,BGPPLSTL))
Q:'$P(^BGPCMSME(BGPPLSTL,0),U,5)
W !!,"TOTAL VISITS THAT WOULD BE EXCLUDED: ",+$G(BGPEXCP(BGPIND,BGPPLSTL))
Q
L1H ;EP - list one header
I $Y>(BGPIOSL-3) D HDR Q:BGPQUIT
;W !,$TR($J("",80)," ","-")
I '$P(^BGPCMSME(BGPPLSTL,0),U,6) W !,"PATIENT NAME",?27,"HRN",?34,"SEX",?38,"AGE",?42,"HOSP DATES",?62,"ADMISSION TYPE"
I $P(^BGPCMSME(BGPPLSTL,0),U,6) W !,"PATIENT NAME",?27,"HRN",?34,"SEX",?38,"AGE",?42,"CLASS/BENEFICIARY",?64,"HOSP DATES"
W !,$TR($J("",80)," ","-")
;I $G(BGPEXCL)=1 Q
I '$P(^BGPCMSME(BGPPLSTL,0),U,5) Q
W !,"*Indicates CRS would have excluded this patient based on this data if RPMS"
W !,"exclusion logic had been applied.",!
Q
HDR ;EP
NEW X,Y,Z
G:'BGPGPG HEADER1
K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1 Q
W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
I $G(BGPGUI) W "ZZZZZZZ",! ;maw
W $P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
W $$CTR("*** IHS 2008 CMS Hospital Quality Reporting Initiative ***",80)
W !,$$CTR($$RPTVER^BGP8BAN,80)
W !,$$CTR("Hospital: "_$P(^DIC(4,BGPHOSP,0),U),80)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W !,$$CTR(X,80)
I $G(BGPIND) S X="Topic: "_$P(^BGPCMSIE(BGPIND,0),U,3) W !,$$CTR(X,80)
I $G(BGPPLSTL),$P($G(^BGPCMSME(BGPPLSTL,71)),U,2)]"" S X="Performance Measure: "_$P(^BGPCMSME(BGPPLSTL,71),U,2) W !,$$CTR(X,80)
I $G(BGPPLSTL) S X="Patient List: "_$P(^BGPCMSME(BGPPLSTL,0),U,4) W !,$$CTR(X,80)
W !,$TR($J("",80)," ","-")
;I $G(BGPPLSTL) W !,$P($G(^BGPCMSME(BGPPLSTL,71)),U) D
;.I $P($G(^BGPCMSME(BGPPLSTL,71)),U,3)]"" W !,$P($G(^BGPCMSME(BGPPLSTL,71)),U,3)
;.W $S(BGPL1P1=0:" (cont'd)",1:""),!
S BGPL1P1=0
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
Q:'BGPTEXD
W:$D(IOF) @IOF
W $$CTR("Cover Page",80)
W !,$$CTR("*** IHS 2008 CMS Hospital Quality Reporting Initiative ***",80)
W !,$$CTR($$RPTVER^BGP8BAN,80)
W !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
W !,$$CTR("Hospital: "_$P(^DIC(4,BGPHOSP,0),U),80)
W !,$$CTR("Report Generated by: "_$$USR,80)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W !,$$CTR(X,80)
D ENDTIME
W !
S BGPX=$O(^BGPCTRL("B",2008,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,21,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
.I $Y>(BGPIOSL-1) D HDR Q:$D(BGPQUIT)
.W !,^BGPCTRL(BGPX,21,BGPY,0)
.Q
K BGPX
Q
ENDTIME ;
I $D(BGPET) S BGPTS=(86400*($P(BGPET,",")-$P(BGPBT,",")))+($P(BGPET,",",2)-$P(BGPBT,",",2)),BGPHR=$P(BGPTS/3600,".") S:BGPHR="" BGPHR=0 D
.S BGPTS=BGPTS-(BGPHR*3600),BGPM=$P(BGPTS/60,".") S:BGPM="" BGPM=0 S BGPTS=BGPTS-(BGPM*60),BGPS=BGPTS S X="RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS W !,$$CTR(X,80)
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:80)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
BGP8CP ; IHS/CMI/LAB - IHS gpra print ; 02 Jul 2008 9:06 AM
+1 ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
+2 ;
+3 ;
PRINT ;
+1 KILL ^TMP($JOB)
+2 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:IOSL)
+3 SET BGPGPG=0
+4 SET BGPQUIT=""
+5 DO HEADER
+6 IF BGPQUIT
GOTO END
+7 DO PRINT1
END ;
+1 KILL ^XTMP("BGP8C1",BGPJ,BGPH)
+2 KILL ^TMP($JOB)
+3 DO EXIT
+4 QUIT
+5 ;
PRINT1 ;EP
+1 SET BGPIND=0
FOR
SET BGPIND=$ORDER(BGPPLSTL(BGPIND))
IF BGPIND'=+BGPIND!(BGPQUIT)
QUIT
Begin DoDot:1
+2 SET BGPPLSTL=0
FOR
SET BGPPLSTL=$ORDER(BGPPLSTL(BGPIND,BGPPLSTL))
IF BGPPLSTL'=+BGPPLSTL!(BGPQUIT)
QUIT
Begin DoDot:2
+3 SET BGPL1P1=1
+4 DO HDR
+5 IF BGPQUIT
QUIT
+6 DO HDR1
+7 IF BGPQUIT
QUIT
+8 SET BGPL1P1=0
+9 DO LIST1
End DoDot:2
End DoDot:1
+10 QUIT
HDR1 ;
+1 IF 'BGPTEXD
QUIT
+2 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPCMSME(BGPPLSTL,21,BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:1
+3 IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQUIT
QUIT
+4 WRITE !,^BGPCMSME(BGPPLSTL,21,BGPX,0)
End DoDot:1
+5 QUIT
LIST1 ;DISPLAY LIST 1
+1 KILL BGPL2
+2 ;if there is a first page header
IF $ORDER(^BGPCMSME(BGPPLSTL,73,0))
IF BGPTEXD
DO HDR
Begin DoDot:1
+3 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPCMSME(BGPPLSTL,73,BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+4 IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQUIT
QUIT
+5 WRITE !,^BGPCMSME(BGPPLSTL,73,BGPX,0)
End DoDot:2
End DoDot:1
+6 IF $ORDER(^BGPCMSME(BGPPLSTL,73,0))
WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+7 IF BGPQUIT
QUIT
+8 DO L1H
+9 IF BGPQUIT
QUIT
+10 SET BGPAST=0
+11 IF '$DATA(^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL))
WRITE !!,"No Visits to report"
QUIT
+12 SET BGPNAME=""
FOR
SET BGPNAME=$ORDER(^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,BGPNAME))
IF BGPNAME=""!(BGPQUIT)
QUIT
Begin DoDot:1
+13 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,BGPNAME,DFN))
IF DFN'=+DFN!(BGPQUIT)
QUIT
Begin DoDot:2
+14 SET BGPVSIT=0
FOR
SET BGPVSIT=$ORDER(^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,BGPNAME,DFN,BGPVSIT))
IF BGPVSIT'=+BGPVSIT!(BGPQUIT)
QUIT
Begin DoDot:3
+15 SET BGPVSIT0=$GET(^AUPNVSIT(BGPVSIT,0))
+16 SET BGPVINP=$ORDER(^AUPNVINP("AD",BGPVSIT,0))
+17 IF $Y>(BGPIOSL-4)
DO HDR
IF BGPQUIT
QUIT
DO L1H
+18 WRITE !!
+19 SET BGPPEX=^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,BGPNAME,DFN,BGPVSIT)
+20 IF BGPPEX]""
WRITE "*"
SET BGPEXCP(BGPIND,BGPPLSTL)=$GET(BGPEXCP(BGPIND,BGPPLSTL))+1
+21 WRITE $EXTRACT(BGPNAME,1,25),?27,$$HRN^AUPNPAT(DFN,DUZ(2)),?35,$PIECE(^DPT(DFN,0),U,2),?38,$$AGE^AUPNPAT(DFN,$PIECE($PIECE(BGPVSIT0,U),"."))
+22 IF '$PIECE(^BGPCMSME(BGPPLSTL,0),U,6)
Begin DoDot:4
+23 WRITE ?42,$$DATE^BGP8UTL($PIECE($PIECE(BGPVSIT0,U),"."))_"-"_$$DATE^BGP8UTL($$DSCH^BGP8CU(BGPVINP))
IF BGPIND=1!(BGPIND=3)
WRITE $SELECT(BGPPEX[2!(BGPPEX[1):"*",1:"")
+24 WRITE ?62,$EXTRACT($$VAL^XBDIQ1(9000010.02,BGPVINP,.07),1,18)
End DoDot:4
+25 IF $PIECE(^BGPCMSME(BGPPLSTL,0),U,6)
Begin DoDot:4
+26 WRITE ?42,$EXTRACT($$VAL^XBDIQ1(9000001,DFN,1111),1,19)
+27 WRITE ?62,$$DATE^BGP8UTL($PIECE($PIECE(BGPVSIT0,U),"."))_"-"_$$DATE^BGP8UTL($$DSCH^BGP8CU(BGPVINP))
End DoDot:4
+28 SET BGPCOUNT(BGPIND,BGPPLSTL)=$GET(BGPCOUNT(BGPIND,BGPPLSTL))+1
+29 XECUTE ^BGPCMSME(BGPPLSTL,1)
End DoDot:3
End DoDot:2
End DoDot:1
+30 IF BGPQUIT
QUIT
+31 IF $Y>(BGPIOSL-4)
DO HDR
IF BGPQUIT
QUIT
DO L1H
+32 WRITE !!,"TOTAL VISITS: ",+$GET(BGPCOUNT(BGPIND,BGPPLSTL))
+33 IF '$PIECE(^BGPCMSME(BGPPLSTL,0),U,5)
QUIT
+34 WRITE !!,"TOTAL VISITS THAT WOULD BE EXCLUDED: ",+$GET(BGPEXCP(BGPIND,BGPPLSTL))
+35 QUIT
L1H ;EP - list one header
+1 IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQUIT
QUIT
+2 ;W !,$TR($J("",80)," ","-")
+3 IF '$PIECE(^BGPCMSME(BGPPLSTL,0),U,6)
WRITE !,"PATIENT NAME",?27,"HRN",?34,"SEX",?38,"AGE",?42,"HOSP DATES",?62,"ADMISSION TYPE"
+4 IF $PIECE(^BGPCMSME(BGPPLSTL,0),U,6)
WRITE !,"PATIENT NAME",?27,"HRN",?34,"SEX",?38,"AGE",?42,"CLASS/BENEFICIARY",?64,"HOSP DATES"
+5 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+6 ;I $G(BGPEXCL)=1 Q
+7 IF '$PIECE(^BGPCMSME(BGPPLSTL,0),U,5)
QUIT
+8 WRITE !,"*Indicates CRS would have excluded this patient based on this data if RPMS"
+9 WRITE !,"exclusion logic had been applied.",!
+10 QUIT
HDR ;EP
+1 NEW X,Y,Z
+2 IF 'BGPGPG
GOTO HEADER1
+3 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BGPQUIT=1
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET BGPGPG=BGPGPG+1
+2 ;maw
IF $GET(BGPGUI)
WRITE "ZZZZZZZ",!
+3 WRITE $PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
+4 WRITE $$CTR("*** IHS 2008 CMS Hospital Quality Reporting Initiative ***",80)
+5 WRITE !,$$CTR($$RPTVER^BGP8BAN,80)
+6 WRITE !,$$CTR("Hospital: "_$PIECE(^DIC(4,BGPHOSP,0),U),80)
+7 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
WRITE !,$$CTR(X,80)
+8 IF $GET(BGPIND)
SET X="Topic: "_$PIECE(^BGPCMSIE(BGPIND,0),U,3)
WRITE !,$$CTR(X,80)
+9 IF $GET(BGPPLSTL)
IF $PIECE($GET(^BGPCMSME(BGPPLSTL,71)),U,2)]""
SET X="Performance Measure: "_$PIECE(^BGPCMSME(BGPPLSTL,71),U,2)
WRITE !,$$CTR(X,80)
+10 IF $GET(BGPPLSTL)
SET X="Patient List: "_$PIECE(^BGPCMSME(BGPPLSTL,0),U,4)
WRITE !,$$CTR(X,80)
+11 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+12 ;I $G(BGPPLSTL) W !,$P($G(^BGPCMSME(BGPPLSTL,71)),U) D
+13 ;.I $P($G(^BGPCMSME(BGPPLSTL,71)),U,3)]"" W !,$P($G(^BGPCMSME(BGPPLSTL,71)),U,3)
+14 ;.W $S(BGPL1P1=0:" (cont'd)",1:""),!
+15 SET BGPL1P1=0
+16 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
+1 IF 'BGPTEXD
QUIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE $$CTR("Cover Page",80)
+4 WRITE !,$$CTR("*** IHS 2008 CMS Hospital Quality Reporting Initiative ***",80)
+5 WRITE !,$$CTR($$RPTVER^BGP8BAN,80)
+6 WRITE !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
+7 WRITE !,$$CTR("Hospital: "_$PIECE(^DIC(4,BGPHOSP,0),U),80)
+8 WRITE !,$$CTR("Report Generated by: "_$$USR,80)
+9 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
WRITE !,$$CTR(X,80)
+10 DO ENDTIME
+11 WRITE !
+12 SET BGPX=$ORDER(^BGPCTRL("B",2008,0))
+13 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,21,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:1
+14 IF $Y>(BGPIOSL-1)
DO HDR
IF $DATA(BGPQUIT)
QUIT
+15 WRITE !,^BGPCTRL(BGPX,21,BGPY,0)
+16 QUIT
End DoDot:1
+17 KILL BGPX
+18 QUIT
ENDTIME ;
+1 IF $DATA(BGPET)
SET BGPTS=(86400*($PIECE(BGPET,",")-$PIECE(BGPBT,",")))+($PIECE(BGPET,",",2)-$PIECE(BGPBT,",",2))
SET BGPHR=$PIECE(BGPTS/3600,".")
IF BGPHR=""
SET BGPHR=0
Begin DoDot:1
+2 SET BGPTS=BGPTS-(BGPHR*3600)
SET BGPM=$PIECE(BGPTS/60,".")
IF BGPM=""
SET BGPM=0
SET BGPTS=BGPTS-(BGPM*60)
SET BGPS=BGPTS
SET X="RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS
WRITE !,$$CTR(X,80)
End DoDot:1
+3 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:80)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
