BGP8EL3 ;IHS/CMI/LAB - ELDER MEASURES;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
I9 ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
S BGPVALUE=$$FLU^BGP8D3(DFN,,BGPEDATE) ;set to date of flu shot
I BGPVALUE]"" S BGPN1=1 ;FLU SHOT
I $P(BGPVALUE,U,3)=2 S BGPN2=1 ;REFUSAL
I $P(BGPVALUE,U,3)=3 S BGPN3=1,BGPN1=1 ;CONTRAINDICATION
I BGPN1,'BGPN2 S BGPN7=1
S BGPVALUE="AC"_"|||"_$$DATE^BGP8UTL($P(BGPVALUE,U,1))_" "_$P(BGPVALUE,U,2)
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T
K BGPX,BGPY,BGPC,BGPG
Q
I10 ;EP
F X=1:1:17 S Y="BGPD"_X S @Y=""
F X=1:1:55 S Y="BGPN"_X S @Y=""
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
NEW BGPTDAP,BGPTD,BGPFLU,BGPZOST,BGPPNEU,BGPPNEUD,BGPDTAPP,BGPPPSEV,BGPPCVEV,BGPPP65,BGPPC65,BGPPP5Y,BGPPC5Y,BGPPC1Y,BGPPC19,BGPPP1Y
S (BGPPNCON,BGPPPSEV,BGPPCVEV,BGPPP65,BGPPC65,BGPPP5Y,BGPPC5Y,BGPPC1Y,BGPPC19,BGPPP1Y,BGPPPCON,BGPPCCON)=""
S BGPVALUE=""
D PN^BGP8D3B
I BGPN8!(BGPN3) S BGPVALUE="AC|||"_$P($G(BGPVALUE),"|||",2) I 1
E S BGPVALUE="AC|||"
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T,BGPLHGB
K BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG
Q
I11 ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
I $P(^DPT(DFN,0),U,2)'="F" S BGPSTOP=1 Q
I $$MAS^BGP8D4(DFN,BGPEDATE) S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
S BGPMAM=$$MAM^BGP8D4(DFN,BGPEDATE,2)
S BGPN1=0 I $P(BGPMAM,U)=1 S BGPN1=1
S BGPN2=0 I $P(BGPMAM,U,3)["Ref" S BGPN2=1
I BGPN1,'BGPN2 S BGPN3=1
S BGPVALUE="AC"_"|||"_$$DATE^BGP8UTL($P(BGPMAM,U,2))_" "_$P(BGPMAM,U,3)
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T,BGPLHGB
K BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG,BGPMAM
Q
I12 ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
I $$CRC^BGP8D62(DFN,BGPEDATE) S BGPSTOP=1 Q ;has colorectal cancer
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
D CRCP^BGP8D62
S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P
K BGPX,BGPY,BGPC,BGPG
Q
;
I13 ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPXPHD,BGP1320)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
D TA^BGP8D7
;S BGPVALUE=BGPVALUE_$S(BGPN1:";SCREENED",1:"")_$S(BGPN2:";USER",1:"")_$S(BGPN3:";SMOKER",1:"")_$S(BGPN4:";SMOKELESS",1:"")
S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,BGPSDX,BGPXPHD,BGP1320
K BGPX,BGPY,BGPC,BGPG
Q
I14 ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
S BGPDVREF=""
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
I BGPSEX'="F" S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
D DV^BGP8D5
S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
Q
;
I15 ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
D DEPEP^BGP8D25
S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
Q
I16 ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I BGPAGEB>74 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
S BGPBMI=$$BMI^BGP8D6(DFN,BGPEDATE,BGPAGEE),BGPN1=$S(BGPBMI]"":1,1:0)
S BGPN2=$$OW^BGP8D6(DFN,BGPBMI,BGPAGEE)
S BGPN3=$$OB^BGP8D6(DFN,BGPBMI,BGPAGEE)
I BGPN2!(BGPN3) S BGPN4=1
I 'BGPN1 S BGPREF=$$REF^BGP8D6(DFN,BGP365,BGPEDATE,BGPAGEB) I $P(BGPREF,U)=1 S BGPN5=1
;I BGPN5 S BGPN1=1
S BGPVALUE="AC"
S BGPVALUE=BGPVALUE_"|||"_$S(BGPBMI]"":$$SB^BGP8PDL1($J($P(BGPBMI,U),6,2)),1:"")_" "_$S(BGPN2:"OW",1:"")_" "_$S(BGPN3:"OB",1:"")
I BGPN5 S BGPVALUE=BGPVALUE_"Ref "_$P(BGPREF,U,2)_" "_$$DATE^BGP8UTL($P(BGPREF,U,3))_" "_$P(BGPREF,U,5)_" "_$$DATE^BGP8UTL($P(BGPREF,U,6))
K X,Y,Z,%,A,B,C,D,E,F,G,H,BDATE,EDATE,P,V,S,F,T,BGPBMI
K BGPL,BGPLWTS,BGPLHTS,%,X,BGPLWTS1,BGPLHTS1,Y
Q
I17 ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
D BPCV^BGP8D41
S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
K X,Y,Z
Q
IELDFSA ;EP
D IELDFSA^BGP8EL31
Q
IELDASA ;EP
D IELDASA^BGP8EL31
Q
IELDPHA ;EP - PHN
D IELDPHA^BGP8EL31
Q
BGP8EL3 ;IHS/CMI/LAB - ELDER MEASURES;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
I9 ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 SET BGPD1=1
+6 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+7 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+8 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+9 IF BGPAGEB>84
SET BGPD5=1
+10 ;set to date of flu shot
SET BGPVALUE=$$FLU^BGP8D3(DFN,,BGPEDATE)
+11 ;FLU SHOT
IF BGPVALUE]""
SET BGPN1=1
+12 ;REFUSAL
IF $PIECE(BGPVALUE,U,3)=2
SET BGPN2=1
+13 ;CONTRAINDICATION
IF $PIECE(BGPVALUE,U,3)=3
SET BGPN3=1
SET BGPN1=1
+14 IF BGPN1
IF 'BGPN2
SET BGPN7=1
+15 SET BGPVALUE="AC"_"|||"_$$DATE^BGP8UTL($PIECE(BGPVALUE,U,1))_" "_$PIECE(BGPVALUE,U,2)
+16 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T
+17 KILL BGPX,BGPY,BGPC,BGPG
+18 QUIT
I10 ;EP
+1 FOR X=1:1:17
SET Y="BGPD"_X
SET @Y=""
+2 FOR X=1:1:55
SET Y="BGPN"_X
SET @Y=""
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 SET BGPD1=1
+6 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+7 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+8 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+9 IF BGPAGEB>84
SET BGPD5=1
+10 NEW BGPTDAP,BGPTD,BGPFLU,BGPZOST,BGPPNEU,BGPPNEUD,BGPDTAPP,BGPPPSEV,BGPPCVEV,BGPPP65,BGPPC65,BGPPP5Y,BGPPC5Y,BGPPC1Y,BGPPC19,BGPPP1Y
+11 SET (BGPPNCON,BGPPPSEV,BGPPCVEV,BGPPP65,BGPPC65,BGPPP5Y,BGPPC5Y,BGPPC1Y,BGPPC19,BGPPP1Y,BGPPPCON,BGPPCCON)=""
+12 SET BGPVALUE=""
+13 DO PN^BGP8D3B
+14 IF BGPN8!(BGPN3)
SET BGPVALUE="AC|||"_$PIECE($GET(BGPVALUE),"|||",2)
IF 1
+15 IF '$TEST
SET BGPVALUE="AC|||"
+16 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T,BGPLHGB
+17 KILL BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG
+18 QUIT
I11 ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 IF $PIECE(^DPT(DFN,0),U,2)'="F"
SET BGPSTOP=1
QUIT
+6 IF $$MAS^BGP8D4(DFN,BGPEDATE)
SET BGPSTOP=1
QUIT
+7 SET BGPD1=1
+8 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+9 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+10 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+11 IF BGPAGEB>84
SET BGPD5=1
+12 SET BGPMAM=$$MAM^BGP8D4(DFN,BGPEDATE,2)
+13 SET BGPN1=0
IF $PIECE(BGPMAM,U)=1
SET BGPN1=1
+14 SET BGPN2=0
IF $PIECE(BGPMAM,U,3)["Ref"
SET BGPN2=1
+15 IF BGPN1
IF 'BGPN2
SET BGPN3=1
+16 SET BGPVALUE="AC"_"|||"_$$DATE^BGP8UTL($PIECE(BGPMAM,U,2))_" "_$PIECE(BGPMAM,U,3)
+17 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T,BGPLHGB
+18 KILL BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG,BGPMAM
+19 QUIT
I12 ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 ;has colorectal cancer
IF $$CRC^BGP8D62(DFN,BGPEDATE)
SET BGPSTOP=1
QUIT
+6 SET BGPD1=1
+7 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+8 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+9 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+10 IF BGPAGEB>84
SET BGPD5=1
+11 DO CRCP^BGP8D62
+12 SET BGPVALUE="AC|||"_$PIECE(BGPVALUE,"|||",2)
+13 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P
+14 KILL BGPX,BGPY,BGPC,BGPG
+15 QUIT
+16 ;
I13 ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPXPHD,BGP1320)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 SET BGPD1=1
+6 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+7 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+8 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+9 IF BGPAGEB>84
SET BGPD5=1
+10 DO TA^BGP8D7
+11 ;S BGPVALUE=BGPVALUE_$S(BGPN1:";SCREENED",1:"")_$S(BGPN2:";USER",1:"")_$S(BGPN3:";SMOKER",1:"")_$S(BGPN4:";SMOKELESS",1:"")
+12 SET BGPVALUE="AC|||"_$PIECE(BGPVALUE,"|||",2)
+13 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,BGPSDX,BGPXPHD,BGP1320
+14 KILL BGPX,BGPY,BGPC,BGPG
+15 QUIT
I14 ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
+3 SET BGPDVREF=""
+4 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+5 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+6 IF BGPSEX'="F"
SET BGPSTOP=1
QUIT
+7 SET BGPD1=1
+8 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+9 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+10 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+11 IF BGPAGEB>84
SET BGPD5=1
+12 DO DV^BGP8D5
+13 SET BGPVALUE="AC|||"_$PIECE(BGPVALUE,"|||",2)
+14 QUIT
+15 ;
I15 ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 SET BGPD1=1
+6 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+7 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+8 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+9 IF BGPAGEB>84
SET BGPD5=1
+10 DO DEPEP^BGP8D25
+11 SET BGPVALUE="AC|||"_$PIECE(BGPVALUE,"|||",2)
+12 QUIT
I16 ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF BGPAGEB>74
SET BGPSTOP=1
QUIT
+5 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+6 SET BGPD1=1
+7 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+8 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+9 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+10 IF BGPAGEB>84
SET BGPD5=1
+11 SET BGPBMI=$$BMI^BGP8D6(DFN,BGPEDATE,BGPAGEE)
SET BGPN1=$SELECT(BGPBMI]"":1,1:0)
+12 SET BGPN2=$$OW^BGP8D6(DFN,BGPBMI,BGPAGEE)
+13 SET BGPN3=$$OB^BGP8D6(DFN,BGPBMI,BGPAGEE)
+14 IF BGPN2!(BGPN3)
SET BGPN4=1
+15 IF 'BGPN1
SET BGPREF=$$REF^BGP8D6(DFN,BGP365,BGPEDATE,BGPAGEB)
IF $PIECE(BGPREF,U)=1
SET BGPN5=1
+16 ;I BGPN5 S BGPN1=1
+17 SET BGPVALUE="AC"
+18 SET BGPVALUE=BGPVALUE_"|||"_$SELECT(BGPBMI]"":$$SB^BGP8PDL1($JUSTIFY($PIECE(BGPBMI,U),6,2)),1:"")_" "_$SELECT(BGPN2:"OW",1:"")_" "_$SELECT(BGPN3:"OB",1:"")
+19 IF BGPN5
SET BGPVALUE=BGPVALUE_"Ref "_$PIECE(BGPREF,U,2)_" "_$$DATE^BGP8UTL($PIECE(BGPREF,U,3))_" "_$PIECE(BGPREF,U,5)_" "_$$DATE^BGP8UTL($PIECE(BGPREF,U,6))
+20 KILL X,Y,Z,%,A,B,C,D,E,F,G,H,BDATE,EDATE,P,V,S,F,T,BGPBMI
+21 KILL BGPL,BGPLWTS,BGPLHTS,%,X,BGPLWTS1,BGPLHTS1,Y
+22 QUIT
I17 ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 SET BGPD1=1
+6 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+7 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+8 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+9 IF BGPAGEB>84
SET BGPD5=1
+10 DO BPCV^BGP8D41
+11 SET BGPVALUE="AC|||"_$PIECE(BGPVALUE,"|||",2)
+12 KILL X,Y,Z
+13 QUIT
IELDFSA ;EP
+1 DO IELDFSA^BGP8EL31
+2 QUIT
IELDASA ;EP
+1 DO IELDASA^BGP8EL31
+2 QUIT
IELDPHA ;EP - PHN
+1 DO IELDPHA^BGP8EL31
+2 QUIT
