- BGP2D74 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM ;
- ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- ;
- IEFR ;EP
- S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
- S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
- I BGPAGEB<65 S BGPSTOP=1 Q
- S BGPD2=1 ;user pop
- I BGPACTCL S BGPD1=1 ;active clinical
- I BGPAGEB>64,BGPAGEB<75,BGPD1 S BGPD3=1
- I BGPAGEB>74,BGPAGEB<85,BGPD1 S BGPD4=1
- I BGPAGEB>84,BGPD1 S BGPD5=1
- S BGPVALUE=""
- S BGPFREX=$$FALLEX(DFN,BGPBDATE,BGPEDATE)
- I BGPFREX S BGPN2=1,BGPVALUE="Screen: "_$P(BGPFREX,U,3)_" "_$P(BGPFREX,U,2)
- S BGPDHF=$$DHF(DFN,BGPBDATE,BGPEDATE)
- I BGPDHF S BGPN3=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPDHF,U,3)_" "_$P(BGPDHF,U,2)
- S BGPFID=$$FID(DFN,BGPBDATE,BGPEDATE)
- I BGPFID S BGPN4=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":";",1:"")_$P(BGPFID,U,3)_" "_$P(BGPFID,U,2)
- S BGPAGM=$$AGM(DFN,BGPBDATE,BGPEDATE)
- I BGPAGM S BGPN5=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":";",1:"")_$P(BGPAGM,U,3)_" "_$P(BGPAGM,U,2)
- S BGPREFEX=$$REFFRE(DFN,BGPBDATE,BGPEDATE)
- I BGPREFEX S BGPN6=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":";",1:"")_$P(BGPREFEX,U,3)_" "_$P(BGPREFEX,U,2)
- S BGPVALUE=$S(BGPRTYPE=5:"",1:"UP")_$S(BGPD1:",AC",1:"")_"|||"_BGPVALUE
- I BGPN2!(BGPN3)!(BGPN4)!(BGPN5) S BGPN1=1
- K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
- Q
- IEDA ;EP
- S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
- S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
- K BGPNUMV ;FOR ELDER 20 NUMERATORS
- I BGPAGEB<65 S BGPSTOP=1 Q
- S BGPD4=1 ;user pop
- I BGPACTCL S BGPD1=1 ;active clinical
- I BGPRTYPE=5,'BGPD1 S BGPSTOP=1 Q ;elder only wants active clinical
- I BGPD1,BGPSEX="M" S BGPD2=1
- I BGPD1,BGPSEX="F" S BGPD3=1
- I BGPD4,BGPSEX="M" S BGPD5=1
- I BGPD4,BGPSEX="F" S BGPD6=1
- I BGPAGEB>64,BGPAGEB<75,BGPD1 S BGPD7=1
- I BGPAGEB>74,BGPAGEB<85,BGPD1 S BGPD8=1
- I BGPAGEB>84,BGPD1 S BGPD9=1
- K BGPMEDS,BGPDAE
- D GETDAE(DFN,BGPBDATE,BGPEDATE,.BGPDAE,.BGPNUMV)
- S X=0,C=0,J="" F S X=$O(BGPDAE(X)) Q:X'=+X S C=C+1,J=J_$S(J]"":"; ",1:"")_$$DATE^BGP2UTL($P(BGPDAE(X),U,3))_" "_$P(BGPDAE(X),U,2)_" ("_$P(BGPDAE(X),U,4)_")"
- I C>0 S BGPN1=1
- I C>1 S BGPN2=1
- F X=1:1:18 I '$D(BGPNUMV(X)) S BGPNUMV(X)=0
- S BGPVALUE="UP"
- I BGPRTYPE=3!(BGPRTYPE=5) S BGPVALUE=""
- S BGPVALUE=BGPVALUE_$S(BGPD1&(BGPVALUE]""):",AC",BGPD1&(BGPVALUE=""):"AC",1:"")_"|||" I C S BGPVALUE=BGPVALUE_C_" drug"_$S(C>1:"s: ",1:":")_J
- K BGPMEDS,BGPMEDS1,J,X,C,Y,BGPDAE
- K ^TMP($J,"MEDS")
- Q
- IBFR ;EP
- S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
- S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9)=0
- S (BGPV2,BGPV3,BGPV4,BGPV5,BGPV6)=""
- S BGPADAY=$$FMDIFF^XLFDT(BGPBDATE,$P(^DPT(DFN,0),U,3))
- I BGPADAY<30 S BGPSTOP=1 Q
- I BGPADAY>394 S BGPSTOP=1 Q
- I 'BGPACTCL S BGPSTOP=1 Q
- S BGPD1=1
- K BGPBFR
- D GETIFC(DFN,BGPBDATE,BGPEDATE,.BGPBFR)
- I $D(BGPBFR) S BGPN1=1 ;has a screening
- ;n2
- D
- .S X=44,G="" K Z F S X=$O(BGPBFR(X)) Q:X'=+X!(X>89) S Z($$ABS^XLFMTH(X-60))=X
- .Q:'$D(Z)
- .S X=$O(Z("")),X=Z(X) ;this is the lowest/closest to 60 days
- .S BGPN2=1
- .S Y=BGPBFR(X)
- .I +Y=1!(+Y=2) S BGPN6=1
- .S BGPV2="2 MOS: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- .S G=1
- D
- .S X=164,G="" K Z F S X=$O(BGPBFR(X)) Q:X'=+X!(X>209) S Z($$ABS^XLFMTH(X-180))=X
- .Q:'$D(Z)
- .S X=$O(Z("")),X=Z(X) ;this is the lowest/closest to 180 days
- .S BGPN3=1
- .S Y=BGPBFR(X)
- .I +Y=1!(+Y=2) S BGPN7=1
- .S BGPV3="6 MOS: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- .S G=1
- D
- .S X=254,G="" K Z F S X=$O(BGPBFR(X)) Q:X'=+X!(X>299) S Z($$ABS^XLFMTH(X-270))=X
- .Q:'$D(Z)
- .S X=$O(Z("")),X=Z(X) ;this is the lowest/closest to 270 days
- .S BGPN4=1
- .S Y=BGPBFR(X)
- .I +Y=1!(+Y=2) S BGPN8=1
- .S BGPV4="9 MOS: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- .S G=1
- D
- .S X=349,G="" K Z F S X=$O(BGPBFR(X)) Q:X'=+X!(X>394) S Z($$ABS^XLFMTH(X-365))=X
- .Q:'$D(Z)
- .S X=$O(Z("")),X=Z(X) ;this is the lowest/closest to 365 days
- .S BGPN5=1
- .S Y=BGPBFR(X)
- .I +Y=1!(+Y=2) S BGPN9=1
- .S BGPV5="1 YR: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- .S G=1
- S BGPVALUE=$S(BGPN1=1:"Scrn: ",1:"") ;,BGPVALUE=BGPVALUE_$S(BGPV2]""!(BGPV3]"")!(BGPV4]"")!(BGPV5)]"":": ",1:"")
- S C=0
- I BGPV2]"" S BGPVALUE=BGPVALUE_$S(C=1:"; ",1:"")_BGPV2,C=1
- I BGPV3]"" S BGPVALUE=BGPVALUE_$S(C=1:"; ",1:"")_BGPV3,C=1
- I BGPV4]"" S BGPVALUE=BGPVALUE_$S(C=1:"; ",1:"")_BGPV4,C=1
- I BGPV5]"" S BGPVALUE=BGPVALUE_$S(C=1:"; ",1:"")_BGPV5,C=1
- I BGPN1,BGPV2="",BGPV3="",BGPV4="",BGPV5="" D
- .S X=$O(BGPBFR("")) S Y=BGPBFR(X) S BGPVALUE="Scrn: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- S BGPVALUE="AC|||"_BGPVALUE
- K BGPV1,BGPV2,BGPV3,BGPV4,BGPV5,BGPV6,BGPBFR
- Q
- GETDAE(P,BDATE,EDATE,BGPRET,BGPRET1) ;EP
- ;get all meds in all taxonomies
- K BGPMEDS,BGPMEDST,BGPRET,BGPRET1
- K BGPMEDS1 S BGPXXX="ANTIANXIETY",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIANXIETY MEDS","BGP HEDIS ANTIANXIETY NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(1)=1
- K BGPMEDS1 S BGPXXX="ANTIEMETIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIEMETIC MEDS","BGP HEDIS ANTIEMETIC NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(2)=1
- K BGPMEDS1 S BGPXXX="ANALGESIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANALGESIC MEDS","BGP HEDIS ANALGESIC NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(3)=1
- K BGPMEDS1 S BGPXXX="ANTIHISTAMINE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIHISTAMINE MEDS","BGP HEDIS ANTIHISTAMINE NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(4)=1
- K BGPMEDS1 S BGPXXX="ANTIPSYCHOTIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIPSYCHOTIC MEDS","BGP HEDIS ANTIPSYCHOTIC NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(5)=1
- K BGPMEDS1 S BGPXXX="AMPHETAMINE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS AMPHETAMINE MEDS","BGP HEDIS AMPHETAMINE NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(6)=1
- K BGPMEDS1 S BGPXXX="BARBITURATE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BARBITURATE MEDS","BGP HEDIS BARBITURATE NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(7)=1
- K BGPMEDS1 S BGPXXX="BENZODIAZEPINE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BENZODIAZEPINE MEDS","BGP HEDIS BENZODIAZEPINE NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(8)=1
- ;K BGPMEDS1 S BGPXXX="OTHER BENZODIAZEPNE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS OTHER BENZODIAZEPINE","BGP HEDIS OTHER BENZO NDC",,,.BGPMEDS1)
- ;D ADDINMED
- ;I BGPGOT S BGPRET1(9)=1
- K BGPMEDS1 S BGPXXX="CALCIUM CHANNEL",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS CALCIUM CHANNEL MEDS","BGP HEDIS CALCIUM CHANNEL NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(10)=1
- K BGPMEDS1 S BGPXXX="GASTRO ANTISPASM",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS GASTRO ANTISPASM MED","BGP HEDIS GASTRO ANTISPASM NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(11)=1
- K BGPMEDS1 S BGPXXX="BELLADONNA",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BELLADONNA ALKA MEDS","BGP HEDIS BELLADONNA ALKA NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(12)=1
- K BGPMEDS1 S BGPXXX="SKL MUSCLE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS SKL MUSCLE RELAX MED","BGP HEDIS SKL MUSCLE RELAX NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(13)=1
- K BGPMEDS1 S BGPXXX="ORAL ESTROGEN",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ORAL ESTROGEN MEDS","BGP HEDIS ORAL ESTROGEN NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(14)=1
- K BGPMEDS1 S BGPXXX="ORAL HYPOGLYCEMIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ORAL HYPOGLYCEMIC RX","BGP HEDIS ORAL HYPOGLYCEMIC ND",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(15)=1
- K BGPMEDS1 S BGPXXX="NARCOTIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS NARCOTIC MEDS","BGP HEDIS NARCOTIC NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(16)=1
- K BGPMEDS1 S BGPXXX="VASODILATOR",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS VASODILATOR MEDS","BGP HEDIS VASODILATOR NDC",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(17)=1
- K BGPMEDS1 S BGPXXX="OTHER MEDS",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS OTHER MEDS AVOID ELD","BGP HEDIS OTHER NDC AVOID ELD",,,.BGPMEDS1)
- D ADDINMED
- I BGPGOT S BGPRET1(18)=1
- K BGPMEDS1
- Q
- ADDINMED ;
- S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X D
- .S Y=$P(BGPMEDS1(X),U,4) ;vmed ien
- .Q:'$D(^AUPNVMED(Y,0))
- .Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
- .S D=$P(^AUPNVMED(Y,0),U,1) ;drug ien
- .;DAYS SUPPLY MUST BE >0
- .S E=$P(^AUPNVMED(Y,0),U,8) ;date discontinued
- .S S=$P(^AUPNVMED(Y,0),U,7) ;DAYS SUPPLY
- .Q:'S
- .I E,E'>$P(BGPMEDS1(X),U,1) Q ;at least one day
- .S $P(BGPRET(D),U)=$P($G(BGPRET(D)),U)+1
- .S $P(BGPRET(D),U,2)=$P(^PSDRUG(D,0),U)
- .S $P(BGPRET(D),U,3)=$P(BGPMEDS1(X),U,1) ;LAST FILL
- .S $P(BGPRET(D),U,4)=BGPXXX
- .S BGPGOT=1
- .Q
- Q
- GETIFC(P,BDATE,EDATE,BGPRET) ;EP
- K BGPRET,BGPG,C,X
- S X=0 F S X=$O(^AUPNVIF("AC",P,X)) Q:X'=+X D
- .Q:'$D(^AUPNVIF(X))
- .S V=$P(^AUPNVIF(X,0),U,3),C=$P(^AUPNVIF(X,0),U,1)
- .Q:V=""
- .Q:'$D(^AUPNVSIT(V,0))
- .S V=$P($P(^AUPNVSIT(V,0),U),".")
- .;I V<BDATE Q
- .;I V>EDATE Q
- .S BGPRET($$FMDIFF^XLFDT(V,$P(^DPT(P,0),U,3)))=C_U_V
- .Q
- Q
- FALLEX(P,BDATE,EDATE) ;EP
- NEW %,BGPG,E
- K BGPG S %=P_"^LAST EXAM 37;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
- I $D(BGPG(1)) Q 1_"^Ex 37^"_$$DATE^BGP2UTL($P(BGPG(1),U))
- S %=$$CPT^BGP2DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP FALL RISK EXAM CPTS",0)),6)
- I % Q "1^CPT "_$P(%,U,3)_"^"_$$DATE^BGP2UTL($P(%,U,2))
- Q ""
- DHF(P,BDATE,EDATE) ;EP
- K BGPG
- S Y="BGPG("
- S X=P_"^LAST DX [BGP HISTORY OF FALL DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
- I $D(BGPG(1)) Q 1_U_"POV "_$P(BGPG(1),U,2)_U_"Hx of Fall: "_$$DATE^BGP2UTL($P(BGPG(1),U))
- Q ""
- FID(P,BDATE,EDATE) ;EP
- S Y="BGPG("
- K BGPG
- S X=P_"^ALL DX;DURING "_BDATE_-EDATE S E=$$START1^APCLDF(X,Y)
- S G=""
- S T=$O(^ATXAX("B","BGP FALL RELATED E-CODES",0))
- S X=0 F S X=$O(BGPG(X)) Q:X'=+X!(G) D
- .S Y=+$P(BGPG(X),U,4),D=$P(^AUPNVPOV(Y,0),U)
- .I $P(^AUPNVPOV(Y,0),U,9)="",$P(^AUPNVPOV(Y,0),U,18)="",$P(^AUPNVPOV(Y,0),U,19)="" Q
- .S E=$P(^AUPNVPOV(Y,0),U,9) I E,$$ICD^ATXCHK(E,T,9) S G=1_U_"E-CODE "_$P($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($P(BGPG(X),U,1)) Q
- .S E=$P(^AUPNVPOV(Y,0),U,18) I E,$$ICD^ATXCHK(E,T,9) S G=1_U_"E-CODE "_$P($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($P(BGPG(X),U,1)) Q
- .S E=$P(^AUPNVPOV(Y,0),U,19) I E,$$ICD^ATXCHK(E,T,9) S G=1_U_"E-CODE "_$P($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($P(BGPG(X),U,1)) Q
- I G Q G
- Q ""
- AGM(P,BDATE,EDATE) ;EP
- S BGPG=$$LASTDX^BGP2UTL1(P,"BGP ABNORMAL GAIT OR MOBILITY",BDATE,EDATE)
- I $P(BGPG,U) Q 1_U_"POV "_$P(BGPG,U,2)_U_"Abnormal Gait: "_$$DATE^BGP2UTL($P(BGPG,U,3))
- Q ""
- REFFRE(P,BDATE,EDATE) ;EP
- ;add Refusal for exam 37
- S G=$$REFUSAL^BGP2UTL1(P,9999999.15,$O(^AUTTEXAM("C",37,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
- I $P(G,U)=1 Q 1_"^Ex 37^"_"Refused "_$$DATE^BGP2UTL($P(G,U,2))
- Q ""
- BGP2D74 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM ;
- +1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- +2 ;
- IEFR ;EP
- +1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
- +2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
- +3 IF BGPAGEB<65
- SET BGPSTOP=1
- QUIT
- +4 ;user pop
- SET BGPD2=1
- +5 ;active clinical
- IF BGPACTCL
- SET BGPD1=1
- +6 IF BGPAGEB>64
- IF BGPAGEB<75
- IF BGPD1
- SET BGPD3=1
- +7 IF BGPAGEB>74
- IF BGPAGEB<85
- IF BGPD1
- SET BGPD4=1
- +8 IF BGPAGEB>84
- IF BGPD1
- SET BGPD5=1
- +9 SET BGPVALUE=""
- +10 SET BGPFREX=$$FALLEX(DFN,BGPBDATE,BGPEDATE)
- +11 IF BGPFREX
- SET BGPN2=1
- SET BGPVALUE="Screen: "_$PIECE(BGPFREX,U,3)_" "_$PIECE(BGPFREX,U,2)
- +12 SET BGPDHF=$$DHF(DFN,BGPBDATE,BGPEDATE)
- +13 IF BGPDHF
- SET BGPN3=1
- SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPDHF,U,3)_" "_$PIECE(BGPDHF,U,2)
- +14 SET BGPFID=$$FID(DFN,BGPBDATE,BGPEDATE)
- +15 IF BGPFID
- SET BGPN4=1
- SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":";",1:"")_$PIECE(BGPFID,U,3)_" "_$PIECE(BGPFID,U,2)
- +16 SET BGPAGM=$$AGM(DFN,BGPBDATE,BGPEDATE)
- +17 IF BGPAGM
- SET BGPN5=1
- SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":";",1:"")_$PIECE(BGPAGM,U,3)_" "_$PIECE(BGPAGM,U,2)
- +18 SET BGPREFEX=$$REFFRE(DFN,BGPBDATE,BGPEDATE)
- +19 IF BGPREFEX
- SET BGPN6=1
- SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":";",1:"")_$PIECE(BGPREFEX,U,3)_" "_$PIECE(BGPREFEX,U,2)
- +20 SET BGPVALUE=$SELECT(BGPRTYPE=5:"",1:"UP")_$SELECT(BGPD1:",AC",1:"")_"|||"_BGPVALUE
- +21 IF BGPN2!(BGPN3)!(BGPN4)!(BGPN5)
- SET BGPN1=1
- +22 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
- +23 QUIT
- IEDA ;EP
- +1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
- +2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
- +3 ;FOR ELDER 20 NUMERATORS
- KILL BGPNUMV
- +4 IF BGPAGEB<65
- SET BGPSTOP=1
- QUIT
- +5 ;user pop
- SET BGPD4=1
- +6 ;active clinical
- IF BGPACTCL
- SET BGPD1=1
- +7 ;elder only wants active clinical
- IF BGPRTYPE=5
- IF 'BGPD1
- SET BGPSTOP=1
- QUIT
- +8 IF BGPD1
- IF BGPSEX="M"
- SET BGPD2=1
- +9 IF BGPD1
- IF BGPSEX="F"
- SET BGPD3=1
- +10 IF BGPD4
- IF BGPSEX="M"
- SET BGPD5=1
- +11 IF BGPD4
- IF BGPSEX="F"
- SET BGPD6=1
- +12 IF BGPAGEB>64
- IF BGPAGEB<75
- IF BGPD1
- SET BGPD7=1
- +13 IF BGPAGEB>74
- IF BGPAGEB<85
- IF BGPD1
- SET BGPD8=1
- +14 IF BGPAGEB>84
- IF BGPD1
- SET BGPD9=1
- +15 KILL BGPMEDS,BGPDAE
- +16 DO GETDAE(DFN,BGPBDATE,BGPEDATE,.BGPDAE,.BGPNUMV)
- +17 SET X=0
- SET C=0
- SET J=""
- FOR
- SET X=$ORDER(BGPDAE(X))
- IF X'=+X
- QUIT
- SET C=C+1
- SET J=J_$SELECT(J]"":"; ",1:"")_$$DATE^BGP2UTL($PIECE(BGPDAE(X),U,3))_" "_$PIECE(BGPDAE(X),U,2)_" ("_$PIECE(BGPDAE(X),U,4)_")"
- +18 IF C>0
- SET BGPN1=1
- +19 IF C>1
- SET BGPN2=1
- +20 FOR X=1:1:18
- IF '$DATA(BGPNUMV(X))
- SET BGPNUMV(X)=0
- +21 SET BGPVALUE="UP"
- +22 IF BGPRTYPE=3!(BGPRTYPE=5)
- SET BGPVALUE=""
- +23 SET BGPVALUE=BGPVALUE_$SELECT(BGPD1&(BGPVALUE]""):",AC",BGPD1&(BGPVALUE=""):"AC",1:"")_"|||"
- IF C
- SET BGPVALUE=BGPVALUE_C_" drug"_$SELECT(C>1:"s: ",1:":")_J
- +24 KILL BGPMEDS,BGPMEDS1,J,X,C,Y,BGPDAE
- +25 KILL ^TMP($JOB,"MEDS")
- +26 QUIT
- IBFR ;EP
- +1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
- +2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9)=0
- +3 SET (BGPV2,BGPV3,BGPV4,BGPV5,BGPV6)=""
- +4 SET BGPADAY=$$FMDIFF^XLFDT(BGPBDATE,$PIECE(^DPT(DFN,0),U,3))
- +5 IF BGPADAY<30
- SET BGPSTOP=1
- QUIT
- +6 IF BGPADAY>394
- SET BGPSTOP=1
- QUIT
- +7 IF 'BGPACTCL
- SET BGPSTOP=1
- QUIT
- +8 SET BGPD1=1
- +9 KILL BGPBFR
- +10 DO GETIFC(DFN,BGPBDATE,BGPEDATE,.BGPBFR)
- +11 ;has a screening
- IF $DATA(BGPBFR)
- SET BGPN1=1
- +12 ;n2
- +13 Begin DoDot:1
- +14 SET X=44
- SET G=""
- KILL Z
- FOR
- SET X=$ORDER(BGPBFR(X))
- IF X'=+X!(X>89)
- QUIT
- SET Z($$ABS^XLFMTH(X-60))=X
- +15 IF '$DATA(Z)
- QUIT
- +16 ;this is the lowest/closest to 60 days
- SET X=$ORDER(Z(""))
- SET X=Z(X)
- +17 SET BGPN2=1
- +18 SET Y=BGPBFR(X)
- +19 IF +Y=1!(+Y=2)
- SET BGPN6=1
- +20 SET BGPV2="2 MOS: "_X_" DO, "_$$DATE^BGP2UTL($PIECE(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- +21 SET G=1
- End DoDot:1
- +22 Begin DoDot:1
- +23 SET X=164
- SET G=""
- KILL Z
- FOR
- SET X=$ORDER(BGPBFR(X))
- IF X'=+X!(X>209)
- QUIT
- SET Z($$ABS^XLFMTH(X-180))=X
- +24 IF '$DATA(Z)
- QUIT
- +25 ;this is the lowest/closest to 180 days
- SET X=$ORDER(Z(""))
- SET X=Z(X)
- +26 SET BGPN3=1
- +27 SET Y=BGPBFR(X)
- +28 IF +Y=1!(+Y=2)
- SET BGPN7=1
- +29 SET BGPV3="6 MOS: "_X_" DO, "_$$DATE^BGP2UTL($PIECE(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- +30 SET G=1
- End DoDot:1
- +31 Begin DoDot:1
- +32 SET X=254
- SET G=""
- KILL Z
- FOR
- SET X=$ORDER(BGPBFR(X))
- IF X'=+X!(X>299)
- QUIT
- SET Z($$ABS^XLFMTH(X-270))=X
- +33 IF '$DATA(Z)
- QUIT
- +34 ;this is the lowest/closest to 270 days
- SET X=$ORDER(Z(""))
- SET X=Z(X)
- +35 SET BGPN4=1
- +36 SET Y=BGPBFR(X)
- +37 IF +Y=1!(+Y=2)
- SET BGPN8=1
- +38 SET BGPV4="9 MOS: "_X_" DO, "_$$DATE^BGP2UTL($PIECE(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- +39 SET G=1
- End DoDot:1
- +40 Begin DoDot:1
- +41 SET X=349
- SET G=""
- KILL Z
- FOR
- SET X=$ORDER(BGPBFR(X))
- IF X'=+X!(X>394)
- QUIT
- SET Z($$ABS^XLFMTH(X-365))=X
- +42 IF '$DATA(Z)
- QUIT
- +43 ;this is the lowest/closest to 365 days
- SET X=$ORDER(Z(""))
- SET X=Z(X)
- +44 SET BGPN5=1
- +45 SET Y=BGPBFR(X)
- +46 IF +Y=1!(+Y=2)
- SET BGPN9=1
- +47 SET BGPV5="1 YR: "_X_" DO, "_$$DATE^BGP2UTL($PIECE(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- +48 SET G=1
- End DoDot:1
- +49 ;,BGPVALUE=BGPVALUE_$S(BGPV2]""!(BGPV3]"")!(BGPV4]"")!(BGPV5)]"":": ",1:"")
- SET BGPVALUE=$SELECT(BGPN1=1:"Scrn: ",1:"")
- +50 SET C=0
- +51 IF BGPV2]""
- SET BGPVALUE=BGPVALUE_$SELECT(C=1:"; ",1:"")_BGPV2
- SET C=1
- +52 IF BGPV3]""
- SET BGPVALUE=BGPVALUE_$SELECT(C=1:"; ",1:"")_BGPV3
- SET C=1
- +53 IF BGPV4]""
- SET BGPVALUE=BGPVALUE_$SELECT(C=1:"; ",1:"")_BGPV4
- SET C=1
- +54 IF BGPV5]""
- SET BGPVALUE=BGPVALUE_$SELECT(C=1:"; ",1:"")_BGPV5
- SET C=1
- +55 IF BGPN1
- IF BGPV2=""
- IF BGPV3=""
- IF BGPV4=""
- IF BGPV5=""
- Begin DoDot:1
- +56 SET X=$ORDER(BGPBFR(""))
- SET Y=BGPBFR(X)
- SET BGPVALUE="Scrn: "_X_" DO, "_$$DATE^BGP2UTL($PIECE(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
- End DoDot:1
- +57 SET BGPVALUE="AC|||"_BGPVALUE
- +58 KILL BGPV1,BGPV2,BGPV3,BGPV4,BGPV5,BGPV6,BGPBFR
- +59 QUIT
- GETDAE(P,BDATE,EDATE,BGPRET,BGPRET1) ;EP
- +1 ;get all meds in all taxonomies
- +2 KILL BGPMEDS,BGPMEDST,BGPRET,BGPRET1
- +3 KILL BGPMEDS1
- SET BGPXXX="ANTIANXIETY"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIANXIETY MEDS","BGP HEDIS ANTIANXIETY NDC",,,.BGPMEDS1)
- +4 DO ADDINMED
- +5 IF BGPGOT
- SET BGPRET1(1)=1
- +6 KILL BGPMEDS1
- SET BGPXXX="ANTIEMETIC"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIEMETIC MEDS","BGP HEDIS ANTIEMETIC NDC",,,.BGPMEDS1)
- +7 DO ADDINMED
- +8 IF BGPGOT
- SET BGPRET1(2)=1
- +9 KILL BGPMEDS1
- SET BGPXXX="ANALGESIC"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANALGESIC MEDS","BGP HEDIS ANALGESIC NDC",,,.BGPMEDS1)
- +10 DO ADDINMED
- +11 IF BGPGOT
- SET BGPRET1(3)=1
- +12 KILL BGPMEDS1
- SET BGPXXX="ANTIHISTAMINE"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIHISTAMINE MEDS","BGP HEDIS ANTIHISTAMINE NDC",,,.BGPMEDS1)
- +13 DO ADDINMED
- +14 IF BGPGOT
- SET BGPRET1(4)=1
- +15 KILL BGPMEDS1
- SET BGPXXX="ANTIPSYCHOTIC"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIPSYCHOTIC MEDS","BGP HEDIS ANTIPSYCHOTIC NDC",,,.BGPMEDS1)
- +16 DO ADDINMED
- +17 IF BGPGOT
- SET BGPRET1(5)=1
- +18 KILL BGPMEDS1
- SET BGPXXX="AMPHETAMINE"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS AMPHETAMINE MEDS","BGP HEDIS AMPHETAMINE NDC",,,.BGPMEDS1)
- +19 DO ADDINMED
- +20 IF BGPGOT
- SET BGPRET1(6)=1
- +21 KILL BGPMEDS1
- SET BGPXXX="BARBITURATE"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BARBITURATE MEDS","BGP HEDIS BARBITURATE NDC",,,.BGPMEDS1)
- +22 DO ADDINMED
- +23 IF BGPGOT
- SET BGPRET1(7)=1
- +24 KILL BGPMEDS1
- SET BGPXXX="BENZODIAZEPINE"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BENZODIAZEPINE MEDS","BGP HEDIS BENZODIAZEPINE NDC",,,.BGPMEDS1)
- +25 DO ADDINMED
- +26 IF BGPGOT
- SET BGPRET1(8)=1
- +27 ;K BGPMEDS1 S BGPXXX="OTHER BENZODIAZEPNE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS OTHER BENZODIAZEPINE","BGP HEDIS OTHER BENZO NDC",,,.BGPMEDS1)
- +28 ;D ADDINMED
- +29 ;I BGPGOT S BGPRET1(9)=1
- +30 KILL BGPMEDS1
- SET BGPXXX="CALCIUM CHANNEL"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS CALCIUM CHANNEL MEDS","BGP HEDIS CALCIUM CHANNEL NDC",,,.BGPMEDS1)
- +31 DO ADDINMED
- +32 IF BGPGOT
- SET BGPRET1(10)=1
- +33 KILL BGPMEDS1
- SET BGPXXX="GASTRO ANTISPASM"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS GASTRO ANTISPASM MED","BGP HEDIS GASTRO ANTISPASM NDC",,,.BGPMEDS1)
- +34 DO ADDINMED
- +35 IF BGPGOT
- SET BGPRET1(11)=1
- +36 KILL BGPMEDS1
- SET BGPXXX="BELLADONNA"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BELLADONNA ALKA MEDS","BGP HEDIS BELLADONNA ALKA NDC",,,.BGPMEDS1)
- +37 DO ADDINMED
- +38 IF BGPGOT
- SET BGPRET1(12)=1
- +39 KILL BGPMEDS1
- SET BGPXXX="SKL MUSCLE"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS SKL MUSCLE RELAX MED","BGP HEDIS SKL MUSCLE RELAX NDC",,,.BGPMEDS1)
- +40 DO ADDINMED
- +41 IF BGPGOT
- SET BGPRET1(13)=1
- +42 KILL BGPMEDS1
- SET BGPXXX="ORAL ESTROGEN"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ORAL ESTROGEN MEDS","BGP HEDIS ORAL ESTROGEN NDC",,,.BGPMEDS1)
- +43 DO ADDINMED
- +44 IF BGPGOT
- SET BGPRET1(14)=1
- +45 KILL BGPMEDS1
- SET BGPXXX="ORAL HYPOGLYCEMIC"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ORAL HYPOGLYCEMIC RX","BGP HEDIS ORAL HYPOGLYCEMIC ND",,,.BGPMEDS1)
- +46 DO ADDINMED
- +47 IF BGPGOT
- SET BGPRET1(15)=1
- +48 KILL BGPMEDS1
- SET BGPXXX="NARCOTIC"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS NARCOTIC MEDS","BGP HEDIS NARCOTIC NDC",,,.BGPMEDS1)
- +49 DO ADDINMED
- +50 IF BGPGOT
- SET BGPRET1(16)=1
- +51 KILL BGPMEDS1
- SET BGPXXX="VASODILATOR"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS VASODILATOR MEDS","BGP HEDIS VASODILATOR NDC",,,.BGPMEDS1)
- +52 DO ADDINMED
- +53 IF BGPGOT
- SET BGPRET1(17)=1
- +54 KILL BGPMEDS1
- SET BGPXXX="OTHER MEDS"
- SET BGPGOT=0
- DO GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS OTHER MEDS AVOID ELD","BGP HEDIS OTHER NDC AVOID ELD",,,.BGPMEDS1)
- +55 DO ADDINMED
- +56 IF BGPGOT
- SET BGPRET1(18)=1
- +57 KILL BGPMEDS1
- +58 QUIT
- ADDINMED ;
- +1 SET X=0
- FOR
- SET X=$ORDER(BGPMEDS1(X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 ;vmed ien
- SET Y=$PIECE(BGPMEDS1(X),U,4)
- +3 IF '$DATA(^AUPNVMED(Y,0))
- QUIT
- +4 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
- QUIT
- +5 ;drug ien
- SET D=$PIECE(^AUPNVMED(Y,0),U,1)
- +6 ;DAYS SUPPLY MUST BE >0
- +7 ;date discontinued
- SET E=$PIECE(^AUPNVMED(Y,0),U,8)
- +8 ;DAYS SUPPLY
- SET S=$PIECE(^AUPNVMED(Y,0),U,7)
- +9 IF 'S
- QUIT
- +10 ;at least one day
- IF E
- IF E'>$PIECE(BGPMEDS1(X),U,1)
- QUIT
- +11 SET $PIECE(BGPRET(D),U)=$PIECE($GET(BGPRET(D)),U)+1
- +12 SET $PIECE(BGPRET(D),U,2)=$PIECE(^PSDRUG(D,0),U)
- +13 ;LAST FILL
- SET $PIECE(BGPRET(D),U,3)=$PIECE(BGPMEDS1(X),U,1)
- +14 SET $PIECE(BGPRET(D),U,4)=BGPXXX
- +15 SET BGPGOT=1
- +16 QUIT
- End DoDot:1
- +17 QUIT
- GETIFC(P,BDATE,EDATE,BGPRET) ;EP
- +1 KILL BGPRET,BGPG,C,X
- +2 SET X=0
- FOR
- SET X=$ORDER(^AUPNVIF("AC",P,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^AUPNVIF(X))
- QUIT
- +4 SET V=$PIECE(^AUPNVIF(X,0),U,3)
- SET C=$PIECE(^AUPNVIF(X,0),U,1)
- +5 IF V=""
- QUIT
- +6 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +7 SET V=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
- +8 ;I V<BDATE Q
- +9 ;I V>EDATE Q
- +10 SET BGPRET($$FMDIFF^XLFDT(V,$PIECE(^DPT(P,0),U,3)))=C_U_V
- +11 QUIT
- End DoDot:1
- +12 QUIT
- FALLEX(P,BDATE,EDATE) ;EP
- +1 NEW %,BGPG,E
- +2 KILL BGPG
- SET %=P_"^LAST EXAM 37;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(%,"BGPG(")
- +3 IF $DATA(BGPG(1))
- QUIT 1_"^Ex 37^"_$$DATE^BGP2UTL($PIECE(BGPG(1),U))
- +4 SET %=$$CPT^BGP2DU(P,BDATE,EDATE,$ORDER(^ATXAX("B","BGP FALL RISK EXAM CPTS",0)),6)
- +5 IF %
- QUIT "1^CPT "_$PIECE(%,U,3)_"^"_$$DATE^BGP2UTL($PIECE(%,U,2))
- +6 QUIT ""
- DHF(P,BDATE,EDATE) ;EP
- +1 KILL BGPG
- +2 SET Y="BGPG("
- +3 SET X=P_"^LAST DX [BGP HISTORY OF FALL DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,Y)
- +4 IF $DATA(BGPG(1))
- QUIT 1_U_"POV "_$PIECE(BGPG(1),U,2)_U_"Hx of Fall: "_$$DATE^BGP2UTL($PIECE(BGPG(1),U))
- +5 QUIT ""
- FID(P,BDATE,EDATE) ;EP
- +1 SET Y="BGPG("
- +2 KILL BGPG
- +3 SET X=P_"^ALL DX;DURING "_BDATE_-EDATE
- SET E=$$START1^APCLDF(X,Y)
- +4 SET G=""
- +5 SET T=$ORDER(^ATXAX("B","BGP FALL RELATED E-CODES",0))
- +6 SET X=0
- FOR
- SET X=$ORDER(BGPG(X))
- IF X'=+X!(G)
- QUIT
- Begin DoDot:1
- +7 SET Y=+$PIECE(BGPG(X),U,4)
- SET D=$PIECE(^AUPNVPOV(Y,0),U)
- +8 IF $PIECE(^AUPNVPOV(Y,0),U,9)=""
- IF $PIECE(^AUPNVPOV(Y,0),U,18)=""
- IF $PIECE(^AUPNVPOV(Y,0),U,19)=""
- QUIT
- +9 SET E=$PIECE(^AUPNVPOV(Y,0),U,9)
- IF E
- IF $$ICD^ATXCHK(E,T,9)
- SET G=1_U_"E-CODE "_$PIECE($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($PIECE(BGPG(X),U,1))
- QUIT
- +10 SET E=$PIECE(^AUPNVPOV(Y,0),U,18)
- IF E
- IF $$ICD^ATXCHK(E,T,9)
- SET G=1_U_"E-CODE "_$PIECE($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($PIECE(BGPG(X),U,1))
- QUIT
- +11 SET E=$PIECE(^AUPNVPOV(Y,0),U,19)
- IF E
- IF $$ICD^ATXCHK(E,T,9)
- SET G=1_U_"E-CODE "_$PIECE($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($PIECE(BGPG(X),U,1))
- QUIT
- End DoDot:1
- +12 IF G
- QUIT G
- +13 QUIT ""
- AGM(P,BDATE,EDATE) ;EP
- +1 SET BGPG=$$LASTDX^BGP2UTL1(P,"BGP ABNORMAL GAIT OR MOBILITY",BDATE,EDATE)
- +2 IF $PIECE(BGPG,U)
- QUIT 1_U_"POV "_$PIECE(BGPG,U,2)_U_"Abnormal Gait: "_$$DATE^BGP2UTL($PIECE(BGPG,U,3))
- +3 QUIT ""
- REFFRE(P,BDATE,EDATE) ;EP
- +1 ;add Refusal for exam 37
- +2 SET G=$$REFUSAL^BGP2UTL1(P,9999999.15,$ORDER(^AUTTEXAM("C",37,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
- +3 IF $PIECE(G,U)=1
- QUIT 1_"^Ex 37^"_"Refused "_$$DATE^BGP2UTL($PIECE(G,U,2))
- +4 QUIT ""