- 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