BGP6D1.m

BGP6D1 ; IHS/CMI/LAB - calc measures 21 Aug 2015 1:02 PM ; 12 Feb 2016  5:57 PM

 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170

 ;

PROC ;EP

 S BGPBT=$H

 D JRNL^BGP6UTL

 S BGPJ=$J,BGPH=$H

 K ^XTMP("BGP28CPL",BGPJ,BGPH)

 K ^XTMP("BGP15TAX",$J)

 D UNFOLDTX^BGP6UTL2

 D XTMP^BGP6UTL("BGP28CPL","National GPRA Comp List")

 D XTMP^BGP6UTL("BGP6DNP","National GPRA Patient List")

 D XTMP^BGP6UTL("BGP6D","CRS Local Patient List")

 ;S BGPICDTN=$S($T(ICDDX^ICDEX)]"":1,1:0)

 ;calculate 3 years before end of each time frame

 S BGP3YE=$$FMADD^XLFDT(BGPED,-1096)

 S BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)

 S BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)

 ;process each patient

 S DFN=0 F  S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN  D

 .Q:'$D(^AUPNPAT(DFN,0))

 .;I $G(BGPDESGP) S P=$$DP(DFN) I P'=BGPDESGP Q

 .Q:'$D(^DPT(DFN,0))

 .Q:$P($G(^DPT(DFN,0)),U)["DEMO,PATIENT"

 .S X=$O(^DIBT("B","RPMS DEMO PATIENT NAMES",0)) I X Q:$D(^DIBT(X,1,DFN))

 .I $O(BGPDESGP(0)) S P=$$DP(DFN) Q:'P  Q:'$D(BGPDESGP(P))  S BGPRPT=$P(BGPDESGP(P),U,1)

 .D PROCCY,PROCPY,PROCBY

N ;

 S BGPET=$H

 K ^XTMP("BGP15TAX",$J)

 Q

 ;

PROCCY ;EP - current time period

 K ^TMP($J)

 S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD,BGPHTN)=""

 K BGPG

 Q:'$D(^DPT(DFN,0))

 Q:$P(^DPT(DFN,0),U,2)=""

 Q:"FM"'[$P(^DPT(DFN,0),U,2)

 S BGPEDATE=BGPED,BGPTIME=1,BGPBDATE=BGPBD,BGPGBL=$S(BGPRTYPE=3:"^BGPHEDCB(",BGPRTYPE=5:"^BGPELDCM(",BGPRTYPE=8:"^BGPEOCB(",1:"^BGPGPDCM(")

 S BGP365=BGPBDATE

 I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGP3YE,BGPEDATE,BGPTAXI,BGPBEN) ;user pop

 I $G(BGPALLPT) S BGPACTUP=$$ACTUPAP(DFN,BGP3YE,BGPEDATE,BGPBEN)

 I 'BGPACTUP,'$G(BGPXPXPX),'$G(BGPIISO) Q

 S BGPACTCL=$$ACTCL(DFN,BGP3YE,BGPEDATE) ;active clinical

 S BGPACTCB=$$ACTCLBH(DFN,BGP3YE,BGPEDATE)  ;active clinical + BH

 S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)

 S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)

 S BGPSEX=$P(^DPT(DFN,0),U,2)

 I $G(BGPIISO)=1 S BGPACTUP=1,BGPACTCL=1  ;if in scheduling option, everyone is user pop/active clinical

 S BGPDM1=$$DM(DFN,,BGPEDATE) ;dm diagnosis ever?

 S BGPDM2=$$DM(DFN,BGPBDATE,BGPEDATE) ;dm diagnosis in past year

 I BGPDM1 D  ;set up 4 dm demoninators

 .S BGPFDMD=$$FIRSTDM(DFN,BGPEDATE) ;1 OR 0 FIRST DX BEFORE BEG

 .S BGP2V=$$V2(DFN,BGPBDATE,BGPEDATE)

 .S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)

 .S BGPYDMV=$$V1DM(DFN,BGPBDATE,BGPEDATE)

 .S BGPDMD1=0 I BGPFDMD S BGPDMD1=1

 .S BGPDMD2=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTCL S BGPDMD2=1

 .S BGPDMD3=0 I BGPFDMD,BGPAGEB>19,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1

 .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1

 I $G(BGPXPRP) Q  ;stop if in national gpra export

 I $G(BGPIISO) D ISS^BGP6DPA1 K ^TMP($J,"A") Q  ;SCHEDULING OPTION

 D CALCIND

 K ^TMP($J,"A")

 Q

