Routine: APCLAP6

APCLAP6 ; IHS/CMI/LAB - APC visit counts by selected vars ;

 ;;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)

 S APCLJOB=$J,APCLBTH=$H

 D INFORM

DY ;determine whether to run yearly (calendar) or daily report

 K APCLDATE,APCLDY,APCLYEAR

 S DIR(0)="S^D:Daily Report;Y:Yearly Report",DIR("A")="Run which Report",DIR("B")="D" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) XIT

 S APCLDY=Y

 I APCLDY="Y" G Y

D ;which day?

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G DY

 S APCLDATE=Y

 S X1=APCLDATE,X2=-1 D C^%DTC S APCLSD=X S (APCLBD,APCLED)=APCLDATE

 G CL

Y ;which year

  S %DT="AE",%DT("A")="Enter the Calendar Year: ",%DT("B")=$E(DT,2,3) D ^%DT I $D(DTOUT) G DY

 I X="^" G DY

 I Y=-1 D ERR G Y

 I $E(Y,4,7)'="0000" D ERR G Y

 S APCLYEAR=Y,APCLBD=$E(Y,1,3)_"0101",APCLED=$E(Y,1,3)_1231,X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X

CL ;choose to tally by clinic or location

 K APCLLOC,APCLLOCT,APCLCLNT,APCLCLOC

 S DIR(0)="S^C:CLINIC;F:FACILITY (LOCATION)",DIR("A")="Do you wish to tally by",DIR("B")="C" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) DY

 S APCLCLOC=Y,APCLCLOC("NAME")=Y(0)

 G:APCLCLOC="F" F

CLINIC ;

 K APCLCLNT

 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" G XIT

 D PEP^AMQQGTX0(+Y,"APCLCLNT(")

 I '$D(APCLCLNT) G CL

 S C=0,X=0 F  S X=$O(APCLCLNT(X)) Q:X'=+X  S C=C+1

 I C>12 W !,$C(7),$C(7),"I can't fit ",C," clinics on this report, please select 1-12 clinics." G CLINIC

LOC ;get location

 S APCLLOC=$$GETLOC^APCLOCCK

 I APCLLOC=-1 G CL

 G ZIS

F ;enter location

 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 XIT

 D PEP^AMQQGTX0(+Y,"APCLLOCT(")

 I '$D(APCLLOCT) G CL

 S C=0,X=0 F  S X=$O(APCLLOCT(X)) Q:X'=+X  S C=C+1

 I C>12 W !,$C(7),$C(7),"I can't fit ",C," facilities on this report, please select 1-12 facilities." G F

ZIS ;call to XBDBQUE

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G LOC

 S XBRP="^APCLAP6P",XBRC="^APCLAP61",XBRX="XIT^APCLAP6",XBNS="APCL"

 D ^XBDBQUE

 D XIT

XIT ;

 K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,DA,D0,DR,DIC,DIE

ERR ;

 W !,$C(7),$C(7),"Enter a valid YEAR only!",!

INFORM ;

 W:$D(IOF) @IOF

 W !!,"This report will tally the number of visits by primary care providers, by",!,"provider at the locations or to the clinics that you specify.",!

 W !,"This report can be run for one day (daily report) or for a year (calendar).",!!

 W "A total number of 6 locations or clinics will fit on an 80 column report,",!,"you may specify up to 12 if you print the report with 132 columns."

APCLAP6   ; IHS/CMI/LAB - APC visit counts by selected vars ;

 +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        SET APCLJOB=$JOB

           SET APCLBTH=$HOROLOG

 +4        DO INFORM

 +5       ;

DY        ;determine whether to run yearly (calendar) or daily report

 +1        KILL APCLDATE,APCLDY,APCLYEAR

 +2        SET DIR(0)="S^D:Daily Report;Y:Yearly Report"

           SET DIR("A")="Run which Report"

           SET DIR("B")="D"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET APCLDY=Y

 +5        IF APCLDY="Y"

               GOTO Y

