- 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 ;
