APCLCP1.m

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