D         ;which day?

 +1        WRITE !

           SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter DATE"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO DY

 +3        SET APCLDATE=Y

 +4        SET X1=APCLDATE

           SET X2=-1

           DO C^%DTC

           SET APCLSD=X

           SET (APCLBD,APCLED)=APCLDATE

 +5        GOTO CL

Y         ;which year

 +1        SET %DT="AE"

           SET %DT("A")="Enter the Calendar Year: "

           SET %DT("B")=$EXTRACT(DT,2,3)

           DO ^%DT

           IF $DATA(DTOUT)

               GOTO DY

 +2        IF X="^"

               GOTO DY

 +3        IF Y=-1

               DO ERR

               GOTO Y

 +4        IF $EXTRACT(Y,4,7)'="0000"

               DO ERR

               GOTO Y

 +5        SET APCLYEAR=Y

           SET APCLBD=$EXTRACT(Y,1,3)_"0101"

           SET APCLED=$EXTRACT(Y,1,3)_1231

           SET X1=APCLBD

           SET X2=-1

           DO C^%DTC

           SET APCLSD=X

CL        ;choose to tally by clinic or location

 +1        KILL APCLLOC,APCLLOCT,APCLCLNT,APCLCLOC

 +2        SET DIR(0)="S^C:CLINIC;F:FACILITY (LOCATION)"

           SET DIR("A")="Do you wish to tally by"

           SET DIR("B")="C"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO DY

 +4        SET APCLCLOC=Y

           SET APCLCLOC("NAME")=Y(0)

 +5        IF APCLCLOC="F"

               GOTO F

CLINIC    ;

 +1        KILL APCLCLNT

 +2        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"

               GOTO XIT

 +3        DO PEP^AMQQGTX0(+Y,"APCLCLNT(")

 +4        IF '$DATA(APCLCLNT)

               GOTO CL

 +5        SET C=0

           SET X=0

FOR

               SET X=$ORDER(APCLCLNT(X))

               IF X'=+X

                   QUIT

               SET C=C+1

 +6        IF C>12

               WRITE !,$CHAR(7),$CHAR(7),"I can't fit ",C," clinics on this report, please select 1-12 clinics."

               GOTO CLINIC

LOC       ;get location

 +1        SET APCLLOC=$$GETLOC^APCLOCCK

 +2        IF APCLLOC=-1

               GOTO CL

 +3        GOTO ZIS

F         ;enter location

 +1        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 XIT

 +2        DO PEP^AMQQGTX0(+Y,"APCLLOCT(")

 +3        IF '$DATA(APCLLOCT)

               GOTO CL

 +4        SET C=0

           SET X=0

FOR

               SET X=$ORDER(APCLLOCT(X))

               IF X'=+X

                   QUIT

               SET C=C+1

 +5        IF C>12

               WRITE !,$CHAR(7),$CHAR(7),"I can't fit ",C," facilities on this report, please select 1-12 facilities."

               GOTO F

ZIS       ;call to XBDBQUE

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO LOC

 +3        SET XBRP="^APCLAP6P"

           SET XBRC="^APCLAP61"

           SET XBRX="XIT^APCLAP6"

           SET XBNS="APCL"

 +4        DO ^XBDBQUE

 +5        DO XIT

 +6        QUIT

XIT       ;

 +1        KILL X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,DA,D0,DR,DIC,DIE

 +2        QUIT

ERR       ;

 +1        WRITE !,$CHAR(7),$CHAR(7),"Enter a valid YEAR only!",!

 +2        QUIT

INFORM    ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,"This report will tally the number of visits by primary care providers, by",!,"provider at the locations or to the clinics that you specify.",!

 +3        WRITE !,"This report can be run for one day (daily report) or for a year (calendar).",!!

 +4        WRITE "A total number of 6 locations or clinics will fit on an 80 column report,",!,"you may specify up to 12 if you print the report with 132 columns."

 +5        QUIT

 +6       ;

APCLAP6.m