BGP7D1 ; IHS/CMI/LAB - calc measures 21 Aug 2015 1:02 PM 13 Jul 2016 12:49 PM ; 04 Apr 2017 9:23 AM
;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
;
PROC ;EP
S BGPBT=$H
D JRNL^BGP7UTL
S BGPJ=$J,BGPH=$H
K ^XTMP("BGP28CPL",BGPJ,BGPH)
K ^XTMP("BGP15TAX",$J),^XTMP("BGPSNOMEDSUBSET",$J)
D UNFOLDTX^BGP7UTL2
D XTMP^BGP7UTL("BGP28CPL","National GPRA Comp List")
D XTMP^BGP7UTL("BGP7DNP","National GPRA Patient List")
D XTMP^BGP7UTL("BGP7D","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 DUZ=2881 Q:$$HRN^AUPNPAT(DFN,DUZ(2))'=121334
.;;I DUZ=2881 Q:'$D(^DIBT(14384,1,DFN))
.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),^XTMP("BGPSNOMEDSUBSET",$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:"^BGPEDLCG(",BGPRTYPE=8:"^BGPEOCB(",1:"^BGPGPDCG(")
S BGP365=BGPBDATE
I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGP3YE,BGPEDATE,BGPTAXI,BGPBEN,$G(BGPCOMMI)) ;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^BGP7DPA1 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:"^BGPEDLPG(",BGPRTYPE=8:"^BGPEOPB(",1:"^BGPGPDPG(")
S BGP365=BGPBDATE
I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGPP3YE,BGPEDATE,BGPTAXI,BGPBEN,$G(BGPCOMMI)) ;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^BGP7D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP7D9(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:"^BGPEDLBG(",BGPRTYPE=8:"^BGPEOBB(",1:"^BGPGPDBG(")
S BGP365=BGPBDATE
I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGPB3YE,BGPEDATE,BGPTAXI,BGPBEN,$G(BGPCOMMI)) ;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^BGP7DCEI Q
D CALCIND^BGP7DCI
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^BGP7UTL2(%,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^BGP7UTL2(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^BGP7UTL1(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,C) ;EP - is this patient in user pop?
NEW X,DOD
S C=$G(C)
S T=$G(T)
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
I C,$P($G(^AUPNPAT(P,11)),U,17)'=C Q 0
I C G LVD
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
LVD 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",2017,0)),11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2017,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",2017,0)),11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2017,0)),95,"B",B)) S S=1
.I G,S S F=1
.Q
Q $S(F:1,1:0)
FIRSTDM(P,EDATE) ;EP
I $G(P)="" Q ""
NEW X,BGPG,E,Y
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)
BGP7D1 ; IHS/CMI/LAB - calc measures 21 Aug 2015 1:02 PM 13 Jul 2016 12:49 PM ; 04 Apr 2017 9:23 AM
+1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
+2 ;
PROC ;EP
+1 SET BGPBT=$HOROLOG
+2 DO JRNL^BGP7UTL
+3 SET BGPJ=$JOB
SET BGPH=$HOROLOG
+4 KILL ^XTMP("BGP28CPL",BGPJ,BGPH)
+5 KILL ^XTMP("BGP15TAX",$JOB),^XTMP("BGPSNOMEDSUBSET",$JOB)
+6 DO UNFOLDTX^BGP7UTL2
+7 DO XTMP^BGP7UTL("BGP28CPL","National GPRA Comp List")
+8 DO XTMP^BGP7UTL("BGP7DNP","National GPRA Patient List")
+9 DO XTMP^BGP7UTL("BGP7D","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 DUZ=2881 Q:$$HRN^AUPNPAT(DFN,DUZ(2))'=121334
+19 ;;I DUZ=2881 Q:'$D(^DIBT(14384,1,DFN))
+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),^XTMP("BGPSNOMEDSUBSET",$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:"^BGPEDLCG(",BGPRTYPE=8:"^BGPEOCB(",1:"^BGPGPDCG(")
+8 SET BGP365=BGPBDATE
+9 ;user pop
IF '$GET(BGPALLPT)
SET BGPACTUP=$$ACTUP(DFN,BGP3YE,BGPEDATE,BGPTAXI,BGPBEN,$GET(BGPCOMMI))
+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^BGP7DPA1
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:"^BGPEDLPG(",BGPRTYPE=8:"^BGPEOPB(",1:"^BGPGPDPG(")
+7 SET BGP365=BGPBDATE
+8 ;user pop
IF '$GET(BGPALLPT)
SET BGPACTUP=$$ACTUP(DFN,BGPP3YE,BGPEDATE,BGPTAXI,BGPBEN,$GET(BGPCOMMI))
+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^BGP7D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP7D9(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:"^BGPEDLBG(",BGPRTYPE=8:"^BGPEOBB(",1:"^BGPGPDBG(")
+7 SET BGP365=BGPBDATE
+8 ;user pop
IF '$GET(BGPALLPT)
SET BGPACTUP=$$ACTUP(DFN,BGPB3YE,BGPEDATE,BGPTAXI,BGPBEN,$GET(BGPCOMMI))
+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,BGPBDATE,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,BGPBDATE,BGPEDATE)
+21 SET BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+22 SET BGPYDMV=$$V1DM(DFN,BGPBDATE,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^BGP7DCEI
QUIT
+2 DO CALCIND^BGP7DCI
+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^BGP7UTL2(%,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 R=$NAME(^TMP($JOB,"A"))
+5 DO ALLV^APCLAPIU(P,BDATE,EDATE,R)
+6 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+7 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>1)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+8 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+9 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+11 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+12 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+13 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+14 SET G=G+1
+15 QUIT
End DoDot:1
+16 QUIT $SELECT(G<2:"",1:1)
+17 ;
V2DM(P,BDATE,EDATE) ;EP
+1 ;P is Patient DFN
+2 ;BDATE - beginning date to look default is DOB
+3 ;EDATE - end date to look default is DT
+4 IF '$GET(P)
QUIT ""
+5 ;patient has no visits
IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+6 IF '$GET(BDATE)
SET BDATE=$$DOB^AUPNPAT(P)
+7 IF '$GET(EDATE)
SET EDATE=DT
+8 NEW T,BIREFN,PDA,PIEN,CDX,VST,VDT,IBDATE,IEDATE,V,G
+9 SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+10 IF 'T
QUIT ""
+11 SET IBDATE=9999999-BDATE
+12 SET IEDATE=9999999-EDATE
+13 SET G=0
+14 KILL V
+15 SET PDA=IEDATE-1
FOR
SET PDA=$ORDER(^AUPNVPOV("AA",P,PDA))
IF 'PDA!(PDA>IBDATE)!(G>1)
QUIT
Begin DoDot:1
+16 SET PIEN=0
FOR
SET PIEN=$ORDER(^AUPNVPOV("AA",P,PDA,PIEN))
IF 'PIEN
QUIT
Begin DoDot:2
+17 SET CDX=$PIECE($GET(^AUPNVPOV(PIEN,0)),U)
+18 IF 'CDX
QUIT
+19 IF '$$ICD^BGP7UTL2(CDX,T,9)
QUIT
+20 SET VST=$PIECE($GET(^AUPNVPOV(PIEN,0)),U,3)
+21 IF 'VST
QUIT
+22 IF '$DATA(^AUPNVSIT(VST,0))
QUIT
+23 ;ELIMINATE TELEPHONE CALLS, CHART REVIEWS, ETC
IF "SAHO"'[$PIECE(^AUPNVSIT(VST,0),U,7)
QUIT
+24 IF $PIECE(^AUPNVSIT(VST,0),U,3)="V"
QUIT
+25 IF '$DATA(V(VST))
SET V(VST)=""
SET G=G+1
End DoDot:2
End DoDot:1
+26 QUIT $SELECT(G<2:"",1:1)
+27 ;**********
+28 ;
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 BGPG(1)=$$LASTDX^BGP7UTL1(P,"SURVEILLANCE DIABETES",BDATE,EDATE)
+4 ;has a dx
IF BGPG(1)
QUIT 1
+5 QUIT 0
+6 ;
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,C) ;EP - is this patient in user pop?
+1 NEW X,DOD
+2 SET C=$GET(C)
+3 SET T=$GET(T)
+4 ;must be Indian/Alaskan Native
IF B=1
IF $$BEN^AUPNPAT(P,"C")'="01"
QUIT 0
+5 ;must not be I/A
IF B=2
IF $$BEN^AUPNPAT(P,"C")="01"
QUIT 0
+6 SET DOD=$$DOD^AUPNPAT(P)
IF DOD]""
IF DOD<EDATE
QUIT 0
+7 IF C
IF $PIECE($GET(^AUPNPAT(P,11)),U,17)'=C
QUIT 0
+8 IF C
GOTO LVD
+9 SET X=$PIECE($GET(^AUPNPAT(P,11)),U,18)
IF X=""
QUIT 0
+10 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
LVD SET X=$$LASTVD(P,BDATE,EDATE)
+1 QUIT $SELECT(X:1,1:0)
+2 ;
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",2017,0)),11,"B",B))
SET G=V
+12 IF V'=G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2017,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",2017,0)),11,"B",B))
SET G=V
+12 IF V'=G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2017,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) ;EP
+1 IF $GET(P)=""
QUIT ""
+2 NEW X,BGPG,E,Y
+3 KILL BGPG
+4 SET Y="BGPG("
+5 SET X=P_"^FIRST DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,Y)
+6 IF '$DATA(BGPG(1))
QUIT ""
+7 SET X=$$FMDIFF^XLFDT(EDATE,$PIECE(BGPG(1),U))
+8 QUIT $SELECT(X>365:1,1:"")
+9 ;
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)
