- BDMPF12 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
- ;
- ;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^BDMPF12(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^BDMPF12(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 ""
- BDMPF12 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
- +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^BDMPF12(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^BDMPF12(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 ""