- 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 ;