Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP3D10

BGP3D10.m

Go to the documentation of this file.
  1. BGP3D10 ; IHS/CMI/LAB - calc measures ;
  1. ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
  1. ;
  1. PROC ;EP
  1. S BGPBT=$H
  1. D JRNL^BGP3UTL
  1. S BGPJ=$J,BGPH=$H
  1. ;calculate 3 years before end of each time frame
  1. S BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
  1. S BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
  1. S BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
  1. ;process each patient
  1. S DFN=0 F S DFN=$O(^DIBT(BGPSEAT,1,DFN)) Q:DFN'=+DFN D
  1. .D PROCCY,PROCPY,PROCBY
  1. S BGPET=$H
  1. Q
  1. ;
  1. BQI(DFN,BQIGREF) ;PEP - iCare EP
  1. ;Description
  1. ; Entry point called by the iCare module, returns GPRA data by global Reference
  1. ; DFN = Patient internal entry number
  1. ; BQIGREF = Global reference to store data
  1. ;
  1. PROCCY ;current time period
  1. K ^TMP($J)
  1. S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD,BGPHTN)=""
  1. Q:'$D(^DPT(DFN,0))
  1. Q:$P(^DPT(DFN,0),U,2)=""
  1. Q:"FM"'[$P(^DPT(DFN,0),U,2)
  1. S BGPEDATE=BGPED,BGPTIME=1,BGPBDATE=BGPBD,BGPGBL="^BGPGPDCH("
  1. S BGP365=BGPBDATE
  1. S BGPACTUP=1
  1. S BGPACTCL=1
  1. S BGPACTCB=1
  1. S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
  1. S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
  1. S BGPSEX=$P(^DPT(DFN,0),U,2)
  1. S BGPDM1=$$DM(DFN,,BGPEDATE) ;dm diagnosis ever?
  1. S BGPDM2=$$DM(DFN,BGP365,BGPEDATE) ;dm diagnosis in past year
  1. I BGPDM1 D ;set up 4 dm demoninators
  1. .S BGPFDMD=$$FIRSTDM(DFN,BGPEDATE) ;1 OR 0 FIRST DX BEFORE BEG
  1. .S BGP2V=$$V2(DFN,BGP365,BGPEDATE)
  1. .S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
  1. .S BGPYDMV=$$V1DM(DFN,BGP365,BGPEDATE)
  1. .S BGPDMD1=0 I BGPFDMD S BGPDMD1=1
  1. .S BGPDMD2=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTCL S BGPDMD2=1
  1. .S BGPDMD3=0 I BGPFDMD,BGPAGEB>19,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
  1. .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
  1. D CALCIND
  1. K ^TMP($J,"A")
  1. Q
  1. PROCPY ;
  1. S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD)=""
  1. Q:'$D(^DPT(DFN,0))
  1. Q:$P(^DPT(DFN,0),U,2)=""
  1. Q:"FM"'[$P(^DPT(DFN,0),U,2)
  1. S BGPEDATE=BGPPED,BGPTIME=2,BGPBDATE=BGPPBD,BGPGBL="^BGPGPDPH("
  1. S BGP365=BGPBDATE
  1. S BGPACTUP=1
  1. S BGPACTCL=1
  1. S BGPACTCB=1
  1. S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
  1. S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
  1. S BGPSEX=$P(^DPT(DFN,0),U,2)
  1. ;I $$V2IHD^BGP3D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP3D9(DFN,BGPEDATE) S BGPIHD=1
  1. S BGPDM1=$$DM(DFN,,BGPEDATE) ;dm diagnosis ever?
  1. S BGPDM2=$$DM(DFN,BGP365,BGPEDATE) ;dm diagnosis in past year
  1. I BGPDM1 D ;set up 4 dm demoninators
  1. .S BGPFDMD=$$FIRSTDM(DFN,BGPEDATE) ;1 OR 0 FIRST DX BEFORE BEG
  1. .S BGP2V=$$V2(DFN,BGP365,BGPEDATE)
  1. .S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
  1. .S BGPYDMV=$$V1DM(DFN,BGP365,BGPEDATE)
  1. .S BGPDMD1=0 I BGPFDMD S BGPDMD1=1
  1. .S BGPDMD2=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTCL S BGPDMD2=1
  1. .S BGPDMD3=0 I BGPFDMD,BGPAGEB>19,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
  1. .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
  1. D CALCIND
  1. K ^TMP($J,"A")
  1. Q
  1. PROCBY ;
  1. S (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,BGPIHD)=""
  1. Q:'$D(^DPT(DFN,0))
  1. Q:$P(^DPT(DFN,0),U,2)=""
  1. Q:"FM"'[$P(^DPT(DFN,0),U,2)
  1. S BGPEDATE=BGPBED,BGPTIME=3,BGPBDATE=BGPBBD,BGPGBL="^BGPGPDBH("
  1. S BGP365=BGPBDATE
  1. S BGPACTUP=1
  1. S BGPACTCL=1
  1. S BGPACTCB=1
  1. S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
  1. S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
  1. S BGPSEX=$P(^DPT(DFN,0),U,2)
  1. S BGPDM1=$$DM(DFN,,BGPEDATE) ;dm diagnosis ever?
  1. S BGPDM2=$$DM(DFN,BGP365,BGPEDATE) ;dm diagnosis in past year
  1. I BGPDM1 D ;set up 4 dm demoninators
  1. .S BGPFDMD=$$FIRSTDM(DFN,BGPEDATE) ;1 OR 0 FIRST DX BEFORE BEG
  1. .S BGP2V=$$V2(DFN,BGP365,BGPEDATE)
  1. .S BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
  1. .S BGPYDMV=$$V1DM(DFN,BGP365,BGPEDATE)
  1. .S BGPDMD1=0 I BGPFDMD S BGPDMD1=1
  1. .S BGPDMD2=0 I BGPFDMD,BGP2V,BGP2DMV,BGPACTCL S BGPDMD2=1
  1. .S BGPDMD3=0 I BGPFDMD,BGPAGEB>19,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
  1. .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGPYDMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
  1. D CALCIND
  1. K ^TMP($J,"A")
  1. Q
  1. CALCIND ;
  1. D CALCIND^BGP3DCI
  1. Q
  1. CREAT(P,EDATE) ;get all creatines all must be <5
  1. K BGPG
  1. S %=P_"^ALL LAB [DM AUDIT CREATININE TAX;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
  1. 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=""
  1. I E="" Q E
  1. S T=$O(^ATXAX("B","BGP CREATININE LOINC CODES",0))
  1. I 'T Q E
  1. S X=0 F S X=$O(^AUPNVLAB("AC",P,X)) Q:X'=+X!(E="") I $P($G(^AUPNVLAB(X,11)),U,13)]"" D
  1. .Q:'$D(^AUPNVLAB(X,0))
  1. .S V=$P(^AUPNVLAB(X,0),U,3),V=$P($G(^AUPNVSIT(V,0)),U,1),V=$P(V,".")
  1. .Q:V>EDATE
  1. .S J=$P(^AUPNVLAB(X,11),U,13)
  1. .Q:'$$LOINC(J,T)
  1. .Q:$P(^AUPNVLAB(X,0),U,4)=""
  1. .S R=$P(^AUPNVLAB(X,0),U,4)
  1. .I +R>5,+R<15 S E=""
  1. Q E
  1. V1DM(P,D,EDATE) ;
  1. I '$G(P) Q ""
  1. I '$D(^AUPNVSIT("AC",P)) Q ""
  1. S PC=$O(^ATXAX("B","BGP PRIMARY CARE CLINICS",0))
  1. I 'PC Q ""
  1. ;I 'PP Q ""
  1. K ^TMP($J,"A")
  1. S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(D)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"A",1)) Q ""
  1. S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
  1. I 'T Q ""
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1. .Q:'$D(^AUPNVPRV("AD",V))
  1. .;Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2) ;PER TERRY
  1. .Q:'$D(^AUPNVPOV("AD",V))
  1. .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
  1. .Q:'D
  1. .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1. .S Y=$$PRIMPROV^APCLV(V,"F")
  1. .Q:'Y
  1. .;Q:'$D(^ATXAX(PP,21,"B",Y))
  1. .Q:$P($G(^DIC(7,Y,9999999)),U,3)'="Y"
  1. .S Y=$$CLINIC^APCLV(V,"I")
  1. .Q:'Y
  1. .Q:'$D(^ATXAX(PC,21,"B",Y))
  1. .S G=G+1
  1. .Q
  1. Q $S(G<1:"",1:1)
  1. ;
  1. V2(P,BDATE,EDATE) ;
  1. I '$D(^AUPNVSIT("AC",P)) Q ""
  1. K ^TMP($J,"A")
  1. S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"A",1)) Q ""
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1. .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1. .S G=G+1
  1. .Q
  1. Q $S(G<2:"",1:1)
  1. ;
  1. V2DM(P,BDATE,EDATE) ;
  1. I '$G(P) Q ""
  1. I '$D(^AUPNVSIT("AC",P)) Q ""
  1. K ^TMP($J,"A")
  1. S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"A",1)) Q ""
  1. S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
  1. I 'T Q ""
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1. .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1. .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
  1. .Q:'D
  1. .S G=G+1
  1. .Q
  1. Q $S(G<2:"",1:1)
  1. ;
  1. DM(P,BDATE,EDATE) ;EP is patient diabetic 1 or 0
  1. I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
  1. K BGPG
  1. S Y="BGPG("
  1. S X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. I $D(BGPG(1)) Q 1 ;has a dx
  1. Q 0
  1. ;
  1. FIRSTDM(P,EDATE) ;
  1. I $G(P)="" Q ""
  1. K BGPG
  1. S Y="BGPG("
  1. S X=P_"^FIRST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
  1. I '$D(BGPG(1)) Q ""
  1. S X=$$FMDIFF^XLFDT(EDATE,$P(BGPG(1),U))
  1. Q $S(X>365:1,1:"")
  1. ;
  1. LASTVD(P,BDATE,EDATE) ;
  1. I '$D(^AUPNVSIT("AC",P)) Q ""
  1. K ^TMP($J,"A")
  1. S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"A",1)) Q ""
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:'$D(^AUPNVPRV("AD",V))
  1. .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1. .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1. .S G=1
  1. .Q
  1. Q G
  1. ;
  1. LOINC(A,B) ;
  1. NEW %
  1. S %=$P($G(^LAB(95.3,A,9999999)),U,2)
  1. I %]"",$D(^ATXAX(B,21,"B",%)) Q 1
  1. S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)
  1. I $D(^ATXAX(B,21,"B",%)) Q 1
  1. Q ""