PROCPY ;

 K ^TMP($J),BGPG

 S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD)=""

 Q:'$D(^DPT(DFN,0))

 Q:$P(^DPT(DFN,0),U,2)=""

 Q:"FM"'[$P(^DPT(DFN,0),U,2)

 S BGPEDATE=BGPPED,BGPTIME=2,BGPBDATE=BGPPBD,BGPGBL=$S(BGPRTYPE=3:"^BGPHEDPB(",BGPRTYPE=5:"^BGPELDPM(",BGPRTYPE=8:"^BGPEOPB(",1:"^BGPGPDPM(")

 S BGP365=BGPBDATE

 I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGPP3YE,BGPEDATE,BGPTAXI,BGPBEN) ;user pop

 I $G(BGPALLPT) S BGPACTUP=$$ACTUPAP(DFN,BGPP3YE,BGPEDATE,BGPBEN)

 I 'BGPACTUP Q  ;if not in user pop, don't use patient

 S BGPACTCL=$$ACTCL(DFN,BGPP3YE,BGPEDATE) ;active clinical

 S BGPACTCB=$$ACTCLBH(DFN,BGP3YE,BGPEDATE)  ;active clinical + BH

 S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)

 S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)

 S BGPSEX=$P(^DPT(DFN,0),U,2)

 ;I $$V2IHD^BGP6D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP6D9(DFN,BGPEDATE) S BGPIHD=1

 S BGPDM1=$$DM(DFN,,BGPEDATE) ;dm diagnosis ever?

 S BGPDM2=$$DM(DFN,BGPBDATE,BGPEDATE) ;dm diagnosis in past year

 I BGPDM1 D  ;set up 4 dm demoninators

 .S BGPFDMD=$$FIRSTDM(DFN,BGPEDATE) ;1 OR 0 FIRST DX BEFORE BEG

 .S BGP2V=$$V2(DFN,BGPBDATE,BGPEDATE)

 .S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)

 .S BGPYDMV=$$V1DM(DFN,BGPBDATE,BGPEDATE)

 .S BGPDMD1=0 I BGPFDMD S BGPDMD1=1

 .S BGPDMD2=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTCL S BGPDMD2=1

 .S BGPDMD3=0 I BGPFDMD,BGPAGEB>19,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1

 .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1

 D CALCIND

 K ^TMP($J)

 Q

