APCLDM1A ; IHS/CMI/LAB -CONTINUATION OF APCLDM1 FOR DM AUDIT DATA FETCHING ;
;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
;
EN ; - EP - from ^APCLDM1
;
F APCLI=1:1 Q:$T(@APCLI)="" K APCLX S APCLY="APCL(" D @APCLI K APCL
Q
;
1 ;
WTTAKEN S APCLMEAS=$O(^AUTTMSR("B","WT","")) D TAKEN
S ^TMP("APCL",$J,4)=APCLMEAS
K APCLMEAS
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,4)["YES":1,1:0),APCLSUB=10 D CUML^APCLDM1
Q
2 ;
LASTWT S APCLW="" S APCLX=APCLPD_"^LAST 24 MEAS WT" S APCLER=$$START1^APCLDF(APCLX,APCLY)
S APCLV221=$O(^ICD9("BA","V22.1 ",""))
F APCLN=1:1 Q:'$D(APCL(APCLN))!$D(^TMP("APCL",$J,5)) S APCLZ=$P(APCL(APCLN),U,5) S APCLD=0 F S APCLD=$O(^AUPNVPOV("AD",APCLZ,APCLD)) Q:'APCLD!$D(^TMP("APCL",$J,5)) D
. I $P(^AUPNVPOV(APCLD,0),U)'=APCLV221 S APCLW=$P(APCL(APCLN),U,2),^TMP("APCL",$J,5)=$P(APCL(APCLN),U,2)_" lbs",Y=$P(APCL(APCLN),U) D DD^%DT S ^TMP("APCL",$J,33)=Y
.Q
I '$D(^TMP("APCL",$J,5)) S ^(5)="NO WT AVAILABLE",^TMP("APCL",$J,33.1)="" I APCLCUML S APCLSUB=54,APCLGOT1=1 D CUML^APCLDM1 S APCLGOT1=0 S APCLSUB=48 D CUML^APCLDM1 S APCLSUB=49,APCLGOT1=0 D CUML^APCLDM1 G X2
I '$G(APCLCUML) G X2
S H=APCLHTKI I 'H S ^TMP("APCL",$J,33.1)="",APCLSUB=54,APCLGOT1=1 D CUML^APCLDM1 S APCLSUB=48,APCLGOT1=0 D CUML^APCLDM1 S APCLSUB=49,APCLGOT1=0 D CUML^APCLDM1 G X2
S APCLW=APCLW*.4536,H=((H*.0254)*(H*.0254)),B=APCLW/H,^TMP("APCL",$J,33.1)=$J(B,4,1)
I $$SEX^AUPNPAT(APCLPD)="M"&(B>31.0)!($$SEX^AUPNPAT(APCLPD)="F"&(B>32.2)) S APCLSUB=49,APCLGOT1=1 D CUML^APCLDM1 S APCLSUB=54,APCLGOT1=0 D CUML^APCLDM1 S APCLGOT1=1,APCLSUB=48 D CUML^APCLDM1 G X2
I $$SEX^AUPNPAT(APCLPD)="M"&(B>27.7)!($$SEX^AUPNPAT(APCLPD)="F"&(B>27.2)) S APCLSUB=48,APCLGOT1=1 D CUML^APCLDM1 S APCLSUB=54,APCLGOT1=0 D CUML^APCLDM1 S APCLSUB=49,APCLGOT1=0 D CUML^APCLDM1 G X2
;I $E(APCLRWPT)="*" S APCLSUB=54,APCLGOT1=1 D CUML^APCLDM1 S APCLGOT1=0,APCLSUB=48 D CUML^APCLDM1 S APCLSUB=49 D CUML^APCLDM1 G X2
;I +APCLRWPT>154 S APCLSUB=49,APCLGOT1=1 D CUML^APCLDM1 S APCLGOT1=0,APCLSUB=48 D CUML^APCLDM1 S APCLSUB=54 D CUML^APCLDM1 G X2
;I +APCLRWPT>125 S APCLSUB=48,APCLGOT1=1 D CUML^APCLDM1 S APCLGOT1=0,APCLSUB=49 D CUML^APCLDM1 S APCLSUB=54 D CUML^APCLDM1 G X2
F APCLSUB=48,49,54 S APCLGOT1=0 D CUML^APCLDM1
X2 ;
K APCLSUB,APCLGOT1,APCLRWPT,APCLZ,APCLN,APCLD,APCLV221,APCLX
Q
3 ;
BPTAKEN S APCLMEAS=$O(^AUTTMSR("B","BP","")) D TAKEN
S ^TMP("APCL",$J,6)=APCLMEAS
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,6)["YES":1,1:0),APCLSUB=11 D CUML^APCLDM1
K APCLMEAS
Q
;
TAKEN ; Is BP or WT taken 75% of time during the last year's diabetic visits
S (APCLYES,APCLNTOT)=0 F APCLL=1:1:APCLTOT Q:'$D(^TMP("APCLDM DXVS",$J,APCLL)) D
.S APCLVDFN=^TMP("APCLDM DXVS",$J,APCLL)
.S APCLNTOT=APCLNTOT+1
.S (APCLMDFN,APCLFOUN)=0 F S APCLMDFN=$O(^AUPNVMSR("AD",APCLVDFN,APCLMDFN)) Q:'APCLMDFN!(APCLFOUN) D
..Q:$P($G(^AUPNVMSR(APCLMDFN,2)),U,1) ;entered in error
..I APCLMDFN,+^AUPNVMSR(APCLMDFN,0)=APCLMEAS S APCLYES=APCLYES+1,APCLFOUN=1 Q
..Q
;***
I 'APCLNTOT S APCLMEAS="No DM visits (01,06,28 clinics only)" G TAKENX
NEW V
S V=(APCLYES/APCLNTOT)*100,V=$J(V,2,0)
S APCLMEAS=$S(V<75:"NO",1:"YES")_" - "_V_"%"
K APCLNTOT
TAKENX Q
;
4 ;
HTNDX ;
D HTNPLDX I $D(APCL(1)) G X
S X=APCLEDT,%DT="" D ^%DT S X1=$S(Y>DT:DT,1:Y) S APCLHTNE=Y,X2=1 D C^%DTC S APCLHTNE=($E(X,1,3)-5)_$E(X,4,7) S Y=APCLHTNE D DD^%DT S APCLHTNE=Y
S APCLX=APCLPD_"^LAST DX [SURVEILLANCE HYPERTENSION;DURING "_APCLHTNE_"-"_APCLEDT S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X S ^TMP("APCL",$J,7)=$S($D(APCL(1)):"YES",1:"NO")
X I APCLER S ^TMP("APCL",$J,7)="*** SCRIPT ERROR IN HTNDX^APCLDM1A. CONTACT SITE MANAGER"
K APCL
Q
HTNPLDX ;see if htn on problem list
S APCLX=APCLPD_"^PROBLEM [DM AUDIT PROBLEM HTN DIAGNOSES",APCLY="APCL(" S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X I $D(APCL(1)) S ^TMP("APCL",$J,7)="YES"
Q
5 ;
BPS ;
S APCLERCO=$O(^DIC(40.7,"C",30,"")),APCLLL=0
S APCLX=APCLPD_"^LAST 50 MEAS BP"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) F APCLL=1:1:20 Q:'$D(APCL(APCLL)) S APCLBP=$P($G(APCL(APCLL)),U,2)_$S($P($G(APCL(APCLL)),U,2)]"":" mm HG",1:"") D
.Q:$P(^AUPNVSIT($P(APCL(APCLL),U,5),0),U,8)=APCLERCO
.S APCLLL=APCLLL+1,^TMP("APCL",$J,8_"."_APCLLL)=APCLBP S Y=$P(APCL(APCLL),U,1) D DD^%DT S ^TMP("APCL",$J,34_"."_APCLLL)=Y
I APCLCUML,$G(^TMP("APCL",$J,8.1))]"" S (APCLSYS,APCLDIA,APCLBPS)=0 F APCLL=1:1:3 Q:'$D(^TMP("APCL",$J,8_"."_APCLL)) S APCLBPS=APCLBPS+1,APCLSYS=APCLSYS+^(8_"."_APCLL),APCLDIA=APCLDIA+$P(^(8_"."_APCLL),"/",2)
CONTROL ;
I '$G(APCLCUML) G X5
I $G(^TMP("APCL",$J,8.3))="" S APCLGOT1=1,APCLSUB=61 D CUML^APCLDM1 D G X5 ;if not at least 3 bps - undocumented
.S APCLGOT1=0 F APCLSUB=12,13,14,60 D CUML^APCLDM1
S APCLSYS=$J((APCLSYS/APCLBPS),0,0),APCLDIA=$J((APCLDIA/APCLBPS),0,0)
I ^TMP("APCL",$J,7)="NO",APCLSYS<140,APCLDIA<90 S APCLGOT1=1,APCLSUB=12 D CUML^APCLDM1 D G X5
.S APCLGOT1=0 F APCLSUB=13,14,60,61 D CUML^APCLDM1
I ^TMP("APCL",$J,7)="YES",APCLSYS<140,APCLDIA<90 S APCLGOT1=1,APCLSUB=13 D CUML^APCLDM1 D G X5
.S APCLGOT1=0 F APCLSUB=12,14,60,61 D CUML^APCLDM1
I APCLSYS>159!(APCLDIA>94) S APCLGOT1=1,APCLSUB=60 D CUML^APCLDM1 D G X5
.S APCLGOT1=0 F APCLSUB=12,13,14,61 D CUML^APCLDM1
I (APCLSYS>139&(APCLSYS<160))!(APCLDIA>89&(APCLDIA<95)) S APCLGOT1=1,APCLSUB=14 D CUML^APCLDM1 D G X5
.S APCLGOT1=0 F APCLSUB=12,13,60,61 D CUML^APCLDM1
X5 K APCLBP,APCLBPS,APCLSYS,APCLDIA,APCLHYP
Q
6 ;
BSTAKEN ;
D BSTAKEN^APCLDM7
Q
;
APCLDM1A ; IHS/CMI/LAB -CONTINUATION OF APCLDM1 FOR DM AUDIT DATA FETCHING ;
+1 ;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
+2 ;
EN ; - EP - from ^APCLDM1
+1 ;
+2 FOR APCLI=1:1
IF $TEXT(@APCLI)=""
QUIT
KILL APCLX
SET APCLY="APCL("
DO @APCLI
KILL APCL
+3 QUIT
+4 ;
1 ;
WTTAKEN SET APCLMEAS=$ORDER(^AUTTMSR("B","WT",""))
DO TAKEN
+1 SET ^TMP("APCL",$JOB,4)=APCLMEAS
+2 KILL APCLMEAS
+3 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,4)["YES":1,1:0)
SET APCLSUB=10
DO CUML^APCLDM1
+4 QUIT
2 ;
LASTWT SET APCLW=""
SET APCLX=APCLPD_"^LAST 24 MEAS WT"
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+1 SET APCLV221=$ORDER(^ICD9("BA","V22.1 ",""))
+2 FOR APCLN=1:1
IF '$DATA(APCL(APCLN))!$DATA(^TMP("APCL",$JOB,5))
QUIT
SET APCLZ=$PIECE(APCL(APCLN),U,5)
SET APCLD=0
FOR
SET APCLD=$ORDER(^AUPNVPOV("AD",APCLZ,APCLD))
IF 'APCLD!$DATA(^TMP("APCL",$JOB,5))
QUIT
Begin DoDot:1
+3 IF $PIECE(^AUPNVPOV(APCLD,0),U)'=APCLV221
SET APCLW=$PIECE(APCL(APCLN),U,2)
SET ^TMP("APCL",$JOB,5)=$PIECE(APCL(APCLN),U,2)_" lbs"
SET Y=$PIECE(APCL(APCLN),U)
DO DD^%DT
SET ^TMP("APCL",$JOB,33)=Y
+4 QUIT
End DoDot:1
+5 IF '$DATA(^TMP("APCL",$JOB,5))
SET ^(5)="NO WT AVAILABLE"
SET ^TMP("APCL",$JOB,33.1)=""
IF APCLCUML
SET APCLSUB=54
SET APCLGOT1=1
DO CUML^APCLDM1
SET APCLGOT1=0
SET APCLSUB=48
DO CUML^APCLDM1
SET APCLSUB=49
SET APCLGOT1=0
DO CUML^APCLDM1
GOTO X2
+6 IF '$GET(APCLCUML)
GOTO X2
+7 SET H=APCLHTKI
IF 'H
SET ^TMP("APCL",$JOB,33.1)=""
SET APCLSUB=54
SET APCLGOT1=1
DO CUML^APCLDM1
SET APCLSUB=48
SET APCLGOT1=0
DO CUML^APCLDM1
SET APCLSUB=49
SET APCLGOT1=0
DO CUML^APCLDM1
GOTO X2
+8 SET APCLW=APCLW*.4536
SET H=((H*.0254)*(H*.0254))
SET B=APCLW/H
SET ^TMP("APCL",$JOB,33.1)=$JUSTIFY(B,4,1)
+9 IF $$SEX^AUPNPAT(APCLPD)="M"&(B>31.0)!($$SEX^AUPNPAT(APCLPD)="F"&(B>32.2))
SET APCLSUB=49
SET APCLGOT1=1
DO CUML^APCLDM1
SET APCLSUB=54
SET APCLGOT1=0
DO CUML^APCLDM1
SET APCLGOT1=1
SET APCLSUB=48
DO CUML^APCLDM1
GOTO X2
+10 IF $$SEX^AUPNPAT(APCLPD)="M"&(B>27.7)!($$SEX^AUPNPAT(APCLPD)="F"&(B>27.2))
SET APCLSUB=48
SET APCLGOT1=1
DO CUML^APCLDM1
SET APCLSUB=54
SET APCLGOT1=0
DO CUML^APCLDM1
SET APCLSUB=49
SET APCLGOT1=0
DO CUML^APCLDM1
GOTO X2
+11 ;I $E(APCLRWPT)="*" S APCLSUB=54,APCLGOT1=1 D CUML^APCLDM1 S APCLGOT1=0,APCLSUB=48 D CUML^APCLDM1 S APCLSUB=49 D CUML^APCLDM1 G X2
+12 ;I +APCLRWPT>154 S APCLSUB=49,APCLGOT1=1 D CUML^APCLDM1 S APCLGOT1=0,APCLSUB=48 D CUML^APCLDM1 S APCLSUB=54 D CUML^APCLDM1 G X2
+13 ;I +APCLRWPT>125 S APCLSUB=48,APCLGOT1=1 D CUML^APCLDM1 S APCLGOT1=0,APCLSUB=49 D CUML^APCLDM1 S APCLSUB=54 D CUML^APCLDM1 G X2
+14 FOR APCLSUB=48,49,54
SET APCLGOT1=0
DO CUML^APCLDM1
X2 ;
+1 KILL APCLSUB,APCLGOT1,APCLRWPT,APCLZ,APCLN,APCLD,APCLV221,APCLX
+2 QUIT
3 ;
BPTAKEN SET APCLMEAS=$ORDER(^AUTTMSR("B","BP",""))
DO TAKEN
+1 SET ^TMP("APCL",$JOB,6)=APCLMEAS
+2 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,6)["YES":1,1:0)
SET APCLSUB=11
DO CUML^APCLDM1
+3 KILL APCLMEAS
+4 QUIT
+5 ;
TAKEN ; Is BP or WT taken 75% of time during the last year's diabetic visits
+1 SET (APCLYES,APCLNTOT)=0
FOR APCLL=1:1:APCLTOT
IF '$DATA(^TMP("APCLDM DXVS",$JOB,APCLL))
QUIT
Begin DoDot:1
+2 SET APCLVDFN=^TMP("APCLDM DXVS",$JOB,APCLL)
+3 SET APCLNTOT=APCLNTOT+1
+4 SET (APCLMDFN,APCLFOUN)=0
FOR
SET APCLMDFN=$ORDER(^AUPNVMSR("AD",APCLVDFN,APCLMDFN))
IF 'APCLMDFN!(APCLFOUN)
QUIT
Begin DoDot:2
+5 ;entered in error
IF $PIECE($GET(^AUPNVMSR(APCLMDFN,2)),U,1)
QUIT
+6 IF APCLMDFN
IF +^AUPNVMSR(APCLMDFN,0)=APCLMEAS
SET APCLYES=APCLYES+1
SET APCLFOUN=1
QUIT
+7 QUIT
End DoDot:2
End DoDot:1
+8 ;***
+9 IF 'APCLNTOT
SET APCLMEAS="No DM visits (01,06,28 clinics only)"
GOTO TAKENX
+10 NEW V
+11 SET V=(APCLYES/APCLNTOT)*100
SET V=$JUSTIFY(V,2,0)
+12 SET APCLMEAS=$SELECT(V<75:"NO",1:"YES")_" - "_V_"%"
+13 KILL APCLNTOT
TAKENX QUIT
+1 ;
4 ;
HTNDX ;
+1 DO HTNPLDX
IF $DATA(APCL(1))
GOTO X
+2 SET X=APCLEDT
SET %DT=""
DO ^%DT
SET X1=$SELECT(Y>DT:DT,1:Y)
SET APCLHTNE=Y
SET X2=1
DO C^%DTC
SET APCLHTNE=($EXTRACT(X,1,3)-5)_$EXTRACT(X,4,7)
SET Y=APCLHTNE
DO DD^%DT
SET APCLHTNE=Y
+3 SET APCLX=APCLPD_"^LAST DX [SURVEILLANCE HYPERTENSION;DURING "_APCLHTNE_"-"_APCLEDT
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
IF APCLER
GOTO X
SET ^TMP("APCL",$JOB,7)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
X IF APCLER
SET ^TMP("APCL",$JOB,7)="*** SCRIPT ERROR IN HTNDX^APCLDM1A. CONTACT SITE MANAGER"
+1 KILL APCL
+2 QUIT
HTNPLDX ;see if htn on problem list
+1 SET APCLX=APCLPD_"^PROBLEM [DM AUDIT PROBLEM HTN DIAGNOSES"
SET APCLY="APCL("
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
IF APCLER
GOTO X
IF $DATA(APCL(1))
SET ^TMP("APCL",$JOB,7)="YES"
+2 QUIT
5 ;
BPS ;
+1 SET APCLERCO=$ORDER(^DIC(40.7,"C",30,""))
SET APCLLL=0
+2 SET APCLX=APCLPD_"^LAST 50 MEAS BP"_APCLDATE
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
FOR APCLL=1:1:20
IF '$DATA(APCL(APCLL))
QUIT
SET APCLBP=$PIECE($GET(APCL(APCLL)),U,2)_$SELECT($PIECE($GET(APCL(APCLL)),U,2)]"":" mm HG",1:"")
Begin DoDot:1
+3 IF $PIECE(^AUPNVSIT($PIECE(APCL(APCLL),U,5),0),U,8)=APCLERCO
QUIT
+4 SET APCLLL=APCLLL+1
SET ^TMP("APCL",$JOB,8_"."_APCLLL)=APCLBP
SET Y=$PIECE(APCL(APCLL),U,1)
DO DD^%DT
SET ^TMP("APCL",$JOB,34_"."_APCLLL)=Y
End DoDot:1
+5 IF APCLCUML
IF $GET(^TMP("APCL",$JOB,8.1))]""
SET (APCLSYS,APCLDIA,APCLBPS)=0
FOR APCLL=1:1:3
IF '$DATA(^TMP("APCL",$JOB,8_"."_APCLL))
QUIT
SET APCLBPS=APCLBPS+1
SET APCLSYS=APCLSYS+^(8_"."_APCLL)
SET APCLDIA=APCLDIA+$PIECE(^(8_"."_APCLL),"/",2)
CONTROL ;
+1 IF '$GET(APCLCUML)
GOTO X5
+2 ;if not at least 3 bps - undocumented
IF $GET(^TMP("APCL",$JOB,8.3))=""
SET APCLGOT1=1
SET APCLSUB=61
DO CUML^APCLDM1
Begin DoDot:1
+3 SET APCLGOT1=0
FOR APCLSUB=12,13,14,60
DO CUML^APCLDM1
End DoDot:1
GOTO X5
+4 SET APCLSYS=$JUSTIFY((APCLSYS/APCLBPS),0,0)
SET APCLDIA=$JUSTIFY((APCLDIA/APCLBPS),0,0)
+5 IF ^TMP("APCL",$JOB,7)="NO"
IF APCLSYS<140
IF APCLDIA<90
SET APCLGOT1=1
SET APCLSUB=12
DO CUML^APCLDM1
Begin DoDot:1
+6 SET APCLGOT1=0
FOR APCLSUB=13,14,60,61
DO CUML^APCLDM1
End DoDot:1
GOTO X5
+7 IF ^TMP("APCL",$JOB,7)="YES"
IF APCLSYS<140
IF APCLDIA<90
SET APCLGOT1=1
SET APCLSUB=13
DO CUML^APCLDM1
Begin DoDot:1
+8 SET APCLGOT1=0
FOR APCLSUB=12,14,60,61
DO CUML^APCLDM1
End DoDot:1
GOTO X5
+9 IF APCLSYS>159!(APCLDIA>94)
SET APCLGOT1=1
SET APCLSUB=60
DO CUML^APCLDM1
Begin DoDot:1
+10 SET APCLGOT1=0
FOR APCLSUB=12,13,14,61
DO CUML^APCLDM1
End DoDot:1
GOTO X5
+11 IF (APCLSYS>139&(APCLSYS<160))!(APCLDIA>89&(APCLDIA<95))
SET APCLGOT1=1
SET APCLSUB=14
DO CUML^APCLDM1
Begin DoDot:1
+12 SET APCLGOT1=0
FOR APCLSUB=12,13,60,61
DO CUML^APCLDM1
End DoDot:1
GOTO X5
X5 KILL APCLBP,APCLBPS,APCLSYS,APCLDIA,APCLHYP
+1 QUIT
6 ;
BSTAKEN ;
+1 DO BSTAKEN^APCLDM7
+2 QUIT
+3 ;
