APCDEFG ; IHS/CMI/LAB -VISIT EDIT DISPLAY ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;IHS/AMNC/LJF
; -- this is a modified copy of APCDVD
; -- modified to select item from display to edit
EP(APCDVIEN,APCDARRY) ;EP
;
I $G(APCDARRY)="" S APCDARRY="^TMP(""APCDEFG"",$J)"
Q:'$D(APCDVIEN)
Q:'APCDVIEN
Q:'$D(^AUPNVSIT(APCDVIEN,0))
D BUILD
D XIT
Q
;
SETF ;set file # in ^TMP
S @APCDARRY@("MNE",APCDNUM)=MN
Q
SET(X) ;set array
S APCDCTR=APCDCTR+1
S @APCDARRY@(APCDCTR,0)=APCDSTR
S @APCDARRY@("IDX",APCDCTR,$S(APCDNUM>0:APCDNUM,1:1))=$G(X)
S APCDSTR=""
Q
BUILD ; build array
K APCDAR
D TERM^VALM0
S APCDVREC=^AUPNVSIT(APCDVIEN,0)
S Y=$P(APCDVREC,U,5) D ^AUPNPAT
S APCDSTR="",APCDCTR=0,APCDNUM=0
S APCDH="Patient Name",APCDV=IOINHI_$E($P(^DPT($P(APCDVREC,U,5),0),U),1,20)_IOINORM D BUILD1
S APCDH="Chart #",APCDV=IOINHI_$S($D(^AUPNPAT($P(APCDVREC,U,5),41,DUZ(2),0)):$P(^(0),U,2),1:"None")_IOINORM D BUILD1
S APCDH="Date of Birth" S Y=AUPNDOB D DD^%DT S APCDV=Y D BUILD1
S APCDH="Sex",APCDV=AUPNSEX D BUILD1
S APCDSTR="" D SET("")
VISIT ;
;S APCDSTR="=============== "_IOINHI_"VISIT FILE"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET ;$J("",X)_APCDSTR D SET
NEW MN S MN=$O(^APCDTKW("F",9000010,0)),APCDNUM=APCDNUM+1
S APCDSTR=" <"_IOINHI_(APCDNUM)_IOINORM_"> ============= "_IOINHI_"VISIT FILE"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET(""),SETF ;$J("",X)_APCDSTR D SET("")
D ENP^XBDIQ1(9000010,APCDVIEN,".01:1500;1502:999999","APCDAR(","E")
S F=0 F S F=$O(APCDAR(F)) Q:F'=+F I APCDAR(F)]"" D
.S APCDH=$P(^DD(9000010,F,0),U)
.S APCDV=APCDAR(F)
.D BUILD1
S APCDSTR="" D SET("")
Q:'$P(APCDVREC,U,9)
VFILES ;set up array of all v file entries
NEW DA,D0,DIC,DIQ,DR,DI
S APCDVFLE=9000010 F S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE) D VF2
D XIT
Q
;
VF2 ;
S APCDVNM=$P(^DIC(APCDVFLE,0),U),APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVIEN,APCDVDFN)",APCDVDFN=""
I $O(@APCDVIGR) S APCDNUM=APCDNUM+1
F APCDVI=1:1 S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN="" D VF3
Q
;
VF3 ;
;I APCDVI<2 S APCDSTR="" D SET S APCDSTR="=============== "_IOINHI_$P(APCDVNM,"V ",2)_"s"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET ;$J("",X)_APCDSTR D SET
NEW MN S MN=$O(^APCDTKW("F",APCDVFLE,0))
I APCDVI<2 S APCDSTR="" D SET("") S APCDSTR=" <"_IOINHI_(APCDNUM)_IOINORM_"> =============== "_IOINHI_$P(APCDVNM,"V ",2)_"s"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET(""),SETF ;$J("",X)_APCDSTR D SET("")
K APCDAR D ENP^XBDIQ1(APCDVFLE,APCDVDFN,".01:.019999;.04:999999","APCDAR(","E")
I APCDVI>1 S APCDSTR="" D SET("")
S F=0 F S F=$O(APCDAR(F)) Q:F'=+F D
.I $G(APCDAR(F))]"" D Q
..S APCDH=$P(^DD(APCDVFLE,F,0),U)
..S APCDV=APCDAR(F)
..D BUILD1
.I $O(APCDAR(F,0)) D
..S APCDNARR=""
..S F1=0 F S F1=$O(APCDAR(F,F1)) Q:F1'=+F1 D
...S APCDV=APCDAR(F,F1)
...D BUILD1
..K APCDNARR
Q
Q
BUILD1 ;
I $D(APCDNARR) S APCDSTR="",APCDSTR=$$SETSTR^VALM1(APCDV,APCDSTR,1,$L(APCDV)) D SET("") Q
S APCDSTR=$E(APCDH,1,21)_":",APCDSTR=$$SETSTR^VALM1(APCDV,APCDSTR,24,$L(APCDV))
D SET("")
Q
XIT ;
K APCDAR,APCDARRY,APCDCTR,APCDH,APCDSTR,APCDV,APCDVDFN,APCDVDG,APCDVFLE,APCDVI,APCDVIEN,APCDVIGR,APCDFL,APCDVNM,APCDVREC,APCDH
K DO,D0,DA,DI,DIC,DIQ,DR,F,X,Y,Z
Q
;
;
APCDEFG ; IHS/CMI/LAB -VISIT EDIT DISPLAY ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;IHS/AMNC/LJF
+3 ; -- this is a modified copy of APCDVD
+4 ; -- modified to select item from display to edit
EP(APCDVIEN,APCDARRY) ;EP
+1 ;
+2 IF $GET(APCDARRY)=""
SET APCDARRY="^TMP(""APCDEFG"",$J)"
+3 IF '$DATA(APCDVIEN)
QUIT
+4 IF 'APCDVIEN
QUIT
+5 IF '$DATA(^AUPNVSIT(APCDVIEN,0))
QUIT
+6 DO BUILD
+7 DO XIT
+8 QUIT
+9 ;
SETF ;set file # in ^TMP
+1 SET @APCDARRY@("MNE",APCDNUM)=MN
+2 QUIT
SET(X) ;set array
+1 SET APCDCTR=APCDCTR+1
+2 SET @APCDARRY@(APCDCTR,0)=APCDSTR
+3 SET @APCDARRY@("IDX",APCDCTR,$SELECT(APCDNUM>0:APCDNUM,1:1))=$GET(X)
+4 SET APCDSTR=""
+5 QUIT
BUILD ; build array
+1 KILL APCDAR
+2 DO TERM^VALM0
+3 SET APCDVREC=^AUPNVSIT(APCDVIEN,0)
+4 SET Y=$PIECE(APCDVREC,U,5)
DO ^AUPNPAT
+5 SET APCDSTR=""
SET APCDCTR=0
SET APCDNUM=0
+6 SET APCDH="Patient Name"
SET APCDV=IOINHI_$EXTRACT($PIECE(^DPT($PIECE(APCDVREC,U,5),0),U),1,20)_IOINORM
DO BUILD1
+7 SET APCDH="Chart #"
SET APCDV=IOINHI_$SELECT($DATA(^AUPNPAT($PIECE(APCDVREC,U,5),41,DUZ(2),0)):$PIECE(^(0),U,2),1:"None")_IOINORM
DO BUILD1
+8 SET APCDH="Date of Birth"
SET Y=AUPNDOB
DO DD^%DT
SET APCDV=Y
DO BUILD1
+9 SET APCDH="Sex"
SET APCDV=AUPNSEX
DO BUILD1
+10 SET APCDSTR=""
DO SET("")
VISIT ;
+1 ;S APCDSTR="=============== "_IOINHI_"VISIT FILE"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET ;$J("",X)_APCDSTR D SET
+2 NEW MN
SET MN=$ORDER(^APCDTKW("F",9000010,0))
SET APCDNUM=APCDNUM+1
+3 ;$J("",X)_APCDSTR D SET("")
SET APCDSTR=" <"_IOINHI_(APCDNUM)_IOINORM_"> ============= "_IOINHI_"VISIT FILE"_IOINORM_" ==============="
SET X=(80-$LENGTH(APCDSTR)\2)
DO SET("")
DO SETF
+4 DO ENP^XBDIQ1(9000010,APCDVIEN,".01:1500;1502:999999","APCDAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(APCDAR(F))
IF F'=+F
QUIT
IF APCDAR(F)]""
Begin DoDot:1
+6 SET APCDH=$PIECE(^DD(9000010,F,0),U)
+7 SET APCDV=APCDAR(F)
+8 DO BUILD1
End DoDot:1
+9 SET APCDSTR=""
DO SET("")
+10 IF '$PIECE(APCDVREC,U,9)
QUIT
VFILES ;set up array of all v file entries
+1 NEW DA,D0,DIC,DIQ,DR,DI
+2 SET APCDVFLE=9000010
FOR
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)
QUIT
DO VF2
+3 DO XIT
+4 QUIT
+5 ;
VF2 ;
+1 SET APCDVNM=$PIECE(^DIC(APCDVFLE,0),U)
SET APCDVDG=^DIC(APCDVFLE,0,"GL")
SET APCDVIGR=APCDVDG_"""AD"",APCDVIEN,APCDVDFN)"
SET APCDVDFN=""
+2 IF $ORDER(@APCDVIGR)
SET APCDNUM=APCDNUM+1
+3 FOR APCDVI=1:1
SET APCDVDFN=$ORDER(@APCDVIGR)
IF APCDVDFN=""
QUIT
DO VF3
+4 QUIT
+5 ;
VF3 ;
+1 ;I APCDVI<2 S APCDSTR="" D SET S APCDSTR="=============== "_IOINHI_$P(APCDVNM,"V ",2)_"s"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET ;$J("",X)_APCDSTR D SET
+2 NEW MN
SET MN=$ORDER(^APCDTKW("F",APCDVFLE,0))
+3 ;$J("",X)_APCDSTR D SET("")
IF APCDVI<2
SET APCDSTR=""
DO SET("")
SET APCDSTR=" <"_IOINHI_(APCDNUM)_IOINORM_"> =============== "_IOINHI_$PIECE(APCDVNM,"V ",2)_"s"_IOINORM_" ==============="
SET X=(80-$LENGTH(APCDSTR)\2)
DO SET("")
DO SETF
+4 KILL APCDAR
DO ENP^XBDIQ1(APCDVFLE,APCDVDFN,".01:.019999;.04:999999","APCDAR(","E")
+5 IF APCDVI>1
SET APCDSTR=""
DO SET("")
+6 SET F=0
FOR
SET F=$ORDER(APCDAR(F))
IF F'=+F
QUIT
Begin DoDot:1
+7 IF $GET(APCDAR(F))]""
Begin DoDot:2
+8 SET APCDH=$PIECE(^DD(APCDVFLE,F,0),U)
+9 SET APCDV=APCDAR(F)
+10 DO BUILD1
End DoDot:2
QUIT
+11 IF $ORDER(APCDAR(F,0))
Begin DoDot:2
+12 SET APCDNARR=""
+13 SET F1=0
FOR
SET F1=$ORDER(APCDAR(F,F1))
IF F1'=+F1
QUIT
Begin DoDot:3
+14 SET APCDV=APCDAR(F,F1)
+15 DO BUILD1
End DoDot:3
+16 KILL APCDNARR
End DoDot:2
End DoDot:1
+17 QUIT
+18 QUIT
BUILD1 ;
+1 IF $DATA(APCDNARR)
SET APCDSTR=""
SET APCDSTR=$$SETSTR^VALM1(APCDV,APCDSTR,1,$LENGTH(APCDV))
DO SET("")
QUIT
+2 SET APCDSTR=$EXTRACT(APCDH,1,21)_":"
SET APCDSTR=$$SETSTR^VALM1(APCDV,APCDSTR,24,$LENGTH(APCDV))
+3 DO SET("")
+4 QUIT
XIT ;
+1 KILL APCDAR,APCDARRY,APCDCTR,APCDH,APCDSTR,APCDV,APCDVDFN,APCDVDG,APCDVFLE,APCDVI,APCDVIEN,APCDVIGR,APCDFL,APCDVNM,APCDVREC,APCDH
+2 KILL DO,D0,DA,DI,DIC,DIQ,DR,F,X,Y,Z
+3 QUIT
+4 ;
+5 ;