PROCBY ;

 K ^TMP($J),BGPG

 S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD)=""

 Q:'$D(^DPT(DFN,0))

 Q:$P(^DPT(DFN,0),U,2)=""

 Q:"FM"'[$P(^DPT(DFN,0),U,2)

 S BGPEDATE=BGPBED,BGPTIME=3,BGPBDATE=BGPBBD,BGPGBL=$S(BGPRTYPE=3:"^BGPHEDBB(",BGPRTYPE=5:"^BGPELDBM(",BGPRTYPE=8:"^BGPEOBB(",1:"^BGPGPDBM(")

 S BGP365=BGPBDATE

 I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGPB3YE,BGPEDATE,BGPTAXI,BGPBEN) ;user pop

 I $G(BGPALLPT) S BGPACTUP=$$ACTUPAP(DFN,BGPB3YE,BGPEDATE,BGPBEN)

 I 'BGPACTUP Q  ;if not in user pop, don't use patient

 S BGPACTCL=$$ACTCL(DFN,BGPB3YE,BGPEDATE) ;active clinical

 S BGPACTCB=$$ACTCLBH(DFN,BGP3YE,BGPEDATE)  ;active clinical + BH

 S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)

 S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)

 S BGPSEX=$P(^DPT(DFN,0),U,2)

 S BGPDM1=$$DM(DFN,,BGPEDATE) ;dm diagnosis ever?

 S BGPDM2=$$DM(DFN,BGPBDATE,BGPEDATE) ;dm diagnosis in past year

 I BGPDM1 D  ;set up 4 dm demoninators

 .S BGPFDMD=$$FIRSTDM(DFN,BGPEDATE) ;1 OR 0 FIRST DX BEFORE BEG

 .S BGP2V=$$V2(DFN,BGPBDATE,BGPEDATE)

 .S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)

 .S BGPYDMV=$$V1DM(DFN,BGPBDATE,BGPEDATE)

 .S BGPDMD1=0 I BGPFDMD S BGPDMD1=1

 .S BGPDMD2=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTCL S BGPDMD2=1

 .S BGPDMD3=0 I BGPFDMD,BGPAGEB>19,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1

 .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1

 D CALCIND

 K ^TMP($J)

 Q

CALCIND ;

 I BGPRTYPE=5 D CALCIND^BGP6DCEI Q

 D CALCIND^BGP6DCI

 Q

CREAT(P,EDATE) ;get all creatines all must be <5

 NEW BGPG,%,X,E,R,T,V,J

 S %=P_"^ALL LAB [DM AUDIT CREATININE TAX;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 S X=0,E=1 F  S X=$O(BGPG(X)) Q:X'=+X  S R=$P(BGPG(X),U,2) I +R>5,+R<15 S E=""

 I E="" Q E

 S T=$O(^ATXAX("B","BGP CREATININE LOINC CODES",0))

 I 'T Q E

 S X=0 F  S X=$O(^AUPNVLAB("AC",P,X)) Q:X'=+X!(E="")  I $P($G(^AUPNVLAB(X,11)),U,13)]"" D

 .Q:'$D(^AUPNVLAB(X,0))

 .S V=$P(^AUPNVLAB(X,0),U,3),V=$P($G(^AUPNVSIT(V,0)),U,1),V=$P(V,".")

 .Q:V>EDATE

 .S J=$P(^AUPNVLAB(X,11),U,13)

 .Q:'$$LOINC(J,T)

 .Q:$P(^AUPNVLAB(X,0),U,4)=""

 .S R=$P(^AUPNVLAB(X,0),U,4)

 .I +R>5,+R<15 S E=""

 Q E

