APCLACGM ;IHS/CMI/LAB - A/C monthly report; [ 12/9/2009 19:39 PM ]
;;2.0;IHS PCC SUITE;**2,5,10,11**;MAY 14, 2009;Build 58
;
;
D PRINT
K ^XTMP("APCLACG",APCLJOB,APCLBTH)
K APCLJOB,APCLBTH
D DONE^APCLOSUT
Q
PRINT ;
S APCL80S="-------------------------------------------------------------------------------"
D NOW^%DTC S Y=X D DD^%DT S APCLDT=Y
S (APCLPG,APCLAP)=0
K APCLQUIT
D HEAD
;S (APCLUPWR,APCLUPOP,APCLUPAC,APCLRPOP,APCLRPWR,APCLRPAC)=999999
S APCLSHD=""
W !,"Date Range:",?40,$$FMTE^XLFDT(APCLBD)," - ",$$FMTE^XLFDT(APCLED),!
W !,"Total Demographics",!
W !,"User Population",?40,$J($$C(APCLUPOP,0,8),12),!
W !,"Number of patients in the User Population",!
W "who had a prescription for Warfarin in the",!
W "45 days prior to ",$$FMTE^XLFDT(APCLED),".",?40,$J($$C(APCLUPWR,0,8),12),?55,$$PER(APCLUPWR,APCLUPOP)," (of User Pop)",!
W !,"Number of patients on Warfarin managed "
W !,"by the Anticoagulation Clinic (had a visit",!,"to Anticoagulation clinic in the ",!,"time period",?40,$J($$C(APCLUPAC,0,8),12),?55,$$PER(APCLUPAC,APCLUPWR)," (of Warfarin Pop)"
I $Y>(IOSL-8) D HEAD Q:$D(APCLQUIT)
RPTPOP ;report population
W !!,"Report Demographics",!
W !,"Report Population:" D
.I APCLGRP="W" W ?40,"Warfarin Patients",!
.I APCLGRP="A" W ?40,"Anticoagulation Clinic Patients",! D
..S X=0 F S X=$O(APCLACCR(X)) Q:X'=+X W ?40,$P(^DIC(40.7,X,0),U),!
.I APCLGRP="S" W ?40,"Search Template: ",!?40,$P(^DIBT(APCLSTMP,0),U),!
.I APCLGRP="I" W ?40,"iCare Panel: ",!?40,$P(APCLICP,U,3),!
.I APCLGRP="E" W ?40,"EHR Personal List: ",!?40,$P(APCLICP,U,3),!
W !,"Number of patients included on this",!,"report",?40,$J($$C(APCLRPOP,0,8),12),!
I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included in this ",!
W "report who had a prescription for Warfarin ",!
W "in the 45 days prior to ",$$FMTE^XLFDT(APCLED),".",?40,$J($$C(APCLRPWR,0,8),12),?55,$$PER(APCLRPWR,APCLRPOP)," (of Report Pop)",!
I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients on Warfarin managed ",!
W "by the Anticoagulation Clinic (had a visit",!,"to Anticoagulation clinic in the ",!,"time period",?40,$J($$C(APCLRPWA,0,8),12),?55,$$PER(APCLRPWA,APCLRPWR)," (of Warfarin Pop)",!
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included on this",!
W "report who had a prescription for Warfarin",!
W "AND had a documented INR within the 45",!
W "days prior to the end of the report:",?40,$J($$C(APCLRPIN,0,8),12),?55,$$PER(APCLRPIN,APCLRPWR)," (of Rep/INR Pop)",!
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included on this",!
W "report who had a prescription for Warfarin",!
W "AND had an INR value greater than or equal",!
W "to 9.0 during the report date range:",?40,$J($$C(APCLRPI9,0,8),12),?55,$$PER(APCLRPI9,APCLRPIN)," (of Rep/War Pop)",!
I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
W !?3,"Patients who had an INR > 9 this month:",!
D SUBHEAD1
S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD1
.W ?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
.S APCLVD=0 F S APCLVD=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD)) Q:APCLVD=""!($D(APCLQUIT)) D
..S APCLI=0 F S APCLI=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD,APCLI)) Q:APCLI'=+APCLI!($D(APCLQUIT)) D
...S APCLR=^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD,APCLI)
...W ?43,$P($$INRGOAL(DFN,APCLED),U,1),?56,APCLR,?66,$$D1^APCHSMU(APCLVD),!
.;NOW DISPLAY INDICATIONS - ALL DXS IN TIME PERIOD
.I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD1
.K APCLD
.S %=DFN_"^ALL DX [BJPC AC THRPY INDIC DXS;DURING "_APCLBD_"-"_APCLED,E=$$START1^APCLDF(%,"APCLD(")
.W ?3,"Indication for Anticoag Therapy:"
.S X=0 F S X=$O(APCLD(X)) Q:X'=+X W " ",$P(APCLD(X),U,2)
.W !
VITK ;
I $Y>(IOSL-8) D HEAD Q:$D(APCLQUIT)
W !!!,"Number of patients included on this",!
W "report who had a prescription for Vitamin K",!
W "during the report date range:",?40,$J($$C(APCLRPVK,0,8),12),?55,$$PER(APCLRPVK,APCLRPWR)," (of Rep/War Pop)",!
I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
W !?3,"Patients who received Vitamin K this month:",!
D SUBHEAD2
S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"VITK",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD2
.W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
.W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
.S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
.W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
.;NOW DISPLAY INDICATIONS - ALL DXS IN TIME PERIOD
.I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT) D SUBHEAD2
.W ?3,"Date of Last Vitamin K prescription: ",$$D1^APCHSMU(^XTMP("APCLACG",APCLJOB,APCLBTH,"VITK",DFN)),!
.K APCLD
.S %=DFN_"^ALL DX [BJPC AC THRPY INDIC DXS;DURING "_APCLBD_"-"_APCLED,E=$$START1^APCLDF(%,"APCLD(")
.W ?3,"Indication for Anticoag Therapy:"
.S X=0 F S X=$O(APCLD(X)) Q:X'=+X W " ",$P(APCLD(X),U,2)
.W !
MONT ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included on this",!
W "report who had a prescription for Warfarin,",!
W "are within their INR Goal range and were",!
W "monitored this month",?40,$J($$C(APCLRPMI,0,8),12),?55,$$PER(APCLRPMI,APCLRPWR)," (of Rep/War Pop)",!
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included on this",!
W "report who had a prescription for Warfarin,",!
W "are within their INR Goal range but were",!
W "NOT monitored this month",?40,$J($$C(APCLRPNI,0,8),12),?55,$$PER(APCLRPNI,APCLRPWR)," (of Rep/War Pop)",!
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included on this",!
W "report who had a prescription for Warfarin,",!
W "who are NOT within their INR Goal range but",!
W "were monitored this month",?40,$J($$C(APCLRPMN,0,8),12),?55,$$PER(APCLRPMN,APCLRPWR)," (of Rep/War Pop)",!
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included on this",!
W "report who had a prescription for Warfarin,",!
W "who are NOT within their INR Goal range and",!
W "were NOT monitored this month",?40,$J($$C(APCLRPNN,0,8),12),?55,$$PER(APCLRPNN,APCLRPWR)," (of Rep/War Pop)",!
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included on this",!
W "report who had a prescription for Warfarin,",!
W "who were monitored this month but their INR",!
W "in goal status could not be determined",?40,$J($$C(APCLRPMU,0,8),12),?55,$$PER(APCLRPMU,APCLRPWR)," (of Rep/War Pop)",!
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"Number of patients included on this",!
W "report who had a prescription for Warfarin,",!
W "who were NOT monitored this month and their INR",!
W "in goal status could not be determined",?40,$J($$C(APCLRPNU,0,8),12),?55,$$PER(APCLRPNU,APCLRPWR)," (of Rep/War Pop)",!
;
LISTS ;
I '$D(APCLLIST) G DONE
I $D(APCLLIST(1)) D LIST1
G:$D(APCLQUIT) DONE
I $D(APCLLIST(2)) D LIST2
G:$D(APCLQUIT) DONE
I $D(APCLLIST(3)) D LIST3
G:$D(APCLQUIT) DONE
I $D(APCLLIST(4)) D LIST4
G:$D(APCLQUIT) DONE
I $D(APCLLIST(5)) D LIST5
Q:$D(APCLQUIT)
;
DONE ;
Q
LIST1 ;all patient in ^TMP($J,"PATIENTS"
S APCLSHD="Patient Population: All patients in the Report Population"
D HEAD
Q:$D(APCLQUIT)
I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"PATIENTS")) W !!,"No data to report." Q
S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"PATIENTS",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
.W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
.W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
.S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
.W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
.Q
Q
LIST2 ;all patient in ^TMP($J,"PATIENTS"
S APCLSHD="Patient Population: Only patients in INR Goal Range who were monitored this month."
D HEAD
Q:$D(APCLQUIT)
I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT IN RANGE")) W !!,"No data to report." Q
S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT IN RANGE",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
.W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
.W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
.S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
.W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
.Q
Q
LIST3 ;all patient in ^TMP($J,"PATIENTS"
S APCLSHD="Patient Population: Only patients in INR Goal Range who were NOT monitored this month."
D HEAD
Q:$D(APCLQUIT)
I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT IN RANGE")) W !!,"No data to report." Q
S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT IN RANGE",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
.W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
.W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
.S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
.W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
.Q
Q
LIST4 ;all patient in ^TMP($J,"PATIENTS"
S APCLSHD="Patient Population: Only patients NOT in INR Goal Range who were monitored this month."
D HEAD
Q:$D(APCLQUIT)
I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT NOT IN RANGE")) W !!,"No data to report." Q
S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT NOT IN RANGE",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
.W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
.W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
.S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
.W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
.Q
Q
LIST5 ;all patient in ^TMP($J,"PATIENTS"
S APCLSHD="Patient Population: Only patients NOT in INR Goal Range who were NOT monitored this month."
D HEAD
Q:$D(APCLQUIT)
I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT NOT IN RANGE")) W !!,"No data to report." Q
S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT NOT IN RANGE",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
.W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
.W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
.S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
.W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
.Q
Q
LASTINR(P,BD,ED) ;EP
NEW APCLVAL
S APCLVAL=$$LASTLAB^APCLAPIU(P,BD,ED,,$O(^ATXLAB("B","BJPC INR LAB TESTS",0)),,$O(^ATXAX("B","BJPC INR LAB LOINCS",0)),"A","INR")
Q APCLVAL
SUBHEAD2 ;
W !?1,"NAME",?25,"HRN",?32,"DOB",?43,"INR GOAL",?56,"Last INR",?66,"Last INR Date",!?62,"(in rpt period)",!
W APCL80S,!
Q
SUBHEAD1 ;
W !?1,"NAME",?25,"HRN",?32,"DOB",?43,"GOAL INR",?56,"INR Value",?66,"INR Date",!
W APCL80S,!
Q
SUBHEAD3 ;
W !?1,"NAME",?25,"HRN",?32,"DOB",?43,"INR GOAL",?56,"LAST INR",?66,"LAST INR DATE",!,?46,"----- last in report period -----",!
W APCL80S,!
Q
MRGOAL(P) ;PEP - most recent INR goal and date
I $G(P)="" Q ""
I '$D(^AUPNVACG("AA",P)) Q ""
NEW X,Y,D,R,I,Z,S
S R=""
S D=0 F S D=$O(^AUPNVACG("AA",P,D)) Q:D'=+D!(R]"") D
.S X=0 F S X=$O(^AUPNVACG("AA",P,D,X)) Q:X'=+X!(R]"") D
..S I=0 F S I=$O(^AUPNVACG("AA",P,D,X,I)) Q:I'=+I D
...Q:$P($G(^AUPNVACG(I,0)),U,4)=""
...Q:$P($G(^AUPNVACG(I,1)),U,1) ;entered in error
...S Z=$P(^AUPNVACG(I,0),U,4)
...I Z=3 S S=$P(^AUPNVACG(I,0),U,5)_" - "_$P(^AUPNVACG(I,0),U,6)
...I Z'=3 S S=$$VAL^XBDIQ1(9000010.51,I,.04)
...S R=$$VD^APCLV($P(^AUPNVACG(I,0),U,3))_"^"_S
Q R
INRGOAL(P,A) ;EP - inr goal documented on or before this date
I $G(P)="" Q ""
I '$D(^AUPNVACG("AA",P)) Q ""
NEW X,Y,D,R,I,Z,S,J
S R=""
S D=0 F S D=$O(^AUPNVACG("AA",P,D)) Q:D'=+D!(R]"") D
.S X=0 F S X=$O(^AUPNVACG("AA",P,D,X)) Q:X'=+X!(R]"") D
..S I=0 F S I=$O(^AUPNVACG("AA",P,D,X,I)) Q:I'=+I D
...Q:$P($G(^AUPNVACG(I,0)),U,4)=""
...Q:$P($G(^AUPNVACG(I,1)),U,1) ;entered in error
...S J=9999999-X
...I J>A Q
...S Z=$P(^AUPNVACG(I,0),U,4)
...I Z=3 S S=$P(^AUPNVACG(I,0),U,5)_" - "_$P(^AUPNVACG(I,0),U,6)
...I Z'=3 S S=$$VAL^XBDIQ1(9000010.51,I,.04)
...S R=S ;_" ("_$$D1^APCHSACG($$VD^APCLV($P(^AUPNVACG(I,0),U,3)))
Q R
C(X,X2,X3) ;
I $G(X3)="" S X3=12
D COMMA^%DTC
Q $$STRIP^XLFSTR(X," ")
PER(N,D) ;return % of n/d
I 'D Q "0.0%"
NEW Z
S Z=N/D,Z=Z*100,Z=$J(Z,3,1)
Q $$STRIP^XLFSTR(Z," ")_"%"
HEAD I 'APCLPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W $$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
W !,$$CTR($$LOC())
W !!,$$CTR("ANTICOAGULATION INR MANAGEMENT REPORT",80),!
I $G(APCLSHD)]"" W !,"PATIENT LIST",!,$$CTR(APCLSHD),!
W APCL80S,!
I $G(APCLSHD)]"" D SUBHEAD3
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")
;----------
APCLACGM ;IHS/CMI/LAB - A/C monthly report; [ 12/9/2009 19:39 PM ]
+1 ;;2.0;IHS PCC SUITE;**2,5,10,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;
+4 DO PRINT
+5 KILL ^XTMP("APCLACG",APCLJOB,APCLBTH)
+6 KILL APCLJOB,APCLBTH
+7 DO DONE^APCLOSUT
+8 QUIT
PRINT ;
+1 SET APCL80S="-------------------------------------------------------------------------------"
+2 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET APCLDT=Y
+3 SET (APCLPG,APCLAP)=0
+4 KILL APCLQUIT
+5 DO HEAD
+6 ;S (APCLUPWR,APCLUPOP,APCLUPAC,APCLRPOP,APCLRPWR,APCLRPAC)=999999
+7 SET APCLSHD=""
+8 WRITE !,"Date Range:",?40,$$FMTE^XLFDT(APCLBD)," - ",$$FMTE^XLFDT(APCLED),!
+9 WRITE !,"Total Demographics",!
+10 WRITE !,"User Population",?40,$JUSTIFY($$C(APCLUPOP,0,8),12),!
+11 WRITE !,"Number of patients in the User Population",!
+12 WRITE "who had a prescription for Warfarin in the",!
+13 WRITE "45 days prior to ",$$FMTE^XLFDT(APCLED),".",?40,$JUSTIFY($$C(APCLUPWR,0,8),12),?55,$$PER(APCLUPWR,APCLUPOP)," (of User Pop)",!
+14 WRITE !,"Number of patients on Warfarin managed "
+15 WRITE !,"by the Anticoagulation Clinic (had a visit",!,"to Anticoagulation clinic in the ",!,"time period",?40,$JUSTIFY($$C(APCLUPAC,0,8),12),?55,$$PER(APCLUPAC,APCLUPWR)," (of Warfarin Pop)"
+16 IF $Y>(IOSL-8)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
RPTPOP ;report population
+1 WRITE !!,"Report Demographics",!
+2 WRITE !,"Report Population:"
Begin DoDot:1
+3 IF APCLGRP="W"
WRITE ?40,"Warfarin Patients",!
+4 IF APCLGRP="A"
WRITE ?40,"Anticoagulation Clinic Patients",!
Begin DoDot:2
+5 SET X=0
FOR
SET X=$ORDER(APCLACCR(X))
IF X'=+X
QUIT
WRITE ?40,$PIECE(^DIC(40.7,X,0),U),!
End DoDot:2
+6 IF APCLGRP="S"
WRITE ?40,"Search Template: ",!?40,$PIECE(^DIBT(APCLSTMP,0),U),!
+7 IF APCLGRP="I"
WRITE ?40,"iCare Panel: ",!?40,$PIECE(APCLICP,U,3),!
+8 IF APCLGRP="E"
WRITE ?40,"EHR Personal List: ",!?40,$PIECE(APCLICP,U,3),!
End DoDot:1
+9 WRITE !,"Number of patients included on this",!,"report",?40,$JUSTIFY($$C(APCLRPOP,0,8),12),!
+10 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+11 WRITE !,"Number of patients included in this ",!
+12 WRITE "report who had a prescription for Warfarin ",!
+13 WRITE "in the 45 days prior to ",$$FMTE^XLFDT(APCLED),".",?40,$JUSTIFY($$C(APCLRPWR,0,8),12),?55,$$PER(APCLRPWR,APCLRPOP)," (of Report Pop)",!
+14 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+15 WRITE !,"Number of patients on Warfarin managed ",!
+16 WRITE "by the Anticoagulation Clinic (had a visit",!,"to Anticoagulation clinic in the ",!,"time period",?40,$JUSTIFY($$C(APCLRPWA,0,8),12),?55,$$PER(APCLRPWA,APCLRPWR)," (of Warfarin Pop)",!
+17 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+18 WRITE !,"Number of patients included on this",!
+19 WRITE "report who had a prescription for Warfarin",!
+20 WRITE "AND had a documented INR within the 45",!
+21 WRITE "days prior to the end of the report:",?40,$JUSTIFY($$C(APCLRPIN,0,8),12),?55,$$PER(APCLRPIN,APCLRPWR)," (of Rep/INR Pop)",!
+22 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+23 WRITE !,"Number of patients included on this",!
+24 WRITE "report who had a prescription for Warfarin",!
+25 WRITE "AND had an INR value greater than or equal",!
+26 WRITE "to 9.0 during the report date range:",?40,$JUSTIFY($$C(APCLRPI9,0,8),12),?55,$$PER(APCLRPI9,APCLRPIN)," (of Rep/War Pop)",!
+27 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+28 WRITE !?3,"Patients who had an INR > 9 this month:",!
+29 DO SUBHEAD1
+30 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+31 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD1
+32 WRITE ?1,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
+33 SET APCLVD=0
FOR
SET APCLVD=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD))
IF APCLVD=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+34 SET APCLI=0
FOR
SET APCLI=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD,APCLI))
IF APCLI'=+APCLI!($DATA(APCLQUIT))
QUIT
Begin DoDot:3
+35 SET APCLR=^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD,APCLI)
+36 WRITE ?43,$PIECE($$INRGOAL(DFN,APCLED),U,1),?56,APCLR,?66,$$D1^APCHSMU(APCLVD),!
End DoDot:3
End DoDot:2
+37 ;NOW DISPLAY INDICATIONS - ALL DXS IN TIME PERIOD
+38 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD1
+39 KILL APCLD
+40 SET %=DFN_"^ALL DX [BJPC AC THRPY INDIC DXS;DURING "_APCLBD_"-"_APCLED
SET E=$$START1^APCLDF(%,"APCLD(")
+41 WRITE ?3,"Indication for Anticoag Therapy:"
+42 SET X=0
FOR
SET X=$ORDER(APCLD(X))
IF X'=+X
QUIT
WRITE " ",$PIECE(APCLD(X),U,2)
+43 WRITE !
End DoDot:1
VITK ;
+1 IF $Y>(IOSL-8)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!!,"Number of patients included on this",!
+3 WRITE "report who had a prescription for Vitamin K",!
+4 WRITE "during the report date range:",?40,$JUSTIFY($$C(APCLRPVK,0,8),12),?55,$$PER(APCLRPVK,APCLRPWR)," (of Rep/War Pop)",!
+5 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+6 WRITE !?3,"Patients who received Vitamin K this month:",!
+7 DO SUBHEAD2
+8 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"VITK",DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+9 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD2
+10 WRITE !?1,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
+11 WRITE ?43,$PIECE($$INRGOAL(DFN,APCLED),U,1)
+12 SET APCLL=$$LASTINR(DFN,APCLBD,APCLED)
+13 WRITE ?56,$PIECE(APCLL,U,3),?66,$$D1^APCHSMU($PIECE(APCLL,U,1)),!
+14 ;NOW DISPLAY INDICATIONS - ALL DXS IN TIME PERIOD
+15 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD2
+16 WRITE ?3,"Date of Last Vitamin K prescription: ",$$D1^APCHSMU(^XTMP("APCLACG",APCLJOB,APCLBTH,"VITK",DFN)),!
+17 KILL APCLD
+18 SET %=DFN_"^ALL DX [BJPC AC THRPY INDIC DXS;DURING "_APCLBD_"-"_APCLED
SET E=$$START1^APCLDF(%,"APCLD(")
+19 WRITE ?3,"Indication for Anticoag Therapy:"
+20 SET X=0
FOR
SET X=$ORDER(APCLD(X))
IF X'=+X
QUIT
WRITE " ",$PIECE(APCLD(X),U,2)
+21 WRITE !
End DoDot:1
MONT ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !,"Number of patients included on this",!
+3 WRITE "report who had a prescription for Warfarin,",!
+4 WRITE "are within their INR Goal range and were",!
+5 WRITE "monitored this month",?40,$JUSTIFY($$C(APCLRPMI,0,8),12),?55,$$PER(APCLRPMI,APCLRPWR)," (of Rep/War Pop)",!
+6 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+7 WRITE !,"Number of patients included on this",!
+8 WRITE "report who had a prescription for Warfarin,",!
+9 WRITE "are within their INR Goal range but were",!
+10 WRITE "NOT monitored this month",?40,$JUSTIFY($$C(APCLRPNI,0,8),12),?55,$$PER(APCLRPNI,APCLRPWR)," (of Rep/War Pop)",!
+11 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+12 WRITE !,"Number of patients included on this",!
+13 WRITE "report who had a prescription for Warfarin,",!
+14 WRITE "who are NOT within their INR Goal range but",!
+15 WRITE "were monitored this month",?40,$JUSTIFY($$C(APCLRPMN,0,8),12),?55,$$PER(APCLRPMN,APCLRPWR)," (of Rep/War Pop)",!
+16 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+17 WRITE !,"Number of patients included on this",!
+18 WRITE "report who had a prescription for Warfarin,",!
+19 WRITE "who are NOT within their INR Goal range and",!
+20 WRITE "were NOT monitored this month",?40,$JUSTIFY($$C(APCLRPNN,0,8),12),?55,$$PER(APCLRPNN,APCLRPWR)," (of Rep/War Pop)",!
+21 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+22 WRITE !,"Number of patients included on this",!
+23 WRITE "report who had a prescription for Warfarin,",!
+24 WRITE "who were monitored this month but their INR",!
+25 WRITE "in goal status could not be determined",?40,$JUSTIFY($$C(APCLRPMU,0,8),12),?55,$$PER(APCLRPMU,APCLRPWR)," (of Rep/War Pop)",!
+26 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+27 WRITE !,"Number of patients included on this",!
+28 WRITE "report who had a prescription for Warfarin,",!
+29 WRITE "who were NOT monitored this month and their INR",!
+30 WRITE "in goal status could not be determined",?40,$JUSTIFY($$C(APCLRPNU,0,8),12),?55,$$PER(APCLRPNU,APCLRPWR)," (of Rep/War Pop)",!
+31 ;
LISTS ;
+1 IF '$DATA(APCLLIST)
GOTO DONE
+2 IF $DATA(APCLLIST(1))
DO LIST1
+3 IF $DATA(APCLQUIT)
GOTO DONE
+4 IF $DATA(APCLLIST(2))
DO LIST2
+5 IF $DATA(APCLQUIT)
GOTO DONE
+6 IF $DATA(APCLLIST(3))
DO LIST3
+7 IF $DATA(APCLQUIT)
GOTO DONE
+8 IF $DATA(APCLLIST(4))
DO LIST4
+9 IF $DATA(APCLQUIT)
GOTO DONE
+10 IF $DATA(APCLLIST(5))
DO LIST5
+11 IF $DATA(APCLQUIT)
QUIT
+12 ;
DONE ;
+1 QUIT
LIST1 ;all patient in ^TMP($J,"PATIENTS"
+1 SET APCLSHD="Patient Population: All patients in the Report Population"
+2 DO HEAD
+3 IF $DATA(APCLQUIT)
QUIT
+4 IF '$DATA(^XTMP("APCLACG",APCLJOB,APCLBTH,"PATIENTS"))
WRITE !!,"No data to report."
QUIT
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"PATIENTS",DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD3
+7 WRITE !?1,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
+8 WRITE ?43,$PIECE($$INRGOAL(DFN,APCLED),U,1)
+9 SET APCLL=$$LASTINR(DFN,APCLBD,APCLED)
+10 WRITE ?56,$PIECE(APCLL,U,3),?66,$$D1^APCHSMU($PIECE(APCLL,U,1)),!
+11 QUIT
End DoDot:1
+12 QUIT
LIST2 ;all patient in ^TMP($J,"PATIENTS"
+1 SET APCLSHD="Patient Population: Only patients in INR Goal Range who were monitored this month."
+2 DO HEAD
+3 IF $DATA(APCLQUIT)
QUIT
+4 IF '$DATA(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT IN RANGE"))
WRITE !!,"No data to report."
QUIT
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT IN RANGE",DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD3
+7 WRITE !?1,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
+8 WRITE ?43,$PIECE($$INRGOAL(DFN,APCLED),U,1)
+9 SET APCLL=$$LASTINR(DFN,APCLBD,APCLED)
+10 WRITE ?56,$PIECE(APCLL,U,3),?66,$$D1^APCHSMU($PIECE(APCLL,U,1)),!
+11 QUIT
End DoDot:1
+12 QUIT
LIST3 ;all patient in ^TMP($J,"PATIENTS"
+1 SET APCLSHD="Patient Population: Only patients in INR Goal Range who were NOT monitored this month."
+2 DO HEAD
+3 IF $DATA(APCLQUIT)
QUIT
+4 IF '$DATA(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT IN RANGE"))
WRITE !!,"No data to report."
QUIT
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT IN RANGE",DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD3
+7 WRITE !?1,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
+8 WRITE ?43,$PIECE($$INRGOAL(DFN,APCLED),U,1)
+9 SET APCLL=$$LASTINR(DFN,APCLBD,APCLED)
+10 WRITE ?56,$PIECE(APCLL,U,3),?66,$$D1^APCHSMU($PIECE(APCLL,U,1)),!
+11 QUIT
End DoDot:1
+12 QUIT
LIST4 ;all patient in ^TMP($J,"PATIENTS"
+1 SET APCLSHD="Patient Population: Only patients NOT in INR Goal Range who were monitored this month."
+2 DO HEAD
+3 IF $DATA(APCLQUIT)
QUIT
+4 IF '$DATA(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT NOT IN RANGE"))
WRITE !!,"No data to report."
QUIT
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT NOT IN RANGE",DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD3
+7 WRITE !?1,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
+8 WRITE ?43,$PIECE($$INRGOAL(DFN,APCLED),U,1)
+9 SET APCLL=$$LASTINR(DFN,APCLBD,APCLED)
+10 WRITE ?56,$PIECE(APCLL,U,3),?66,$$D1^APCHSMU($PIECE(APCLL,U,1)),!
+11 QUIT
End DoDot:1
+12 QUIT
LIST5 ;all patient in ^TMP($J,"PATIENTS"
+1 SET APCLSHD="Patient Population: Only patients NOT in INR Goal Range who were NOT monitored this month."
+2 DO HEAD
+3 IF $DATA(APCLQUIT)
QUIT
+4 IF '$DATA(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT NOT IN RANGE"))
WRITE !!,"No data to report."
QUIT
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT NOT IN RANGE",DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
DO SUBHEAD3
+7 WRITE !?1,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
+8 WRITE ?43,$PIECE($$INRGOAL(DFN,APCLED),U,1)
+9 SET APCLL=$$LASTINR(DFN,APCLBD,APCLED)
+10 WRITE ?56,$PIECE(APCLL,U,3),?66,$$D1^APCHSMU($PIECE(APCLL,U,1)),!
+11 QUIT
End DoDot:1
+12 QUIT
LASTINR(P,BD,ED) ;EP
+1 NEW APCLVAL
+2 SET APCLVAL=$$LASTLAB^APCLAPIU(P,BD,ED,,$ORDER(^ATXLAB("B","BJPC INR LAB TESTS",0)),,$ORDER(^ATXAX("B","BJPC INR LAB LOINCS",0)),"A","INR")
+3 QUIT APCLVAL
SUBHEAD2 ;
+1 WRITE !?1,"NAME",?25,"HRN",?32,"DOB",?43,"INR GOAL",?56,"Last INR",?66,"Last INR Date",!?62,"(in rpt period)",!
+2 WRITE APCL80S,!
+3 QUIT
SUBHEAD1 ;
+1 WRITE !?1,"NAME",?25,"HRN",?32,"DOB",?43,"GOAL INR",?56,"INR Value",?66,"INR Date",!
+2 WRITE APCL80S,!
+3 QUIT
SUBHEAD3 ;
+1 WRITE !?1,"NAME",?25,"HRN",?32,"DOB",?43,"INR GOAL",?56,"LAST INR",?66,"LAST INR DATE",!,?46,"----- last in report period -----",!
+2 WRITE APCL80S,!
+3 QUIT
MRGOAL(P) ;PEP - most recent INR goal and date
+1 IF $GET(P)=""
QUIT ""
+2 IF '$DATA(^AUPNVACG("AA",P))
QUIT ""
+3 NEW X,Y,D,R,I,Z,S
+4 SET R=""
+5 SET D=0
FOR
SET D=$ORDER(^AUPNVACG("AA",P,D))
IF D'=+D!(R]"")
QUIT
Begin DoDot:1
+6 SET X=0
FOR
SET X=$ORDER(^AUPNVACG("AA",P,D,X))
IF X'=+X!(R]"")
QUIT
Begin DoDot:2
+7 SET I=0
FOR
SET I=$ORDER(^AUPNVACG("AA",P,D,X,I))
IF I'=+I
QUIT
Begin DoDot:3
+8 IF $PIECE($GET(^AUPNVACG(I,0)),U,4)=""
QUIT
+9 ;entered in error
IF $PIECE($GET(^AUPNVACG(I,1)),U,1)
QUIT
+10 SET Z=$PIECE(^AUPNVACG(I,0),U,4)
+11 IF Z=3
SET S=$PIECE(^AUPNVACG(I,0),U,5)_" - "_$PIECE(^AUPNVACG(I,0),U,6)
+12 IF Z'=3
SET S=$$VAL^XBDIQ1(9000010.51,I,.04)
+13 SET R=$$VD^APCLV($PIECE(^AUPNVACG(I,0),U,3))_"^"_S
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT R
INRGOAL(P,A) ;EP - inr goal documented on or before this date
+1 IF $GET(P)=""
QUIT ""
+2 IF '$DATA(^AUPNVACG("AA",P))
QUIT ""
+3 NEW X,Y,D,R,I,Z,S,J
+4 SET R=""
+5 SET D=0
FOR
SET D=$ORDER(^AUPNVACG("AA",P,D))
IF D'=+D!(R]"")
QUIT
Begin DoDot:1
+6 SET X=0
FOR
SET X=$ORDER(^AUPNVACG("AA",P,D,X))
IF X'=+X!(R]"")
QUIT
Begin DoDot:2
+7 SET I=0
FOR
SET I=$ORDER(^AUPNVACG("AA",P,D,X,I))
IF I'=+I
QUIT
Begin DoDot:3
+8 IF $PIECE($GET(^AUPNVACG(I,0)),U,4)=""
QUIT
+9 ;entered in error
IF $PIECE($GET(^AUPNVACG(I,1)),U,1)
QUIT
+10 SET J=9999999-X
+11 IF J>A
QUIT
+12 SET Z=$PIECE(^AUPNVACG(I,0),U,4)
+13 IF Z=3
SET S=$PIECE(^AUPNVACG(I,0),U,5)_" - "_$PIECE(^AUPNVACG(I,0),U,6)
+14 IF Z'=3
SET S=$$VAL^XBDIQ1(9000010.51,I,.04)
+15 ;_" ("_$$D1^APCHSACG($$VD^APCLV($P(^AUPNVACG(I,0),U,3)))
SET R=S
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT R
C(X,X2,X3) ;
+1 IF $GET(X3)=""
SET X3=12
+2 DO COMMA^%DTC
+3 QUIT $$STRIP^XLFSTR(X," ")
PER(N,D) ;return % of n/d
+1 IF 'D
QUIT "0.0%"
+2 NEW Z
+3 SET Z=N/D
SET Z=Z*100
SET Z=$JUSTIFY(Z,3,1)
+4 QUIT $$STRIP^XLFSTR(Z," ")_"%"
HEAD IF 'APCLPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE $$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
+3 WRITE !,$$CTR($$LOC())
+4 WRITE !!,$$CTR("ANTICOAGULATION INR MANAGEMENT REPORT",80),!
+5 IF $GET(APCLSHD)]""
WRITE !,"PATIENT LIST",!,$$CTR(APCLSHD),!
+6 WRITE APCL80S,!
+7 IF $GET(APCLSHD)]""
DO SUBHEAD3
+8 QUIT
+9 ;
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 ;----------
