AMHVD1 ; IHS/TUCSON/LAB -VISIT DISPLAY ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
INTAKE ;EP
Q
BUILD1 ;
S AMHSTR=$E(AMHH,1,21)_":",AMHSTR=$$SETSTR^VALM1(AMHVAL,AMHSTR,24,$L(AMHVAL))
D S^AMHVD(AMHSTR)
Q
SAN ;EP
Q
Q:$P(^AMHREC(AMHV,0),U,33)=""
I "SU"'[$P(^AMHREC(AMHV,0),U,33) Q
S AMHSTR="=============== "_"BH SAN DATA ITEMS"_" ===============",X=(80-$L(AMHSTR)\2) D S^AMHVD(AMHSTR,1) ;$J("",X)_AMHSTR D S^AMHVD(AMHSTR)
I $P(^AMHREC(AMHV,0),U,33)="U" D SANU Q
1 ;
K AMHAR
D ENP^XBDIQ1(9002011,AMHV,"7701;7702;7703;7704;7706;7707;7901","AMHAR(","E")
S F=0 F S F=$O(AMHAR(F)) Q:F'=+F I AMHAR(F)]"" D
.S AMHH=$P(^DD(9002011,F,0),U)
.S AMHVAL=AMHAR(F)
.D BUILD1
2 ;
K AMHAR
F AMHX=7709,7717,7711,7712 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHV,AMHX,0)) D
.S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S^AMHVD(AMHSTR)
.K AMHAR D ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
.S F=0 F S F=$O(AMHAR(AMHX,F)) Q:F'=+F S AMHSTR=AMHAR(AMHX,F) D S^AMHVD(AMHSTR)
.S AMHSTR="" D S^AMHVD(AMHSTR)
.Q
3 ;
K AMHAR
D ENP^XBDIQ1(9002011,AMHV,7713,"AMHAR(","E")
S F=0 F S F=$O(AMHAR(F)) Q:F'=+F I AMHAR(F)]"" D
.S AMHH=$P(^DD(9002011,F,0),U)
.S AMHVAL=AMHAR(F)
.D BUILD1
4 ;
K AMHAR
F AMHX=7715 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHV,AMHX,0)) D
.S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S^AMHVD(AMHSTR)
.K AMHAR D ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
.S F=0 F S F=$O(AMHAR(AMHX,F)) Q:F'=+F S AMHSTR=AMHAR(AMHX,F) D S^AMHVD(AMHSTR)
.S AMHSTR="" D S^AMHVD(AMHSTR)
5 ;
K AMHAR
D ENP^XBDIQ1(9002011,AMHV,"7902;7719;7721;7722;7903;7904;7905","AMHAR(","E")
S F=0 F S F=$O(AMHAR(F)) Q:F'=+F I AMHAR(F)]"" D
.S AMHH=$P(^DD(9002011,F,0),U)
.S AMHVAL=AMHAR(F)
.D BUILD1
6 ;
K AMHAR
F AMHX=7724 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHV,AMHX,0)) D
.S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S^AMHVD(AMHSTR)
.K AMHAR D ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
.S F=0 F S F=$O(AMHAR(AMHX,F)) Q:F'=+F S AMHSTR=AMHAR(AMHX,F) D S^AMHVD(AMHSTR)
.S AMHSTR="" D S^AMHVD(AMHSTR)
.Q
S AMHSTR="" D S^AMHVD(AMHSTR)
K AMHAR
Q
SANU ;
K AMHAR
F AMHX=7801 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHV,AMHX,0)) D
.S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S^AMHVD(AMHSTR)
.K AMHAR D ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
.S F=0 F S F=$O(AMHAR(AMHX,F)) Q:F'=+F S AMHSTR=AMHAR(AMHX,F) D S^AMHVD(AMHSTR)
.S AMHSTR="" D S^AMHVD(AMHSTR)
.Q
78 ;
K AMHAR
D ENP^XBDIQ1(9002011,AMHV,7802,"AMHAR(","E")
S F=0 F S F=$O(AMHAR(F)) Q:F'=+F I AMHAR(F)]"" D
.S AMHH=$P(^DD(9002011,F,0),U)
.S AMHVAL=AMHAR(F)
.D BUILD1
783 ;
K AMHAR
F AMHX=7803:1:7805 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHV,AMHX,0)) D
.S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S^AMHVD(AMHSTR)
.K AMHAR D ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
.S F=0 F S F=$O(AMHAR(AMHX,F)) Q:F'=+F S AMHSTR=AMHAR(AMHX,F) D S^AMHVD(AMHSTR)
.S AMHSTR="" D S^AMHVD(AMHSTR)
.Q
786 ;
K AMHAR
D ENP^XBDIQ1(9002011,AMHV,7806,"AMHAR(","E")
S F=0 F S F=$O(AMHAR(F)) Q:F'=+F I AMHAR(F)]"" D
.S AMHH=$P(^DD(9002011,F,0),U)
.S AMHVAL=AMHAR(F)
.D BUILD1
787 ;
K AMHAR
F AMHX=7808:1:7809 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHV,AMHX,0)) D
.S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S^AMHVD(AMHSTR)
.K AMHAR D ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
.S F=0 F S F=$O(AMHAR(AMHX,F)) Q:F'=+F S AMHSTR=AMHAR(AMHX,F) D S^AMHVD(AMHSTR)
.S AMHSTR="" D S^AMHVD(AMHSTR)
.Q
7811 ;
K AMHAR
D ENP^XBDIQ1(9002011,AMHV,"7811;7812","AMHAR(","E")
S F=0 F S F=$O(AMHAR(F)) Q:F'=+F I AMHAR(F)]"" D
.S AMHH=$P(^DD(9002011,F,0),U)
.S AMHVAL=AMHAR(F)
.D BUILD1
7813 ;
K AMHAR
F AMHX=7813 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHV,AMHX,0)) D
.S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S^AMHVD(AMHSTR)
.K AMHAR D ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
.S F=0 F S F=$O(AMHAR(AMHX,F)) Q:F'=+F S AMHSTR=AMHAR(AMHX,F) D S^AMHVD(AMHSTR)
.S AMHSTR="" D S^AMHVD(AMHSTR)
.Q
XIT ;
K AMHAR
Q
AMHVD1 ; IHS/TUCSON/LAB -VISIT DISPLAY ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
INTAKE ;EP
+1 QUIT
BUILD1 ;
+1 SET AMHSTR=$EXTRACT(AMHH,1,21)_":"
SET AMHSTR=$$SETSTR^VALM1(AMHVAL,AMHSTR,24,$LENGTH(AMHVAL))
+2 DO S^AMHVD(AMHSTR)
+3 QUIT
SAN ;EP
+1 QUIT
+2 IF $PIECE(^AMHREC(AMHV,0),U,33)=""
QUIT
+3 IF "SU"'[$PIECE(^AMHREC(AMHV,0),U,33)
QUIT
+4 ;$J("",X)_AMHSTR D S^AMHVD(AMHSTR)
SET AMHSTR="=============== "_"BH SAN DATA ITEMS"_" ==============="
SET X=(80-$LENGTH(AMHSTR)\2)
DO S^AMHVD(AMHSTR,1)
+5 IF $PIECE(^AMHREC(AMHV,0),U,33)="U"
DO SANU
QUIT
1 ;
+1 KILL AMHAR
+2 DO ENP^XBDIQ1(9002011,AMHV,"7701;7702;7703;7704;7706;7707;7901","AMHAR(","E")
+3 SET F=0
FOR
SET F=$ORDER(AMHAR(F))
IF F'=+F
QUIT
IF AMHAR(F)]""
Begin DoDot:1
+4 SET AMHH=$PIECE(^DD(9002011,F,0),U)
+5 SET AMHVAL=AMHAR(F)
+6 DO BUILD1
End DoDot:1
2 ;
+1 KILL AMHAR
+2 FOR AMHX=7709,7717,7711,7712
IF $DATA(^DD(9002011,AMHX,0))
IF $ORDER(^AMHREC(AMHV,AMHX,0))
Begin DoDot:1
+3 SET AMHSTR=$PIECE(^DD(9002011,AMHX,0),U)
DO S^AMHVD(AMHSTR)
+4 KILL AMHAR
DO ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(AMHAR(AMHX,F))
IF F'=+F
QUIT
SET AMHSTR=AMHAR(AMHX,F)
DO S^AMHVD(AMHSTR)
+6 SET AMHSTR=""
DO S^AMHVD(AMHSTR)
+7 QUIT
End DoDot:1
3 ;
+1 KILL AMHAR
+2 DO ENP^XBDIQ1(9002011,AMHV,7713,"AMHAR(","E")
+3 SET F=0
FOR
SET F=$ORDER(AMHAR(F))
IF F'=+F
QUIT
IF AMHAR(F)]""
Begin DoDot:1
+4 SET AMHH=$PIECE(^DD(9002011,F,0),U)
+5 SET AMHVAL=AMHAR(F)
+6 DO BUILD1
End DoDot:1
4 ;
+1 KILL AMHAR
+2 FOR AMHX=7715
IF $DATA(^DD(9002011,AMHX,0))
IF $ORDER(^AMHREC(AMHV,AMHX,0))
Begin DoDot:1
+3 SET AMHSTR=$PIECE(^DD(9002011,AMHX,0),U)
DO S^AMHVD(AMHSTR)
+4 KILL AMHAR
DO ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(AMHAR(AMHX,F))
IF F'=+F
QUIT
SET AMHSTR=AMHAR(AMHX,F)
DO S^AMHVD(AMHSTR)
+6 SET AMHSTR=""
DO S^AMHVD(AMHSTR)
End DoDot:1
5 ;
+1 KILL AMHAR
+2 DO ENP^XBDIQ1(9002011,AMHV,"7902;7719;7721;7722;7903;7904;7905","AMHAR(","E")
+3 SET F=0
FOR
SET F=$ORDER(AMHAR(F))
IF F'=+F
QUIT
IF AMHAR(F)]""
Begin DoDot:1
+4 SET AMHH=$PIECE(^DD(9002011,F,0),U)
+5 SET AMHVAL=AMHAR(F)
+6 DO BUILD1
End DoDot:1
6 ;
+1 KILL AMHAR
+2 FOR AMHX=7724
IF $DATA(^DD(9002011,AMHX,0))
IF $ORDER(^AMHREC(AMHV,AMHX,0))
Begin DoDot:1
+3 SET AMHSTR=$PIECE(^DD(9002011,AMHX,0),U)
DO S^AMHVD(AMHSTR)
+4 KILL AMHAR
DO ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(AMHAR(AMHX,F))
IF F'=+F
QUIT
SET AMHSTR=AMHAR(AMHX,F)
DO S^AMHVD(AMHSTR)
+6 SET AMHSTR=""
DO S^AMHVD(AMHSTR)
+7 QUIT
End DoDot:1
+8 SET AMHSTR=""
DO S^AMHVD(AMHSTR)
+9 KILL AMHAR
+10 QUIT
SANU ;
+1 KILL AMHAR
+2 FOR AMHX=7801
IF $DATA(^DD(9002011,AMHX,0))
IF $ORDER(^AMHREC(AMHV,AMHX,0))
Begin DoDot:1
+3 SET AMHSTR=$PIECE(^DD(9002011,AMHX,0),U)
DO S^AMHVD(AMHSTR)
+4 KILL AMHAR
DO ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(AMHAR(AMHX,F))
IF F'=+F
QUIT
SET AMHSTR=AMHAR(AMHX,F)
DO S^AMHVD(AMHSTR)
+6 SET AMHSTR=""
DO S^AMHVD(AMHSTR)
+7 QUIT
End DoDot:1
78 ;
+1 KILL AMHAR
+2 DO ENP^XBDIQ1(9002011,AMHV,7802,"AMHAR(","E")
+3 SET F=0
FOR
SET F=$ORDER(AMHAR(F))
IF F'=+F
QUIT
IF AMHAR(F)]""
Begin DoDot:1
+4 SET AMHH=$PIECE(^DD(9002011,F,0),U)
+5 SET AMHVAL=AMHAR(F)
+6 DO BUILD1
End DoDot:1
783 ;
+1 KILL AMHAR
+2 FOR AMHX=7803:1:7805
IF $DATA(^DD(9002011,AMHX,0))
IF $ORDER(^AMHREC(AMHV,AMHX,0))
Begin DoDot:1
+3 SET AMHSTR=$PIECE(^DD(9002011,AMHX,0),U)
DO S^AMHVD(AMHSTR)
+4 KILL AMHAR
DO ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(AMHAR(AMHX,F))
IF F'=+F
QUIT
SET AMHSTR=AMHAR(AMHX,F)
DO S^AMHVD(AMHSTR)
+6 SET AMHSTR=""
DO S^AMHVD(AMHSTR)
+7 QUIT
End DoDot:1
786 ;
+1 KILL AMHAR
+2 DO ENP^XBDIQ1(9002011,AMHV,7806,"AMHAR(","E")
+3 SET F=0
FOR
SET F=$ORDER(AMHAR(F))
IF F'=+F
QUIT
IF AMHAR(F)]""
Begin DoDot:1
+4 SET AMHH=$PIECE(^DD(9002011,F,0),U)
+5 SET AMHVAL=AMHAR(F)
+6 DO BUILD1
End DoDot:1
787 ;
+1 KILL AMHAR
+2 FOR AMHX=7808:1:7809
IF $DATA(^DD(9002011,AMHX,0))
IF $ORDER(^AMHREC(AMHV,AMHX,0))
Begin DoDot:1
+3 SET AMHSTR=$PIECE(^DD(9002011,AMHX,0),U)
DO S^AMHVD(AMHSTR)
+4 KILL AMHAR
DO ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(AMHAR(AMHX,F))
IF F'=+F
QUIT
SET AMHSTR=AMHAR(AMHX,F)
DO S^AMHVD(AMHSTR)
+6 SET AMHSTR=""
DO S^AMHVD(AMHSTR)
+7 QUIT
End DoDot:1
7811 ;
+1 KILL AMHAR
+2 DO ENP^XBDIQ1(9002011,AMHV,"7811;7812","AMHAR(","E")
+3 SET F=0
FOR
SET F=$ORDER(AMHAR(F))
IF F'=+F
QUIT
IF AMHAR(F)]""
Begin DoDot:1
+4 SET AMHH=$PIECE(^DD(9002011,F,0),U)
+5 SET AMHVAL=AMHAR(F)
+6 DO BUILD1
End DoDot:1
7813 ;
+1 KILL AMHAR
+2 FOR AMHX=7813
IF $DATA(^DD(9002011,AMHX,0))
IF $ORDER(^AMHREC(AMHV,AMHX,0))
Begin DoDot:1
+3 SET AMHSTR=$PIECE(^DD(9002011,AMHX,0),U)
DO S^AMHVD(AMHSTR)
+4 KILL AMHAR
DO ENP^XBDIQ1(9002011,AMHV,AMHX,"AMHAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(AMHAR(AMHX,F))
IF F'=+F
QUIT
SET AMHSTR=AMHAR(AMHX,F)
DO S^AMHVD(AMHSTR)
+6 SET AMHSTR=""
DO S^AMHVD(AMHSTR)
+7 QUIT
End DoDot:1
XIT ;
+1 KILL AMHAR
+2 QUIT
