BDMPG12 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
;;2.0;IHS DIABETES SYSTEM;**12**;JUN 14, 2007;Build 51
;
;cmi/anch/maw 9/10/2007 code set versioning in HYSTER,MAMMOG
;
SETN ;
S N="" NEW A,G S (A,G)=0 F S A=$O(BDM(A)) Q:A'=+A!(G) I $P(^AUPNVLAB(+$P(BDM(A),U,4),0),U,4)]"" S G=A
S N=$S(G:G,1:1)
Q
TBTX(P) ;EP
I '$G(P) Q ""
NEW BDM,E,X
K BDM
S X=P_"^LAST HEALTH [DM AUDIT TB HEALTH FACTORS" S E=$$START1^APCLDF(X,"BDM(")
I E Q ""
I $D(BDM(1)) Q $P(BDM(1),U,3)_U_$S($P(BDM(1),U,3)["TX COMPLETE":"1 Yes",$P(BDM(1),U,3)["TX INCOMPLETE"!($P(BDM(1),U,3)["TX UNTREATED"):"2 No",1:"4 Unknown")
N T,Y S T=$O(^ATXAX("B","DM AUDIT TB HEALTH FACTORS",0))
I 'T Q ""
N G S G="",X=0 F S X=$O(^AUPNHF("AA",P,X)) Q:X'=+X!(G]"") I $D(^ATXAX(T,21,"B",X)) S G=$P(^AUTTHF(X,0),U)
I G]"" Q G_U_$S(G["TX COMPLETE":"1 Yes",G["TX INCOMPLETE"!(G["TX UNTREATED"):"2 No",1:"4 Unknown")
Q ""
CPT(P,BDATE,EDATE,T,F) ;EP return ien of CPT entry if patient had this CPT
I '$G(P) Q ""
I $G(T)="" Q ""
I '$G(F) S F=1
I $G(EDATE)="" Q ""
I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
;go through visits in a date range for this patient, check cpts
NEW D,BD,ED,X,Y,D,G,V
S ED=9999999-EDATE,BD=9999999-BDATE,G=0
F S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G) D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..Q:'$D(^AUPNVCPT("AD",V))
..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G) D
...I $$ICD^BDMUTL($P(^AUPNVCPT(X,0),U),T,1) S G=X
...Q
..Q
.Q
I 'G Q ""
I F=1 Q $S(G:1,1:"")
I F=2 Q G
I F=3 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
I F=4 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
Q ""
RAD(P,BDATE,EDATE,T,F) ;EP return if a v rad entry in date range
I '$G(P) Q ""
I $G(T)="" Q ""
I '$G(F) S F=1
I $G(EDATE)="" Q ""
I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
;go through visits in a date range for this patient, check cpts
NEW D,BD,ED,X,Y,D,G,V
S ED=9999999-EDATE,BD=9999999-BDATE,G=0
F S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G) D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..Q:'$D(^AUPNVRAD("AD",V))
..S X=0 F S X=$O(^AUPNVRAD("AD",V,X)) Q:X'=+X!(G) D
...Q:'$D(^AUPNVRAD(X,0))
...S Y=$P(^AUPNVRAD(X,0),U) Q:'Y Q:'$D(^RAMIS(71,Y,0))
...S Y=$P($G(^RAMIS(71,Y,0)),U,9) Q:'Y
...Q:'$$ICD^BDMUTL(Y,T,1)
...S G=X
...Q
..Q
.Q
I 'G Q ""
I F=1 Q $S(G:1,1:"")
I F=2 Q G
I F=3 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
I F=4 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
Q ""
EKG(P,EDATE,F) ;EP
I $G(F)="" S F="E"
S %DT="P",X=EDATE D ^%DT S ED=Y
NEW BDM,X,%,E,LEKG S LEKG="",%=P_"^LAST DIAGNOSTIC ECG SUMMARY;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
I $D(BDM) S LEKG=$P(BDM(1),U)
K BDM S %=P_"^LAST PROCEDURE 89.51",E=$$START1^APCLDF(%,"BDM(")
I $D(BDM(1)) D
.Q:LEKG>$P(BDM(1),U)
.S LEKG=$P(BDM(1),U)
K BDM S %=P_"^LAST PROCEDURE 89.52",E=$$START1^APCLDF(%,"BDM(")
I $D(BDM(1)) D
.Q:LEKG>$P(BDM(1),U)
.S LEKG=$P(BDM(1),U)
K BDM S %=P_"^LAST PROCEDURE 89.53",E=$$START1^APCLDF(%,"BDM(")
I $D(BDM(1)) D
.Q:LEKG>$P(BDM(1),U)
.S LEKG=$P(BDM(1),U)
K BDM S %=P_"^LAST PROCEDURE 89.50",E=$$START1^APCLDF(%,"BDM(")
I $D(BDM(1)) D
.Q:LEKG>$P(BDM(1),U)
.S LEKG=$P(BDM(1),U)
K BDM S %=P_"^LAST DX 794.31",E=$$START1^APCLDF(%,"BDM(")
I $D(BDM(1)) D
.Q:LEKG>$P(BDM(1),U)
.S LEKG=$P(BDM(1),U)
;check CPT codes in year prior to date range
S T=$O(^ATXAX("B","DM AUDIT EKG CPTS",0))
K BDM I T S BDM(1)=$$CPT^BDMPG12(P,,ED,"DM AUDIT EKG CPTS",3) D
.I BDM(1)="" K BDM Q
.Q:LEKG>$P(BDM(1),U)
.S LEKG=$P(BDM(1),U)
K BDM I T S BDM(1)=$$RAD^BDMPG12(P,,ED,"DM AUDIT EKG CPTS",3) D
.I BDM(1)="" K BDM Q
.Q:LEKG>$P(BDM(1),U)
.S LEKG=$P(BDM(1),U)
Q $S(F="E":$$FMTE^XLFDT(LEKG),1:LEKG)
;
ALT(P,BDATE,EDATE) ;EP
NEW BDM,X,%,E,R,V
K BDM
S %=P_"^LAST LAB [DM AUDIT ALT TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
I '$D(BDM(1)) Q ""
S D=$P(BDM(1),U),D=$$FMTE^XLFDT(D) K BDM S %=P_"^ALL LAB [DM AUDIT ALT TAX;DURING "_D_"-"_D,E=$$START1^APCLDF(%,"BDM(")
NEW N D SETN
Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_" "_$$FMTE^XLFDT($P(BDM(N),U),5)
AST(P,BDATE,EDATE) ;EP
NEW BDM,X,%,E,R,V
K BDM
S %=P_"^LAST LAB [DM AUDIT AST TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
I '$D(BDM(1)) Q ""
S D=$P(BDM(1),U),D=$$FMTE^XLFDT(D) K BDM S %=P_"^ALL LAB [DM AUDIT AST TAX;DURING "_D_"-"_D,E=$$START1^APCLDF(%,"BDM(")
NEW N D SETN
Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_" "_$$FMTE^XLFDT($P(BDM(N),U),5)
INSULIN(P,BDATE,EDATE) ;EP
NEW X,BDM,E
S X=P_"^LAST MEDS [DM AUDIT INSULIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
I $D(BDM(1)) Q "X"
Q ""
TXNAME(V) ;EP
I $G(V)="" Q ""
S V=$$TXNAMES(V)
Q $E(V,1,16)
TXNAMES(Y) ;
I Y=1 Q "DIET"
I Y=2 Q "INSULIN"
I Y=3 Q "SULFONYLUREA"
I Y=4 Q "METFORMIN (GLUCOPHAGE)"
I Y=5 Q "ACARBOSE OR MIGLITOL"
I Y=6 Q "GLITAZONE"
I Y=9 Q "UNKNOWN/REFUSED"
I Y=23 Q "INSULIN+S'UREA"
I Y=24 Q "INSULIN+MET"
I Y=25 Q "INSULIN+ACAR"
I Y=26 Q "INSULIN+GLITAZONE"
I Y=34 Q "S'UREA+MET"
I Y=35 Q "S'UREA+ACAR"
I Y=36 Q "S'UREA+GLITAZONE"
I Y=45 Q "MET+ACAR"
I Y=46 Q "MET+GLITAZONE"
I Y=56 Q "ACAR+GLITAZONE"
I Y=234 Q "INS+S'UREA+MET"
I Y=235 Q "INS+S'UREA+ACAR"
I Y=236 Q "INS+S'UREA+GLIT"
I Y=245 Q "INS+MET+ACAR"
I Y=246 Q "INS+MET+GLITAZONE"
I Y=256 Q "INS+ACAR+GLITAZONE"
I Y=345 Q "S'UREA+MET+ACAR"
I Y=346 Q "S'UREA+MET+GLIT"
I Y=356 Q "S'UREA+ACAR+GLIT"
I Y=456 Q "MET+ACAR+GLIT"
Q ""
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 ""
BDMPG12 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
+1 ;;2.0;IHS DIABETES SYSTEM;**12**;JUN 14, 2007;Build 51
+2 ;
+3 ;cmi/anch/maw 9/10/2007 code set versioning in HYSTER,MAMMOG
+4 ;
SETN ;
+1 SET N=""
NEW A,G
SET (A,G)=0
FOR
SET A=$ORDER(BDM(A))
IF A'=+A!(G)
QUIT
IF $PIECE(^AUPNVLAB(+$PIECE(BDM(A),U,4),0),U,4)]""
SET G=A
+2 SET N=$SELECT(G:G,1:1)
+3 QUIT
TBTX(P) ;EP
+1 IF '$GET(P)
QUIT ""
+2 NEW BDM,E,X
+3 KILL BDM
+4 SET X=P_"^LAST HEALTH [DM AUDIT TB HEALTH FACTORS"
SET E=$$START1^APCLDF(X,"BDM(")
+5 IF E
QUIT ""
+6 IF $DATA(BDM(1))
QUIT $PIECE(BDM(1),U,3)_U_$SELECT($PIECE(BDM(1),U,3)["TX COMPLETE":"1 Yes",$PIECE(BDM(1),U,3)["TX INCOMPLETE"!($PIECE(BDM(1),U,3)["TX UNTREATED"):"2 No",1:"4 Unknown")
+7 NEW T,Y
SET T=$ORDER(^ATXAX("B","DM AUDIT TB HEALTH FACTORS",0))
+8 IF 'T
QUIT ""
+9 NEW G
SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNHF("AA",P,X))
IF X'=+X!(G]"")
QUIT
IF $DATA(^ATXAX(T,21,"B",X))
SET G=$PIECE(^AUTTHF(X,0),U)
+10 IF G]""
QUIT G_U_$SELECT(G["TX COMPLETE":"1 Yes",G["TX INCOMPLETE"!(G["TX UNTREATED"):"2 No",1:"4 Unknown")
+11 QUIT ""
CPT(P,BDATE,EDATE,T,F) ;EP return ien of CPT entry if patient had this CPT
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(T)=""
QUIT ""
+3 IF '$GET(F)
SET F=1
+4 IF $GET(EDATE)=""
QUIT ""
+5 IF $GET(BDATE)=""
SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+6 ;go through visits in a date range for this patient, check cpts
+7 NEW D,BD,ED,X,Y,D,G,V
+8 SET ED=9999999-EDATE
SET BD=9999999-BDATE
SET G=0
+9 FOR
SET ED=$ORDER(^AUPNVSIT("AA",P,ED))
IF ED=""!($PIECE(ED,".")>BD)!(G)
QUIT
Begin DoDot:1
+10 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+11 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+12 IF '$DATA(^AUPNVCPT("AD",V))
QUIT
+13 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+14 IF $$ICD^BDMUTL($PIECE(^AUPNVCPT(X,0),U),T,1)
SET G=X
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 IF 'G
QUIT ""
+19 IF F=1
QUIT $SELECT(G:1,1:"")
+20 IF F=2
QUIT G
+21 IF F=3
SET V=$PIECE(^AUPNVCPT(G,0),U,3)
IF V
QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
+22 IF F=4
SET V=$PIECE(^AUPNVCPT(G,0),U,3)
IF V
QUIT $$FMTE^XLFDT($PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),"."))
+23 QUIT ""
RAD(P,BDATE,EDATE,T,F) ;EP return if a v rad entry in date range
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(T)=""
QUIT ""
+3 IF '$GET(F)
SET F=1
+4 IF $GET(EDATE)=""
QUIT ""
+5 IF $GET(BDATE)=""
SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+6 ;go through visits in a date range for this patient, check cpts
+7 NEW D,BD,ED,X,Y,D,G,V
+8 SET ED=9999999-EDATE
SET BD=9999999-BDATE
SET G=0
+9 FOR
SET ED=$ORDER(^AUPNVSIT("AA",P,ED))
IF ED=""!($PIECE(ED,".")>BD)!(G)
QUIT
Begin DoDot:1
+10 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+11 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+12 IF '$DATA(^AUPNVRAD("AD",V))
QUIT
+13 SET X=0
FOR
SET X=$ORDER(^AUPNVRAD("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+14 IF '$DATA(^AUPNVRAD(X,0))
QUIT
+15 SET Y=$PIECE(^AUPNVRAD(X,0),U)
IF 'Y
QUIT
IF '$DATA(^RAMIS(71,Y,0))
QUIT
+16 SET Y=$PIECE($GET(^RAMIS(71,Y,0)),U,9)
IF 'Y
QUIT
+17 IF '$$ICD^BDMUTL(Y,T,1)
QUIT
+18 SET G=X
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF 'G
QUIT ""
+23 IF F=1
QUIT $SELECT(G:1,1:"")
+24 IF F=2
QUIT G
+25 IF F=3
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
+26 IF F=4
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT $$FMTE^XLFDT($PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),"."))
+27 QUIT ""
EKG(P,EDATE,F) ;EP
+1 IF $GET(F)=""
SET F="E"
+2 SET %DT="P"
SET X=EDATE
DO ^%DT
SET ED=Y
+3 NEW BDM,X,%,E,LEKG
SET LEKG=""
SET %=P_"^LAST DIAGNOSTIC ECG SUMMARY;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE
SET E=$$START1^APCLDF(%,"BDM(")
+4 IF $DATA(BDM)
SET LEKG=$PIECE(BDM(1),U)
+5 KILL BDM
SET %=P_"^LAST PROCEDURE 89.51"
SET E=$$START1^APCLDF(%,"BDM(")
+6 IF $DATA(BDM(1))
Begin DoDot:1
+7 IF LEKG>$PIECE(BDM(1),U)
QUIT
+8 SET LEKG=$PIECE(BDM(1),U)
End DoDot:1
+9 KILL BDM
SET %=P_"^LAST PROCEDURE 89.52"
SET E=$$START1^APCLDF(%,"BDM(")
+10 IF $DATA(BDM(1))
Begin DoDot:1
+11 IF LEKG>$PIECE(BDM(1),U)
QUIT
+12 SET LEKG=$PIECE(BDM(1),U)
End DoDot:1
+13 KILL BDM
SET %=P_"^LAST PROCEDURE 89.53"
SET E=$$START1^APCLDF(%,"BDM(")
+14 IF $DATA(BDM(1))
Begin DoDot:1
+15 IF LEKG>$PIECE(BDM(1),U)
QUIT
+16 SET LEKG=$PIECE(BDM(1),U)
End DoDot:1
+17 KILL BDM
SET %=P_"^LAST PROCEDURE 89.50"
SET E=$$START1^APCLDF(%,"BDM(")
+18 IF $DATA(BDM(1))
Begin DoDot:1
+19 IF LEKG>$PIECE(BDM(1),U)
QUIT
+20 SET LEKG=$PIECE(BDM(1),U)
End DoDot:1
+21 KILL BDM
SET %=P_"^LAST DX 794.31"
SET E=$$START1^APCLDF(%,"BDM(")
+22 IF $DATA(BDM(1))
Begin DoDot:1
+23 IF LEKG>$PIECE(BDM(1),U)
QUIT
+24 SET LEKG=$PIECE(BDM(1),U)
End DoDot:1
+25 ;check CPT codes in year prior to date range
+26 SET T=$ORDER(^ATXAX("B","DM AUDIT EKG CPTS",0))
+27 KILL BDM
IF T
SET BDM(1)=$$CPT^BDMPG12(P,,ED,"DM AUDIT EKG CPTS",3)
Begin DoDot:1
+28 IF BDM(1)=""
KILL BDM
QUIT
+29 IF LEKG>$PIECE(BDM(1),U)
QUIT
+30 SET LEKG=$PIECE(BDM(1),U)
End DoDot:1
+31 KILL BDM
IF T
SET BDM(1)=$$RAD^BDMPG12(P,,ED,"DM AUDIT EKG CPTS",3)
Begin DoDot:1
+32 IF BDM(1)=""
KILL BDM
QUIT
+33 IF LEKG>$PIECE(BDM(1),U)
QUIT
+34 SET LEKG=$PIECE(BDM(1),U)
End DoDot:1
+35 QUIT $SELECT(F="E":$$FMTE^XLFDT(LEKG),1:LEKG)
+36 ;
ALT(P,BDATE,EDATE) ;EP
+1 NEW BDM,X,%,E,R,V
+2 KILL BDM
+3 SET %=P_"^LAST LAB [DM AUDIT ALT TAX;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"BDM(")
+4 IF '$DATA(BDM(1))
QUIT ""
+5 SET D=$PIECE(BDM(1),U)
SET D=$$FMTE^XLFDT(D)
KILL BDM
SET %=P_"^ALL LAB [DM AUDIT ALT TAX;DURING "_D_"-"_D
SET E=$$START1^APCLDF(%,"BDM(")
+6 NEW N
DO SETN
+7 QUIT $PIECE(^AUPNVLAB(+$PIECE(BDM(N),U,4),0),U,4)_" "_$$FMTE^XLFDT($PIECE(BDM(N),U),5)
AST(P,BDATE,EDATE) ;EP
+1 NEW BDM,X,%,E,R,V
+2 KILL BDM
+3 SET %=P_"^LAST LAB [DM AUDIT AST TAX;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"BDM(")
+4 IF '$DATA(BDM(1))
QUIT ""
+5 SET D=$PIECE(BDM(1),U)
SET D=$$FMTE^XLFDT(D)
KILL BDM
SET %=P_"^ALL LAB [DM AUDIT AST TAX;DURING "_D_"-"_D
SET E=$$START1^APCLDF(%,"BDM(")
+6 NEW N
DO SETN
+7 QUIT $PIECE(^AUPNVLAB(+$PIECE(BDM(N),U,4),0),U,4)_" "_$$FMTE^XLFDT($PIECE(BDM(N),U),5)
INSULIN(P,BDATE,EDATE) ;EP
+1 NEW X,BDM,E
+2 SET X=P_"^LAST MEDS [DM AUDIT INSULIN DRUGS"_";DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"BDM(")
+3 IF $DATA(BDM(1))
QUIT "X"
+4 QUIT ""
TXNAME(V) ;EP
+1 IF $GET(V)=""
QUIT ""
+2 SET V=$$TXNAMES(V)
+3 QUIT $EXTRACT(V,1,16)
TXNAMES(Y) ;
+1 IF Y=1
QUIT "DIET"
+2 IF Y=2
QUIT "INSULIN"
+3 IF Y=3
QUIT "SULFONYLUREA"
+4 IF Y=4
QUIT "METFORMIN (GLUCOPHAGE)"
+5 IF Y=5
QUIT "ACARBOSE OR MIGLITOL"
+6 IF Y=6
QUIT "GLITAZONE"
+7 IF Y=9
QUIT "UNKNOWN/REFUSED"
+8 IF Y=23
QUIT "INSULIN+S'UREA"
+9 IF Y=24
QUIT "INSULIN+MET"
+10 IF Y=25
QUIT "INSULIN+ACAR"
+11 IF Y=26
QUIT "INSULIN+GLITAZONE"
+12 IF Y=34
QUIT "S'UREA+MET"
+13 IF Y=35
QUIT "S'UREA+ACAR"
+14 IF Y=36
QUIT "S'UREA+GLITAZONE"
+15 IF Y=45
QUIT "MET+ACAR"
+16 IF Y=46
QUIT "MET+GLITAZONE"
+17 IF Y=56
QUIT "ACAR+GLITAZONE"
+18 IF Y=234
QUIT "INS+S'UREA+MET"
+19 IF Y=235
QUIT "INS+S'UREA+ACAR"
+20 IF Y=236
QUIT "INS+S'UREA+GLIT"
+21 IF Y=245
QUIT "INS+MET+ACAR"
+22 IF Y=246
QUIT "INS+MET+GLITAZONE"
+23 IF Y=256
QUIT "INS+ACAR+GLITAZONE"
+24 IF Y=345
QUIT "S'UREA+MET+ACAR"
+25 IF Y=346
QUIT "S'UREA+MET+GLIT"
+26 IF Y=356
QUIT "S'UREA+ACAR+GLIT"
+27 IF Y=456
QUIT "MET+ACAR+GLIT"
+28 QUIT ""
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 ""