V1DM(P,D,EDATE) ;

 I '$G(P) Q ""

 I '$D(^AUPNVSIT("AC",P)) Q ""

 S PC=$O(^ATXAX("B","BGP PRIMARY CARE CLINICS",0))

 I 'PC Q ""

 ;I 'PP Q ""

 K ^TMP($J,"A")

 NEW A,B,T,X,G,V,Y

 S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(D)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)

 I '$D(^TMP($J,"A",1)) Q ""

 S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))

 I 'T Q ""

 S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>2)  S V=$P(^TMP($J,"A",X),U,5) D

 .Q:'$D(^AUPNVSIT(V,0))

 .Q:'$P(^AUPNVSIT(V,0),U,9)

 .Q:$P(^AUPNVSIT(V,0),U,11)

 .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)

 .Q:$P(^AUPNVSIT(V,0),U,6)=""

 .Q:'$D(^AUPNVPRV("AD",V))

 .;Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2) ;PER TERRY

 .Q:'$D(^AUPNVPOV("AD",V))

 .S (D,Y)=0 F  S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D)  I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^BGP6UTL2(%,T,9) S D=1

 .Q:'D

 .Q:"V"[$P(^AUPNVSIT(V,0),U,3)

 .S Y=$$PRIMPROV^APCLV(V,"F")

 .Q:'Y

 .;Q:'$D(^ATXAX(PP,21,"B",Y))

 .Q:$P($G(^DIC(7,Y,9999999)),U,3)'="Y"

 .S Y=$$CLINIC^APCLV(V,"I")

 .Q:'Y

 .Q:'$D(^ATXAX(PC,21,"B",Y))

 .S G=G+1

 .Q

 Q $S(G<1:"",1:1)

 ;

V2(P,BDATE,EDATE) ;EP

 I '$D(^AUPNVSIT("AC",P)) Q ""

 K ^TMP($J,"A")

 NEW A,B,X,G,V

 S R=$NA(^TMP($J,"A"))

 D ALLV^APCLAPIU(P,BDATE,EDATE,R)

 I '$D(^TMP($J,"A",1)) Q ""

 S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>1)  S V=$P(^TMP($J,"A",X),U,5) D

 .Q:'$D(^AUPNVSIT(V,0))

 .Q:'$P(^AUPNVSIT(V,0),U,9)

 .Q:$P(^AUPNVSIT(V,0),U,11)

 .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)

 .Q:"V"[$P(^AUPNVSIT(V,0),U,3)

 .Q:$P(^AUPNVSIT(V,0),U,6)=""

 .S G=G+1

 .Q

 Q $S(G<2:"",1:1)

 ;

V2DM(P,BDATE,EDATE) ;EP

 ;P is Patient DFN

 ;BDATE  - beginning date to look default is DOB

 ;EDATE - end date to look default is DT

 I '$G(P) Q ""

 I '$D(^AUPNVSIT("AC",P)) Q ""  ;patient has no visits

 I '$G(BDATE) S BDATE=$$DOB^AUPNPAT(P)

 I '$G(EDATE) S EDATE=DT

 NEW T,BIREFN,PDA,PIEN,CDX,VST,VDT,IBDATE,IEDATE,V,G

 S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))

 I 'T Q ""

 S IBDATE=9999999-BDATE

 S IEDATE=9999999-EDATE

 S G=0

 K V

 S PDA=IEDATE-1 F  S PDA=$O(^AUPNVPOV("AA",P,PDA)) Q:'PDA!(PDA>IBDATE)!(G>1)  D

 . S PIEN=0 F  S PIEN=$O(^AUPNVPOV("AA",P,PDA,PIEN)) Q:'PIEN  D

 .. S CDX=$P($G(^AUPNVPOV(PIEN,0)),U)

 .. Q:'CDX

 .. Q:'$$ICD^BGP6UTL2(CDX,T,9)

 .. S VST=$P($G(^AUPNVPOV(PIEN,0)),U,3)

 .. Q:'VST

 .. Q:'$D(^AUPNVSIT(VST,0))

 .. Q:"SAHO"'[$P(^AUPNVSIT(VST,0),U,7)  ;ELIMINATE TELEPHONE CALLS, CHART REVIEWS, ETC

 .. Q:$P(^AUPNVSIT(VST,0),U,3)="V"

 .. I '$D(V(VST)) S V(VST)="",G=G+1

 Q $S(G<2:"",1:1)

 ;**********

 ;

DM(P,BDATE,EDATE) ;EP is patient diabetic 1 or 0

 I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)

 NEW BGPG

 S BGPG(1)=$$LASTDX^BGP6UTL1(P,"SURVEILLANCE DIABETES",BDATE,EDATE)

 I BGPG(1) Q 1  ;has a dx

 Q 0

 ;

