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
Q
;
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
Q
;
;
LIST ;
S %=AMHRBIN
F I=1:1 S X=$P(%,";",I) Q:X="" W !,$P(X,"-")," - ",$P(X,"-",2)
W !
Q
;
SETBIN ;
S AMHRBIN="0-0;1-4;5-14;15-19;20-24;25-44;45-64;65-125"
Q
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
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""^AMHRPSP"")"
S XBNS="AMH",XBRC="^AMHRPS1",XBRX="XIT^AMHRPS",XBIOP=0 D ^XBDBQUE
Q
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
Q
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
