APCLEM1 ; IHS/CMI/LAB - ; 03 May 2011 5:14 PM
;;2.0;IHS PCC SUITE;**6,7,20**;MAY 14, 2009;Build 25
;
;
START ;
D XIT
D INFORM
GETDATES ;
BD ;
W !!!,"Enter the time frame of interest.",! S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S APCLBD=Y
ED ;
S DIR(0)="DA^::EP",DIR("A")="Enter Ending Visit Date: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
I Y<APCLBD W !,"Ending date must be greater than or equal to beginning date!" G ED
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
PROV ;
K APCLPROV,APCLPRVN,APCLPRVD,APCLOPRV
S APCLPT=""
S DIR(0)="S^O:ONE Primary Care Provider;C:COHORT or Selected Set of Providers (Taxonomy)",DIR("A")="Prepare report for",DIR("B")="O" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G GETDATES
S APCLPT=Y
I APCLPT="C" G PROVC
PROV1 ;
S DIC("A")="Which PROVIDER: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 GETDATES
S APCLPROV(+Y)="",APCLOPRV=+Y
;GET TEAM?
S APCLTEAM=""
S DIR(0)="Y",DIR("A")="Would you like to include statistics for a Primary Care Team",DIR("B")="Y" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) PROV1
G:'Y LOCATION
TEAM ;get team
S APCLTEAM=""
K DIC S DIC="^BSDPCT(",DIC("A")="Enter Primary Care Team: ",DIC(0)="AEMQ" D ^DIC K DIC,DA
I Y=-1 G PROV1
I '$D(^BSDPCT(+Y,1,"B",APCLOPRV)) W !!,$P(^VA(200,APCLOPRV,0),U,1)," is NOT a member of that team, please reselect a team.",!! G TEAM
S APCLTEAM=+Y
G LOCATION
PROVC ;cohort
K APCLPROV
S X="PRIMARY PROVIDER",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
D PEP^AMQQGTX0(+Y,"APCLPROV(")
I '$D(APCLPROV) G PROV
I $D(APCLPROV("*")) W !,"Selecting all providers not allowed with this report" K APCLPROV G PROV
LOCATION ;
W !!,"Enter the Visit Location(s) to be included in the numerator and",!,"denominator visit counts.",!
K APCLLOC
S APCLPT=""
S DIR(0)="S^O:ONE Location of Encounter;C:COHORT or Selected Set of Locations (Taxonomy)",DIR("A")="Which set of Locations",DIR("B")="O" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PROV
S APCLPT=Y
I APCLPT="C" G LOCC
LOC1 ;
S DIC("A")="Which LOCATION: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 LOCATION
S APCLLOC(+Y)=""
G CLINIC
LOCC ;cohort
K APCLLOC
S X="LOCATION OF ENCOUNTER",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
D PEP^AMQQGTX0(+Y,"APCLLOC(")
I '$D(APCLLOC) G LOCATION
I $D(APCLLOC("*")) W !,"Selecting all locations is not allowed with this report" K APCLLOC G LOCC
CLINIC ;
W !!,"Enter the list of clinics that you have determined to be primary care clinics."
W !,"You can enter them 1 at a time or enter a taxonomy using the '[' notation."
K APCLCLIN
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
D PEP^AMQQGTX0(+Y,"APCLCLIN(")
I '$D(APCLCLIN) G LOCATION
I $D(APCLCLIN("*")) W !,"all not allowed with this report" K APCLCLIN G CLINIC
ZIS ;
W !!,"You are currently logged in to division ",$P(^DIC(4,DUZ(2),0),U),!,"Patients must be registered (have a chart at) this location",!,"in order to be included in this report.",!
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G CLINIC
S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) G XIT
I $G(Y)="B" D BROWSE,XIT Q
S XBRP="PRINT^APCLEM1",XBRC="PROC^APCLEM1",XBNS="APCL",XBRX="XIT^APCLEM1"
D ^XBDBQUE
Q
;
XIT ;
D EN^XBVK("APCL")
D KILL^AUPNPAT
D ^XBFMK
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^APCLEM1"")"
S XBNS="APCL",XBRC="PROC^APCLEM1",XBRX="XIT^APCLEM1",XBIOP=0 D ^XBDBQUE
Q
;
PROC ;EP - called from xbdbque
K APCLTOTP,APCLTOTT
K APCLCLNV
K APCLCLTV
K APCLTOTM
S X=0 F S X=$O(APCLCLIN(X)) Q:X'=+X D
.S APCLCLTV($P(^DIC(40.7,X,0),U,1))="0^0",APCLTOTT($P(^DIC(40.7,X,0),U,1))="0^0"
.S Y=0 F S Y=$O(APCLPROV(Y)) Q:Y'=+Y D
..S APCLTOTP(Y)="0^0",APCLTOTP(Y,$P(^DIC(40.7,X,0),U,1))="0^0"
I $G(APCLTEAM) D
.S Y=0 F S Y=$O(^BSDPCT(APCLTEAM,1,"B",Y)) Q:Y'=+Y D
..S X=0 F S X=$O(APCLCLIN(X)) Q:X'=+X S APCLTOTM(Y,$P(^DIC(40.7,X,0),U,1))="0^0",APCLTOTM(Y)="0^0"
NEW A,P,X,C
S APCLTOTV=0,APCLTOTR=0
;APCLTOTP(primary provider ien,clinic or "UNKNOWN"))=# of visits^# of visits to this provider
S APCLSD=APCLSD_".9999" F S APCLSD=$O(^AUPNVSIT("B",APCLSD)) Q:APCLSD=""!((APCLSD\1)>APCLED) D V1
;
Q
V1 ;
S APCLVIEN="" F S APCLVIEN=$O(^AUPNVSIT("B",APCLSD,APCLVIEN)) Q:APCLVIEN'=+APCLVIEN D
.Q:'$D(^AUPNVSIT(APCLVIEN,0))
.Q:$P(^AUPNVSIT(APCLVIEN,0),U,11)
.S APCLDFN=$P(^AUPNVSIT(APCLVIEN,0),U,5)
.Q:APCLDFN=""
.Q:'$D(^AUPNPAT(APCLDFN,0))
.Q:'$D(^DPT(APCLDFN,0))
.Q:'$D(^AUPNPAT(APCLDFN,41,DUZ(2),0)) ;no chart at duz(2)
.S X=0,D=$$VD^APCLV(APCLVIEN)
.S X=$S($P($G(^AUPNPAT(APCLDFN,41,DUZ(2),0)),U,3)="":1,$P($G(^AUPNPAT(APCLDFN,41,DUZ(2),0)),U,3)>D:1,1:0)
.Q:'X ;INACTIVE PATIENT
.S X=0
.S X=$S($P($G(^DPT(APCLDFN,.35)),U)="":1,1:0)
.Q:'X ;deceased patient
.S APCLPP=$P(^AUPNPAT(APCLDFN,0),U,14)
.Q:APCLPP=""
.Q:'$D(APCLPROV(APCLPP)) ;not a designated provider we want so we don't want this visit
.Q:'$D(^AUPNVPOV("AD",APCLVIEN)) ;NO POV, SKIP
.;Q:$$PRIMPROV^APCLV(APCLVIEN,"I")="" ;NO PRIMARY PROVIDER SKIP
.S C=$$CLINIC^APCLV(APCLVIEN)
.Q:'C ;NO CLINIC SO SKIP
.Q:'$D(APCLCLIN(C)) ;NOT A CLINIC OF INTEREST SO SKIP
.S C=$$CLINIC^APCLV(APCLVIEN,"E")
.Q:"EDX"[$P(^AUPNVSIT(APCLVIEN,0),U,7) ;skip chart reviews and telephone calls - PER CJ, INCLUDE THEM
.S F=$P(^AUPNVSIT(APCLVIEN,0),U,6)
.Q:'F
.Q:'$D(APCLLOC(F))
.I $G(APCLTEAM) S $P(APCLTOTM(APCLPP,C),U,1)=$P(APCLTOTM(APCLPP,C),U,1)+1 ;total FOR TEAM LINE THIS CLINIC
.I $G(APCLTEAM) S $P(APCLTOTM(APCLPP),U,1)=$P($G(APCLTOTM(APCLPP)),U,1)+1 ;FOR TEAM LINES
.S $P(APCLTOTP(APCLPP),U,1)=$P($G(APCLTOTP(APCLPP)),U,1)+1 ;TOTAL FOR THIS PROVIDER ALL CLINICS
.S $P(APCLTOTP(APCLPP,C),U,1)=$P($G(APCLTOTP(APCLPP,C)),U,1)+1 ;TOTAL FOR THIS PROVIDER FOR THIS CLINIC
.S $P(APCLTOTT,U,1)=$P($G(APCLTOTT),U,1)+1
.S $P(APCLTOTT(C),U,1)=$P($G(APCLTOTT(C)),U,1)+1
.S APCLTOTV=APCLTOTV+1
.S A=$$PRIMPROV^APCLV(APCLVIEN,"I")
.S APCLGPP=0
.I A,A=APCLPP D
..;I $G(APCLTEAM) S $P(APCLTOTM(APCLPP,C),U,2)=$P($G(APCLTOTM(APCLPP,C)),U,2)+1 ;FOR TEAM DISPLAY
..S $P(APCLTOTP(APCLPP,C),U,2)=$P($G(APCLTOTP(APCLPP,C)),U,2)+1 ;FOR PROVIDER DISPLAY
..S $P(APCLTOTP(APCLPP),U,2)=$P($G(APCLTOTP(APCLPP)),U,2)+1 ;FOR PROVIDER DISPLAY TOTAL LINE
..S APCLTOTR=APCLTOTR+1
.I A,$G(APCLTEAM) D
..Q:'$D(^BSDPCT(APCLTEAM,1,"B",A)) ;not on the team
..S $P(APCLTOTM(A,C),U,2)=$P(APCLTOTM(A,C),U,2)+1 ;FOR TOTAL LINE FOR CLINIC FOR MEMBER
..S $P(APCLTOTM(A),U,2)=$P($G(APCLTOTM(A)),U,2)+1 ;FOR TOTAL LINE FOR MEMBER
..;S $P(APCLTOTM($P(^VA(200,A,0),U,1)),U,3)=$$VAL^XBDIQ1(200,A,53.5)
..;S $P(APCLTOTM($P(^VA(200,A,0),U,1)),U,1)=$P($G(APCLTOTP(APCLOPRV,C)),U,1)
..S $P(APCLTOTT(C),U,2)=$P($G(APCLTOTT(C)),U,2)+1
..S $P(APCLTOTT,U,2)=$P($G(APCLTOTT),U,2)+1
..S APCLGPP=1
.;NOW CHECK SECONDARY FOR TEAM
.Q:APCLGPP
.S X=0,G=0 F S X=$O(^AUPNVPRV("AD",APCLVIEN,X)) Q:X'=+X!(G) D
..Q:'$D(^AUPNVPRV(X,0))
..Q:$P(^AUPNVPRV(X,0),U,4)="P"
..S P=$$VALI^XBDIQ1(9000010.06,X,.01)
..I P,$G(APCLTEAM) D
...Q:'$D(^BSDPCT(APCLTEAM,1,"B",P)) ;not on team
...;W !,$$VAL^XBDIQ1(9000010.06,X,.01)," ",APCLVIEN
...S $P(APCLTOTM($$VALI^XBDIQ1(9000010.06,X,.01),C),U,2)=$P($G(APCLTOTM($$VALI^XBDIQ1(9000010.06,X,.01),C)),U,2)+1
...S $P(APCLTOTM($$VALI^XBDIQ1(9000010.06,X,.01)),U,2)=$P($G(APCLTOTM($$VALI^XBDIQ1(9000010.06,X,.01))),U,2)+1
...;S $P(APCLTOTM($$VAL^XBDIQ1(9000010.06,X,.01)),U,3)=$$VAL^XBDIQ1(200,$$VALI^XBDIQ1(9000010.06,X,.01),53.5)
...;S $P(APCLTOTM($$VAL^XBDIQ1(9000010.06,X,.01)),U,1)=$P($G(APCLTOTP(APCLOPRV,C)),U,1)
...S $P(APCLTOTT(C),U,2)=$P($G(APCLTOTT(C)),U,2)+1
...S $P(APCLTOTT,U,2)=$P($G(APCLTOTT),U,2)+1
...S G=1
Q
PRINT ;
;I DUZ=2881 W BOMB
K APCLQUIT
S APCLPG=0
D HEADER
S APCLPP=0 F S APCLPP=$O(APCLTOTP(APCLPP)) Q:APCLPP'=+APCLPP!($D(APCLQUIT)) D
.I $Y>(IOSL-4) D HEADER Q:$D(APCLQUIT)
.W !,$P(^VA(200,APCLPP,0),U,1)," (",$$VAL^XBDIQ1(200,APCLPP,53.5),")",!
.S APCLC=0 F S APCLC=$O(APCLTOTP(APCLPP,APCLC)) Q:APCLC=""!($D(APCLQUIT)) D
..I $Y>(IOSL-4) D HEADER Q:$D(APCLQUIT)
..W ?3,APCLC,?42,$$C($P(APCLTOTP(APCLPP,APCLC),U,2),0),?57,$$C($P(APCLTOTP(APCLPP,APCLC),U,1),0),?72,$$PER($P(APCLTOTP(APCLPP,APCLC),U,2),$P(APCLTOTP(APCLPP,APCLC),U,1)),!
.W "Total for ",$E($P(^VA(200,APCLPP,0),U,1),1,30),?42,$$C($P(APCLTOTP(APCLPP),U,2),0),?57,$$C($P(APCLTOTP(APCLPP),U,1),0),?72,$$PER($P(APCLTOTP(APCLPP),U,2),$P(APCLTOTP(APCLPP),U,1)),!
Q:$D(APCLQUIT)
I $Y>(IOSL-4) D HEADER Q:$D(APCLQUIT)
I '$G(APCLTEAM) W !!,"Total:",?42,$$C(APCLTOTR,0),?57,$$C(APCLTOTV,0),?72,$$PER(APCLTOTR,APCLTOTV),!
Q:'$G(APCLTEAM)
I $Y>(IOSL-4) D HEADER Q:$D(APCLQUIT)
W !,$P(^BSDPCT(APCLTEAM,0),U,1)," Members"
S APCLPP="" F S APCLPP=$O(APCLTOTM(APCLPP)) Q:APCLPP=""!($D(APCLQUIT)) D
.I $Y>(IOSL-4) D HEADER Q:$D(APCLQUIT)
.W !,$P(^VA(200,APCLPP,0),U,1)," (",$$VAL^XBDIQ1(200,APCLPP,53.5),")",!
.S APCLC="" F S APCLC=$O(APCLTOTM(APCLPP,APCLC)) Q:APCLC=""!($D(APCLQUIT)) D
..I $Y>(IOSL-4) D HEADER Q:$D(APCLQUIT)
..W ?3,APCLC,?42,$$C($P(APCLTOTM(APCLPP,APCLC),U,2),0),?57,$$C($P(APCLTOTT(APCLC),U,1),0),?72,$$PER($P(APCLTOTM(APCLPP,APCLC),U,2),$P(APCLTOTT(APCLC),U,1)),!
.W "Total for ",$P(^VA(200,APCLPP,0),U,1),?42,$$C($P(APCLTOTM(APCLPP),U,2),0),?57,$$C($P(APCLTOTT,U,1),0),?72,$$PER($P(APCLTOTM(APCLPP),U,2),$P(APCLTOTT,U,1)),!
W !,$P(^BSDPCT(APCLTEAM,0),U,1)," Team",!
S APCLC=0 F S APCLC=$O(APCLTOTT(APCLC)) Q:APCLC=""!($D(APCLQUIT)) D
.I $Y>(IOSL-3) D HEADER Q:$D(APCLQUIT)
.W ?3,APCLC,?42,$$C($P(APCLTOTT(APCLC),U,2),0),?57,$$C($P(APCLTOTT(APCLC),U,1),0),?72,$$PER($P(APCLTOTT(APCLC),U,2),$P(APCLTOTT(APCLC),U,1)),!
W "Total for ",$E($P(^BSDPCT(APCLTEAM,0),U,1),1,20),?42,$$C($P(APCLTOTT,U,2),0),?57,$$C($P(APCLTOTT,U,1),0),?72,$$PER($P(APCLTOTT,U,2),$P(APCLTOTT,U,1)),!
Q
PER(N,D) ;EP - return % of n/d
I 'D Q "0%"
NEW Z
S Z=N/D,Z=Z*100,Z=$J(Z,3,0)
Q $$STRIP^XLFSTR(Z," ")_"%"
C(X,X2,X3) ;EP
D COMMA^%DTC
Q $J($$STRIP^XLFSTR(X," "),7)
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 ;
I APCLPG W:$D(IOF) @IOF
S APCLPG=APCLPG+1
W !,$$CTR($$FMTE^XLFDT(DT),80),?70,"Page ",APCLPG,!
W $$CTR($$LOC,80),!
W $$CTR("Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" - "_$$FMTE^XLFDT(APCLED),80),!
I $G(APCLTEAM) D
.W $$CTR("Primary Care Team: "_$P(^BSDPCT(APCLTEAM,0),U,1),80),!
.S X=0,APCLX="",APCLC1=0 F S X=$O(^BSDPCT(APCLTEAM,1,"B",X)) Q:X'=+X S APCLC1=APCLC1+1
.S X=0,APCLX="",C=0 F S X=$O(^BSDPCT(APCLTEAM,1,"B",X)) Q:X'=+X!(C>2) S C=C+1,APCLX=APCLX_$S(APCLX]"":";",1:"")_$P(^VA(200,X,0),U)
.W $$CTR("Team Members: "_APCLX,80),!
.I APCLC1>3 D
..S X=0,APCLX="",C=0 F S X=$O(^BSDPCT(APCLTEAM,1,"B",X)) Q:X'=+X S C=C+1 I C>3 S APCLX=APCLX_$S(APCLX]"":";",1:"")_$P(^VA(200,X,0),U)
..W $$CTR("Team Members: "_APCLX,80),!
W "PROVIDER/CLINIC",?42,"Numerator",?57,"Denominator",?72,"%",!
W $$REPEAT^XLFSTR("-",79),!
Q
INFORM ;tell user what is going on
W:$D(IOF) @IOF
W $$CTR("******* CONTINUITY OF CARE TO A PRIMARY CARE PROVIDER ******",80)
W !,"This report measures the continuity of care to a designated"
W !,"primary care provider."
W !,"The continuity of care measures the number of times that a patient saw their"
W !,"own designated primary care provider in a primary care clinic setting. "
W !!,"Numerator: The number of times that a patient saw their designated primary"
W !,"care provider in a primary care clinic setting."
W !,"Denominator: The number of times that a patient has been seen by any provider"
W !,"in a primary care clinic setting."
W !!,"If you include Team statistics:"
W !,"Numerator: The number of times that a patient saw any member of the team"
W !," as either a primary or secondary provider."
W !,"Denominator: The number of times that a patient was seen by any provider."
W !,"This report should be run for one division at a time if you are operating"
W !,"on a multi-divisional database."
W !,"The user will be prompted to enter the following information:"
W !?5,"- The designated primary care provider(s)"
W !?5,"- If one primary care provider is chosen, the user may indicate a team"
W !?5,"- The date range for visit selection"
W !?5,"- The location(s) of encounter for visit selection. You may choose one or"
W !?10,"locations or facilities where the provider provides services."
W !?5,"- The set of clinics you have determined to be 'Primary' clinics."
W !?10,"A taxonomy or group of these clinics can be created for later use"
W !,"In order to be included in the denominator the visit must be a "
W !,"complete visit (have a POV and a provider.)"
W !,"Inactive and deceased patients are excluded."
D PAUSE^APCLVL01
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("A")="End of Report. Press return",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")
;----------
;
POST ;EP
S X=$$ADD^XPDMENU("APCLMENU","APCL IPC REPORTS MENU","IPC")
S X=$$ADD^XPDMENU("APCL IPC REPORTS MENU","BDPMENU","BDP")
S X=$$ADD^XPDMENU("APCL IPC REPORTS MENU","BSD MENU PRIMARY CARE","PCP")
Q
APCLEM1 ; IHS/CMI/LAB - ; 03 May 2011 5:14 PM
+1 ;;2.0;IHS PCC SUITE;**6,7,20**;MAY 14, 2009;Build 25
+2 ;
+3 ;
START ;
+1 DO XIT
+2 DO INFORM
GETDATES ;
BD ;
+1 WRITE !!!,"Enter the time frame of interest.",!
SET DIR(0)="D^::EP"
SET DIR("A")="Enter Beginning Visit Date"
SET DIR("?")="Enter the beginning visit date for the search."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET APCLBD=Y
ED ;
+1 SET DIR(0)="DA^::EP"
SET DIR("A")="Enter Ending Visit Date: "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF Y<APCLBD
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET APCLED=Y
+5 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
PROV ;
+1 KILL APCLPROV,APCLPRVN,APCLPRVD,APCLOPRV
+2 SET APCLPT=""
+3 SET DIR(0)="S^O:ONE Primary Care Provider;C:COHORT or Selected Set of Providers (Taxonomy)"
SET DIR("A")="Prepare report for"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO GETDATES
+5 SET APCLPT=Y
+6 IF APCLPT="C"
GOTO PROVC
PROV1 ;
+1 SET DIC("A")="Which PROVIDER: "
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
GOTO GETDATES
+2 SET APCLPROV(+Y)=""
SET APCLOPRV=+Y
+3 ;GET TEAM?
+4 SET APCLTEAM=""
+5 SET DIR(0)="Y"
SET DIR("A")="Would you like to include statistics for a Primary Care Team"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO PROV1
+7 IF 'Y
GOTO LOCATION
TEAM ;get team
+1 SET APCLTEAM=""
+2 KILL DIC
SET DIC="^BSDPCT("
SET DIC("A")="Enter Primary Care Team: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
+3 IF Y=-1
GOTO PROV1
+4 IF '$DATA(^BSDPCT(+Y,1,"B",APCLOPRV))
WRITE !!,$PIECE(^VA(200,APCLOPRV,0),U,1)," is NOT a member of that team, please reselect a team.",!!
GOTO TEAM
+5 SET APCLTEAM=+Y
+6 GOTO LOCATION
PROVC ;cohort
+1 KILL APCLPROV
+2 SET X="PRIMARY PROVIDER"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+3 DO PEP^AMQQGTX0(+Y,"APCLPROV(")
+4 IF '$DATA(APCLPROV)
GOTO PROV
+5 IF $DATA(APCLPROV("*"))
WRITE !,"Selecting all providers not allowed with this report"
KILL APCLPROV
GOTO PROV
LOCATION ;
+1 WRITE !!,"Enter the Visit Location(s) to be included in the numerator and",!,"denominator visit counts.",!
+2 KILL APCLLOC
+3 SET APCLPT=""
+4 SET DIR(0)="S^O:ONE Location of Encounter;C:COHORT or Selected Set of Locations (Taxonomy)"
SET DIR("A")="Which set of Locations"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO PROV
+6 SET APCLPT=Y
+7 IF APCLPT="C"
GOTO LOCC
LOC1 ;
+1 SET DIC("A")="Which LOCATION: "
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
GOTO LOCATION
+2 SET APCLLOC(+Y)=""
+3 GOTO CLINIC
LOCC ;cohort
+1 KILL APCLLOC
+2 SET X="LOCATION OF ENCOUNTER"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+3 DO PEP^AMQQGTX0(+Y,"APCLLOC(")
+4 IF '$DATA(APCLLOC)
GOTO LOCATION
+5 IF $DATA(APCLLOC("*"))
WRITE !,"Selecting all locations is not allowed with this report"
KILL APCLLOC
GOTO LOCC
CLINIC ;
+1 WRITE !!,"Enter the list of clinics that you have determined to be primary care clinics."
+2 WRITE !,"You can enter them 1 at a time or enter a taxonomy using the '[' notation."
+3 KILL APCLCLIN
+4 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+5 DO PEP^AMQQGTX0(+Y,"APCLCLIN(")
+6 IF '$DATA(APCLCLIN)
GOTO LOCATION
+7 IF $DATA(APCLCLIN("*"))
WRITE !,"all not allowed with this report"
KILL APCLCLIN
GOTO CLINIC
ZIS ;
+1 WRITE !!,"You are currently logged in to division ",$PIECE(^DIC(4,DUZ(2),0),U),!,"Patients must be registered (have a chart at) this location",!,"in order to be included in this report.",!
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO CLINIC
+3 SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to "
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO XIT
+5 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+6 SET XBRP="PRINT^APCLEM1"
SET XBRC="PROC^APCLEM1"
SET XBNS="APCL"
SET XBRX="XIT^APCLEM1"
+7 DO ^XBDBQUE
+8 QUIT
+9 ;
XIT ;
+1 DO EN^XBVK("APCL")
+2 DO KILL^AUPNPAT
+3 DO ^XBFMK
+4 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^APCLEM1"")"
+2 SET XBNS="APCL"
SET XBRC="PROC^APCLEM1"
SET XBRX="XIT^APCLEM1"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
+4 ;
PROC ;EP - called from xbdbque
+1 KILL APCLTOTP,APCLTOTT
+2 KILL APCLCLNV
+3 KILL APCLCLTV
+4 KILL APCLTOTM
+5 SET X=0
FOR
SET X=$ORDER(APCLCLIN(X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET APCLCLTV($PIECE(^DIC(40.7,X,0),U,1))="0^0"
SET APCLTOTT($PIECE(^DIC(40.7,X,0),U,1))="0^0"
+7 SET Y=0
FOR
SET Y=$ORDER(APCLPROV(Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+8 SET APCLTOTP(Y)="0^0"
SET APCLTOTP(Y,$PIECE(^DIC(40.7,X,0),U,1))="0^0"
End DoDot:2
End DoDot:1
+9 IF $GET(APCLTEAM)
Begin DoDot:1
+10 SET Y=0
FOR
SET Y=$ORDER(^BSDPCT(APCLTEAM,1,"B",Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+11 SET X=0
FOR
SET X=$ORDER(APCLCLIN(X))
IF X'=+X
QUIT
SET APCLTOTM(Y,$PIECE(^DIC(40.7,X,0),U,1))="0^0"
SET APCLTOTM(Y)="0^0"
End DoDot:2
End DoDot:1
+12 NEW A,P,X,C
+13 SET APCLTOTV=0
SET APCLTOTR=0
+14 ;APCLTOTP(primary provider ien,clinic or "UNKNOWN"))=# of visits^# of visits to this provider
+15 SET APCLSD=APCLSD_".9999"
FOR
SET APCLSD=$ORDER(^AUPNVSIT("B",APCLSD))
IF APCLSD=""!((APCLSD\1)>APCLED)
QUIT
DO V1
+16 ;
+17 QUIT
V1 ;
+1 SET APCLVIEN=""
FOR
SET APCLVIEN=$ORDER(^AUPNVSIT("B",APCLSD,APCLVIEN))
IF APCLVIEN'=+APCLVIEN
QUIT
Begin DoDot:1
+2 IF '$DATA(^AUPNVSIT(APCLVIEN,0))
QUIT
+3 IF $PIECE(^AUPNVSIT(APCLVIEN,0),U,11)
QUIT
+4 SET APCLDFN=$PIECE(^AUPNVSIT(APCLVIEN,0),U,5)
+5 IF APCLDFN=""
QUIT
+6 IF '$DATA(^AUPNPAT(APCLDFN,0))
QUIT
+7 IF '$DATA(^DPT(APCLDFN,0))
QUIT
+8 ;no chart at duz(2)
IF '$DATA(^AUPNPAT(APCLDFN,41,DUZ(2),0))
QUIT
+9 SET X=0
SET D=$$VD^APCLV(APCLVIEN)
+10 SET X=$SELECT($PIECE($GET(^AUPNPAT(APCLDFN,41,DUZ(2),0)),U,3)="":1,$PIECE($GET(^AUPNPAT(APCLDFN,41,DUZ(2),0)),U,3)>D:1,1:0)
+11 ;INACTIVE PATIENT
IF 'X
QUIT
+12 SET X=0
+13 SET X=$SELECT($PIECE($GET(^DPT(APCLDFN,.35)),U)="":1,1:0)
+14 ;deceased patient
IF 'X
QUIT
+15 SET APCLPP=$PIECE(^AUPNPAT(APCLDFN,0),U,14)
+16 IF APCLPP=""
QUIT
+17 ;not a designated provider we want so we don't want this visit
IF '$DATA(APCLPROV(APCLPP))
QUIT
+18 ;NO POV, SKIP
IF '$DATA(^AUPNVPOV("AD",APCLVIEN))
QUIT
+19 ;Q:$$PRIMPROV^APCLV(APCLVIEN,"I")="" ;NO PRIMARY PROVIDER SKIP
+20 SET C=$$CLINIC^APCLV(APCLVIEN)
+21 ;NO CLINIC SO SKIP
IF 'C
QUIT
+22 ;NOT A CLINIC OF INTEREST SO SKIP
IF '$DATA(APCLCLIN(C))
QUIT
+23 SET C=$$CLINIC^APCLV(APCLVIEN,"E")
+24 ;skip chart reviews and telephone calls - PER CJ, INCLUDE THEM
IF "EDX"[$PIECE(^AUPNVSIT(APCLVIEN,0),U,7)
QUIT
+25 SET F=$PIECE(^AUPNVSIT(APCLVIEN,0),U,6)
+26 IF 'F
QUIT
+27 IF '$DATA(APCLLOC(F))
QUIT
+28 ;total FOR TEAM LINE THIS CLINIC
IF $GET(APCLTEAM)
SET $PIECE(APCLTOTM(APCLPP,C),U,1)=$PIECE(APCLTOTM(APCLPP,C),U,1)+1
+29 ;FOR TEAM LINES
IF $GET(APCLTEAM)
SET $PIECE(APCLTOTM(APCLPP),U,1)=$PIECE($GET(APCLTOTM(APCLPP)),U,1)+1
+30 ;TOTAL FOR THIS PROVIDER ALL CLINICS
SET $PIECE(APCLTOTP(APCLPP),U,1)=$PIECE($GET(APCLTOTP(APCLPP)),U,1)+1
+31 ;TOTAL FOR THIS PROVIDER FOR THIS CLINIC
SET $PIECE(APCLTOTP(APCLPP,C),U,1)=$PIECE($GET(APCLTOTP(APCLPP,C)),U,1)+1
+32 SET $PIECE(APCLTOTT,U,1)=$PIECE($GET(APCLTOTT),U,1)+1
+33 SET $PIECE(APCLTOTT(C),U,1)=$PIECE($GET(APCLTOTT(C)),U,1)+1
+34 SET APCLTOTV=APCLTOTV+1
+35 SET A=$$PRIMPROV^APCLV(APCLVIEN,"I")
+36 SET APCLGPP=0
+37 IF A
IF A=APCLPP
Begin DoDot:2
+38 ;I $G(APCLTEAM) S $P(APCLTOTM(APCLPP,C),U,2)=$P($G(APCLTOTM(APCLPP,C)),U,2)+1 ;FOR TEAM DISPLAY
+39 ;FOR PROVIDER DISPLAY
SET $PIECE(APCLTOTP(APCLPP,C),U,2)=$PIECE($GET(APCLTOTP(APCLPP,C)),U,2)+1
+40 ;FOR PROVIDER DISPLAY TOTAL LINE
SET $PIECE(APCLTOTP(APCLPP),U,2)=$PIECE($GET(APCLTOTP(APCLPP)),U,2)+1
+41 SET APCLTOTR=APCLTOTR+1
End DoDot:2
+42 IF A
IF $GET(APCLTEAM)
Begin DoDot:2
+43 ;not on the team
IF '$DATA(^BSDPCT(APCLTEAM,1,"B",A))
QUIT
+44 ;FOR TOTAL LINE FOR CLINIC FOR MEMBER
SET $PIECE(APCLTOTM(A,C),U,2)=$PIECE(APCLTOTM(A,C),U,2)+1
+45 ;FOR TOTAL LINE FOR MEMBER
SET $PIECE(APCLTOTM(A),U,2)=$PIECE($GET(APCLTOTM(A)),U,2)+1
+46 ;S $P(APCLTOTM($P(^VA(200,A,0),U,1)),U,3)=$$VAL^XBDIQ1(200,A,53.5)
+47 ;S $P(APCLTOTM($P(^VA(200,A,0),U,1)),U,1)=$P($G(APCLTOTP(APCLOPRV,C)),U,1)
+48 SET $PIECE(APCLTOTT(C),U,2)=$PIECE($GET(APCLTOTT(C)),U,2)+1
+49 SET $PIECE(APCLTOTT,U,2)=$PIECE($GET(APCLTOTT),U,2)+1
+50 SET APCLGPP=1
End DoDot:2
+51 ;NOW CHECK SECONDARY FOR TEAM
+52 IF APCLGPP
QUIT
+53 SET X=0
SET G=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",APCLVIEN,X))
IF X'=+X!(G)
QUIT
Begin DoDot:2
+54 IF '$DATA(^AUPNVPRV(X,0))
QUIT
+55 IF $PIECE(^AUPNVPRV(X,0),U,4)="P"
QUIT
+56 SET P=$$VALI^XBDIQ1(9000010.06,X,.01)
+57 IF P
IF $GET(APCLTEAM)
Begin DoDot:3
+58 ;not on team
IF '$DATA(^BSDPCT(APCLTEAM,1,"B",P))
QUIT
+59 ;W !,$$VAL^XBDIQ1(9000010.06,X,.01)," ",APCLVIEN
+60 SET $PIECE(APCLTOTM($$VALI^XBDIQ1(9000010.06,X,.01),C),U,2)=$PIECE($GET(APCLTOTM($$VALI^XBDIQ1(9000010.06,X,.01),C)),U,2)+1
+61 SET $PIECE(APCLTOTM($$VALI^XBDIQ1(9000010.06,X,.01)),U,2)=$PIECE($GET(APCLTOTM($$VALI^XBDIQ1(9000010.06,X,.01))),U,2)+1
+62 ;S $P(APCLTOTM($$VAL^XBDIQ1(9000010.06,X,.01)),U,3)=$$VAL^XBDIQ1(200,$$VALI^XBDIQ1(9000010.06,X,.01),53.5)
+63 ;S $P(APCLTOTM($$VAL^XBDIQ1(9000010.06,X,.01)),U,1)=$P($G(APCLTOTP(APCLOPRV,C)),U,1)
+64 SET $PIECE(APCLTOTT(C),U,2)=$PIECE($GET(APCLTOTT(C)),U,2)+1
+65 SET $PIECE(APCLTOTT,U,2)=$PIECE($GET(APCLTOTT),U,2)+1
+66 SET G=1
End DoDot:3
End DoDot:2
End DoDot:1
+67 QUIT
PRINT ;
+1 ;I DUZ=2881 W BOMB
+2 KILL APCLQUIT
+3 SET APCLPG=0
+4 DO HEADER
+5 SET APCLPP=0
FOR
SET APCLPP=$ORDER(APCLTOTP(APCLPP))
IF APCLPP'=+APCLPP!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(APCLQUIT)
QUIT
+7 WRITE !,$PIECE(^VA(200,APCLPP,0),U,1)," (",$$VAL^XBDIQ1(200,APCLPP,53.5),")",!
+8 SET APCLC=0
FOR
SET APCLC=$ORDER(APCLTOTP(APCLPP,APCLC))
IF APCLC=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+9 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(APCLQUIT)
QUIT
+10 WRITE ?3,APCLC,?42,$$C($PIECE(APCLTOTP(APCLPP,APCLC),U,2),0),?57,$$C($PIECE(APCLTOTP(APCLPP,APCLC),U,1),0),?72,$$PER($PIECE(APCLTOTP(APCLPP,APCLC),U,2),$PIECE(APCLTOTP(APCLPP,APCLC),U,1)),!
End DoDot:2
+11 WRITE "Total for ",$EXTRACT($PIECE(^VA(200,APCLPP,0),U,1),1,30),?42,$$C($PIECE(APCLTOTP(APCLPP),U,2),0),?57,$$C($PIECE(APCLTOTP(APCLPP),U,1),0),?72,$$PER($PIECE(APCLTOTP(APCLPP),U,2),$PIECE(APCLTOTP(APCLPP),U,1)),!
End DoDot:1
+12 IF $DATA(APCLQUIT)
QUIT
+13 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(APCLQUIT)
QUIT
+14 IF '$GET(APCLTEAM)
WRITE !!,"Total:",?42,$$C(APCLTOTR,0),?57,$$C(APCLTOTV,0),?72,$$PER(APCLTOTR,APCLTOTV),!
+15 IF '$GET(APCLTEAM)
QUIT
+16 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(APCLQUIT)
QUIT
+17 WRITE !,$PIECE(^BSDPCT(APCLTEAM,0),U,1)," Members"
+18 SET APCLPP=""
FOR
SET APCLPP=$ORDER(APCLTOTM(APCLPP))
IF APCLPP=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+19 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(APCLQUIT)
QUIT
+20 WRITE !,$PIECE(^VA(200,APCLPP,0),U,1)," (",$$VAL^XBDIQ1(200,APCLPP,53.5),")",!
+21 SET APCLC=""
FOR
SET APCLC=$ORDER(APCLTOTM(APCLPP,APCLC))
IF APCLC=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+22 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(APCLQUIT)
QUIT
+23 WRITE ?3,APCLC,?42,$$C($PIECE(APCLTOTM(APCLPP,APCLC),U,2),0),?57,$$C($PIECE(APCLTOTT(APCLC),U,1),0),?72,$$PER($PIECE(APCLTOTM(APCLPP,APCLC),U,2),$PIECE(APCLTOTT(APCLC),U,1)),!
End DoDot:2
+24 WRITE "Total for ",$PIECE(^VA(200,APCLPP,0),U,1),?42,$$C($PIECE(APCLTOTM(APCLPP),U,2),0),?57,$$C($PIECE(APCLTOTT,U,1),0),?72,$$PER($PIECE(APCLTOTM(APCLPP),U,2),$PIECE(APCLTOTT,U,1)),!
End DoDot:1
+25 WRITE !,$PIECE(^BSDPCT(APCLTEAM,0),U,1)," Team",!
+26 SET APCLC=0
FOR
SET APCLC=$ORDER(APCLTOTT(APCLC))
IF APCLC=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+27 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(APCLQUIT)
QUIT
+28 WRITE ?3,APCLC,?42,$$C($PIECE(APCLTOTT(APCLC),U,2),0),?57,$$C($PIECE(APCLTOTT(APCLC),U,1),0),?72,$$PER($PIECE(APCLTOTT(APCLC),U,2),$PIECE(APCLTOTT(APCLC),U,1)),!
End DoDot:1
+29 WRITE "Total for ",$EXTRACT($PIECE(^BSDPCT(APCLTEAM,0),U,1),1,20),?42,$$C($PIECE(APCLTOTT,U,2),0),?57,$$C($PIECE(APCLTOTT,U,1),0),?72,$$PER($PIECE(APCLTOTT,U,2),$PIECE(APCLTOTT,U,1)),!
+30 QUIT
PER(N,D) ;EP - return % of n/d
+1 IF 'D
QUIT "0%"
+2 NEW Z
+3 SET Z=N/D
SET Z=Z*100
SET Z=$JUSTIFY(Z,3,0)
+4 QUIT $$STRIP^XLFSTR(Z," ")_"%"
C(X,X2,X3) ;EP
+1 DO COMMA^%DTC
+2 QUIT $JUSTIFY($$STRIP^XLFSTR(X," "),7)
+1 IF 'APCLPG
GOTO HEAD1
+2 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 APCLPG
IF $DATA(IOF)
WRITE @IOF
+2 SET APCLPG=APCLPG+1
+3 WRITE !,$$CTR($$FMTE^XLFDT(DT),80),?70,"Page ",APCLPG,!
+4 WRITE $$CTR($$LOC,80),!
+5 WRITE $$CTR("Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" - "_$$FMTE^XLFDT(APCLED),80),!
+6 IF $GET(APCLTEAM)
Begin DoDot:1
+7 WRITE $$CTR("Primary Care Team: "_$PIECE(^BSDPCT(APCLTEAM,0),U,1),80),!
+8 SET X=0
SET APCLX=""
SET APCLC1=0
FOR
SET X=$ORDER(^BSDPCT(APCLTEAM,1,"B",X))
IF X'=+X
QUIT
SET APCLC1=APCLC1+1
+9 SET X=0
SET APCLX=""
SET C=0
FOR
SET X=$ORDER(^BSDPCT(APCLTEAM,1,"B",X))
IF X'=+X!(C>2)
QUIT
SET C=C+1
SET APCLX=APCLX_$SELECT(APCLX]"":";",1:"")_$PIECE(^VA(200,X,0),U)
+10 WRITE $$CTR("Team Members: "_APCLX,80),!
+11 IF APCLC1>3
Begin DoDot:2
+12 SET X=0
SET APCLX=""
SET C=0
FOR
SET X=$ORDER(^BSDPCT(APCLTEAM,1,"B",X))
IF X'=+X
QUIT
SET C=C+1
IF C>3
SET APCLX=APCLX_$SELECT(APCLX]"":";",1:"")_$PIECE(^VA(200,X,0),U)
+13 WRITE $$CTR("Team Members: "_APCLX,80),!
End DoDot:2
End DoDot:1
+14 WRITE "PROVIDER/CLINIC",?42,"Numerator",?57,"Denominator",?72,"%",!
+15 WRITE $$REPEAT^XLFSTR("-",79),!
+16 QUIT
INFORM ;tell user what is going on
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE $$CTR("******* CONTINUITY OF CARE TO A PRIMARY CARE PROVIDER ******",80)
+3 WRITE !,"This report measures the continuity of care to a designated"
+4 WRITE !,"primary care provider."
+5 WRITE !,"The continuity of care measures the number of times that a patient saw their"
+6 WRITE !,"own designated primary care provider in a primary care clinic setting. "
+7 WRITE !!,"Numerator: The number of times that a patient saw their designated primary"
+8 WRITE !,"care provider in a primary care clinic setting."
+9 WRITE !,"Denominator: The number of times that a patient has been seen by any provider"
+10 WRITE !,"in a primary care clinic setting."
+11 WRITE !!,"If you include Team statistics:"
+12 WRITE !,"Numerator: The number of times that a patient saw any member of the team"
+13 WRITE !," as either a primary or secondary provider."
+14 WRITE !,"Denominator: The number of times that a patient was seen by any provider."
+15 WRITE !,"This report should be run for one division at a time if you are operating"
+16 WRITE !,"on a multi-divisional database."
+17 WRITE !,"The user will be prompted to enter the following information:"
+18 WRITE !?5,"- The designated primary care provider(s)"
+19 WRITE !?5,"- If one primary care provider is chosen, the user may indicate a team"
+20 WRITE !?5,"- The date range for visit selection"
+21 WRITE !?5,"- The location(s) of encounter for visit selection. You may choose one or"
+22 WRITE !?10,"locations or facilities where the provider provides services."
+23 WRITE !?5,"- The set of clinics you have determined to be 'Primary' clinics."
+24 WRITE !?10,"A taxonomy or group of these clinics can be created for later use"
+25 WRITE !,"In order to be included in the denominator the visit must be a "
+26 WRITE !,"complete visit (have a POV and a provider.)"
+27 WRITE !,"Inactive and deceased patients are excluded."
+28 DO PAUSE^APCLVL01
+29 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("A")="End of Report. Press return"
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 ;
POST ;EP
+1 SET X=$$ADD^XPDMENU("APCLMENU","APCL IPC REPORTS MENU","IPC")
+2 SET X=$$ADD^XPDMENU("APCL IPC REPORTS MENU","BDPMENU","BDP")
+3 SET X=$$ADD^XPDMENU("APCL IPC REPORTS MENU","BSD MENU PRIMARY CARE","PCP")
+4 QUIT