ACTUPAP(P,BDATE,EDATE,B) ;EP - is this patient in user pop?

 NEW X

 I B=1,$$BEN^AUPNPAT(P,"C")'="01" Q 0  ;must be Indian/Alaskan Native

 I B=2,$$BEN^AUPNPAT(P,"C")="01" Q 0  ;must not be I/A

 S DOD=$$DOD^AUPNPAT(P) I DOD]"",DOD<EDATE Q 0

 S X=$$LASTVD(P,BDATE,EDATE)

 Q $S(X:1,1:0)

 ;

ACTUP(P,BDATE,EDATE,T,B) ;EP - is this patient in user pop?

 NEW X,DOD

 I B=1,$$BEN^AUPNPAT(P,"C")'="01" Q 0  ;must be Indian/Alaskan Native

 I B=2,$$BEN^AUPNPAT(P,"C")="01" Q 0  ;must not be I/A

 S DOD=$$DOD^AUPNPAT(P) I DOD]"",DOD<EDATE Q 0

 S X=$P($G(^AUPNPAT(P,11)),U,18) I X="" Q 0

 I '$D(^ATXAX(T,21,"B",($P(^AUPNPAT(P,11),U,18)))),'$D(^ATXAX(T,21,"AA",$P(^AUPNPAT(P,11),U,18),$P(^AUPNPAT(P,11),U,18))) Q 0

 S X=$$LASTVD(P,BDATE,EDATE)

 Q $S(X:1,1:0)

 ;

ACTCL(P,BDATE,EDATE) ;EP - clinical user

 S (X,G,F,S)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F)  S V=$P(^TMP($J,"A",X),U,5) D

 .Q:'$D(^AUPNVSIT(V,0))

 .Q:'$P(^AUPNVSIT(V,0),U,9)

 .Q:$P(^AUPNVSIT(V,0),U,11)

 .Q:'$D(^AUPNVPRV("AD",V))

 .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)

 .Q:"V"[$P(^AUPNVSIT(V,0),U,3)

 .Q:$P(^AUPNVSIT(V,0),U,6)=""

 .S B=$$CLINIC^APCLV(V,"C")

 .Q:B=""

 .I 'G,$D(^BGPCTRL($O(^BGPCTRL("B",2016,0)),11,"B",B)) S G=V  ;must be a primary clinic S G=V

 .I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2016,0)),12,"B",B)) S S=1

 .I G,S S F=1

 .Q

 Q $S(F:1,1:0)

ACTCLBH(P,BDATE,EDATE) ;EP - clinical user

 S (X,G,F,S)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F)  S V=$P(^TMP($J,"A",X),U,5) D

 .Q:'$D(^AUPNVSIT(V,0))

 .Q:'$P(^AUPNVSIT(V,0),U,9)

 .Q:$P(^AUPNVSIT(V,0),U,11)

 .Q:'$D(^AUPNVPRV("AD",V))

 .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)

 .Q:"V"[$P(^AUPNVSIT(V,0),U,3)

 .Q:$P(^AUPNVSIT(V,0),U,6)=""

 .S B=$$CLINIC^APCLV(V,"C")

 .Q:B=""

 .I 'G,$D(^BGPCTRL($O(^BGPCTRL("B",2016,0)),11,"B",B)) S G=V  ;must be a primary clinic S G=V

 .I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2016,0)),95,"B",B)) S S=1

 .I G,S S F=1

 .Q

 Q $S(F:1,1:0)

FIRSTDM(P,EDATE) ;

 I $G(P)="" Q ""

 K BGPG

 S Y="BGPG("

 S X=P_"^FIRST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)

 I '$D(BGPG(1)) Q ""

 S X=$$FMDIFF^XLFDT(EDATE,$P(BGPG(1),U))

 Q $S(X>365:1,1:"")

 ;

