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

BGP9D1.m

Go to the documentation of this file. 
  1. BGP9D1 ; IHS/CMI/LAB - calc measures 29 Apr 2008 7:38 PM 14 Nov 2006 5:02 PM 12 Nov 2007 11:03 AM 27 May 2009 10:08 AM ; 
  1.  ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
  1.  ;
  1. PROC ;EP
  1.  S BGPBT=$H
  1.  D JRNL^BGP9UTL
  1.  S BGPJ=$J,BGPH=$H
  1.  S BGPCHWC=0
  1.  K ^XTMP("BGP08CPL",BGPJ,BGPH)
  1.  D XTMP^BGP9UTL("BGP08CPL","National GPRA Comp List")
  1.  D XTMP^BGP9UTL("BGP9DNP","National GPRA Patient List")
  1.  D XTMP^BGP9UTL("BGP9D","CRS Local Patient List")
  1.  S BGPCHSO=$P($G(^BGPSITE(DUZ(2),0)),U,6)
  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(^AUPNPAT(DFN)) Q:DFN'=+DFN  D
  1.  .;I DUZ=5634,DFN'=24776 Q
  1.  .I $G(BGPDESGP) S P=$$DP(DFN) I P'=BGPDESGP Q
  1.  .Q:'$D(^DPT(DFN,0))
  1.  .Q:$P($G(^DPT(DFN,0)),U)["DEMO,PATIENT"
  1.  .I $P($G(^BGPSITE(DUZ(2),0)),U,12) Q:$D(^DIBT($P(^BGPSITE(DUZ(2),0),U,12),1,DFN))
  1.  .D PROCCY,PROCPY,PROCBY
  1. N ;
  1.  I BGPRTYPE=1,$G(BGPEXPT),'$G(BGP9GPU) S ^BGPGPDCN(BGPRPT,88888,0)="^90536.0388888A^"_BGPCHWC_"^"_BGPCHWC
  1.  I $G(BGPYWCHW) S ^BGPGPDCN(BGPRPT,88888,0)="^90536.0388888A^"_BGPCHWC_"^"_BGPCHWC
  1.  S BGPET=$H
  1.  Q
  1.  ;
  1. PROCCY ;EP - 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=$S(BGPRTYPE=3:"^BGPHEDCN(",BGPRTYPE=5:"^BGPELDCN(",BGPRTYPE=8:"^BGPEOCN(",1:"^BGPGPDCN(")
  1.  S BGP365=BGPBDATE
  1.  I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGP3YE,BGPEDATE,BGPTAXI,BGPBEN) ;user pop
  1.  I $G(BGPALLPT) S BGPACTUP=$$ACTUPAP(DFN,BGP3YE,BGPEDATE,BGPBEN)
  1.  I 'BGPACTUP,'$G(BGPXPXPX),'$G(BGPIISO) Q
  1.  S BGPACTCL=$$ACTCL(DFN,BGP3YE,BGPEDATE,BGPCHSO) ;active clinical
  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 $G(BGPIISO)=1 S BGPACTUP=1,BGPACTCL=1  ;if in scheduling option, everyone is user pop/active clinical
  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 BGP1DMV=$$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,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
  1.  .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
  1.  I $G(BGPXPRP) Q  ;stop if in national gpra export
  1.  I $G(BGPIISO) D ISS^BGP9DPA1 K ^TMP($J,"A") Q  ;SCHEDULING OPTION
  1.  D CALCIND
  1.  I BGPRTYPE=1,$G(BGPYWCHW),'$G(BGP9GPU) D
  1.  .;Q:$$AGE^AUPNPAT(DFN,BGPED)>18
  1.  .D GEN^BGP9DCHW
  1.  K ^TMP($J,"A")
  1.  Q
  1. PROCPY ;
  1.  K ^TMP($J)
  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=$S(BGPRTYPE=3:"^BGPHEDPN(",BGPRTYPE=5:"^BGPELDPN(",BGPRTYPE=8:"^BGPEOPN(",1:"^BGPGPDPN(")
  1.  S BGP365=BGPBDATE
  1.  I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGPP3YE,BGPEDATE,BGPTAXI,BGPBEN) ;user pop
  1.  I $G(BGPALLPT) S BGPACTUP=$$ACTUPAP(DFN,BGPP3YE,BGPEDATE,BGPBEN)
  1.  I 'BGPACTUP Q  ;if not in user pop, don't use patient
  1.  S BGPACTCL=$$ACTCL(DFN,BGPP3YE,BGPEDATE,BGPCHSO) ;active clinical
  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 BGP1DMV=$$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,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
  1.  .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
  1.  D CALCIND
  1.  K ^TMP($J)
  1.  Q
  1. PROCBY ;
  1.  K ^TMP($J)
  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=$S(BGPRTYPE=3:"^BGPHEDBN(",BGPRTYPE=5:"^BGPELDBN(",BGPRTYPE=8:"^BGPEOBN(",1:"^BGPGPDBN(")
  1.  S BGP365=BGPBDATE
  1.  I '$G(BGPALLPT) S BGPACTUP=$$ACTUP(DFN,BGPB3YE,BGPEDATE,BGPTAXI,BGPBEN) ;user pop
  1.  I $G(BGPALLPT) S BGPACTUP=$$ACTUPAP(DFN,BGPB3YE,BGPEDATE,BGPBEN)
  1.  I 'BGPACTUP Q  ;if not in user pop, don't use patient
  1.  S BGPACTCL=$$ACTCL(DFN,BGPB3YE,BGPEDATE,BGPCHSO) ;active clinical
  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 BGP1DMV=$$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,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD3=1
  1.  .S BGPDMD5=0 I BGPFDMD,BGP2DMV,BGP1DMV,$$CREAT(DFN,BGPEDATE) S BGPDMD5=1
  1.  D CALCIND
  1.  K ^TMP($J)
  1.  Q
  1. CALCIND ;
  1.  I BGPRTYPE=3 D CALCIND^BGP9DCHI Q
  1.  I BGPRTYPE=5 D CALCIND^BGP9DCEI Q
  1.  I BGPRTYPE=8 D CALCIND^BGP9EOCI Q
  1.  D CALCIND^BGP9DCI
  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:$P(^AUPNVSIT(V,0),U,6)=""
  1.  .I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
  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) ;EP
  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.  .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1.  .I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
  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.  .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1.  .I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
  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. ACTUPAP(P,BDATE,EDATE,B) ;EP - is this patient in user pop?
  1.  I B=1,$$BEN^AUPNPAT(P,"C")'="01" Q 0  ;must be Indian/Alaskan Native
  1.  I B=2,$$BEN^AUPNPAT(P,"C")="01" Q 0  ;must not be I/A
  1.  S DOD=$$DOD^AUPNPAT(P) I DOD]"",DOD<EDATE Q 0
  1.  S X=$$LASTVD(P,BDATE,EDATE)
  1.  Q $S(X:1,1:0)
  1.  ;
  1. ACTUP(P,BDATE,EDATE,T,B) ;EP - is this patient in user pop?
  1.  I B=1,$$BEN^AUPNPAT(P,"C")'="01" Q 0  ;must be Indian/Alaskan Native
  1.  I B=2,$$BEN^AUPNPAT(P,"C")="01" Q 0  ;must not be I/A
  1.  S DOD=$$DOD^AUPNPAT(P) I DOD]"",DOD<EDATE Q 0
  1.  S X=$P($G(^AUPNPAT(P,11)),U,18) I X="" Q 0
  1.  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
  1.  S X=$$LASTVD(P,BDATE,EDATE)
  1.  Q $S(X:1,1:0)
  1.  ;
  1. ACTCL(P,BDATE,EDATE,CHS) ;EP - clinical user
  1.  I CHS G CHSACTCL
  1.  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
  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.  .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1.  .I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
  1.  .S B=$$CLINIC^APCLV(V,"C")
  1.  .Q:B=""
  1.  .I 'G,$D(^BGPCTRL($O(^BGPCTRL("B",2009,0)),11,"B",B)) S G=V  ;must be a primary clinic S G=V
  1.  .I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2009,0)),12,"B",B)) S S=1
  1.  .I G,S S F=1
  1.  .Q
  1.  Q $S(F:1,1:0)
  1.  ;
  1. CHSACTCL ;chs only sites active clinical defintion
  1.  ;2 chs visits in past 3 years
  1.  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
  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:"SAHOI"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:"C"'[$P(^AUPNVSIT(V,0),U,3)
  1.  .S F=F+1
  1.  Q $S(F>1:1,1:0)
  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.  .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1.  .I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
  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 ""
  1. DP(P) ;
  1.  I $P(^AUPNPAT(P,0),U,14) Q $P(^AUPNPAT(P,0),U,14)
  1.  I $T(ALLDP^BDPAPI)="" Q ""
  1.  NEW X
  1.  D ALLDP^BDPAPI(P,"DESIGNATED PRIMARY PROVIDER",.X)
  1.  Q $P($G(X("DESIGNATED PRIMARY PROVIDER")),U,2)