- 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
