- AMHRPSU3 ; 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 !!,"Extract Suicide Form Data Elements in Delimited format"
- W !!,"This report will extract all data elements on the Suicide Form in a ",!,"delimited form for a date range specified by the user.",!!
- 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
- 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^AMHRPSU3",XBRC="PROC^AMHRPSU3",XBNS="AMH",XBRX="EOJ^AMHRPSU3"
- D ^XBDBQUE
- D EOJ
- Q
- BROWSE ;
- S XBRP="VIEWR^XBLM(""PRINT^AMHRPSU3"")"
- S XBNS="AMH",XBRC="PROC^AMHRPSU3",XBRX="EOJ^AMHRPSU3",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 ;
- D EN^XBVK("AMH")
- K L,M,S,T,X,X1,X2,Y,Z,B,A
- D KILL^AUPNPAT
- D ^XBFMK
- Q
- PROC ;EP
- S AMHJ=$J,AMHH=$H
- K ^XTMP("AMHRPSU3",AMHJ,AMHH)
- D XTMP("AMHRPSU3","AMH - SUICIDE")
- V ; Run by visit date
- F S AMHSD=$O(^AMHPSUIC("AD",AMHSD)) Q:AMHSD=""!((AMHSD\1)>AMHED) D V1
- Q
- ;
- V1 ;
- S AMHVDFN="" F S AMHVDFN=$O(^AMHPSUIC("AD",AMHSD,AMHVDFN)) Q:AMHVDFN'=+AMHVDFN D
- .I $P(^AMHPSUIC(AMHVDFN,0),U,13)="",AMHANS'[0 Q
- .I $P(^AMHPSUIC(AMHVDFN,0),U,13),'$D(AMHSELF($P(^AMHPSUIC(AMHVDFN,0),U,13))) Q
- .S P=$P(^AMHPSUIC(AMHVDFN,0),U,4)
- .Q:$$DEMO^AMHUTIL1(P,$G(AMHDEMO))
- .;I '$$ALLOW^AMHSFR(DUZ,AMHVDFN) Q
- .S AMHREC=""
- .F AMHX=1:1:20 S AMHT=$T(@AMHX) D
- ..S AMHP=$P(AMHT,";;",1),AMHV=$P(AMHT,";;",3)
- ..X AMHV
- ..S $P(AMHREC,U,AMHP)=X
- ..Q
- .F AMHX=$S(AMHBD<$$DV4^AMHUTIL:22,1:21):1:23 S AMHT=$T(@AMHX) D
- ..S AMHP=$P(AMHT,";;",1),AMHV=$P(AMHT,";;",3)
- ..X AMHV
- ..S $P(AMHREC,U,AMHP)=X
- ..Q
- .;rest of multiples
- .S AMHC=23,AMHX=0 F S AMHX=$O(^AMHPSUIC(AMHVDFN,11,AMHX)) Q:AMHX'=+AMHX!(AMHC>26) D
- ..S AMHC=AMHC+1
- ..S Y=$P(^AMHPSUIC(AMHVDFN,11,AMHX,0),U),$P(AMHREC,U,AMHC)=$$EXTSET^XBFUNC(9002011.6511,.01,Y)
- ..I $P(^AMHPSUIC(AMHVDFN,11,AMHX,0),U,2)]"" S $P(AMHREC,U,27)=$P(^AMHPSUIC(AMHVDFN,11,AMHX,0),U,2)
- ..;METHOD IF OTHER
- .S AMHC=28,AMHX=0 S AMHX=$P(^AMHPSUIC(AMHVDFN,0),U,26) D
- ..S Y=$P(^AMHPSUIC(AMHVDFN,0),U,26),$P(AMHREC,U,AMHC)=$$EXTSET^XBFUNC(9002011.65,.26,Y)
- .;substance used
- .S AMHC=28,AMHX=0 F S AMHX=$O(^AMHPSUIC(AMHVDFN,15,AMHX)) Q:AMHX'=+AMHX!(AMHC>31) D
- ..S AMHC=AMHC+1
- ..S Y=$P(^AMHPSUIC(AMHVDFN,15,AMHX,0),U),$P(AMHREC,U,AMHC)=$P(^AMHTSSU(Y,0),U,1)
- ..I $P(^AMHPSUIC(AMHVDFN,15,AMHX,0),U,2)]"" S $P(AMHREC,U,32)=$P(^AMHPSUIC(AMHVDFN,15,AMHX,0),U,2)
- .S AMHC=32,AMHX=0 F S AMHX=$O(^AMHPSUIC(AMHVDFN,13,AMHX)) Q:AMHX'=+AMHX!(AMHC>35) D
- ..S AMHC=AMHC+1
- ..S Y=$P(^AMHPSUIC(AMHVDFN,13,AMHX,0),U),$P(AMHREC,U,AMHC)=$P(^AMHTSCF(Y,0),U,1)
- ..I $P(^AMHPSUIC(AMHVDFN,13,AMHX,0),U,2)]"" S $P(AMHREC,U,36)=$P(^AMHPSUIC(AMHVDFN,13,AMHX,0),U,2)
- .S AMHDFNP=$P(^AMHPSUIC(AMHVDFN,0),U,4)
- .S $P(AMHREC,U,37)=$P($$RACE^AGUTL(AMHDFNP),U,2)
- .S $P(AMHREC,U,38)=$P($$RACE^AGUTL(AMHDFNP),U,3)
- .S $P(AMHREC,U,39)=$$ETHN^AMHRPSU1(AMHDFNP,"E")
- .S $P(AMHREC,U,40)=$$VAL^XBDIQ1(2,AMHDFNP,1901)
- .S ^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN)=AMHREC
- Q
- PRINT ;EP called from xbdbque
- W:$D(IOF) @IOF
- W !,$$LOC,"^^^",$$FMTE^XLFDT(DT)
- S X="***** AGGREGATED SUICIDE DATA *****" W !,X,!
- W "Act Occurred","^",$$FMTE^XLFDT(AMHBD),"^",$$FMTE^XLFDT(AMHED),!
- F AMHX=1:1:23 S AMHT=$T(@AMHX),AMHT=$P(AMHT,";;",2) S $P(X,U,AMHX)=AMHT
- F AMHX=24:1:26 S $P(X,U,AMHX)="Method "_(AMHX-23)
- S $P(X,U,27)="Method if OTHER"
- F AMHX=28 S $P(X,U,AMHX)="Substance Involved "
- F AMHX=29:1:31 S $P(X,U,AMHX)="Substance DRUG "_(AMHX-28)
- S $P(X,U,32)="Substance if Other"
- F AMHX=33:1:35 S $P(X,U,AMHX)="Contributing Factor "_(AMHX-32)
- S $P(X,U,36)="Contributing Factor, if other"
- S $P(X,U,37)="Race"
- S $P(X,U,38)="Race"
- S $P(X,U,39)="Ethnicity"
- S $P(X,U,40)="Veteran Status"
- W !!,X
- S AMHVDFN="" F S AMHVDFN=$O(^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN)) Q:AMHVDFN="" D
- .W !,^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN)
- 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("AMHRPSU3",AMHJ,AMHH)
- 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 ;;Unique Case ID;;S X=$P(^AMHPSUIC(AMHVDFN,0),U)
- 2 ;;Local Case #;;S X=$P(^AMHPSUIC(AMHVDFN,0),U,2)
- 3 ;;Event logged by;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.031)
- 4 ;;Discipline of Prov;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.032)
- 5 ;;Unique ID of Patient;;S X=$P(^AMHPSUIC(AMHVDFN,0),U,4),X=$$UID^AGTXID(X)
- 6 ;;Sex of Patient;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.041)
- 7 ;;Age of Patient on date of act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.043)
- 8 ;;Tribe of Enrollment;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.044)
- 9 ;;Community of Residence;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.045)
- 10 ;;Employment Status;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.05)
- 11 ;;Date of Act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.06)
- 12 ;;Community where act occurred;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.07)
- 13 ;;Relationship Status;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.08)
- 14 ;;Relationship if Other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.09)
- 15 ;;Education Level;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.11)
- 16 ;;If less than 12;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.12)
- 17 ;;Suicidal Behavior;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.131)
- 18 ;;Previous Attempts;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.14)
- 19 ;;Location of Act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.15)
- 20 ;;Location of Act, if other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,1401)
- 21 ;;Lethality;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.24)
- 22 ;;Disposition;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.25)
- 23 ;;Disposition if other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,1402)
- AMHRPSU3 ; 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 !!,"Extract Suicide Form Data Elements in Delimited format"
- +5 WRITE !!,"This report will extract all data elements on the Suicide Form in a ",!,"delimited form for a date range specified by the user.",!!
- +6 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
- 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^AMHRPSU3"
- SET XBRC="PROC^AMHRPSU3"
- SET XBNS="AMH"
- SET XBRX="EOJ^AMHRPSU3"
- +5 DO ^XBDBQUE
- +6 DO EOJ
- +7 QUIT
- BROWSE ;
- +1 SET XBRP="VIEWR^XBLM(""PRINT^AMHRPSU3"")"
- +2 SET XBNS="AMH"
- SET XBRC="PROC^AMHRPSU3"
- SET XBRX="EOJ^AMHRPSU3"
- 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 ;
- +1 DO EN^XBVK("AMH")
- +2 KILL L,M,S,T,X,X1,X2,Y,Z,B,A
- +3 DO KILL^AUPNPAT
- +4 DO ^XBFMK
- +5 QUIT
- PROC ;EP
- +1 SET AMHJ=$JOB
- SET AMHH=$HOROLOG
- +2 KILL ^XTMP("AMHRPSU3",AMHJ,AMHH)
- +3 DO XTMP("AMHRPSU3","AMH - SUICIDE")
- V ; Run by visit date
- +1 FOR
- SET AMHSD=$ORDER(^AMHPSUIC("AD",AMHSD))
- IF AMHSD=""!((AMHSD\1)>AMHED)
- QUIT
- DO V1
- +2 QUIT
- +3 ;
- V1 ;
- +1 SET AMHVDFN=""
- FOR
- SET AMHVDFN=$ORDER(^AMHPSUIC("AD",AMHSD,AMHVDFN))
- IF AMHVDFN'=+AMHVDFN
- QUIT
- Begin DoDot:1
- +2 IF $PIECE(^AMHPSUIC(AMHVDFN,0),U,13)=""
- IF AMHANS'[0
- QUIT
- +3 IF $PIECE(^AMHPSUIC(AMHVDFN,0),U,13)
- IF '$DATA(AMHSELF($PIECE(^AMHPSUIC(AMHVDFN,0),U,13)))
- QUIT
- +4 SET P=$PIECE(^AMHPSUIC(AMHVDFN,0),U,4)
- +5 IF $$DEMO^AMHUTIL1(P,$GET(AMHDEMO))
- QUIT
- +6 ;I '$$ALLOW^AMHSFR(DUZ,AMHVDFN) Q
- +7 SET AMHREC=""
- +8 FOR AMHX=1:1:20
- SET AMHT=$TEXT(@AMHX)
- Begin DoDot:2
- +9 SET AMHP=$PIECE(AMHT,";;",1)
- SET AMHV=$PIECE(AMHT,";;",3)
- +10 XECUTE AMHV
- +11 SET $PIECE(AMHREC,U,AMHP)=X
- +12 QUIT
- End DoDot:2
- +13 FOR AMHX=$SELECT(AMHBD<$$DV4^AMHUTIL:22,1:21):1:23
- SET AMHT=$TEXT(@AMHX)
- Begin DoDot:2
- +14 SET AMHP=$PIECE(AMHT,";;",1)
- SET AMHV=$PIECE(AMHT,";;",3)
- +15 XECUTE AMHV
- +16 SET $PIECE(AMHREC,U,AMHP)=X
- +17 QUIT
- End DoDot:2
- +18 ;rest of multiples
- +19 SET AMHC=23
- SET AMHX=0
- FOR
- SET AMHX=$ORDER(^AMHPSUIC(AMHVDFN,11,AMHX))
- IF AMHX'=+AMHX!(AMHC>26)
- QUIT
- Begin DoDot:2
- +20 SET AMHC=AMHC+1
- +21 SET Y=$PIECE(^AMHPSUIC(AMHVDFN,11,AMHX,0),U)
- SET $PIECE(AMHREC,U,AMHC)=$$EXTSET^XBFUNC(9002011.6511,.01,Y)
- +22 IF $PIECE(^AMHPSUIC(AMHVDFN,11,AMHX,0),U,2)]""
- SET $PIECE(AMHREC,U,27)=$PIECE(^AMHPSUIC(AMHVDFN,11,AMHX,0),U,2)
- +23 ;METHOD IF OTHER
- End DoDot:2
- +24 SET AMHC=28
- SET AMHX=0
- SET AMHX=$PIECE(^AMHPSUIC(AMHVDFN,0),U,26)
- Begin DoDot:2
- +25 SET Y=$PIECE(^AMHPSUIC(AMHVDFN,0),U,26)
- SET $PIECE(AMHREC,U,AMHC)=$$EXTSET^XBFUNC(9002011.65,.26,Y)
- End DoDot:2
- +26 ;substance used
- +27 SET AMHC=28
- SET AMHX=0
- FOR
- SET AMHX=$ORDER(^AMHPSUIC(AMHVDFN,15,AMHX))
- IF AMHX'=+AMHX!(AMHC>31)
- QUIT
- Begin DoDot:2
- +28 SET AMHC=AMHC+1
- +29 SET Y=$PIECE(^AMHPSUIC(AMHVDFN,15,AMHX,0),U)
- SET $PIECE(AMHREC,U,AMHC)=$PIECE(^AMHTSSU(Y,0),U,1)
- +30 IF $PIECE(^AMHPSUIC(AMHVDFN,15,AMHX,0),U,2)]""
- SET $PIECE(AMHREC,U,32)=$PIECE(^AMHPSUIC(AMHVDFN,15,AMHX,0),U,2)
- End DoDot:2
- +31 SET AMHC=32
- SET AMHX=0
- FOR
- SET AMHX=$ORDER(^AMHPSUIC(AMHVDFN,13,AMHX))
- IF AMHX'=+AMHX!(AMHC>35)
- QUIT
- Begin DoDot:2
- +32 SET AMHC=AMHC+1
- +33 SET Y=$PIECE(^AMHPSUIC(AMHVDFN,13,AMHX,0),U)
- SET $PIECE(AMHREC,U,AMHC)=$PIECE(^AMHTSCF(Y,0),U,1)
- +34 IF $PIECE(^AMHPSUIC(AMHVDFN,13,AMHX,0),U,2)]""
- SET $PIECE(AMHREC,U,36)=$PIECE(^AMHPSUIC(AMHVDFN,13,AMHX,0),U,2)
- End DoDot:2
- +35 SET AMHDFNP=$PIECE(^AMHPSUIC(AMHVDFN,0),U,4)
- +36 SET $PIECE(AMHREC,U,37)=$PIECE($$RACE^AGUTL(AMHDFNP),U,2)
- +37 SET $PIECE(AMHREC,U,38)=$PIECE($$RACE^AGUTL(AMHDFNP),U,3)
- +38 SET $PIECE(AMHREC,U,39)=$$ETHN^AMHRPSU1(AMHDFNP,"E")
- +39 SET $PIECE(AMHREC,U,40)=$$VAL^XBDIQ1(2,AMHDFNP,1901)
- +40 SET ^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN)=AMHREC
- End DoDot:1
- +41 QUIT
- PRINT ;EP called from xbdbque
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,$$LOC,"^^^",$$FMTE^XLFDT(DT)
- +3 SET X="***** AGGREGATED SUICIDE DATA *****"
- WRITE !,X,!
- +4 WRITE "Act Occurred","^",$$FMTE^XLFDT(AMHBD),"^",$$FMTE^XLFDT(AMHED),!
- +5 FOR AMHX=1:1:23
- SET AMHT=$TEXT(@AMHX)
- SET AMHT=$PIECE(AMHT,";;",2)
- SET $PIECE(X,U,AMHX)=AMHT
- +6 FOR AMHX=24:1:26
- SET $PIECE(X,U,AMHX)="Method "_(AMHX-23)
- +7 SET $PIECE(X,U,27)="Method if OTHER"
- +8 FOR AMHX=28
- SET $PIECE(X,U,AMHX)="Substance Involved "
- +9 FOR AMHX=29:1:31
- SET $PIECE(X,U,AMHX)="Substance DRUG "_(AMHX-28)
- +10 SET $PIECE(X,U,32)="Substance if Other"
- +11 FOR AMHX=33:1:35
- SET $PIECE(X,U,AMHX)="Contributing Factor "_(AMHX-32)
- +12 SET $PIECE(X,U,36)="Contributing Factor, if other"
- +13 SET $PIECE(X,U,37)="Race"
- +14 SET $PIECE(X,U,38)="Race"
- +15 SET $PIECE(X,U,39)="Ethnicity"
- +16 SET $PIECE(X,U,40)="Veteran Status"
- +17 WRITE !!,X
- +18 SET AMHVDFN=""
- FOR
- SET AMHVDFN=$ORDER(^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN))
- IF AMHVDFN=""
- QUIT
- Begin DoDot:1
- +19 WRITE !,^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN)
- 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("AMHRPSU3",AMHJ,AMHH)
- +3 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 ;;Unique Case ID;;S X=$P(^AMHPSUIC(AMHVDFN,0),U)
- 2 ;;Local Case #;;S X=$P(^AMHPSUIC(AMHVDFN,0),U,2)
- 3 ;;Event logged by;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.031)
- 4 ;;Discipline of Prov;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.032)
- 5 ;;Unique ID of Patient;;S X=$P(^AMHPSUIC(AMHVDFN,0),U,4),X=$$UID^AGTXID(X)
- 6 ;;Sex of Patient;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.041)
- 7 ;;Age of Patient on date of act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.043)
- 8 ;;Tribe of Enrollment;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.044)
- 9 ;;Community of Residence;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.045)
- 10 ;;Employment Status;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.05)
- 11 ;;Date of Act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.06)
- 12 ;;Community where act occurred;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.07)
- 13 ;;Relationship Status;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.08)
- 14 ;;Relationship if Other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.09)
- 15 ;;Education Level;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.11)
- 16 ;;If less than 12;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.12)
- 17 ;;Suicidal Behavior;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.131)
- 18 ;;Previous Attempts;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.14)
- 19 ;;Location of Act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.15)
- 20 ;;Location of Act, if other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,1401)
- 21 ;;Lethality;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.24)
- 22 ;;Disposition;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.25)
- 23 ;;Disposition if other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,1402)