AMHRPPA ; IHS/CMI/LAB - TALLY PREVENTION ACTIVITIES ;
;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
;
START ;
D XIT
I '$D(IOF) D HOME^%ZIS
W @(IOF),!!
D INFORM
DATES K AMHED,AMHBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
D ^DIR G:Y<1 XIT S AMHBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
D ^DIR G:Y<1 XIT S AMHED=Y
;
I AMHED<AMHBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
;
PROG ;
S AMHPROG=""
S DIR(0)="S^O:ONE Program;A:ALL Programs",DIR("A")="Run the Report for which PROGRAM",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) DATES
I Y="A" G PROV
S DIR(0)="9002011,.02",DIR("A")="Which PROGRAM" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) PROG
I X="" G PROG
S AMHPROG=Y
PROV ;
K AMHQ
W !!,$G(IORVON)_"Please enter the Providers whose Prevention activities you want to tally."_$G(IORVOFF),!
S AMHPRVT=""
K AMHPRVS
S DIR(0)="S^A:ALL Providers;S:Selected set or Taxonomy of Providers;O:ONE Provider",DIR("A")="Include Visits to Which Providers",DIR("B")="A"
S DIR("A")="Enter a code indicating which providers are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
G:$D(DIRUT) PROG
S AMHPRVT=Y
I AMHPRVT="A" G DEMO
D @(AMHPRVT_"PRV")
G:$D(AMHQ) PROV
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G PROV
ZIS ;call xbdbque
S XBRC="DRIVER^AMHRPPA",XBRP="PRINT^AMHRPPA",XBRX="XIT^AMHRPPA",XBNS="AMH"
D ^XBDBQUE
D XIT
Q
DRIVER ;EP entry point for taskman
D PROCESS
S AMHET=$H
Q
XIT ;
K DIR
D EN^XBVK("AMH") ;clean up AMH variables
D ^XBFMK ;clean up fileman variables
Q
;
PROCESS ;
D XTMP^AMHUTIL("AMHRPPA","BH - PREVENTION ACTIVITIES")
S (AMHBT,AMHBTH)=$H,AMHJOB=$J
S AMHSD=$P(AMHBD,".")-1,AMHSD=AMHSD_".9999"
K AMHPRAT,AMHTARG S AMHGRTA=0,AMHGRTT=0,AMHGTPA=0
S (AMHRCNT,AMHVIEN)=0 F S AMHSD=$O(^AMHREC("B",AMHSD)) Q:AMHSD=""!($P(AMHSD,".")>$P(AMHED,".")) D
.S AMHVIEN=0 F S AMHVIEN=$O(^AMHREC("B",AMHSD,AMHVIEN)) Q:AMHVIEN'=+AMHVIEN D
..S AMHV0=$G(^AMHREC(AMHVIEN,0))
..Q:AMHV0=""
..Q:'$D(^AMHRPA("AD",AMHVIEN)) ;no prevention activities
..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHVIEN)
..I $P(AMHV0,U,8) Q:$$DEMO^AMHUTIL1($P(AMHV0,U,8),$G(AMHDEMO))
..I AMHPROG]"",$P(^AMHREC(AMHVIEN,0),U,2)'=AMHPROG Q ;not correct program visit
..S AMHVPP=$$PPINT^AMHUTIL(AMHVIEN)
..I AMHVPP="",$D(AMHPRVS) Q ;PRIM PROV blank and want certain PRIM PROVS
..I $D(AMHPRVS),'$D(AMHPRVS(AMHVPP)) Q ;not a PRIM PROV we want
..S AMHTAR=$$VAL^XBDIQ1(9002011,AMHVIEN,1106)
..I AMHTAR]"" S AMHGRTT=AMHGRTT+1,AMHTARG(AMHTAR)=$G(AMHTARG(AMHTAR))+1
..I AMHTAR="" S AMHGRTT=AMHGRTT+1,AMHTARG("NOT RECORDED")=$G(AMHTARG("NOT RECORDED"))+1
..S AMHGRTA=AMHGRTA+1
..S AMHX=0 F S AMHX=$O(^AMHRPA("AD",AMHVIEN,AMHX)) Q:AMHX'=+AMHX D
...S X=$$VAL^XBDIQ1(9002011.09,AMHX,.01)
...I X="OTHER" S Y=$E($$UP^XLFSTR($$VAL^XBDIQ1(9002011.09,AMHX,.04)),1,40) S X=$S(Y]"":Y,1:"OTHER - NO DETAIL GIVEN")
...S AMHPRAT(X)=$G(AMHPRAT(X))+1
...I AMHTAR]"" S AMHPRAT(X,AMHTAR)=$G(AMHPRAT(X,AMHTAR))+1
...I AMHTAR="" S AMHPRAT(X,"NOT RECORDED")=$G(AMHPRAT(X,"NOT RECORDED"))+1
...S AMHGTPA=AMHGTPA+1
..Q
.Q
S AMHET=$H
Q
;
PRINT ;EP - called from xbdbque
S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
S AMHPG=0
K AMHQUIT
D PRINT1
DONE I $D(AMHET) S AMHDVTS=(86400*($P(AMHET,",")-$P(AMHBT,",")))+($P(AMHET,",",2)-$P(AMHBT,",",2)),AMHDVH=$P(AMHDVTS/3600,".") S:AMHDVH="" AMHDVH=0
S AMHDVTS=AMHDVTS-(AMHDVH*3600),AMHDVM=$P(AMHDVTS/60,".") S:AMHDVM="" AMHDVM=0 S AMHDVTS=AMHDVTS-(AMHDVM*60),AMHDVS=AMHDVTS W !!,"RUN TIME (H.M.S): ",AMHDVH,".",AMHDVM,".",AMHDVS
I $E(IOST)="C",IO=IO(0) S DIR(0)="E" D ^DIR K DIR
W:$D(IOF) @IOF
Q
PRINT1 ;
D HEAD
I '$D(AMHPRAT) W !!,"There are no visits with Prevention Activities Recorded." Q
W !!,"Total # Visits w/Prevention Activity: ",?45,$$C(AMHGRTA,0)
W !,"Total # of Prevention Activities recorded: ",?45,$$C(AMHGTPA,0)
S AMHS="" F S AMHS=$O(AMHPRAT(AMHS)) Q:AMHS=""!($D(AMHQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
.S AMHX=AMHPRAT(AMHS)
.W !!?1,AMHS,?45,$$C(AMHX,0),?60,$J(((AMHX/AMHGRTA)*100),5,1)
.S AMHY="" F S AMHY=$O(AMHPRAT(AMHS,AMHY)) Q:AMHY=""!($D(AMHQUIT)) D
..I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
..W !?4,AMHY
..S AMHZ=AMHPRAT(AMHS,AMHY)
..W ?20,$$C(AMHZ,0),?28,$J(((AMHZ/AMHX)*100),5,1)
Q:$D(AMHQUIT)
I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
W !!,"TARGET TOTALS",!
S AMHX="" F S AMHX=$O(AMHTARG(AMHX)) Q:AMHX=""!($D(AMHQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
.W !?4,AMHX,?20,$$C(AMHTARG(AMHX),0),?28,$J(((AMHTARG(AMHX)/AMHGRTT)*100),5,1)
Q
PAGEHEAD ;
HEAD ;EP;HEADER
I 'AMHPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S AMHPG=AMHPG+1
W !,$$FMTE^XLFDT(DT),?70,"Page: ",AMHPG
W !?29,"Behavioral Health"
W !,$$CTR($$REPEAT^XLFSTR("*",36),80)
W !,$$CTR("* TALLY OF PREVENTION ACTIVITIES *",80)
W !,$$CTR($$REPEAT^XLFSTR("*",36),80)
S X="VISIT Date Range: "_AMHBDD_" through "_AMHEDD W !,$$CTR(X,80)
I AMHPROG]"" S X="Program: "_$$EXTSET^XBFUNC(9002011,.02,AMHPROG) W !,$$CTR(X,80),!
W !?5,"PREVENTION ACTIVITY",?45,"# of visits",?60,"% of visits"
W !,$$REPEAT^XLFSTR("-",80)
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q $$STRIP^XLFSTR(X," ")
D(D) ;
I $G(D)="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="End of report. Press Enter",DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
INFORM ;inform user what this report is all about
W !,$$CTR($$LOC)
W !!,$$CTR("BEHAVIORAL HEALTH PREVENTION ACTIVITIES")
W !!,"This report will produce a count of all visits with a prevention"
W !,"activity entered. It will also produce a tally/count of those"
W !,"prevention activities with Target Audience subtotals."
W !
D DBHUSR^AMHUTIL
Q
OPRV ;one PROVIDER
S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC K DIC
I Y=-1 S AMHQ="" Q
S AMHPRVS(+Y)=""
Q
SPRV ;taxonomy of PROVIDERS
S X="PRIMARY PROVIDER",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,"AMHPRVS(")
I '$D(AMHPRVS) S AMHQ="" Q
I $D(AMHPRVS("*")) S AMHPRVT="A" K AMHPRVS W !!,"**** all PROVIDERS will be included ****",! Q
Q
;
AMHRPPA ; IHS/CMI/LAB - TALLY PREVENTION ACTIVITIES ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
+2 ;
START ;
+1 DO XIT
+2 IF '$DATA(IOF)
DO HOME^%ZIS
+3 WRITE @(IOF),!!
+4 DO INFORM
DATES KILL AMHED,AMHBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Visit Date"
+2 DO ^DIR
IF Y<1
GOTO XIT
SET AMHBD=Y
+3 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Visit Date"
+4 DO ^DIR
IF Y<1
GOTO XIT
SET AMHED=Y
+5 ;
+6 IF AMHED<AMHBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+8 SET AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
+9 ;
PROG ;
+1 SET AMHPROG=""
+2 SET DIR(0)="S^O:ONE Program;A:ALL Programs"
SET DIR("A")="Run the Report for which PROGRAM"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO DATES
+4 IF Y="A"
GOTO PROV
+5 SET DIR(0)="9002011,.02"
SET DIR("A")="Which PROGRAM"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO PROG
+7 IF X=""
GOTO PROG
+8 SET AMHPROG=Y
PROV ;
+1 KILL AMHQ
+2 WRITE !!,$GET(IORVON)_"Please enter the Providers whose Prevention activities you want to tally."_$GET(IORVOFF),!
+3 SET AMHPRVT=""
+4 KILL AMHPRVS
+5 SET DIR(0)="S^A:ALL Providers;S:Selected set or Taxonomy of Providers;O:ONE Provider"
SET DIR("A")="Include Visits to Which Providers"
SET DIR("B")="A"
+6 SET DIR("A")="Enter a code indicating which providers are of interest"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR,DA
+7 IF $DATA(DIRUT)
GOTO PROG
+8 SET AMHPRVT=Y
+9 IF AMHPRVT="A"
GOTO DEMO
+10 DO @(AMHPRVT_"PRV")
+11 IF $DATA(AMHQ)
GOTO PROV
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO PROV
ZIS ;call xbdbque
+1 SET XBRC="DRIVER^AMHRPPA"
SET XBRP="PRINT^AMHRPPA"
SET XBRX="XIT^AMHRPPA"
SET XBNS="AMH"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
DRIVER ;EP entry point for taskman
+1 DO PROCESS
+2 SET AMHET=$HOROLOG
+3 QUIT
XIT ;
+1 KILL DIR
+2 ;clean up AMH variables
DO EN^XBVK("AMH")
+3 ;clean up fileman variables
DO ^XBFMK
+4 QUIT
+5 ;
PROCESS ;
+1 DO XTMP^AMHUTIL("AMHRPPA","BH - PREVENTION ACTIVITIES")
+2 SET (AMHBT,AMHBTH)=$HOROLOG
SET AMHJOB=$JOB
+3 SET AMHSD=$PIECE(AMHBD,".")-1
SET AMHSD=AMHSD_".9999"
+4 KILL AMHPRAT,AMHTARG
SET AMHGRTA=0
SET AMHGRTT=0
SET AMHGTPA=0
+5 SET (AMHRCNT,AMHVIEN)=0
FOR
SET AMHSD=$ORDER(^AMHREC("B",AMHSD))
IF AMHSD=""!($PIECE(AMHSD,".")>$PIECE(AMHED,"."))
QUIT
Begin DoDot:1
+6 SET AMHVIEN=0
FOR
SET AMHVIEN=$ORDER(^AMHREC("B",AMHSD,AMHVIEN))
IF AMHVIEN'=+AMHVIEN
QUIT
Begin DoDot:2
+7 SET AMHV0=$GET(^AMHREC(AMHVIEN,0))
+8 IF AMHV0=""
QUIT
+9 ;no prevention activities
IF '$DATA(^AMHRPA("AD",AMHVIEN))
QUIT
+10 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHVIEN)
QUIT
+11 IF $PIECE(AMHV0,U,8)
IF $$DEMO^AMHUTIL1($PIECE(AMHV0,U,8),$GET(AMHDEMO))
QUIT
+12 ;not correct program visit
IF AMHPROG]""
IF $PIECE(^AMHREC(AMHVIEN,0),U,2)'=AMHPROG
QUIT
+13 SET AMHVPP=$$PPINT^AMHUTIL(AMHVIEN)
+14 ;PRIM PROV blank and want certain PRIM PROVS
IF AMHVPP=""
IF $DATA(AMHPRVS)
QUIT
+15 ;not a PRIM PROV we want
IF $DATA(AMHPRVS)
IF '$DATA(AMHPRVS(AMHVPP))
QUIT
+16 SET AMHTAR=$$VAL^XBDIQ1(9002011,AMHVIEN,1106)
+17 IF AMHTAR]""
SET AMHGRTT=AMHGRTT+1
SET AMHTARG(AMHTAR)=$GET(AMHTARG(AMHTAR))+1
+18 IF AMHTAR=""
SET AMHGRTT=AMHGRTT+1
SET AMHTARG("NOT RECORDED")=$GET(AMHTARG("NOT RECORDED"))+1
+19 SET AMHGRTA=AMHGRTA+1
+20 SET AMHX=0
FOR
SET AMHX=$ORDER(^AMHRPA("AD",AMHVIEN,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:3
+21 SET X=$$VAL^XBDIQ1(9002011.09,AMHX,.01)
+22 IF X="OTHER"
SET Y=$EXTRACT($$UP^XLFSTR($$VAL^XBDIQ1(9002011.09,AMHX,.04)),1,40)
SET X=$SELECT(Y]"":Y,1:"OTHER - NO DETAIL GIVEN")
+23 SET AMHPRAT(X)=$GET(AMHPRAT(X))+1
+24 IF AMHTAR]""
SET AMHPRAT(X,AMHTAR)=$GET(AMHPRAT(X,AMHTAR))+1
+25 IF AMHTAR=""
SET AMHPRAT(X,"NOT RECORDED")=$GET(AMHPRAT(X,"NOT RECORDED"))+1
+26 SET AMHGTPA=AMHGTPA+1
End DoDot:3
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 SET AMHET=$HOROLOG
+30 QUIT
+31 ;
PRINT ;EP - called from xbdbque
+1 SET Y=AMHBD
DO DD^%DT
SET AMHBDD=Y
SET Y=AMHED
DO DD^%DT
SET AMHEDD=Y
+2 SET AMHPG=0
+3 KILL AMHQUIT
+4 DO PRINT1
DONE IF $DATA(AMHET)
SET AMHDVTS=(86400*($PIECE(AMHET,",")-$PIECE(AMHBT,",")))+($PIECE(AMHET,",",2)-$PIECE(AMHBT,",",2))
SET AMHDVH=$PIECE(AMHDVTS/3600,".")
IF AMHDVH=""
SET AMHDVH=0
+1 SET AMHDVTS=AMHDVTS-(AMHDVH*3600)
SET AMHDVM=$PIECE(AMHDVTS/60,".")
IF AMHDVM=""
SET AMHDVM=0
SET AMHDVTS=AMHDVTS-(AMHDVM*60)
SET AMHDVS=AMHDVTS
WRITE !!,"RUN TIME (H.M.S): ",AMHDVH,".",AMHDVM,".",AMHDVS
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
PRINT1 ;
+1 DO HEAD
+2 IF '$DATA(AMHPRAT)
WRITE !!,"There are no visits with Prevention Activities Recorded."
QUIT
+3 WRITE !!,"Total # Visits w/Prevention Activity: ",?45,$$C(AMHGRTA,0)
+4 WRITE !,"Total # of Prevention Activities recorded: ",?45,$$C(AMHGTPA,0)
+5 SET AMHS=""
FOR
SET AMHS=$ORDER(AMHPRAT(AMHS))
IF AMHS=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+7 SET AMHX=AMHPRAT(AMHS)
+8 WRITE !!?1,AMHS,?45,$$C(AMHX,0),?60,$JUSTIFY(((AMHX/AMHGRTA)*100),5,1)
+9 SET AMHY=""
FOR
SET AMHY=$ORDER(AMHPRAT(AMHS,AMHY))
IF AMHY=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:2
+10 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+11 WRITE !?4,AMHY
+12 SET AMHZ=AMHPRAT(AMHS,AMHY)
+13 WRITE ?20,$$C(AMHZ,0),?28,$JUSTIFY(((AMHZ/AMHX)*100),5,1)
End DoDot:2
End DoDot:1
+14 IF $DATA(AMHQUIT)
QUIT
+15 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+16 WRITE !!,"TARGET TOTALS",!
+17 SET AMHX=""
FOR
SET AMHX=$ORDER(AMHTARG(AMHX))
IF AMHX=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+18 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+19 WRITE !?4,AMHX,?20,$$C(AMHTARG(AMHX),0),?28,$JUSTIFY(((AMHTARG(AMHX)/AMHGRTT)*100),5,1)
End DoDot:1
+20 QUIT
PAGEHEAD ;
HEAD ;EP;HEADER
+1 IF 'AMHPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET AMHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHPG=AMHPG+1
+2 WRITE !,$$FMTE^XLFDT(DT),?70,"Page: ",AMHPG
+3 WRITE !?29,"Behavioral Health"
+4 WRITE !,$$CTR($$REPEAT^XLFSTR("*",36),80)
+5 WRITE !,$$CTR("* TALLY OF PREVENTION ACTIVITIES *",80)
+6 WRITE !,$$CTR($$REPEAT^XLFSTR("*",36),80)
+7 SET X="VISIT Date Range: "_AMHBDD_" through "_AMHEDD
WRITE !,$$CTR(X,80)
+8 IF AMHPROG]""
SET X="Program: "_$$EXTSET^XBFUNC(9002011,.02,AMHPROG)
WRITE !,$$CTR(X,80),!
+9 WRITE !?5,"PREVENTION ACTIVITY",?45,"# of visits",?60,"% of visits"
+10 WRITE !,$$REPEAT^XLFSTR("-",80)
+11 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT $$STRIP^XLFSTR(X," ")
D(D) ;
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="End of report. Press Enter"
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
INFORM ;inform user what this report is all about
+1 WRITE !,$$CTR($$LOC)
+2 WRITE !!,$$CTR("BEHAVIORAL HEALTH PREVENTION ACTIVITIES")
+3 WRITE !!,"This report will produce a count of all visits with a prevention"
+4 WRITE !,"activity entered. It will also produce a tally/count of those"
+5 WRITE !,"prevention activities with Target Audience subtotals."
+6 WRITE !
+7 DO DBHUSR^AMHUTIL
+8 QUIT
OPRV ;one PROVIDER
+1 SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Which PROVIDER: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET AMHQ=""
QUIT
+3 SET AMHPRVS(+Y)=""
+4 QUIT
SPRV ;taxonomy of PROVIDERS
+1 SET X="PRIMARY PROVIDER"
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,"AMHPRVS(")
+3 IF '$DATA(AMHPRVS)
SET AMHQ=""
QUIT
+4 IF $DATA(AMHPRVS("*"))
SET AMHPRVT="A"
KILL AMHPRVS
WRITE !!,"**** all PROVIDERS will be included ****",!
QUIT
+5 QUIT
+6 ;