LASTVD(P,BDATE,EDATE) ;

 I '$D(^AUPNVSIT("AC",P)) Q ""

 K ^TMP($J,"A")

 S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)

 I '$D(^TMP($J,"A",1)) Q ""

 S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  S V=$P(^TMP($J,"A",X),U,5) D

 .Q:'$D(^AUPNVSIT(V,0))

 .Q:'$P(^AUPNVSIT(V,0),U,9)

 .Q:$P(^AUPNVSIT(V,0),U,11)

 .Q:'$D(^AUPNVPRV("AD",V))

 .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)

 .Q:"V"[$P(^AUPNVSIT(V,0),U,3)

 .Q:$P(^AUPNVSIT(V,0),U,6)=""

 .S G=1

 .Q

 Q G

 ;

LOINC(A,B) ;

 NEW %

 S %=$P($G(^LAB(95.3,A,9999999)),U,2)

 I %]"",$D(^ATXAX(B,21,"B",%)) Q 1

 S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)

 I $D(^ATXAX(B,21,"B",%)) Q 1

 Q ""

DP(P) ;

 I $P(^AUPNPAT(P,0),U,14) Q $P(^AUPNPAT(P,0),U,14)

 I $T(ALLDP^BDPAPI)="" Q ""

 NEW X

 D ALLDP^BDPAPI(P,"DESIGNATED PRIMARY PROVIDER",.X)

 Q $P($G(X("DESIGNATED PRIMARY PROVIDER")),U,2)

BGP6D1    ; IHS/CMI/LAB - calc measures 21 Aug 2015 1:02 PM ; 12 Feb 2016  5:57 PM

 +1       ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170

 +2       ;

