- 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
