AMHRPSU1 ; IHS/CMI/LAB - Suicide Form data element tally ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,8**;JUN 02, 2010;Build 7
;
;
START ;
W:$D(IOF) @IOF
D EOJ
W:$D(IOF) @IOF
W !!,"IHS Aggregate Suicide Form Data - Standard"
W !!,"This report will tally the data items specific to the Suicide"
W !,"Form for a date range, community and type of suicidal behavior"
W !,"act as specified by the user."
W !
D DBHUSRP^AMHUTIL
GETDATES ;
BD ;
S DIR(0)="D^::EP",DIR("A")="Enter Beginning Date of Suicide Act",DIR("?")="Enter the beginning date of suicide act for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) EOJ
S AMHBD=Y
ED ;
S DIR(0)="DA^::EP",DIR("A")="Enter Ending Date of Suicide Act: " D ^DIR K DIR,DA S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) EOJ
I Y<AMHBD W !,"Ending date must be greater than or equal to beginning date!" G ED
S AMHED=Y
S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X
COMM ;
K AMHCOMM
S DIR(0)="S^O:One particular Community;A:All Communities",DIR("A")="Report on Suicide Forms for Suicide Acts that occurred in",DIR("B")="O" K DA D ^DIR K DIR
G:$D(DIRUT) GETDATES
I Y="A" W !!,"All communities will be included in the report.",! G SELF
I Y="O" D G:'$D(AMHCOMM) COMM G:$D(AMHCOMM) SELF I 1
.S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Which COMMUNITY: " D ^DIC K DIC
.Q:Y=-1
.S AMHCOMM(+Y)=""
S X="COMMUNITY",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 GETDATES
D PEP^AMQQGTX0(+Y,"AMHCOMM(")
I '$D(AMHCOMM) G COMM
I $D(AMHCOMM("*")) K AMHCOMM
SELF ;
K AMHSELF
W !?5,1,?10,"IDEATION WITH PLAN AND INTENT"
W !?5,2,?10,"ATTEMPT"
W !?5,3,?10,"COMPLETED SUICIDE"
W !?5,4,?10,"ATTEMPTED SUICIDE WITH HOMICIDE (INACTIVE)"
W !?5,5,?10,"COMPLETED SUICIDE WITH HOMICIDE (INACTIVE)"
W !?5,6,?10,"ATTEMPTED SUICIDE WITH ATTEMPTED HOMICIDE"
W !?5,7,?10,"ATTEMPTED SUICIDE WITH COMPLETED HOMICIDE"
W !?5,8,?10,"COMPLETED SUICIDE WITH ATTEMPTED HOMICIDE"
W !?5,9,?10,"COMPLETED SUICIDE WITH COMPLETED HOMICIDE"
W !?5,0,?10,"ALL OF THE ABOVE (ALSO INCLUDES BLANKS)"
S DIR(0)="L^0:9",DIR("A")="Include which Suicidal Behaviors",DIR("B")="0" KILL DA D ^DIR KILL DIR
S AMHANS=Y,AMHC="" F AMHI=1:1 S AMHC=$P(AMHANS,",",AMHI) Q:AMHC="" S AMHSELF(AMHC)=""
I AMHANS[0 F X=1:1:9 S AMHSELF(X)=""
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G SELF
ZIS ;
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 EOJ
I $G(Y)="B" D BROWSE,EOJ Q
W !! S XBRP="PRINT^AMHRPSU1",XBRC="PROC^AMHRPSU1",XBNS="AMH",XBRX="EOJ^AMHRPSU1"
D ^XBDBQUE
D EOJ
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^AMHRPSU1"")"
S XBNS="AMH",XBRC="PROC^AMHRPSU1",XBRX="EOJ^AMHRPSU1",XBIOP=0 D ^XBDBQUE
Q
;
PAUSE ;
S DIR(0)="E",DIR("A")="Press return to continue or '^' to quit" D ^DIR K DIR,DA
S:$D(DIRUT) AMHQUIT=1
W:$D(IOF) @IOF
Q
EOJ ;EP
D EN^XBVK("AMH")
K L,M,S,T,X,X1,X2,Y,Z,B
D KILL^AUPNPAT
D ^XBFMK
Q
PROC ;EP
S AMHJ=$J,AMHH=$H
K ^XTMP("AMHRPSU1",AMHJ,AMHH)
D XTMP("AMHRPSU1","AMH - SUICIDE")
V ; Run by visit date
K AMHTOT,AMHIA,AMHCS S AMHTOT=0,AMHIA=0,AMHCS=0
F S AMHSD=$O(^AMHPSUIC("AD",AMHSD)) Q:AMHSD=""!((AMHSD\1)>AMHED) D V1
Q
;
V1 ;
S AMHR="" F S AMHR=$O(^AMHPSUIC("AD",AMHSD,AMHR)) Q:AMHR'=+AMHR D V2
Q
V2 ;
I $P(^AMHPSUIC(AMHR,0),U,13)="",AMHANS'[0 Q
I $P(^AMHPSUIC(AMHR,0),U,13),'$D(AMHSELF($P(^AMHPSUIC(AMHR,0),U,13))) Q
S P=$P(^AMHPSUIC(AMHR,0),U,4)
;I P,'$$ALLOWP^AMHUTIL(DUZ,P) Q
I P,$$DEMO^AMHUTIL1(P,$G(AMHDEMO)) Q
S AMHTOT=AMHTOT+1
S AMHSUC=$P(^AMHPSUIC(AMHR,0),U,7) I AMHSUC,$D(AMHCOMM),'$D(AMHCOMM(AMHSUC)) Q
S A=$$VAL^XBDIQ1(9002011.65,AMHR,.043)
S AMHAGEG=$S(A<0:" 0-0",A>0&(A<5):"1-4",A>4&(A<15):"5-14",A>14&(A<20):"15-19",A>19&(A<25):"20-24",A>24&(A<45):"25-44",A>44&(A<65):"45-64",A>64&(A<199):"65-125",1:"OTHER")
S AMHTOT(AMHAGEG)=$G(AMHTOT(AMHAGEG))+1
;tally each date element
S AMHC=0 F AMHX=.13,.032,.03,.041,.05,.044,.045,.08,.11 D
.S AMHC=AMHC+1
.S X=$$VAL^XBDIQ1(9002011.65,AMHR,AMHX),Y=$$VALI^XBDIQ1(9002011.65,AMHR,AMHX)
.I AMHX=".13",Y S X=$P($G(^AMHTSBEH(Y,0)),U,4)
.I Y="" S Y=X
.S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
;method 10
S AMHC=10 S Z=0 F S Z=$O(^AMHPSUIC(AMHR,11,Z)) Q:Z'=+Z D
.S Y=$P(^AMHPSUIC(AMHR,11,Z,0),U),X=$$EXTSET^XBFUNC(9002011.6511,.01,Y)
.S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
.;METHOD IF OTHER
.I $P(^AMHPSUIC(AMHR,11,Z,0),U,2)]"" S (X,Y)=$P(^AMHPSUIC(AMHR,11,Z,0),U,2) S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,11,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",11,Y,X)):^(X)+1,1:1)
S AMHC=12,X=$$VAL^XBDIQ1(9002011.65,AMHR,.14),Y=$$VALI^XBDIQ1(9002011.65,AMHR,.14)
S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
;sub use 11
S AMHC=13 S Y=$P(^AMHPSUIC(AMHR,0),U,26),X=$$EXTSET^XBFUNC(9002011.65,.26,Y)
S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
S AMHC=14,X=$$VAL^XBDIQ1(9002011.65,AMHR,.15),Y=$$VALI^XBDIQ1(9002011.65,AMHR,.15)
S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
I $P($G(^AMHPSUIC(AMHR,14)),U)]"" D
.S AMHC=15,X=$$VAL^XBDIQ1(9002011.65,AMHR,1401),Y=$$VALI^XBDIQ1(9002011.65,AMHR,1401) ;OTHER LOC OF ACT VALUES
.S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
;cont fact 15
S AMHC=19 S Z=0 F S Z=$O(^AMHPSUIC(AMHR,13,Z)) Q:Z'=+Z D
.S Y=$P(^AMHPSUIC(AMHR,13,Z,0),U),Y=$P(^AMHTSCF(Y,0),U,2),X=$P(^AMHTSCF(Y,0),U,1)
.S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
.;cf IF OTHER
.I $P(^AMHPSUIC(AMHR,13,Z,0),U,2)]"" S (X,Y)=$P(^AMHPSUIC(AMHR,13,Z,0),U,2) S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,20,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",20,Y,X)):^(X)+1,1:1)
S AMHC=17 S X=$$VAL^XBDIQ1(9002011.65,AMHR,.25),Y=$$VALI^XBDIQ1(9002011.65,AMHR,.25) D
.S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
I $P($G(^AMHPSUIC(AMHR,14)),U,2)]"" D
.S AMHC=18,X=$$VAL^XBDIQ1(9002011.65,AMHR,1402),Y=$$VALI^XBDIQ1(9002011.65,AMHR,1402) ;OTHER LOC OF ACT VALUES
.S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
I AMHBD<$$DV4^AMHUTIL S AMHC=16 S X=$$VAL^XBDIQ1(9002011.65,AMHR,.24),Y=$$VALI^XBDIQ1(9002011.65,AMHR,.24) D
.S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
.Q
S AMHC=21 S Z=0 F S Z=$O(^AMHPSUIC(AMHR,15,Z)) Q:Z'=+Z D
.S Y=$P(^AMHPSUIC(AMHR,15,Z,0),U),X=$P(^AMHTSSU(Y,0),U,1)
.S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
.;cf IF OTHER
.I $P(^AMHPSUIC(AMHR,15,Z,0),U,2)]"" S (X,Y)=$P(^AMHPSUIC(AMHR,15,Z,0),U,2) S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
;IHS/CMI/LAB PATCH 8 06/14/17
S P=$P(^AMHPSUIC(AMHR,0),U,4)
S AMHC=23,X=$$RACE^AGUTL(P)
S (X,Y)=$P(X,U,2)
I X="" S X="UNKNOWN",Y="ZZZZZ"
S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
S AMHC=24,(X,Y)=$$ETHN($P(^AMHPSUIC(AMHR,0),U,4),"E")
I X="" S X="UNKNOWN",Y="ZZZZZ"
S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
S AMHC=25,(X,Y)=$$VAL^XBDIQ1(2,P,1901)
I X="" S X="UNKNOWN",Y="ZZZZZ"
S ^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
Q
ETHN(P,F) ;EP
I '$G(P) Q ""
I $G(F)="" S F="E"
I '$D(^DPT(P,0)) Q ""
NEW Z,E,I
S (E,I)=""
S Z=0 F S Z=$O(^DPT(P,.06,Z)) Q:Z'=+Z!(E]"") D
.S I=$P($G(^DPT(P,.06,Z,0)),U,1)
.Q:I=""
.S E=$P($G(^DIC(10.2,I,0)),U,1)
.Q
I F="E" Q E
I F="I" Q I
Q ""
PRINT ;EP called from xbdbque
S AMHPG=0
K AMHQUIT
I 'AMHTOT D HEAD W !!,"No Suicide Forms to Report" G DONE
S AMHAGEG="" F S AMHAGEG=$O(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG)) Q:AMHAGEG=""!($D(AMHQUIT)) D
.D HEAD Q:$D(AMHQUIT)
.W !,"Age Range: ",AMHAGEG," years",?30,"Total # of Suicide Forms: ",AMHTOT(AMHAGEG),!?63,"REPORT TOTALS"
.S AMHV="" F S AMHV=$O(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHV)) Q:AMHV=""!($D(AMHQUIT)) D
..I $Y>(IOSL-6) D HEAD Q:$D(AMHQUIT)
..S AMHL=$P($T(@AMHV),";;",2) W !?1,$$LBLK(AMHL,28)
..S AMHY="" F S AMHY=$O(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHV,AMHY)) Q:AMHY=""!($D(AMHQUIT)) D
...S AMHX="" S AMHX=$O(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHV,AMHY,AMHX)) Q:AMHX=""!($D(AMHQUIT)) D
....S X=^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHV,AMHY,AMHX)
....W ?31,$E(AMHX,1,30),?63,$J(X,4) S T=AMHTOT(AMHAGEG) W ?72,$J(((X/T)*100),3,0)_"%",!
..Q
.Q
I $D(AMHQUIT) G DONE
D HEAD Q:$D(AMHQUIT)
W !,"Age Range: ","ALL AGES",?30,"Total # of Suicide Forms: ",AMHTOT,!?63,"REPORT TOTALS"
S AMHV="" F S AMHV=$O(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHV)) Q:AMHV=""!($D(AMHQUIT)) D
.I $Y>(IOSL-6) D HEAD Q:$D(AMHQUIT)
.S AMHL=$P($T(@AMHV),";;",2) W !?1,$$LBLK(AMHL,28)
.S AMHY="" F S AMHY=$O(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY)) Q:AMHY=""!($D(AMHQUIT)) D
..S AMHX="" S AMHX=$O(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY,AMHX)) Q:AMHX=""!($D(AMHQUIT)) D
...S X=^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY,AMHX)
...W ?31,$E(AMHX,1,30),?63,$J(X,4) W ?72,$J(((X/AMHTOT)*100),3,0)_"%",!
..Q
.Q
DONE ;
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. PRESS RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
K ^XTMP("AMHRPSU1",AMHJ,AMHH)
Q
HEAD ;EP
G:'AMHPG HEAD1
K DIR 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 !,$$LOC,?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHPG,!
S X="***** AGGREGATE SUICIDE FORM DATA - STANDARD*****" W !,?((80-$L(X))/2),X,!
S X="Act Occurred: "_$$FMTE^XLFDT(AMHBD)_" - "_$$FMTE^XLFDT(AMHED) W $$CTR(X),!
S X="Community where Act Occurred: "_$S($D(AMHCOMM):$P(^AUTTCOM($O(AMHCOMM(0)),0),U),1:"ALL Communities") W $$CTR(X),!
W $TR($J("",80)," ","-"),!
Q
LBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
Q V
RBLK(V,L) ;EP right blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "
Q V
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(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")
;----------
XTMP(N,D) ;EP - set xtmp 0 node
Q:$G(N)=""
S ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$G(D)
Q
;
LABEL ;
1 ;;Suicidal Behavior:
2 ;;Event logged by Discipline:
3 ;;Event logged by Provider:
4 ;;Sex:
5 ;;Employed:
6 ;;Tribe of Enrollment:
7 ;;Community of Residence:
8 ;;Relationship:
9 ;;Education:
10 ;;Method:
11 ;;Method if Other:
12 ;;Previous Attempts:
13 ;;Substance Use Involved:
14 ;;Location of Act:
15 ;;Other location of Act:
16 ;;Lethality:
17 ;;Disposition:
18 ;;Disposition if OTHER:
19 ;;Contributing Factors:
20 ;;Contributing Factor if OTHER:
21 ;;Substance Drugs:
22 ;;Substance Drugs if OTHER:
23 ;;Race:
24 ;;Ethnicity:
25 ;;Veteran's Status:
AMHRPSU1 ; IHS/CMI/LAB - Suicide Form data element tally ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,8**;JUN 02, 2010;Build 7
+2 ;
+3 ;
START ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 DO EOJ
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE !!,"IHS Aggregate Suicide Form Data - Standard"
+5 WRITE !!,"This report will tally the data items specific to the Suicide"
+6 WRITE !,"Form for a date range, community and type of suicidal behavior"
+7 WRITE !,"act as specified by the user."
+8 WRITE !
+9 DO DBHUSRP^AMHUTIL
GETDATES ;
BD ;
+1 SET DIR(0)="D^::EP"
SET DIR("A")="Enter Beginning Date of Suicide Act"
SET DIR("?")="Enter the beginning date of suicide act for the search."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO EOJ
+3 SET AMHBD=Y
ED ;
+1 SET DIR(0)="DA^::EP"
SET DIR("A")="Enter Ending Date of Suicide Act: "
DO ^DIR
KILL DIR,DA
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO EOJ
+3 IF Y<AMHBD
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET AMHED=Y
+5 SET X1=AMHBD
SET X2=-1
DO C^%DTC
SET AMHSD=X
COMM ;
+1 KILL AMHCOMM
+2 SET DIR(0)="S^O:One particular Community;A:All Communities"
SET DIR("A")="Report on Suicide Forms for Suicide Acts that occurred in"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO GETDATES
+4 IF Y="A"
WRITE !!,"All communities will be included in the report.",!
GOTO SELF
+5 IF Y="O"
Begin DoDot:1
+6 SET DIC="^AUTTCOM("
SET DIC(0)="AEMQ"
SET DIC("A")="Which COMMUNITY: "
DO ^DIC
KILL DIC
+7 IF Y=-1
QUIT
+8 SET AMHCOMM(+Y)=""
End DoDot:1
IF '$DATA(AMHCOMM)
GOTO COMM
IF $DATA(AMHCOMM)
GOTO SELF
IF 1
+9 SET X="COMMUNITY"
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 GETDATES
+10 DO PEP^AMQQGTX0(+Y,"AMHCOMM(")
+11 IF '$DATA(AMHCOMM)
GOTO COMM
+12 IF $DATA(AMHCOMM("*"))
KILL AMHCOMM
SELF ;
+1 KILL AMHSELF
+2 WRITE !?5,1,?10,"IDEATION WITH PLAN AND INTENT"
+3 WRITE !?5,2,?10,"ATTEMPT"
+4 WRITE !?5,3,?10,"COMPLETED SUICIDE"
+5 WRITE !?5,4,?10,"ATTEMPTED SUICIDE WITH HOMICIDE (INACTIVE)"
+6 WRITE !?5,5,?10,"COMPLETED SUICIDE WITH HOMICIDE (INACTIVE)"
+7 WRITE !?5,6,?10,"ATTEMPTED SUICIDE WITH ATTEMPTED HOMICIDE"
+8 WRITE !?5,7,?10,"ATTEMPTED SUICIDE WITH COMPLETED HOMICIDE"
+9 WRITE !?5,8,?10,"COMPLETED SUICIDE WITH ATTEMPTED HOMICIDE"
+10 WRITE !?5,9,?10,"COMPLETED SUICIDE WITH COMPLETED HOMICIDE"
+11 WRITE !?5,0,?10,"ALL OF THE ABOVE (ALSO INCLUDES BLANKS)"
+12 SET DIR(0)="L^0:9"
SET DIR("A")="Include which Suicidal Behaviors"
SET DIR("B")="0"
KILL DA
DO ^DIR
KILL DIR
+13 SET AMHANS=Y
SET AMHC=""
FOR AMHI=1:1
SET AMHC=$PIECE(AMHANS,",",AMHI)
IF AMHC=""
QUIT
SET AMHSELF(AMHC)=""
+14 IF AMHANS[0
FOR X=1:1:9
SET AMHSELF(X)=""
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO SELF
ZIS ;
+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 EOJ
+3 IF $GET(Y)="B"
DO BROWSE
DO EOJ
QUIT
+4 WRITE !!
SET XBRP="PRINT^AMHRPSU1"
SET XBRC="PROC^AMHRPSU1"
SET XBNS="AMH"
SET XBRX="EOJ^AMHRPSU1"
+5 DO ^XBDBQUE
+6 DO EOJ
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^AMHRPSU1"")"
+2 SET XBNS="AMH"
SET XBRC="PROC^AMHRPSU1"
SET XBRX="EOJ^AMHRPSU1"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
+4 ;
PAUSE ;
+1 SET DIR(0)="E"
SET DIR("A")="Press return to continue or '^' to quit"
DO ^DIR
KILL DIR,DA
+2 IF $DATA(DIRUT)
SET AMHQUIT=1
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
EOJ ;EP
+1 DO EN^XBVK("AMH")
+2 KILL L,M,S,T,X,X1,X2,Y,Z,B
+3 DO KILL^AUPNPAT
+4 DO ^XBFMK
+5 QUIT
PROC ;EP
+1 SET AMHJ=$JOB
SET AMHH=$HOROLOG
+2 KILL ^XTMP("AMHRPSU1",AMHJ,AMHH)
+3 DO XTMP("AMHRPSU1","AMH - SUICIDE")
V ; Run by visit date
+1 KILL AMHTOT,AMHIA,AMHCS
SET AMHTOT=0
SET AMHIA=0
SET AMHCS=0
+2 FOR
SET AMHSD=$ORDER(^AMHPSUIC("AD",AMHSD))
IF AMHSD=""!((AMHSD\1)>AMHED)
QUIT
DO V1
+3 QUIT
+4 ;
V1 ;
+1 SET AMHR=""
FOR
SET AMHR=$ORDER(^AMHPSUIC("AD",AMHSD,AMHR))
IF AMHR'=+AMHR
QUIT
DO V2
+2 QUIT
V2 ;
+1 IF $PIECE(^AMHPSUIC(AMHR,0),U,13)=""
IF AMHANS'[0
QUIT
+2 IF $PIECE(^AMHPSUIC(AMHR,0),U,13)
IF '$DATA(AMHSELF($PIECE(^AMHPSUIC(AMHR,0),U,13)))
QUIT
+3 SET P=$PIECE(^AMHPSUIC(AMHR,0),U,4)
+4 ;I P,'$$ALLOWP^AMHUTIL(DUZ,P) Q
+5 IF P
IF $$DEMO^AMHUTIL1(P,$GET(AMHDEMO))
QUIT
+6 SET AMHTOT=AMHTOT+1
+7 SET AMHSUC=$PIECE(^AMHPSUIC(AMHR,0),U,7)
IF AMHSUC
IF $DATA(AMHCOMM)
IF '$DATA(AMHCOMM(AMHSUC))
QUIT
+8 SET A=$$VAL^XBDIQ1(9002011.65,AMHR,.043)
+9 SET AMHAGEG=$SELECT(A<0:" 0-0",A>0&(A<5):"1-4",A>4&(A<15):"5-14",A>14&(A<20):"15-19",A>19&(A<25):"20-24",A>24&(A<45):"25-44",A>44&(A<65):"45-64",A>64&(A<199):"65-125",1:"OTHER")
+10 SET AMHTOT(AMHAGEG)=$GET(AMHTOT(AMHAGEG))+1
+11 ;tally each date element
+12 SET AMHC=0
FOR AMHX=.13,.032,.03,.041,.05,.044,.045,.08,.11
Begin DoDot:1
+13 SET AMHC=AMHC+1
+14 SET X=$$VAL^XBDIQ1(9002011.65,AMHR,AMHX)
SET Y=$$VALI^XBDIQ1(9002011.65,AMHR,AMHX)
+15 IF AMHX=".13"
IF Y
SET X=$PIECE($GET(^AMHTSBEH(Y,0)),U,4)
+16 IF Y=""
SET Y=X
+17 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
End DoDot:1
+18 ;method 10
+19 SET AMHC=10
SET Z=0
FOR
SET Z=$ORDER(^AMHPSUIC(AMHR,11,Z))
IF Z'=+Z
QUIT
Begin DoDot:1
+20 SET Y=$PIECE(^AMHPSUIC(AMHR,11,Z,0),U)
SET X=$$EXTSET^XBFUNC(9002011.6511,.01,Y)
+21 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+22 ;METHOD IF OTHER
+23 IF $PIECE(^AMHPSUIC(AMHR,11,Z,0),U,2)]""
SET (X,Y)=$PIECE(^AMHPSUIC(AMHR,11,Z,0),U,2)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,11,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",11,Y,X)):^(X)+1,1:1)
End DoDot:1
+24 SET AMHC=12
SET X=$$VAL^XBDIQ1(9002011.65,AMHR,.14)
SET Y=$$VALI^XBDIQ1(9002011.65,AMHR,.14)
+25 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+26 ;sub use 11
+27 SET AMHC=13
SET Y=$PIECE(^AMHPSUIC(AMHR,0),U,26)
SET X=$$EXTSET^XBFUNC(9002011.65,.26,Y)
+28 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+29 SET AMHC=14
SET X=$$VAL^XBDIQ1(9002011.65,AMHR,.15)
SET Y=$$VALI^XBDIQ1(9002011.65,AMHR,.15)
+30 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+31 IF $PIECE($GET(^AMHPSUIC(AMHR,14)),U)]""
Begin DoDot:1
+32 ;OTHER LOC OF ACT VALUES
SET AMHC=15
SET X=$$VAL^XBDIQ1(9002011.65,AMHR,1401)
SET Y=$$VALI^XBDIQ1(9002011.65,AMHR,1401)
+33 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
End DoDot:1
+34 ;cont fact 15
+35 SET AMHC=19
SET Z=0
FOR
SET Z=$ORDER(^AMHPSUIC(AMHR,13,Z))
IF Z'=+Z
QUIT
Begin DoDot:1
+36 SET Y=$PIECE(^AMHPSUIC(AMHR,13,Z,0),U)
SET Y=$PIECE(^AMHTSCF(Y,0),U,2)
SET X=$PIECE(^AMHTSCF(Y,0),U,1)
+37 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+38 ;cf IF OTHER
+39 IF $PIECE(^AMHPSUIC(AMHR,13,Z,0),U,2)]""
SET (X,Y)=$PIECE(^AMHPSUIC(AMHR,13,Z,0),U,2)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,20,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",20,Y,X)):^(X)+1,1:1)
End DoDot:1
+40 SET AMHC=17
SET X=$$VAL^XBDIQ1(9002011.65,AMHR,.25)
SET Y=$$VALI^XBDIQ1(9002011.65,AMHR,.25)
Begin DoDot:1
+41 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
End DoDot:1
+42 IF $PIECE($GET(^AMHPSUIC(AMHR,14)),U,2)]""
Begin DoDot:1
+43 ;OTHER LOC OF ACT VALUES
SET AMHC=18
SET X=$$VAL^XBDIQ1(9002011.65,AMHR,1402)
SET Y=$$VALI^XBDIQ1(9002011.65,AMHR,1402)
+44 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
End DoDot:1
+45 IF AMHBD<$$DV4^AMHUTIL
SET AMHC=16
SET X=$$VAL^XBDIQ1(9002011.65,AMHR,.24)
SET Y=$$VALI^XBDIQ1(9002011.65,AMHR,.24)
Begin DoDot:1
+46 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+47 QUIT
End DoDot:1
+48 SET AMHC=21
SET Z=0
FOR
SET Z=$ORDER(^AMHPSUIC(AMHR,15,Z))
IF Z'=+Z
QUIT
Begin DoDot:1
+49 SET Y=$PIECE(^AMHPSUIC(AMHR,15,Z,0),U)
SET X=$PIECE(^AMHTSSU(Y,0),U,1)
+50 IF Y=""
SET Y="ZZZZZ"
IF X=""
SET X="DATA NOT ENTERED"
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+51 ;cf IF OTHER
+52 IF $PIECE(^AMHPSUIC(AMHR,15,Z,0),U,2)]""
SET (X,Y)=$PIECE(^AMHPSUIC(AMHR,15,Z,0),U,2)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
End DoDot:1
+53 ;IHS/CMI/LAB PATCH 8 06/14/17
+54 SET P=$PIECE(^AMHPSUIC(AMHR,0),U,4)
+55 SET AMHC=23
SET X=$$RACE^AGUTL(P)
+56 SET (X,Y)=$PIECE(X,U,2)
+57 IF X=""
SET X="UNKNOWN"
SET Y="ZZZZZ"
+58 SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+59 SET AMHC=24
SET (X,Y)=$$ETHN($PIECE(^AMHPSUIC(AMHR,0),U,4),"E")
+60 IF X=""
SET X="UNKNOWN"
SET Y="ZZZZZ"
+61 SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+62 SET AMHC=25
SET (X,Y)=$$VAL^XBDIQ1(2,P,1901)
+63 IF X=""
SET X="UNKNOWN"
SET Y="ZZZZZ"
+64 SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHC,Y,X)):^(X)+1,1:1)
SET ^(X)=$SELECT($DATA(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
+65 QUIT
ETHN(P,F) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(F)=""
SET F="E"
+3 IF '$DATA(^DPT(P,0))
QUIT ""
+4 NEW Z,E,I
+5 SET (E,I)=""
+6 SET Z=0
FOR
SET Z=$ORDER(^DPT(P,.06,Z))
IF Z'=+Z!(E]"")
QUIT
Begin DoDot:1
+7 SET I=$PIECE($GET(^DPT(P,.06,Z,0)),U,1)
+8 IF I=""
QUIT
+9 SET E=$PIECE($GET(^DIC(10.2,I,0)),U,1)
+10 QUIT
End DoDot:1
+11 IF F="E"
QUIT E
+12 IF F="I"
QUIT I
+13 QUIT ""
PRINT ;EP called from xbdbque
+1 SET AMHPG=0
+2 KILL AMHQUIT
+3 IF 'AMHTOT
DO HEAD
WRITE !!,"No Suicide Forms to Report"
GOTO DONE
+4 SET AMHAGEG=""
FOR
SET AMHAGEG=$ORDER(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG))
IF AMHAGEG=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+5 DO HEAD
IF $DATA(AMHQUIT)
QUIT
+6 WRITE !,"Age Range: ",AMHAGEG," years",?30,"Total # of Suicide Forms: ",AMHTOT(AMHAGEG),!?63,"REPORT TOTALS"
+7 SET AMHV=""
FOR
SET AMHV=$ORDER(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHV))
IF AMHV=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:2
+8 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+9 SET AMHL=$PIECE($TEXT(@AMHV),";;",2)
WRITE !?1,$$LBLK(AMHL,28)
+10 SET AMHY=""
FOR
SET AMHY=$ORDER(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHV,AMHY))
IF AMHY=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:3
+11 SET AMHX=""
SET AMHX=$ORDER(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHV,AMHY,AMHX))
IF AMHX=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:4
+12 SET X=^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","AGE",AMHAGEG,AMHV,AMHY,AMHX)
+13 WRITE ?31,$EXTRACT(AMHX,1,30),?63,$JUSTIFY(X,4)
SET T=AMHTOT(AMHAGEG)
WRITE ?72,$JUSTIFY(((X/T)*100),3,0)_"%",!
End DoDot:4
End DoDot:3
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 IF $DATA(AMHQUIT)
GOTO DONE
+17 DO HEAD
IF $DATA(AMHQUIT)
QUIT
+18 WRITE !,"Age Range: ","ALL AGES",?30,"Total # of Suicide Forms: ",AMHTOT,!?63,"REPORT TOTALS"
+19 SET AMHV=""
FOR
SET AMHV=$ORDER(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHV))
IF AMHV=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+20 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+21 SET AMHL=$PIECE($TEXT(@AMHV),";;",2)
WRITE !?1,$$LBLK(AMHL,28)
+22 SET AMHY=""
FOR
SET AMHY=$ORDER(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY))
IF AMHY=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:2
+23 SET AMHX=""
SET AMHX=$ORDER(^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY,AMHX))
IF AMHX=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:3
+24 SET X=^XTMP("AMHRPSU1",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY,AMHX)
+25 WRITE ?31,$EXTRACT(AMHX,1,30),?63,$JUSTIFY(X,4)
WRITE ?72,$JUSTIFY(((X/AMHTOT)*100),3,0)_"%",!
End DoDot:3
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
DONE ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. PRESS RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 KILL ^XTMP("AMHRPSU1",AMHJ,AMHH)
+3 QUIT
HEAD ;EP
+1 IF 'AMHPG
GOTO HEAD1
+2 KILL DIR
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 !,$$LOC,?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHPG,!
+3 SET X="***** AGGREGATE SUICIDE FORM DATA - STANDARD*****"
WRITE !,?((80-$LENGTH(X))/2),X,!
+4 SET X="Act Occurred: "_$$FMTE^XLFDT(AMHBD)_" - "_$$FMTE^XLFDT(AMHED)
WRITE $$CTR(X),!
+5 SET X="Community where Act Occurred: "_$SELECT($DATA(AMHCOMM):$PIECE(^AUTTCOM($ORDER(AMHCOMM(0)),0),U),1:"ALL Communities")
WRITE $$CTR(X),!
+6 WRITE $TRANSLATE($JUSTIFY("",80)," ","-"),!
+7 QUIT
LBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=" "_V
+3 QUIT V
RBLK(V,L) ;EP right blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=V_" "
+3 QUIT V
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(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 ;----------
XTMP(N,D) ;EP - set xtmp 0 node
+1 IF $GET(N)=""
QUIT
+2 SET ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$GET(D)
+3 QUIT
+4 ;
LABEL ;
1 ;;Suicidal Behavior:
2 ;;Event logged by Discipline:
3 ;;Event logged by Provider:
4 ;;Sex:
5 ;;Employed:
6 ;;Tribe of Enrollment:
7 ;;Community of Residence:
8 ;;Relationship:
9 ;;Education:
10 ;;Method:
11 ;;Method if Other:
12 ;;Previous Attempts:
13 ;;Substance Use Involved:
14 ;;Location of Act:
15 ;;Other location of Act:
16 ;;Lethality:
17 ;;Disposition:
18 ;;Disposition if OTHER:
19 ;;Contributing Factors:
20 ;;Contributing Factor if OTHER:
21 ;;Substance Drugs:
22 ;;Substance Drugs if OTHER:
23 ;;Race:
24 ;;Ethnicity:
25 ;;Veteran's Status:
