Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHRPSU3

AMHRPSU3.m

Go to the documentation of this file.
  1. AMHRPSU3 ; IHS/CMI/LAB - Suicide Form data element tally ;
  1. ;;4.0;IHS BEHAVIORAL HEALTH;**1,8**;JUN 02, 2010;Build 7
  1. ;
  1. ;
  1. START ;
  1. W:$D(IOF) @IOF
  1. D EOJ
  1. W:$D(IOF) @IOF
  1. W !!,"Extract Suicide Form Data Elements in Delimited format"
  1. W !!,"This report will extract all data elements on the Suicide Form in a ",!,"delimited form for a date range specified by the user.",!!
  1. D DBHUSRP^AMHUTIL
  1. GETDATES ;
  1. BD ;
  1. 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
  1. G:$D(DIRUT) EOJ
  1. S AMHBD=Y
  1. ED ;
  1. S DIR(0)="DA^::EP",DIR("A")="Enter Ending Date of Suicide Act: " D ^DIR K DIR,DA S:$D(DUOUT) DIRUT=1
  1. G:$D(DIRUT) EOJ
  1. I Y<AMHBD W !,"Ending date must be greater than or equal to beginning date!" G ED
  1. S AMHED=Y
  1. S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X
  1. SELF ;
  1. K AMHSELF
  1. W !?5,1,?10,"IDEATION WITH PLAN AND INTENT"
  1. W !?5,2,?10,"ATTEMPT"
  1. W !?5,3,?10,"COMPLETED SUICIDE"
  1. W !?5,4,?10,"ATTEMPTED SUICIDE WITH HOMICIDE (INACTIVE)"
  1. W !?5,5,?10,"COMPLETED SUICIDE WITH HOMICIDE (INACTIVE)"
  1. W !?5,6,?10,"ATTEMPTED SUICIDE WITH ATTEMPTED HOMICIDE"
  1. W !?5,7,?10,"ATTEMPTED SUICIDE WITH COMPLETED HOMICIDE"
  1. W !?5,8,?10,"COMPLETED SUICIDE WITH ATTEMPTED HOMICIDE"
  1. W !?5,9,?10,"COMPLETED SUICIDE WITH COMPLETED HOMICIDE"
  1. W !?5,0,?10,"ALL OF THE ABOVE (ALSO INCLUDES BLANKS)"
  1. S DIR(0)="L^0:9",DIR("A")="Include which Suicidal Behaviors",DIR("B")="0" KILL DA D ^DIR KILL DIR
  1. S AMHANS=Y,AMHC="" F AMHI=1:1 S AMHC=$P(AMHANS,",",AMHI) Q:AMHC="" S AMHSELF(AMHC)=""
  1. I AMHANS[0 F X=1:1:9 S AMHSELF(X)=""
  1. DEMO ;
  1. D DEMOCHK^AMHUTIL1(.AMHDEMO)
  1. I AMHDEMO=-1 G SELF
  1. ZIS ;
  1. 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
  1. I $D(DIRUT) G EOJ
  1. I $G(Y)="B" D BROWSE,EOJ Q
  1. W !! S XBRP="PRINT^AMHRPSU3",XBRC="PROC^AMHRPSU3",XBNS="AMH",XBRX="EOJ^AMHRPSU3"
  1. D ^XBDBQUE
  1. D EOJ
  1. Q
  1. BROWSE ;
  1. S XBRP="VIEWR^XBLM(""PRINT^AMHRPSU3"")"
  1. S XBNS="AMH",XBRC="PROC^AMHRPSU3",XBRX="EOJ^AMHRPSU3",XBIOP=0 D ^XBDBQUE
  1. Q
  1. ;
  1. PAUSE ;
  1. S DIR(0)="E",DIR("A")="Press return to continue or '^' to quit" D ^DIR K DIR,DA
  1. S:$D(DIRUT) AMHQUIT=1
  1. W:$D(IOF) @IOF
  1. Q
  1. EOJ ;
  1. D EN^XBVK("AMH")
  1. K L,M,S,T,X,X1,X2,Y,Z,B,A
  1. D KILL^AUPNPAT
  1. D ^XBFMK
  1. Q
  1. PROC ;EP
  1. S AMHJ=$J,AMHH=$H
  1. K ^XTMP("AMHRPSU3",AMHJ,AMHH)
  1. D XTMP("AMHRPSU3","AMH - SUICIDE")
  1. V ; Run by visit date
  1. F S AMHSD=$O(^AMHPSUIC("AD",AMHSD)) Q:AMHSD=""!((AMHSD\1)>AMHED) D V1
  1. Q
  1. ;
  1. V1 ;
  1. S AMHVDFN="" F S AMHVDFN=$O(^AMHPSUIC("AD",AMHSD,AMHVDFN)) Q:AMHVDFN'=+AMHVDFN D
  1. .I $P(^AMHPSUIC(AMHVDFN,0),U,13)="",AMHANS'[0 Q
  1. .I $P(^AMHPSUIC(AMHVDFN,0),U,13),'$D(AMHSELF($P(^AMHPSUIC(AMHVDFN,0),U,13))) Q
  1. .S P=$P(^AMHPSUIC(AMHVDFN,0),U,4)
  1. .Q:$$DEMO^AMHUTIL1(P,$G(AMHDEMO))
  1. .;I '$$ALLOW^AMHSFR(DUZ,AMHVDFN) Q
  1. .S AMHREC=""
  1. .F AMHX=1:1:20 S AMHT=$T(@AMHX) D
  1. ..S AMHP=$P(AMHT,";;",1),AMHV=$P(AMHT,";;",3)
  1. ..X AMHV
  1. ..S $P(AMHREC,U,AMHP)=X
  1. ..Q
  1. .F AMHX=$S(AMHBD<$$DV4^AMHUTIL:22,1:21):1:23 S AMHT=$T(@AMHX) D
  1. ..S AMHP=$P(AMHT,";;",1),AMHV=$P(AMHT,";;",3)
  1. ..X AMHV
  1. ..S $P(AMHREC,U,AMHP)=X
  1. ..Q
  1. .;rest of multiples
  1. .S AMHC=23,AMHX=0 F S AMHX=$O(^AMHPSUIC(AMHVDFN,11,AMHX)) Q:AMHX'=+AMHX!(AMHC>26) D
  1. ..S AMHC=AMHC+1
  1. ..S Y=$P(^AMHPSUIC(AMHVDFN,11,AMHX,0),U),$P(AMHREC,U,AMHC)=$$EXTSET^XBFUNC(9002011.6511,.01,Y)
  1. ..I $P(^AMHPSUIC(AMHVDFN,11,AMHX,0),U,2)]"" S $P(AMHREC,U,27)=$P(^AMHPSUIC(AMHVDFN,11,AMHX,0),U,2)
  1. ..;METHOD IF OTHER
  1. .S AMHC=28,AMHX=0 S AMHX=$P(^AMHPSUIC(AMHVDFN,0),U,26) D
  1. ..S Y=$P(^AMHPSUIC(AMHVDFN,0),U,26),$P(AMHREC,U,AMHC)=$$EXTSET^XBFUNC(9002011.65,.26,Y)
  1. .;substance used
  1. .S AMHC=28,AMHX=0 F S AMHX=$O(^AMHPSUIC(AMHVDFN,15,AMHX)) Q:AMHX'=+AMHX!(AMHC>31) D
  1. ..S AMHC=AMHC+1
  1. ..S Y=$P(^AMHPSUIC(AMHVDFN,15,AMHX,0),U),$P(AMHREC,U,AMHC)=$P(^AMHTSSU(Y,0),U,1)
  1. ..I $P(^AMHPSUIC(AMHVDFN,15,AMHX,0),U,2)]"" S $P(AMHREC,U,32)=$P(^AMHPSUIC(AMHVDFN,15,AMHX,0),U,2)
  1. .S AMHC=32,AMHX=0 F S AMHX=$O(^AMHPSUIC(AMHVDFN,13,AMHX)) Q:AMHX'=+AMHX!(AMHC>35) D
  1. ..S AMHC=AMHC+1
  1. ..S Y=$P(^AMHPSUIC(AMHVDFN,13,AMHX,0),U),$P(AMHREC,U,AMHC)=$P(^AMHTSCF(Y,0),U,1)
  1. ..I $P(^AMHPSUIC(AMHVDFN,13,AMHX,0),U,2)]"" S $P(AMHREC,U,36)=$P(^AMHPSUIC(AMHVDFN,13,AMHX,0),U,2)
  1. .S AMHDFNP=$P(^AMHPSUIC(AMHVDFN,0),U,4)
  1. .S $P(AMHREC,U,37)=$P($$RACE^AGUTL(AMHDFNP),U,2)
  1. .S $P(AMHREC,U,38)=$P($$RACE^AGUTL(AMHDFNP),U,3)
  1. .S $P(AMHREC,U,39)=$$ETHN^AMHRPSU1(AMHDFNP,"E")
  1. .S $P(AMHREC,U,40)=$$VAL^XBDIQ1(2,AMHDFNP,1901)
  1. .S ^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN)=AMHREC
  1. Q
  1. PRINT ;EP called from xbdbque
  1. W:$D(IOF) @IOF
  1. W !,$$LOC,"^^^",$$FMTE^XLFDT(DT)
  1. S X="***** AGGREGATED SUICIDE DATA *****" W !,X,!
  1. W "Act Occurred","^",$$FMTE^XLFDT(AMHBD),"^",$$FMTE^XLFDT(AMHED),!
  1. F AMHX=1:1:23 S AMHT=$T(@AMHX),AMHT=$P(AMHT,";;",2) S $P(X,U,AMHX)=AMHT
  1. F AMHX=24:1:26 S $P(X,U,AMHX)="Method "_(AMHX-23)
  1. S $P(X,U,27)="Method if OTHER"
  1. F AMHX=28 S $P(X,U,AMHX)="Substance Involved "
  1. F AMHX=29:1:31 S $P(X,U,AMHX)="Substance DRUG "_(AMHX-28)
  1. S $P(X,U,32)="Substance if Other"
  1. F AMHX=33:1:35 S $P(X,U,AMHX)="Contributing Factor "_(AMHX-32)
  1. S $P(X,U,36)="Contributing Factor, if other"
  1. S $P(X,U,37)="Race"
  1. S $P(X,U,38)="Race"
  1. S $P(X,U,39)="Ethnicity"
  1. S $P(X,U,40)="Veteran Status"
  1. W !!,X
  1. S AMHVDFN="" F S AMHVDFN=$O(^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN)) Q:AMHVDFN="" D
  1. .W !,^XTMP("AMHRPSU3",AMHJ,AMHH,"RECS",AMHVDFN)
  1. DONE ;
  1. 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
  1. K ^XTMP("AMHRPSU3",AMHJ,AMHH)
  1. Q
  1. LBLK(V,L) ;left blank fill
  1. NEW %,I
  1. S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
  1. Q V
  1. RBLK(V,L) ;EP right blank fill
  1. NEW %,I
  1. S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "
  1. Q V
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. EOP ;EP - End of page.
  1. Q:$E(IOST)'="C"
  1. Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1. NEW DIR
  1. K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1. S DIR(0)="E" D ^DIR
  1. Q
  1. ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1. Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1. ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1. Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1. ;----------
  1. XTMP(N,D) ;EP - set xtmp 0 node
  1. Q:$G(N)=""
  1. S ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$G(D)
  1. Q
  1. ;
  1. LABEL ;
  1. 1 ;;Unique Case ID;;S X=$P(^AMHPSUIC(AMHVDFN,0),U)
  1. 2 ;;Local Case #;;S X=$P(^AMHPSUIC(AMHVDFN,0),U,2)
  1. 3 ;;Event logged by;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.031)
  1. 4 ;;Discipline of Prov;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.032)
  1. 5 ;;Unique ID of Patient;;S X=$P(^AMHPSUIC(AMHVDFN,0),U,4),X=$$UID^AGTXID(X)
  1. 6 ;;Sex of Patient;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.041)
  1. 7 ;;Age of Patient on date of act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.043)
  1. 8 ;;Tribe of Enrollment;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.044)
  1. 9 ;;Community of Residence;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.045)
  1. 10 ;;Employment Status;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.05)
  1. 11 ;;Date of Act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.06)
  1. 12 ;;Community where act occurred;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.07)
  1. 13 ;;Relationship Status;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.08)
  1. 14 ;;Relationship if Other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.09)
  1. 15 ;;Education Level;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.11)
  1. 16 ;;If less than 12;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.12)
  1. 17 ;;Suicidal Behavior;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.131)
  1. 18 ;;Previous Attempts;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.14)
  1. 19 ;;Location of Act;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.15)
  1. 20 ;;Location of Act, if other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,1401)
  1. 21 ;;Lethality;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.24)
  1. 22 ;;Disposition;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,.25)
  1. 23 ;;Disposition if other;;S X=$$VAL^XBDIQ1(9002011.65,AMHVDFN,1402)