BGP8D10 ; IHS/CMI/LAB - calc measures ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
PROC ;EP
S BGPBT=$H
D JRNL^BGP8UTL
S BGPJ=$J,BGPH=$H
D UNFOLDTX^BGP8UTL2
;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(^DIBT(BGPSEAT,1,DFN)) Q:DFN'=+DFN D
.D PROCCY,PROCPY,PROCBY
K ^XTMP("BGP15TAX",$J),^XTMP("BGPSNOMEDSUBSET",$J)
S BGPET=$H
Q
;
BQI(DFN,BQIGREF) ;PEP - iCare EP
;Description
; Entry point called by the iCare module, returns GPRA data by global Reference
; DFN = Patient internal entry number
; BQIGREF = Global reference to store data
;
;
PROCCY ;current time period
K ^TMP($J)
S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPDMD6,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="^BGPGPDCR("
S BGP365=BGPBDATE
S BGPACTUP=1
S BGPACTCL=1
S BGPACTCB=1
S BGPIPCUP=1
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^BGP8D1(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
.S BGPDMD6=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTUP S BGPDMD6=1 ;NEW GPRA DM USER POP DENOM V18.0
D CALCIND
K ^TMP($J)
Q
PROCPY ;
K ^TMP($J)
S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPDMD6,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="^BGPGPDPR("
S BGP365=BGPBDATE
S BGPACTUP=1
S BGPACTCL=1
S BGPACTCB=1
S BGPIPCUP=1
S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
S BGPSEX=$P(^DPT(DFN,0),U,2)
;I $$V2IHD^BGP8D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP8D9(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^BGP8D1(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
.S BGPDMD6=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTUP S BGPDMD6=1 ;NEW GPRA DM USER POP DENOM V18.0
D CALCIND
K ^TMP($J)
Q
PROCBY ;
S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPDMD6,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="^BGPGPDBR("
S BGP365=BGPBDATE
S BGPACTUP=1
S BGPACTCL=1
S BGPACTCB=1
S BGPIPCUP=1
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^BGP8D1(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
.S BGPDMD6=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTUP S BGPDMD6=1 ;NEW GPRA DM USER POP DENOM V18.0
D CALCIND
K ^TMP($J)
Q
CALCIND ;
D CALCIND^BGP8DCI
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:'$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^BGP8UTL2(%,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) ;
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)
.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)
.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^BGP8UTL2(%,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)
N BGPG
;S Y="BGPG("
;S X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S BGPG(1)=$$LASTDX^BGP8UTL1(P,"SURVEILLANCE DIABETES",BDATE,EDATE)
I BGPG(1) Q 1 ;has a dx
Q 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)
.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 ""
BGP8D10 ; IHS/CMI/LAB - calc measures ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
PROC ;EP
+1 SET BGPBT=$HOROLOG
+2 DO JRNL^BGP8UTL
+3 SET BGPJ=$JOB
SET BGPH=$HOROLOG
+4 DO UNFOLDTX^BGP8UTL2
+5 ;calculate 3 years before end of each time frame
+6 SET BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
+7 SET BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
+8 SET BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
+9 ;process each patient
+10 SET DFN=0
FOR
SET DFN=$ORDER(^DIBT(BGPSEAT,1,DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+11 DO PROCCY
DO PROCPY
DO PROCBY
End DoDot:1
+12 KILL ^XTMP("BGP15TAX",$JOB),^XTMP("BGPSNOMEDSUBSET",$JOB)
+13 SET BGPET=$HOROLOG
+14 QUIT
+15 ;
BQI(DFN,BQIGREF) ;PEP - iCare EP
+1 ;Description
+2 ; Entry point called by the iCare module, returns GPRA data by global Reference
+3 ; DFN = Patient internal entry number
+4 ; BQIGREF = Global reference to store data
+5 ;
+6 ;
PROCCY ;current time period
+1 KILL ^TMP($JOB)
+2 SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPDMD6,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="^BGPGPDCR("
+7 SET BGP365=BGPBDATE
+8 SET BGPACTUP=1
+9 SET BGPACTCL=1
+10 SET BGPACTCB=1
+11 SET BGPIPCUP=1
+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^BGP8D1(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+21 SET BGPYDMV=$$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 BGPYDMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD3=1
+25 SET BGPDMD5=0
IF BGPFDMD
IF BGP2DMV
IF BGPYDMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD5=1
+26 ;NEW GPRA DM USER POP DENOM V18.0
SET BGPDMD6=0
IF BGPFDMD
IF BGP2V
IF BGP2DMV
IF BGPACTUP
SET BGPDMD6=1
End DoDot:1
+27 DO CALCIND
+28 KILL ^TMP($JOB)
+29 QUIT
PROCPY ;
+1 KILL ^TMP($JOB)
+2 SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPDMD6,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="^BGPGPDPR("
+7 SET BGP365=BGPBDATE
+8 SET BGPACTUP=1
+9 SET BGPACTCL=1
+10 SET BGPACTCB=1
+11 SET BGPIPCUP=1
+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^BGP8D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP8D9(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^BGP8D1(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
+27 ;NEW GPRA DM USER POP DENOM V18.0
SET BGPDMD6=0
IF BGPFDMD
IF BGP2V
IF BGP2DMV
IF BGPACTUP
SET BGPDMD6=1
End DoDot:1
+28 DO CALCIND
+29 KILL ^TMP($JOB)
+30 QUIT
PROCBY ;
+1 SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPDMD6,BGPIHD)=""
+2 IF '$DATA(^DPT(DFN,0))
QUIT
+3 IF $PIECE(^DPT(DFN,0),U,2)=""
QUIT
+4 IF "FM"'[$PIECE(^DPT(DFN,0),U,2)
QUIT
+5 SET BGPEDATE=BGPBED
SET BGPTIME=3
SET BGPBDATE=BGPBBD
SET BGPGBL="^BGPGPDBR("
+6 SET BGP365=BGPBDATE
+7 SET BGPACTUP=1
+8 SET BGPACTCL=1
+9 SET BGPACTCB=1
+10 SET BGPIPCUP=1
+11 SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
+12 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+13 SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)
+14 ;dm diagnosis ever?
SET BGPDM1=$$DM(DFN,,BGPEDATE)
+15 ;dm diagnosis in past year
SET BGPDM2=$$DM(DFN,BGP365,BGPEDATE)
+16 ;set up 4 dm demoninators
IF BGPDM1
Begin DoDot:1
+17 ;1 OR 0 FIRST DX BEFORE BEG
SET BGPFDMD=$$FIRSTDM(DFN,BGPEDATE)
+18 SET BGP2V=$$V2(DFN,BGP365,BGPEDATE)
+19 SET BGP2DMV=$$V2DM^BGP8D1(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+20 SET BGPYDMV=$$V1DM(DFN,BGP365,BGPEDATE)
+21 SET BGPDMD1=0
IF BGPFDMD
SET BGPDMD1=1
+22 SET BGPDMD2=0
IF BGPFDMD
IF BGP2V
IF BGP2DMV
IF BGPACTCL
SET BGPDMD2=1
+23 SET BGPDMD3=0
IF BGPFDMD
IF BGPAGEB>19
IF BGP2DMV
IF BGPYDMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD3=1
+24 SET BGPDMD5=0
IF BGPFDMD
IF BGP2DMV
IF BGPYDMV
IF $$CREAT(DFN,BGPEDATE)
SET BGPDMD5=1
+25 ;NEW GPRA DM USER POP DENOM V18.0
SET BGPDMD6=0
IF BGPFDMD
IF BGP2V
IF BGP2DMV
IF BGPACTUP
SET BGPDMD6=1
End DoDot:1
+26 DO CALCIND
+27 KILL ^TMP($JOB)
+28 QUIT
CALCIND ;
+1 DO CALCIND^BGP8DCI
+2 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 '$DATA(^AUPNVPRV("AD",V))
QUIT
+17 ;Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2) ;PER TERRY
+18 IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+19 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^BGP8UTL2(%,T,9)
SET D=1
+20 IF 'D
QUIT
+21 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+22 SET Y=$$PRIMPROV^APCLV(V,"F")
+23 IF 'Y
QUIT
+24 ;Q:'$D(^ATXAX(PP,21,"B",Y))
+25 IF $PIECE($GET(^DIC(7,Y,9999999)),U,3)'="Y"
QUIT
+26 SET Y=$$CLINIC^APCLV(V,"I")
+27 IF 'Y
QUIT
+28 IF '$DATA(^ATXAX(PC,21,"B",Y))
QUIT
+29 SET G=G+1
+30 QUIT
End DoDot:1
+31 QUIT $SELECT(G<1:"",1:1)
+32 ;
V2(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>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 SET G=G+1
+12 QUIT
End DoDot:1
+13 QUIT $SELECT(G<2:"",1:1)
+14 ;
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 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^BGP8UTL2(%,T,9)
SET D=1
+15 IF 'D
QUIT
+16 SET G=G+1
+17 QUIT
End DoDot:1
+18 QUIT $SELECT(G<2:"",1:1)
+19 ;
DM(P,BDATE,EDATE) ;EP is patient diabetic 1 or 0
+1 IF $GET(BDATE)=""
SET BDATE=$$DOB^AUPNPAT(P)
+2 NEW BGPG
+3 ;S Y="BGPG("
+4 ;S X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
+5 SET BGPG(1)=$$LASTDX^BGP8UTL1(P,"SURVEILLANCE DIABETES",BDATE,EDATE)
+6 ;has a dx
IF BGPG(1)
QUIT 1
+7 QUIT 0
+8 ;
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 SET G=1
+13 QUIT
End DoDot:1
+14 QUIT G
+15 ;
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 ""
