- BGP2D231 ; IHS/CMI/LAB - measure I2 23 Jun 2010 10:08 AM ;
- ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- WC(P,BDATE,EDATE) ;EP
- I 'P Q ""
- KILL %,BGPARRY,H,E
- S %=P_"^LAST MEAS WC;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(%,"BGPARRY(") S H=$P($G(BGPARRY(1)),U,2)
- I H="" Q H
- I H["?" Q ""
- I $P(^DPT(P,0),U,2)="M",H>40 Q "WC="_H
- I $P(^DPT(P,0),U,2)="F",H>35 Q "WC="_H
- Q ""
- TRIG(P,BDATE,EDATE) ;EP
- ;now get all loinc/taxonomy tests
- S T=$O(^ATXAX("B","BGP TRIGLYCERIDE LOINC CODES",0))
- S BGPLT=$O(^ATXLAB("B","DM AUDIT TRIGLYCERIDE TAX",0))
- S R=""
- S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(R]"") D
- .S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(R]"") D
- ..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(R]"") D
- ...Q:'$D(^AUPNVLAB(X,0))
- ...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) D Q:R]""
- ....S V=$P(^AUPNVLAB(X,0),U,4) Q:V="" Q:'V Q:+V<150 S R="TRIG="_V
- ...Q:'T
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,T)
- ...S V=$P(^AUPNVLAB(X,0),U,4)
- ...Q:V="" Q:V'=+V
- ...Q:+V<150
- ...S R="TRIG="_V
- ...Q
- Q R
- ;
- 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 ""
- BGP2D231 ; IHS/CMI/LAB - measure I2 23 Jun 2010 10:08 AM ;
- +1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- WC(P,BDATE,EDATE) ;EP
- +1 IF 'P
- QUIT ""
- +2 KILL %,BGPARRY,H,E
- +3 SET %=P_"^LAST MEAS WC;DURING "_BDATE_"-"_EDATE
- SET E=$$START1^APCLDF(%,"BGPARRY(")
- SET H=$PIECE($GET(BGPARRY(1)),U,2)
- +4 IF H=""
- QUIT H
- +5 IF H["?"
- QUIT ""
- +6 IF $PIECE(^DPT(P,0),U,2)="M"
- IF H>40
- QUIT "WC="_H
- +7 IF $PIECE(^DPT(P,0),U,2)="F"
- IF H>35
- QUIT "WC="_H
- +8 QUIT ""
- TRIG(P,BDATE,EDATE) ;EP
- +1 ;now get all loinc/taxonomy tests
- +2 SET T=$ORDER(^ATXAX("B","BGP TRIGLYCERIDE LOINC CODES",0))
- +3 SET BGPLT=$ORDER(^ATXLAB("B","DM AUDIT TRIGLYCERIDE TAX",0))
- +4 SET R=""
- +5 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)!(R]"")
- QUIT
- Begin DoDot:1
- +6 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L!(R]"")
- QUIT
- Begin DoDot:2
- +7 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X!(R]"")
- QUIT
- Begin DoDot:3
- +8 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +9 IF BGPLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(BGPLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- Begin DoDot:4
- +10 SET V=$PIECE(^AUPNVLAB(X,0),U,4)
- IF V=""
- QUIT
- IF 'V
- QUIT
- IF +V<150
- QUIT
- SET R="TRIG="_V
- End DoDot:4
- IF R]""
- QUIT
- +11 IF 'T
- QUIT
- +12 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +13 IF '$$LOINC(J,T)
- QUIT
- +14 SET V=$PIECE(^AUPNVLAB(X,0),U,4)
- +15 IF V=""
- QUIT
- IF V'=+V
- QUIT
- +16 IF +V<150
- QUIT
- +17 SET R="TRIG="_V
- +18 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 QUIT R
- +20 ;
- 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 ""
