APCLPCT ; IHS/CMI/LAB - DRIVER FOR ACTIVE POP ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
D INIT
G:$D(APCLQUIT) QUIT
SUF S APCLVFL="",APCLSUF="",DIR(0)="SBO^F:FACILITY;S:SERVICE UNIT",DIR("A")="Report on Patients registered at a particular Facility or in a Service Unit?" D ^DIR K DIR
G:$D(DIRUT) QUIT
S APCLFS=Y
G:Y="S" S
F ;
S DIC("A")="Which Facility: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 QUIT
S APCLSU=+Y
S APCLSUF=$P(^AUTTLOC(APCLSU,0),U,5) Q:APCLSUF=""
VL S DIR(0)="S^A:All Locations;L:The Location entered above: ",DIR("A")="Do you want to include Visits to",DIR("B")="A" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) SUF
S APCLVFL=Y
G IND
S W ! S APCLDICB=$P(^AUTTLOC(DUZ(2),0),U,5),APCLDIC("B")=$P(^AUTTSU(APCLDICB,0),U),DIC("A")="Select Service Unit: "_APCLDIC("B")_"//"
S DIC="^AUTTSU(",DIC(0)="AEMQZ" W ! D ^DIC
I X="" S (APCLSU,APCLSUF)=APCLDICB G IND
G:Y=-1 QUIT
S (APCLSU,APCLSUF)=+Y
IND ;
W ! S APCLIND="",DIR(0)="YO",DIR("A")="Do you wish to include only INDIAN patients",DIR("?")="If you wish to exclude Non-Indians from the report enter a Y" D ^DIR K DIR
G:$D(DIRUT) SUF
S APCLIND=Y
SD ;
W !
S Y=DT X ^DD("DD") S APCLDTP=Y
S %DT("A")="Starting Visit Date for Visit Counts: ",%DT="AEPX" W ! D ^%DT
I Y=-1 G IND
S APCLSD=Y X ^DD("DD") S APCLSDY=Y
ED S %DT("A")="Ending Visit Date for Visit Counts: " W ! D ^%DT K %DT
I Y=-1 G SD
S APCLED=Y X ^DD("DD") S APCLEDY=Y
I APCLED<APCLSD W !!,"Ending Date cannot be before Starting Date! Please reenter.",! G SD
SBT ;subtotal by tribe?
G:APCLSORT'="C" SBC
W ! S APCLSUB="" S DIR(0)="YO",DIR("A")="Do you wish to Sub-Total by Tribe",DIR("?")="If you want sub-totals by tribe for each community enter a Y" D ^DIR K DIR
G:$D(DIRUT) SD
S APCLSUB=Y
G ZIS
SBC ;subtotal by community
W ! S APCLSUB="" S DIR(0)="YO",DIR("A")="Do you wish to Sub-Total by Current Community of Residence",DIR("?")="If you want sub-totals by community for each Tribe enter a Y" D ^DIR K DIR
G:$D(DIRUT) SD
S APCLSUB=Y
W !!!,"THIS REPORT WILL SEARCH THE ENTIRE PATIENT AND VISIT FILES!",!!,"IT IS STRONGLY RECOMMENDED THAT YOU QUEUE THIS REPORT FOR A TIME WHEN THE",!,"SYSTEM IS NOT IN HEAVY USE!",!
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G SD
S XBRP="^APCLPCT1",XBRC="^APCLPCT2",XBRX="QUIT^APCLPCT",XBNS="APCL"
D ^XBDBQUE
D QUIT
Q
QUIT ;
PCTEOJ K DIC,%DT,ZTSK,ZTQUEUED,IO("Q"),I,J,K,JK,X,Y,DIRUT,POP,H,M,S,TS
K APCLSVJ,APCLCOMM,APCLDIC("B"),APCLDICB,APCLJ,APCLCNT,APCLDFN,APCLGOT1,APCLHRN,APCLTRI,APCLTRIC,APCLSU,APCL80D,APCLPG,APCLED,APCLSD,APCLEDY,APCLSDY,APCLFS,APCLFYB,APCLFYE,APCL,APCL3,APCL4,APCL5,APCLT1,APCLT2,APCLT3,APCLT4,APCLT5,APCLVFL
K APCLACTT,APCLCNTT,APCLVCTT,APCLAPCT,APCLPCPT,APCLQUIT,APCLACT,APCLAPC,APCLVCNT,APCLPCP,APCLCOMN,APCLGOTA,APCLGOTB,APCLSKIP,APCLV,APCLVDFN,APCL1,APCLDISC,APCL2,APCLAP,APCLY,APCLDTP,APCLSUP,APCLVD,APCLSBT,APCLLOCC,APCLPAR
K APCLVAR,APCLVAR1,APCLVAR2,APCLIND,APCLT,APCLP,APCLI,APCLSUF,APCLCOMN,APCLSUB,APCLSORT,APCLMAJ,APCLMIN,APCLSUN,APCLSUR,APCLVREC,APCLPPOV,APCLCLIN,APCLVLOC,APCLBT,APCLJOB,APCLVFL
Q
;
Q
INIT ;
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",! S APCLQUIT="" Q
I '$D(APCLSORT) W $C(7),$C(7),!!,"Report Type Missing!!",! S APCLQUIT="" Q
W:$D(IOF) @IOF
W !!,"This Option will search the Patient file for all patients registered",!,"at the Service Unit or the facility that you select.",!
W "A Report will result which will give the following counts:",!
W ?5,"- All Living Patients registered at the facility or SU selected",!
W ?5,"- All Patients seen in the Visit Date Range specified",!
W ?5,"- Total number of Visits by these patients",!
W ?5,"- Total number of APC Visits by these patients",!
W ?5,"- Total number of Primary Care Provider Visits by these patients",!
W "The report will be sorted by ",$S(APCLSORT="C":"COMMUNITY OF RESIDENCE",APCLSORT="T":"TRIBE OF MEMBERSHIP",1:"SERVICE UNIT OF RESIDENCE"),".",!!
Q
APCLPCT ; IHS/CMI/LAB - DRIVER FOR ACTIVE POP ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
+1 DO INIT
+2 IF $DATA(APCLQUIT)
GOTO QUIT
SUF SET APCLVFL=""
SET APCLSUF=""
SET DIR(0)="SBO^F:FACILITY;S:SERVICE UNIT"
SET DIR("A")="Report on Patients registered at a particular Facility or in a Service Unit?"
DO ^DIR
KILL DIR
+1 IF $DATA(DIRUT)
GOTO QUIT
+2 SET APCLFS=Y
+3 IF Y="S"
GOTO S
F ;
+1 SET DIC("A")="Which Facility: "
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
GOTO QUIT
+2 SET APCLSU=+Y
+3 SET APCLSUF=$PIECE(^AUTTLOC(APCLSU,0),U,5)
IF APCLSUF=""
QUIT
VL SET DIR(0)="S^A:All Locations;L:The Location entered above: "
SET DIR("A")="Do you want to include Visits to"
SET DIR("B")="A"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+1 IF $DATA(DIRUT)
GOTO SUF
+2 SET APCLVFL=Y
+3 GOTO IND
S WRITE !
SET APCLDICB=$PIECE(^AUTTLOC(DUZ(2),0),U,5)
SET APCLDIC("B")=$PIECE(^AUTTSU(APCLDICB,0),U)
SET DIC("A")="Select Service Unit: "_APCLDIC("B")_"//"
+1 SET DIC="^AUTTSU("
SET DIC(0)="AEMQZ"
WRITE !
DO ^DIC
+2 IF X=""
SET (APCLSU,APCLSUF)=APCLDICB
GOTO IND
+3 IF Y=-1
GOTO QUIT
+4 SET (APCLSU,APCLSUF)=+Y
IND ;
+1 WRITE !
SET APCLIND=""
SET DIR(0)="YO"
SET DIR("A")="Do you wish to include only INDIAN patients"
SET DIR("?")="If you wish to exclude Non-Indians from the report enter a Y"
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO SUF
+3 SET APCLIND=Y
SD ;
+1 WRITE !
+2 SET Y=DT
XECUTE ^DD("DD")
SET APCLDTP=Y
+3 SET %DT("A")="Starting Visit Date for Visit Counts: "
SET %DT="AEPX"
WRITE !
DO ^%DT
+4 IF Y=-1
GOTO IND
+5 SET APCLSD=Y
XECUTE ^DD("DD")
SET APCLSDY=Y
ED SET %DT("A")="Ending Visit Date for Visit Counts: "
WRITE !
DO ^%DT
KILL %DT
+1 IF Y=-1
GOTO SD
+2 SET APCLED=Y
XECUTE ^DD("DD")
SET APCLEDY=Y
+3 IF APCLED<APCLSD
WRITE !!,"Ending Date cannot be before Starting Date! Please reenter.",!
GOTO SD
SBT ;subtotal by tribe?
+1 IF APCLSORT'="C"
GOTO SBC
+2 WRITE !
SET APCLSUB=""
SET DIR(0)="YO"
SET DIR("A")="Do you wish to Sub-Total by Tribe"
SET DIR("?")="If you want sub-totals by tribe for each community enter a Y"
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO SD
+4 SET APCLSUB=Y
+5 GOTO ZIS
SBC ;subtotal by community
+1 WRITE !
SET APCLSUB=""
SET DIR(0)="YO"
SET DIR("A")="Do you wish to Sub-Total by Current Community of Residence"
SET DIR("?")="If you want sub-totals by community for each Tribe enter a Y"
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO SD
+3 SET APCLSUB=Y
+4 WRITE !!!,"THIS REPORT WILL SEARCH THE ENTIRE PATIENT AND VISIT FILES!",!!,"IT IS STRONGLY RECOMMENDED THAT YOU QUEUE THIS REPORT FOR A TIME WHEN THE",!,"SYSTEM IS NOT IN HEAVY USE!",!
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO SD
+3 SET XBRP="^APCLPCT1"
SET XBRC="^APCLPCT2"
SET XBRX="QUIT^APCLPCT"
SET XBNS="APCL"
+4 DO ^XBDBQUE
+5 DO QUIT
+6 QUIT
QUIT ;
PCTEOJ KILL DIC,%DT,ZTSK,ZTQUEUED,IO("Q"),I,J,K,JK,X,Y,DIRUT,POP,H,M,S,TS
+1 KILL APCLSVJ,APCLCOMM,APCLDIC("B"),APCLDICB,APCLJ,APCLCNT,APCLDFN,APCLGOT1,APCLHRN,APCLTRI,APCLTRIC,APCLSU,APCL80D,APCLPG,APCLED,APCLSD,APCLEDY,APCLSDY,APCLFS,APCLFYB,APCLFYE,APCL,APCL3,APCL4,APCL5,APCLT1,APCLT2,APCLT3,APCLT4,APCLT5,APCLVFL
+2 KILL APCLACTT,APCLCNTT,APCLVCTT,APCLAPCT,APCLPCPT,APCLQUIT,APCLACT,APCLAPC,APCLVCNT,APCLPCP,APCLCOMN,APCLGOTA,APCLGOTB,APCLSKIP,APCLV,APCLVDFN,APCL1,APCLDISC,APCL2,APCLAP,APCLY,APCLDTP,APCLSUP,APCLVD,APCLSBT,APCLLOCC,APCLPAR
+3 KILL APCLVAR,APCLVAR1,APCLVAR2,APCLIND,APCLT,APCLP,APCLI,APCLSUF,APCLCOMN,APCLSUB,APCLSORT,APCLMAJ,APCLMIN,APCLSUN,APCLSUR,APCLVREC,APCLPPOV,APCLCLIN,APCLVLOC,APCLBT,APCLJOB,APCLVFL
+4 QUIT
+5 ;
+6 QUIT
INIT ;
+1 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!
SET APCLQUIT=""
QUIT
+2 IF '$DATA(APCLSORT)
WRITE $CHAR(7),$CHAR(7),!!,"Report Type Missing!!",!
SET APCLQUIT=""
QUIT
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE !!,"This Option will search the Patient file for all patients registered",!,"at the Service Unit or the facility that you select.",!
+5 WRITE "A Report will result which will give the following counts:",!
+6 WRITE ?5,"- All Living Patients registered at the facility or SU selected",!
+7 WRITE ?5,"- All Patients seen in the Visit Date Range specified",!
+8 WRITE ?5,"- Total number of Visits by these patients",!
+9 WRITE ?5,"- Total number of APC Visits by these patients",!
+10 WRITE ?5,"- Total number of Primary Care Provider Visits by these patients",!
+11 WRITE "The report will be sorted by ",$SELECT(APCLSORT="C":"COMMUNITY OF RESIDENCE",APCLSORT="T":"TRIBE OF MEMBERSHIP",1:"SERVICE UNIT OF RESIDENCE"),".",!!
+12 QUIT
