BDMDM1A ; IHS/CMI/LAB -CONTINUATION OF BDMDM1 FOR DM AUDIT DATA FETCHING ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
;
EN ; - EP - from ^BDMDM1
;
F BDMI=1:1 Q:$T(@BDMI)="" K BDMX S BDMY="BDM(" D @BDMI K BDM
Q
;
1 ;
WTTAKEN S BDMMEAS=$O(^AUTTMSR("B","WT","")) D TAKEN
S ^TMP("BDM",$J,4)=BDMMEAS
K BDMMEAS
I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,4)["YES":1,1:0),BDMSUB=10 D CUML^BDMDM1
Q
2 ;
LASTWT S BDMW="" S BDMX=BDMPD_"^LAST 24 MEAS WT" S BDMER=$$START1^APCLDF(BDMX,BDMY)
S BDMV221=$O(^ICD9("BA","V22.1 ",""))
F BDMN=1:1 Q:'$D(BDM(BDMN))!$D(^TMP("BDM",$J,5)) S BDMZ=$P(BDM(BDMN),U,5) S BDMD=0 F S BDMD=$O(^AUPNVPOV("AD",BDMZ,BDMD)) Q:'BDMD!$D(^TMP("BDM",$J,5)) D
. I $P(^AUPNVPOV(BDMD,0),U)'=BDMV221 S BDMW=$P(BDM(BDMN),U,2),^TMP("BDM",$J,5)=$P(BDM(BDMN),U,2)_" lbs",Y=$P(BDM(BDMN),U) D DD^%DT S ^TMP("BDM",$J,33)=Y
.Q
I '$D(^TMP("BDM",$J,5)) S ^(5)="NO WT AVAILABLE",^TMP("BDM",$J,33.1)="" I BDMCUML S BDMSUB=54,BDMGOT1=1 D CUML^BDMDM1 S BDMGOT1=0 S BDMSUB=48 D CUML^BDMDM1 S BDMSUB=49,BDMGOT1=0 D CUML^BDMDM1 G X2
I '$G(BDMCUML) G X2
S H=BDMHTKI I 'H S ^TMP("BDM",$J,33.1)="",BDMSUB=54,BDMGOT1=1 D CUML^BDMDM1 S BDMSUB=48,BDMGOT1=0 D CUML^BDMDM1 S BDMSUB=49,BDMGOT1=0 D CUML^BDMDM1 G X2
S BDMW=BDMW*.4536,H=((H*.0254)*(H*.0254)),B=BDMW/H,^TMP("BDM",$J,33.1)=$J(B,4,1)
I $$SEX^AUPNPAT(BDMPD)="M"&(B>31.0)!($$SEX^AUPNPAT(BDMPD)="F"&(B>32.2)) S BDMSUB=49,BDMGOT1=1 D CUML^BDMDM1 S BDMSUB=54,BDMGOT1=0 D CUML^BDMDM1 S BDMGOT1=1,BDMSUB=48 D CUML^BDMDM1 G X2
I $$SEX^AUPNPAT(BDMPD)="M"&(B>27.7)!($$SEX^AUPNPAT(BDMPD)="F"&(B>27.2)) S BDMSUB=48,BDMGOT1=1 D CUML^BDMDM1 S BDMSUB=54,BDMGOT1=0 D CUML^BDMDM1 S BDMSUB=49,BDMGOT1=0 D CUML^BDMDM1 G X2
;I $E(BDMRWPT)="*" S BDMSUB=54,BDMGOT1=1 D CUML^BDMDM1 S BDMGOT1=0,BDMSUB=48 D CUML^BDMDM1 S BDMSUB=49 D CUML^BDMDM1 G X2
;I +BDMRWPT>154 S BDMSUB=49,BDMGOT1=1 D CUML^BDMDM1 S BDMGOT1=0,BDMSUB=48 D CUML^BDMDM1 S BDMSUB=54 D CUML^BDMDM1 G X2
;I +BDMRWPT>125 S BDMSUB=48,BDMGOT1=1 D CUML^BDMDM1 S BDMGOT1=0,BDMSUB=49 D CUML^BDMDM1 S BDMSUB=54 D CUML^BDMDM1 G X2
F BDMSUB=48,49,54 S BDMGOT1=0 D CUML^BDMDM1
X2 ;
K BDMSUB,BDMGOT1,BDMRWPT,BDMZ,BDMN,BDMD,BDMV221,BDMX
Q
3 ;
BPTAKEN S BDMMEAS=$O(^AUTTMSR("B","BP","")) D TAKEN
S ^TMP("BDM",$J,6)=BDMMEAS
I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,6)["YES":1,1:0),BDMSUB=11 D CUML^BDMDM1
K BDMMEAS
Q
;
TAKEN ; Is BP or WT taken 75% of time during the last year's diabetic visits
S (BDMYES,BDMNTOT)=0 F BDML=1:1:BDMTOT Q:'$D(^TMP("BDMDM DXVS",$J,BDML)) D
.S BDMVDFN=^TMP("BDMDM DXVS",$J,BDML)
.S BDMNTOT=BDMNTOT+1
.S (BDMMDFN,BDMFOUN)=0 F S BDMMDFN=$O(^AUPNVMSR("AD",BDMVDFN,BDMMDFN)) Q:'BDMMDFN!(BDMFOUN) D
..I BDMMDFN,+^AUPNVMSR(BDMMDFN,0)=BDMMEAS S BDMYES=BDMYES+1,BDMFOUN=1 Q
..Q
;***
I 'BDMNTOT S BDMMEAS="No DM visits (01,06,28 clinics only)" G TAKENX
NEW V
S V=(BDMYES/BDMNTOT)*100,V=$J(V,2,0)
S BDMMEAS=$S(V<75:"NO",1:"YES")_" - "_V_"%"
K BDMNTOT
TAKENX Q
;
4 ;
HTNDX ;
D HTNPLDX I $D(BDM(1)) G X
S X=BDMEDT,%DT="" D ^%DT S X1=$S(Y>DT:DT,1:Y) S BDMHTNE=Y,X2=1 D C^%DTC S BDMHTNE=($E(X,1,3)-5)_$E(X,4,7) S Y=BDMHTNE D DD^%DT S BDMHTNE=Y
S BDMX=BDMPD_"^LAST DX [SURVEILLANCE HYPERTENSION;DURING "_BDMHTNE_"-"_BDMEDT S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X S ^TMP("BDM",$J,7)=$S($D(BDM(1)):"YES",1:"NO")
X I BDMER S ^TMP("BDM",$J,7)="*** SCRIPT ERROR IN HTNDX^BDMDM1A. CONTACT SITE MANAGER"
K BDM
Q
HTNPLDX ;see if htn on problem list
S BDMX=BDMPD_"^PROBLEM [DM AUDIT PROBLEM HTN DIAGNOSES",BDMY="BDM(" S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X I $D(BDM(1)) S ^TMP("BDM",$J,7)="YES"
Q
5 ;
BPS ;
S BDMERCO=$O(^DIC(40.7,"C",30,"")),BDMLL=0
S BDMX=BDMPD_"^LAST 50 MEAS BP"_BDMDATE S BDMER=$$START1^APCLDF(BDMX,BDMY) F BDML=1:1:20 Q:'$D(BDM(BDML)) S BDMBP=$P($G(BDM(BDML)),U,2)_$S($P($G(BDM(BDML)),U,2)]"":" mm HG",1:"") D
.Q:$P(^AUPNVSIT($P(BDM(BDML),U,5),0),U,8)=BDMERCO
.S BDMLL=BDMLL+1,^TMP("BDM",$J,8_"."_BDMLL)=BDMBP S Y=$P(BDM(BDML),U,1) D DD^%DT S ^TMP("BDM",$J,34_"."_BDMLL)=Y
I BDMCUML,$G(^TMP("BDM",$J,8.1))]"" S (BDMSYS,BDMDIA,BDMBPS)=0 F BDML=1:1:3 Q:'$D(^TMP("BDM",$J,8_"."_BDML)) S BDMBPS=BDMBPS+1,BDMSYS=BDMSYS+^(8_"."_BDML),BDMDIA=BDMDIA+$P(^(8_"."_BDML),"/",2)
CONTROL ;
I '$G(BDMCUML) G X5
I $G(^TMP("BDM",$J,8.3))="" S BDMGOT1=1,BDMSUB=61 D CUML^BDMDM1 D G X5 ;if not at least 3 bps - undocumented
.S BDMGOT1=0 F BDMSUB=12,13,14,60 D CUML^BDMDM1
S BDMSYS=$J((BDMSYS/BDMBPS),0,0),BDMDIA=$J((BDMDIA/BDMBPS),0,0)
I ^TMP("BDM",$J,7)="NO",BDMSYS<140,BDMDIA<90 S BDMGOT1=1,BDMSUB=12 D CUML^BDMDM1 D G X5
.S BDMGOT1=0 F BDMSUB=13,14,60,61 D CUML^BDMDM1
I ^TMP("BDM",$J,7)="YES",BDMSYS<140,BDMDIA<90 S BDMGOT1=1,BDMSUB=13 D CUML^BDMDM1 D G X5
.S BDMGOT1=0 F BDMSUB=12,14,60,61 D CUML^BDMDM1
I BDMSYS>159!(BDMDIA>94) S BDMGOT1=1,BDMSUB=60 D CUML^BDMDM1 D G X5
.S BDMGOT1=0 F BDMSUB=12,13,14,61 D CUML^BDMDM1
I (BDMSYS>139&(BDMSYS<160))!(BDMDIA>89&(BDMDIA<95)) S BDMGOT1=1,BDMSUB=14 D CUML^BDMDM1 D G X5
.S BDMGOT1=0 F BDMSUB=12,13,60,61 D CUML^BDMDM1
X5 K BDMBP,BDMBPS,BDMSYS,BDMDIA,BDMHYP
Q
6 ;
BSTAKEN ;
D BSTAKEN^BDMDM7
Q
;
BDMDM1A ; IHS/CMI/LAB -CONTINUATION OF BDMDM1 FOR DM AUDIT DATA FETCHING ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
+2 ;
EN ; - EP - from ^BDMDM1
+1 ;
+2 FOR BDMI=1:1
IF $TEXT(@BDMI)=""
QUIT
KILL BDMX
SET BDMY="BDM("
DO @BDMI
KILL BDM
+3 QUIT
+4 ;
1 ;
WTTAKEN SET BDMMEAS=$ORDER(^AUTTMSR("B","WT",""))
DO TAKEN
+1 SET ^TMP("BDM",$JOB,4)=BDMMEAS
+2 KILL BDMMEAS
+3 IF BDMCUML
SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,4)["YES":1,1:0)
SET BDMSUB=10
DO CUML^BDMDM1
+4 QUIT
2 ;
LASTWT SET BDMW=""
SET BDMX=BDMPD_"^LAST 24 MEAS WT"
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
+1 SET BDMV221=$ORDER(^ICD9("BA","V22.1 ",""))
+2 FOR BDMN=1:1
IF '$DATA(BDM(BDMN))!$DATA(^TMP("BDM",$JOB,5))
QUIT
SET BDMZ=$PIECE(BDM(BDMN),U,5)
SET BDMD=0
FOR
SET BDMD=$ORDER(^AUPNVPOV("AD",BDMZ,BDMD))
IF 'BDMD!$DATA(^TMP("BDM",$JOB,5))
QUIT
Begin DoDot:1
+3 IF $PIECE(^AUPNVPOV(BDMD,0),U)'=BDMV221
SET BDMW=$PIECE(BDM(BDMN),U,2)
SET ^TMP("BDM",$JOB,5)=$PIECE(BDM(BDMN),U,2)_" lbs"
SET Y=$PIECE(BDM(BDMN),U)
DO DD^%DT
SET ^TMP("BDM",$JOB,33)=Y
+4 QUIT
End DoDot:1
+5 IF '$DATA(^TMP("BDM",$JOB,5))
SET ^(5)="NO WT AVAILABLE"
SET ^TMP("BDM",$JOB,33.1)=""
IF BDMCUML
SET BDMSUB=54
SET BDMGOT1=1
DO CUML^BDMDM1
SET BDMGOT1=0
SET BDMSUB=48
DO CUML^BDMDM1
SET BDMSUB=49
SET BDMGOT1=0
DO CUML^BDMDM1
GOTO X2
+6 IF '$GET(BDMCUML)
GOTO X2
+7 SET H=BDMHTKI
IF 'H
SET ^TMP("BDM",$JOB,33.1)=""
SET BDMSUB=54
SET BDMGOT1=1
DO CUML^BDMDM1
SET BDMSUB=48
SET BDMGOT1=0
DO CUML^BDMDM1
SET BDMSUB=49
SET BDMGOT1=0
DO CUML^BDMDM1
GOTO X2
+8 SET BDMW=BDMW*.4536
SET H=((H*.0254)*(H*.0254))
SET B=BDMW/H
SET ^TMP("BDM",$JOB,33.1)=$JUSTIFY(B,4,1)
+9 IF $$SEX^AUPNPAT(BDMPD)="M"&(B>31.0)!($$SEX^AUPNPAT(BDMPD)="F"&(B>32.2))
SET BDMSUB=49
SET BDMGOT1=1
DO CUML^BDMDM1
SET BDMSUB=54
SET BDMGOT1=0
DO CUML^BDMDM1
SET BDMGOT1=1
SET BDMSUB=48
DO CUML^BDMDM1
GOTO X2
+10 IF $$SEX^AUPNPAT(BDMPD)="M"&(B>27.7)!($$SEX^AUPNPAT(BDMPD)="F"&(B>27.2))
SET BDMSUB=48
SET BDMGOT1=1
DO CUML^BDMDM1
SET BDMSUB=54
SET BDMGOT1=0
DO CUML^BDMDM1
SET BDMSUB=49
SET BDMGOT1=0
DO CUML^BDMDM1
GOTO X2
+11 ;I $E(BDMRWPT)="*" S BDMSUB=54,BDMGOT1=1 D CUML^BDMDM1 S BDMGOT1=0,BDMSUB=48 D CUML^BDMDM1 S BDMSUB=49 D CUML^BDMDM1 G X2
+12 ;I +BDMRWPT>154 S BDMSUB=49,BDMGOT1=1 D CUML^BDMDM1 S BDMGOT1=0,BDMSUB=48 D CUML^BDMDM1 S BDMSUB=54 D CUML^BDMDM1 G X2
+13 ;I +BDMRWPT>125 S BDMSUB=48,BDMGOT1=1 D CUML^BDMDM1 S BDMGOT1=0,BDMSUB=49 D CUML^BDMDM1 S BDMSUB=54 D CUML^BDMDM1 G X2
+14 FOR BDMSUB=48,49,54
SET BDMGOT1=0
DO CUML^BDMDM1
X2 ;
+1 KILL BDMSUB,BDMGOT1,BDMRWPT,BDMZ,BDMN,BDMD,BDMV221,BDMX
+2 QUIT
3 ;
BPTAKEN SET BDMMEAS=$ORDER(^AUTTMSR("B","BP",""))
DO TAKEN
+1 SET ^TMP("BDM",$JOB,6)=BDMMEAS
+2 IF BDMCUML
SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,6)["YES":1,1:0)
SET BDMSUB=11
DO CUML^BDMDM1
+3 KILL BDMMEAS
+4 QUIT
+5 ;
TAKEN ; Is BP or WT taken 75% of time during the last year's diabetic visits
+1 SET (BDMYES,BDMNTOT)=0
FOR BDML=1:1:BDMTOT
IF '$DATA(^TMP("BDMDM DXVS",$JOB,BDML))
QUIT
Begin DoDot:1
+2 SET BDMVDFN=^TMP("BDMDM DXVS",$JOB,BDML)
+3 SET BDMNTOT=BDMNTOT+1
+4 SET (BDMMDFN,BDMFOUN)=0
FOR
SET BDMMDFN=$ORDER(^AUPNVMSR("AD",BDMVDFN,BDMMDFN))
IF 'BDMMDFN!(BDMFOUN)
QUIT
Begin DoDot:2
+5 IF BDMMDFN
IF +^AUPNVMSR(BDMMDFN,0)=BDMMEAS
SET BDMYES=BDMYES+1
SET BDMFOUN=1
QUIT
+6 QUIT
End DoDot:2
End DoDot:1
+7 ;***
+8 IF 'BDMNTOT
SET BDMMEAS="No DM visits (01,06,28 clinics only)"
GOTO TAKENX
+9 NEW V
+10 SET V=(BDMYES/BDMNTOT)*100
SET V=$JUSTIFY(V,2,0)
+11 SET BDMMEAS=$SELECT(V<75:"NO",1:"YES")_" - "_V_"%"
+12 KILL BDMNTOT
TAKENX QUIT
+1 ;
4 ;
HTNDX ;
+1 DO HTNPLDX
IF $DATA(BDM(1))
GOTO X
+2 SET X=BDMEDT
SET %DT=""
DO ^%DT
SET X1=$SELECT(Y>DT:DT,1:Y)
SET BDMHTNE=Y
SET X2=1
DO C^%DTC
SET BDMHTNE=($EXTRACT(X,1,3)-5)_$EXTRACT(X,4,7)
SET Y=BDMHTNE
DO DD^%DT
SET BDMHTNE=Y
+3 SET BDMX=BDMPD_"^LAST DX [SURVEILLANCE HYPERTENSION;DURING "_BDMHTNE_"-"_BDMEDT
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
IF BDMER
GOTO X
SET ^TMP("BDM",$JOB,7)=$SELECT($DATA(BDM(1)):"YES",1:"NO")
X IF BDMER
SET ^TMP("BDM",$JOB,7)="*** SCRIPT ERROR IN HTNDX^BDMDM1A. CONTACT SITE MANAGER"
+1 KILL BDM
+2 QUIT
HTNPLDX ;see if htn on problem list
+1 SET BDMX=BDMPD_"^PROBLEM [DM AUDIT PROBLEM HTN DIAGNOSES"
SET BDMY="BDM("
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
IF BDMER
GOTO X
IF $DATA(BDM(1))
SET ^TMP("BDM",$JOB,7)="YES"
+2 QUIT
5 ;
BPS ;
+1 SET BDMERCO=$ORDER(^DIC(40.7,"C",30,""))
SET BDMLL=0
+2 SET BDMX=BDMPD_"^LAST 50 MEAS BP"_BDMDATE
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
FOR BDML=1:1:20
IF '$DATA(BDM(BDML))
QUIT
SET BDMBP=$PIECE($GET(BDM(BDML)),U,2)_$SELECT($PIECE($GET(BDM(BDML)),U,2)]"":" mm HG",1:"")
Begin DoDot:1
+3 IF $PIECE(^AUPNVSIT($PIECE(BDM(BDML),U,5),0),U,8)=BDMERCO
QUIT
+4 SET BDMLL=BDMLL+1
SET ^TMP("BDM",$JOB,8_"."_BDMLL)=BDMBP
SET Y=$PIECE(BDM(BDML),U,1)
DO DD^%DT
SET ^TMP("BDM",$JOB,34_"."_BDMLL)=Y
End DoDot:1
+5 IF BDMCUML
IF $GET(^TMP("BDM",$JOB,8.1))]""
SET (BDMSYS,BDMDIA,BDMBPS)=0
FOR BDML=1:1:3
IF '$DATA(^TMP("BDM",$JOB,8_"."_BDML))
QUIT
SET BDMBPS=BDMBPS+1
SET BDMSYS=BDMSYS+^(8_"."_BDML)
SET BDMDIA=BDMDIA+$PIECE(^(8_"."_BDML),"/",2)
CONTROL ;
+1 IF '$GET(BDMCUML)
GOTO X5
+2 ;if not at least 3 bps - undocumented
IF $GET(^TMP("BDM",$JOB,8.3))=""
SET BDMGOT1=1
SET BDMSUB=61
DO CUML^BDMDM1
Begin DoDot:1
+3 SET BDMGOT1=0
FOR BDMSUB=12,13,14,60
DO CUML^BDMDM1
End DoDot:1
GOTO X5
+4 SET BDMSYS=$JUSTIFY((BDMSYS/BDMBPS),0,0)
SET BDMDIA=$JUSTIFY((BDMDIA/BDMBPS),0,0)
+5 IF ^TMP("BDM",$JOB,7)="NO"
IF BDMSYS<140
IF BDMDIA<90
SET BDMGOT1=1
SET BDMSUB=12
DO CUML^BDMDM1
Begin DoDot:1
+6 SET BDMGOT1=0
FOR BDMSUB=13,14,60,61
DO CUML^BDMDM1
End DoDot:1
GOTO X5
+7 IF ^TMP("BDM",$JOB,7)="YES"
IF BDMSYS<140
IF BDMDIA<90
SET BDMGOT1=1
SET BDMSUB=13
DO CUML^BDMDM1
Begin DoDot:1
+8 SET BDMGOT1=0
FOR BDMSUB=12,14,60,61
DO CUML^BDMDM1
End DoDot:1
GOTO X5
+9 IF BDMSYS>159!(BDMDIA>94)
SET BDMGOT1=1
SET BDMSUB=60
DO CUML^BDMDM1
Begin DoDot:1
+10 SET BDMGOT1=0
FOR BDMSUB=12,13,14,61
DO CUML^BDMDM1
End DoDot:1
GOTO X5
+11 IF (BDMSYS>139&(BDMSYS<160))!(BDMDIA>89&(BDMDIA<95))
SET BDMGOT1=1
SET BDMSUB=14
DO CUML^BDMDM1
Begin DoDot:1
+12 SET BDMGOT1=0
FOR BDMSUB=12,13,60,61
DO CUML^BDMDM1
End DoDot:1
GOTO X5
X5 KILL BDMBP,BDMBPS,BDMSYS,BDMDIA,BDMHYP
+1 QUIT
6 ;
BSTAKEN ;
+1 DO BSTAKEN^BDMDM7
+2 QUIT
+3 ;
