AMHRPS1 ; IHS/CMI/LAB - PROCESS REPORT ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
;
START ;
D XTMP^AMHUTIL("AMHRPS","BH - ABUSE/SUICIDE REPORT")
S (AMHBT,AMHBTH)=$H,AMHJOB=$J
S AMHRNN=AMHRBIN,AMHRA="" F I=1:1 S AMHRX=$P(AMHRNN,";",I) Q:AMHRX="" D SETA
S AMHRDOBS=AMHRA
D DATE,XIT
Q
;
DATE ; Run by encounter date
S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X
S AMHODAT=AMHSD_".9999" F S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!((AMHODAT\1)>AMHED) D D1
Q
;
XIT ;
S AMHET=$H
D EOJ
Q
EOJ ;
Q
D1 ;
S (AMHR,AMHRCNT)=0 F S AMHR=$O(^AMHREC("B",AMHODAT,AMHR)) Q:AMHR'=+AMHR I $D(^AMHREC(AMHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"" S AMHR0=^(0) D PROC
Q
PROC ;
S DFN=$P(AMHR0,U,8) Q:DFN="" ;do not use if no patient
Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)
Q:'$D(^AMHRPRO("AD",AMHR)) ;quit if no problems entered
Q:$D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"PATIENTS",DFN)) ;quit if already counted this patient
;find pov
S (AMHFOUND,X)=0,AMHSORT="" F S X=$O(^AMHRPRO("AD",AMHR,X)) Q:X'=+X!(AMHFOUND) S P=$P(^AMHRPRO(X,0),U),P=$P(^AMHPROB(P,0),U) I $D(AMHPROB(P)) S AMHFOUND=1,AMHSORT=P
Q:'AMHFOUND ; quit if not visit for problem
SETTMP ;
S AMHRAGE="" D GETAGE
Q:'AMHRAGE
Q:AMHRSEX=""
S ^XTMP("AMHRPS",AMHJOB,AMHBTH,"PATIENTS",DFN)=""
S ^(AMHRAGE)=$S($D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE",AMHRSEX,AMHSORT,AMHRAGE)):^(AMHRAGE)+1,1:1)
S ^(AMHRAGE)=$S($D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL",AMHRSEX,AMHRAGE)):^(AMHRAGE)+1,1:1)
S ^(AMHSORT)=$S($D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL SORT",AMHRSEX,AMHSORT)):^(AMHSORT)+1,1:1)
S ^(AMHRAGE)=$S($D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE","B",AMHSORT,AMHRAGE)):^(AMHRAGE)+1,1:1)
S ^(AMHRAGE)=$S($D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL","B",AMHRAGE)):^(AMHRAGE)+1,1:1)
S ^(AMHSORT)=$S($D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL SORT","B",AMHSORT)):^(AMHSORT)+1,1:1)
Q
GETAGE ;
S AMHRDOB=$P(^DPT($P(AMHR0,U,8),0),U,3) Q:AMHRDOB=""
S AMHRSEX=$P(^DPT($P(AMHR0,U,8),0),U,2)
ATT ;
F I=1:1 S AMHRNN=$P(AMHRA,";",I) Q:AMHRNN="" S AMHRX=$P(AMHRNN,"-"),AMHRY=$P(AMHRNN,"-",2) I AMHRDOB'<AMHRX,AMHRDOB'>AMHRY S AMHRAGE=I Q
Q
;
;
SETA ;
S AMHRY=$P(AMHRX,"-"),AMHRZ=$P(AMHRX,"-",2)
I AMHRA]"" S AMHRA=AMHRA_";"
S AMHRA=AMHRA_(DT+1-(10000*(AMHRZ+1)))_"-"_(DT-(AMHRY*10000))
S ^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL","AGE",I)=0
Q
AMHRPS1 ; IHS/CMI/LAB - PROCESS REPORT ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
+5 ;
START ;
+1 DO XTMP^AMHUTIL("AMHRPS","BH - ABUSE/SUICIDE REPORT")
+2 SET (AMHBT,AMHBTH)=$HOROLOG
SET AMHJOB=$JOB
+3 SET AMHRNN=AMHRBIN
SET AMHRA=""
FOR I=1:1
SET AMHRX=$PIECE(AMHRNN,";",I)
IF AMHRX=""
QUIT
DO SETA
+4 SET AMHRDOBS=AMHRA
+5 DO DATE
DO XIT
+6 QUIT
+7 ;
DATE ; Run by encounter date
+1 SET X1=AMHBD
SET X2=-1
DO C^%DTC
SET AMHSD=X
+2 SET AMHODAT=AMHSD_".9999"
FOR
SET AMHODAT=$ORDER(^AMHREC("B",AMHODAT))
IF AMHODAT=""!((AMHODAT\1)>AMHED)
QUIT
DO D1
+3 QUIT
+4 ;
XIT ;
+1 SET AMHET=$HOROLOG
+2 DO EOJ
+3 QUIT
EOJ ;
+1 QUIT
D1 ;
+1 SET (AMHR,AMHRCNT)=0
FOR
SET AMHR=$ORDER(^AMHREC("B",AMHODAT,AMHR))
IF AMHR'=+AMHR
QUIT
IF $DATA(^AMHREC(AMHR,0))
IF $PIECE(^(0),U,2)]""
IF $PIECE(^(0),U,3)]""
SET AMHR0=^(0)
DO PROC
+2 QUIT
PROC ;
+1 ;do not use if no patient
SET DFN=$PIECE(AMHR0,U,8)
IF DFN=""
QUIT
+2 IF '$$ALLOWP^AMHUTIL(DUZ,DFN)
QUIT
+3 IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
QUIT
+4 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)
QUIT
+5 ;quit if no problems entered
IF '$DATA(^AMHRPRO("AD",AMHR))
QUIT
+6 ;quit if already counted this patient
IF $DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"PATIENTS",DFN))
QUIT
+7 ;find pov
+8 SET (AMHFOUND,X)=0
SET AMHSORT=""
FOR
SET X=$ORDER(^AMHRPRO("AD",AMHR,X))
IF X'=+X!(AMHFOUND)
QUIT
SET P=$PIECE(^AMHRPRO(X,0),U)
SET P=$PIECE(^AMHPROB(P,0),U)
IF $DATA(AMHPROB(P))
SET AMHFOUND=1
SET AMHSORT=P
+9 ; quit if not visit for problem
IF 'AMHFOUND
QUIT
SETTMP ;
+1 SET AMHRAGE=""
DO GETAGE
+2 IF 'AMHRAGE
QUIT
+3 IF AMHRSEX=""
QUIT
+4 SET ^XTMP("AMHRPS",AMHJOB,AMHBTH,"PATIENTS",DFN)=""
+5 SET ^(AMHRAGE)=$SELECT($DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE",AMHRSEX,AMHSORT,AMHRAGE)):^(AMHRAGE)+1,1:1)
+6 SET ^(AMHRAGE)=$SELECT($DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL",AMHRSEX,AMHRAGE)):^(AMHRAGE)+1,1:1)
+7 SET ^(AMHSORT)=$SELECT($DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL SORT",AMHRSEX,AMHSORT)):^(AMHSORT)+1,1:1)
+8 SET ^(AMHRAGE)=$SELECT($DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE","B",AMHSORT,AMHRAGE)):^(AMHRAGE)+1,1:1)
+9 SET ^(AMHRAGE)=$SELECT($DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL","B",AMHRAGE)):^(AMHRAGE)+1,1:1)
+10 SET ^(AMHSORT)=$SELECT($DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL SORT","B",AMHSORT)):^(AMHSORT)+1,1:1)
+11 QUIT
GETAGE ;
+1 SET AMHRDOB=$PIECE(^DPT($PIECE(AMHR0,U,8),0),U,3)
IF AMHRDOB=""
QUIT
+2 SET AMHRSEX=$PIECE(^DPT($PIECE(AMHR0,U,8),0),U,2)
ATT ;
+1 FOR I=1:1
SET AMHRNN=$PIECE(AMHRA,";",I)
IF AMHRNN=""
QUIT
SET AMHRX=$PIECE(AMHRNN,"-")
SET AMHRY=$PIECE(AMHRNN,"-",2)
IF AMHRDOB'<AMHRX
IF AMHRDOB'>AMHRY
SET AMHRAGE=I
QUIT
+2 QUIT
+3 ;
+4 ;
SETA ;
+1 SET AMHRY=$PIECE(AMHRX,"-")
SET AMHRZ=$PIECE(AMHRX,"-",2)
+2 IF AMHRA]""
SET AMHRA=AMHRA_";"
+3 SET AMHRA=AMHRA_(DT+1-(10000*(AMHRZ+1)))_"-"_(DT-(AMHRY*10000))
+4 SET ^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL","AGE",I)=0
+5 QUIT
