BGP9DS ; IHS/CMI/LAB - IHS gpra print ;
;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
;
START ;
Q:$G(BGPAREAA)
Q:'$D(BGPLIST)
I $G(BGPNPL) Q
I $G(BGPCPPL) Q ;not on comprehensive pt
S BGPQUIT="",BGPGPG=0
;D HEADER
S BGPL=0 F S BGPL=$O(BGPLIST(BGPL)) Q:BGPL'=+BGPL!(BGPQUIT) D
.S BGPFIRSP=1 S BGPCOUNT=0,BGPPCNT=0
.D HEADER Q:BGPQUIT
.S BGPCNT=$G(BGPLIST(BGPL))
.I 'BGPCNT S BGPCNT=0 G GO
.I BGPCNT<100 S BGPCNT=1 G GO
.I BGPLIST'="R" S BGPCNT=1 G GO
.;I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
.;I BGPCNT<100 G GO
.S BGPCNT=10
GO .;
.D WTITLE ;W !,$P(^BGPINDN(BGPL,0),U,3),!
.W !,"Denominator(s):"
.S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,61,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPINDN(BGPL,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...;I $P(^BGPINDN(BGPL,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
...;I BGPRTYPE=4,$P(^BGPINDN(BGPL,61,BGPY,0),U,3)'[BGPINDT Q ;don't display
...I '$D(^BGPINDN(BGPL,61,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
...I BGPRTYPE=4,'$D(^BGPINDN(BGPL,61,BGPY,12,"B",BGPINDT))
...S BGPZ=0 F S BGPZ=$O(^BGPINDN(BGPL,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
....W !,^BGPINDN(BGPL,61,BGPY,1,BGPZ,0)
....Q
...;W !
...Q
..Q
.I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.W !!,"Numerator(s):"
.S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,62,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPINDN(BGPL,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...;I $P(^BGPINDN(BGPL,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
...;I BGPRTYPE=4,BGPINDT'="S",$P(^BGPINDN(BGPL,62,BGPY,0),U,3)'[BGPINDT Q ;don't display
...I '$D(^BGPINDN(BGPL,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
...I BGPRTYPE=4,'$D(^BGPINDN(BGPL,62,BGPY,12,"B",BGPINDT)) Q ;not this measure type on selected
...S BGPZ=0 F S BGPZ=$O(^BGPINDN(BGPL,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
....W !,^BGPINDN(BGPL,62,BGPY,1,BGPZ,0)
....Q
...;W !
...Q
..Q
.S BGPNODE=11
.I BGPRTYPE=1,$O(^BGPINDN(BGPL,54,0)) S BGPNODE=54
.I BGPRTYPE=7,$O(^BGPINDN(BGPL,56,0)) S BGPNODE=56
.W !!,"Logic" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
..W !,^BGPINDN(BGPL,BGPNODE,BGPX,0)
.W !!,"Performance Measure Description" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,51,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
..W !,^BGPINDN(BGPL,51,BGPX,0)
.I $O(^BGPINDN(BGPL,52,0)) W !,"Past Performance and/or Target" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,52,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
..W !,^BGPINDN(BGPL,52,BGPX,0)
.I $O(^BGPINDN(BGPL,55,0)) W !,"Source" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,55,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
..W !,^BGPINDN(BGPL,55,BGPX,0)
.I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
.W !
.D H1
.Q:BGPQUIT
.S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D
..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D
...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
....S DFN=0 F S DFN=$O(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT) S BGPCOUNT=BGPCOUNT+1 D PRINTL
....Q
...Q
..Q
.I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.W !!,"Total # of Patients on list: ",+$G(BGPPCNT)
Q
WTITLE ;EP - write title line
NEW T,X,Y,S
S T=$P(^BGPINDN(BGPL,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
;
PRINTL ;print one line
Q:(BGPCOUNT#BGPCNT)
I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT D
.;S X=0 F S X=$O(^BGPINDN(BGPL,72,X)) Q:X'=+X W !,^BGPINDN(BGPL,72,X,0)
.D H1
Q:BGPQUIT
S BGPPCNT=BGPPCNT+1
W !,$E($P(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$E(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE
W ?53,$P(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
W:BGPL=43 " NUMERATOR: "
W ?65,$P(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
Q
;
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 !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
W !,$$CTR("*** IHS 2009 Clinical Performance Measure Patient List ***",80),!
W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W $$CTR(X,80),!
W $$CTR($S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
W !,$TR($J("",80)," ","-")
Q
H1 ;
S BGPTSUB=$S(BGPFIRSP:71,1:72)
S X=0,C=0 F S X=$O(^BGPINDN(BGPL,BGPTSUB,X)) Q:X'=+X S C=C+1
I $Y>(BGPIOSL-(C+6)) D HEADER Q:BGPQUIT
W !,"UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",!,"PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",!
S X=0 F S X=$O(^BGPINDN(BGPL,BGPTSUB,X)) Q:X'=+X W !,^BGPINDN(BGPL,BGPTSUB,X,0)
W !,"PATIENT NAME",?24,"HRN",?31,"COMMUNITY",?45,"SEX",?49,"AGE",?53,"DENOMINATOR",?65,"NUMERATOR"
W !,$TR($J("",80)," ","-")
S BGPFIRSP=0
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
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")
;----------
BGP9DS ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
+2 ;
START ;
+1 IF $GET(BGPAREAA)
QUIT
+2 IF '$DATA(BGPLIST)
QUIT
+3 IF $GET(BGPNPL)
QUIT
+4 ;not on comprehensive pt
IF $GET(BGPCPPL)
QUIT
+5 SET BGPQUIT=""
SET BGPGPG=0
+6 ;D HEADER
+7 SET BGPL=0
FOR
SET BGPL=$ORDER(BGPLIST(BGPL))
IF BGPL'=+BGPL!(BGPQUIT)
QUIT
Begin DoDot:1
+8 SET BGPFIRSP=1
SET BGPCOUNT=0
SET BGPPCNT=0
+9 DO HEADER
IF BGPQUIT
QUIT
+10 SET BGPCNT=$GET(BGPLIST(BGPL))
+11 IF 'BGPCNT
SET BGPCNT=0
GOTO GO
+12 IF BGPCNT<100
SET BGPCNT=1
GOTO GO
+13 IF BGPLIST'="R"
SET BGPCNT=1
GOTO GO
+14 ;I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
+15 ;I BGPCNT<100 G GO
+16 SET BGPCNT=10
GO ;
+1 ;W !,$P(^BGPINDN(BGPL,0),U,3),!
DO WTITLE
+2 WRITE !,"Denominator(s):"
+3 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPL,61,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDN(BGPL,61,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+5 ;I $P(^BGPINDN(BGPL,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
+6 ;I BGPRTYPE=4,$P(^BGPINDN(BGPL,61,BGPY,0),U,3)'[BGPINDT Q ;don't display
+7 ;not this report type
IF '$DATA(^BGPINDN(BGPL,61,BGPY,11,"B",BGPRTYPE))
QUIT
+8 IF BGPRTYPE=4
IF '$DATA(^BGPINDN(BGPL,61,BGPY,12,"B",BGPINDT))
+9 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDN(BGPL,61,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ!(BGPQUIT)
QUIT
Begin DoDot:4
+10 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+11 WRITE !,^BGPINDN(BGPL,61,BGPY,1,BGPZ,0)
+12 QUIT
End DoDot:4
+13 ;W !
+14 QUIT
End DoDot:3
+15 QUIT
End DoDot:2
+16 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+17 WRITE !!,"Numerator(s):"
+18 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPL,62,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+19 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDN(BGPL,62,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+20 ;I $P(^BGPINDN(BGPL,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
+21 ;I BGPRTYPE=4,BGPINDT'="S",$P(^BGPINDN(BGPL,62,BGPY,0),U,3)'[BGPINDT Q ;don't display
+22 ;not this report type
IF '$DATA(^BGPINDN(BGPL,62,BGPY,11,"B",BGPRTYPE))
QUIT
+23 ;not this measure type on selected
IF BGPRTYPE=4
IF '$DATA(^BGPINDN(BGPL,62,BGPY,12,"B",BGPINDT))
QUIT
+24 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDN(BGPL,62,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ!(BGPQUIT)
QUIT
Begin DoDot:4
+25 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+26 WRITE !,^BGPINDN(BGPL,62,BGPY,1,BGPZ,0)
+27 QUIT
End DoDot:4
+28 ;W !
+29 QUIT
End DoDot:3
+30 QUIT
End DoDot:2
+31 SET BGPNODE=11
+32 IF BGPRTYPE=1
IF $ORDER(^BGPINDN(BGPL,54,0))
SET BGPNODE=54
+33 IF BGPRTYPE=7
IF $ORDER(^BGPINDN(BGPL,56,0))
SET BGPNODE=56
+34 WRITE !!,"Logic"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPL,BGPNODE,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+35 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+36 WRITE !,^BGPINDN(BGPL,BGPNODE,BGPX,0)
End DoDot:2
+37 WRITE !!,"Performance Measure Description"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPL,51,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+38 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+39 WRITE !,^BGPINDN(BGPL,51,BGPX,0)
End DoDot:2
+40 IF $ORDER(^BGPINDN(BGPL,52,0))
WRITE !,"Past Performance and/or Target"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPL,52,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+41 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+42 WRITE !,^BGPINDN(BGPL,52,BGPX,0)
End DoDot:2
+43 IF $ORDER(^BGPINDN(BGPL,55,0))
WRITE !,"Source"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPL,55,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+44 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+45 WRITE !,^BGPINDN(BGPL,55,BGPX,0)
End DoDot:2
+46 IF $Y>(BGPIOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+47 WRITE !
+48 DO H1
+49 IF BGPQUIT
QUIT
+50 SET BGPCOM=""
FOR
SET BGPCOM=$ORDER(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM))
IF BGPCOM=""!(BGPQUIT)
QUIT
Begin DoDot:2
+51 SET BGPSEX=""
FOR
SET BGPSEX=$ORDER(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX))
IF BGPSEX=""!(BGPQUIT)
QUIT
Begin DoDot:3
+52 SET BGPAGE=""
FOR
SET BGPAGE=$ORDER(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE))
IF BGPAGE=""!(BGPQUIT)
QUIT
Begin DoDot:4
+53 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN))
IF DFN'=+DFN!(BGPQUIT)
QUIT
SET BGPCOUNT=BGPCOUNT+1
DO PRINTL
+54 QUIT
End DoDot:4
+55 QUIT
End DoDot:3
+56 QUIT
End DoDot:2
+57 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+58 WRITE !!,"Total # of Patients on list: ",+$GET(BGPPCNT)
End DoDot:1
+59 QUIT
WTITLE ;EP - write title line
+1 NEW T,X,Y,S
+2 SET T=$PIECE(^BGPINDN(BGPL,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
+10 ;
PRINTL ;print one line
+1 IF (BGPCOUNT#BGPCNT)
QUIT
+2 IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
Begin DoDot:1
+3 ;S X=0 F S X=$O(^BGPINDN(BGPL,72,X)) Q:X'=+X W !,^BGPINDN(BGPL,72,X,0)
+4 DO H1
End DoDot:1
+5 IF BGPQUIT
QUIT
+6 SET BGPPCNT=BGPPCNT+1
+7 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$EXTRACT(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE
+8 WRITE ?53,$PIECE(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
+9 IF BGPL=43
WRITE " NUMERATOR: "
+10 WRITE ?65,$PIECE(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
+11 QUIT
+12 ;
+1 IF 'BGPGPG
GOTO HEADER1
+2 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 !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
+4 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
+5 WRITE !,$$CTR("*** IHS 2009 Clinical Performance Measure Patient List ***",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),!
+7 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
WRITE $$CTR(X,80),!
+8 WRITE $$CTR($SELECT(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
+9 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+10 QUIT
H1 ;
+1 SET BGPTSUB=$SELECT(BGPFIRSP:71,1:72)
+2 SET X=0
SET C=0
FOR
SET X=$ORDER(^BGPINDN(BGPL,BGPTSUB,X))
IF X'=+X
QUIT
SET C=C+1
+3 IF $Y>(BGPIOSL-(C+6))
DO HEADER
IF BGPQUIT
QUIT
+4 WRITE !,"UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",!,"PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",!
+5 SET X=0
FOR
SET X=$ORDER(^BGPINDN(BGPL,BGPTSUB,X))
IF X'=+X
QUIT
WRITE !,^BGPINDN(BGPL,BGPTSUB,X,0)
+6 WRITE !,"PATIENT NAME",?24,"HRN",?31,"COMMUNITY",?45,"SEX",?49,"AGE",?53,"DENOMINATOR",?65,"NUMERATOR"
+7 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+8 SET BGPFIRSP=0
+9 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 ;----------
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 ;----------
