- 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
