Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP7EL3

BGP7EL3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. I9 ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8)=0
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. S BGPVALUE=$$FLU^BGP7D3(DFN,,BGPEDATE) ;set to date of flu shot
  1. I BGPVALUE]"" S BGPN1=1 ;FLU SHOT
  1. I $P(BGPVALUE,U,3)=2 S BGPN2=1 ;REFUSAL
  1. I $P(BGPVALUE,U,3)=3 S BGPN3=1,BGPN1=1 ;CONTRAINDICATION
  1. I BGPN1,'BGPN2 S BGPN7=1
  1. S BGPVALUE="AC"_"|||"_$$DATE^BGP7UTL($P(BGPVALUE,U,1))_" "_$P(BGPVALUE,U,2)
  1. K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T
  1. K BGPX,BGPY,BGPC,BGPG
  1. Q
  1. I10 ;EP
  1. 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
  1. 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
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. D PN^BGP7D3B
  1. I BGPN8!(BGPN3) S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2) I 1
  1. E S BGPVALUE="AC|||"
  1. K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T,BGPLHGB
  1. K BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG
  1. Q
  1. I11 ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. I $P(^DPT(DFN,0),U,2)'="F" S BGPSTOP=1 Q
  1. I $$MAS^BGP7D4(DFN,BGPEDATE) S BGPSTOP=1 Q
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. S BGPMAM=$$MAM^BGP7D4(DFN,BGPEDATE,2)
  1. S BGPN1=0 I $P(BGPMAM,U)=1 S BGPN1=1
  1. S BGPN2=0 I $P(BGPMAM,U,3)["Ref" S BGPN2=1
  1. I BGPN1,'BGPN2 S BGPN3=1
  1. S BGPVALUE="AC"_"|||"_$$DATE^BGP7UTL($P(BGPMAM,U,2))_" "_$P(BGPMAM,U,3)
  1. K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T,BGPLHGB
  1. K BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG,BGPMAM
  1. Q
  1. I12 ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8)=0
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. I $$CRC^BGP7D62(DFN,BGPEDATE) S BGPSTOP=1 Q ;has colorectal cancer
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. D CRCP^BGP7D62
  1. S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
  1. K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P
  1. K BGPX,BGPY,BGPC,BGPG
  1. Q
  1. ;
  1. I13 ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6)=0
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. D TA^BGP7D7
  1. ;S BGPVALUE=BGPVALUE_$S(BGPN1:";SCREENED",1:"")_$S(BGPN2:";USER",1:"")_$S(BGPN3:";SMOKER",1:"")_$S(BGPN4:";SMOKELESS",1:"")
  1. S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
  1. K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,BGPSDX,BGPXPHD,BGP1320
  1. K BGPX,BGPY,BGPC,BGPG
  1. Q
  1. I14 ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
  1. S BGPDVREF=""
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. I BGPSEX'="F" S BGPSTOP=1 Q
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. D DV^BGP7D5
  1. S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
  1. Q
  1. ;
  1. I15 ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11)=0
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. D DEPEP^BGP7D25
  1. S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
  1. Q
  1. I16 ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8)=0
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I BGPAGEB>74 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. S BGPBMI=$$BMI^BGP7D6(DFN,BGPEDATE,BGPAGEE),BGPN1=$S(BGPBMI]"":1,1:0)
  1. S BGPN2=$$OW^BGP7D6(DFN,BGPBMI,BGPAGEE)
  1. S BGPN3=$$OB^BGP7D6(DFN,BGPBMI,BGPAGEE)
  1. I BGPN2!(BGPN3) S BGPN4=1
  1. I 'BGPN1 S BGPREF=$$REF^BGP7D6(DFN,BGP365,BGPEDATE,BGPAGEB) I $P(BGPREF,U)=1 S BGPN5=1
  1. ;I BGPN5 S BGPN1=1
  1. S BGPVALUE="AC"
  1. S BGPVALUE=BGPVALUE_"|||"_$S(BGPBMI]"":$$SB^BGP7PDL1($J($P(BGPBMI,U),6,2)),1:"")_" "_$S(BGPN2:"OW",1:"")_" "_$S(BGPN3:"OB",1:"")
  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))
  1. K X,Y,Z,%,A,B,C,D,E,F,G,H,BDATE,EDATE,P,V,S,F,T,BGPBMI
  1. K BGPL,BGPLWTS,BGPLHTS,%,X,BGPLWTS1,BGPLHTS1,Y
  1. Q
  1. I17 ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN6,BGPN7)=0
  1. I BGPAGEB<55 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. S BGPD1=1
  1. I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
  1. I BGPAGEB>84 S BGPD5=1
  1. D BPCV^BGP7D41
  1. S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
  1. K X,Y,Z
  1. Q
  1. IELDFSA ;EP
  1. D IELDFSA^BGP7EL31
  1. Q
  1. IELDASA ;EP
  1. D IELDASA^BGP7EL31
  1. Q
  1. IELDPHA ;EP - PHN
  1. D IELDPHA^BGP7EL31
  1. Q