AMHRP31 ; IHS/CMI/LAB - PROCESS REPORT ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
;
START ;
D XTMP^AMHUTIL("AMHRP3","BH ACTIVITY BY PRIMPROV")
S (AMHBT,AMHBTH)=$H,AMHJOB=$J
D D,END
Q
;
D ; 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
;
END ;
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 ;
Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)
I $P(AMHR0,U,8) Q:$$DEMO^AMHUTIL1($P(AMHR0,U,8),$G(AMHDEMO))
I AMHPROG]"",$P(AMHR0,U,2)'=AMHPROG Q
I AMHPRV S (X,G)=0 F S X=$O(^AMHRPROV("AD",AMHR,X)) Q:X'=+X I $P(^AMHRPROV(X,0),U)=AMHPRV S G=1
I AMHPRV,'G Q
K X,G
S AMHLOC=$P(AMHR0,U,4) Q:AMHLOC="" S AMHAREA=$P(^AUTTLOC(AMHLOC,0),U,4),AMHSU=$P(^AUTTLOC(AMHLOC,0),U,5)
S AMHACT=$P(AMHR0,U,6),AMHACT=$S(AMHACT]"":$P(^AMHTACT(AMHACT,0),U)_"-"_$P(^(0),U,2),1:"9999-UNKNOWN")
S AMHPIEN=$O(^AMHRPRO("AD",AMHR,"")) S AMHPIEN=$S(AMHPIEN]"":$P(^AMHRPRO(AMHPIEN,0),U),1:"")
S AMHPROB=$S(AMHPIEN]"":$P(^AMHPROB(AMHPIEN,0),U)_"-"_$P(^AMHPROB(AMHPIEN,0),U,2),1:"NO PROBLEM RECORDED")
S AMHX=0 F S AMHX=$O(^AMHRPROV("AD",AMHR,AMHX)) Q:AMHX'=+AMHX D
.I AMHPRV,AMHPRV'=$P(^AMHRPROV(AMHX,0),U) Q
.I AMHPSP="P",$P(^AMHRPROV(AMHX,0),U,4)'="P" Q
.S AMHPNAME=$P(^VA(200,$P(^AMHRPROV(AMHX,0),U),0),U),AMHDISC=$$PROVCLS^XBFUNC1($P(^AMHRPROV(AMHX,0),U),"E"),AMHPROV=AMHPNAME_" ("_AMHDISC_")"
.S $P(^(AMHPROB),U)=$S($D(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB)):$P(^(AMHPROB),U)+1,1:1)
.S $P(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,2)=$P(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,2)+$P(AMHR0,U,12)
.S $P(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,4)=$P(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,4)+$P(AMHR0,U,9)
.Q:$P(AMHR0,U,8)=""
.Q:$D(^XTMP("AMHRP3",AMHJOB,AMHBT,"PATIENT",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB,$P(AMHR0,U,8)))
.S ^XTMP("AMHRP3",AMHJOB,AMHBT,"PATIENT",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB,$P(AMHR0,U,8))=""
.S $P(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,3)=$P(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,3)+1
Q
AMHRP31 ; IHS/CMI/LAB - PROCESS REPORT ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
+5 ;
START ;
+1 DO XTMP^AMHUTIL("AMHRP3","BH ACTIVITY BY PRIMPROV")
+2 SET (AMHBT,AMHBTH)=$HOROLOG
SET AMHJOB=$JOB
+3 DO D
DO END
+4 QUIT
+5 ;
D ; 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 ;
END ;
+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 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)
QUIT
+2 IF $PIECE(AMHR0,U,8)
IF $$DEMO^AMHUTIL1($PIECE(AMHR0,U,8),$GET(AMHDEMO))
QUIT
+3 IF AMHPROG]""
IF $PIECE(AMHR0,U,2)'=AMHPROG
QUIT
+4 IF AMHPRV
SET (X,G)=0
FOR
SET X=$ORDER(^AMHRPROV("AD",AMHR,X))
IF X'=+X
QUIT
IF $PIECE(^AMHRPROV(X,0),U)=AMHPRV
SET G=1
+5 IF AMHPRV
IF 'G
QUIT
+6 KILL X,G
+7 SET AMHLOC=$PIECE(AMHR0,U,4)
IF AMHLOC=""
QUIT
SET AMHAREA=$PIECE(^AUTTLOC(AMHLOC,0),U,4)
SET AMHSU=$PIECE(^AUTTLOC(AMHLOC,0),U,5)
+8 SET AMHACT=$PIECE(AMHR0,U,6)
SET AMHACT=$SELECT(AMHACT]"":$PIECE(^AMHTACT(AMHACT,0),U)_"-"_$PIECE(^(0),U,2),1:"9999-UNKNOWN")
+9 SET AMHPIEN=$ORDER(^AMHRPRO("AD",AMHR,""))
SET AMHPIEN=$SELECT(AMHPIEN]"":$PIECE(^AMHRPRO(AMHPIEN,0),U),1:"")
+10 SET AMHPROB=$SELECT(AMHPIEN]"":$PIECE(^AMHPROB(AMHPIEN,0),U)_"-"_$PIECE(^AMHPROB(AMHPIEN,0),U,2),1:"NO PROBLEM RECORDED")
+11 SET AMHX=0
FOR
SET AMHX=$ORDER(^AMHRPROV("AD",AMHR,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+12 IF AMHPRV
IF AMHPRV'=$PIECE(^AMHRPROV(AMHX,0),U)
QUIT
+13 IF AMHPSP="P"
IF $PIECE(^AMHRPROV(AMHX,0),U,4)'="P"
QUIT
+14 SET AMHPNAME=$PIECE(^VA(200,$PIECE(^AMHRPROV(AMHX,0),U),0),U)
SET AMHDISC=$$PROVCLS^XBFUNC1($PIECE(^AMHRPROV(AMHX,0),U),"E")
SET AMHPROV=AMHPNAME_" ("_AMHDISC_")"
+15 SET $PIECE(^(AMHPROB),U)=$SELECT($DATA(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB)):$PIECE(^(AMHPROB),U)+1,1:1)
+16 SET $PIECE(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,2)=$PIECE(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,2)+$PIECE(AMHR0,U,12)
+17 SET $PIECE(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,4)=$PIECE(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,4)+$PIECE(AMHR0,U,9)
+18 IF $PIECE(AMHR0,U,8)=""
QUIT
+19 IF $DATA(^XTMP("AMHRP3",AMHJOB,AMHBT,"PATIENT",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB,$PIECE(AMHR0,U,8)))
QUIT
+20 SET ^XTMP("AMHRP3",AMHJOB,AMHBT,"PATIENT",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB,$PIECE(AMHR0,U,8))=""
+21 SET $PIECE(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,3)=$PIECE(^XTMP("AMHRP3",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT,AMHPROB),U,3)+1
End DoDot:1
+22 QUIT
