APCLD311 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
IMM ;
S:'$D(APCLCUML(140)) APCLCUML(140)="IMMUNIZATIONS"
S $P(APCLCUML(140),U,2)=$P(APCLCUML(140),U,2)+1
S V=$G(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,64))
I $E(V)="Y" S $P(APCLCUML(140),U,3)=$P(APCLCUML(140),U,3)+1
I $E(V)="R" S $P(APCLCUML(140),U,6)=$P(APCLCUML(140),U,6)+1
S V=$G(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,66))
I $E(V)="Y" S $P(APCLCUML(140),U,4)=$P(APCLCUML(140),U,4)+1
I $E(V)="R" S $P(APCLCUML(140),U,7)=$P(APCLCUML(140),U,7)+1
S V=$G(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,68))
I $E(V)="Y" S $P(APCLCUML(140),U,5)=$P(APCLCUML(140),U,5)+1
I $E(V)="R" S $P(APCLCUML(140),U,8)=$P(APCLCUML(140),U,8)+1
URIN ;
;title^total^total with urinalysis^protein present^protein absent^protein not done^micro present^micro absent^micro not done
;145
S:'$D(APCLCUML(145)) APCLCUML(145)="URINALYSIS"
S $P(APCLCUML(145),U,2)=$P(APCLCUML(145),U,2)+1
S V=$G(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,92))
S A=$G(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,94))
I $E(V)="Y" S $P(APCLCUML(145),U,3)=$P(APCLCUML(145),U,3)+1
I $E(A)="Y" S $P(APCLCUML(145),U,4)=$P(APCLCUML(145),U,4)+1
I A["No result" S $P(APCLCUML(145),U,6)=$P(APCLCUML(145),U,6)+1 G EKG
I $E(A)="N" S $P(APCLCUML(145),U,5)=$P(APCLCUML(145),U,5)+1 D
.S V=$G(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,96))
.I $E(V,1,3)="Pos" S $P(APCLCUML(145),U,7)=$P(APCLCUML(145),U,7)+1 Q
.I $E(V,1,3)="Neg" S $P(APCLCUML(145),U,8)=$P(APCLCUML(145),U,8)+1 Q
.S $P(APCLCUML(145),U,9)=$P(APCLCUML(145),U,9)+1
.Q
EKG ;need date of last ekg
S:'$D(APCLCUML(150)) APCLCUML(150)="EKG"
S $P(APCLCUML(150),U,2)=$P(APCLCUML(150),U,2)+1
S V=$$EKG^APCLD312(APCLPD,APCLRED,"I")
I V]"" D
.S E=$$FMDIFF^XLFDT(APCLADAT,V)
.I E<(365.25*3) S $P(APCLCUML(150),U,3)=$P(APCLCUML(150),U,3)+1
.I E<(365.25*5) S $P(APCLCUML(150),U,4)=$P(APCLCUML(150),U,4)+1
.S $P(APCLCUML(150),U,5)=$P(APCLCUML(150),U,5)+1
CREAT ;
S:'$D(APCLCUML(170)) APCLCUML(170)="Creatinine obtained in the past 12 months"
S $P(APCLCUML(170),U,2)=$P(APCLCUML(170),U,2)+1
S V=$$CREAT^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
I V="" S $P(APCLCUML(170),U,5)=$P(APCLCUML(170),U,5)+1 G TCHOL
S V=$P(V,U)
I $E(V)'=+$E(V),$E(V)'="." S $P(APCLCUML(170),U,6)=$P(APCLCUML(170),U,6)+1 G TCHOL ;unable to determine result, not a number
I V>1.9 S $P(APCLCUML(170),U,3)=$P(APCLCUML(170),U,3)+1
I V<2.0 S $P(APCLCUML(170),U,4)=$P(APCLCUML(170),U,4)+1
TCHOL ;
S:'$D(APCLCUML(180)) APCLCUML(180)="Total Cholesterol obtained in past 12 months"
S $P(APCLCUML(180),U,2)=$P(APCLCUML(180),U,2)+1
S V=$$CHOL^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
I V="" S $P(APCLCUML(180),U,6)=$P(APCLCUML(180),U,6)+1 G LDL
S V=$P(V,U)
I $E(V)'=+$E(V) S $P(APCLCUML(180),U,7)=$P(APCLCUML(180),U,7)+1 G LDL ;unable to determine result, not a number or is blank
I V<200 S $P(APCLCUML(180),U,3)=$P(APCLCUML(180),U,3)+1
I V<240&(V>199) S $P(APCLCUML(180),U,4)=$P(APCLCUML(180),U,4)+1
I V>239 S $P(APCLCUML(180),U,5)=$P(APCLCUML(180),U,5)+1
LDL ;
S:'$D(APCLCUML(190)) APCLCUML(190)="LDL Cholesterol obtained in the past 12 months"
S $P(APCLCUML(190),U,2)=$P(APCLCUML(190),U,2)+1
S V=$$LDL^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
I V="" S $P(APCLCUML(190),U,7)=$P(APCLCUML(190),U,7)+1 G HDL
S V=$P(V,U)
I $E(V)'=+$E(V) S $P(APCLCUML(190),U,8)=$P(APCLCUML(190),U,8)+1 G HDL ;unable to determine result, not a number or blank
I V<100 S $P(APCLCUML(190),U,3)=$P(APCLCUML(190),U,3)+1
I V<130&(V>99) S $P(APCLCUML(190),U,4)=$P(APCLCUML(190),U,4)+1
I V>129&(V<161) S $P(APCLCUML(190),U,5)=$P(APCLCUML(190),U,5)+1
I V>160 S $P(APCLCUML(190),U,6)=$P(APCLCUML(190),U,6)+1
HDL ;
S:'$D(APCLCUML(195)) APCLCUML(195)="HDL Cholesterol obtained in the past 12 months"
S $P(APCLCUML(195),U,2)=$P(APCLCUML(195),U,2)+1
S V=$$HDL^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
I V="" S $P(APCLCUML(195),U,7)=$P(APCLCUML(195),U,7)+1 G TRIG
S V=$P(V,U)
I $E(V)'=+$E(V) S $P(APCLCUML(195),U,8)=$P(APCLCUML(195),U,8)+1 G TRIG ;unable to determine result, not a number
S V=$P(V,".")
I V<35 S $P(APCLCUML(195),U,3)=$P(APCLCUML(195),U,3)+1
I V<46&(V>34) S $P(APCLCUML(195),U,4)=$P(APCLCUML(195),U,4)+1
I V>45&(V<56) S $P(APCLCUML(195),U,5)=$P(APCLCUML(195),U,5)+1
I V>55 S $P(APCLCUML(195),U,6)=$P(APCLCUML(195),U,6)+1
TRIG ;
S:'$D(APCLCUML(200)) APCLCUML(200)="Triglycerides obtained in past 12 months"
S $P(APCLCUML(200),U,2)=$P(APCLCUML(200),U,2)+1
S V=$$TRIG^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
I V="" S $P(APCLCUML(200),U,7)=$P(APCLCUML(200),U,7)+1 G SELF
S V=$P(V,U)
I $E(V)'=+$E(V) S $P(APCLCUML(200),U,8)=$P(APCLCUML(200),U,8)+1 G SELF ;unable to determine result, not a number
I V<150 S $P(APCLCUML(200),U,3)=$P(APCLCUML(200),U,3)+1
I V<200&(V>149) S $P(APCLCUML(200),U,4)=$P(APCLCUML(200),U,4)+1
I V>199&(V<401) S $P(APCLCUML(200),U,5)=$P(APCLCUML(200),U,5)+1
I V>400 S $P(APCLCUML(200),U,6)=$P(APCLCUML(200),U,6)+1
SELF ;
S:'$D(APCLCUML(210)) APCLCUML(210)="Self monitoring of blood glucose documented"
S $P(APCLCUML(210),U,2)=$P(APCLCUML(210),U,2)+1
S V=$G(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,98))
S P=$S($E(V)="Y":3,$E(V)="N":4,$E(V)="R":5,1:6)
S $P(APCLCUML(210),U,P)=$P(APCLCUML(210),U,P)+1
SDM ;
Q ;NOT IN 2003
S:'$D(APCLCUML(220)) APCLCUML(220)="Participating in SDM"
S $P(APCLCUML(220),U,2)=$P(APCLCUML(220),U,2)+1
S V=$G(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,100))
S P=$S($E(V)="Y":3,1:4)
S $P(APCLCUML(220),U,P)=$P(APCLCUML(220),U,P)+1
Q
CESS(P,B,D) ;EP - find any cessation hf in 12 months before E
I '$G(P) Q ""
NEW APCL,E,X,G,T
K APCL
S X=P_"^LAST HEALTH [DM AUDIT CESSATION HLTH FACTOR;DURING "_B_"-"_D S E=$$START1^APCLDF(X,"APCL(")
I $D(APCL(1)) Q "Yes-"_$$FMTE^XLFDT($P(APCL(1),U))
S X=P_"^EDUC [DM AUDIT SMOKING CESS EDUC;DURING "_B_"-"_D S E=$$START1^APCLDF(X,"APCL(")
I $D(APCL(1)) Q "Yes-"_$$FMTE^XLFDT($P(APCL(1),U))
NEW T S T=$O(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",0))
I 'T Q "No"
S (X,G)=0 F S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G) I $$REFUSAL^APCLD317(P,9999999.09,$P(^ATXAX(T,21,X,0),U),B,D) S G=1
I G Q "Refused"
Q "No"
;
APCLD311 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
IMM ;
+1 IF '$DATA(APCLCUML(140))
SET APCLCUML(140)="IMMUNIZATIONS"
+2 SET $PIECE(APCLCUML(140),U,2)=$PIECE(APCLCUML(140),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,64))
+4 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(140),U,3)=$PIECE(APCLCUML(140),U,3)+1
+5 IF $EXTRACT(V)="R"
SET $PIECE(APCLCUML(140),U,6)=$PIECE(APCLCUML(140),U,6)+1
+6 SET V=$GET(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,66))
+7 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(140),U,4)=$PIECE(APCLCUML(140),U,4)+1
+8 IF $EXTRACT(V)="R"
SET $PIECE(APCLCUML(140),U,7)=$PIECE(APCLCUML(140),U,7)+1
+9 SET V=$GET(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,68))
+10 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(140),U,5)=$PIECE(APCLCUML(140),U,5)+1
+11 IF $EXTRACT(V)="R"
SET $PIECE(APCLCUML(140),U,8)=$PIECE(APCLCUML(140),U,8)+1
URIN ;
+1 ;title^total^total with urinalysis^protein present^protein absent^protein not done^micro present^micro absent^micro not done
+2 ;145
+3 IF '$DATA(APCLCUML(145))
SET APCLCUML(145)="URINALYSIS"
+4 SET $PIECE(APCLCUML(145),U,2)=$PIECE(APCLCUML(145),U,2)+1
+5 SET V=$GET(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,92))
+6 SET A=$GET(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,94))
+7 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(145),U,3)=$PIECE(APCLCUML(145),U,3)+1
+8 IF $EXTRACT(A)="Y"
SET $PIECE(APCLCUML(145),U,4)=$PIECE(APCLCUML(145),U,4)+1
+9 IF A["No result"
SET $PIECE(APCLCUML(145),U,6)=$PIECE(APCLCUML(145),U,6)+1
GOTO EKG
+10 IF $EXTRACT(A)="N"
SET $PIECE(APCLCUML(145),U,5)=$PIECE(APCLCUML(145),U,5)+1
Begin DoDot:1
+11 SET V=$GET(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,96))
+12 IF $EXTRACT(V,1,3)="Pos"
SET $PIECE(APCLCUML(145),U,7)=$PIECE(APCLCUML(145),U,7)+1
QUIT
+13 IF $EXTRACT(V,1,3)="Neg"
SET $PIECE(APCLCUML(145),U,8)=$PIECE(APCLCUML(145),U,8)+1
QUIT
+14 SET $PIECE(APCLCUML(145),U,9)=$PIECE(APCLCUML(145),U,9)+1
+15 QUIT
End DoDot:1
EKG ;need date of last ekg
+1 IF '$DATA(APCLCUML(150))
SET APCLCUML(150)="EKG"
+2 SET $PIECE(APCLCUML(150),U,2)=$PIECE(APCLCUML(150),U,2)+1
+3 SET V=$$EKG^APCLD312(APCLPD,APCLRED,"I")
+4 IF V]""
Begin DoDot:1
+5 SET E=$$FMDIFF^XLFDT(APCLADAT,V)
+6 IF E<(365.25*3)
SET $PIECE(APCLCUML(150),U,3)=$PIECE(APCLCUML(150),U,3)+1
+7 IF E<(365.25*5)
SET $PIECE(APCLCUML(150),U,4)=$PIECE(APCLCUML(150),U,4)+1
+8 SET $PIECE(APCLCUML(150),U,5)=$PIECE(APCLCUML(150),U,5)+1
End DoDot:1
CREAT ;
+1 IF '$DATA(APCLCUML(170))
SET APCLCUML(170)="Creatinine obtained in the past 12 months"
+2 SET $PIECE(APCLCUML(170),U,2)=$PIECE(APCLCUML(170),U,2)+1
+3 SET V=$$CREAT^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
+4 IF V=""
SET $PIECE(APCLCUML(170),U,5)=$PIECE(APCLCUML(170),U,5)+1
GOTO TCHOL
+5 SET V=$PIECE(V,U)
+6 ;unable to determine result, not a number
IF $EXTRACT(V)'=+$EXTRACT(V)
IF $EXTRACT(V)'="."
SET $PIECE(APCLCUML(170),U,6)=$PIECE(APCLCUML(170),U,6)+1
GOTO TCHOL
+7 IF V>1.9
SET $PIECE(APCLCUML(170),U,3)=$PIECE(APCLCUML(170),U,3)+1
+8 IF V<2.0
SET $PIECE(APCLCUML(170),U,4)=$PIECE(APCLCUML(170),U,4)+1
TCHOL ;
+1 IF '$DATA(APCLCUML(180))
SET APCLCUML(180)="Total Cholesterol obtained in past 12 months"
+2 SET $PIECE(APCLCUML(180),U,2)=$PIECE(APCLCUML(180),U,2)+1
+3 SET V=$$CHOL^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
+4 IF V=""
SET $PIECE(APCLCUML(180),U,6)=$PIECE(APCLCUML(180),U,6)+1
GOTO LDL
+5 SET V=$PIECE(V,U)
+6 ;unable to determine result, not a number or is blank
IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(APCLCUML(180),U,7)=$PIECE(APCLCUML(180),U,7)+1
GOTO LDL
+7 IF V<200
SET $PIECE(APCLCUML(180),U,3)=$PIECE(APCLCUML(180),U,3)+1
+8 IF V<240&(V>199)
SET $PIECE(APCLCUML(180),U,4)=$PIECE(APCLCUML(180),U,4)+1
+9 IF V>239
SET $PIECE(APCLCUML(180),U,5)=$PIECE(APCLCUML(180),U,5)+1
LDL ;
+1 IF '$DATA(APCLCUML(190))
SET APCLCUML(190)="LDL Cholesterol obtained in the past 12 months"
+2 SET $PIECE(APCLCUML(190),U,2)=$PIECE(APCLCUML(190),U,2)+1
+3 SET V=$$LDL^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
+4 IF V=""
SET $PIECE(APCLCUML(190),U,7)=$PIECE(APCLCUML(190),U,7)+1
GOTO HDL
+5 SET V=$PIECE(V,U)
+6 ;unable to determine result, not a number or blank
IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(APCLCUML(190),U,8)=$PIECE(APCLCUML(190),U,8)+1
GOTO HDL
+7 IF V<100
SET $PIECE(APCLCUML(190),U,3)=$PIECE(APCLCUML(190),U,3)+1
+8 IF V<130&(V>99)
SET $PIECE(APCLCUML(190),U,4)=$PIECE(APCLCUML(190),U,4)+1
+9 IF V>129&(V<161)
SET $PIECE(APCLCUML(190),U,5)=$PIECE(APCLCUML(190),U,5)+1
+10 IF V>160
SET $PIECE(APCLCUML(190),U,6)=$PIECE(APCLCUML(190),U,6)+1
HDL ;
+1 IF '$DATA(APCLCUML(195))
SET APCLCUML(195)="HDL Cholesterol obtained in the past 12 months"
+2 SET $PIECE(APCLCUML(195),U,2)=$PIECE(APCLCUML(195),U,2)+1
+3 SET V=$$HDL^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
+4 IF V=""
SET $PIECE(APCLCUML(195),U,7)=$PIECE(APCLCUML(195),U,7)+1
GOTO TRIG
+5 SET V=$PIECE(V,U)
+6 ;unable to determine result, not a number
IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(APCLCUML(195),U,8)=$PIECE(APCLCUML(195),U,8)+1
GOTO TRIG
+7 SET V=$PIECE(V,".")
+8 IF V<35
SET $PIECE(APCLCUML(195),U,3)=$PIECE(APCLCUML(195),U,3)+1
+9 IF V<46&(V>34)
SET $PIECE(APCLCUML(195),U,4)=$PIECE(APCLCUML(195),U,4)+1
+10 IF V>45&(V<56)
SET $PIECE(APCLCUML(195),U,5)=$PIECE(APCLCUML(195),U,5)+1
+11 IF V>55
SET $PIECE(APCLCUML(195),U,6)=$PIECE(APCLCUML(195),U,6)+1
TRIG ;
+1 IF '$DATA(APCLCUML(200))
SET APCLCUML(200)="Triglycerides obtained in past 12 months"
+2 SET $PIECE(APCLCUML(200),U,2)=$PIECE(APCLCUML(200),U,2)+1
+3 SET V=$$TRIG^APCLD318(APCLPD,APCLRBD,APCLRED,"I")
+4 IF V=""
SET $PIECE(APCLCUML(200),U,7)=$PIECE(APCLCUML(200),U,7)+1
GOTO SELF
+5 SET V=$PIECE(V,U)
+6 ;unable to determine result, not a number
IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(APCLCUML(200),U,8)=$PIECE(APCLCUML(200),U,8)+1
GOTO SELF
+7 IF V<150
SET $PIECE(APCLCUML(200),U,3)=$PIECE(APCLCUML(200),U,3)+1
+8 IF V<200&(V>149)
SET $PIECE(APCLCUML(200),U,4)=$PIECE(APCLCUML(200),U,4)+1
+9 IF V>199&(V<401)
SET $PIECE(APCLCUML(200),U,5)=$PIECE(APCLCUML(200),U,5)+1
+10 IF V>400
SET $PIECE(APCLCUML(200),U,6)=$PIECE(APCLCUML(200),U,6)+1
SELF ;
+1 IF '$DATA(APCLCUML(210))
SET APCLCUML(210)="Self monitoring of blood glucose documented"
+2 SET $PIECE(APCLCUML(210),U,2)=$PIECE(APCLCUML(210),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,98))
+4 SET P=$SELECT($EXTRACT(V)="Y":3,$EXTRACT(V)="N":4,$EXTRACT(V)="R":5,1:6)
+5 SET $PIECE(APCLCUML(210),U,P)=$PIECE(APCLCUML(210),U,P)+1
SDM ;
+1 ;NOT IN 2003
QUIT
+2 IF '$DATA(APCLCUML(220))
SET APCLCUML(220)="Participating in SDM"
+3 SET $PIECE(APCLCUML(220),U,2)=$PIECE(APCLCUML(220),U,2)+1
+4 SET V=$GET(^XTMP("APCLDM31",APCLJOB,APCLBTH,"AUDIT",APCLPD,100))
+5 SET P=$SELECT($EXTRACT(V)="Y":3,1:4)
+6 SET $PIECE(APCLCUML(220),U,P)=$PIECE(APCLCUML(220),U,P)+1
+7 QUIT
CESS(P,B,D) ;EP - find any cessation hf in 12 months before E
+1 IF '$GET(P)
QUIT ""
+2 NEW APCL,E,X,G,T
+3 KILL APCL
+4 SET X=P_"^LAST HEALTH [DM AUDIT CESSATION HLTH FACTOR;DURING "_B_"-"_D
SET E=$$START1^APCLDF(X,"APCL(")
+5 IF $DATA(APCL(1))
QUIT "Yes-"_$$FMTE^XLFDT($PIECE(APCL(1),U))
+6 SET X=P_"^EDUC [DM AUDIT SMOKING CESS EDUC;DURING "_B_"-"_D
SET E=$$START1^APCLDF(X,"APCL(")
+7 IF $DATA(APCL(1))
QUIT "Yes-"_$$FMTE^XLFDT($PIECE(APCL(1),U))
+8 NEW T
SET T=$ORDER(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",0))
+9 IF 'T
QUIT "No"
+10 SET (X,G)=0
FOR
SET X=$ORDER(^ATXAX(T,21,X))
IF X'=+X!(G)
QUIT
IF $$REFUSAL^APCLD317(P,9999999.09,$PIECE(^ATXAX(T,21,X,0),U),B,D)
SET G=1
+11 IF G
QUIT "Refused"
+12 QUIT "No"
+13 ;
