Routine: AMHRPS

AMHRPS ; IHS/CMI/LAB - SUICIDE REPORT ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28

START ;

 I '$D(IOF) D HOME^%ZIS

 W @(IOF),!!

 K AMHQUIT

 I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q

 I '$D(AMHTITLE) W !!,$C(7),$C(7),"Report type missing!",! K AMHQUIT Q

 D INFORM

GETDATES ;

BD ;get beginning date

 W !,"Please enter the date range during which the patient should have been seen ",!,"with one of these problems.",!

 S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Visit 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 Visit 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 S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

AGEGRP ;GET AGE GROUPS

 W !!

 D SETBIN

BIN ;

 W !,"The Age Groups to be used are currently defined as:",! D LIST

 S DIR(0)="YO",DIR("A")="Do you wish to modify these age groups" D ^DIR K DIR

 I $D(DIRUT) S AMHQUIT="" G BD

 I Y=0 G ZIS

RUN ;

 K AMHQUIT S AMHRY="",AMHRA=-1 W ! F  D AGE Q:AMHRX=""  I $D(AMHQUIT) G BIN

 D CLOSE I $D(AMHQUIT) G BIN

 D LIST

 G BIN

AGE ;

 S AMHRX=""

 S DIR(0)="NO^0:150:0",DIR("A")="Enter the starting age of the "_$S(AMHRY="":"first",1:"next")_" age group" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DUOUT)!($D(DTOUT)) S AMHQUIT="" Q

 S AMHRX=Y

 I Y="" Q

 I AMHRX?1.3N,AMHRX>AMHRA D SET Q

 W $C(7) W !,"Make sure the age is higher the beginning age of the previous group.",! G RUN

SET S AMHRA=AMHRX

 I AMHRY="" S AMHRY=AMHRX Q

 S AMHRY=AMHRY_"-"_(AMHRX-1)_";"_AMHRX

CLOSE I AMHRY="" Q

GC ;

 S DIR(0)="NO^0:150:0",DIR("A")="Enter the highest age for the last group" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DUOUT)!($D(DTOUT)) S AMHQUIT="" Q

 S AMHRX=Y I Y="" S AMHRX=199

 I AMHRX?1.3N,AMHRX'<AMHRA S AMHRY=AMHRY_"-"_AMHRX,AMHRBIN=AMHRY Q

 W "  ??",$C(7) G CLOSE

LIST ;

 S %=AMHRBIN

 F I=1:1 S X=$P(%,";",I) Q:X=""  W !,$P(X,"-")," - ",$P(X,"-",2)

W !

SETBIN ;

 S AMHRBIN="0-0;1-4;5-14;15-19;20-24;25-44;45-64;65-125"

ZIS ;

DEMO ;

 D DEMOCHK^AMHUTIL1(.AMHDEMO)

 I AMHDEMO=-1 G XIT

 W !,$C(7),"This report should be printed on 132 column paper or on a printer with ",!,"condensed print.",!

 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 XBRC="^AMHRPS1",XBRP="^AMHRPSP",XBNS="AMH",XBRX="XIT^AMHRPS"

 D ^XBDBQUE

XIT K ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPROV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D

 K AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP

BROWSE ;

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

 S XBNS="AMH",XBRC="^AMHRPS1",XBRX="XIT^AMHRPS",XBIOP=0 D ^XBDBQUE

INFORM ;inform user what this report is all about

 W !,AMHTITLE

 I AMHTITLE="ABUSE REPORT" D  I 1

 .W !,"This report focuses on patients who may have been victims of abuse or "

 .W !,"neglect.  It will present, by age and sex, the number of individual"

 .W !,"patients who were seen for the following Purpose of Visits (POV): "

 E  W !,"This report will present, by age and sex, the number of individual patients",!,"who were seen for the following Purpose of Visits (POV):",!

 S AMHX="" F  S AMHX=$O(AMHPROB(AMHX)) Q:AMHX=""  S AMHY=0 F  S AMHY=$O(^AMHPROB("B",AMHX,AMHY)) Q:AMHY'=+AMHY  D

 .I $Y>(IOSL-4) D PAUSE^AMHLEA  W:$D(IOF) @IOF

 .I AMHY]"" W !?10,$P(^AMHPROB(AMHY,0),U)," - ",$P(^AMHPROB(AMHY,0),U,2)

 D DBHUSR^AMHUTIL

AMHRPS    ; IHS/CMI/LAB - SUICIDE REPORT ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28

 +2       ;

START     ;

 +1        IF '$DATA(IOF)

               DO HOME^%ZIS

 +2        WRITE @(IOF),!!

 +3        KILL AMHQUIT

 +4        IF '$GET(DUZ(2))

               WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!

               QUIT

 +5        IF '$DATA(AMHTITLE)

               WRITE !!,$CHAR(7),$CHAR(7),"Report type missing!",!

               KILL AMHQUIT

               QUIT

 +6        DO INFORM

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !,"Please enter the date range during which the patient should have been seen ",!,"with one of these problems.",!

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

           SET DIR("A")="Enter Beginning Visit Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

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

           SET DIR("A")="Enter Ending Visit 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

           SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

 +5       ;

AGEGRP    ;GET AGE GROUPS

 +1        WRITE !!

 +2        DO SETBIN

