- 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
