AMHPVDSG ; IHS/CMI/LAB -VISIT DISPLAY ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
EP(AMHVIEN,AMHARRY) ;EP
I $G(AMHARRY)="" S AMHARRY="^TMP(""AMHPVDSG"",$J)"
Q:'$D(AMHVIEN)
Q:'AMHVIEN
Q:'$D(^AUPNVSIT(AMHVIEN,0))
D BUILD
D XIT
Q
;
SET ;set array
S AMHCTR=AMHCTR+1
S @AMHARRY@(AMHCTR,0)=AMHSTR
S AMHSTR=""
Q
BUILD ; build array
K AMHAR
D TERM^VALM0
S AMHVREC=^AUPNVSIT(AMHVIEN,0)
S Y=$P(AMHVREC,U,5) D ^AUPNPAT
S AMHSTR="",AMHCTR=0
S AMHH="Patient Name",AMHV=IOINHI_$E($P(^DPT($P(AMHVREC,U,5),0),U),1,20)_IOINORM D BUILD1
S AMHH="Chart #",AMHV=IOINHI_$S($D(^AUPNPAT($P(AMHVREC,U,5),41,DUZ(2),0)):$P(^(0),U,2),1:"None")_IOINORM D BUILD1
S AMHH="Date of Birth" S Y=AUPNDOB D DD^%DT S AMHV=Y D BUILD1
S AMHH="Sex",AMHV=AUPNSEX D BUILD1
S AMHSTR="" D SET
VISIT ;
S AMHSTR="=============== "_IOINHI_"VISIT FILE"_IOINORM_" ===============",X=(80-$L(AMHSTR)\2) D SET ;$J("",X)_AMHSTR D SET
D ENP^XBDIQ1(9000010,AMHVIEN,".01:999999","AMHAR(","E")
S F=0 F S F=$O(AMHAR(F)) Q:F'=+F I AMHAR(F)]"" D
.S AMHH=$P(^DD(9000010,F,0),U)
.S AMHV=AMHAR(F)
.D BUILD1
S AMHSTR="" D SET
Q:'$P(AMHVREC,U,9)
VFILES ;set up array of all v file entries
NEW DA,D0,DIC,DIQ,DR,DI
S AMHVFLE=9000010 F S AMHVFLE=$O(^DIC(AMHVFLE)) Q:AMHVFLE>9000010.99!(AMHVFLE'=+AMHVFLE) D VF2
D XIT
Q
;
VF2 ;
S AMHVNM=$P(^DIC(AMHVFLE,0),U),AMHVDG=^DIC(AMHVFLE,0,"GL"),AMHVIGR=AMHVDG_"""AD"",AMHVIEN,AMHVDFN)",AMHVDFN=""
F AMHVI=1:1 S AMHVDFN=$O(@AMHVIGR) Q:AMHVDFN="" D VF3
Q
;
VF3 ;
I AMHVI<2 S AMHSTR="" D SET S AMHSTR="=============== "_IOINHI_$P(AMHVNM,"V ",2)_"s"_IOINORM_" ===============",X=(80-$L(AMHSTR)\2) D SET ;$J("",X)_AMHSTR D SET
K AMHAR D ENP^XBDIQ1(AMHVFLE,AMHVDFN,".01:.019999;.04:999999","AMHAR(","E")
I AMHVI>1 S AMHSTR="" D SET
S F=0 F S F=$O(AMHAR(F)) Q:F'=+F I AMHAR(F)]"" D
.S AMHH=$P(^DD(AMHVFLE,F,0),U)
.S AMHV=AMHAR(F)
.D BUILD1
Q
BUILD1 ;
S AMHSTR=$E(AMHH,1,21)_":",AMHSTR=$$SETSTR^VALM1(AMHV,AMHSTR,24,$L(AMHV))
D SET
Q
I $L(AMHSTR)>39 D SET
S AMHV=" "_AMHV_" ",X=AMHH_": "_AMHV
I $L(AMHSTR),$L(X)>40 D SET
I $L(AMHSTR) S AMHSTR=$$SETSTR^VALM1(X,AMHSTR,40,$L(X))
I '$L(AMHSTR) S AMHSTR=X
K AMHV,AMHH,X
Q
XIT ;
K AMHAR,AMHARRY,AMHCTR,AMHH,AMHSTR,AMHV,AMHVDFN,AMHVDG,AMHVFLE,AMHVI,AMHVIEN,AMHVIGR,AMHFL,AMHVNM,AMHVREC,AMHH
K DO,D0,DA,DI,DIC,DIQ,DR,F,X,Y,Z
Q
AMHPVDSG ; IHS/CMI/LAB -VISIT DISPLAY ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
EP(AMHVIEN,AMHARRY) ;EP
+1 IF $GET(AMHARRY)=""
SET AMHARRY="^TMP(""AMHPVDSG"",$J)"
+2 IF '$DATA(AMHVIEN)
QUIT
+3 IF 'AMHVIEN
QUIT
+4 IF '$DATA(^AUPNVSIT(AMHVIEN,0))
QUIT
+5 DO BUILD
+6 DO XIT
+7 QUIT
+8 ;
SET ;set array
+1 SET AMHCTR=AMHCTR+1
+2 SET @AMHARRY@(AMHCTR,0)=AMHSTR
+3 SET AMHSTR=""
+4 QUIT
BUILD ; build array
+1 KILL AMHAR
+2 DO TERM^VALM0
+3 SET AMHVREC=^AUPNVSIT(AMHVIEN,0)
+4 SET Y=$PIECE(AMHVREC,U,5)
DO ^AUPNPAT
+5 SET AMHSTR=""
SET AMHCTR=0
+6 SET AMHH="Patient Name"
SET AMHV=IOINHI_$EXTRACT($PIECE(^DPT($PIECE(AMHVREC,U,5),0),U),1,20)_IOINORM
DO BUILD1
+7 SET AMHH="Chart #"
SET AMHV=IOINHI_$SELECT($DATA(^AUPNPAT($PIECE(AMHVREC,U,5),41,DUZ(2),0)):$PIECE(^(0),U,2),1:"None")_IOINORM
DO BUILD1
+8 SET AMHH="Date of Birth"
SET Y=AUPNDOB
DO DD^%DT
SET AMHV=Y
DO BUILD1
+9 SET AMHH="Sex"
SET AMHV=AUPNSEX
DO BUILD1
+10 SET AMHSTR=""
DO SET
VISIT ;
+1 ;$J("",X)_AMHSTR D SET
SET AMHSTR="=============== "_IOINHI_"VISIT FILE"_IOINORM_" ==============="
SET X=(80-$LENGTH(AMHSTR)\2)
DO SET
+2 DO ENP^XBDIQ1(9000010,AMHVIEN,".01:999999","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(9000010,F,0),U)
+5 SET AMHV=AMHAR(F)
+6 DO BUILD1
End DoDot:1
+7 SET AMHSTR=""
DO SET
+8 IF '$PIECE(AMHVREC,U,9)
QUIT
VFILES ;set up array of all v file entries
+1 NEW DA,D0,DIC,DIQ,DR,DI
+2 SET AMHVFLE=9000010
FOR
SET AMHVFLE=$ORDER(^DIC(AMHVFLE))
IF AMHVFLE>9000010.99!(AMHVFLE'=+AMHVFLE)
QUIT
DO VF2
+3 DO XIT
+4 QUIT
+5 ;
VF2 ;
+1 SET AMHVNM=$PIECE(^DIC(AMHVFLE,0),U)
SET AMHVDG=^DIC(AMHVFLE,0,"GL")
SET AMHVIGR=AMHVDG_"""AD"",AMHVIEN,AMHVDFN)"
SET AMHVDFN=""
+2 FOR AMHVI=1:1
SET AMHVDFN=$ORDER(@AMHVIGR)
IF AMHVDFN=""
QUIT
DO VF3
+3 QUIT
+4 ;
VF3 ;
+1 ;$J("",X)_AMHSTR D SET
IF AMHVI<2
SET AMHSTR=""
DO SET
SET AMHSTR="=============== "_IOINHI_$PIECE(AMHVNM,"V ",2)_"s"_IOINORM_" ==============="
SET X=(80-$LENGTH(AMHSTR)\2)
DO SET
+2 KILL AMHAR
DO ENP^XBDIQ1(AMHVFLE,AMHVDFN,".01:.019999;.04:999999","AMHAR(","E")
+3 IF AMHVI>1
SET AMHSTR=""
DO SET
+4 SET F=0
FOR
SET F=$ORDER(AMHAR(F))
IF F'=+F
QUIT
IF AMHAR(F)]""
Begin DoDot:1
+5 SET AMHH=$PIECE(^DD(AMHVFLE,F,0),U)
+6 SET AMHV=AMHAR(F)
+7 DO BUILD1
End DoDot:1
+8 QUIT
BUILD1 ;
+1 SET AMHSTR=$EXTRACT(AMHH,1,21)_":"
SET AMHSTR=$$SETSTR^VALM1(AMHV,AMHSTR,24,$LENGTH(AMHV))
+2 DO SET
+3 QUIT
+4 IF $LENGTH(AMHSTR)>39
DO SET
+5 SET AMHV=" "_AMHV_" "
SET X=AMHH_": "_AMHV
+6 IF $LENGTH(AMHSTR)
IF $LENGTH(X)>40
DO SET
+7 IF $LENGTH(AMHSTR)
SET AMHSTR=$$SETSTR^VALM1(X,AMHSTR,40,$LENGTH(X))
+8 IF '$LENGTH(AMHSTR)
SET AMHSTR=X
+9 KILL AMHV,AMHH,X
+10 QUIT
XIT ;
+1 KILL AMHAR,AMHARRY,AMHCTR,AMHH,AMHSTR,AMHV,AMHVDFN,AMHVDG,AMHVFLE,AMHVI,AMHVIEN,AMHVIGR,AMHFL,AMHVNM,AMHVREC,AMHH
+2 KILL DO,D0,DA,DI,DIC,DIQ,DR,F,X,Y,Z
+3 QUIT
