APCLDM7 ; IHS/CMI/LAB - BLOOD SUGAR TAKEN/LAST 3 ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
BSTAKEN ;EP
K APCLLVST,APCLLGLU
K ^TMP("APCLDM FETCH",$J) S APCLX=APCLPD_"^ALL LAB [DM AUDIT GLUCOSE TESTS TAX"_APCLDATE,APCLY="^TMP(""APCLDM FETCH"",$J," S APCLER=$$START1^APCLDF(APCLX,APCLY)
I APCLER W !,"*** SCRIPT ERROR IN DMGLUCOSE^APCLDM7. CONTACT SITE MANAGER" G BSTAKENX
F APCLL=1:1 Q:'$D(^TMP("APCLDM FETCH",$J,APCLL)) S APCLLVST($P(^TMP("APCLDM FETCH",$J,APCLL),U,5))=$P(^AUPNVLAB(+$P(^TMP("APCLDM FETCH",$J,APCLL),U,4),0),U)_U_^TMP("APCLDM FETCH",$J,APCLL)
K APCL,^TMP("APCLDM FETCH",$J)
K APCL S APCLY="APCL(",APCLX=APCLPD_"^LAST LAB [DM AUDIT HGB A1C TAX"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) S ^TMP("APCL",$J,32)=$S($D(APCL(1)):$P(APCL(1),U,2)_"%",1:"-")
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
.I $D(APCLLVST(APCLVDFN)) S APCLYES=APCLYES+1 ;***
.Q
I 'APCLNTOT S ^TMP("APCL",$J,9)="No DM visits (01,06,28 clinics only)" G BSTAKENC
NEW V S V=(APCLYES/APCLNTOT)*100,V=$J(V,2,0)
S ^TMP("APCL",$J,9)=$S(V<75:"NO",1:"YES")_" - "_V_"%"
BSTAKENC I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,9)["YES":1,1:0),APCLSUB=15 D CUML^APCLDM1
BSTAKENX K APCLNTOT
LAST3BS ;GET LAST THREE
K APCLLGLU,APCLL3R
S V=0 F S V=$O(APCLLVST(V)) Q:V'=+V D
.I $P(^AUPNVSIT(V,0),U,8)]"",$P(^(0),U,8)=APCLERCO Q ;don't count er visits in last 3
.S APCLLGLU(9999999-$P(APCLLVST(V),U,2),$P($P(APCLLVST(V),U,5),";"))=$P(APCLLVST(V),U,4)_" - "_$S($P(^LAB(60,$P(APCLLVST(V),U),0),U)["FAST":"FASTING",1:"RANDOM")_" - "_$P(APCLLVST(V),U,3)
S (APCLX,APCLY,APCLZ)=0 F Q:APCLZ=3 S APCLX=$O(APCLLGLU(APCLX)) Q:APCLX="" F S APCLY=$O(APCLLGLU(APCLX,APCLY)) Q:'APCLY!(APCLZ=3) D
.S APCLZ=APCLZ+1,^TMP("APCL",$J,10_"."_APCLZ)=APCLLGLU(APCLX,APCLY),Y=(9999999-APCLX) D DD^%DT S ^TMP("APCL",$J,38_"."_APCLZ)=Y
I APCLCUML D BSLEVEL
K APCLLVST,APCLBEL,APCLLAB,APCLCOUN,APCLTYPE,APCLLGLU,APCLTEST,APCLYES,APCLX,APCLY,APCLZ
Q
;
X7 K APCLLVST,APCLBEL,APCLLAB,APCLCOUN,APCLTYPE,APCLERCO,APCLL3R,APCLLGLU
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 APCL S APCLY="APCL(",APCLX=APCLPD_"^LAST LAB [DM AUDIT HGB A1C TAX"_APCLDATE
S APCLER=$$START1^APCLDF(APCLX,APCLY) I $D(APCL(1)),$P(APCL(1),U,2)]"",$P(APCL(1),U,2)'="?" D Q
.S V=$P(APCL(1),U,2)
.I V<7.6 S APCLGOT1=1,APCLSUB=16 D CUML^APCLDM1 D Q
..S APCLGOT1=0 F APCLSUB=17,18,58,59 D CUML^APCLDM1
.;
.I V>7.5&(V<10.1) S APCLGOT1=1,APCLSUB=17 D CUML^APCLDM1 D Q
..S APCLGOT1=0 F APCLSUB=16,18,58,59 D CUML^APCLDM1
.;
.I V>10.0&(V<12.1) S APCLGOT1=1,APCLSUB=18 D CUML^APCLDM1 D Q
..S APCLGOT1=0 F APCLSUB=16,17,58,59 D CUML^APCLDM1
.I V>12.0 S APCLGOT1=1,APCLSUB=58 D CUML^APCLDM1 D Q
..S APCLGOT1=0 F APCLSUB=16,17,18,59 D CUML^APCLDM1
GLUCOSE ;check mean of last 3 glucose results
I '$D(^TMP("APCL",$J,10.3)) S APCLGOT1=1,APCLSUB=59 D CUML^APCLDM1 D Q
.S APCLGOT1=0 F APCLSUB=16,17,18,58 D CUML^APCLDM1
S APCLTOT=""
S C=0 F X=10.1,10.2,10.3 S V=+(+$P(^TMP("APCL",$J,X),"- ",3)) I V S C=C+1,APCLTOT=APCLTOT+V
I C'=3 S APCLGOT1=1,APCLSUB=59 D CUML^APCLDM1 D Q
.S APCLGOT1=0 F APCLSUB=16,17,18,58 D CUML^APCLDM1
S X=APCLTOT/3
I X<166 S APCLGOT1=1,APCLSUB=16 D CUML^APCLDM1 D Q
.S APCLGOT1=0 F APCLSUB=17,18,58,59 D CUML^APCLDM1
I X>165,X<251 S APCLGOT1=1,APCLSUB=17 D CUML^APCLDM1 D Q
.S APCLGOT1=0 F APCLSUB=16,18,58,59 D CUML^APCLDM1
I X>250,X<341 S APCLSUB=18,APCLGOT1=1 D CUML^APCLDM1 D Q
.S APCLGOT1=0 F APCLSUB=16,17,58,59 D CUML^APCLDM1
I X>340 S APCLSUB=58,APCLGOT1=1 D CUML^APCLDM1 D Q
.S APCLGOT1=0 F APCLSUB=16,17,18,59 D CUML^APCLDM1
Q
APCLDM7 ; IHS/CMI/LAB - BLOOD SUGAR TAKEN/LAST 3 ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
BSTAKEN ;EP
+1 KILL APCLLVST,APCLLGLU
+2 KILL ^TMP("APCLDM FETCH",$JOB)
SET APCLX=APCLPD_"^ALL LAB [DM AUDIT GLUCOSE TESTS TAX"_APCLDATE
SET APCLY="^TMP(""APCLDM FETCH"",$J,"
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+3 IF APCLER
WRITE !,"*** SCRIPT ERROR IN DMGLUCOSE^APCLDM7. CONTACT SITE MANAGER"
GOTO BSTAKENX
+4 FOR APCLL=1:1
IF '$DATA(^TMP("APCLDM FETCH",$JOB,APCLL))
QUIT
SET APCLLVST($PIECE(^TMP("APCLDM FETCH",$JOB,APCLL),U,5))=$PIECE(^AUPNVLAB(+$PIECE(^TMP("APCLDM FETCH",$JOB,APCLL),U,4),0),U)_U_^TMP("APCLDM FETCH",$JOB,APCLL)
+5 KILL APCL,^TMP("APCLDM FETCH",$JOB)
+6 KILL APCL
SET APCLY="APCL("
SET APCLX=APCLPD_"^LAST LAB [DM AUDIT HGB A1C TAX"_APCLDATE
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
SET ^TMP("APCL",$JOB,32)=$SELECT($DATA(APCL(1)):$PIECE(APCL(1),U,2)_"%",1:"-")
+7 SET (APCLYES,APCLNTOT)=0
FOR APCLL=1:1:APCLTOT
IF '$DATA(^TMP("APCLDM DXVS",$JOB,APCLL))
QUIT
Begin DoDot:1
+8 SET APCLVDFN=^TMP("APCLDM DXVS",$JOB,APCLL)
+9 SET APCLNTOT=APCLNTOT+1
+10 ;***
IF $DATA(APCLLVST(APCLVDFN))
SET APCLYES=APCLYES+1
+11 QUIT
End DoDot:1
+12 IF 'APCLNTOT
SET ^TMP("APCL",$JOB,9)="No DM visits (01,06,28 clinics only)"
GOTO BSTAKENC
+13 NEW V
SET V=(APCLYES/APCLNTOT)*100
SET V=$JUSTIFY(V,2,0)
+14 SET ^TMP("APCL",$JOB,9)=$SELECT(V<75:"NO",1:"YES")_" - "_V_"%"
BSTAKENC IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,9)["YES":1,1:0)
SET APCLSUB=15
DO CUML^APCLDM1
BSTAKENX KILL APCLNTOT
LAST3BS ;GET LAST THREE
+1 KILL APCLLGLU,APCLL3R
+2 SET V=0
FOR
SET V=$ORDER(APCLLVST(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)=APCLERCO
QUIT
+4 SET APCLLGLU(9999999-$PIECE(APCLLVST(V),U,2),$PIECE($PIECE(APCLLVST(V),U,5),";"))=$PIECE(APCLLVST(V),U,4)_" - "_$SELECT($PIECE(^LAB(60,$PIECE(APCLLVST(V),U),0),U)["FAST":"FASTING",1:"RANDOM")_" - "_$PIECE(APCLLVST(V),U,3)
End DoDot:1
+5 SET (APCLX,APCLY,APCLZ)=0
FOR
IF APCLZ=3
QUIT
SET APCLX=$ORDER(APCLLGLU(APCLX))
IF APCLX=""
QUIT
FOR
SET APCLY=$ORDER(APCLLGLU(APCLX,APCLY))
IF 'APCLY!(APCLZ=3)
QUIT
Begin DoDot:1
+6 SET APCLZ=APCLZ+1
SET ^TMP("APCL",$JOB,10_"."_APCLZ)=APCLLGLU(APCLX,APCLY)
SET Y=(9999999-APCLX)
DO DD^%DT
SET ^TMP("APCL",$JOB,38_"."_APCLZ)=Y
End DoDot:1
+7 IF APCLCUML
DO BSLEVEL
+8 KILL APCLLVST,APCLBEL,APCLLAB,APCLCOUN,APCLTYPE,APCLLGLU,APCLTEST,APCLYES,APCLX,APCLY,APCLZ
+9 QUIT
+10 ;
X7 KILL APCLLVST,APCLBEL,APCLLAB,APCLCOUN,APCLTYPE,APCLERCO,APCLL3R,APCLLGLU
+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 APCL
SET APCLY="APCL("
SET APCLX=APCLPD_"^LAST LAB [DM AUDIT HGB A1C TAX"_APCLDATE
+11 SET APCLER=$$START1^APCLDF(APCLX,APCLY)
IF $DATA(APCL(1))
IF $PIECE(APCL(1),U,2)]""
IF $PIECE(APCL(1),U,2)'="?"
Begin DoDot:1
+12 SET V=$PIECE(APCL(1),U,2)
+13 IF V<7.6
SET APCLGOT1=1
SET APCLSUB=16
DO CUML^APCLDM1
Begin DoDot:2
+14 SET APCLGOT1=0
FOR APCLSUB=17,18,58,59
DO CUML^APCLDM1
End DoDot:2
QUIT
+15 ;
+16 IF V>7.5&(V<10.1)
SET APCLGOT1=1
SET APCLSUB=17
DO CUML^APCLDM1
Begin DoDot:2
+17 SET APCLGOT1=0
FOR APCLSUB=16,18,58,59
DO CUML^APCLDM1
End DoDot:2
QUIT
+18 ;
+19 IF V>10.0&(V<12.1)
SET APCLGOT1=1
SET APCLSUB=18
DO CUML^APCLDM1
Begin DoDot:2
+20 SET APCLGOT1=0
FOR APCLSUB=16,17,58,59
DO CUML^APCLDM1
End DoDot:2
QUIT
+21 IF V>12.0
SET APCLGOT1=1
SET APCLSUB=58
DO CUML^APCLDM1
Begin DoDot:2
+22 SET APCLGOT1=0
FOR APCLSUB=16,17,18,59
DO CUML^APCLDM1
End DoDot:2
QUIT
End DoDot:1
QUIT
GLUCOSE ;check mean of last 3 glucose results
+1 IF '$DATA(^TMP("APCL",$JOB,10.3))
SET APCLGOT1=1
SET APCLSUB=59
DO CUML^APCLDM1
Begin DoDot:1
+2 SET APCLGOT1=0
FOR APCLSUB=16,17,18,58
DO CUML^APCLDM1
End DoDot:1
QUIT
+3 SET APCLTOT=""
+4 SET C=0
FOR X=10.1,10.2,10.3
SET V=+(+$PIECE(^TMP("APCL",$JOB,X),"- ",3))
IF V
SET C=C+1
SET APCLTOT=APCLTOT+V
+5 IF C'=3
SET APCLGOT1=1
SET APCLSUB=59
DO CUML^APCLDM1
Begin DoDot:1
+6 SET APCLGOT1=0
FOR APCLSUB=16,17,18,58
DO CUML^APCLDM1
End DoDot:1
QUIT
+7 SET X=APCLTOT/3
+8 IF X<166
SET APCLGOT1=1
SET APCLSUB=16
DO CUML^APCLDM1
Begin DoDot:1
+9 SET APCLGOT1=0
FOR APCLSUB=17,18,58,59
DO CUML^APCLDM1
End DoDot:1
QUIT
+10 IF X>165
IF X<251
SET APCLGOT1=1
SET APCLSUB=17
DO CUML^APCLDM1
Begin DoDot:1
+11 SET APCLGOT1=0
FOR APCLSUB=16,18,58,59
DO CUML^APCLDM1
End DoDot:1
QUIT
+12 IF X>250
IF X<341
SET APCLSUB=18
SET APCLGOT1=1
DO CUML^APCLDM1
Begin DoDot:1
+13 SET APCLGOT1=0
FOR APCLSUB=16,17,58,59
DO CUML^APCLDM1
End DoDot:1
QUIT
+14 IF X>340
SET APCLSUB=58
SET APCLGOT1=1
DO CUML^APCLDM1
Begin DoDot:1
+15 SET APCLGOT1=0
FOR APCLSUB=16,17,18,59
DO CUML^APCLDM1
End DoDot:1
QUIT
+16 QUIT
