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

AMHRPSU2.m

Go to the documentation of this file. 
  1. AMHRPSU2 ; 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.  D EN^XBVK("AMH")
  1.  W:$D(IOF) @IOF
  1.  W !!,"Aggregate Suicide Data Report - Selected Variables"
  1.  W !!,"This report will tally the data items selected by the user for Suicide",!,"Forms in a date range.",!!
  1.  ;D PAUSE
  1.  ;GETDATES ;
  1.  D DBHUSRP^AMHUTIL
  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.  I $D(AMHQUIT) D EOJ Q
  1.  D ADD
  1.  S AMHTCW=0,AMHPCNT=0
  1.  S AMHPTVS="S",AMHXREF="SU"
  1.  S AMHRPTC=7
  1. SCREEN ;
  1.  K ^AMHTRPT(AMHRPT,11) S AMHCNTL="S",AMHTYPE="SU",AMHPTTX="Suicide Form",AMHPTTS="Suicide Forms" D ^AMHRL4 K AMHRDTR,AMHCNTL I $D(AMHQUIT) D DEL^AMHRL G EOJ
  1. DEMO ;
  1.  D DEMOCHK^AMHUTIL1(.AMHDEMO)
  1.  I AMHDEMO=-1 G BD
  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^AMHRPSU2",XBRC="PROC^AMHRPSU2",XBNS="AMH",XBRX="EOJ^AMHRPSU2"
  1.  D ^XBDBQUE
  1.  D EOJ
  1.  Q
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^AMHRPSU2"")"
  1.  S XBNS="AMH",XBRC="PROC^AMHRPSU2",XBRX="EOJ^AMHRPSU2",XBIOP=0 D ^XBDBQUE
  1.  Q
  1.  ;
  1. ADD ;EP
  1.  S %H=$H D YX^%DTC S X=$P(^VA(200,DUZ,0),U)_"-"_Y,DIC(0)="L",DIC="^AMHTRPT(",DLAYGO=9002013.8,DIADD=1 D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S AMHQUIT=1 Q
  1.  S AMHRPT=+Y
  1.  K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
  1.  ;DELETE ALL 11 MULTIPLE HERE
  1.  K ^AMHTRPT(AMHRPT,11)
  1.  Q
  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 DEL^AMHRL
  1.  D EN^XBVK("AMH")
  1.  K L,M,S,T,X,X1,X2,Y,Z,B
  1.  D KILL^AUPNPAT
  1.  D ^XBFMK
  1.  Q
  1. PROC ;EP
  1.  S AMHJ=$J,AMHH=$H
  1.  K ^XTMP("AMHRPSU2",AMHJ,AMHH)
  1.  D XTMP("AMHRPSU2","AMH - SUICIDE")
  1. V ; Run by visit date
  1.  K AMHTOT,AMHIA,AMHCS S AMHTOT=0,AMHIA=0,AMHCS=0
  1.  ;S AMHR=0 F  S AMHR=$O(^AMHPSUIC(AMHR)) Q:AMHR'=+AMHR  D V1
  1.   F  S AMHSD=$O(^AMHPSUIC("AD",AMHSD)) Q:AMHSD=""!((AMHSD\1)>AMHED)  D V1
  1.  Q
  1.  ;
  1. V1 ;
  1.  S AMHR="" F  S AMHR=$O(^AMHPSUIC("AD",AMHSD,AMHR)) Q:AMHR'=+AMHR  D V2
  1.  Q
  1.  ;
  1. V2 ;
  1.  S AMHR0=^AMHPSUIC(AMHR,0)
  1.  S DFN=$P(AMHR0,U,4)
  1.  ;I DFN,'$$ALLOWP^AMHUTIL(DUZ,DFN) Q
  1.  Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
  1.  D SCREENS
  1.  Q:$D(AMHSKIP)
  1.  S AMHTOT=AMHTOT+1
  1.  S AMHSUC=$P(^AMHPSUIC(AMHR,0),U,7) I $D(AMHCOMM),'$D(AMHCOMM(AMHSUC)) Q
  1.  S A=$$VAL^XBDIQ1(9002011.65,AMHR,.043)
  1.  ;tally each date element
  1.  S AMHC=0 F AMHX=.131,.032,.03,.041,.05,.044,.045,.08,.11 D
  1.  .S AMHC=AMHC+1
  1.  .S X=$$VAL^XBDIQ1(9002011.65,AMHR,AMHX),Y=$$VALI^XBDIQ1(9002011.65,AMHR,AMHX) I Y="" S Y=X
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  ;method 10
  1.  S AMHC=10 S Z=0 F  S Z=$O(^AMHPSUIC(AMHR,11,Z)) Q:Z'=+Z  D
  1.  .S Y=$P(^AMHPSUIC(AMHR,11,Z,0),U),X=$$EXTSET^XBFUNC(9002011.6511,.01,Y)
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  .;METHOD IF OTHER
  1.  .I $P(^AMHPSUIC(AMHR,11,Z,0),U,2)]"" S (X,Y)=$P(^AMHPSUIC(AMHR,11,Z,0),U,2),^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",11,Y,X)):^(X)+1,1:1)
  1.  S AMHC=12,X=$$VAL^XBDIQ1(9002011.65,AMHR,.14),Y=$$VALI^XBDIQ1(9002011.65,AMHR,.14)
  1.  S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  ;sub use 11
  1.  S AMHC=13 S Y=$P(^AMHPSUIC(AMHR,0),U,26),X=$$EXTSET^XBFUNC(9002011.65,.26,Y)
  1.  S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  S AMHC=14,X=$$VAL^XBDIQ1(9002011.65,AMHR,.15),Y=$$VALI^XBDIQ1(9002011.65,AMHR,.15)
  1.  S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  I $P($G(^AMHPSUIC(AMHR,14)),U)]"" D
  1.  .S AMHC=15,X=$$VAL^XBDIQ1(9002011.65,AMHR,1401),Y=$$VALI^XBDIQ1(9002011.65,AMHR,1401)  ;OTHER LOC OF ACT VALUES
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  ;cont fact 15
  1.  S AMHC=19 S Z=0 F  S Z=$O(^AMHPSUIC(AMHR,13,Z)) Q:Z'=+Z  D
  1.  .S Y=$P(^AMHPSUIC(AMHR,13,Z,0),U),Y=$P(^AMHTSCF(Y,0),U,2),X=$P(^AMHTSCF(Y,0),U,1)
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  .;cf IF OTHER
  1.  .I $P(^AMHPSUIC(AMHR,13,Z,0),U,2)]"" S (X,Y)=$P(^AMHPSUIC(AMHR,13,Z,0),U,2),^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",20,Y,X)):^(X)+1,1:1)
  1.  S AMHC=17 S X=$$VAL^XBDIQ1(9002011.65,AMHR,.25),Y=$$VALI^XBDIQ1(9002011.65,AMHR,.25) D
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  I $P($G(^AMHPSUIC(AMHR,14)),U,2)]"" D
  1.  .S AMHC=18,X=$$VAL^XBDIQ1(9002011.65,AMHR,1402),Y=$$VALI^XBDIQ1(9002011.65,AMHR,1402)  ;OTHER LOC OF ACT VALUES
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,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
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  .Q
  1.  S AMHC=21 S Z=0 F  S Z=$O(^AMHPSUIC(AMHR,15,Z)) Q:Z'=+Z  D
  1.  .S Y=$P(^AMHPSUIC(AMHR,15,Z,0),U),X=$P(^AMHTSSU(Y,0),U,1)
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  .;cf IF OTHER
  1.  .I $P(^AMHPSUIC(AMHR,15,Z,0),U,2)]"" S (X,Y)=$P(^AMHPSUIC(AMHR,15,Z,0),U,2),^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",22,Y,X)):^(X)+1,1:1)
  1.  S P=$P(^AMHPSUIC(AMHR,0),U,4)
  1.  S AMHC=23,X=$$RACE^AGUTL(P)
  1.  S (X,Y)=$P(X,U,2)
  1.  I X="" S X="UNKNOWN",Y="ZZZZZ"
  1.  S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  S AMHC=24,(X,Y)=$$ETHN^AMHRPSU1($P(^AMHPSUIC(AMHR,0),U,4),"E")
  1.  I X="" S X="UNKNOWN",Y="ZZZZZ"
  1.  S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  S AMHC=25,(X,Y)=$$VAL^XBDIQ1(2,P,1901)
  1.  I X="" S X="UNKNOWN",Y="ZZZZZ"
  1.  S ^(X)=$S($D(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHC,Y,X)):^(X)+1,1:1)
  1.  Q
  1. SCREENS ;
  1.  K AMHSKIP
  1.  S AMHI=0 F  S AMHI=$O(^AMHTRPT(AMHRPT,11,AMHI)) Q:AMHI'=+AMHI!($D(AMHSKIP))  D
  1.  .I '$P(^AMHSORT(AMHI,0),U,8) D SINGLE Q
  1.  .D MULT
  1.  .Q
  1.  Q
  1. SINGLE ;
  1.  K AMHSPEC
  1.  S X="",AMHX=0
  1.  X:$D(^AMHSORT(AMHI,1)) ^(1)
  1.  I X="" S AMHSKIP="" Q
  1.  I '$D(AMHSPEC),'$D(^AMHTRPT(AMHRPT,11,AMHI,11,"B",X)) S AMHSKIP="" Q
  1.  Q
  1. MULT ;
  1.  K AMHFOUN,AMHSKIP,X S AMHX=0,X=""
  1.  X:$D(^AMHSORT(AMHI,1)) ^(1)
  1.  I '$L($O(X)) S AMHSKIP="" Q
  1.  S Y="" F  S Y=$O(X(Y)) Q:Y=""  I $D(^AMHTRPT(AMHRPT,11,AMHI,11,"B",Y)) S AMHFOUN="" Q
  1.  S:'$D(AMHFOUN) AMHSKIP=""
  1.  Q
  1. PRINT ;EP called from xbdbque
  1.  S AMHPG=0
  1.  K AMHQUIT
  1.  S AMHSUIC=1
  1.  D COVPAGE^AMHRPTCP
  1.  I 'AMHTOT D HEAD W !!,"No Suicide Forms to Report"  G DONE
  1.  I $D(AMHQUIT) G DONE
  1.  D HEAD Q:$D(AMHQUIT)
  1.  W !,"Total # of Suicide Forms: ",AMHTOT,!?63,"REPORT TOTALS"
  1.  S AMHV="" F  S AMHV=$O(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHV)) Q:AMHV=""!($D(AMHQUIT))  D
  1.  .I $Y>(IOSL-6) D HEAD Q:$D(AMHQUIT)
  1.  .S AMHL=$P($T(@AMHV),";;",2) W !?1,$$LBLK(AMHL,28)
  1.  .S AMHY="" F  S AMHY=$O(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY)) Q:AMHY=""!($D(AMHQUIT))  D
  1.  ..S AMHX="" S AMHX=$O(^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY,AMHX)) Q:AMHX=""!($D(AMHQUIT))  D
  1.  ...S X=^XTMP("AMHRPSU2",AMHJ,AMHH,"TALLY","TOTAL",AMHV,AMHY,AMHX)
  1.  ...W ?31,$E(AMHX,1,30),?63,$J(X,4) S T=AMHTOT W ?72,$J(((X/T)*100),3,0)_"%",!
  1.  ..Q
  1.  .Q
  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("AMHRPSU2",AMHJ,AMHH)
  1.  Q
  1.  G:'AMHPG HEAD1
  1.  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
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S AMHPG=AMHPG+1
  1.  W !,$$LOC,?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHPG,!
  1.  S X="***** AGGREGATED SUICIDE DATA *****" W !,?((80-$L(X))/2),X,!
  1.  S X="Act Occurred: "_$$FMTE^XLFDT(AMHBD)_" - "_$$FMTE^XLFDT(AMHED) W $$CTR(X),!
  1.  W $TR($J("",80)," ","-"),!
  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 ;;Suicidal Behavior:
  1. 2 ;;Event logged by Discipline:
  1. 3 ;;Event logged by Provider:
  1. 4 ;;Sex:
  1. 5 ;;Employed:
  1. 6 ;;Tribe of Enrollment:
  1. 7 ;;Community of Residence:
  1. 8 ;;Relationship:
  1. 9 ;;Education:
  1. 10 ;;Method:
  1. 11 ;;Method if Other:
  1. 12 ;;Previous Attempts:
  1. 13 ;;Substance Use Involved:
  1. 14 ;;Location of Act:
  1. 15 ;;Other location of Act:
  1. 16 ;;Lethality:
  1. 17 ;;Disposition:
  1. 18 ;;Disposition if OTHER:
  1. 19 ;;Contributing Factors:
  1. 20 ;;Contributing Factor if OTHER:
  1. 21 ;;Substance Drugs:
  1. 22 ;;Substance Drugs if OTHER:
  1. 23 ;;Race:
  1. 24 ;;Ethnicity:
  1. 25 ;;Veteran's Status