- 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
