BDMDM7 ; IHS/CMI/LAB - BLOOD SUGAR TAKEN/LAST 3 ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
;
;
BSTAKEN ;EP
K BDMLVST,BDMLGLU
K ^TMP("BDMDM FETCH",$J) S BDMX=BDMPD_"^ALL LAB [DM AUDIT GLUCOSE TESTS TAX"_BDMDATE,BDMY="^TMP(""BDMDM FETCH"",$J," S BDMER=$$START1^APCLDF(BDMX,BDMY)
I BDMER W !,"*** SCRIPT ERROR IN DMGLUCOSE^BDMDM7. CONTACT SITE MANAGER" G BSTAKENX
F BDML=1:1 Q:'$D(^TMP("BDMDM FETCH",$J,BDML)) S BDMLVST($P(^TMP("BDMDM FETCH",$J,BDML),U,5))=$P(^AUPNVLAB(+$P(^TMP("BDMDM FETCH",$J,BDML),U,4),0),U)_U_^TMP("BDMDM FETCH",$J,BDML)
K BDM,^TMP("BDMDM FETCH",$J)
K BDM S BDMY="BDM(",BDMX=BDMPD_"^LAST LAB [DM AUDIT HGB A1C TAX"_BDMDATE S BDMER=$$START1^APCLDF(BDMX,BDMY) S ^TMP("BDM",$J,32)=$S($D(BDM(1)):$P(BDM(1),U,2)_"%",1:"-")
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
.I $D(BDMLVST(BDMVDFN)) S BDMYES=BDMYES+1 ;***
.Q
I 'BDMNTOT S ^TMP("BDM",$J,9)="No DM visits (01,06,28 clinics only)" G BSTAKENC
NEW V S V=(BDMYES/BDMNTOT)*100,V=$J(V,2,0)
S ^TMP("BDM",$J,9)=$S(V<75:"NO",1:"YES")_" - "_V_"%"
BSTAKENC I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,9)["YES":1,1:0),BDMSUB=15 D CUML^BDMDM1
BSTAKENX K BDMNTOT
LAST3BS ;GET LAST THREE
K BDMLGLU,BDML3R
S V=0 F S V=$O(BDMLVST(V)) Q:V'=+V D
.I $P(^AUPNVSIT(V,0),U,8)]"",$P(^(0),U,8)=BDMERCO Q ;don't count er visits in last 3
.S BDMLGLU(9999999-$P(BDMLVST(V),U,2),$P($P(BDMLVST(V),U,5),";"))=$P(BDMLVST(V),U,4)_" - "_$S($P(^LAB(60,$P(BDMLVST(V),U),0),U)["FAST":"FASTING",1:"RANDOM")_" - "_$P(BDMLVST(V),U,3)
S (BDMX,BDMY,BDMZ)=0 F Q:BDMZ=3 S BDMX=$O(BDMLGLU(BDMX)) Q:BDMX="" F S BDMY=$O(BDMLGLU(BDMX,BDMY)) Q:'BDMY!(BDMZ=3) D
.S BDMZ=BDMZ+1,^TMP("BDM",$J,10_"."_BDMZ)=BDMLGLU(BDMX,BDMY),Y=(9999999-BDMX) D DD^%DT S ^TMP("BDM",$J,38_"."_BDMZ)=Y
I BDMCUML D BSLEVEL
K BDMLVST,BDMBEL,BDMLAB,BDMCOUN,BDMTYPE,BDMLGLU,BDMTEST,BDMYES,BDMX,BDMY,BDMZ
Q
;
X7 K BDMLVST,BDMBEL,BDMLAB,BDMCOUN,BDMTYPE,BDMERCO,BDML3R,BDMLGLU
Q
BSLEVEL ;calculate bs control
;get last Hemoglobin A1C in time frame, if there is one,
;use it to calculate :
; ---> acceptable <=7.5
; ---> fair 7.6-10.0
; ---> high 10.1-12.0
; ---> very high >12.0
;quit
;if no hgla1c get last 3 bs's - if not three put in undocumented
;take mean of 3
K BDM S BDMY="BDM(",BDMX=BDMPD_"^LAST LAB [DM AUDIT HGB A1C TAX"_BDMDATE
S BDMER=$$START1^APCLDF(BDMX,BDMY) I $D(BDM(1)),$P(BDM(1),U,2)]"",$P(BDM(1),U,2)'="?" D Q
.S V=$P(BDM(1),U,2)
.I V<7.6 S BDMGOT1=1,BDMSUB=16 D CUML^BDMDM1 D Q
..S BDMGOT1=0 F BDMSUB=17,18,58,59 D CUML^BDMDM1
.;
.I V>7.5&(V<10.1) S BDMGOT1=1,BDMSUB=17 D CUML^BDMDM1 D Q
..S BDMGOT1=0 F BDMSUB=16,18,58,59 D CUML^BDMDM1
.;
.I V>10.0&(V<12.1) S BDMGOT1=1,BDMSUB=18 D CUML^BDMDM1 D Q
..S BDMGOT1=0 F BDMSUB=16,17,58,59 D CUML^BDMDM1
.I V>12.0 S BDMGOT1=1,BDMSUB=58 D CUML^BDMDM1 D Q
..S BDMGOT1=0 F BDMSUB=16,17,18,59 D CUML^BDMDM1
GLUCOSE ;check mean of last 3 glucose results
I '$D(^TMP("BDM",$J,10.3)) S BDMGOT1=1,BDMSUB=59 D CUML^BDMDM1 D Q
.S BDMGOT1=0 F BDMSUB=16,17,18,58 D CUML^BDMDM1
S BDMTOT=""
S C=0 F X=10.1,10.2,10.3 S V=+(+$P(^TMP("BDM",$J,X),"- ",3)) I V S C=C+1,BDMTOT=BDMTOT+V
I C'=3 S BDMGOT1=1,BDMSUB=59 D CUML^BDMDM1 D Q
.S BDMGOT1=0 F BDMSUB=16,17,18,58 D CUML^BDMDM1
S X=BDMTOT/3
I X<166 S BDMGOT1=1,BDMSUB=16 D CUML^BDMDM1 D Q
.S BDMGOT1=0 F BDMSUB=17,18,58,59 D CUML^BDMDM1
I X>165,X<251 S BDMGOT1=1,BDMSUB=17 D CUML^BDMDM1 D Q
.S BDMGOT1=0 F BDMSUB=16,18,58,59 D CUML^BDMDM1
I X>250,X<341 S BDMSUB=18,BDMGOT1=1 D CUML^BDMDM1 D Q
.S BDMGOT1=0 F BDMSUB=16,17,58,59 D CUML^BDMDM1
I X>340 S BDMSUB=58,BDMGOT1=1 D CUML^BDMDM1 D Q
.S BDMGOT1=0 F BDMSUB=16,17,18,59 D CUML^BDMDM1
Q
BDMDM7 ; IHS/CMI/LAB - BLOOD SUGAR TAKEN/LAST 3 ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
+2 ;
+3 ;
BSTAKEN ;EP
+1 KILL BDMLVST,BDMLGLU
+2 KILL ^TMP("BDMDM FETCH",$JOB)
SET BDMX=BDMPD_"^ALL LAB [DM AUDIT GLUCOSE TESTS TAX"_BDMDATE
SET BDMY="^TMP(""BDMDM FETCH"",$J,"
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
+3 IF BDMER
WRITE !,"*** SCRIPT ERROR IN DMGLUCOSE^BDMDM7. CONTACT SITE MANAGER"
GOTO BSTAKENX
+4 FOR BDML=1:1
IF '$DATA(^TMP("BDMDM FETCH",$JOB,BDML))
QUIT
SET BDMLVST($PIECE(^TMP("BDMDM FETCH",$JOB,BDML),U,5))=$PIECE(^AUPNVLAB(+$PIECE(^TMP("BDMDM FETCH",$JOB,BDML),U,4),0),U)_U_^TMP("BDMDM FETCH",$JOB,BDML)
+5 KILL BDM,^TMP("BDMDM FETCH",$JOB)
+6 KILL BDM
SET BDMY="BDM("
SET BDMX=BDMPD_"^LAST LAB [DM AUDIT HGB A1C TAX"_BDMDATE
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
SET ^TMP("BDM",$JOB,32)=$SELECT($DATA(BDM(1)):$PIECE(BDM(1),U,2)_"%",1:"-")
+7 SET (BDMYES,BDMNTOT)=0
FOR BDML=1:1:BDMTOT
IF '$DATA(^TMP("BDMDM DXVS",$JOB,BDML))
QUIT
Begin DoDot:1
+8 SET BDMVDFN=^TMP("BDMDM DXVS",$JOB,BDML)
+9 SET BDMNTOT=BDMNTOT+1
+10 ;***
IF $DATA(BDMLVST(BDMVDFN))
SET BDMYES=BDMYES+1
+11 QUIT
End DoDot:1
+12 IF 'BDMNTOT
SET ^TMP("BDM",$JOB,9)="No DM visits (01,06,28 clinics only)"
GOTO BSTAKENC
+13 NEW V
SET V=(BDMYES/BDMNTOT)*100
SET V=$JUSTIFY(V,2,0)
+14 SET ^TMP("BDM",$JOB,9)=$SELECT(V<75:"NO",1:"YES")_" - "_V_"%"
BSTAKENC IF BDMCUML
SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,9)["YES":1,1:0)
SET BDMSUB=15
DO CUML^BDMDM1
BSTAKENX KILL BDMNTOT
LAST3BS ;GET LAST THREE
+1 KILL BDMLGLU,BDML3R
+2 SET V=0
FOR
SET V=$ORDER(BDMLVST(V))
IF V'=+V
QUIT
Begin DoDot:1
+3 ;don't count er visits in last 3
IF $PIECE(^AUPNVSIT(V,0),U,8)]""
IF $PIECE(^(0),U,8)=BDMERCO
QUIT
+4 SET BDMLGLU(9999999-$PIECE(BDMLVST(V),U,2),$PIECE($PIECE(BDMLVST(V),U,5),";"))=$PIECE(BDMLVST(V),U,4)_" - "_$SELECT($PIECE(^LAB(60,$PIECE(BDMLVST(V),U),0),U)["FAST":"FASTING",1:"RANDOM")_" - "_$PIECE(BDMLVST(V),U,3)
End DoDot:1
+5 SET (BDMX,BDMY,BDMZ)=0
FOR
IF BDMZ=3
QUIT
SET BDMX=$ORDER(BDMLGLU(BDMX))
IF BDMX=""
QUIT
FOR
SET BDMY=$ORDER(BDMLGLU(BDMX,BDMY))
IF 'BDMY!(BDMZ=3)
QUIT
Begin DoDot:1
+6 SET BDMZ=BDMZ+1
SET ^TMP("BDM",$JOB,10_"."_BDMZ)=BDMLGLU(BDMX,BDMY)
SET Y=(9999999-BDMX)
DO DD^%DT
SET ^TMP("BDM",$JOB,38_"."_BDMZ)=Y
End DoDot:1
+7 IF BDMCUML
DO BSLEVEL
+8 KILL BDMLVST,BDMBEL,BDMLAB,BDMCOUN,BDMTYPE,BDMLGLU,BDMTEST,BDMYES,BDMX,BDMY,BDMZ
+9 QUIT
+10 ;
X7 KILL BDMLVST,BDMBEL,BDMLAB,BDMCOUN,BDMTYPE,BDMERCO,BDML3R,BDMLGLU
+1 QUIT
BSLEVEL ;calculate bs control
+1 ;get last Hemoglobin A1C in time frame, if there is one,
+2 ;use it to calculate :
+3 ; ---> acceptable <=7.5
+4 ; ---> fair 7.6-10.0
+5 ; ---> high 10.1-12.0
+6 ; ---> very high >12.0
+7 ;quit
+8 ;if no hgla1c get last 3 bs's - if not three put in undocumented
+9 ;take mean of 3
+10 KILL BDM
SET BDMY="BDM("
SET BDMX=BDMPD_"^LAST LAB [DM AUDIT HGB A1C TAX"_BDMDATE
+11 SET BDMER=$$START1^APCLDF(BDMX,BDMY)
IF $DATA(BDM(1))
IF $PIECE(BDM(1),U,2)]""
IF $PIECE(BDM(1),U,2)'="?"
Begin DoDot:1
+12 SET V=$PIECE(BDM(1),U,2)
+13 IF V<7.6
SET BDMGOT1=1
SET BDMSUB=16
DO CUML^BDMDM1
Begin DoDot:2
+14 SET BDMGOT1=0
FOR BDMSUB=17,18,58,59
DO CUML^BDMDM1
End DoDot:2
QUIT
+15 ;
+16 IF V>7.5&(V<10.1)
SET BDMGOT1=1
SET BDMSUB=17
DO CUML^BDMDM1
Begin DoDot:2
+17 SET BDMGOT1=0
FOR BDMSUB=16,18,58,59
DO CUML^BDMDM1
End DoDot:2
QUIT
+18 ;
+19 IF V>10.0&(V<12.1)
SET BDMGOT1=1
SET BDMSUB=18
DO CUML^BDMDM1
Begin DoDot:2
+20 SET BDMGOT1=0
FOR BDMSUB=16,17,58,59
DO CUML^BDMDM1
End DoDot:2
QUIT
+21 IF V>12.0
SET BDMGOT1=1
SET BDMSUB=58
DO CUML^BDMDM1
Begin DoDot:2
+22 SET BDMGOT1=0
FOR BDMSUB=16,17,18,59
DO CUML^BDMDM1
End DoDot:2
QUIT
End DoDot:1
QUIT
GLUCOSE ;check mean of last 3 glucose results
+1 IF '$DATA(^TMP("BDM",$JOB,10.3))
SET BDMGOT1=1
SET BDMSUB=59
DO CUML^BDMDM1
Begin DoDot:1
+2 SET BDMGOT1=0
FOR BDMSUB=16,17,18,58
DO CUML^BDMDM1
End DoDot:1
QUIT
+3 SET BDMTOT=""
+4 SET C=0
FOR X=10.1,10.2,10.3
SET V=+(+$PIECE(^TMP("BDM",$JOB,X),"- ",3))
IF V
SET C=C+1
SET BDMTOT=BDMTOT+V
+5 IF C'=3
SET BDMGOT1=1
SET BDMSUB=59
DO CUML^BDMDM1
Begin DoDot:1
+6 SET BDMGOT1=0
FOR BDMSUB=16,17,18,58
DO CUML^BDMDM1
End DoDot:1
QUIT
+7 SET X=BDMTOT/3
+8 IF X<166
SET BDMGOT1=1
SET BDMSUB=16
DO CUML^BDMDM1
Begin DoDot:1
+9 SET BDMGOT1=0
FOR BDMSUB=17,18,58,59
DO CUML^BDMDM1
End DoDot:1
QUIT
+10 IF X>165
IF X<251
SET BDMGOT1=1
SET BDMSUB=17
DO CUML^BDMDM1
Begin DoDot:1
+11 SET BDMGOT1=0
FOR BDMSUB=16,18,58,59
DO CUML^BDMDM1
End DoDot:1
QUIT
+12 IF X>250
IF X<341
SET BDMSUB=18
SET BDMGOT1=1
DO CUML^BDMDM1
Begin DoDot:1
+13 SET BDMGOT1=0
FOR BDMSUB=16,17,58,59
DO CUML^BDMDM1
End DoDot:1
QUIT
+14 IF X>340
SET BDMSUB=58
SET BDMGOT1=1
DO CUML^BDMDM1
Begin DoDot:1
+15 SET BDMGOT1=0
FOR BDMSUB=16,17,18,59
DO CUML^BDMDM1
End DoDot:1
QUIT
+16 QUIT
