BDMDM1 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
;
;
EN ; - ENTRY POINT - from ^BDMASK
S BDMER=0
D EN^BDMDM5 ;header and patient ident
D CLINICAL
D CLEAN^BDMDM5
XIT Q
;
;
CUML ; - ENTRY POINT - Set cumulative nodes
I '$D(^TMP("BDMCUML",$J,BDMSUB)) S ^TMP("BDMCUML",$J,BDMSUB)=BDMGOT1_"/"_1
E S ^(BDMSUB)=$S(BDMGOT1:$P(^TMP("BDMCUML",$J,BDMSUB),"/")+1,1:$P(^TMP("BDMCUML",$J,BDMSUB),"/"))_"/"_($P(^(BDMSUB),"/",2)+1)
Q
;
CLINICAL ; Get clinical data
D DMVISITS
G:BDMER X
D VISITS
F BDMI=1:1 Q:$T(@BDMI)="" K BDMX S BDMY="BDM(" D @BDMI K BDM
D ^BDMDM1A
D ^BDMDM2
D ^BDMDM3
D ^BDMDM4
X K BDMY Q
;
DMVISITS ; Gets all visits where dx was DM for indicated time period
K ^TMP("BDMDM FETCH",$J) ;IHS/CMI/LAB - ADDED
S BDMX=BDMPD_"^DX [SURVEILLANCE DIABETES"_BDMDATE,BDMY="^TMP(""BDMDM FETCH"",$J," S BDMER=$$START1^APCLDF(BDMX,BDMY)
I BDMER W !,"*** SCRIPT ERROR IN DMVISITS^BDMDM1. CONTACT SITE MANAGER" G X1
K ^TMP("BDMDM V",$J) S BDMC=0 F BDML=1:1 Q:'$D(^TMP("BDMDM FETCH",$J,BDML)) D
.S V=$P(^TMP("BDMDM FETCH",$J,BDML),U,5) Q:$D(^TMP("BDMDM V",$J,V)) S ^TMP("BDMDM V",$J,V)="",C=$$CLINIC^APCLV(V,"C")
.I C'="06"&(C'="01")&(C'="28") Q
.I "TC"[$P(^AUPNVSIT(V,0),U,7) Q ;IHS/CMI/LAB - no tele,cr
.S BDMC=BDMC+1,^TMP("BDMDM DXVS",$J,BDMC)=$P(^TMP("BDMDM FETCH",$J,BDML),U,5)
S BDMTOT=BDMC K ^TMP("BDMDM V",$J),BDMC
I 'BDMTOT S BDMTOT=1
K BDMDX,BDM,^TMP("BDMDM FETCH",$J)
X1 Q
;
VISITS ; Get all visits for indicated time period
S BDMX=BDMPD_"^VISIT"_BDMDATE,BDMY="^TMP(""BDMDM FETCH"",$J," S BDMER=$$START1^APCLDF(BDMX,BDMY)
F BDML=1:1 Q:'$D(^TMP("BDMDM FETCH",$J,BDML)) S ^TMP("BDMDM VST",$J,$P(^TMP("BDMDM FETCH",$J,BDML),U,5))=""
K BDM
Q
;
1 ;
TOBACCO ;
D TOBACCO^BDMDM6
Q
2 ;
FIRSTDX ;
K BDM
S BDMX=BDMPD_"^FIRST DX [SURVEILLANCE DIABETES" S BDMER=$$START1^APCLDF(BDMX,BDMY) S Y=$P($G(BDM(1)),U) I Y]"" D DD^%DT
S ^TMP("BDM",$J,2)=Y
X2 ;
S:BDMER ^TMP("BDM",$J,2)="*** SCRIPT ERROR IN FIRSTDX^BDMDM1. CONTACT SITE MANAGER"
K BDM
Q
4 ;DATE OF ONSET
D CMSFDX I $D(^TMP("BDM",$J,37)) G 41
D PLFDX I $D(^TMP("BDM",$J,37)) G 41
S ^TMP("BDM",$J,37)="Date of Onset not recorded"
41 ;
I ^TMP("BDM",$J,37)="Date of Onset not recorded" D G X4
. S BDMGOT1=1,BDMSUB=47 D CUML
. F BDMSUB=45,46 S BDMGOT1=0 D CUML
. Q
S X=^TMP("BDM",$J,37),%DT="" D ^%DT S X1=DT,X2=Y D ^%DTC S BDMGOT1=1,BDMSUB=$S(X'<3652.5:46,1:45) D CUML S BDMSUB=$S(BDMSUB=46:45,1:46),BDMGOT1=0 D CUML S BDMSUB=47,BDMGOT1=0 D CUML
X4 ;
K BDM,BDMSUB,BDMGOT1
Q
CMSFDX ;get first dm dx from case management
K BDMFDX
Q:'$G(BDMDMRG)
S BDMX=0 F S BDMX=$O(^ACM(44,"C",BDMPD,BDMX)) Q:BDMX'=+BDMX!($D(BDMFDX)) I $P(^ACM(44,BDMX,0),U,4)=BDMDMRG D
.S BDMFDX=$P($G(^ACM(44,BDMX,"SV")),U,2)
.Q:BDMFDX=""
.S BDM(1)=BDMFDX,Y=BDMFDX D DD^%DT S ^TMP("BDM",$J,37)=Y,^TMP("BDM",$J,40)="CMS"
.Q
Q
PLFDX ;get first dm dx from problem list
S BDMX=BDMPD_"^PROBLEM [DM AUDIT PROBLEM DIABETES DX" S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER PLFDXX I $D(BDM(1)) D
.S BDM(1)=$P(^AUPNPROB(+$P(BDM(1),U,4),0),U,13) I BDM(1)="" K BDM(1) Q
.S Y=BDM(1) D DD^%DT S ^TMP("BDM",$J,37)=Y,^TMP("BDM",$J,40)="PCC Problem List"
.Q
PLFDXX Q
3 ;
LASTHT S BDMX=BDMPD_"^LAST MEAS HT" S BDMER=$$START1^APCLDF(BDMX,BDMY) S (BDMHT,BDMHTKI)=$P($G(BDM(1)),U,2) I BDMHT]"" S BDMHT=(BDMHT\12)_" feet "_(BDMHT#12)_" inches"
S ^TMP("BDM",$J,3)=BDMHT
I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,3)]"":1,1:0),BDMSUB=9 D CUML
Q
;
BDMDM1 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
+2 ;
+3 ;
EN ; - ENTRY POINT - from ^BDMASK
+1 SET BDMER=0
+2 ;header and patient ident
DO EN^BDMDM5
+3 DO CLINICAL
+4 DO CLEAN^BDMDM5
XIT QUIT
+1 ;
+2 ;
CUML ; - ENTRY POINT - Set cumulative nodes
+1 IF '$DATA(^TMP("BDMCUML",$JOB,BDMSUB))
SET ^TMP("BDMCUML",$JOB,BDMSUB)=BDMGOT1_"/"_1
+2 IF '$TEST
SET ^(BDMSUB)=$SELECT(BDMGOT1:$PIECE(^TMP("BDMCUML",$JOB,BDMSUB),"/")+1,1:$PIECE(^TMP("BDMCUML",$JOB,BDMSUB),"/"))_"/"_($PIECE(^(BDMSUB),"/",2)+1)
+3 QUIT
+4 ;
CLINICAL ; Get clinical data
+1 DO DMVISITS
+2 IF BDMER
GOTO X
+3 DO VISITS
+4 FOR BDMI=1:1
IF $TEXT(@BDMI)=""
QUIT
KILL BDMX
SET BDMY="BDM("
DO @BDMI
KILL BDM
+5 DO ^BDMDM1A
+6 DO ^BDMDM2
+7 DO ^BDMDM3
+8 DO ^BDMDM4
X KILL BDMY
QUIT
+1 ;
DMVISITS ; Gets all visits where dx was DM for indicated time period
+1 ;IHS/CMI/LAB - ADDED
KILL ^TMP("BDMDM FETCH",$JOB)
+2 SET BDMX=BDMPD_"^DX [SURVEILLANCE DIABETES"_BDMDATE
SET BDMY="^TMP(""BDMDM FETCH"",$J,"
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
+3 IF BDMER
WRITE !,"*** SCRIPT ERROR IN DMVISITS^BDMDM1. CONTACT SITE MANAGER"
GOTO X1
+4 KILL ^TMP("BDMDM V",$JOB)
SET BDMC=0
FOR BDML=1:1
IF '$DATA(^TMP("BDMDM FETCH",$JOB,BDML))
QUIT
Begin DoDot:1
+5 SET V=$PIECE(^TMP("BDMDM FETCH",$JOB,BDML),U,5)
IF $DATA(^TMP("BDMDM V",$JOB,V))
QUIT
SET ^TMP("BDMDM V",$JOB,V)=""
SET C=$$CLINIC^APCLV(V,"C")
+6 IF C'="06"&(C'="01")&(C'="28")
QUIT
+7 ;IHS/CMI/LAB - no tele,cr
IF "TC"[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+8 SET BDMC=BDMC+1
SET ^TMP("BDMDM DXVS",$JOB,BDMC)=$PIECE(^TMP("BDMDM FETCH",$JOB,BDML),U,5)
End DoDot:1
+9 SET BDMTOT=BDMC
KILL ^TMP("BDMDM V",$JOB),BDMC
+10 IF 'BDMTOT
SET BDMTOT=1
+11 KILL BDMDX,BDM,^TMP("BDMDM FETCH",$JOB)
X1 QUIT
+1 ;
VISITS ; Get all visits for indicated time period
+1 SET BDMX=BDMPD_"^VISIT"_BDMDATE
SET BDMY="^TMP(""BDMDM FETCH"",$J,"
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
+2 FOR BDML=1:1
IF '$DATA(^TMP("BDMDM FETCH",$JOB,BDML))
QUIT
SET ^TMP("BDMDM VST",$JOB,$PIECE(^TMP("BDMDM FETCH",$JOB,BDML),U,5))=""
+3 KILL BDM
+4 QUIT
+5 ;
1 ;
TOBACCO ;
+1 DO TOBACCO^BDMDM6
+2 QUIT
2 ;
FIRSTDX ;
+1 KILL BDM
+2 SET BDMX=BDMPD_"^FIRST DX [SURVEILLANCE DIABETES"
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
SET Y=$PIECE($GET(BDM(1)),U)
IF Y]""
DO DD^%DT
+3 SET ^TMP("BDM",$JOB,2)=Y
X2 ;
+1 IF BDMER
SET ^TMP("BDM",$JOB,2)="*** SCRIPT ERROR IN FIRSTDX^BDMDM1. CONTACT SITE MANAGER"
+2 KILL BDM
+3 QUIT
4 ;DATE OF ONSET
+1 DO CMSFDX
IF $DATA(^TMP("BDM",$JOB,37))
GOTO 41
+2 DO PLFDX
IF $DATA(^TMP("BDM",$JOB,37))
GOTO 41
+3 SET ^TMP("BDM",$JOB,37)="Date of Onset not recorded"
41 ;
+1 IF ^TMP("BDM",$JOB,37)="Date of Onset not recorded"
Begin DoDot:1
+2 SET BDMGOT1=1
SET BDMSUB=47
DO CUML
+3 FOR BDMSUB=45,46
SET BDMGOT1=0
DO CUML
+4 QUIT
End DoDot:1
GOTO X4
+5 SET X=^TMP("BDM",$JOB,37)
SET %DT=""
DO ^%DT
SET X1=DT
SET X2=Y
DO ^%DTC
SET BDMGOT1=1
SET BDMSUB=$SELECT(X'<3652.5:46,1:45)
DO CUML
SET BDMSUB=$SELECT(BDMSUB=46:45,1:46)
SET BDMGOT1=0
DO CUML
SET BDMSUB=47
SET BDMGOT1=0
DO CUML
X4 ;
+1 KILL BDM,BDMSUB,BDMGOT1
+2 QUIT
CMSFDX ;get first dm dx from case management
+1 KILL BDMFDX
+2 IF '$GET(BDMDMRG)
QUIT
+3 SET BDMX=0
FOR
SET BDMX=$ORDER(^ACM(44,"C",BDMPD,BDMX))
IF BDMX'=+BDMX!($DATA(BDMFDX))
QUIT
IF $PIECE(^ACM(44,BDMX,0),U,4)=BDMDMRG
Begin DoDot:1
+4 SET BDMFDX=$PIECE($GET(^ACM(44,BDMX,"SV")),U,2)
+5 IF BDMFDX=""
QUIT
+6 SET BDM(1)=BDMFDX
SET Y=BDMFDX
DO DD^%DT
SET ^TMP("BDM",$JOB,37)=Y
SET ^TMP("BDM",$JOB,40)="CMS"
+7 QUIT
End DoDot:1
+8 QUIT
PLFDX ;get first dm dx from problem list
+1 SET BDMX=BDMPD_"^PROBLEM [DM AUDIT PROBLEM DIABETES DX"
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
IF BDMER
GOTO PLFDXX
IF $DATA(BDM(1))
Begin DoDot:1
+2 SET BDM(1)=$PIECE(^AUPNPROB(+$PIECE(BDM(1),U,4),0),U,13)
IF BDM(1)=""
KILL BDM(1)
QUIT
+3 SET Y=BDM(1)
DO DD^%DT
SET ^TMP("BDM",$JOB,37)=Y
SET ^TMP("BDM",$JOB,40)="PCC Problem List"
+4 QUIT
End DoDot:1
PLFDXX QUIT
3 ;
LASTHT SET BDMX=BDMPD_"^LAST MEAS HT"
SET BDMER=$$START1^APCLDF(BDMX,BDMY)
SET (BDMHT,BDMHTKI)=$PIECE($GET(BDM(1)),U,2)
IF BDMHT]""
SET BDMHT=(BDMHT\12)_" feet "_(BDMHT#12)_" inches"
+1 SET ^TMP("BDM",$JOB,3)=BDMHT
+2 IF BDMCUML
SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,3)]"":1,1:0)
SET BDMSUB=9
DO CUML
+3 QUIT
+4 ;
