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

APCLPSU1.m

Go to the documentation of this file. 
  1. APCLPSU1 ; IHS/CMI/LAB - Suicide Form data element tally ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1.  ;
  1. START ;
  1.  W:$D(IOF) @IOF
  1.  D EOJ
  1.  W:$D(IOF) @IOF
  1.  W !!,"IHS Aggregated Data from Suicide Reporting Forms"
  1.  W !!,"This report will tally the data items specific to the Suicide Reporting form ",!,"for a date range and community specified by the user.",!
  1.  W !
  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 APCLBD=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<APCLBD W !,"Ending date must be greater than or equal to beginning date!" G ED
  1.  S APCLED=Y
  1.  S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
  1. COMM ;
  1.  K APCLCOMM
  1.  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
  1.  G:$D(DIRUT) GETDATES
  1.  I Y="A" W !!,"All communities will be included in the report.",! G ZIS
  1.  I Y="O" D  G:'$D(APCLCOMM) COMM G:$D(APCLCOMM) ZIS I 1
  1.  .S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Which COMMUNITY: " D ^DIC K DIC
  1.  .Q:Y=-1
  1.  .S APCLCOMM(+Y)=""
  1.  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
  1.  D PEP^AMQQGTX0(+Y,"APCLCOMM(")
  1.  I '$D(APCLCOMM) G COMM
  1.  I $D(APCLCOMM("*")) K APCLCOMM
  1. ZIS ;
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCLDEMO)
  1.  I APCLDEMO=-1 G COMM
  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^APCLPSU1",XBRC="PROC^APCLPSU1",XBNS="APCL",XBRX="EOJ^APCLPSU1"
  1.  D ^XBDBQUE
  1.  D EOJ
  1.  Q
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^APCLPSU1"")"
  1.  S XBNS="APCL",XBRC="PROC^APCLPSU1",XBRX="EOJ^APCLPSU1",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) APCLQUIT=1
  1.  W:$D(IOF) @IOF
  1.  Q
  1. EOJ ;
  1.  D EN^XBVK("APCL")
  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 APCLJ=$J,APCLH=$H
  1.  K ^XTMP("APCLPSU1",APCLJ,APCLH)
  1.  D XTMP("APCLPSU1","APCL - SUICIDE")
  1. V ; Run by visit date
  1.  K APCLTOT,APCLIA,APCLCS S APCLTOT=0,APCLIA=0,APCLCS=0
  1.  F  S APCLSD=$O(^AMHPSUIC("AD",APCLSD)) Q:APCLSD=""!((APCLSD\1)>APCLED)  D V1
  1.  Q
  1.  ;
  1. V1 ;
  1.  S APCLVDFN="" F  S APCLVDFN=$O(^AMHPSUIC("AD",APCLSD,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN  D
  1.  .Q:$$DEMO^APCLUTL($P(^AMHPSUIC(APCLVDFN,0),U,4),$G(APCLDEMO))
  1.  .S APCLTOT=APCLTOT+1
  1.  .S APCLSUC=$P(^AMHPSUIC(APCLVDFN,0),U,7) I APCLSUC,$D(APCLCOMM),'$D(APCLCOMM(APCLSUC)) Q
  1.  .S A=$$VAL^XBDIQ1(9002011.65,APCLVDFN,.043)
  1.  .S APCLAGEG=$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")
  1.  .S APCLTOT(APCLAGEG)=$G(APCLTOT(APCLAGEG))+1
  1.  .;tally each date element
  1.  .S APCLC=0 F APCLX=.13,.032,.03,.041,.05,.044,.045,.08,.11 D
  1.  ..S APCLC=APCLC+1
  1.  ..S X=$$VAL^XBDIQ1(9002011.65,APCLVDFN,APCLX),Y=$$VALI^XBDIQ1(9002011.65,APCLVDFN,APCLX) I Y="" S Y=X
  1.  ..S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLC,Y,X)):^(X)+1,1:1)
  1.  .;method 10
  1.  .S APCLC=10 S Z=0 F  S Z=$O(^AMHPSUIC(APCLVDFN,11,Z)) Q:Z'=+Z  D
  1.  ..S Y=$P(^AMHPSUIC(APCLVDFN,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("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLC,Y,X)):^(X)+1,1:1)
  1.  .S APCLC=11,X=$$VAL^XBDIQ1(9002011.65,APCLVDFN,.14),Y=$$VALI^XBDIQ1(9002011.65,APCLVDFN,.14)
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLC,Y,X)):^(X)+1,1:1)
  1.  .;sub use 12
  1.  .S APCLC=12 S Y=$P(^AMHPSUIC(APCLVDFN,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("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLC,Y,X)):^(X)+1,1:1)
  1.  .S APCLC=13,X=$$VAL^XBDIQ1(9002011.65,APCLVDFN,.15),Y=$$VALI^XBDIQ1(9002011.65,APCLVDFN,.15)
  1.  .S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLC,Y,X)):^(X)+1,1:1)
  1.  .;cont fact 15
  1.  .S APCLC=16 S Z=0 F  S Z=$O(^AMHPSUIC(APCLVDFN,13,Z)) Q:Z'=+Z  D
  1.  ..S Y=$P(^AMHPSUIC(APCLVDFN,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("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLC,Y,X)):^(X)+1,1:1)
  1.  .S APCLC=15 S X=$$VAL^XBDIQ1(9002011.65,APCLVDFN,.25),Y=$$VALI^XBDIQ1(9002011.65,APCLVDFN,.25) D
  1.  ..S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLC,Y,X)):^(X)+1,1:1)
  1.  .S APCLC=14 S X=$$VAL^XBDIQ1(9002011.65,APCLVDFN,.24),Y=$$VALI^XBDIQ1(9002011.65,APCLVDFN,.24) D
  1.  ..S:Y="" Y="ZZZZZ" S:X="" X="DATA NOT ENTERED" S ^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLC,Y,X)):^(X)+1,1:1),^(X)=$S($D(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLC,Y,X)):^(X)+1,1:1)
  1.  .Q
  1.  Q
  1. PRINT ;EP called from xbdbque
  1.  S APCLPG=0
  1.  K APCLQUIT
  1.  I 'APCLTOT D HEAD W !!,"No Suicide Forms to Report"  G DONE
  1.  S APCLAGEG="" F  S APCLAGEG=$O(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG)) Q:APCLAGEG=""!($D(APCLQUIT))  D
  1.  .D HEAD Q:$D(APCLQUIT)
  1.  .W !,"Age Range: ",APCLAGEG," years",?30,"Total # of Suicide Forms: ",APCLTOT(APCLAGEG),!?63,"REPORT TOTALS"
  1.  .S APCLV="" F  S APCLV=$O(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLV)) Q:APCLV=""!($D(APCLQUIT))  D
  1.  ..I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
  1.  ..S APCLL=$P($T(@APCLV),";;",2) W !?1,$$LBLK(APCLL,28)
  1.  ..S APCLY="" F  S APCLY=$O(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLV,APCLY)) Q:APCLY=""!($D(APCLQUIT))  D
  1.  ...S APCLX="" S APCLX=$O(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLV,APCLY,APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
  1.  ....S X=^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","AGE",APCLAGEG,APCLV,APCLY,APCLX)
  1.  ....W ?31,$E(APCLX,1,30),?63,$J(X,4) S T=APCLTOT(APCLAGEG) W ?72,$J(((X/T)*100),3,0)_"%",!
  1.  ..Q
  1.  .Q
  1.  I $D(APCLQUIT) G DONE
  1.  D HEAD Q:$D(APCLQUIT)
  1.  W !,"Age Range: ","ALL AGES",?30,"Total # of Suicide Forms: ",APCLTOT,!?63,"REPORT TOTALS"
  1.  S APCLV="" F  S APCLV=$O(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLV)) Q:APCLV=""!($D(APCLQUIT))  D
  1.  .I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
  1.  .S APCLL=$P($T(@APCLV),";;",2) W !?1,$$LBLK(APCLL,28)
  1.  .S APCLY="" F  S APCLY=$O(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLV,APCLY)) Q:APCLY=""!($D(APCLQUIT))  D
  1.  ..S APCLX="" S APCLX=$O(^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLV,APCLY,APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
  1.  ...S X=^XTMP("APCLPSU1",APCLJ,APCLH,"TALLY","TOTAL",APCLV,APCLY,APCLX)
  1.  ...W ?31,$E(APCLX,1,30),?63,$J(X,4) W ?72,$J(((X/APCLTOT)*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("APCLPSU1",APCLJ,APCLH)
  1.  Q
  1.  G:'APCLPG 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 APCLQUIT="" Q
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S APCLPG=APCLPG+1
  1.  W !,$$LOC,?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
  1.  S X="***** AGGREGATED DATA FROM SUICIDE REPORTING FORMS *****" W !,?((80-$L(X))/2),X,!
  1.  S X="Act Occurred: "_$$FMTE^XLFDT(APCLBD)_" - "_$$FMTE^XLFDT(APCLED) W $$CTR(X),!
  1.  S X="Community where Act Occurred: "_$S($D(APCLCOMM):$P(^AUTTCOM($O(APCLCOMM(0)),0),U),1:"ALL Communities") 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 ;;Self Destructive Act:
  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 ;;Previous Attempts:
  1. 12 ;;Substance Use Involved:
  1. 13 ;;Location of Act:
  1. 14 ;;Lethality:
  1. 15 ;;Disposition:
  1. 16 ;;Contributing Factors: