BGP9DAR9 ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM ; 04 Aug 2009 8:05 AM
;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
;
;
W:$D(IOF) @IOF
S BGPA=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2),BGPA=$O(^AUTTAREA("C",BGPA,0)) S BGPA=$S(BGPA:$P(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
W !!,$$CTR(BGPA_" Area Aggregate National GPRA & PART Report",80)
W !!,"This will produce an Area Aggregate National GPRA & PART Report for the"
W !,"2010 GPRA year using the same performance measure definitions from CRS"
W !,"Version 9.0."
W !!
INTRO ;
D EXIT
TP ;
S BGPAREAA=1
S BGPRTYPE=1,BGPBEN=1,BGP9RPTH=""
S X=$O(^BGPCTRL("B",2009,0))
S Y=^BGPCTRL(X,0)
S BGPBD=$P(Y,U,8),BGPED=$P(Y,U,9)
S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)
S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)
S BGPPER=$P(Y,U,14),BGPQTR=3
;ADDED FOR 09 REPORT
S BGPBD=3090701,BGPED=3100630
S BGPPBD=3080701,BGPPED=3090630
S BGPPER=3100000
S BGPNGR09=1
G NT ;comment out when testing in TEHR
W !!,"for testing purposes only, please enter a report year",!
D F
I BGPPER="" W !!,"no year entered..bye" D EXIT Q
S BGPQTR=3
S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"
S BGPPBD=($E(BGPPER,1,3)-1)_"0101",BGPPED=($E(BGPPER,1,3)-1)_"1231"
W !!,"for testing purposes only, please enter a BASELINE year",!
D B
I BGPBPER="" W !!,"no year entered..bye" D EXIT Q
S BGPBBD=$E(BGPBPER,1,3)_"0101",BGPBED=$E(BGPBPER,1,3)_"1231"
NT ;END TEST STUFF
W !!,"The date ranges for this report are:"
W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
ASU ;
S BGPSUCNT=0
S BGPRPTT=""
S DIR(0)="S^A:AREA Aggregate;F:One Facility",DIR("A")="Run Report for",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) EXIT
S BGPRPTT=Y
W !!!,"You will now be able to select which sites to use in the",!,"area aggregate/facility report.",!
S DIR(0)="E",DIR("A")="Press Enter to Continue" KILL DA D ^DIR KILL DIR
K BGPSUL
D EN^BGP9ASL
I '$D(BGPSUL) W !!,"No sites selected" D EXIT Q
S X=0,C=0 F S X=$O(BGPSUL(X)) Q:X'=+X S C=C+1
W !!,"A total of ",C," facilities have been selected.",!!
;I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPGPDCN(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)
ZIS ;call to XBDBQUE
EISSEX ;
S BGPEXCEL=$S($G(BGPSUMON):0,1:1)
S BGPUF=$$GETDIR^BGP9UTL2()
;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")
;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"
I BGPEXCEL=1 D
.S BGPNOW=$$NOW^XLFDT() S BGPNOW=$$NOW^XLFDT() S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP9UTL($P(BGPNOW,".",2),6)
.S BGPC=0,X=0 F S X=$O(BGPSUL(X)) Q:X'=+X S BGPC=BGPC+1
.I BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." Q
.S BGPFGNT1="CRSGPRANT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP9UTL(BGPNOW)_"_"_$$LZERO^BGP9UTL(BGPC,6)_".TXT"
.S BGPFGNT2="CRSGPRANT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP9UTL(BGPNOW)_"_"_$$LZERO^BGP9UTL(BGPC,6)_".TXT"
.S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP9UTL(BGPNOW)_"_"_$$LZERO^BGP9UTL(BGPC,6)_".TXT"
.S BGPFGNT4="CRSGPRANT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP9UTL(BGPNOW)_"_"_$$LZERO^BGP9UTL(BGPC,6)_".TXT"
.Q
S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
I BGPEXCEL D
.W !!,"A file will be created called ",BGPFGNT1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFGNT2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFGNT3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFGNT4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
. S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
D ^XBFMK
K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
GI ;gather all gpra measures
S X=0 F S X=$O(^BGPINDN("GPRA",1,X)) Q:X'=+X S BGPIND(X)=""
S BGPINDT="G"
D PT^BGP9DSL
I BGPROT="" G ASU
;
K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,EXIT Q
K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
I POP D EXIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
U IO
D PRINT^BGP9PARP
I BGPRPTT="A",BGPIFTR=1 D GNT1^BGP9UTL
D ^%ZISC
D EXIT
Q
;
TSKMN ;EP ENTRY POINT FROM TASKMAN
S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
K ZTSAVE S ZTSAVE("BGP*")=""
S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BGP9DAR9",ZTDTH="",ZTDESC="GPRA REPORT" D ^%ZTLOAD D HOME^%ZIS D EXIT Q
Q
;
EXIT ;
D ^%ZISC
D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
D KILL^AUPNPAT
D ^XBFMK
Q
NODEV ;
S XBRP="",XBRC="NODEV1^BGP9DAR9",XBRX="EXIT^BGP9DAR9",XBNS="BGP"
D ^XBDBQUE
Q
;
NODEV1 ;
D PRINT^BGP9PARP
I BGPRPTT="A" D GNT1^BGP9UTL
D ^%ZISC
D EXIT
Q
;
B ;fiscal year
S (BGPBPER,BGPVDT)=""
W !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2005"
S DIR(0)="D^::EP"
S DIR("A")="Enter BASELINE year"
S DIR("?")="This report is compiled for a period. Enter a valid date."
D ^DIR KILL DIR
I $D(DIRUT) Q
I $D(DUOUT) S DIRUT=1 Q
S BGPVDT=Y
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
S BGPBPER=BGPVDT
Q
F ;fiscal year
S BGPPER=""
W !
S BGPVDT=""
W !,"Enter the Fiscal Year (FY) for the report END date. Use a 4 digit",!,"year, e.g. 2002, 2005"
S DIR(0)="D^::EP"
S DIR("A")="Enter FY"
S DIR("?")="This report is compiled for a period. Enter a valid date."
D ^DIR
K DIC
I $D(DUOUT) S DIRUT=1 S BGPQUIT="" Q
S BGPVDT=Y
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
S BGPPER=BGPVDT,BGPBD=($E(BGPVDT,1,3)-1)_"1001",BGPED=$E(BGPVDT,1,3)_"0930"
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$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")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
;
BGP9DAR9 ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM ; 04 Aug 2009 8:05 AM
+1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 SET BGPA=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),1,2)
SET BGPA=$ORDER(^AUTTAREA("C",BGPA,0))
SET BGPA=$SELECT(BGPA:$PIECE(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
+6 WRITE !!,$$CTR(BGPA_" Area Aggregate National GPRA & PART Report",80)
+7 WRITE !!,"This will produce an Area Aggregate National GPRA & PART Report for the"
+8 WRITE !,"2010 GPRA year using the same performance measure definitions from CRS"
+9 WRITE !,"Version 9.0."
+10 WRITE !!
INTRO ;
+1 DO EXIT
TP ;
+1 SET BGPAREAA=1
+2 SET BGPRTYPE=1
SET BGPBEN=1
SET BGP9RPTH=""
+3 SET X=$ORDER(^BGPCTRL("B",2009,0))
+4 SET Y=^BGPCTRL(X,0)
+5 SET BGPBD=$PIECE(Y,U,8)
SET BGPED=$PIECE(Y,U,9)
+6 SET BGPPBD=$PIECE(Y,U,10)
SET BGPPED=$PIECE(Y,U,11)
+7 SET BGPBBD=$PIECE(Y,U,12)
SET BGPBED=$PIECE(Y,U,13)
+8 SET BGPPER=$PIECE(Y,U,14)
SET BGPQTR=3
+9 ;ADDED FOR 09 REPORT
+10 SET BGPBD=3090701
SET BGPED=3100630
+11 SET BGPPBD=3080701
SET BGPPED=3090630
+12 SET BGPPER=3100000
+13 SET BGPNGR09=1
+14 ;comment out when testing in TEHR
GOTO NT
+15 WRITE !!,"for testing purposes only, please enter a report year",!
+16 DO F
+17 IF BGPPER=""
WRITE !!,"no year entered..bye"
DO EXIT
QUIT
+18 SET BGPQTR=3
+19 SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
+20 SET BGPPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"
SET BGPPED=($EXTRACT(BGPPER,1,3)-1)_"1231"
+21 WRITE !!,"for testing purposes only, please enter a BASELINE year",!
+22 DO B
+23 IF BGPBPER=""
WRITE !!,"no year entered..bye"
DO EXIT
QUIT
+24 SET BGPBBD=$EXTRACT(BGPBPER,1,3)_"0101"
SET BGPBED=$EXTRACT(BGPBPER,1,3)_"1231"
NT ;END TEST STUFF
+1 WRITE !!,"The date ranges for this report are:"
+2 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
+3 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
+4 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
ASU ;
+1 SET BGPSUCNT=0
+2 SET BGPRPTT=""
+3 SET DIR(0)="S^A:AREA Aggregate;F:One Facility"
SET DIR("A")="Run Report for"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO EXIT
+5 SET BGPRPTT=Y
+6 WRITE !!!,"You will now be able to select which sites to use in the",!,"area aggregate/facility report.",!
+7 SET DIR(0)="E"
SET DIR("A")="Press Enter to Continue"
KILL DA
DO ^DIR
KILL DIR
+8 KILL BGPSUL
+9 DO EN^BGP9ASL
+10 IF '$DATA(BGPSUL)
WRITE !!,"No sites selected"
DO EXIT
QUIT
+11 SET X=0
SET C=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET C=C+1
+12 WRITE !!,"A total of ",C," facilities have been selected.",!!
+13 ;I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPGPDCN(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)
ZIS ;call to XBDBQUE
EISSEX ;
+1 SET BGPEXCEL=$SELECT($GET(BGPSUMON):0,1:1)
+2 SET BGPUF=$$GETDIR^BGP9UTL2()
+3 ;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")
+4 ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"
+5 IF BGPEXCEL=1
Begin DoDot:1
+6 SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$PIECE(BGPNOW,".")_"."_$$RZERO^BGP9UTL($PIECE(BGPNOW,".",2),6)
+7 SET BGPC=0
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET BGPC=BGPC+1
+8 IF BGPUF=""
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written."
QUIT
+9 SET BGPFGNT1="CRSGPRANT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP9UTL(BGPNOW)_"_"_$$LZERO^BGP9UTL(BGPC,6)_".TXT"
+10 SET BGPFGNT2="CRSGPRANT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP9UTL(BGPNOW)_"_"_$$LZERO^BGP9UTL(BGPC,6)_".TXT"
+11 SET BGPFGNT3="CRSGPRANT3"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP9UTL(BGPNOW)_"_"_$$LZERO^BGP9UTL(BGPC,6)_".TXT"
+12 SET BGPFGNT4="CRSGPRANT4"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP9UTL(BGPNOW)_"_"_$$LZERO^BGP9UTL(BGPC,6)_".TXT"
+13 QUIT
End DoDot:1
+14 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+15 IF BGPEXCEL
Begin DoDot:1
+16 WRITE !!,"A file will be created called ",BGPFGNT1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+17 WRITE !!,"A file will be created called ",BGPFGNT2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+18 WRITE !!,"A file will be created called ",BGPFGNT3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+19 WRITE !!,"A file will be created called ",BGPFGNT4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+20 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
End DoDot:1
+21 DO ^XBFMK
+22 KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
GI ;gather all gpra measures
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDN("GPRA",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+2 SET BGPINDT="G"
+3 DO PT^BGP9DSL
+4 IF BGPROT=""
GOTO ASU
+5 ;
+6 KILL IOP,%ZIS
IF BGPROT="D"
IF BGPDELT="F"
DO NODEV
DO EXIT
QUIT
+7 KILL IOP,%ZIS
WRITE !!
SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
DO ^%ZIS
+8 IF POP
DO EXIT
QUIT
+9 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 USE IO
+2 DO PRINT^BGP9PARP
+3 IF BGPRPTT="A"
IF BGPIFTR=1
DO GNT1^BGP9UTL
+4 DO ^%ZISC
+5 DO EXIT
+6 QUIT
+7 ;
TSKMN ;EP ENTRY POINT FROM TASKMAN
+1 SET ZTIO=$SELECT($DATA(ION):ION,1:IO)
IF $DATA(IOST)#2
IF IOST]""
SET ZTIO=ZTIO_";"_IOST
+2 IF $GET(IO("DOC"))]""
SET ZTIO=ZTIO_";"_$GET(IO("DOC"))
+3 IF $DATA(IOM)#2
IF IOM
SET ZTIO=ZTIO_";"_IOM
IF $DATA(IOSL)#2
IF IOSL
SET ZTIO=ZTIO_";"_IOSL
+4 KILL ZTSAVE
SET ZTSAVE("BGP*")=""
+5 SET ZTCPU=$GET(IOCPU)
SET ZTRTN="DRIVER^BGP9DAR9"
SET ZTDTH=""
SET ZTDESC="GPRA REPORT"
DO ^%ZTLOAD
DO HOME^%ZIS
DO EXIT
QUIT
+6 QUIT
+7 ;
EXIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO KILL^AUPNPAT
+4 DO ^XBFMK
+5 QUIT
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP9DAR9"
SET XBRX="EXIT^BGP9DAR9"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO PRINT^BGP9PARP
+2 IF BGPRPTT="A"
DO GNT1^BGP9UTL
+3 DO ^%ZISC
+4 DO EXIT
+5 QUIT
+6 ;
B ;fiscal year
+1 SET (BGPBPER,BGPVDT)=""
+2 WRITE !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2005"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter BASELINE year"
+5 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 IF $DATA(DUOUT)
SET DIRUT=1
QUIT
+9 SET BGPVDT=Y
+10 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO F
+11 SET BGPBPER=BGPVDT
+12 QUIT
F ;fiscal year
+1 SET BGPPER=""
+2 WRITE !
+3 SET BGPVDT=""
+4 WRITE !,"Enter the Fiscal Year (FY) for the report END date. Use a 4 digit",!,"year, e.g. 2002, 2005"
+5 SET DIR(0)="D^::EP"
+6 SET DIR("A")="Enter FY"
+7 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+8 DO ^DIR
+9 KILL DIC
+10 IF $DATA(DUOUT)
SET DIRUT=1
SET BGPQUIT=""
QUIT
+11 SET BGPVDT=Y
+12 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO F
+13 SET BGPPER=BGPVDT
SET BGPBD=($EXTRACT(BGPVDT,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPVDT,1,3)_"0930"
+14 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$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 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
+3 ;
