AMHRP2.m

AMHRP2 ; 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" 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="^AMHRP2P",XBRC="^AMHRP21",XBRX="XIT^AMHRP2",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,AMHPRV,AMHPSP

 K DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,Y

 Q

 ;

BROWSE ;

 S XBRP="VIEWR^XBLM(""^AMHRP2P"")"

 S XBNS="AMH",XBRC="^AMHRP21",XBRX="XIT^AMHRP2",XBIOP=0 D ^XBDBQUE

 Q

INFORM ;

 W:$D(IOF) @IOF

 W !,"****** ACTIVITY REPORT ******",!

 W !,"This report will tally activities by service unit, facility, and by ",!,"provider.",!

 D DBHUSR^AMHUTIL

 Q

 ;

 ;

AMHRP2    ; 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"

               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="^AMHRP2P"

           SET XBRC="^AMHRP21"

           SET XBRX="XIT^AMHRP2"

           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,AMHPRV,AMHPSP

 +3        KILL DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,Y

 +4        QUIT 

 +5       ;

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""^AMHRP2P"")"

 +2        SET XBNS="AMH"

           SET XBRC="^AMHRP21"

           SET XBRX="XIT^AMHRP2"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT 

INFORM    ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !,"****** ACTIVITY REPORT ******",!

 +3        WRITE !,"This report will tally activities by service unit, facility, and by ",!,"provider.",!

 +4        DO DBHUSR^AMHUTIL

 +5        QUIT 

 +6       ;

 +7       ;