AMHRP3 ; IHS/CMI/LAB - All visit report driver ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
START ;
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! K AMHSITE Q
S AMHJOB=$J,AMHBTH=$H
D INFORM
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Encounter Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G XIT
S AMHBD=Y
ED ;get ending date
W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter ending Encounter Date" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S AMHED=Y
S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X
;
PROG ;select program to run report for
S AMHPROG=""
S DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER;A:ALL",DIR("A")="Run Report for which Program",DIR("B")="M" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) BD
S AMHPROG=Y,AMHPROG=$S(AMHPROG="A":"",1:AMHPROG)
PRV ;
S DIR(0)="S^1:ONE PROVIDER;2:ALL PROVIDERS",DIR("A")="Run Report for",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G PROG
S AMHS=Y
S AMHPRV=0
I AMHS=1 S DIC=200,DIC(0)="AEQMZ",DIC("A")="Enter PROVIDER: " D ^DIC G PRV:Y<0 S AMHPRV=+Y
PS ;
S AMHPSP=""
S DIR(0)="S^P:Primary Provider Only;S:Both Primary and Secondary Providers",DIR("A")="Include which providers",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PRV
S AMHPSP=Y
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G PS
ZIS ;CALL TO XBDBQUE
S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) G XIT
I $G(Y)="B" D BROWSE,XIT Q
S XBRP="^AMHRP3P",XBRC="^AMHRP31",XBRX="XIT^AMHRP3",XBNS="AMH"
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 ;EP
K AMHACT,AMHAREA,AMHAT,AMHATOT,AMHBD,AMHBDD,AMHBT,AMHBTH,AMHDISC,AMHDT,AMHED,AMHEDD,AMHET,AMHFTOT,AMHJOB,AMHLENG,AMHLOC,AMHLTOT,AMHODAT,AMHPAT,AMHPG,AMHPNAME,AMHPROG,AMHPROV,AMHPTOT,AMHQUIT,AMHR,AMHR0,AMHRCNT,AMHREC,AMHSD,AMHSITE,AMHSTOT
K AMHSU,AMHX,AMHACTOT,AMHATOT,AMHPRV,AMHPSP
K DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,Y
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""^AMHRP3P"")"
S XBNS="AMH",XBRC="^AMHRP31",XBRX="XIT^AMHRP3",XBIOP=0 D ^XBDBQUE
Q
INFORM ;
W:$D(IOF) @IOF
W !,"****** ACTIVITY BY PRIMARY PUPOSE REPORT ******",!
W !,"This report will tally PRIMARY problems by service unit, facility, and by ",!,"provider and activity.",!
D DBHUSR^AMHUTIL
Q
;
;
AMHRP3 ; IHS/CMI/LAB - All visit report driver ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
START ;
+1 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
KILL AMHSITE
QUIT
+2 SET AMHJOB=$JOB
SET AMHBTH=$HOROLOG
+3 DO INFORM
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Encounter Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET AMHBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="D^"_AMHBD_":DT:EP"
SET DIR("A")="Enter ending Encounter Date"
SET Y=AMHBD
DO DD^%DT
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET AMHED=Y
+4 SET X1=AMHBD
SET X2=-1
DO C^%DTC
SET AMHSD=X
+5 ;
PROG ;select program to run report for
+1 SET AMHPROG=""
+2 SET DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER;A:ALL"
SET DIR("A")="Run Report for which Program"
SET DIR("B")="M"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO BD
+4 SET AMHPROG=Y
SET AMHPROG=$SELECT(AMHPROG="A":"",1:AMHPROG)
PRV ;
+1 SET DIR(0)="S^1:ONE PROVIDER;2:ALL PROVIDERS"
SET DIR("A")="Run Report for"
SET DIR("B")="1"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO PROG
+3 SET AMHS=Y
+4 SET AMHPRV=0
+5 IF AMHS=1
SET DIC=200
SET DIC(0)="AEQMZ"
SET DIC("A")="Enter PROVIDER: "
DO ^DIC
IF Y<0
GOTO PRV
SET AMHPRV=+Y
PS ;
+1 SET AMHPSP=""
+2 SET DIR(0)="S^P:Primary Provider Only;S:Both Primary and Secondary Providers"
SET DIR("A")="Include which providers"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO PRV
+4 SET AMHPSP=Y
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO PS
ZIS ;CALL TO XBDBQUE
+1 SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to "
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+4 SET XBRP="^AMHRP3P"
SET XBRC="^AMHRP31"
SET XBRX="XIT^AMHRP3"
SET XBNS="AMH"
+5 DO ^XBDBQUE
+6 DO XIT
+7 QUIT
ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
XIT ;EP
+1 KILL AMHACT,AMHAREA,AMHAT,AMHATOT,AMHBD,AMHBDD,AMHBT,AMHBTH,AMHDISC,AMHDT,AMHED,AMHEDD,AMHET,AMHFTOT,AMHJOB,AMHLENG,AMHLOC,AMHLTOT,AMHODAT,AMHPAT,AMHPG,AMHPNAME,AMHPROG,AMHPROV,AMHPTOT,AMHQUIT,AMHR,AMHR0,AMHRCNT,AMHREC,AMHSD,AMHSITE,AMHSTOT
+2 KILL AMHSU,AMHX,AMHACTOT,AMHATOT,AMHPRV,AMHPSP
+3 KILL DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,Y
+4 QUIT
+5 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^AMHRP3P"")"
+2 SET XBNS="AMH"
SET XBRC="^AMHRP31"
SET XBRX="XIT^AMHRP3"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"****** ACTIVITY BY PRIMARY PUPOSE REPORT ******",!
+3 WRITE !,"This report will tally PRIMARY problems by service unit, facility, and by ",!,"provider and activity.",!
+4 DO DBHUSR^AMHUTIL
+5 QUIT
+6 ;
+7 ;
