- 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