- BGP0EOS ; IHS/CMI/LAB - IHS gpra print ;
- ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- ;
- START ;
- Q:$G(BGPAREAA)
- ;Q:'$D(BGPLIST) ;cmi/maw 7/9/08 orig line
- Q:'$O(BGPLIST("")) ;cmi/maw 7/9/08 modified as BGPLIST always exists but sometimes not with the list array
- S BGPQUIT="",BGPGPG=0,BGPCOUNT=0
- D:BGPPTYPE="P" W^BGP0EOH("PATIENT LISTS",0,3,BGPPTYPE) D
- .D W^BGP0EOH("**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",0,2,BGPPTYPE)
- S BGPL=0 F S BGPL=$O(BGPLIST(BGPL)) Q:BGPL'=+BGPL!(BGPQUIT) D
- .S BGPCOUNT=0,BGPPCNT=0
- .I BGPPTYPE="P" D HEADER Q:BGPQUIT
- .I BGPPTYPE="D" D W^BGP0EOH("",0,2,BGPPTYPE)
- .S BGPCNT=$G(BGPLIST(BGPL))
- .I 'BGPCNT S BGPCNT=0 G GO
- .I BGPCNT<11!(BGPLIST'="R") S BGPCNT=1 G GO
- .I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
- .S BGPCNT=10
- GO .;
- .D W^BGP0EOH($P(^BGPEOMT(BGPL,0),U,2),0,1,BGPPTYPE)
- .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .D W^BGP0EOH("Denominator(s):",0,2,BGPPTYPE)
- .S BGPX=0 F S BGPX=$O(^BGPEOMT(BGPL,61,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- ..S BGPY=0 F S BGPY=$O(^BGPEOMT(BGPL,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
- ...D WP
- .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .D W^BGP0EOH("Numerator(s):",0,2,BGPPTYPE)
- .S BGPX=0 F S BGPX=$O(^BGPEOMT(BGPL,62,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- ..S BGPY=0 F S BGPY=$O(^BGPEOMT(BGPL,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
- ...D WP
- .I $O(^BGPEOMT(BGPL,11,0)) D W^BGP0EOH("Logic:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPEOMT(BGPL,11,BGPX)) Q:BGPX'=+BGPX D
- ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ..D W^BGP0EOH(^BGPEOMT(BGPL,11,BGPX,0),0,1,BGPPTYPE)
- .D W^BGP0EOH("",0,1,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPEOMT(BGPL,71,BGPX)) Q:BGPX'=+BGPX D
- ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ..;D W^BGP0EOH(^BGPEOMT(BGPL,71,BGPX,0),0,1,BGPPTYPE)
- .D H1
- .S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D
- ..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D
- ...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
- ....S DFN=0 F S DFN=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT) S BGPCOUNT=BGPCOUNT+1 D PRINTL
- ....Q
- ...Q
- ..Q
- .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .D W^BGP0EOH("Total # of Patients on list: "_+$G(BGPPCNT),0,2,BGPPTYPE),W^BGP0EOH("",0,1,BGPPTYPE)
- Q
- WP ;
- K ^UTILITY($J,"W")
- S BGPZ=0,BGPLCNT=0
- S DIWL=1,DIWR=80,DIWF="",BGPZ=0 F S BGPZ=$O(^BGPEOMT(BGPL,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
- .S BGPLCNT=BGPLCNT+1
- .S X=^BGPEOMT(BGPL,BGPNODE,BGPY,1,BGPZ,0) S:BGPLCNT=1 X=" - "_X D ^DIWP
- .Q
- WPS ;
- S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z D
- .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .D W^BGP0EOH(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
- K DIWL,DIWR,DIWF,Z
- K ^UTILITY($J,"W"),X
- Q
- ;
- PRINTL ;print one line
- Q:(BGPCOUNT#BGPCNT)
- I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT D
- .D H1
- S BGPPCNT=BGPPCNT+1
- D W^BGP0EOH($E($P(^DPT(DFN,0),U),1,22),0,1,BGPPTYPE)
- D W^BGP0EOH($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,BGPPTYPE,2,24)
- D W^BGP0EOH(BGPCOM,0,0,BGPPTYPE,3,31)
- D W^BGP0EOH(BGPSEX,0,0,BGPPTYPE,4,46)
- D W^BGP0EOH(BGPAGE,0,0,BGPPTYPE,5,49)
- D W^BGP0EOH($P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),0,0,BGPPTYPE,6,53)
- D W^BGP0EOH($P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2),0,0,BGPPTYPE,7,59)
- ;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("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?59,$P(^XTMP("BGP0D",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 2010 Executive Order Quality Transparency Measures Patient List ***",80),!
- W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
- S X="Reporting 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 X=$S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV) D W^BGP0EOH(X,0,1,BGPPTYPE)
- D W^BGP0EOH("UP=User Pop; AC=Active Clinical; AD=Active Diabetic",0,2,BGPPTYPE),W^BGP0EOH("",0,1,BGPPTYPE)
- S N=$S(BGPCOUNT<2:71,1:72) S X=0 F S X=$O(^BGPEOMT(BGPL,N,X)) Q:X'=+X D W^BGP0EOH(^BGPEOMT(BGPL,N,X,0),0,1,BGPPTYPE)
- D W^BGP0EOH("PATIENT NAME",0,2,BGPPTYPE)
- D W^BGP0EOH("HRN",0,0,BGPPTYPE,2,24)
- D W^BGP0EOH("COMMUNITY",0,0,BGPPTYPE,3,31)
- D W^BGP0EOH("SEX",0,0,BGPPTYPE,4,45)
- D W^BGP0EOH("AGE",0,0,BGPPTYPE,5,49)
- D W^BGP0EOH("DENOM",0,0,BGPPTYPE,6,53)
- D W^BGP0EOH("NUMERATOR",0,0,BGPPTYPE,7,59)
- D W^BGP0EOH($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- 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")
- ;----------
- BGP0EOS ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- +2 ;
- START ;
- +1 IF $GET(BGPAREAA)
- QUIT
- +2 ;Q:'$D(BGPLIST) ;cmi/maw 7/9/08 orig line
- +3 ;cmi/maw 7/9/08 modified as BGPLIST always exists but sometimes not with the list array
- IF '$ORDER(BGPLIST(""))
- QUIT
- +4 SET BGPQUIT=""
- SET BGPGPG=0
- SET BGPCOUNT=0
- +5 IF BGPPTYPE="P"
- DO W^BGP0EOH("PATIENT LISTS",0,3,BGPPTYPE)
- Begin DoDot:1
- +6 DO W^BGP0EOH("**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",0,2,BGPPTYPE)
- End DoDot:1
- +7 SET BGPL=0
- FOR
- SET BGPL=$ORDER(BGPLIST(BGPL))
- IF BGPL'=+BGPL!(BGPQUIT)
- QUIT
- Begin DoDot:1
- +8 SET BGPCOUNT=0
- SET BGPPCNT=0
- +9 IF BGPPTYPE="P"
- DO HEADER
- IF BGPQUIT
- QUIT
- +10 IF BGPPTYPE="D"
- DO W^BGP0EOH("",0,2,BGPPTYPE)
- +11 SET BGPCNT=$GET(BGPLIST(BGPL))
- +12 IF 'BGPCNT
- SET BGPCNT=0
- GOTO GO
- +13 IF BGPCNT<11!(BGPLIST'="R")
- SET BGPCNT=1
- GOTO GO
- +14 IF BGPCNT<100
- SET BGPCNT=BGPCNT\10
- GOTO GO
- +15 SET BGPCNT=10
- GO ;
- +1 DO W^BGP0EOH($PIECE(^BGPEOMT(BGPL,0),U,2),0,1,BGPPTYPE)
- +2 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +3 DO W^BGP0EOH("Denominator(s):",0,2,BGPPTYPE)
- +4 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPEOMT(BGPL,61,"B",BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +5 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPEOMT(BGPL,61,"B",BGPX,BGPY))
- IF BGPY'=+BGPY!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +6 DO WP
- End DoDot:3
- End DoDot:2
- +7 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +8 DO W^BGP0EOH("Numerator(s):",0,2,BGPPTYPE)
- +9 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPEOMT(BGPL,62,"B",BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +10 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPEOMT(BGPL,62,"B",BGPX,BGPY))
- IF BGPY'=+BGPY!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +11 DO WP
- End DoDot:3
- End DoDot:2
- +12 IF $ORDER(^BGPEOMT(BGPL,11,0))
- DO W^BGP0EOH("Logic:",0,2,BGPPTYPE)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPEOMT(BGPL,11,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +13 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +14 DO W^BGP0EOH(^BGPEOMT(BGPL,11,BGPX,0),0,1,BGPPTYPE)
- End DoDot:2
- +15 DO W^BGP0EOH("",0,1,BGPPTYPE)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPEOMT(BGPL,71,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +16 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +17 ;D W^BGP0EOH(^BGPEOMT(BGPL,71,BGPX,0),0,1,BGPPTYPE)
- End DoDot:2
- +18 DO H1
- +19 SET BGPCOM=""
- FOR
- SET BGPCOM=$ORDER(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM))
- IF BGPCOM=""!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +20 SET BGPSEX=""
- FOR
- SET BGPSEX=$ORDER(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX))
- IF BGPSEX=""!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +21 SET BGPAGE=""
- FOR
- SET BGPAGE=$ORDER(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE))
- IF BGPAGE=""!(BGPQUIT)
- QUIT
- Begin DoDot:4
- +22 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN))
- IF DFN'=+DFN!(BGPQUIT)
- QUIT
- SET BGPCOUNT=BGPCOUNT+1
- DO PRINTL
- +23 QUIT
- End DoDot:4
- +24 QUIT
- End DoDot:3
- +25 QUIT
- End DoDot:2
- +26 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +27 DO W^BGP0EOH("Total # of Patients on list: "_+$GET(BGPPCNT),0,2,BGPPTYPE)
- DO W^BGP0EOH("",0,1,BGPPTYPE)
- End DoDot:1
- +28 QUIT
- WP ;
- +1 KILL ^UTILITY($JOB,"W")
- +2 SET BGPZ=0
- SET BGPLCNT=0
- +3 SET DIWL=1
- SET DIWR=80
- SET DIWF=""
- SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPEOMT(BGPL,BGPNODE,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:1
- +4 SET BGPLCNT=BGPLCNT+1
- +5 SET X=^BGPEOMT(BGPL,BGPNODE,BGPY,1,BGPZ,0)
- IF BGPLCNT=1
- SET X=" - "_X
- DO ^DIWP
- +6 QUIT
- End DoDot:1
- WPS ;
- +1 SET Z=0
- FOR
- SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
- IF Z'=+Z
- QUIT
- Begin DoDot:1
- +2 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +3 DO W^BGP0EOH(^UTILITY($JOB,"W",DIWL,Z,0),0,1,BGPPTYPE)
- End DoDot:1
- +4 KILL DIWL,DIWR,DIWF,Z
- +5 KILL ^UTILITY($JOB,"W"),X
- +6 QUIT
- +7 ;
- PRINTL ;print one line
- +1 IF (BGPCOUNT#BGPCNT)
- QUIT
- +2 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- Begin DoDot:1
- +3 DO H1
- End DoDot:1
- +4 SET BGPPCNT=BGPPCNT+1
- +5 DO W^BGP0EOH($EXTRACT($PIECE(^DPT(DFN,0),U),1,22),0,1,BGPPTYPE)
- +6 DO W^BGP0EOH($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,BGPPTYPE,2,24)
- +7 DO W^BGP0EOH(BGPCOM,0,0,BGPPTYPE,3,31)
- +8 DO W^BGP0EOH(BGPSEX,0,0,BGPPTYPE,4,46)
- +9 DO W^BGP0EOH(BGPAGE,0,0,BGPPTYPE,5,49)
- +10 DO W^BGP0EOH($PIECE(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),0,0,BGPPTYPE,6,53)
- +11 DO W^BGP0EOH($PIECE(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2),0,0,BGPPTYPE,7,59)
- +12 ;W !,$E($P(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$E(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE
- +13 ;W ?53,$P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?59,$P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
- +14 QUIT
- +15 ;
- +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 2010 Executive Order Quality Transparency Measures Patient List ***",80),!
- +6 WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),!
- +7 SET X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- WRITE $$CTR(X,80),!
- +8 ;W $$CTR($S(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 X=$SELECT(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV)
- DO W^BGP0EOH(X,0,1,BGPPTYPE)
- +2 DO W^BGP0EOH("UP=User Pop; AC=Active Clinical; AD=Active Diabetic",0,2,BGPPTYPE)
- DO W^BGP0EOH("",0,1,BGPPTYPE)
- +3 SET N=$SELECT(BGPCOUNT<2:71,1:72)
- SET X=0
- FOR
- SET X=$ORDER(^BGPEOMT(BGPL,N,X))
- IF X'=+X
- QUIT
- DO W^BGP0EOH(^BGPEOMT(BGPL,N,X,0),0,1,BGPPTYPE)
- +4 DO W^BGP0EOH("PATIENT NAME",0,2,BGPPTYPE)
- +5 DO W^BGP0EOH("HRN",0,0,BGPPTYPE,2,24)
- +6 DO W^BGP0EOH("COMMUNITY",0,0,BGPPTYPE,3,31)
- +7 DO W^BGP0EOH("SEX",0,0,BGPPTYPE,4,45)
- +8 DO W^BGP0EOH("AGE",0,0,BGPPTYPE,5,49)
- +9 DO W^BGP0EOH("DENOM",0,0,BGPPTYPE,6,53)
- +10 DO W^BGP0EOH("NUMERATOR",0,0,BGPPTYPE,7,59)
- +11 DO W^BGP0EOH($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +12 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 ;----------