BGP8PC2 ; IHS/CMI/LAB - measure I2 ; 02 Feb 2018 11:25 AM
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
DMG ;EP
S (BGPN1,BGPD1)=0
S BGPDV=""
I BGPAGEE<18 S BGPSTOP=1 Q ;18 or greater during time period
I BGPAGEB>74 S BGPSTOP=1 Q ;75 or less during time period
S V=$$DMRP(DFN,BGPBDATE,BGPEDATE) I 'V S BGPSTOP=1 Q ;no dm pov or problem list entry
S BGPDV=$$ENC1(DFN,BGPBDATE,BGPEDATE) I BGPDV="" S BGPSTOP=1 Q ;no office visit
;
;now what about exclusions?
I $$HOSPIND(DFN,BGPBDATE,BGPEDATE) S BGPSTOP=1 Q ;no hospice pts
S BGPD1=1
S X=$$HGBA1C(DFN,BGPBDATE,BGPEDATE)
I $E(X)=1 S BGPN1=1
S BGPVALUE=""
S BGPVALUE="ENC "_$P(BGPDV,U,2)_"|||" ;hit denominator
S BGPVALUE=BGPVALUE_$S(BGPN1:"*** ",1:"")_"A1c: "_$P(X,U,2)_" "_$P(X,U,3)
I BGPN1 ;S BGPVALUE=BGPVALUE_" **"
K V,BGPDV
Q
ENC1(P,BDATE,EDATE) ;EP - have encounter per CMS122v6
;HAS one of the following
;1. cpt in BGP IPC OFFICE VISIT CPTS
;2. snomed in PXRM BGP IPC FACE2FACE
;3. CPT in BGP IPC PREVCARE EOV >=18 CPTS
;4. CPT in BGP IPC PREVCARE IOV >=18 CPTS
;5. CPT in BGP IPC HOMEHEALTH VISIT CPTS
;6. CPT in BGP IPC ANNUAL WELLNESS CPTS
NEW X,Y,Z,G,BGPV,D
;Let's check all Visits, looping through once
S G="" ;return variable
;get all visits in date range in BGPV
D ALLV^APCLAPIU(P,BDATE,EDATE,"BGPV")
;now loop through and check Face to Face and .17 in visit and check v cpts attached to the visit
S X=0 F S X=$O(BGPV(X)) Q:X'=+X!(G) S V=$P(BGPV(X),U,5) D
.Q:'$P(^AUPNVSIT(V,0),U,9) ;no dependent entries
.Q:$P(^AUPNVSIT(V,0),U,11) ;deleted
.S D=$$VD^APCLV(V)
.S Y=$$FTOF(V) I Y]"" S G=1_U_$$DATE^BGP8UTL(D)_" FTOF: "_Y Q
.;is .17 a cpt we want?
.S Y=$$VALI^XBDIQ1(9000010,V,.17)
.I Y,$$OFFCPT(Y) S G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$P($$CPT^ICPTCOD(Y),U,2) Q
.;now check all V CPTs
.S Z=0 F S Z=$O(^AUPNVCPT("AD",V,Z)) Q:Z'=+Z!(G) D
..S Y=$P($G(^AUPNVCPT(Z,0)),U,1)
..I Y,$$OFFCPT(Y) S G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$P($$CPT^ICPTCOD(Y),U,2) Q
Q G
FTOF(V) ;EP
NEW A,B,C
S A=0,B=""
F S A=$O(^AUPNVSIT(V,28,"B",A)) Q:A=""!(B]"") D
.I $D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC FACE2FACE",A)) S B=A
Q B
OFFCPT(C) ;EP
I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC OFFICE VISIT CPTS",0)),1) Q 1
I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC PREVCARE EOV >=18 CPTS",0)),1) Q 1
I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC PREVCARE IOV >=18 CPTS",0)),1) Q 1
I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC HOMEHEALTH VISIT CPTS",0)),1) Q 1
I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC ANNUAL WELLNESS CPTS",0)),1) Q 1
Q ""
DMRP(P,BDATE,EDATE) ;EP - DM DURING REPORT PERIOD
NEW X,Y,Z
I $$PLTAXND^BGP8DU(P,"BGP IPC DIABETES DXS",EDATE,1) Q 1
I $$IPLSNOND^BGP8DU(P,"PXRM BGP IPC DIABETES",EDATE,1) Q 1
I $$LASTDX^BGP8UTL1(P,"BGP IPC DIABETES DXS",BDATE,EDATE) Q 1
Q ""
HOSPIND(P,BDATE,EDATE) ;EP - Hospice indicator IPC
;GET ALL VISITS IN TIME PERIOD
;CHECK SNOMED FOR INPATIENT AND DSCH
;CHECK OUTPATIENT SNOMED IN V POV
;CHECK PROBLEM LIST ENTRIES FOR NOT INACTIVE AND NOT DELETED
;
;1. CHECK V POV FOR SNOMED CODES
NEW S,Y,T,G,D,M,O,A,B,V
S T="PXRM BGP IPC HOSPICE"
S G=""
S S=0 F S S=$O(^XTMP("BGPSNOMEDSUBSET",$J,T,S)) Q:S=""!(G) D
.Q:'$D(^AUPNVPOV("ASNC",P,S))
.S D=0 F S D=$O(^AUPNVPOV("ASNC",P,S,D)) Q:D=""!(G) D
..S Y=9999999-D
..Q:Y<BDATE
..Q:Y>EDATE
..S G=1
I G Q G
I $$IPLSNOND^BGP8DU(P,"PXRM BGP IPC HOSPICE",EDATE,1) Q 1
I G Q G
;check all discharges V Hospitalization discharges during the report period
S X=0,G=""
F S X=$O(^AUPNVINP("AC",P,X)) Q:X'=+X!(G) D
.Q:'$D(^AUPNVINP(X,0))
.S D=$P($P(^AUPNVINP(X,0),U),".")
.I D<BDATE Q
.I D>EDATE Q
.;is where seen correct?
.S V=$P(^AUPNVINP(X,0),U,3)
.Q:'V
.S Z=0
.S A=0 F S A=$O(^AUPNVSIT(V,26,"B",A)) Q:A="" I $D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC INPT ENC",A)) S Z=1
.S Y=$$VAL^XBDIQ1(9000010.02,X,6107)
.I Z,Y]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC DISCHG HOSPICE",Y)) S G=1
.I G Q
.S A=0 F S A=$O(^AUPNVSIT(V,28,"B",A)) Q:A="" I $D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC INPT ENC",A)) S Z=1
.S Y=$$VAL^XBDIQ1(9000010.02,X,6107)
.I Z,Y]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC DISCHG HOSPICE",Y)) S G=1
Q G
HGBA1C(P,BDATE,EDATE) ;EP
NEW BGPG,BGPT,BGPC,T,BGPLT,E,D,B,L,X,J,C,%
K BGPG,BGPT
S BGPC=0
;now get all loinc/taxonomy tests
S T=$O(^ATXAX("B","BGP IPC HBA1C LOINC CODES",0))
S BGPLT=$O(^ATXLAB("B","DM AUDIT HGB A1C TAX",0))
S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B) D
.S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L D
..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X D
...Q:'$D(^AUPNVLAB(X,0))
...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) D
....;SET RESULT DATE/TIME 999999 WITH TIME, IF BLANK SET VISIT DATE/TIME WITH IEN
....S %=$$VDTM^APCLV($P(^AUPNVLAB(X,0),U,3))
....S %=(9999999-$P(%,"."))_"."_(9999-$$RZERO^BGP8UTL($P(%,".",2),4)),%=+%
....S BGPC=BGPC+1,BGPT(%,X)=$P(^AUPNVLAB(X,0),U,4) Q
...Q:'T
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC(J,T)
...S %=$$VDTM^APCLV($P(^AUPNVLAB(X,0),U,3))
...S %=(9999999-$P(%,"."))_"."_+(9999-$$RZERO^BGP8UTL($P(%,".",2),4)),%=+%
...S BGPC=BGPC+1,BGPT(%,X)=$P(^AUPNVLAB(X,0),U,4) Q
...Q
; now got though and set return value of done 1 or 0^numerator 2-7^date^value
I '$D(BGPT) Q 1_U_"No HbA1c Tests"
S D=0,G="" F S D=$O(BGPT(D)) Q:D=""!(G]"") D
.S C=0 F S C=$O(BGPT(D,C)) Q:C="" D
..S X=BGPT(D,C)
..I $$UP^XLFSTR(X)="COMMENT" Q
..I X="" Q
..I $E(X)[">" S G=1_U_$$DATE^BGP8UTL(9999999-$P(D,"."))_U_X Q
..I $E(X)["<" S G=1_U_$$DATE^BGP8UTL(9999999-$P(D,"."))_U_X Q
..I $E(X)'=+$E(X) Q
..S G=1_U_$$DATE^BGP8UTL(9999999-$P(D,"."))_U_X
I G="" Q 1_U_"No Tests w/ Result"
S R=$P(G,U,3)
I $E(R)=">" Q G
I $E(R)="<" Q 0_U_$P(G,U,2,3)
S R=+R
I R>9 Q G
Q 0_U_$P(G,U,2,3)
LOINC(A,B) ;EP
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 ""
BGP8PC2 ; IHS/CMI/LAB - measure I2 ; 02 Feb 2018 11:25 AM
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
DMG ;EP
+1 SET (BGPN1,BGPD1)=0
+2 SET BGPDV=""
+3 ;18 or greater during time period
IF BGPAGEE<18
SET BGPSTOP=1
QUIT
+4 ;75 or less during time period
IF BGPAGEB>74
SET BGPSTOP=1
QUIT
+5 ;no dm pov or problem list entry
SET V=$$DMRP(DFN,BGPBDATE,BGPEDATE)
IF 'V
SET BGPSTOP=1
QUIT
+6 ;no office visit
SET BGPDV=$$ENC1(DFN,BGPBDATE,BGPEDATE)
IF BGPDV=""
SET BGPSTOP=1
QUIT
+7 ;
+8 ;now what about exclusions?
+9 ;no hospice pts
IF $$HOSPIND(DFN,BGPBDATE,BGPEDATE)
SET BGPSTOP=1
QUIT
+10 SET BGPD1=1
+11 SET X=$$HGBA1C(DFN,BGPBDATE,BGPEDATE)
+12 IF $EXTRACT(X)=1
SET BGPN1=1
+13 SET BGPVALUE=""
+14 ;hit denominator
SET BGPVALUE="ENC "_$PIECE(BGPDV,U,2)_"|||"
+15 SET BGPVALUE=BGPVALUE_$SELECT(BGPN1:"*** ",1:"")_"A1c: "_$PIECE(X,U,2)_" "_$PIECE(X,U,3)
+16 ;S BGPVALUE=BGPVALUE_" **"
IF BGPN1
+17 KILL V,BGPDV
+18 QUIT
ENC1(P,BDATE,EDATE) ;EP - have encounter per CMS122v6
+1 ;HAS one of the following
+2 ;1. cpt in BGP IPC OFFICE VISIT CPTS
+3 ;2. snomed in PXRM BGP IPC FACE2FACE
+4 ;3. CPT in BGP IPC PREVCARE EOV >=18 CPTS
+5 ;4. CPT in BGP IPC PREVCARE IOV >=18 CPTS
+6 ;5. CPT in BGP IPC HOMEHEALTH VISIT CPTS
+7 ;6. CPT in BGP IPC ANNUAL WELLNESS CPTS
+8 NEW X,Y,Z,G,BGPV,D
+9 ;Let's check all Visits, looping through once
+10 ;return variable
SET G=""
+11 ;get all visits in date range in BGPV
+12 DO ALLV^APCLAPIU(P,BDATE,EDATE,"BGPV")
+13 ;now loop through and check Face to Face and .17 in visit and check v cpts attached to the visit
+14 SET X=0
FOR
SET X=$ORDER(BGPV(X))
IF X'=+X!(G)
QUIT
SET V=$PIECE(BGPV(X),U,5)
Begin DoDot:1
+15 ;no dependent entries
IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+16 ;deleted
IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+17 SET D=$$VD^APCLV(V)
+18 SET Y=$$FTOF(V)
IF Y]""
SET G=1_U_$$DATE^BGP8UTL(D)_" FTOF: "_Y
QUIT
+19 ;is .17 a cpt we want?
+20 SET Y=$$VALI^XBDIQ1(9000010,V,.17)
+21 IF Y
IF $$OFFCPT(Y)
SET G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$PIECE($$CPT^ICPTCOD(Y),U,2)
QUIT
+22 ;now check all V CPTs
+23 SET Z=0
FOR
SET Z=$ORDER(^AUPNVCPT("AD",V,Z))
IF Z'=+Z!(G)
QUIT
Begin DoDot:2
+24 SET Y=$PIECE($GET(^AUPNVCPT(Z,0)),U,1)
+25 IF Y
IF $$OFFCPT(Y)
SET G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$PIECE($$CPT^ICPTCOD(Y),U,2)
QUIT
End DoDot:2
End DoDot:1
+26 QUIT G
FTOF(V) ;EP
+1 NEW A,B,C
+2 SET A=0
SET B=""
+3 FOR
SET A=$ORDER(^AUPNVSIT(V,28,"B",A))
IF A=""!(B]"")
QUIT
Begin DoDot:1
+4 IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,"PXRM BGP IPC FACE2FACE",A))
SET B=A
End DoDot:1
+5 QUIT B
OFFCPT(C) ;EP
+1 IF $$ICD^ATXAPI(C,$ORDER(^ATXAX("B","BGP IPC OFFICE VISIT CPTS",0)),1)
QUIT 1
+2 IF $$ICD^ATXAPI(C,$ORDER(^ATXAX("B","BGP IPC PREVCARE EOV >=18 CPTS",0)),1)
QUIT 1
+3 IF $$ICD^ATXAPI(C,$ORDER(^ATXAX("B","BGP IPC PREVCARE IOV >=18 CPTS",0)),1)
QUIT 1
+4 IF $$ICD^ATXAPI(C,$ORDER(^ATXAX("B","BGP IPC HOMEHEALTH VISIT CPTS",0)),1)
QUIT 1
+5 IF $$ICD^ATXAPI(C,$ORDER(^ATXAX("B","BGP IPC ANNUAL WELLNESS CPTS",0)),1)
QUIT 1
+6 QUIT ""
DMRP(P,BDATE,EDATE) ;EP - DM DURING REPORT PERIOD
+1 NEW X,Y,Z
+2 IF $$PLTAXND^BGP8DU(P,"BGP IPC DIABETES DXS",EDATE,1)
QUIT 1
+3 IF $$IPLSNOND^BGP8DU(P,"PXRM BGP IPC DIABETES",EDATE,1)
QUIT 1
+4 IF $$LASTDX^BGP8UTL1(P,"BGP IPC DIABETES DXS",BDATE,EDATE)
QUIT 1
+5 QUIT ""
HOSPIND(P,BDATE,EDATE) ;EP - Hospice indicator IPC
+1 ;GET ALL VISITS IN TIME PERIOD
+2 ;CHECK SNOMED FOR INPATIENT AND DSCH
+3 ;CHECK OUTPATIENT SNOMED IN V POV
+4 ;CHECK PROBLEM LIST ENTRIES FOR NOT INACTIVE AND NOT DELETED
+5 ;
+6 ;1. CHECK V POV FOR SNOMED CODES
+7 NEW S,Y,T,G,D,M,O,A,B,V
+8 SET T="PXRM BGP IPC HOSPICE"
+9 SET G=""
+10 SET S=0
FOR
SET S=$ORDER(^XTMP("BGPSNOMEDSUBSET",$JOB,T,S))
IF S=""!(G)
QUIT
Begin DoDot:1
+11 IF '$DATA(^AUPNVPOV("ASNC",P,S))
QUIT
+12 SET D=0
FOR
SET D=$ORDER(^AUPNVPOV("ASNC",P,S,D))
IF D=""!(G)
QUIT
Begin DoDot:2
+13 SET Y=9999999-D
+14 IF Y<BDATE
QUIT
+15 IF Y>EDATE
QUIT
+16 SET G=1
End DoDot:2
End DoDot:1
+17 IF G
QUIT G
+18 IF $$IPLSNOND^BGP8DU(P,"PXRM BGP IPC HOSPICE",EDATE,1)
QUIT 1
+19 IF G
QUIT G
+20 ;check all discharges V Hospitalization discharges during the report period
+21 SET X=0
SET G=""
+22 FOR
SET X=$ORDER(^AUPNVINP("AC",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+23 IF '$DATA(^AUPNVINP(X,0))
QUIT
+24 SET D=$PIECE($PIECE(^AUPNVINP(X,0),U),".")
+25 IF D<BDATE
QUIT
+26 IF D>EDATE
QUIT
+27 ;is where seen correct?
+28 SET V=$PIECE(^AUPNVINP(X,0),U,3)
+29 IF 'V
QUIT
+30 SET Z=0
+31 SET A=0
FOR
SET A=$ORDER(^AUPNVSIT(V,26,"B",A))
IF A=""
QUIT
IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,"PXRM BGP IPC INPT ENC",A))
SET Z=1
+32 SET Y=$$VAL^XBDIQ1(9000010.02,X,6107)
+33 IF Z
IF Y]""
IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,"PXRM BGP IPC DISCHG HOSPICE",Y))
SET G=1
+34 IF G
QUIT
+35 SET A=0
FOR
SET A=$ORDER(^AUPNVSIT(V,28,"B",A))
IF A=""
QUIT
IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,"PXRM BGP IPC INPT ENC",A))
SET Z=1
+36 SET Y=$$VAL^XBDIQ1(9000010.02,X,6107)
+37 IF Z
IF Y]""
IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,"PXRM BGP IPC DISCHG HOSPICE",Y))
SET G=1
End DoDot:1
+38 QUIT G
HGBA1C(P,BDATE,EDATE) ;EP
+1 NEW BGPG,BGPT,BGPC,T,BGPLT,E,D,B,L,X,J,C,%
+2 KILL BGPG,BGPT
+3 SET BGPC=0
+4 ;now get all loinc/taxonomy tests
+5 SET T=$ORDER(^ATXAX("B","BGP IPC HBA1C LOINC CODES",0))
+6 SET BGPLT=$ORDER(^ATXLAB("B","DM AUDIT HGB A1C TAX",0))
+7 SET B=9999999-BDATE
SET E=9999999-EDATE
SET D=E-1
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(D>B)
QUIT
Begin DoDot:1
+8 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L
QUIT
Begin DoDot:2
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X
QUIT
Begin DoDot:3
+10 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+11 IF BGPLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(BGPLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
Begin DoDot:4
+12 ;SET RESULT DATE/TIME 999999 WITH TIME, IF BLANK SET VISIT DATE/TIME WITH IEN
+13 SET %=$$VDTM^APCLV($PIECE(^AUPNVLAB(X,0),U,3))
+14 SET %=(9999999-$PIECE(%,"."))_"."_(9999-$$RZERO^BGP8UTL($PIECE(%,".",2),4))
SET %=+%
+15 SET BGPC=BGPC+1
SET BGPT(%,X)=$PIECE(^AUPNVLAB(X,0),U,4)
QUIT
End DoDot:4
+16 IF 'T
QUIT
+17 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+18 IF '$$LOINC(J,T)
QUIT
+19 SET %=$$VDTM^APCLV($PIECE(^AUPNVLAB(X,0),U,3))
+20 SET %=(9999999-$PIECE(%,"."))_"."_+(9999-$$RZERO^BGP8UTL($PIECE(%,".",2),4))
SET %=+%
+21 SET BGPC=BGPC+1
SET BGPT(%,X)=$PIECE(^AUPNVLAB(X,0),U,4)
QUIT
+22 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+23 ; now got though and set return value of done 1 or 0^numerator 2-7^date^value
+24 IF '$DATA(BGPT)
QUIT 1_U_"No HbA1c Tests"
+25 SET D=0
SET G=""
FOR
SET D=$ORDER(BGPT(D))
IF D=""!(G]"")
QUIT
Begin DoDot:1
+26 SET C=0
FOR
SET C=$ORDER(BGPT(D,C))
IF C=""
QUIT
Begin DoDot:2
+27 SET X=BGPT(D,C)
+28 IF $$UP^XLFSTR(X)="COMMENT"
QUIT
+29 IF X=""
QUIT
+30 IF $EXTRACT(X)[">"
SET G=1_U_$$DATE^BGP8UTL(9999999-$PIECE(D,"."))_U_X
QUIT
+31 IF $EXTRACT(X)["<"
SET G=1_U_$$DATE^BGP8UTL(9999999-$PIECE(D,"."))_U_X
QUIT
+32 IF $EXTRACT(X)'=+$EXTRACT(X)
QUIT
+33 SET G=1_U_$$DATE^BGP8UTL(9999999-$PIECE(D,"."))_U_X
End DoDot:2
End DoDot:1
+34 IF G=""
QUIT 1_U_"No Tests w/ Result"
+35 SET R=$PIECE(G,U,3)
+36 IF $EXTRACT(R)=">"
QUIT G
+37 IF $EXTRACT(R)="<"
QUIT 0_U_$PIECE(G,U,2,3)
+38 SET R=+R
+39 IF R>9
QUIT G
+40 QUIT 0_U_$PIECE(G,U,2,3)
LOINC(A,B) ;EP
+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 ""