BIN       ;

 +1        WRITE !,"The Age Groups to be used are currently defined as:",!

           DO LIST

 +2        SET DIR(0)="YO"

           SET DIR("A")="Do you wish to modify these age groups"

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET AMHQUIT=""

               GOTO BD

 +4        IF Y=0

               GOTO ZIS

RUN       ;

 +1        KILL AMHQUIT

           SET AMHRY=""

           SET AMHRA=-1

           WRITE !

FOR

               DO AGE

               IF AMHRX=""

                   QUIT

               IF $DATA(AMHQUIT)

                   GOTO BIN

 +2        DO CLOSE

           IF $DATA(AMHQUIT)

               GOTO BIN

 +3        DO LIST

 +4        GOTO BIN

 +5       ;

AGE       ;

 +1        SET AMHRX=""

 +2        SET DIR(0)="NO^0:150:0"

           SET DIR("A")="Enter the starting age of the "_$SELECT(AMHRY="":"first",1:"next")_" age group"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DUOUT)!($DATA(DTOUT))

               SET AMHQUIT=""

               QUIT

 +4        SET AMHRX=Y

 +5        IF Y=""

               QUIT

 +6        IF AMHRX?1.3N

               IF AMHRX>AMHRA

                   DO SET

                   QUIT

 +7        WRITE $CHAR(7)

           WRITE !,"Make sure the age is higher the beginning age of the previous group.",!

           GOTO RUN

 +8       ;

SET        SET AMHRA=AMHRX

 +1        IF AMHRY=""

               SET AMHRY=AMHRX

               QUIT

 +2        SET AMHRY=AMHRY_"-"_(AMHRX-1)_";"_AMHRX

 +3        QUIT

 +4       ;

CLOSE      IF AMHRY=""

               QUIT

GC        ;

 +1        SET DIR(0)="NO^0:150:0"

           SET DIR("A")="Enter the highest age for the last group"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))

               SET AMHQUIT=""

               QUIT

 +3        SET AMHRX=Y

           IF Y=""

               SET AMHRX=199

 +4        IF AMHRX?1.3N

               IF AMHRX'<AMHRA

                   SET AMHRY=AMHRY_"-"_AMHRX

                   SET AMHRBIN=AMHRY

                   QUIT

 +5        WRITE "  ??",$CHAR(7)

           GOTO CLOSE

 +6        QUIT

 +7       ;

 +8       ;

LIST      ;

 +1        SET %=AMHRBIN

 +2        FOR I=1:1

               SET X=$PIECE(%,";",I)

               IF X=""

                   QUIT

               WRITE !,$PIECE(X,"-")," - ",$PIECE(X,"-",2)

 +3        WRITE !

 +4        QUIT

 +5       ;

SETBIN    ;

 +1        SET AMHRBIN="0-0;1-4;5-14;15-19;20-24;25-44;45-64;65-125"

 +2        QUIT

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^AMHUTIL1(.AMHDEMO)

 +2        IF AMHDEMO=-1

               GOTO XIT

 +3        WRITE !,$CHAR(7),"This report should be printed on 132 column paper or on a printer with ",!,"condensed print.",!

 +4        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

 +5        IF $DATA(DIRUT)

               GOTO XIT

 +6        IF $GET(Y)="B"

               DO BROWSE

               DO XIT

               QUIT

 +7        SET XBRC="^AMHRPS1"

           SET XBRP="^AMHRPSP"

           SET XBNS="AMH"

           SET XBRX="XIT^AMHRPS"

 +8        DO ^XBDBQUE

XIT        KILL ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPROV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D

 +1        KILL AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP

 +2        QUIT

 +3       ;

BROWSE    ;

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

 +2        SET XBNS="AMH"

           SET XBRC="^AMHRPS1"

           SET XBRX="XIT^AMHRPS"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

INFORM    ;inform user what this report is all about

 +1        WRITE !,AMHTITLE

 +2        IF AMHTITLE="ABUSE REPORT"

               Begin DoDot:1

 +3                WRITE !,"This report focuses on patients who may have been victims of abuse or "

 +4                WRITE !,"neglect.  It will present, by age and sex, the number of individual"

 +5                WRITE !,"patients who were seen for the following Purpose of Visits (POV): "

               End DoDot:1

               IF 1

 +6       IF '$TEST

               WRITE !,"This report will present, by age and sex, the number of individual patients",!,"who were seen for the following Purpose of Visits (POV):",!

 +7        SET AMHX=""

FOR

               SET AMHX=$ORDER(AMHPROB(AMHX))

               IF AMHX=""

                   QUIT

               SET AMHY=0

FOR

                   SET AMHY=$ORDER(^AMHPROB("B",AMHX,AMHY))

                   IF AMHY'=+AMHY

                       QUIT

                   Begin DoDot:1

 +8                    IF $Y>(IOSL-4)

                           DO PAUSE^AMHLEA

                           IF $DATA(IOF)

                               WRITE @IOF

 +9                    IF AMHY]""

                           WRITE !?10,$PIECE(^AMHPROB(AMHY,0),U)," - ",$PIECE(^AMHPROB(AMHY,0),U,2)

                   End DoDot:1

 +10       DO DBHUSR^AMHUTIL

 +11       QUIT

AMHRPS.m