BGP0D1 ; IHS/CMI/LAB - calc measures 29 Apr 2009 7:38 PM 14 Nov 2006 5:02 PM 12 Nov 2008 11:03 AM 27 May 2010 10:08 AM 12 May 2010 6:04 PM ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;
PROC ;EP
S BGPBT=$H
D JRNL^BGP0UTL
S BGPJ=$J,BGPH=$H
S BGPCHWC=0
K ^XTMP("BGP08CPL",BGPJ,BGPH)
D XTMP^BGP0UTL("BGP08CPL","National GPRA Comp List")
D XTMP^BGP0UTL("BGP0DNP","National GPRA Patient List")
D XTMP^BGP0UTL("BGP0D","CRS Local Patient List")
S BGPCHSO=$P($G(^BGPSITE(DUZ(2),0)),U,6)
;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=5634 Q:$$HRN^AUPNPAT(DFN,DUZ(2))'=160617
.;I DUZ=5634,'$D(^DIBT(4641,1,DFN)) Q
.;I DUZ=5634,DFN'=132429 Q
.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"
.I $P($G(^BGPSITE(DUZ(2),0)),U,12) Q:$D(^DIBT($P(^BGPSITE(DUZ(2),0),U,12),1,DFN))
.D PROCCY,PROCPY,PROCBY
N ;
I BGPRTYPE=1,$G(BGPEXPT),'$G(BGP0GPU) S ^BGPGPDCT(BGPRPT,88888,0)="^90377.0388888A^"_BGPCHWC_"^"_BGPCHWC
I $G(BGPYWCHW) S ^BGPGPDCT(BGPRPT,88888,0)="^90377.0388888A^"_BGPCHWC_"^"_BGPCHWC
S BGPET=$H
Q
;
PROCCY ;EP - current time period
K ^TMP($J)
S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD,BGPHTN)=""
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:"^BGPHEDCT(",BGPRTYPE=5:"^BGPELDCT(",BGPRTYPE=8:"^BGPEOCT(",1:"^BGPGPDCT(")
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,BGPCHSO) ;active clinical
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 BGP1DMV=$$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,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
.S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
I $G(BGPXPRP) Q ;stop if in national gpra export
I $G(BGPIISO) D ISS^BGP0DPA1 K ^TMP($J,"A") Q ;SCHEDULING OPTION
D CALCIND
I BGPRTYPE=1,$G(BGPYWCHW),'$G(BGP0GPU) D
.;Q:$$AGE^AUPNPAT(DFN,BGPED)>18
.D GEN^BGP0DCHW
K ^TMP($J,"A")
Q
PROCPY ;
K ^TMP($J)
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:"^BGPHEDPT(",BGPRTYPE=5:"^BGPELDPT(",BGPRTYPE=8:"^BGPEOPT(",1:"^BGPGPDPT(")
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,BGPCHSO) ;active clinical
S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
S BGPSEX=$P(^DPT(DFN,0),U,2)
;I $$V2IHD^BGP3D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP3D9(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 BGP1DMV=$$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,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
.S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
D CALCIND
K ^TMP($J)
Q
PROCBY ;
K ^TMP($J)
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:"^BGPHEDBT(",BGPRTYPE=5:"^BGPELDBT(",BGPRTYPE=8:"^BGPEOBT(",1:"^BGPGPDBT(")
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,BGPCHSO) ;active clinical
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 BGP1DMV=$$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,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
.S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
D CALCIND
K ^TMP($J)
Q
CALCIND ;
I BGPRTYPE=3 D CALCIND^BGP0DCHI Q
I BGPRTYPE=5 D CALCIND^BGP0DCEI Q
I BGPRTYPE=8 D CALCIND^BGP0EOCI Q
D CALCIND^BGP0DCI
Q
CREAT(P,EDATE) ;get all creatines all must be <5
K BGPG
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")
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)=""
.I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.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^ATXCHK(%,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")
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)=""
.I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.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")
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)=""
.I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.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^ATXCHK(%,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)
K 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?
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?
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,CHS) ;EP - clinical user
I CHS G CHSACTCL
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)=""
.I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.S B=$$CLINIC^APCLV(V,"C")
.Q:B=""
.I 'G,$D(^BGPCTRL($O(^BGPCTRL("B",2010,0)),11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2010,0)),12,"B",B)) S S=1
.I G,S S F=1
.Q
Q $S(F:1,1:0)
;
CHSACTCL ;chs only sites active clinical defintion
;2 chs visits in past 3 years
S (X,G,F,S)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F>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:'$D(^AUPNVPRV("AD",V))
.Q:"SAHOI"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"C"'[$P(^AUPNVSIT(V,0),U,3)
.S F=F+1
Q $S(F>1: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)=""
.I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.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)
BGP0D1 ; IHS/CMI/LAB - calc measures 29 Apr 2009 7:38 PM 14 Nov 2006 5:02 PM 12 Nov 2008 11:03 AM 27 May 2010 10:08 AM 12 May 2010 6:04 PM ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+2 ;
PROC ;EP
+1 SET BGPBT=$HOROLOG
+2 DO JRNL^BGP0UTL
+3 SET BGPJ=$JOB
SET BGPH=$HOROLOG
+4 SET BGPCHWC=0
+5 KILL ^XTMP("BGP08CPL",BGPJ,BGPH)
+6 DO XTMP^BGP0UTL("BGP08CPL","National GPRA Comp List")
+7 DO XTMP^BGP0UTL("BGP0DNP","National GPRA Patient List")
+8 DO XTMP^BGP0UTL("BGP0D","CRS Local Patient List")
+9 SET BGPCHSO=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,6)
+10 ;calculate 3 years before end of each time frame
+11 SET BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
+12 SET BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
+13 SET BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
+14 ;process each patient
+15 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+16 ;I DUZ=5634 Q:$$HRN^AUPNPAT(DFN,DUZ(2))'=160617
+17 ;I DUZ=5634,'$D(^DIBT(4641,1,DFN)) Q
+18 ;I DUZ=5634,DFN'=132429 Q
+19 IF $GET(BGPDESGP)
SET P=$$DP(DFN)
IF P'=BGPDESGP
QUIT
+20 IF '$DATA(^DPT(DFN,0))
QUIT
+21 IF $PIECE($GET(^DPT(DFN,0)),U)["DEMO,PATIENT"
QUIT
+22 IF $PIECE($GET(^BGPSITE(DUZ(2),0)),U,12)
IF $DATA(^DIBT($PIECE(^BGPSITE(DUZ(2),0),U,12),1,DFN))
QUIT
+23 DO PROCCY
DO PROCPY
DO PROCBY
End DoDot:1
N ;
+1 IF BGPRTYPE=1
IF $GET(BGPEXPT)
IF '$GET(BGP0GPU)
SET ^BGPGPDCT(BGPRPT,88888,0)="^90377.0388888A^"_BGPCHWC_"^"_BGPCHWC
+2 IF $GET(BGPYWCHW)
SET ^BGPGPDCT(BGPRPT,88888,0)="^90377.0388888A^"_BGPCHWC_"^"_BGPCHWC
+3 SET BGPET=$HOROLOG
+4 QUIT
+5 ;
PROCCY ;EP - current time period
+1 KILL ^TMP($JOB)
+2 SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD,BGPHTN)=""
+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=BGPED
SET BGPTIME=1
SET BGPBDATE=BGPBD
SET BGPGBL=$SELECT(BGPRTYPE=3:"^BGPHEDCT(",BGPRTYPE=5:"^BGPELDCT(",BGPRTYPE=8:"^BGPEOCT(",1:"^BGPGPDCT(")
+7 SET BGP365=BGPBDATE
+8 ;user pop
IF '$GET(BGPALLPT)
SET BGPACTUP=$$ACTUP(DFN,BGP3YE,BGPEDATE,BGPTAXI,BGPBEN)
+9 IF $GET(BGPALLPT)
SET BGPACTUP=$$ACTUPAP(DFN,BGP3YE,BGPEDATE,BGPBEN)
+10 IF 'BGPACTUP
IF '$GET(BGPXPXPX)
IF '$GET(BGPIISO)
QUIT
+11 ;active clinical
SET BGPACTCL=$$ACTCL(DFN,BGP3YE,BGPEDATE,BGPCHSO)
+12 SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
+13 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+14 SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)
+15 ;if in scheduling option, everyone is user pop/active clinical
IF $GET(BGPIISO)=1
SET BGPACTUP=1
SET BGPACTCL=1
+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 BGP1DMV=$$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 BGP1DMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD3=1
+26 SET BGPDMD5=0
IF BGPFDMD
IF BGP2DMV
IF BGP1DMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD5=1
End DoDot:1
+27 ;stop if in national gpra export
IF $GET(BGPXPRP)
QUIT
+28 ;SCHEDULING OPTION
IF $GET(BGPIISO)
DO ISS^BGP0DPA1
KILL ^TMP($JOB,"A")
QUIT
+29 DO CALCIND
+30 IF BGPRTYPE=1
IF $GET(BGPYWCHW)
IF '$GET(BGP0GPU)
Begin DoDot:1
+31 ;Q:$$AGE^AUPNPAT(DFN,BGPED)>18
+32 DO GEN^BGP0DCHW
End DoDot:1
+33 KILL ^TMP($JOB,"A")
+34 QUIT
PROCPY ;
+1 KILL ^TMP($JOB)
+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:"^BGPHEDPT(",BGPRTYPE=5:"^BGPELDPT(",BGPRTYPE=8:"^BGPEOPT(",1:"^BGPGPDPT(")
+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,BGPCHSO)
+12 SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
+13 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+14 SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)
+15 ;I $$V2IHD^BGP3D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP3D9(DFN,BGPEDATE) S BGPIHD=1
+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 BGP1DMV=$$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 BGP1DMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD3=1
+26 SET BGPDMD5=0
IF BGPFDMD
IF BGP2DMV
IF BGP1DMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD5=1
End DoDot:1
+27 DO CALCIND
+28 KILL ^TMP($JOB)
+29 QUIT
PROCBY ;
+1 KILL ^TMP($JOB)
+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:"^BGPHEDBT(",BGPRTYPE=5:"^BGPELDBT(",BGPRTYPE=8:"^BGPEOBT(",1:"^BGPGPDBT(")
+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,BGPCHSO)
+12 SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
+13 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+14 SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)
+15 ;dm diagnosis ever?
SET BGPDM1=$$DM(DFN,,BGPEDATE)
+16 ;dm diagnosis in past year
SET BGPDM2=$$DM(DFN,BGP365,BGPEDATE)
+17 ;set up 4 dm demoninators
IF BGPDM1
Begin DoDot:1
+18 ;1 OR 0 FIRST DX BEFORE BEG
SET BGPFDMD=$$FIRSTDM(DFN,BGPEDATE)
+19 SET BGP2V=$$V2(DFN,BGP365,BGPEDATE)
+20 SET BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+21 SET BGP1DMV=$$V1DM(DFN,BGP365,BGPEDATE)
+22 SET BGPDMD1=0
IF BGPFDMD
SET BGPDMD1=1
+23 SET BGPDMD2=0
IF BGPFDMD
IF BGP2V
IF BGP2DMV
IF BGPACTCL
SET BGPDMD2=1
+24 SET BGPDMD3=0
IF BGPFDMD
IF BGPAGEB>19
IF BGP2DMV
IF BGP1DMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD3=1
+25 SET BGPDMD5=0
IF BGPFDMD
IF BGP2DMV
IF BGP1DMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD5=1
End DoDot:1
+26 DO CALCIND
+27 KILL ^TMP($JOB)
+28 QUIT
CALCIND ;
+1 IF BGPRTYPE=3
DO CALCIND^BGP0DCHI
QUIT
+2 IF BGPRTYPE=5
DO CALCIND^BGP0DCEI
QUIT
+3 IF BGPRTYPE=8
DO CALCIND^BGP0EOCI
QUIT
+4 DO CALCIND^BGP0DCI
+5 QUIT
CREAT(P,EDATE) ;get all creatines all must be <5
+1 KILL BGPG
+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 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(D)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+8 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+9 SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+10 IF 'T
QUIT ""
+11 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
+12 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+13 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+14 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+15 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+16 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+17 IF $GET(BGPMFITI)
IF '$DATA(^ATXAX(BGPMFITI,21,"B",$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^ATXCHK(%,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 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>2)
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 "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+10 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+12 IF $GET(BGPMFITI)
IF '$DATA(^ATXAX(BGPMFITI,21,"B",$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 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 T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+7 IF 'T
QUIT ""
+8 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
+9 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+10 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+12 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+13 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+14 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+15 IF $GET(BGPMFITI)
IF '$DATA(^ATXAX(BGPMFITI,21,"B",$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^ATXCHK(%,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 KILL 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 ;must be Indian/Alaskan Native
IF B=1
IF $$BEN^AUPNPAT(P,"C")'="01"
QUIT 0
+2 ;must not be I/A
IF B=2
IF $$BEN^AUPNPAT(P,"C")="01"
QUIT 0
+3 SET DOD=$$DOD^AUPNPAT(P)
IF DOD]""
IF DOD<EDATE
QUIT 0
+4 SET X=$$LASTVD(P,BDATE,EDATE)
+5 QUIT $SELECT(X:1,1:0)
+6 ;
ACTUP(P,BDATE,EDATE,T,B) ;EP - is this patient in user pop?
+1 ;must be Indian/Alaskan Native
IF B=1
IF $$BEN^AUPNPAT(P,"C")'="01"
QUIT 0
+2 ;must not be I/A
IF B=2
IF $$BEN^AUPNPAT(P,"C")="01"
QUIT 0
+3 SET DOD=$$DOD^AUPNPAT(P)
IF DOD]""
IF DOD<EDATE
QUIT 0
+4 SET X=$PIECE($GET(^AUPNPAT(P,11)),U,18)
IF X=""
QUIT 0
+5 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
+6 SET X=$$LASTVD(P,BDATE,EDATE)
+7 QUIT $SELECT(X:1,1:0)
+8 ;
ACTCL(P,BDATE,EDATE,CHS) ;EP - clinical user
+1 IF CHS
GOTO CHSACTCL
+2 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
+3 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+4 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+5 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+6 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+7 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+8 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+9 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+10 IF $GET(BGPMFITI)
IF '$DATA(^ATXAX(BGPMFITI,21,"B",$PIECE(^AUPNVSIT(V,0),U,6)))
QUIT
+11 SET B=$$CLINIC^APCLV(V,"C")
+12 IF B=""
QUIT
+13 ;must be a primary clinic S G=V
IF 'G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2010,0)),11,"B",B))
SET G=V
+14 IF V'=G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2010,0)),12,"B",B))
SET S=1
+15 IF G
IF S
SET F=1
+16 QUIT
End DoDot:1
+17 QUIT $SELECT(F:1,1:0)
+18 ;
CHSACTCL ;chs only sites active clinical defintion
+1 ;2 chs visits in past 3 years
+2 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(F>1)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+3 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+4 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+5 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+6 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+7 IF "SAHOI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+8 IF "C"'[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+9 SET F=F+1
End DoDot:1
+10 QUIT $SELECT(F>1: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 IF $GET(BGPMFITI)
IF '$DATA(^ATXAX(BGPMFITI,21,"B",$PIECE(^AUPNVSIT(V,0),U,6)))
QUIT
+14 SET G=1
+15 QUIT
End DoDot:1
+16 QUIT G
+17 ;
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)