PROC      ;EP

 +1        SET BGPBT=$HOROLOG

 +2        DO JRNL^BGP6UTL

 +3        SET BGPJ=$JOB

           SET BGPH=$HOROLOG

 +4        KILL ^XTMP("BGP28CPL",BGPJ,BGPH)

 +5        KILL ^XTMP("BGP15TAX",$JOB)

 +6        DO UNFOLDTX^BGP6UTL2

 +7        DO XTMP^BGP6UTL("BGP28CPL","National GPRA Comp List")

 +8        DO XTMP^BGP6UTL("BGP6DNP","National GPRA Patient List")

 +9        DO XTMP^BGP6UTL("BGP6D","CRS Local Patient List")

 +10      ;S BGPICDTN=$S($T(ICDDX^ICDEX)]"":1,1:0)

 +11      ;calculate 3 years before end of each time frame

 +12       SET BGP3YE=$$FMADD^XLFDT(BGPED,-1096)

 +13       SET BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)

 +14       SET BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)

 +15      ;process each patient

 +16       SET DFN=0

           FOR 

               SET DFN=$ORDER(^AUPNPAT(DFN))

               IF DFN'=+DFN

                   QUIT 

               Begin DoDot:1

 +17               IF '$DATA(^AUPNPAT(DFN,0))

                       QUIT 

 +18      ;I $G(BGPDESGP) S P=$$DP(DFN) I P'=BGPDESGP Q

 +19               IF '$DATA(^DPT(DFN,0))

                       QUIT 

 +20               IF $PIECE($GET(^DPT(DFN,0)),U)["DEMO,PATIENT"

                       QUIT 

 +21               SET X=$ORDER(^DIBT("B","RPMS DEMO PATIENT NAMES",0))

                   IF X

                       IF $DATA(^DIBT(X,1,DFN))

                           QUIT 

 +22               IF $ORDER(BGPDESGP(0))

                       SET P=$$DP(DFN)

                       IF 'P

                           QUIT 

                       IF '$DATA(BGPDESGP(P))

                           QUIT 

                       SET BGPRPT=$PIECE(BGPDESGP(P),U,1)

 +23               DO PROCCY

                   DO PROCPY

                   DO PROCBY

               End DoDot:1

N         ;

 +1        SET BGPET=$HOROLOG

 +2        KILL ^XTMP("BGP15TAX",$JOB)

 +3        QUIT 

 +4       ;

PROCCY    ;EP - current time period

 +1        KILL ^TMP($JOB)

 +2        SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD,BGPHTN)=""

 +3        KILL BGPG

 +4        IF '$DATA(^DPT(DFN,0))

               QUIT 

 +5        IF $PIECE(^DPT(DFN,0),U,2)=""

               QUIT 

 +6        IF "FM"'[$PIECE(^DPT(DFN,0),U,2)

               QUIT 

 +7        SET BGPEDATE=BGPED

           SET BGPTIME=1

           SET BGPBDATE=BGPBD

           SET BGPGBL=$SELECT(BGPRTYPE=3:"^BGPHEDCB(",BGPRTYPE=5:"^BGPELDCM(",BGPRTYPE=8:"^BGPEOCB(",1:"^BGPGPDCM(")

 +8        SET BGP365=BGPBDATE

 +9       ;user pop

           IF '$GET(BGPALLPT)

               SET BGPACTUP=$$ACTUP(DFN,BGP3YE,BGPEDATE,BGPTAXI,BGPBEN)

 +10       IF $GET(BGPALLPT)

               SET BGPACTUP=$$ACTUPAP(DFN,BGP3YE,BGPEDATE,BGPBEN)

 +11       IF 'BGPACTUP

               IF '$GET(BGPXPXPX)

                   IF '$GET(BGPIISO)

                       QUIT 

 +12      ;active clinical

           SET BGPACTCL=$$ACTCL(DFN,BGP3YE,BGPEDATE)

 +13      ;active clinical + BH

           SET BGPACTCB=$$ACTCLBH(DFN,BGP3YE,BGPEDATE)

 +14       SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)

 +15       SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)

 +16       SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)

 +17      ;if in scheduling option, everyone is user pop/active clinical

           IF $GET(BGPIISO)=1

               SET BGPACTUP=1

               SET BGPACTCL=1

 +18      ;dm diagnosis ever?

           SET BGPDM1=$$DM(DFN,,BGPEDATE)

 +19      ;dm diagnosis in past year

           SET BGPDM2=$$DM(DFN,BGPBDATE,BGPEDATE)

 +20      ;set up 4 dm demoninators

           IF BGPDM1

               Begin DoDot:1

 +21      ;1 OR 0 FIRST DX BEFORE BEG

                   SET BGPFDMD=$$FIRSTDM(DFN,BGPEDATE)

 +22               SET BGP2V=$$V2(DFN,BGPBDATE,BGPEDATE)

 +23               SET BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)

 +24               SET BGPYDMV=$$V1DM(DFN,BGPBDATE,BGPEDATE)

 +25               SET BGPDMD1=0

                   IF BGPFDMD

                       SET BGPDMD1=1

 +26               SET BGPDMD2=0

                   IF BGPFDMD

                       IF BGP2V

                           IF BGP2DMV

                               IF BGPACTCL

                                   SET BGPDMD2=1

 +27               SET BGPDMD3=0

                   IF BGPFDMD

                       IF BGPAGEB>19

                           IF BGP2DMV

                               IF BGPYDMV

                                   IF $$CREAT(DFN,BGPEDATE)

                                       SET BGPDMD3=1

 +28               SET BGPDMD5=0

                   IF BGPFDMD

                       IF BGP2DMV

                           IF BGPYDMV

                               IF $$CREAT(DFN,BGPEDATE)

                                   SET BGPDMD5=1

               End DoDot:1

 +29      ;stop if in national gpra export

           IF $GET(BGPXPRP)

               QUIT 

 +30      ;SCHEDULING OPTION

           IF $GET(BGPIISO)

               DO ISS^BGP6DPA1

               KILL ^TMP($JOB,"A")

               QUIT 

 +31       DO CALCIND

 +32       KILL ^TMP($JOB,"A")

 +33       QUIT 

