- BGP3D10 ; IHS/CMI/LAB - calc measures ;
- ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
- ;
- PROC ;EP
- S BGPBT=$H
- D JRNL^BGP3UTL
- S BGPJ=$J,BGPH=$H
- ;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
- 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,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="^BGPGPDCH("
- S BGP365=BGPBDATE
- S BGPACTUP=1
- S BGPACTCL=1
- S BGPACTCB=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(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,"A")
- Q
- PROCPY ;
- 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="^BGPGPDPH("
- S BGP365=BGPBDATE
- S BGPACTUP=1
- S BGPACTCL=1
- S BGPACTCB=1
- 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 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,"A")
- Q
- PROCBY ;
- 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="^BGPGPDBH("
- S BGP365=BGPBDATE
- S BGPACTUP=1
- S BGPACTCL=1
- S BGPACTCB=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(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,"A")
- Q
- CALCIND ;
- D CALCIND^BGP3DCI
- 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^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) ;
- 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^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
- ;
- 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 ""
- BGP3D10 ; IHS/CMI/LAB - calc measures ;
- +1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
- +2 ;
- PROC ;EP
- +1 SET BGPBT=$HOROLOG
- +2 DO JRNL^BGP3UTL
- +3 SET BGPJ=$JOB
- SET BGPH=$HOROLOG
- +4 ;calculate 3 years before end of each time frame
- +5 SET BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
- +6 SET BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
- +7 SET BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
- +8 ;process each patient
- +9 SET DFN=0
- FOR
- SET DFN=$ORDER(^DIBT(BGPSEAT,1,DFN))
- IF DFN'=+DFN
- QUIT
- Begin DoDot:1
- +10 DO PROCCY
- DO PROCPY
- DO PROCBY
- End DoDot:1
- +11 SET BGPET=$HOROLOG
- +12 QUIT
- +13 ;
- 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 ;
- PROCCY ;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="^BGPGPDCH("
- +7 SET BGP365=BGPBDATE
- +8 SET BGPACTUP=1
- +9 SET BGPACTCL=1
- +10 SET BGPACTCB=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(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
- End DoDot:1
- +25 DO CALCIND
- +26 KILL ^TMP($JOB,"A")
- +27 QUIT
- PROCPY ;
- +1 SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,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=BGPPED
- SET BGPTIME=2
- SET BGPBDATE=BGPPBD
- SET BGPGBL="^BGPGPDPH("
- +6 SET BGP365=BGPBDATE
- +7 SET BGPACTUP=1
- +8 SET BGPACTCL=1
- +9 SET BGPACTCB=1
- +10 SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
- +11 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
- +12 SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)
- +13 ;I $$V2IHD^BGP3D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP3D9(DFN,BGPEDATE) S BGPIHD=1
- +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(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
- End DoDot:1
- +25 DO CALCIND
- +26 KILL ^TMP($JOB,"A")
- +27 QUIT
- PROCBY ;
- +1 SET (BGPACTUP,BGPACTCL,BGPDM1,BGPDM2,BGPDMD1,BGPDMD2,BGPDMD3,BGPDMD4,BGPDMD5,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="^BGPGPDBH("
- +6 SET BGP365=BGPBDATE
- +7 SET BGPACTUP=1
- +8 SET BGPACTCL=1
- +9 SET BGPACTCB=1
- +10 SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
- +11 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
- +12 SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)
- +13 ;dm diagnosis ever?
- SET BGPDM1=$$DM(DFN,,BGPEDATE)
- +14 ;dm diagnosis in past year
- SET BGPDM2=$$DM(DFN,BGP365,BGPEDATE)
- +15 ;set up 4 dm demoninators
- IF BGPDM1
- Begin DoDot:1
- +16 ;1 OR 0 FIRST DX BEFORE BEG
- SET BGPFDMD=$$FIRSTDM(DFN,BGPEDATE)
- +17 SET BGP2V=$$V2(DFN,BGP365,BGPEDATE)
- +18 SET BGP2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
- +19 SET BGPYDMV=$$V1DM(DFN,BGP365,BGPEDATE)
- +20 SET BGPDMD1=0
- IF BGPFDMD
- SET BGPDMD1=1
- +21 SET BGPDMD2=0
- IF BGPFDMD
- IF BGP2V
- IF BGP2DMV
- IF BGPACTCL
- SET BGPDMD2=1
- +22 SET BGPDMD3=0
- IF BGPFDMD
- IF BGPAGEB>19
- IF BGP2DMV
- IF BGPYDMV
- IF $$CREAT(DFN,BGPEDATE)
- SET BGPDMD3=1
- +23 SET BGPDMD5=0
- IF BGPFDMD
- IF BGP2DMV
- IF BGPYDMV
- IF $$CREAT(DFN,BGPEDATE)
- SET BGPDMD5=1
- End DoDot:1
- +24 DO CALCIND
- +25 KILL ^TMP($JOB,"A")
- +26 QUIT
- CALCIND ;
- +1 DO CALCIND^BGP3DCI
- +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^ATXCHK(%,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^ATXCHK(%,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 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 ;
- 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 ""