APCLCP1 ; IHS/CMI/LAB - DISC tally activity time ;
;;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!!",!! Q
S APCLSITE=DUZ(2)
I APCLSORV="APCLVLOC" S APCLNSP="APCLCP1",APCLSORT="LOCATION OF ENCOUNTER"
I APCLSORV="APCLCODE" S APCLNSP="APCLCP2",APCLSORT="PRIMARY DX"
D INFORM
;
GETGROUP ;
W ! S DIC="^APCLACTG(",DIC("A")="Enter the Provider Discipline Group you wish to report on: ",DIC(0)="AEMQ" D ^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
;
LOC ;get location
K APCLLOC
S DIR(0)="S^O:One Location;T:Taxonomy of or Selected set of Locations;A:All Locations"
S DIR("A")="Include visits from which set of locations",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) BD
I Y="A" K APCLLOC G CLINIC
I Y="O" D O G:$D(APCLQ) LOC
I Y="T" D T G:$D(APCLQ) LOC
CLINIC ;
K APCLCLN
S DIR(0)="S^O:One Clinic;T:Taxonomy 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) LOC
I Y="A" K APCLCLN G ZIS
I Y="O" D OC G:$D(APCLQ) CLINIC
I Y="T" D TC G:$D(APCLQ) CLINIC
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G CLINIC
S XBRP="^APCLCP1P",XBRC="^APCLCP11",XBRX="XIT^APCLCP1",XBNS="APCL"
D ^XBDBQUE
D XIT
Q
;
ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
XIT ;
K APCL80S,APCLBDD,APCLBT,APCLDT,APCLED,APCLEDD,APCLLENG,APCLLOC,APCLPG,APCLQUIT,APCL1,APCL2,APCLAP,APCLDISC,APCLODAT,APCLSD,APCLSKIP,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLX,APCLY,APCLPRIM,APCLSITE,APCLBD
K APCLACTG,APCLPIEC,APCLGLOB,APCLRRTN,APCLJOB
K X,Z,X1,X2,IO("Q"),%,Y,DIRUT,POP,ZTSK,ZTQUEUED,T,S,M,TS,H,DIR,DUOUT,DTOUT,DUOUT,DLOUT,APCLNSP,APCLSORT,APCLZ,APCLSORV,APCLVAL,APCLSUB
Q
;
INFORM ;
W:$D(IOF) @IOF
W !,"Time and Services Report by Provider a Group of Provider Disciplines",!,"that you select.",!
W !,"This report displays by ",APCLSORT,", the number of patient",!,"contacts and the total activity and travel time for each provider",!,"with a discipline in the provider 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
K APCLLOC
S X="ENCOUNTER LOCATION",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" S APCLQ=1 Q
D PEP^AMQQGTX0(+Y,"APCLLOC(")
I '$D(APCLLOC) S APCLQ=1 Q
I $D(APCLLOC("*")) K APCLLOC W !!,$C(7),$C(7),"ALL locations is NOT an option with this choice",! G T
S X="" F S X=$O(APCLLOC(X)) Q:X="" S APCLLOC(X)=""
Q
;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
K APCLCLN
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" S APCLQ=1 Q
D PEP^AMQQGTX0(+Y,"APCLCLN(")
I '$D(APCLCLN) S APCLQ=1 Q
I $D(APCLCLN("*")) K APCLCLN W !!,$C(7),$C(7),"ALL CLINICs is NOT an option with this choice",! G TC
S X="" F S X=$O(APCLCLN(X)) Q:X="" S APCLCLN(X)=""
Q
;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
APCLCP1 ; IHS/CMI/LAB - DISC tally activity time ;
+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!!",!!
QUIT
+2 SET APCLSITE=DUZ(2)
+3 IF APCLSORV="APCLVLOC"
SET APCLNSP="APCLCP1"
SET APCLSORT="LOCATION OF ENCOUNTER"
+4 IF APCLSORV="APCLCODE"
SET APCLNSP="APCLCP2"
SET APCLSORT="PRIMARY DX"
+5 DO INFORM
+6 ;
GETGROUP ;
+1 WRITE !
SET DIC="^APCLACTG("
SET DIC("A")="Enter the Provider Discipline Group you wish to report on: "
SET DIC(0)="AEMQ"
DO ^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 ;
LOC ;get location
+1 KILL APCLLOC
+2 SET DIR(0)="S^O:One Location;T:Taxonomy of or Selected set of Locations;A:All Locations"
+3 SET DIR("A")="Include visits from which set of locations"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO BD
+5 IF Y="A"
KILL APCLLOC
GOTO CLINIC
+6 IF Y="O"
DO O
IF $DATA(APCLQ)
GOTO LOC
+7 IF Y="T"
DO T
IF $DATA(APCLQ)
GOTO LOC
CLINIC ;
+1 KILL APCLCLN
+2 SET DIR(0)="S^O:One Clinic;T:Taxonomy 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 LOC
+5 IF Y="A"
KILL APCLCLN
GOTO ZIS
+6 IF Y="O"
DO OC
IF $DATA(APCLQ)
GOTO CLINIC
+7 IF Y="T"
DO TC
IF $DATA(APCLQ)
GOTO CLINIC
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO CLINIC
+3 SET XBRP="^APCLCP1P"
SET XBRC="^APCLCP11"
SET XBRX="XIT^APCLCP1"
SET XBNS="APCL"
+4 DO ^XBDBQUE
+5 DO XIT
+6 QUIT
+7 ;
ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
XIT ;
+1 KILL APCL80S,APCLBDD,APCLBT,APCLDT,APCLED,APCLEDD,APCLLENG,APCLLOC,APCLPG,APCLQUIT,APCL1,APCL2,APCLAP,APCLDISC,APCLODAT,APCLSD,APCLSKIP,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLX,APCLY,APCLPRIM,APCLSITE,APCLBD
+2 KILL APCLACTG,APCLPIEC,APCLGLOB,APCLRRTN,APCLJOB
+3 KILL X,Z,X1,X2,IO("Q"),%,Y,DIRUT,POP,ZTSK,ZTQUEUED,T,S,M,TS,H,DIR,DUOUT,DTOUT,DUOUT,DLOUT,APCLNSP,APCLSORT,APCLZ,APCLSORV,APCLVAL,APCLSUB
+4 QUIT
+5 ;
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"Time and Services Report by Provider a Group of Provider Disciplines",!,"that you select.",!
+3 WRITE !,"This report displays by ",APCLSORT,", the number of patient",!,"contacts and the total activity and travel time for each provider",!,"with a discipline in the provider 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 KILL APCLLOC
+3 SET X="ENCOUNTER LOCATION"
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"
SET APCLQ=1
QUIT
+4 DO PEP^AMQQGTX0(+Y,"APCLLOC(")
+5 IF '$DATA(APCLLOC)
SET APCLQ=1
QUIT
+6 IF $DATA(APCLLOC("*"))
KILL APCLLOC
WRITE !!,$CHAR(7),$CHAR(7),"ALL locations is NOT an option with this choice",!
GOTO T
+7 SET X=""
FOR
SET X=$ORDER(APCLLOC(X))
IF X=""
QUIT
SET APCLLOC(X)=""
+8 QUIT
+9 ;S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=9999999.06" D ^DIC K DIC
+10 ;I Y=-1 S APCLQ="" Q
+11 ;S X=0 F S X=$O(^ATXAX(+Y,21,"B",X)) Q:X="" S APCLLOC(X)=""
+12 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 KILL APCLCLN
+3 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"
SET APCLQ=1
QUIT
+4 DO PEP^AMQQGTX0(+Y,"APCLCLN(")
+5 IF '$DATA(APCLCLN)
SET APCLQ=1
QUIT
+6 IF $DATA(APCLCLN("*"))
KILL APCLCLN
WRITE !!,$CHAR(7),$CHAR(7),"ALL CLINICs is NOT an option with this choice",!
GOTO TC
+7 SET X=""
FOR
SET X=$ORDER(APCLCLN(X))
IF X=""
QUIT
SET APCLCLN(X)=""
+8 QUIT
+9 ;S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=40.7" D ^DIC K DIC
+10 ;I Y=-1 S APCLQ="" Q
+11 ;S X=0 F S X=$O(^ATXAX(+Y,21,"B",X)) Q:X="" S APCLCLN(X)=""
+12 QUIT
