BDMD71G ; IHS/CMI/LAB - calc indicators 16 Jan 2007 8:13 PM ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
;
ACTDMPT(DFN,BDMBDAT,BDMEDAT,BDMCOMT,BDMBEN,BDM3YE) ;EP
K BDM365,BDMACUP,BDMACCL,BDMAGEB,BDMAGEE,BDMSEX,BDMDM1,BDMDM2,BDMFDMD,BDM2V,BDM2DMV,BDM1DMV,BDMDMD1,BDMDMD2,BDMDMD3,BDMDMD5
S BDM365=BDMBDAT,BDMDMD2=0
S BDMACUP=$$ACTUP(DFN,BDM3YE,BDMEDAT,BDMCOMT,BDMBEN) ;user pop
I 'BDMACUP Q 0
S BDMACCL=$$ACTCL(DFN,BDM3YE,BDMEDAT) ;active clinical
I 'BDMACCL Q 0 ;not active clinical
S BDMAGEB=$$AGE^AUPNPAT(DFN,BDMBDAT)
S BDMAGEE=$$AGE^AUPNPAT(DFN,BDMEDAT)
S BDMSEX=$P(^DPT(DFN,0),U,2)
S BDMDM1=$$DM(DFN,,BDMEDAT) ;dm diagnosis ever?
S BDMDM2=$$DM(DFN,BDM365,BDMEDAT) ;dm diagnosis in past year
I BDMDM1 D ;set up 4 dm demoninators
.S BDMFDMD=$$FIRSTDM(DFN,BDMEDAT) ;1 OR 0 FIRST DX BEFORE BEG
.S BDM2V=$$V2(DFN,BDM365,BDMEDAT)
.S BDM2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BDMEDAT)
.S BDM1DMV=$$V1DM(DFN,BDM365,BDMEDAT)
.S BDMDMD2=0 I BDMFDMD,BDM2V,BDM2DMV,BDMACCL S BDMDMD2=1
K ^TMP($J,"A")
K BDM365,BDMACUP,BDMACCL,BDMAGEB,BDMAGEE,BDMSEX,BDMDM1,BDMDM2,BDMFDMD,BDM2V,BDM2DMV,BDM1DMV,BDMDMD1
Q BDMDMD2
V1DM(P,D,EDATE) ;
I '$G(P) Q ""
I '$D(^AUPNVSIT("AC",P)) Q ""
S PC=$O(^ATXAX("B","BDM 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 BDMG
S Y="BDMG("
S X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BDMG(1)) Q 1 ;has a dx
Q 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) ;EP - clinical user
NEW CL S CL=$O(^BDMCNTL("B","DM AUDIT 2005 CLINIC LIST 1",0))
NEW CL2 S CL2=$O(^BDMCNTL("B","DM AUDIT 2005 CLINIC LIST 2",0))
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)
.S B=$$CLINIC^APCLV(V,"C")
.Q:B=""
.I 'G,$D(^BDMCNTL(CL,11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BDMCNTL(CL2,11,"B",B)) S S=1
.I G,S S F=1
.Q
Q $S(F:1,1:0)
;
FIRSTDM(P,EDATE) ;
I $G(P)="" Q ""
K BDMG
S Y="BDMG("
S X=P_"^FIRST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
I '$D(BDMG(1)) Q ""
S X=$$FMDIFF^XLFDT(EDATE,$P(BDMG(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 ""
BDMD71G ; IHS/CMI/LAB - calc indicators 16 Jan 2007 8:13 PM ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
+2 ;
ACTDMPT(DFN,BDMBDAT,BDMEDAT,BDMCOMT,BDMBEN,BDM3YE) ;EP
+1 KILL BDM365,BDMACUP,BDMACCL,BDMAGEB,BDMAGEE,BDMSEX,BDMDM1,BDMDM2,BDMFDMD,BDM2V,BDM2DMV,BDM1DMV,BDMDMD1,BDMDMD2,BDMDMD3,BDMDMD5
+2 SET BDM365=BDMBDAT
SET BDMDMD2=0
+3 ;user pop
SET BDMACUP=$$ACTUP(DFN,BDM3YE,BDMEDAT,BDMCOMT,BDMBEN)
+4 IF 'BDMACUP
QUIT 0
+5 ;active clinical
SET BDMACCL=$$ACTCL(DFN,BDM3YE,BDMEDAT)
+6 ;not active clinical
IF 'BDMACCL
QUIT 0
+7 SET BDMAGEB=$$AGE^AUPNPAT(DFN,BDMBDAT)
+8 SET BDMAGEE=$$AGE^AUPNPAT(DFN,BDMEDAT)
+9 SET BDMSEX=$PIECE(^DPT(DFN,0),U,2)
+10 ;dm diagnosis ever?
SET BDMDM1=$$DM(DFN,,BDMEDAT)
+11 ;dm diagnosis in past year
SET BDMDM2=$$DM(DFN,BDM365,BDMEDAT)
+12 ;set up 4 dm demoninators
IF BDMDM1
Begin DoDot:1
+13 ;1 OR 0 FIRST DX BEFORE BEG
SET BDMFDMD=$$FIRSTDM(DFN,BDMEDAT)
+14 SET BDM2V=$$V2(DFN,BDM365,BDMEDAT)
+15 SET BDM2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BDMEDAT)
+16 SET BDM1DMV=$$V1DM(DFN,BDM365,BDMEDAT)
+17 SET BDMDMD2=0
IF BDMFDMD
IF BDM2V
IF BDM2DMV
IF BDMACCL
SET BDMDMD2=1
End DoDot:1
+18 KILL ^TMP($JOB,"A")
+19 KILL BDM365,BDMACUP,BDMACCL,BDMAGEB,BDMAGEE,BDMSEX,BDMDM1,BDMDM2,BDMFDMD,BDM2V,BDM2DMV,BDM1DMV,BDMDMD1
+20 QUIT BDMDMD2
V1DM(P,D,EDATE) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 SET PC=$ORDER(^ATXAX("B","BDM 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 BDMG
+3 SET Y="BDMG("
+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(BDMG(1))
QUIT 1
+6 QUIT 0
+7 ;
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) ;EP - clinical user
+1 NEW CL
SET CL=$ORDER(^BDMCNTL("B","DM AUDIT 2005 CLINIC LIST 1",0))
+2 NEW CL2
SET CL2=$ORDER(^BDMCNTL("B","DM AUDIT 2005 CLINIC LIST 2",0))
+3 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
+4 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+5 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+6 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+7 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+8 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+9 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+10 SET B=$$CLINIC^APCLV(V,"C")
+11 IF B=""
QUIT
+12 ;must be a primary clinic S G=V
IF 'G
IF $DATA(^BDMCNTL(CL,11,"B",B))
SET G=V
+13 IF V'=G
IF $DATA(^BDMCNTL(CL2,11,"B",B))
SET S=1
+14 IF G
IF S
SET F=1
+15 QUIT
End DoDot:1
+16 QUIT $SELECT(F:1,1:0)
+17 ;
FIRSTDM(P,EDATE) ;
+1 IF $GET(P)=""
QUIT ""
+2 KILL BDMG
+3 SET Y="BDMG("
+4 SET X=P_"^FIRST DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,Y)
+5 IF '$DATA(BDMG(1))
QUIT ""
+6 SET X=$$FMDIFF^XLFDT(EDATE,$PIECE(BDMG(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 ""
