- 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
