BGP5D1 ; IHS/CMI/LAB - calc measures ; 06 Apr 2015 2:35 PM
;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
;
PROC ;EP
S BGPBT=$H
D JRNL^BGP5UTL
S BGPJ=$J,BGPH=$H
K ^XTMP("BGP28CPL",BGPJ,BGPH)
K ^XTMP("BGP15TAX",$J)
D UNFOLDTX^BGP5UTL2
D XTMP^BGP5UTL("BGP28CPL","National GPRA Comp List")
D XTMP^BGP5UTL("BGP5DNP","National GPRA Patient List")
D XTMP^BGP5UTL("BGP5D","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
.;I DUZ=2881,'$D(^DIBT(14173,1,DFN)) Q
.;I DUZ=2881,DFN'=26214 Q ;599
.;I DUZ=2881 Q:DFN'=116831
.;I DUZ=2881 Q:$$HRN^AUPNPAT(DFN,DUZ(2))'=145905
.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:"^BGPELDCK(",BGPRTYPE=8:"^BGPEOCB(",1:"^BGPGPDCK(")
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,BGP365,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,BGP365,BGPEDATE)
.S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
.S BGPYDMV=$$V1DM(DFN,BGP365,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^BGP5DPA1 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:"^BGPELDPK(",BGPRTYPE=8:"^BGPEOPB(",1:"^BGPGPDPK(")
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^BGP5D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP5D9(DFN,BGPEDATE) S BGPIHD=1
S BGPDM1=$$DM(DFN,,BGPEDATE) ;dm diagnosis ever?
S BGPDM2=$$DM(DFN,BGP365,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,BGP365,BGPEDATE)
.S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
.S BGPYDMV=$$V1DM(DFN,BGP365,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:"^BGPELDBK(",BGPRTYPE=8:"^BGPEOBB(",1:"^BGPGPDBK(")
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,BGP365,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,BGP365,BGPEDATE)
.S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
.S BGPYDMV=$$V1DM(DFN,BGP365,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^BGP5DCEI Q
D CALCIND^BGP5DCI
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^BGP5UTL2(%,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 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>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:"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) ;
I '$G(P) Q ""
I '$D(^AUPNVSIT("AC",P)) Q ""
K ^TMP($J,"A")
NEW A,B,E,T,G,V,Y
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 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:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.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^BGP5UTL2(%,T,9) S D=1
.Q:'D
.S G=G+1
.Q
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 Y="BGPG("
S X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(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",2015,0)),11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2015,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",2015,0)),11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2015,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)
BGP5D1 ; IHS/CMI/LAB - calc measures ; 06 Apr 2015 2:35 PM
+1 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
+2 ;
PROC ;EP
+1 SET BGPBT=$HOROLOG
+2 DO JRNL^BGP5UTL
+3 SET BGPJ=$JOB
SET BGPH=$HOROLOG
+4 KILL ^XTMP("BGP28CPL",BGPJ,BGPH)
+5 KILL ^XTMP("BGP15TAX",$JOB)
+6 DO UNFOLDTX^BGP5UTL2
+7 DO XTMP^BGP5UTL("BGP28CPL","National GPRA Comp List")
+8 DO XTMP^BGP5UTL("BGP5DNP","National GPRA Patient List")
+9 DO XTMP^BGP5UTL("BGP5D","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 ;I DUZ=2881,'$D(^DIBT(14173,1,DFN)) Q
+18 ;I DUZ=2881,DFN'=26214 Q ;599
+19 ;I DUZ=2881 Q:DFN'=116831
+20 ;I DUZ=2881 Q:$$HRN^AUPNPAT(DFN,DUZ(2))'=145905
+21 IF '$DATA(^AUPNPAT(DFN,0))
QUIT
+22 ;I $G(BGPDESGP) S P=$$DP(DFN) I P'=BGPDESGP Q
+23 IF '$DATA(^DPT(DFN,0))
QUIT
+24 IF $PIECE($GET(^DPT(DFN,0)),U)["DEMO,PATIENT"
QUIT
+25 SET X=$ORDER(^DIBT("B","RPMS DEMO PATIENT NAMES",0))
IF X
IF $DATA(^DIBT(X,1,DFN))
QUIT
+26 IF $ORDER(BGPDESGP(0))
SET P=$$DP(DFN)
IF 'P
QUIT
IF '$DATA(BGPDESGP(P))
QUIT
SET BGPRPT=$PIECE(BGPDESGP(P),U,1)
+27 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:"^BGPELDCK(",BGPRTYPE=8:"^BGPEOCB(",1:"^BGPGPDCK(")
+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,BGP365,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,BGP365,BGPEDATE)
+23 SET BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+24 SET BGPYDMV=$$V1DM(DFN,BGP365,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^BGP5DPA1
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:"^BGPELDPK(",BGPRTYPE=8:"^BGPEOPB(",1:"^BGPGPDPK(")
+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^BGP5D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP5D9(DFN,BGPEDATE) S BGPIHD=1
+17 ;dm diagnosis ever?
SET BGPDM1=$$DM(DFN,,BGPEDATE)
+18 ;dm diagnosis in past year
SET BGPDM2=$$DM(DFN,BGP365,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,BGP365,BGPEDATE)
+22 SET BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+23 SET BGPYDMV=$$V1DM(DFN,BGP365,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:"^BGPELDBK(",BGPRTYPE=8:"^BGPEOBB(",1:"^BGPGPDBK(")
+7 SET BGP365=BGPBDATE
+8 ;user pop
IF '$GET(BGPALLPT)
SET BGPACTUP=$$ACTUP(DFN,BGPB3YE,BGPEDATE,BGPTAXI,BGPBEN)
+9 IF $GET(BGPALLPT)
SET BGPACTUP=$$ACTUPAP(DFN,BGPB3YE,BGPEDATE,BGPBEN)
+10 ;if not in user pop, don't use patient
IF 'BGPACTUP
QUIT
+11 ;active clinical
SET BGPACTCL=$$ACTCL(DFN,BGPB3YE,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 ;dm diagnosis ever?
SET BGPDM1=$$DM(DFN,,BGPEDATE)
+17 ;dm diagnosis in past year
SET BGPDM2=$$DM(DFN,BGP365,BGPEDATE)
+18 ;set up 4 dm demoninators
IF BGPDM1
Begin DoDot:1
+19 ;1 OR 0 FIRST DX BEFORE BEG
SET BGPFDMD=$$FIRSTDM(DFN,BGPEDATE)
+20 SET BGP2V=$$V2(DFN,BGP365,BGPEDATE)
+21 SET BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+22 SET BGPYDMV=$$V1DM(DFN,BGP365,BGPEDATE)
+23 SET BGPDMD1=0
IF BGPFDMD
SET BGPDMD1=1
+24 SET BGPDMD2=0
IF BGPFDMD
IF BGP2V
IF BGP2DMV
IF BGPACTCL
SET BGPDMD2=1
+25 SET BGPDMD3=0
IF BGPFDMD
IF BGPAGEB>19
IF BGP2DMV
IF BGPYDMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD3=1
+26 SET BGPDMD5=0
IF BGPFDMD
IF BGP2DMV
IF BGPYDMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD5=1
End DoDot:1
+27 DO CALCIND
+28 KILL ^TMP($JOB)
+29 QUIT
CALCIND ;
+1 IF BGPRTYPE=5
DO CALCIND^BGP5DCEI
QUIT
+2 DO CALCIND^BGP5DCI
+3 QUIT
CREAT(P,EDATE) ;get all creatines all must be <5
+1 NEW BGPG,%,X,E,R,T,V,J
+2 SET %=P_"^ALL LAB [DM AUDIT CREATININE TAX;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGPG(")
+3 SET X=0
SET E=1
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET R=$PIECE(BGPG(X),U,2)
IF +R>5
IF +R<15
SET E=""
+4 IF E=""
QUIT E
+5 SET T=$ORDER(^ATXAX("B","BGP CREATININE LOINC CODES",0))
+6 IF 'T
QUIT E
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AC",P,X))
IF X'=+X!(E="")
QUIT
IF $PIECE($GET(^AUPNVLAB(X,11)),U,13)]""
Begin DoDot:1
+8 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+9 SET V=$PIECE(^AUPNVLAB(X,0),U,3)
SET V=$PIECE($GET(^AUPNVSIT(V,0)),U,1)
SET V=$PIECE(V,".")
+10 IF V>EDATE
QUIT
+11 SET J=$PIECE(^AUPNVLAB(X,11),U,13)
+12 IF '$$LOINC(J,T)
QUIT
+13 IF $PIECE(^AUPNVLAB(X,0),U,4)=""
QUIT
+14 SET R=$PIECE(^AUPNVLAB(X,0),U,4)
+15 IF +R>5
IF +R<15
SET E=""
End DoDot:1
+16 QUIT E
V1DM(P,D,EDATE) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 SET PC=$ORDER(^ATXAX("B","BGP PRIMARY CARE CLINICS",0))
+4 IF 'PC
QUIT ""
+5 ;I 'PP Q ""
+6 KILL ^TMP($JOB,"A")
+7 NEW A,B,T,X,G,V,Y
+8 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(D)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+9 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+10 SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+11 IF 'T
QUIT ""
+12 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>2)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+13 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+14 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+15 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+16 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+17 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+18 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+19 ;Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2) ;PER TERRY
+20 IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+21 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(D)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
SET %=$PIECE(^AUPNVPOV(Y,0),U)
IF $$ICD^BGP5UTL2(%,T,9)
SET D=1
+22 IF 'D
QUIT
+23 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+24 SET Y=$$PRIMPROV^APCLV(V,"F")
+25 IF 'Y
QUIT
+26 ;Q:'$D(^ATXAX(PP,21,"B",Y))
+27 IF $PIECE($GET(^DIC(7,Y,9999999)),U,3)'="Y"
QUIT
+28 SET Y=$$CLINIC^APCLV(V,"I")
+29 IF 'Y
QUIT
+30 IF '$DATA(^ATXAX(PC,21,"B",Y))
QUIT
+31 SET G=G+1
+32 QUIT
End DoDot:1
+33 QUIT $SELECT(G<1:"",1:1)
+34 ;
V2(P,BDATE,EDATE) ;EP
+1 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+2 KILL ^TMP($JOB,"A")
+3 NEW A,B,X,G,V
+4 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+5 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+6 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>2)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+7 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+8 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+9 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+10 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+11 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+13 SET G=G+1
+14 QUIT
End DoDot:1
+15 QUIT $SELECT(G<2:"",1:1)
+16 ;
V2DM(P,BDATE,EDATE) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 KILL ^TMP($JOB,"A")
+4 NEW A,B,E,T,G,V,Y
+5 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+6 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+7 SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+8 IF 'T
QUIT ""
+9 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>2)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+10 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+11 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+13 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+14 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+15 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+16 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(D)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
SET %=$PIECE(^AUPNVPOV(Y,0),U)
IF $$ICD^BGP5UTL2(%,T,9)
SET D=1
+17 IF 'D
QUIT
+18 SET G=G+1
+19 QUIT
End DoDot:1
+20 QUIT $SELECT(G<2:"",1:1)
+21 ;
DM(P,BDATE,EDATE) ;EP is patient diabetic 1 or 0
+1 IF $GET(BDATE)=""
SET BDATE=$$DOB^AUPNPAT(P)
+2 NEW BGPG
+3 SET Y="BGPG("
+4 SET X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+5 ;has a dx
IF $DATA(BGPG(1))
QUIT 1
+6 QUIT 0
+7 ;
ACTUPAP(P,BDATE,EDATE,B) ;EP - is this patient in user pop?
+1 NEW X
+2 ;must be Indian/Alaskan Native
IF B=1
IF $$BEN^AUPNPAT(P,"C")'="01"
QUIT 0
+3 ;must not be I/A
IF B=2
IF $$BEN^AUPNPAT(P,"C")="01"
QUIT 0
+4 SET DOD=$$DOD^AUPNPAT(P)
IF DOD]""
IF DOD<EDATE
QUIT 0
+5 SET X=$$LASTVD(P,BDATE,EDATE)
+6 QUIT $SELECT(X:1,1:0)
+7 ;
ACTUP(P,BDATE,EDATE,T,B) ;EP - is this patient in user pop?
+1 NEW X,DOD
+2 ;must be Indian/Alaskan Native
IF B=1
IF $$BEN^AUPNPAT(P,"C")'="01"
QUIT 0
+3 ;must not be I/A
IF B=2
IF $$BEN^AUPNPAT(P,"C")="01"
QUIT 0
+4 SET DOD=$$DOD^AUPNPAT(P)
IF DOD]""
IF DOD<EDATE
QUIT 0
+5 SET X=$PIECE($GET(^AUPNPAT(P,11)),U,18)
IF X=""
QUIT 0
+6 IF '$DATA(^ATXAX(T,21,"B",($PIECE(^AUPNPAT(P,11),U,18))))
IF '$DATA(^ATXAX(T,21,"AA",$PIECE(^AUPNPAT(P,11),U,18),$PIECE(^AUPNPAT(P,11),U,18)))
QUIT 0
+7 SET X=$$LASTVD(P,BDATE,EDATE)
+8 QUIT $SELECT(X:1,1:0)
+9 ;
ACTCL(P,BDATE,EDATE) ;EP - clinical user
+1 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(F)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+2 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+3 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+4 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+5 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+6 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+7 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+8 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+9 SET B=$$CLINIC^APCLV(V,"C")
+10 IF B=""
QUIT
+11 ;must be a primary clinic S G=V
IF 'G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2015,0)),11,"B",B))
SET G=V
+12 IF V'=G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2015,0)),12,"B",B))
SET S=1
+13 IF G
IF S
SET F=1
+14 QUIT
End DoDot:1
+15 QUIT $SELECT(F:1,1:0)
ACTCLBH(P,BDATE,EDATE) ;EP - clinical user
+1 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(F)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+2 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+3 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+4 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+5 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+6 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+7 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+8 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+9 SET B=$$CLINIC^APCLV(V,"C")
+10 IF B=""
QUIT
+11 ;must be a primary clinic S G=V
IF 'G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2015,0)),11,"B",B))
SET G=V
+12 IF V'=G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2015,0)),95,"B",B))
SET S=1
+13 IF G
IF S
SET F=1
+14 QUIT
End DoDot:1
+15 QUIT $SELECT(F:1,1:0)
FIRSTDM(P,EDATE) ;
+1 IF $GET(P)=""
QUIT ""
+2 KILL BGPG
+3 SET Y="BGPG("
+4 SET X=P_"^FIRST DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,Y)
+5 IF '$DATA(BGPG(1))
QUIT ""
+6 SET X=$$FMDIFF^XLFDT(EDATE,$PIECE(BGPG(1),U))
+7 QUIT $SELECT(X>365:1,1:"")
+8 ;
LASTVD(P,BDATE,EDATE) ;
+1 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+2 KILL ^TMP($JOB,"A")
+3 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+4 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+5 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+7 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+8 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+9 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+10 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+11 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+13 SET G=1
+14 QUIT
End DoDot:1
+15 QUIT G
+16 ;
LOINC(A,B) ;
+1 NEW %
+2 SET %=$PIECE($GET(^LAB(95.3,A,9999999)),U,2)
+3 IF %]""
IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+4 SET %=$PIECE($GET(^LAB(95.3,A,0)),U)_"-"_$PIECE($GET(^LAB(95.3,A,0)),U,15)
+5 IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+6 QUIT ""
DP(P) ;
+1 IF $PIECE(^AUPNPAT(P,0),U,14)
QUIT $PIECE(^AUPNPAT(P,0),U,14)
+2 IF $TEXT(ALLDP^BDPAPI)=""
QUIT ""
+3 NEW X
+4 DO ALLDP^BDPAPI(P,"DESIGNATED PRIMARY PROVIDER",.X)
+5 QUIT $PIECE($GET(X("DESIGNATED PRIMARY PROVIDER")),U,2)
