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

AMHRSU5.m

Go to the documentation of this file. 
  1. AMHRSU5 ; IHS/CMI/LAB - ; 20 Jun 2017  10:33 AM
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**6,8**;JUN 02, 2010;Build 7
  1.  ;
  1. START ;
  1.  D XIT
  1.  I '$D(IOF) D HOME^%ZIS
  1.  W @(IOF),!!
  1.  D INFORM
  1. DATES K AMHED,AMHBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
  1.  D ^DIR G:Y<1 XIT S AMHBD=Y
  1.  K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
  1.  D ^DIR G:Y<1 XIT  S AMHED=Y
  1.  ;
  1.  I AMHED<AMHBD D  G DATES
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
  1.  ;
  1. PROG ;
  1.  S AMHPROG=""
  1.  S DIR(0)="S^O:ONE Program;A:ALL Programs",DIR("A")="Run the Report for which PROGRAM",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) DATES
  1.  I Y="A" G DEMO
  1.  S DIR(0)="9002011,.02",DIR("A")="Which PROGRAM" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) PROG
  1.  I X="" G PROG
  1.  S AMHPROG=Y
  1. DEMO ;
  1.  D DEMOCHK^AMHUTIL1(.AMHDEMO)
  1.  I AMHDEMO=-1 G PROG
  1. ZIS ;call xbdbque
  1.  S XBRC="DRIVER^AMHRSU5",XBRP="PRINT^AMHRSU5",XBRX="XIT^AMHRSU5",XBNS="AMH"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. DRIVER ;EP entry point for taskman
  1.  D PROCESS
  1.  S AMHET=$H
  1.  Q
  1. XIT ;
  1.  K DIR
  1.  D EN^XBVK("AMH")  ;clean up AMH variables
  1.  D ^XBFMK  ;clean up fileman variables
  1.  Q
  1.  ;
  1. PROCESS ;
  1.  D XTMP^AMHUTIL("AMHRSU5","BH - SUICIDE POV REPORT")
  1.  S (AMHBT,AMHBTH)=$H,AMHJOB=$J
  1.  K AMHMALEV,AMHFEMV,AMHALLV,AMHMALEP,AMHFEMP,AMHALLP
  1.  F X=1:1:13 S (AMHMALEV(X),AMHFEMV(X),AMHALLV(X),AMHMALEP(X),AMHFEMP(X),AMHALLP(X))=0
  1.  S AMHSD=$P(AMHBD,".")-1,AMHSD=AMHSD_".9999"
  1.  K AMHPRAT S AMHGRTA=0
  1.  S (AMHRCNT,AMHVIEN)=0 F  S AMHSD=$O(^AMHREC("B",AMHSD)) Q:AMHSD=""!($P(AMHSD,".")>$P(AMHED,"."))  D
  1.  .S AMHVIEN=0 F  S AMHVIEN=$O(^AMHREC("B",AMHSD,AMHVIEN)) Q:AMHVIEN'=+AMHVIEN  D
  1.  ..S AMHV0=$G(^AMHREC(AMHVIEN,0))
  1.  ..Q:AMHV0=""
  1.  ..S DFN=$P(^AMHREC(AMHVIEN,0),U,8)
  1.  ..Q:DFN=""
  1.  ..Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
  1.  ..I AMHPROG]"",$P(^AMHREC(AMHVIEN,0),U,2)'=AMHPROG Q  ;not correct program visit
  1.  ..Q:'$D(^AMHRPRO("AD",AMHVIEN))  ;no pOVS
  1.  ..S AMHAGE=$$AGE^AUPNPAT(DFN,$P($P(AMHV0,U),"."))
  1.  ..S A=$$AG(AMHAGE)
  1.  ..D SETT(1,A,DFN)
  1.  ..Q:'$$SUICPOV(AMHVIEN)  ;no suicide pov
  1.  ..D SETT(2,A,DFN)
  1.  ..I $$SUICC(AMHVIEN,39) D SETT(3,A,DFN)
  1.  ..I $$SUICC(AMHVIEN,40) D SETT(4,A,DFN)
  1.  ..I $$SUICC(AMHVIEN,41) D SETT(5,A,DFN)
  1.  ..I $$SUICC(AMHVIEN,"V62.84") D SETT(3,A,DFN)
  1.  ..I $$SUICC(AMHVIEN,"R45.851") D SETT(3,A,DFN)
  1.  ..I $$SUICC(AMHVIEN,"T14.91") D SETT(4,A,DFN)
  1.  ..Q
  1.  .Q
  1.  S AMHET=$H
  1.  Q
  1.  ;
  1. SETT(P,A,D) ;
  1.  S $P(AMHALLV(13),U,P)=$P(AMHALLV(13),U,P)+1  ;all visits, all 39/40/41
  1.  I $P(^DPT(D,0),U,2)="M" S $P(AMHMALEV(13),U,P)=$P(AMHMALEV(13),U,P)+1
  1.  I $P(^DPT(D,0),U,2)="F" S $P(AMHFEMV(13),U,P)=$P(AMHFEMV(13),U,P)+1
  1.  S $P(AMHALLV(A),U,P)=$P(AMHALLV(A),U,P)+1
  1.  I $P(^DPT(D,0),U,2)="M" S $P(AMHMALEV(A),U,P)=$P(AMHMALEV(A),U,P)+1
  1.  I $P(^DPT(D,0),U,2)="F" S $P(AMHFEMV(A),U,P)=$P(AMHFEMV(A),U,P)+1
  1.  I $P($G(^XTMP("AMHRSU5",AMHJOB,AMHBTH,"PATIENTS",D)),U,P) Q
  1.  S $P(^XTMP("AMHRSU5",AMHJOB,AMHBTH,"PATIENTS",D),U,P)=1
  1.  S $P(AMHALLP(13),U,P)=$P(AMHALLP(13),U,P)+1
  1.  I $P(^DPT(D,0),U,2)="M" S $P(AMHMALEP(13),U,P)=$P(AMHMALEP(13),U,P)+1
  1.  I $P(^DPT(D,0),U,2)="F" S $P(AMHFEMP(13),U,P)=$P(AMHFEMP(13),U,P)+1
  1.  S $P(AMHALLP(A),U,P)=$P(AMHALLP(A),U,P)+1
  1.  I $P(^DPT(D,0),U,2)="M" S $P(AMHMALEP(A),U,P)=$P(AMHMALEP(A),U,P)+1
  1.  I $P(^DPT(D,0),U,2)="F" S $P(AMHFEMP(A),U,P)=$P(AMHFEMP(A),U,P)+1
  1.  Q
  1. AG(A) ;
  1.  I A<5 Q 1
  1.  I A>4,A<10 Q 2
  1.  I A>9,A<15 Q 3
  1.  I A>14,A<20 Q 4
  1.  I A>19,A<25 Q 5
  1.  I A>24,A<35 Q 6
  1.  I A>34,A<45 Q 7
  1.  I A>44,A<55 Q 8
  1.  I A>54,A<65 Q 9
  1.  I A>64,A<75 Q 10
  1.  I A>74,A<85 Q 11
  1.  I A>84 Q 12
  1.  Q ""
  1. SUICPOV(V) ;
  1.  S G=0
  1.  S X=0 F  S X=$O(^AMHRPRO("AD",V,X)) Q:X'=+X  D
  1.  .Q:'$D(^AMHRPRO(X,0))
  1.  .S Y=$P(^AMHRPRO(X,0),U)
  1.  .Q:'$D(^AMHPROB(Y,0))
  1.  .S Y=$P(^AMHPROB(Y,0),U)
  1.  .I Y=39!(Y=40)!(Y=41)!(Y="V62.84")!(Y="R45.851")!(Y="T14.91") S G=1
  1.  .Q
  1.  Q G
  1. SUICC(V,C) ;
  1.  S G=0
  1.  S X=0 F  S X=$O(^AMHRPRO("AD",V,X)) Q:X'=+X  D
  1.  .Q:'$D(^AMHRPRO(X,0))
  1.  .S Y=$P(^AMHRPRO(X,0),U)
  1.  .Q:'$D(^AMHPROB(Y,0))
  1.  .S Y=$P(^AMHPROB(Y,0),U)
  1.  .I Y=C S G=1
  1.  .Q
  1.  Q G
  1. PRINT ;EP - called from xbdbque
  1.  S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
  1.  S AMHPG=0
  1.  K AMHQUIT
  1.  D PRINT1
  1. DONE I $D(AMHET) S AMHDVTS=(86400*($P(AMHET,",")-$P(AMHBT,",")))+($P(AMHET,",",2)-$P(AMHBT,",",2)),AMHDVH=$P(AMHDVTS/3600,".") S:AMHDVH="" AMHDVH=0
  1.  S AMHDVTS=AMHDVTS-(AMHDVH*3600),AMHDVM=$P(AMHDVTS/60,".") S:AMHDVM="" AMHDVM=0 S AMHDVTS=AMHDVTS-(AMHDVM*60),AMHDVS=AMHDVTS W !!,"RUN TIME (H.M.S): ",AMHDVH,".",AMHDVM,".",AMHDVS
  1.  I $E(IOST)="C",IO=IO(0) S DIR("A")="End of Report, press Enter",DIR(0)="E" D ^DIR K DIR
  1.  W:$D(IOF) @IOF
  1.  Q
  1. PRINT1 ;
  1.  S AMHSUBH="BOTH MALE AND FEMALE PATIENTS' VISITS"
  1.  D HEAD Q:$D(AMHQUIT)
  1.  F AMHX=1:1:13 D  Q:$D(AMHQUIT)
  1.  .Q:$D(AMHQUIT)
  1.  .I $Y>(IOSL-2) D HEAD Q:$D(AMHQUIT)
  1.  .W !!?1,$P($T(@AMHX),";;",2)
  1.  .W ?13,$$RJ^XLFSTR($$C($P(AMHALLV(AMHX),U,1),0,6),6)
  1.  .S N=$P(AMHALLV(AMHX),U,1),D=$P(AMHALLV(13),U,1)
  1.  .I 'D W ?22,"0.0"
  1.  .I D W ?20,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?27,$$RJ^XLFSTR($$C($P(AMHALLV(AMHX),U,3),0,6),6)
  1.  .S N=$P(AMHALLV(AMHX),U,3),D=$P(AMHALLV(AMHX),U,1)
  1.  .I 'D W ?35,"0.0"
  1.  .I D W ?34,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?41,$$RJ^XLFSTR($$C($P(AMHALLV(AMHX),U,4),0,6),6)
  1.  .S N=$P(AMHALLV(AMHX),U,4),D=$P(AMHALLV(AMHX),U,1)
  1.  .I 'D W ?48,"0.0"
  1.  .I D W ?47,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?54,$$RJ^XLFSTR($$C($P(AMHALLV(AMHX),U,5),0,6),6)
  1.  .S N=$P(AMHALLV(AMHX),U,5),D=$P(AMHALLV(AMHX),U,1)
  1.  .I 'D W ?64,"0.0"
  1.  .I D W ?62,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?68,$$RJ^XLFSTR($$C($P(AMHALLV(AMHX),U,2),0,6),6)
  1.  .S N=$P(AMHALLV(AMHX),U,2),D=$P(AMHALLV(AMHX),U,1)
  1.  .I 'D W ?77,"0.0"
  1.  .I D W ?74,$J(((N/D)*100),5,1)
  1. MALEV ;MALE VISITS
  1.  Q:$D(AMHQUIT)
  1.  S AMHSUBH="MALE PATIENTS VISITS"
  1.  D HEAD Q:$D(AMHQUIT)
  1.  F AMHX=1:1:13 D  Q:$D(AMHQUIT)
  1.  .I $Y>(IOSL-2) D HEAD Q:$D(AMHQUIT)
  1.  .W !!?1,$P($T(@AMHX),";;",2)
  1.  .W ?13,$$RJ^XLFSTR($$C($P(AMHMALEV(AMHX),U,1),0,6),6)
  1.  .S N=$P(AMHMALEV(AMHX),U,1),D=$P(AMHMALEV(13),U,1)
  1.  .I 'D W ?22,"0.0"
  1.  .I D W ?20,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?27,$$RJ^XLFSTR($$C($P(AMHMALEV(AMHX),U,3),0,6),6)
  1.  .S N=$P(AMHMALEV(AMHX),U,3),D=$P(AMHMALEV(AMHX),U,1)
  1.  .I 'D W ?35,"0.0"
  1.  .I D W ?34,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?41,$$RJ^XLFSTR($$C($P(AMHMALEV(AMHX),U,4),0,6),6)
  1.  .S N=$P(AMHMALEV(AMHX),U,4),D=$P(AMHMALEV(AMHX),U,1)
  1.  .I 'D W ?48,"0.0"
  1.  .I D W ?47,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?54,$$RJ^XLFSTR($$C($P(AMHMALEV(AMHX),U,5),0,6),6)
  1.  .S N=$P(AMHMALEV(AMHX),U,5),D=$P(AMHMALEV(AMHX),U,1)
  1.  .I 'D W ?64,"0.0"
  1.  .I D W ?61,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?68,$$RJ^XLFSTR($$C($P(AMHMALEV(AMHX),U,2),0,6),6)
  1.  .S N=$P(AMHMALEV(AMHX),U,2),D=$P(AMHMALEV(AMHX),U,1)
  1.  .I 'D W ?77,"0.0"
  1.  .I D W ?77,$J(((N/D)*100),5,1)
  1.  ;
  1. FEMV ;FEMALE VISITSA
  1.  Q:$D(AMHQUIT)
  1.  S AMHSUBH="FEMALE PATIENTS VISITS"
  1.  D HEAD Q:$D(AMHQUIT)
  1.  F AMHX=1:1:13 D  Q:$D(AMHQUIT)
  1.  .I $Y>(IOSL-2) D HEAD Q:$D(AMHQUIT)
  1.  .W !!?1,$P($T(@AMHX),";;",2)
  1.  .W ?13,$$RJ^XLFSTR($$C($P(AMHFEMV(AMHX),U,1),0,6),6)
  1.  .S N=$P(AMHFEMV(AMHX),U,1),D=$P(AMHFEMV(13),U,1)
  1.  .I 'D W ?22,"0.0"
  1.  .I D W ?20,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?27,$$RJ^XLFSTR($$C($P(AMHFEMV(AMHX),U,3),0,6),6)
  1.  .S N=$P(AMHFEMV(AMHX),U,3),D=$P(AMHFEMV(AMHX),U,1)
  1.  .I 'D W ?35,"0.0"
  1.  .I D W ?34,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?41,$$RJ^XLFSTR($$C($P(AMHFEMV(AMHX),U,4),0,6),6)
  1.  .S N=$P(AMHFEMV(AMHX),U,4),D=$P(AMHFEMV(AMHX),U,1)
  1.  .I 'D W ?48,"0.0"
  1.  .I D W ?47,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?54,$$RJ^XLFSTR($$C($P(AMHFEMV(AMHX),U,5),0,6),6)
  1.  .S N=$P(AMHFEMV(AMHX),U,5),D=$P(AMHFEMV(AMHX),U,1)
  1.  .I 'D W ?64,"0.0"
  1.  .I D W ?61,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?68,$$RJ^XLFSTR($$C($P(AMHFEMV(AMHX),U,2),0,6),6)
  1.  .S N=$P(AMHFEMV(AMHX),U,2),D=$P(AMHFEMV(AMHX),U,1)
  1.  .I 'D W ?77,"0.0"
  1.  .I D W ?77,$J(((N/D)*100),5,1)
  1.  ;
  1. PRINT2 ;
  1.  S AMHSUBH="UNDUPLICATED PATIENT COUNT - BOTH MALE AND FEMALE PATIENTS"
  1.  Q:$D(AMHQUIT)
  1.  D HEAD Q:$D(AMHQUIT)
  1.  F AMHX=1:1:13 D  Q:$D(AMHQUIT)
  1.  .I $Y>(IOSL-2) D HEAD Q:$D(AMHQUIT)
  1.  .W !!?1,$P($T(@AMHX),";;",2)
  1.  .W ?13,$$RJ^XLFSTR($$C($P(AMHALLP(AMHX),U,1),0,6),6)
  1.  .S N=$P(AMHALLP(AMHX),U,1),D=$P(AMHALLP(13),U,1)
  1.  .I 'D W ?22,"0.0"
  1.  .I D W ?20,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?27,$$RJ^XLFSTR($$C($P(AMHALLP(AMHX),U,3),0,6),6)
  1.  .S N=$P(AMHALLP(AMHX),U,3),D=$P(AMHALLP(AMHX),U,1)
  1.  .I 'D W ?35,"0.0"
  1.  .I D W ?34,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?41,$$RJ^XLFSTR($$C($P(AMHALLP(AMHX),U,4),0,6),6)
  1.  .S N=$P(AMHALLP(AMHX),U,4),D=$P(AMHALLP(AMHX),U,1)
  1.  .I 'D W ?48,"0.0"
  1.  .I D W ?47,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?54,$$RJ^XLFSTR($$C($P(AMHALLP(AMHX),U,5),0,6),6)
  1.  .S N=$P(AMHALLP(AMHX),U,5),D=$P(AMHALLP(AMHX),U,1)
  1.  .I 'D W ?64,"0.0"
  1.  .I D W ?61,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?68,$$RJ^XLFSTR($$C($P(AMHALLP(AMHX),U,2),0,6),6)
  1.  .S N=$P(AMHALLP(AMHX),U,2),D=$P(AMHALLP(AMHX),U,1)
  1.  .I 'D W ?77,"0.0"
  1.  .I D W ?77,$J(((N/D)*100),5,1)
  1. MALEP ;MALE PATS
  1.  Q:$D(AMHQUIT)
  1.  S AMHSUBH="UNDUPLICATED PATIENT COUNT - MALE PATIENTS"
  1.  D HEAD Q:$D(AMHQUIT)
  1.  F AMHX=1:1:13 D  Q:$D(AMHQUIT)
  1.  .I $Y>(IOSL-2) D HEAD Q:$D(AMHQUIT)
  1.  .W !!?1,$P($T(@AMHX),";;",2)
  1.  .W ?13,$$RJ^XLFSTR($$C($P(AMHMALEP(AMHX),U,1),0,6),6)
  1.  .S N=$P(AMHMALEP(AMHX),U,1),D=$P(AMHMALEP(13),U,1)
  1.  .I 'D W ?22,"0.0"
  1.  .I D W ?20,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?27,$$RJ^XLFSTR($$C($P(AMHMALEP(AMHX),U,3),0,6),6)
  1.  .S N=$P(AMHMALEP(AMHX),U,3),D=$P(AMHMALEP(AMHX),U,1)
  1.  .I 'D W ?35,"0.0"
  1.  .I D W ?34,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?41,$$RJ^XLFSTR($$C($P(AMHMALEP(AMHX),U,4),0,6),6)
  1.  .S N=$P(AMHMALEP(AMHX),U,4),D=$P(AMHMALEP(AMHX),U,1)
  1.  .I 'D W ?48,"0.0"
  1.  .I D W ?47,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?54,$$RJ^XLFSTR($$C($P(AMHMALEP(AMHX),U,5),0,6),6)
  1.  .S N=$P(AMHMALEP(AMHX),U,5),D=$P(AMHMALEP(AMHX),U,1)
  1.  .I 'D W ?64,"0.0"
  1.  .I D W ?61,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?68,$$RJ^XLFSTR($$C($P(AMHMALEP(AMHX),U,2),0,6),6)
  1.  .S N=$P(AMHMALEP(AMHX),U,2),D=$P(AMHMALEP(AMHX),U,1)
  1.  .I 'D W ?77,"0.0"
  1.  .I D W ?77,$J(((N/D)*100),5,1)
  1.  ;
  1. FEMP ;FEMALE PATS
  1.  Q:$D(AMHQUIT)
  1.  S AMHSUBH="UNDUPLICATED PATIENT COUNT - FEMALE PATIENTS"
  1.  D HEAD
  1.  Q:$D(AMHQUIT)
  1.  F AMHX=1:1:13 D  Q:$D(AMHQUIT)
  1.  .I $Y>(IOSL-2) D HEAD Q:$D(AMHQUIT)
  1.  .W !!?1,$P($T(@AMHX),";;",2)
  1.  .W ?13,$$RJ^XLFSTR($$C($P(AMHFEMP(AMHX),U,1),0,6),6)
  1.  .S N=$P(AMHFEMP(AMHX),U,1),D=$P(AMHFEMP(13),U,1)
  1.  .I 'D W ?22,"0.0"
  1.  .I D W ?20,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?27,$$RJ^XLFSTR($$C($P(AMHFEMP(AMHX),U,3),0,6),6)
  1.  .S N=$P(AMHFEMP(AMHX),U,3),D=$P(AMHFEMP(AMHX),U,1)
  1.  .I 'D W ?35,"0.0"
  1.  .I D W ?34,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?41,$$RJ^XLFSTR($$C($P(AMHFEMP(AMHX),U,4),0,6),6)
  1.  .S N=$P(AMHFEMP(AMHX),U,4),D=$P(AMHFEMP(AMHX),U,1)
  1.  .I 'D W ?48,"0.0"
  1.  .I D W ?47,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?54,$$RJ^XLFSTR($$C($P(AMHFEMP(AMHX),U,5),0,6),6)
  1.  .S N=$P(AMHFEMP(AMHX),U,5),D=$P(AMHFEMP(AMHX),U,1)
  1.  .I 'D W ?64,"0.0"
  1.  .I D W ?61,$J(((N/D)*100),5,1)
  1.  .;
  1.  .W ?68,$$RJ^XLFSTR($$C($P(AMHFEMP(AMHX),U,2),0,6),6)
  1.  .S N=$P(AMHFEMP(AMHX),U,2),D=$P(AMHFEMP(AMHX),U,1)
  1.  .I 'D W ?77,"0.0"
  1.  .I D W ?77,$J(((N/D)*100),5,1)
  1.  ;
  1.  Q
  1.  I 'AMHPG G HEAD1
  1.  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 !,$$FMTE^XLFDT(DT),?70,"Page: ",AMHPG
  1.  W !?29,"Behavioral Health"
  1.  W !,$$CTR($$REPEAT^XLFSTR("*",35),80)
  1.  W !,$$CTR("*   SUICIDE PURPOSE OF VISIT REPORT  *",80)
  1.  W !,$$CTR($$REPEAT^XLFSTR("*",35),80)
  1.  S X="VISIT Date Range: "_AMHBDD_" through "_AMHEDD W !,$$CTR(X,80)
  1.  S X=AMHSUBH W !,$$CTR(X,80),!
  1.  S X="39, V62.84, R45.851 - Suicide Ideation; 40 & T14.91 - Suicide Attempt/Gesture;" W !,$$CTR(X,80),!
  1.  S X="41 - Suicide Completed" W $$CTR(X,80),!
  1.  W !,"AGE GROUP",?13,"# Encs",?27,"# w POV 39",?42,"w/ POV 40",?54,"w/ POV 41",?68,"w/ 39/40/41/"
  1.  W !?27,"V62.84/R45.851",?42,"& T14.91",?68,"V62.84/R45.851"
  1.  W !?15,"#",?22,"%",?29,"#",?36,"%",?43,"#",?50,"%",?56,"#",?63,"%",?70,"#",?77,"%"
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  Q
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q $$STRIP^XLFSTR(X," ")
  1. D(D) ;
  1.  I $G(D)="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  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("A")="End of report.  Press Enter",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. INFORM ;inform user what this report is all about
  1.  W !,$$CTR($$LOC)
  1.  W !!,$$CTR("BEHAVIORAL HEALTH SUICIDE PURPOSE OF VISIT REPORT")
  1.  W !!,"This report will display the Suicide POVs (39,40,41,V62.84, R45.851, T14.91)"
  1.  W !," as a percentage of the total number of Behavioral Health encounter"
  1.  W !,"records (Encs).  Any records containing the ICD-9 code v62.84,"
  1.  W !,"Suicidal Ideation or ICD-10 code R45.851 will be included in "
  1.  W !,"the tallies for Problem code 39.  Any records with ICD-10 Code T14.91"
  1.  W !,"will be included in the tallies for Problem code 40. A display by "
  1.  W !,"age and gender is also included."
  1.  W !
  1.  Q
  1. OPRV ;one PROVIDER
  1.  S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC K DIC
  1.  I Y=-1 S AMHQ="" Q
  1.  S AMHPRVS(+Y)=""
  1.  Q
  1. SPRV ;taxonomy of PROVIDERS
  1.  S X="PRIMARY PROVIDER",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 XIT
  1.  D PEP^AMQQGTX0(+Y,"AMHPRVS(")
  1.  I '$D(AMHPRVS) S AMHQ="" Q
  1.  I $D(AMHPRVS("*")) S AMHPRVT="A" K AMHPRVS W !!,"**** all PROVIDERS will be included ****",! Q
  1.  Q
  1.  ;
  1. 1 ;;1-4 yrs
  1. 2 ;;5-9 yrs
  1. 3 ;;10-14 yrs
  1. 4 ;;15-19 yrs
  1. 5 ;;20-24 yrs
  1. 6 ;;25-34 yrs
  1. 7 ;;35-44 yrs
  1. 8 ;;45-54 yrs
  1. 9 ;;55-64 yrs
  1. 10 ;;65-74 yrs
  1. 11 ;;75-84 yrs
  1. 12 ;;85+ yrs
  1. 13 ;;TOTAL