AMHRLKUP ; IHS/CMI/LAB - lookup up record ;
;;4.0;IHS BEHAVIORAL HEALTH;**4,5**;JUN 02, 2010;Build 18
;
EN ;EP
D EOJ
K AMHR
I AMHPAT,'$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL Q
I AMHPAT]"",'$D(^AMHREC("C",AMHPAT)) W !!,"No visits currently on file for ",$P(^DPT(AMHPAT,0),U),".",! Q
I AMHLOC]"",'$D(^AMHREC("AA",AMHDATE,AMHLOC)) W !!,"No visits currently on file for ",$P(^DIC(4,AMHLOC,0),U),".",! Q
S AMHDASH="--------------------------------------------------------------------------------"
D COLLECT
I AMHRCNT=1 S AMHR=AMHRRECS(1) D EOJ Q
I AMHRCNT=0 K AMHR D EOJ Q
D DISPRECS
D SELECT
EOJ ;
K AMHQUIT,AMHPG,AMHODAT,AMHRRECS,AMHP,AMHR0,AMHRCNT,AMHRCTR
Q
HEAD ;
I 'AMHPG G HEAD1
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
HEAD1 ;
S AMHPG=AMHPG+1
W:$D(IOF) @IOF
W !,AMHDASH
W !?13,"Behavioral Health visits for " S Y=AMHDATE D DD^%DT W Y I AMHLOC]"" W !,"Location: ",$P(^DIC(4,AMHLOC,0),U)
W !,AMHDASH
W !," #",?7,"PROVIDER",?18,"LOC",?23,"COMMUNITY",?33,"ACT",?37,"CONT",?42,"PATIENT",?55,"PROB",?64,"NARRATIVE",!,AMHDASH
Q
SELECT ;
W ! S DIR(0)="NO^1:"_AMHRCNT_":0",DIR("A")="Which record do you want to display" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No Records selected to display." D PAUSE^AMHLEIN Q
I '$D(AMHRRECS(+Y)) W !,"Invalid selection!!" G SELECT
S AMHR=AMHRRECS(+Y)
Q
COLLECT ;
S AMHODAT=(AMHDATE-1)_".9999",(AMHRCNT,AMHRIEN)=0 F S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!(AMHODAT>(AMHDATE_".9999"))!($D(AMHQUIT)) D
.S AMHRIEN=0 F S AMHRIEN=$O(^AMHREC("B",AMHODAT,AMHRIEN)) Q:AMHRIEN'=+AMHRIEN!($D(AMHQUIT)) S AMHR0=^AMHREC(AMHRIEN,0) D
..I AMHLOC]"",AMHLOC'=$P(AMHR0,U,4) Q
..I AMHPAT]"",AMHPAT'=$P(AMHR0,U,8) Q
..I $G(AMHEHR),'$P($G(^AMHREC(AMHRIEN,11)),U,10) Q
..I '$$ALLOWVI^AMHUTIL(DUZ,AMHRIEN) Q
..I $P(AMHR0,U,8),'$$ALLOWP^AMHUTIL(DUZ,$P(AMHR0,U,8)) Q ;can user see this patient?
..S AMHRCNT=AMHRCNT+1,AMHRRECS(AMHRCNT)=AMHRIEN
..Q
.Q
Q
DISPRECS ;display visits for selection by user
S (AMHPG,AMHRCTR,AMHRIEN)=0
D HEAD
F S AMHRCTR=$O(AMHRRECS(AMHRCTR)) Q:AMHRCTR'=+AMHRCTR S AMHRIEN=AMHRRECS(AMHRCTR),AMHR0=^AMHREC(AMHRIEN,0) D
.I $Y>(IOSL-1) D HEAD Q:$D(AMHQUIT)
.W !,AMHRCTR,?5,$E($$PPNAME^AMHUTIL(AMHRIEN),1,12)
.W:$P(AMHR0,U,4) ?18,$S($P(^AUTTLOC($P(AMHR0,U,4),0),U,7)]"":$P(^(0),U,7),1:$E($P(^AUTTLOC($P(AMHR0,U,4),0),U),1,4))
.W:$P(AMHR0,U,5) ?23,$E($P(^AUTTCOM($P(AMHR0,U,5),0),U),1,10)
.W ?34,$S($P(AMHR0,U,6)]"":$P(^AMHTACT($P(AMHR0,U,6),0),U),1:""),?37,$S($P(AMHR0,U,7)]"":$E($P(^AMHTSET($P(AMHR0,U,7),0),U),1,4),1:"")
.I $P(AMHR0,U,8)]"" D
..I $P(AMHR0,U,4),$D(^AUPNPAT($P(AMHR0,U,8),41,$P(AMHR0,U,4))) W ?42,$P(^AUTTLOC($P(AMHR0,U,4),0),U,7)," ",$P(^AUPNPAT($P(AMHR0,U,8),41,$P(AMHR0,U,4),0),U,2) Q
..I $D(^AUPNPAT($P(AMHR0,U,8),41,DUZ(2))) W ?42,$P(^AUTTLOC(DUZ(2),0),U,7)," ",$P(^AUPNPAT($P(AMHR0,U,8),41,DUZ(2),0),U,2)
.E W ?42,"-----"
.S AMHP=$O(^AMHRPRO("AD",AMHRIEN,0)) I AMHP="" W ?55,"No Problems recorded." Q
.W ?55,$P(^AMHPROB($P(^AMHRPRO(AMHP,0),U),0),U) W ?64,$E($$GET1^DIQ(9002011.01,AMHP,.04),1,15)
.Q
Q
AMHRLKUP ; IHS/CMI/LAB - lookup up record ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**4,5**;JUN 02, 2010;Build 18
+2 ;
EN ;EP
+1 DO EOJ
+2 KILL AMHR
+3 IF AMHPAT
IF '$$ALLOWP^AMHUTIL(DUZ,AMHPAT)
DO NALLOWP^AMHUTIL
QUIT
+4 IF AMHPAT]""
IF '$DATA(^AMHREC("C",AMHPAT))
WRITE !!,"No visits currently on file for ",$PIECE(^DPT(AMHPAT,0),U),".",!
QUIT
+5 IF AMHLOC]""
IF '$DATA(^AMHREC("AA",AMHDATE,AMHLOC))
WRITE !!,"No visits currently on file for ",$PIECE(^DIC(4,AMHLOC,0),U),".",!
QUIT
+6 SET AMHDASH="--------------------------------------------------------------------------------"
+7 DO COLLECT
+8 IF AMHRCNT=1
SET AMHR=AMHRRECS(1)
DO EOJ
QUIT
+9 IF AMHRCNT=0
KILL AMHR
DO EOJ
QUIT
+10 DO DISPRECS
+11 DO SELECT
EOJ ;
+1 KILL AMHQUIT,AMHPG,AMHODAT,AMHRRECS,AMHP,AMHR0,AMHRCNT,AMHRCTR
+2 QUIT
HEAD ;
+1 IF 'AMHPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET AMHQUIT=""
QUIT
HEAD1 ;
+1 SET AMHPG=AMHPG+1
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !,AMHDASH
+4 WRITE !?13,"Behavioral Health visits for "
SET Y=AMHDATE
DO DD^%DT
WRITE Y
IF AMHLOC]""
WRITE !,"Location: ",$PIECE(^DIC(4,AMHLOC,0),U)
+5 WRITE !,AMHDASH
+6 WRITE !," #",?7,"PROVIDER",?18,"LOC",?23,"COMMUNITY",?33,"ACT",?37,"CONT",?42,"PATIENT",?55,"PROB",?64,"NARRATIVE",!,AMHDASH
+7 QUIT
SELECT ;
+1 WRITE !
SET DIR(0)="NO^1:"_AMHRCNT_":0"
SET DIR("A")="Which record do you want to display"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
WRITE !,"No Records selected to display."
DO PAUSE^AMHLEIN
QUIT
+3 IF '$DATA(AMHRRECS(+Y))
WRITE !,"Invalid selection!!"
GOTO SELECT
+4 SET AMHR=AMHRRECS(+Y)
+5 QUIT
COLLECT ;
+1 SET AMHODAT=(AMHDATE-1)_".9999"
SET (AMHRCNT,AMHRIEN)=0
FOR
SET AMHODAT=$ORDER(^AMHREC("B",AMHODAT))
IF AMHODAT=""!(AMHODAT>(AMHDATE_".9999"))!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+2 SET AMHRIEN=0
FOR
SET AMHRIEN=$ORDER(^AMHREC("B",AMHODAT,AMHRIEN))
IF AMHRIEN'=+AMHRIEN!($DATA(AMHQUIT))
QUIT
SET AMHR0=^AMHREC(AMHRIEN,0)
Begin DoDot:2
+3 IF AMHLOC]""
IF AMHLOC'=$PIECE(AMHR0,U,4)
QUIT
+4 IF AMHPAT]""
IF AMHPAT'=$PIECE(AMHR0,U,8)
QUIT
+5 IF $GET(AMHEHR)
IF '$PIECE($GET(^AMHREC(AMHRIEN,11)),U,10)
QUIT
+6 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHRIEN)
QUIT
+7 ;can user see this patient?
IF $PIECE(AMHR0,U,8)
IF '$$ALLOWP^AMHUTIL(DUZ,$PIECE(AMHR0,U,8))
QUIT
+8 SET AMHRCNT=AMHRCNT+1
SET AMHRRECS(AMHRCNT)=AMHRIEN
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
DISPRECS ;display visits for selection by user
+1 SET (AMHPG,AMHRCTR,AMHRIEN)=0
+2 DO HEAD
+3 FOR
SET AMHRCTR=$ORDER(AMHRRECS(AMHRCTR))
IF AMHRCTR'=+AMHRCTR
QUIT
SET AMHRIEN=AMHRRECS(AMHRCTR)
SET AMHR0=^AMHREC(AMHRIEN,0)
Begin DoDot:1
+4 IF $Y>(IOSL-1)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+5 WRITE !,AMHRCTR,?5,$EXTRACT($$PPNAME^AMHUTIL(AMHRIEN),1,12)
+6 IF $PIECE(AMHR0,U,4)
WRITE ?18,$SELECT($PIECE(^AUTTLOC($PIECE(AMHR0,U,4),0),U,7)]"":$PIECE(^(0),U,7),1:$EXTRACT($PIECE(^AUTTLOC($PIECE(AMHR0,U,4),0),U),1,4))
+7 IF $PIECE(AMHR0,U,5)
WRITE ?23,$EXTRACT($PIECE(^AUTTCOM($PIECE(AMHR0,U,5),0),U),1,10)
+8 WRITE ?34,$SELECT">SELECT($PIECE(AMHR0,U,6)]"":$PIECE(^AMHTACT($PIECE(AMHR0,U,6),0),U),1:""),?37,$SELECT">SELECT($PIECE(AMHR0,U,7)]"":$EXTRACT($PIECE(^AMHTSET($PIECE(AMHR0,U,7),0),U),1,4),1:"")
+9 IF $PIECE(AMHR0,U,8)]""
Begin DoDot:2
+10 IF $PIECE(AMHR0,U,4)
IF $DATA(^AUPNPAT($PIECE(AMHR0,U,8),41,$PIECE(AMHR0,U,4)))
WRITE ?42,$PIECE(^AUTTLOC($PIECE(AMHR0,U,4),0),U,7)," ",$PIECE(^AUPNPAT($PIECE(AMHR0,U,8),41,$PIECE(AMHR0,U,4),0),U,2)
QUIT
+11 IF $DATA(^AUPNPAT($PIECE(AMHR0,U,8),41,DUZ(2)))
WRITE ?42,$PIECE(^AUTTLOC(DUZ(2),0),U,7)," ",$PIECE(^AUPNPAT($PIECE(AMHR0,U,8),41,DUZ(2),0),U,2)
End DoDot:2
+12 IF '$TEST
WRITE ?42,"-----"
+13 SET AMHP=$ORDER(^AMHRPRO("AD",AMHRIEN,0))
IF AMHP=""
WRITE ?55,"No Problems recorded."
QUIT
+14 WRITE ?55,$PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHP,0),U),0),U)
WRITE ?64,$EXTRACT($$GET1^DIQ(9002011.01,AMHP,.04),1,15)
+15 QUIT
End DoDot:1
+16 QUIT
