BGP7EL3 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM 20 Mar 2017 7:52 AM ;
;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
;
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^BGP7D3(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^BGP7UTL($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
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13)=0
S (BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN35,BGPN36,BGPN37,BGPN38,BGPN39,BGPN40)=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 PN^BGP7D3B
I BGPN8!(BGPN3) S BGPVALUE="AC|||"_$P(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^BGP7D4(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^BGP7D4(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^BGP7UTL($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^BGP7D62(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^BGP7D62
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,BGPN6)=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^BGP7D7
;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^BGP7D5
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^BGP7D25
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^BGP7D6(DFN,BGPEDATE,BGPAGEE),BGPN1=$S(BGPBMI]"":1,1:0)
S BGPN2=$$OW^BGP7D6(DFN,BGPBMI,BGPAGEE)
S BGPN3=$$OB^BGP7D6(DFN,BGPBMI,BGPAGEE)
I BGPN2!(BGPN3) S BGPN4=1
I 'BGPN1 S BGPREF=$$REF^BGP7D6(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^BGP7PDL1($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^BGP7UTL($P(BGPREF,U,3))_" "_$P(BGPREF,U,5)_" "_$$DATE^BGP7UTL($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^BGP7D41
S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
K X,Y,Z
Q
IELDFSA ;EP
D IELDFSA^BGP7EL31
Q
IELDASA ;EP
D IELDASA^BGP7EL31
Q
IELDPHA ;EP - PHN
D IELDPHA^BGP7EL31
Q
BGP7EL3 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM 20 Mar 2017 7:52 AM ;
+1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
+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^BGP7D3(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^BGP7UTL($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 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13)=0
+2 SET (BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN35,BGPN36,BGPN37,BGPN38,BGPN39,BGPN40)=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 PN^BGP7D3B
+11 IF BGPN8!(BGPN3)
SET BGPVALUE="AC|||"_$PIECE(BGPVALUE,"|||",2)
IF 1
+12 IF '$TEST
SET BGPVALUE="AC|||"
+13 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T,BGPLHGB
+14 KILL BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG
+15 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^BGP7D4(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^BGP7D4(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^BGP7UTL($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^BGP7D62(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^BGP7D62
+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,BGPN6)=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^BGP7D7
+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^BGP7D5
+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^BGP7D25
+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^BGP7D6(DFN,BGPEDATE,BGPAGEE)
SET BGPN1=$SELECT(BGPBMI]"":1,1:0)
+12 SET BGPN2=$$OW^BGP7D6(DFN,BGPBMI,BGPAGEE)
+13 SET BGPN3=$$OB^BGP7D6(DFN,BGPBMI,BGPAGEE)
+14 IF BGPN2!(BGPN3)
SET BGPN4=1
+15 IF 'BGPN1
SET BGPREF=$$REF^BGP7D6(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^BGP7PDL1($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^BGP7UTL($PIECE(BGPREF,U,3))_" "_$PIECE(BGPREF,U,5)_" "_$$DATE^BGP7UTL($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^BGP7D41
+11 SET BGPVALUE="AC|||"_$PIECE(BGPVALUE,"|||",2)
+12 KILL X,Y,Z
+13 QUIT
IELDFSA ;EP
+1 DO IELDFSA^BGP7EL31
+2 QUIT
IELDASA ;EP
+1 DO IELDASA^BGP7EL31
+2 QUIT
IELDPHA ;EP - PHN
+1 DO IELDPHA^BGP7EL31
+2 QUIT
