APCLEM2 ; IHS/CMI/LAB - active users by community ;
;;2.0;IHS PCC SUITE;**6**;MAY 14, 2009;Build 11
;IHS/CMI/LAB - added a template creation option
START ;
D INIT
SUF ;
F ;
K APCLSU,APCLSUF
W !!,"Enter the Facilities you want to report on. To be included in this report"
W !,"the patient must be registered at one of these facilities and must have"
W !,"had at least one visit in the past 3 years to one of these facilities.",!
W !,"If you are operating on a multi divisional database it might be best to"
W !,"run one report for each facility."
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 EOJ
D PEP^AMQQGTX0(+Y,"APCLSU(")
I '$D(APCLSU) D EOJ Q
I $D(APCLSU("*")) W !,"You can't choose all locations." H 2 K APCLSU G SUF
FY ;
S Y=DT X ^DD("DD") S APCLDTP=Y
S %DT("A")="** Patients are to be considered ACTIVE 'as of' what date: ",%DT="AEPX" W ! D ^%DT
I Y=-1 G F
S APCLFYE=Y X ^DD("DD") S APCLFYEY=Y
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G FY
W !!!,"THIS REPORT WILL SEARCH THE ENTIRE PATIENT FILE!",!!,"IT IS STRONGLY RECOMMENDED THAT YOU QUEUE THIS REPORT FOR A TIME WHEN THE",!,"SYSTEM IS NOT IN HEAVY USE!",!
S XBRP="PRINT^APCLEM2",XBRC="PROCESS^APCLEM2",XBRX="EOJ^APCLEM2",XBNS="APCL"
D ^XBDBQUE
D EOJ
Q
;
INIT ;
ACC ;
W:$D(IOF) @IOF
W $$CTR("***** Percent of Patient's Empanelled *****")
W !,"This option will produce either a count of active users and the "
W !,"number and percent of those patients who were empanelled on the "
W !,"as of the date the report is run."
W !,"Your Report can be generated for one or more Facilities."
W !!,"The system will select patients who have had a visit at the Facility(s) specified",!
W "within the past 3 years of the date you specify."
W !,"The visit used to determine if the patient is active must meet the following"
W !,"criteria:"
W !?5,"- must be to a location (facility) you specify"
W !?5,"- must be a complete visit (have a POV and primary provider)"
W !?5,"- must not be service category Chart Review, Telephone Call, Event"
W !?10,"or In-Hospital visit"
W !?5,"- must not be to clinics Home, Telephone, employee health or chart review"
W !
Q
;
EOJ ;ENTRY POINT
ACCEOJ K DIC,%DT,IO("Q"),I,J,K,JK,X,Y,POP,DIRUT,ZTSK,H,M,S,TS,ZTQUEUED
D EN^XBVK("APCL")
Q
PROCESS ;
S APCLTOTP=0,APCLTOTR=0
X S X1=APCLFYE,X2=1 D C^%DTC S APCLFYB=($E(X,1,3)-3)_$E(X,4,7) S Y=APCLFYB D DD^%DT S APCLFYBY=Y
S APCLJ=0
PAT S APCLDFN=0 F S APCLDFN=$O(^AUPNPAT(APCLDFN)) Q:APCLDFN'=+APCLDFN D C1
K APCLDFN,APCLV,APCLFYBI,APCLFYEI,APCLGOTA
S APCLET=$H
Q
C1 ;
Q:'$D(^DPT(APCLDFN,0))
Q:$P(^DPT(APCLDFN,0),U,19)]""
Q:$$DEMO^APCLUTL(APCLDFN,$G(APCLDEMO))
I $D(^DPT(APCLDFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)'>APCLFYE Q
HRN S (APCLGOT1,APCLHRN)=0 F J=0:0 S APCLHRN=$O(^AUPNPAT(APCLDFN,41,APCLHRN)) Q:APCLHRN'=+APCLHRN!(APCLGOT1) I $D(APCLSU($P(^AUPNPAT(APCLDFN,41,APCLHRN,0),U))) S APCLGOT1=1
Q:'APCLGOT1
VISITS ;
S APCLFYBI=9999999-APCLFYB,APCLFYEI=9999999-APCLFYE
K APCLGOTA,APCLSKIP
S APCLV=0 F S APCLV=$O(^AUPNVSIT("AA",APCLDFN,APCLV)) Q:APCLV'=+APCLV!($D(APCLGOTA))!($P(APCLV,".")>APCLFYBI) S APCLVD=$P(APCLV,".") D PROC
Q
PROC ;
S APCLVDFN=0 F S APCLVDFN=$O(^AUPNVSIT("AA",APCLDFN,APCLV,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN!($D(APCLGOTA)) D ACTIVE
Q
ACTIVE ;determine if patient was seen in FYs
;home clinic, telephone and employee health clinics ignored
Q:$D(APCLGOTA)
Q:APCLVD>APCLFYBI
Q:APCLVD<APCLFYEI
Q:$P(^AUPNVSIT(APCLVDFN,0),U,11)
Q:'$P(^AUPNVSIT(APCLVDFN,0),U,9)
Q:"DXECTI"[$P(^AUPNVSIT(APCLVDFN,0),U,7)
S %=$$CLINIC^APCLV(APCLVDFN,"C") I %=11!(%=68)!(%=51)!(%=52) Q
Q:'$D(^AUPNVPOV("AD",APCLVDFN))
Q:$$PRIMPROV^APCLV(APCLVDFN,"I")=""
S F=$P(^AUPNVSIT(APCLVDFN,0),U,6)
Q:F=""
I '$D(APCLSU(F)) Q
S APCLGOTA=1
S APCLTOTP=APCLTOTP+1
I $P(^AUPNPAT(APCLDFN,0),U,14) S APCLTOTR=APCLTOTR+1
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")
;----------
LOC1() ;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")
;----------
GETPROV ;
;get dpcp on date APCLFYE
S P=""
K S
S X=$O(^BDPRECN("AA",APCLDFN,1,0))
I 'X Q
S Y=0 F S Y=$O(^BDPRECN(X,1,Y)) Q:Y'=+Y D
.S B=$P(^BDPRECN(X,1,Y,0),U,3)
.S Z=$O(^BDPRECN(X,1,Y))
.I Z S E=$P(^BDPRECN(X,1,Z,0),U,3),E=$$FMADD^XLFDT(E,-1)
.I 'Z S E=DT
.S S(B,E)=$P(^BDPRECN(X,1,Y,0),U,1)
.Q
Q
PRINT ;
S APCLPG=0
D HEADER
W !," Total # of active patients: ",$$C^APCLEM1(APCLTOTP,0),!
W !,"Total # of active patients Empanelled: ",$$C^APCLEM1(APCLTOTR,0),!
W !," Percent Empanelled: ",$$PER^APCLEM1(APCLTOTR,APCLTOTP),!!
D PAUSE^APCLVL01
Q
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^APCLEM1($$FMTE^XLFDT(DT),80),?70,"Page ",APCLPG,!
W $$CTR^APCLEM1($$LOC^APCLEM1,80),!
W $$CTR^APCLEM1("Patients Active as of: "_$$FMTE^XLFDT(APCLFYE)),!
W $$REPEAT^XLFSTR("-",79),!
Q
APCLEM2 ; IHS/CMI/LAB - active users by community ;
+1 ;;2.0;IHS PCC SUITE;**6**;MAY 14, 2009;Build 11
+2 ;IHS/CMI/LAB - added a template creation option
START ;
+1 DO INIT
SUF ;
F ;
+1 KILL APCLSU,APCLSUF
+2 WRITE !!,"Enter the Facilities you want to report on. To be included in this report"
+3 WRITE !,"the patient must be registered at one of these facilities and must have"
+4 WRITE !,"had at least one visit in the past 3 years to one of these facilities.",!
+5 WRITE !,"If you are operating on a multi divisional database it might be best to"
+6 WRITE !,"run one report for each facility."
+7 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 EOJ
+8 DO PEP^AMQQGTX0(+Y,"APCLSU(")
+9 IF '$DATA(APCLSU)
DO EOJ
QUIT
+10 IF $DATA(APCLSU("*"))
WRITE !,"You can't choose all locations."
HANG 2
KILL APCLSU
GOTO SUF
FY ;
+1 SET Y=DT
XECUTE ^DD("DD")
SET APCLDTP=Y
+2 SET %DT("A")="** Patients are to be considered ACTIVE 'as of' what date: "
SET %DT="AEPX"
WRITE !
DO ^%DT
+3 IF Y=-1
GOTO F
+4 SET APCLFYE=Y
XECUTE ^DD("DD")
SET APCLFYEY=Y
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO FY
+3 WRITE !!!,"THIS REPORT WILL SEARCH THE ENTIRE PATIENT FILE!",!!,"IT IS STRONGLY RECOMMENDED THAT YOU QUEUE THIS REPORT FOR A TIME WHEN THE",!,"SYSTEM IS NOT IN HEAVY USE!",!
+4 SET XBRP="PRINT^APCLEM2"
SET XBRC="PROCESS^APCLEM2"
SET XBRX="EOJ^APCLEM2"
SET XBNS="APCL"
+5 DO ^XBDBQUE
+6 DO EOJ
+7 QUIT
+8 ;
INIT ;
ACC ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE $$CTR("***** Percent of Patient's Empanelled *****")
+3 WRITE !,"This option will produce either a count of active users and the "
+4 WRITE !,"number and percent of those patients who were empanelled on the "
+5 WRITE !,"as of the date the report is run."
+6 WRITE !,"Your Report can be generated for one or more Facilities."
+7 WRITE !!,"The system will select patients who have had a visit at the Facility(s) specified",!
+8 WRITE "within the past 3 years of the date you specify."
+9 WRITE !,"The visit used to determine if the patient is active must meet the following"
+10 WRITE !,"criteria:"
+11 WRITE !?5,"- must be to a location (facility) you specify"
+12 WRITE !?5,"- must be a complete visit (have a POV and primary provider)"
+13 WRITE !?5,"- must not be service category Chart Review, Telephone Call, Event"
+14 WRITE !?10,"or In-Hospital visit"
+15 WRITE !?5,"- must not be to clinics Home, Telephone, employee health or chart review"
+16 WRITE !
+17 QUIT
+18 ;
EOJ ;ENTRY POINT
ACCEOJ KILL DIC,%DT,IO("Q"),I,J,K,JK,X,Y,POP,DIRUT,ZTSK,H,M,S,TS,ZTQUEUED
+1 DO EN^XBVK("APCL")
+2 QUIT
PROCESS ;
+1 SET APCLTOTP=0
SET APCLTOTR=0
X SET X1=APCLFYE
SET X2=1
DO C^%DTC
SET APCLFYB=($EXTRACT(X,1,3)-3)_$EXTRACT(X,4,7)
SET Y=APCLFYB
DO DD^%DT
SET APCLFYBY=Y
+1 SET APCLJ=0
PAT SET APCLDFN=0
FOR
SET APCLDFN=$ORDER(^AUPNPAT(APCLDFN))
IF APCLDFN'=+APCLDFN
QUIT
DO C1
+1 KILL APCLDFN,APCLV,APCLFYBI,APCLFYEI,APCLGOTA
+2 SET APCLET=$HOROLOG
+3 QUIT
C1 ;
+1 IF '$DATA(^DPT(APCLDFN,0))
QUIT
+2 IF $PIECE(^DPT(APCLDFN,0),U,19)]""
QUIT
+3 IF $$DEMO^APCLUTL(APCLDFN,$GET(APCLDEMO))
QUIT
+4 IF $DATA(^DPT(APCLDFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)'>APCLFYE
QUIT
HRN SET (APCLGOT1,APCLHRN)=0
FOR J=0:0
SET APCLHRN=$ORDER(^AUPNPAT(APCLDFN,41,APCLHRN))
IF APCLHRN'=+APCLHRN!(APCLGOT1)
QUIT
IF $DATA(APCLSU($PIECE(^AUPNPAT(APCLDFN,41,APCLHRN,0),U)))
SET APCLGOT1=1
+1 IF 'APCLGOT1
QUIT
VISITS ;
+1 SET APCLFYBI=9999999-APCLFYB
SET APCLFYEI=9999999-APCLFYE
+2 KILL APCLGOTA,APCLSKIP
+3 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("AA",APCLDFN,APCLV))
IF APCLV'=+APCLV!($DATA(APCLGOTA))!($PIECE(APCLV,".")>APCLFYBI)
QUIT
SET APCLVD=$PIECE(APCLV,".")
DO PROC
+4 QUIT
PROC ;
+1 SET APCLVDFN=0
FOR
SET APCLVDFN=$ORDER(^AUPNVSIT("AA",APCLDFN,APCLV,APCLVDFN))
IF APCLVDFN'=+APCLVDFN!($DATA(APCLGOTA))
QUIT
DO ACTIVE
+2 QUIT
ACTIVE ;determine if patient was seen in FYs
+1 ;home clinic, telephone and employee health clinics ignored
+2 IF $DATA(APCLGOTA)
QUIT
+3 IF APCLVD>APCLFYBI
QUIT
+4 IF APCLVD<APCLFYEI
QUIT
+5 IF $PIECE(^AUPNVSIT(APCLVDFN,0),U,11)
QUIT
+6 IF '$PIECE(^AUPNVSIT(APCLVDFN,0),U,9)
QUIT
+7 IF "DXECTI"[$PIECE(^AUPNVSIT(APCLVDFN,0),U,7)
QUIT
+8 SET %=$$CLINIC^APCLV(APCLVDFN,"C")
IF %=11!(%=68)!(%=51)!(%=52)
QUIT
+9 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
QUIT
+10 IF $$PRIMPROV^APCLV(APCLVDFN,"I")=""
QUIT
+11 SET F=$PIECE(^AUPNVSIT(APCLVDFN,0),U,6)
+12 IF F=""
QUIT
+13 IF '$DATA(APCLSU(F))
QUIT
+14 SET APCLGOTA=1
+15 SET APCLTOTP=APCLTOTP+1
+16 IF $PIECE(^AUPNPAT(APCLDFN,0),U,14)
SET APCLTOTR=APCLTOTR+1
+17 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 ;----------
LOC1() ;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 ;----------
GETPROV ;
+1 ;get dpcp on date APCLFYE
+2 SET P=""
+3 KILL S
+4 SET X=$ORDER(^BDPRECN("AA",APCLDFN,1,0))
+5 IF 'X
QUIT
+6 SET Y=0
FOR
SET Y=$ORDER(^BDPRECN(X,1,Y))
IF Y'=+Y
QUIT
Begin DoDot:1
+7 SET B=$PIECE(^BDPRECN(X,1,Y,0),U,3)
+8 SET Z=$ORDER(^BDPRECN(X,1,Y))
+9 IF Z
SET E=$PIECE(^BDPRECN(X,1,Z,0),U,3)
SET E=$$FMADD^XLFDT(E,-1)
+10 IF 'Z
SET E=DT
+11 SET S(B,E)=$PIECE(^BDPRECN(X,1,Y,0),U,1)
+12 QUIT
End DoDot:1
+13 QUIT
PRINT ;
+1 SET APCLPG=0
+2 DO HEADER
+3 WRITE !," Total # of active patients: ",$$C^APCLEM1(APCLTOTP,0),!
+4 WRITE !,"Total # of active patients Empanelled: ",$$C^APCLEM1(APCLTOTR,0),!
+5 WRITE !," Percent Empanelled: ",$$PER^APCLEM1(APCLTOTR,APCLTOTP),!!
+6 DO PAUSE^APCLVL01
+7 QUIT
+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^APCLEM1($$FMTE^XLFDT(DT),80),?70,"Page ",APCLPG,!
+4 WRITE $$CTR^APCLEM1($$LOC^APCLEM1,80),!
+5 WRITE $$CTR^APCLEM1("Patients Active as of: "_$$FMTE^XLFDT(APCLFYE)),!
+6 WRITE $$REPEAT^XLFSTR("-",79),!
+7 QUIT