PROCPY    ;

 +1        KILL ^TMP($JOB),BGPG

 +2        SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD)=""

 +3        IF '$DATA(^DPT(DFN,0))

               QUIT 

 +4        IF $PIECE(^DPT(DFN,0),U,2)=""

               QUIT 

 +5        IF "FM"'[$PIECE(^DPT(DFN,0),U,2)

               QUIT 

 +6        SET BGPEDATE=BGPPED

           SET BGPTIME=2

           SET BGPBDATE=BGPPBD

           SET BGPGBL=$SELECT(BGPRTYPE=3:"^BGPHEDPB(",BGPRTYPE=5:"^BGPELDPM(",BGPRTYPE=8:"^BGPEOPB(",1:"^BGPGPDPM(")

 +7        SET BGP365=BGPBDATE

 +8       ;user pop

           IF '$GET(BGPALLPT)

               SET BGPACTUP=$$ACTUP(DFN,BGPP3YE,BGPEDATE,BGPTAXI,BGPBEN)

 +9        IF $GET(BGPALLPT)

               SET BGPACTUP=$$ACTUPAP(DFN,BGPP3YE,BGPEDATE,BGPBEN)

 +10      ;if not in user pop, don't use patient

           IF 'BGPACTUP

               QUIT 

 +11      ;active clinical

           SET BGPACTCL=$$ACTCL(DFN,BGPP3YE,BGPEDATE)

 +12      ;active clinical + BH

           SET BGPACTCB=$$ACTCLBH(DFN,BGP3YE,BGPEDATE)

 +13       SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)

 +14       SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)

 +15       SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)

 +16      ;I $$V2IHD^BGP6D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP6D9(DFN,BGPEDATE) S BGPIHD=1

 +17      ;dm diagnosis ever?

           SET BGPDM1=$$DM(DFN,,BGPEDATE)

 +18      ;dm diagnosis in past year

           SET BGPDM2=$$DM(DFN,BGPBDATE,BGPEDATE)

 +19      ;set up 4 dm demoninators

           IF BGPDM1

               Begin DoDot:1

 +20      ;1 OR 0 FIRST DX BEFORE BEG

                   SET BGPFDMD=$$FIRSTDM(DFN,BGPEDATE)

 +21               SET BGP2V=$$V2(DFN,BGPBDATE,BGPEDATE)

 +22               SET BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)

 +23               SET BGPYDMV=$$V1DM(DFN,BGPBDATE,BGPEDATE)

 +24               SET BGPDMD1=0

                   IF BGPFDMD

                       SET BGPDMD1=1

 +25               SET BGPDMD2=0

                   IF BGPFDMD

                       IF BGP2V

                           IF BGP2DMV

                               IF BGPACTCL

                                   SET BGPDMD2=1

 +26               SET BGPDMD3=0

                   IF BGPFDMD

                       IF BGPAGEB>19

                           IF BGP2DMV

                               IF BGPYDMV

                                   IF $$CREAT(DFN,BGPEDATE)

                                       SET BGPDMD3=1

 +27               SET BGPDMD5=0

                   IF BGPFDMD

                       IF BGP2DMV

                           IF BGPYDMV

                               IF $$CREAT(DFN,BGPEDATE)

                                   SET BGPDMD5=1

               End DoDot:1

 +28       DO CALCIND

 +29       KILL ^TMP($JOB)

 +30       QUIT 

PROCBY    ;

 +1        KILL ^TMP($JOB),BGPG

 +2        SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD)=""

 +3        IF '$DATA(^DPT(DFN,0))

               QUIT 

 +4        IF $PIECE(^DPT(DFN,0),U,2)=""

               QUIT 

 +5        IF "FM"'[$PIECE(^DPT(DFN,0),U,2)

               QUIT 

 +6        SET BGPEDATE=BGPBED

           SET BGPTIME=3

           SET BGPBDATE=BGPBBD

           SET BGPGBL=$SELECT(BGPRTYPE=3:"^BGPHEDBB(",BGPRTYPE=5:"^BGPELDBM(",BGPRTYPE=8:"^BGPEOBB(",1:"^BGPGPDBM(")