AMHLRDSP ; IHS/CMI/LAB - DISPLAYS DAILY ACT RECORDS ;
;;4.0;IHS BEHAVIORAL HEALTH;;JUN 02, 2010;Build 18
;
;Display all records for the provider, on this date.
;
;caller must pass AMHLOC - provider IEN
; AMHDATE - date in fileman format, no time or sec
;passed back to caller: AMHRCNT - number of records found
; AMHVRECS(n)=record ien n is consecutive
; number
;
I '$D(IOF) D HOME^%ZIS
K AMHQUIT,AMHVRECS,AMHRCNT S AMHPG=0
I '$D(^AMHREC("AA",$P(AMHDATE,"."),AMHLOC)) W !!,"No records currently on file for ",$P(^DIC(4,AMHLOC,0),U)," on " S Y=AMHDATE D DD^%DT W Y,".",! Q
W:$D(IOF) @IOF
D HEAD
D DISPRECS
K AMHQUIT,AMHPG,AMHREC,AMHV,AMHP
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 !,"Program: ",AMHPROGN,?35,"Date of Encounter: " S Y=AMHDATE D DD^%DT W Y,!,"Location of Encounter: ",$P(^DIC(4,AMHLOC,0),U),!,AMHDASH
W !," #",?6,"PROV",?12,"COMMUNITY",?24,"ACT",?29,"VISIT",?37,"AT",?41,"PATIENT",?51,"PROB",?58,"NARRATIVE",!,AMHDASH
Q
DISPRECS ;
S (AMHRCNT,AMHV)=0 F S AMHV=$O(^AMHREC("AA",$P(AMHDATE,"."),AMHLOC,AMHV)) Q:AMHV'=+AMHV!($D(AMHQUIT)) S AMHRCNT=AMHRCNT+1,AMHVRECS(AMHRCNT)=AMHV,AMHREC=^AMHREC(AMHV,0) D
.I $Y>(IOSL-2) D HEAD Q:$D(AMHQUIT)
.W !,AMHRCNT,?6,$$PPINI^AMHUTIL(AMHV) W:$P(AMHREC,U,5) ?12,$E($P(^AUTTCOM($P(AMHREC,U,5),0),U),1,10)
.W ?25,$S($P(AMHREC,U,6)]"":$P(^AMHTACT($P(AMHREC,U,6),0),U),1:""),?29,$S($P(AMHREC,U,7)]"":$E($P(^AMHTSET($P(AMHREC,U,7),0),U,2),1,7),1:""),?37,$P(AMHREC,U,12)
.I $P(AMHREC,U,8)]"" D
..I $D(^AUPNPAT($P(AMHREC,U,8),41,$P(AMHREC,U,4))) W ?41,$P(^AUTTLOC($P(AMHREC,U,4),0),U,7)," ",$P(^AUPNPAT($P(AMHREC,U,8),41,$P(AMHREC,U,4),0),U,2) Q
..I $D(^AUPNPAT(DUZ(2),41,$P(AMHREC,U,4))) W ?41,$P(^AUTTLOC($P(AMHREC,U,4),0),U,7)," ",$P(^AUPNPAT($P(AMHREC,U,8),41,$P(AMHREC,U,4),0),U,2) Q
..W ?41,"<*****>"
.E W ?42,"-----"
.S AMHP=$O(^AMHRPRO("AD",AMHV,0)) I AMHP="" W ?56,"No Problems recorded." Q
.W ?51,$P(^AMHPROB($P(^AMHRPRO(AMHP,0),U),0),U) W ?58,$E($$GET1^DIQ(9002011.01,AMHP,.04),1,21)
.Q
Q
AMHLRDSP ; IHS/CMI/LAB - DISPLAYS DAILY ACT RECORDS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;JUN 02, 2010;Build 18
+2 ;
+3 ;Display all records for the provider, on this date.
+4 ;
+5 ;caller must pass AMHLOC - provider IEN
+6 ; AMHDATE - date in fileman format, no time or sec
+7 ;passed back to caller: AMHRCNT - number of records found
+8 ; AMHVRECS(n)=record ien n is consecutive
+9 ; number
+10 ;
+11 IF '$DATA(IOF)
DO HOME^%ZIS
+12 KILL AMHQUIT,AMHVRECS,AMHRCNT
SET AMHPG=0
+13 IF '$DATA(^AMHREC("AA",$PIECE(AMHDATE,"."),AMHLOC))
WRITE !!,"No records currently on file for ",$PIECE(^DIC(4,AMHLOC,0),U)," on "
SET Y=AMHDATE
DO DD^%DT
WRITE Y,".",!
QUIT
+14 IF $DATA(IOF)
WRITE @IOF
+15 DO HEAD
+16 DO DISPRECS
+17 KILL AMHQUIT,AMHPG,AMHREC,AMHV,AMHP
+18 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 !,"Program: ",AMHPROGN,?35,"Date of Encounter: "
SET Y=AMHDATE
DO DD^%DT
WRITE Y,!,"Location of Encounter: ",$PIECE(^DIC(4,AMHLOC,0),U),!,AMHDASH
+5 WRITE !," #",?6,"PROV",?12,"COMMUNITY",?24,"ACT",?29,"VISIT",?37,"AT",?41,"PATIENT",?51,"PROB",?58,"NARRATIVE",!,AMHDASH
+6 QUIT
DISPRECS ;
+1 SET (AMHRCNT,AMHV)=0
FOR
SET AMHV=$ORDER(^AMHREC("AA",$PIECE(AMHDATE,"."),AMHLOC,AMHV))
IF AMHV'=+AMHV!($DATA(AMHQUIT))
QUIT
SET AMHRCNT=AMHRCNT+1
SET AMHVRECS(AMHRCNT)=AMHV
SET AMHREC=^AMHREC(AMHV,0)
Begin DoDot:1
+2 IF $Y>(IOSL-2)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+3 WRITE !,AMHRCNT,?6,$$PPINI^AMHUTIL(AMHV)
IF $PIECE(AMHREC,U,5)
WRITE ?12,$EXTRACT($PIECE(^AUTTCOM($PIECE(AMHREC,U,5),0),U),1,10)
+4 WRITE ?25,$SELECT($PIECE(AMHREC,U,6)]"":$PIECE(^AMHTACT($PIECE(AMHREC,U,6),0),U),1:""),?29,$SELECT($PIECE(AMHREC,U,7)]"":$EXTRACT($PIECE(^AMHTSET($PIECE(AMHREC,U,7),0),U,2),1,7),1:""),?37,$PIECE(AMHREC,U,12)
+5 IF $PIECE(AMHREC,U,8)]""
Begin DoDot:2
+6 IF $DATA(^AUPNPAT($PIECE(AMHREC,U,8),41,$PIECE(AMHREC,U,4)))
WRITE ?41,$PIECE(^AUTTLOC($PIECE(AMHREC,U,4),0),U,7)," ",$PIECE(^AUPNPAT($PIECE(AMHREC,U,8),41,$PIECE(AMHREC,U,4),0),U,2)
QUIT
+7 IF $DATA(^AUPNPAT(DUZ(2),41,$PIECE(AMHREC,U,4)))
WRITE ?41,$PIECE(^AUTTLOC($PIECE(AMHREC,U,4),0),U,7)," ",$PIECE(^AUPNPAT($PIECE(AMHREC,U,8),41,$PIECE(AMHREC,U,4),0),U,2)
QUIT
+8 WRITE ?41,"<*****>"
End DoDot:2
+9 IF '$TEST
WRITE ?42,"-----"
+10 SET AMHP=$ORDER(^AMHRPRO("AD",AMHV,0))
IF AMHP=""
WRITE ?56,"No Problems recorded."
QUIT
+11 WRITE ?51,$PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHP,0),U),0),U)
WRITE ?58,$EXTRACT($$GET1^DIQ(9002011.01,AMHP,.04),1,21)
+12 QUIT
End DoDot:1
+13 QUIT
