APCLCP9 ; IHS/CMI/LAB - APC visits by primary provider ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
START ;
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! K APCLSITE Q
D INFORM
GETGROUP ;
S DIC="^APCLACTG(",DIC("A")="Enter the Provider Discipline Group you wish to report on: ",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 W !,"Bye ... " G XIT
S APCLACTG=+Y
W !!,"You have selected the ",$P(Y,U,2)," discipline group.",!
S DIC="^APCLACTG(",DA=+Y D EN^DIQ K DIC,DA
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETGROUP
S APCLBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date for Search: " S Y=APCLBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
;
S S APCLDICB=$P(^AUTTLOC(DUZ(2),0),U,5),APCLDIC("B")=$P(^AUTTSU(APCLDICB,0),U),DIC("A")="Which Service Unit: "_APCLDIC("B")_"//"
S DIC="^AUTTSU(",DIC(0)="AEMQZ" W ! D ^DIC K DIC
I X="" S (APCLSU,APCLSUF)=APCLDICB G CLINIC
G:Y=-1 XIT
S (APCLSU,APCLSUF)=+Y
;
CLINIC ;
K APCLCLN
S DIR(0)="S^O:One Clinic;T:Taxonomy of or Selected Set of Clinics;A:All Clinics"
S DIR("A")="Include visits from which set of clinics",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) S
I Y="A" K APCLCLN G ZIS
I Y="O" D OC^APCLCP1 G:$D(APCLQ) CLINIC
I Y="T" D TC^APCLCP1 G:$D(APCLQ) CLINIC
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G CLINIC
S XBRP="^APCLCP9P",XBRC="^APCLCP91",XBNS="APCL",XBRX="XIT^APCLCP9"
D ^XBDBQUE
Q
ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
XIT ;
K APCL80S,APCLBD,APCLBDD,APCLBT,APCLCODE,APCLDT,APCLED,APCLEDD,APCLLENG,APCLPG,APCLQUIT,APCLSU,APCL1,APCL2,APCLAP,APCLCHN,APCLDA1,APCLDA2,APCLDISC,APCLFOUN,APCLHIGH,APCLICD,APCLIPTR,APCLLOW,APCLODAT,APCLSD
K APCLSKIP,APCLSU,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLSITE,APCLX,APCLY,APCLPRIM,APCLLOC,APCLCNT,APCLDIC,APCLDICB,APCLSUF,APCLGLOB,APCLPIEC,APCLACTG,APCLNUM,APCLRRTN,APCLJOB
K X,X1,X2,IO("Q"),%,Y,DIRUT,POP,ZTSK,ZTQUEUED,T,S,M,TS,H
Q
;
INFORM ;
W:$D(IOF) @IOF
W !,"Top Ten Primary Purposes for Services",!
W !,"This report displays, by service unit, the top ten primary purposes for",!,"services by staff in the discipline group that you select.",!
W !
Q
;
;
O ;EP one location
K APCLQ
S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S APCLLOC(+Y)=""
Q
T ;EP taxonomy
K APCLQ
S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=9999999.06" D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S X=0 F S X=$O(^ATXAX(+Y,21,"B",X)) Q:X="" S APCLLOC(X)=""
Q
OC ;EP one location
K APCLQ
S DIC="^DIC(40.7,",DIC(0)="AEMQ",DIC("A")="Which CLINIC: " D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S APCLCLN(+Y)=""
Q
TC ;EP taxonomy
K APCLQ
S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=40.7" D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S X=0 F S X=$O(^ATXAX(+Y,21,"B",X)) Q:X="" S APCLCLN(X)=""
Q
APCLCP9 ; IHS/CMI/LAB - APC visits by primary provider ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
START ;
+1 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
KILL APCLSITE
QUIT
+2 DO INFORM
GETGROUP ;
+1 SET DIC="^APCLACTG("
SET DIC("A")="Enter the Provider Discipline Group you wish to report on: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+2 IF Y=-1
WRITE !,"Bye ... "
GOTO XIT
+3 SET APCLACTG=+Y
+4 WRITE !!,"You have selected the ",$PIECE(Y,U,2)," discipline group.",!
+5 SET DIC="^APCLACTG("
SET DA=+Y
DO EN^DIQ
KILL DIC,DA
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date for Search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETGROUP
+3 SET APCLBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCLBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date for Search: "
SET Y=APCLBD
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCLED=Y
+4 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
+5 ;
S SET APCLDICB=$PIECE(^AUTTLOC(DUZ(2),0),U,5)
SET APCLDIC("B")=$PIECE(^AUTTSU(APCLDICB,0),U)
SET DIC("A")="Which Service Unit: "_APCLDIC("B")_"//"
+1 SET DIC="^AUTTSU("
SET DIC(0)="AEMQZ"
WRITE !
DO ^DIC
KILL DIC
+2 IF X=""
SET (APCLSU,APCLSUF)=APCLDICB
GOTO CLINIC
+3 IF Y=-1
GOTO XIT
+4 SET (APCLSU,APCLSUF)=+Y
+5 ;
CLINIC ;
+1 KILL APCLCLN
+2 SET DIR(0)="S^O:One Clinic;T:Taxonomy of or Selected Set of Clinics;A:All Clinics"
+3 SET DIR("A")="Include visits from which set of clinics"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO S
+5 IF Y="A"
KILL APCLCLN
GOTO ZIS
+6 IF Y="O"
DO OC^APCLCP1
IF $DATA(APCLQ)
GOTO CLINIC
+7 IF Y="T"
DO TC^APCLCP1
IF $DATA(APCLQ)
GOTO CLINIC
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO CLINIC
+3 SET XBRP="^APCLCP9P"
SET XBRC="^APCLCP91"
SET XBNS="APCL"
SET XBRX="XIT^APCLCP9"
+4 DO ^XBDBQUE
+5 QUIT
ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
XIT ;
+1 KILL APCL80S,APCLBD,APCLBDD,APCLBT,APCLCODE,APCLDT,APCLED,APCLEDD,APCLLENG,APCLPG,APCLQUIT,APCLSU,APCL1,APCL2,APCLAP,APCLCHN,APCLDA1,APCLDA2,APCLDISC,APCLFOUN,APCLHIGH,APCLICD,APCLIPTR,APCLLOW,APCLODAT,APCLSD
+2 KILL APCLSKIP,APCLSU,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLSITE,APCLX,APCLY,APCLPRIM,APCLLOC,APCLCNT,APCLDIC,APCLDICB,APCLSUF,APCLGLOB,APCLPIEC,APCLACTG,APCLNUM,APCLRRTN,APCLJOB
+3 KILL X,X1,X2,IO("Q"),%,Y,DIRUT,POP,ZTSK,ZTQUEUED,T,S,M,TS,H
+4 QUIT
+5 ;
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"Top Ten Primary Purposes for Services",!
+3 WRITE !,"This report displays, by service unit, the top ten primary purposes for",!,"services by staff in the discipline group that you select.",!
+4 WRITE !
+5 QUIT
+6 ;
+7 ;
O ;EP one location
+1 KILL APCLQ
+2 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which LOCATION: "
DO ^DIC
KILL DIC
+3 IF Y=-1
SET APCLQ=""
QUIT
+4 SET APCLLOC(+Y)=""
+5 QUIT
T ;EP taxonomy
+1 KILL APCLQ
+2 SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Which TAXONOMY: "
SET DIC("S")="I $P(^(0),U,15)=9999999.06"
DO ^DIC
KILL DIC
+3 IF Y=-1
SET APCLQ=""
QUIT
+4 SET X=0
FOR
SET X=$ORDER(^ATXAX(+Y,21,"B",X))
IF X=""
QUIT
SET APCLLOC(X)=""
+5 QUIT
OC ;EP one location
+1 KILL APCLQ
+2 SET DIC="^DIC(40.7,"
SET DIC(0)="AEMQ"
SET DIC("A")="Which CLINIC: "
DO ^DIC
KILL DIC
+3 IF Y=-1
SET APCLQ=""
QUIT
+4 SET APCLCLN(+Y)=""
+5 QUIT
TC ;EP taxonomy
+1 KILL APCLQ
+2 SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Which TAXONOMY: "
SET DIC("S")="I $P(^(0),U,15)=40.7"
DO ^DIC
KILL DIC
+3 IF Y=-1
SET APCLQ=""
QUIT
+4 SET X=0
FOR
SET X=$ORDER(^ATXAX(+Y,21,"B",X))
IF X=""
QUIT
SET APCLCLN(X)=""
+5 QUIT
