BRNRD ; IHS/PHXAO/TMJ -DISCLOSURE DISPLAY ; [ 04/10/03 1:34 PM ]
;;2.0;RELEASE OF INFO SYSTEM;*1,4*;APR 10, 2003;Build 15
;IHS/OIT/LJF 03/06/2008 PATCH 1 Changed ;PEP to ;EP on line EP
;IHS/OIT/GAB PATCH 4 - Change to Description; April 2017
EP(BRNRIEN) ;EP
START ;Enter Point to Build Array
Q:'$D(BRNRIEN)
Q:'BRNRIEN
Q:'$D(^BRNREC(BRNRIEN,0))
K ^TMP("BRNRDSP",$J)
D BUILD
D EOJ
Q
;
BUILD ; build array
K BRNAR
D TERM^VALM0
S BRNRREC=^BRNREC(BRNRIEN,0)
S Y=$P(BRNRREC,U,3) D ^AUPNPAT
S BRNSTR="",BRNCTR=0
S BRNH="Patient Name",BRNV=IOINHI_$E($P(^DPT($P(BRNRREC,U,3),0),U),1,20)_IOINORM D BUILD1
S BRNH="Chart #",BRNV=IOINHI_$S($D(^AUPNPAT($P(BRNRREC,U,3),41,DUZ(2),0)):$P(^(0),U,2),1:"None")_IOINORM D BUILD1
S BRNH="Date of Birth" S Y=AUPNDOB D DD^%DT S BRNV=Y D BUILD1
S BRNH="Sex",BRNV=AUPNSEX D BUILD1
S BRNSTR="" D SET
REFERRAL ;
S BRNSTR="=============== "_IOINHI_"DISCLOSURE RECORD"_IOINORM_" ===============",X=(80-$L(BRNSTR)\2) D SET ;$J("",X)_BRNSTR D SET
K BRNAR D ENP^XBDIQ1(90264,BRNRIEN,".01:.49","BRNAR(","E")
S F=0 F S F=$O(BRNAR(F)) Q:F'=+F I BRNAR(F)]"" D
.S BRNH=$P(^DD(90264,F,0),U)
.S BRNV=BRNAR(F)
.D BUILD1
S BRNSTR="" D SET
S BRNH="PURPOSE OF DISCLOSURE",BRNV=$$VAL^XBDIQ1(90264,BRNRIEN,.07) D BUILD1,SET
2 ;
;/IHS/OIT/GAB Patch #4 - changed below to Disclosure Description
;S BRNSTR="DISCLOSURE NOTES:" D SET
S BRNSTR="DISCLOSURE DESCRIPTION:" D SET
K BRNAR D ENP^XBDIQ1(90264,BRNRIEN,22,"BRNAR(","E")
S F=0 F S F=$O(BRNAR(22,F)) Q:F'=+F S BRNSTR=BRNAR(22,F) D SET
S BRNSTR="" D SET
AUTH ;display Receiving Parties, similiar to v file
I '$D(^BRNREC(BRNRIEN,23)) G VFILES
S BRNSTR="ROI RECEIVING PARTIES:" D SET
K BRNAR D ENPM^XBDIQ1(90264.023,"BRNRIEN,0",".01:.04","BRNAR(")
S (I,F)=0 F S I=$O(BRNAR(I)) Q:I'=+I S BRNSTR="" D SET S F=0 F S F=$O(BRNAR(I,F)) Q:F'=+F D
.S BRNH=$P(^DD(90264.023,F,0),U)
.S BRNV=BRNAR(I,F)
.D BUILD1
S BRNSTR="" D SET
VFILES ;set up array of all v file entries
NEW DA,D0,DIC,DIQ,DR,DI
S BRNVFLE=90264 F BRNVL=0:0 S BRNVFLE=$O(^DIC(BRNVFLE)) Q:BRNVFLE>90264.04!(BRNVFLE'=+BRNVFLE) D VF2
Q
;
VF2 ;
S BRNVNM=$P(^DIC(BRNVFLE,0),U),BRNVDG=^DIC(BRNVFLE,0,"GL"),BRNVIGR=BRNVDG_"""AD"",BRNRIEN,BRNVDFN)",BRNVDFN=""
F BRNVI=1:1 S BRNVDFN=$O(@BRNVIGR) Q:BRNVDFN="" D VF3
Q
;
VF3 ;
I BRNVI<2 S BRNSTR="" D SET S BRNSTR="=============== "_IOINHI_BRNVNM_"s"_IOINORM_" ===============",X=(80-$L(BRNSTR)\2) D SET ;$J("",X)_BRNSTR D SET
K BRNAR D ENP^XBDIQ1(BRNVFLE,BRNVDFN,".01:.019999;.04:999999","BRNAR(","E")
S BRNSTR="" D SET
S F=0 F S F=$O(BRNAR(F)) Q:F'=+F D
.I $G(BRNAR(F))]"" D
..S BRNH=$P(^DD(BRNVFLE,F,0),U)
..S BRNV=BRNAR(F)
..D BUILD1
.S G=0 F S G=$O(BRNAR(F,G)) Q:G'=+G I $G(BRNAR(F,G))]"" D
..S BRNSTR=BRNAR(F,G)
..D SET
..Q
K G
Q
BUILD1 ;
S BRNSTR=$E(BRNH,1,25)_":",BRNSTR=$$SETSTR^VALM1(BRNV,BRNSTR,28,$L(BRNV))
D SET
Q
SET ;set array
S BRNCTR=BRNCTR+1
S ^TMP("BRNRDSP",$J,BRNCTR,0)=BRNSTR
S BRNSTR=""
Q
;
EOJ ;
K BRNAR,BRNSTR,BRNCTR,BRNH,BRNRREC,BRNV,BRNVNM,BRNVDG,BRNVIGR,BRNVDFN
K BRNVFLE,BRNVI,BRNVL
Q
BRNRD ; IHS/PHXAO/TMJ -DISCLOSURE DISPLAY ; [ 04/10/03 1:34 PM ]
+1 ;;2.0;RELEASE OF INFO SYSTEM;*1,4*;APR 10, 2003;Build 15
+2 ;IHS/OIT/LJF 03/06/2008 PATCH 1 Changed ;PEP to ;EP on line EP
+3 ;IHS/OIT/GAB PATCH 4 - Change to Description; April 2017
EP(BRNRIEN) ;EP
START ;Enter Point to Build Array
+1 IF '$DATA(BRNRIEN)
QUIT
+2 IF 'BRNRIEN
QUIT
+3 IF '$DATA(^BRNREC(BRNRIEN,0))
QUIT
+4 KILL ^TMP("BRNRDSP",$JOB)
+5 DO BUILD
+6 DO EOJ
+7 QUIT
+8 ;
BUILD ; build array
+1 KILL BRNAR
+2 DO TERM^VALM0
+3 SET BRNRREC=^BRNREC(BRNRIEN,0)
+4 SET Y=$PIECE(BRNRREC,U,3)
DO ^AUPNPAT
+5 SET BRNSTR=""
SET BRNCTR=0
+6 SET BRNH="Patient Name"
SET BRNV=IOINHI_$EXTRACT($PIECE(^DPT($PIECE(BRNRREC,U,3),0),U),1,20)_IOINORM
DO BUILD1
+7 SET BRNH="Chart #"
SET BRNV=IOINHI_$SELECT($DATA(^AUPNPAT($PIECE(BRNRREC,U,3),41,DUZ(2),0)):$PIECE(^(0),U,2),1:"None")_IOINORM
DO BUILD1
+8 SET BRNH="Date of Birth"
SET Y=AUPNDOB
DO DD^%DT
SET BRNV=Y
DO BUILD1
+9 SET BRNH="Sex"
SET BRNV=AUPNSEX
DO BUILD1
+10 SET BRNSTR=""
DO SET
REFERRAL ;
+1 ;$J("",X)_BRNSTR D SET
SET BRNSTR="=============== "_IOINHI_"DISCLOSURE RECORD"_IOINORM_" ==============="
SET X=(80-$LENGTH(BRNSTR)\2)
DO SET
+2 KILL BRNAR
DO ENP^XBDIQ1(90264,BRNRIEN,".01:.49","BRNAR(","E")
+3 SET F=0
FOR
SET F=$ORDER(BRNAR(F))
IF F'=+F
QUIT
IF BRNAR(F)]""
Begin DoDot:1
+4 SET BRNH=$PIECE(^DD(90264,F,0),U)
+5 SET BRNV=BRNAR(F)
+6 DO BUILD1
End DoDot:1
+7 SET BRNSTR=""
DO SET
+8 SET BRNH="PURPOSE OF DISCLOSURE"
SET BRNV=$$VAL^XBDIQ1(90264,BRNRIEN,.07)
DO BUILD1
DO SET
2 ;
+1 ;/IHS/OIT/GAB Patch #4 - changed below to Disclosure Description
+2 ;S BRNSTR="DISCLOSURE NOTES:" D SET
+3 SET BRNSTR="DISCLOSURE DESCRIPTION:"
DO SET
+4 KILL BRNAR
DO ENP^XBDIQ1(90264,BRNRIEN,22,"BRNAR(","E")
+5 SET F=0
FOR
SET F=$ORDER(BRNAR(22,F))
IF F'=+F
QUIT
SET BRNSTR=BRNAR(22,F)
DO SET
+6 SET BRNSTR=""
DO SET
AUTH ;display Receiving Parties, similiar to v file
+1 IF '$DATA(^BRNREC(BRNRIEN,23))
GOTO VFILES
+2 SET BRNSTR="ROI RECEIVING PARTIES:"
DO SET
+3 KILL BRNAR
DO ENPM^XBDIQ1(90264.023,"BRNRIEN,0",".01:.04","BRNAR(")
+4 SET (I,F)=0
FOR
SET I=$ORDER(BRNAR(I))
IF I'=+I
QUIT
SET BRNSTR=""
DO SET
SET F=0
FOR
SET F=$ORDER(BRNAR(I,F))
IF F'=+F
QUIT
Begin DoDot:1
+5 SET BRNH=$PIECE(^DD(90264.023,F,0),U)
+6 SET BRNV=BRNAR(I,F)
+7 DO BUILD1
End DoDot:1
+8 SET BRNSTR=""
DO SET
VFILES ;set up array of all v file entries
+1 NEW DA,D0,DIC,DIQ,DR,DI
+2 SET BRNVFLE=90264
FOR BRNVL=0:0
SET BRNVFLE=$ORDER(^DIC(BRNVFLE))
IF BRNVFLE>90264.04!(BRNVFLE'=+BRNVFLE)
QUIT
DO VF2
+3 QUIT
+4 ;
VF2 ;
+1 SET BRNVNM=$PIECE(^DIC(BRNVFLE,0),U)
SET BRNVDG=^DIC(BRNVFLE,0,"GL")
SET BRNVIGR=BRNVDG_"""AD"",BRNRIEN,BRNVDFN)"
SET BRNVDFN=""
+2 FOR BRNVI=1:1
SET BRNVDFN=$ORDER(@BRNVIGR)
IF BRNVDFN=""
QUIT
DO VF3
+3 QUIT
+4 ;
VF3 ;
+1 ;$J("",X)_BRNSTR D SET
IF BRNVI<2
SET BRNSTR=""
DO SET
SET BRNSTR="=============== "_IOINHI_BRNVNM_"s"_IOINORM_" ==============="
SET X=(80-$LENGTH(BRNSTR)\2)
DO SET
+2 KILL BRNAR
DO ENP^XBDIQ1(BRNVFLE,BRNVDFN,".01:.019999;.04:999999","BRNAR(","E")
+3 SET BRNSTR=""
DO SET
+4 SET F=0
FOR
SET F=$ORDER(BRNAR(F))
IF F'=+F
QUIT
Begin DoDot:1
+5 IF $GET(BRNAR(F))]""
Begin DoDot:2
+6 SET BRNH=$PIECE(^DD(BRNVFLE,F,0),U)
+7 SET BRNV=BRNAR(F)
+8 DO BUILD1
End DoDot:2
+9 SET G=0
FOR
SET G=$ORDER(BRNAR(F,G))
IF G'=+G
QUIT
IF $GET(BRNAR(F,G))]""
Begin DoDot:2
+10 SET BRNSTR=BRNAR(F,G)
+11 DO SET
+12 QUIT
End DoDot:2
End DoDot:1
+13 KILL G
+14 QUIT
BUILD1 ;
+1 SET BRNSTR=$EXTRACT(BRNH,1,25)_":"
SET BRNSTR=$$SETSTR^VALM1(BRNV,BRNSTR,28,$LENGTH(BRNV))
+2 DO SET
+3 QUIT
SET ;set array
+1 SET BRNCTR=BRNCTR+1
+2 SET ^TMP("BRNRDSP",$JOB,BRNCTR,0)=BRNSTR
+3 SET BRNSTR=""
+4 QUIT
+5 ;
EOJ ;
+1 KILL BRNAR,BRNSTR,BRNCTR,BRNH,BRNRREC,BRNV,BRNVNM,BRNVDG,BRNVIGR,BRNVDFN
+2 KILL BRNVFLE,BRNVI,BRNVL
+3 QUIT
