APCLDM1 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
EN ; - ENTRY POINT - from ^APCLASK
S APCLER=0
D EN^APCLDM5 ;header and patient ident
D CLINICAL
D CLEAN^APCLDM5
XIT Q
;
;
CUML ; - ENTRY POINT - Set cumulative nodes
I '$D(^TMP("APCLCUML",$J,APCLSUB)) S ^TMP("APCLCUML",$J,APCLSUB)=APCLGOT1_"/"_1
E S ^(APCLSUB)=$S(APCLGOT1:$P(^TMP("APCLCUML",$J,APCLSUB),"/")+1,1:$P(^TMP("APCLCUML",$J,APCLSUB),"/"))_"/"_($P(^(APCLSUB),"/",2)+1)
Q
;
CLINICAL ; Get clinical data
D DMVISITS
G:APCLER X
D VISITS
F APCLI=1:1 Q:$T(@APCLI)="" K APCLX S APCLY="APCL(" D @APCLI K APCL
D ^APCLDM1A
D ^APCLDM2
D ^APCLDM3
D ^APCLDM4
X K APCLY Q
;
DMVISITS ; Gets all visits where dx was DM for indicated time period
K ^TMP("APCLDM FETCH",$J) ;IHS/CMI/LAB - ADDED
S APCLX=APCLPD_"^DX [SURVEILLANCE DIABETES"_APCLDATE,APCLY="^TMP(""APCLDM FETCH"",$J," S APCLER=$$START1^APCLDF(APCLX,APCLY)
I APCLER W !,"*** SCRIPT ERROR IN DMVISITS^APCLDM1. CONTACT SITE MANAGER" G X1
K ^TMP("APCLDM V",$J) S APCLC=0 F APCLL=1:1 Q:'$D(^TMP("APCLDM FETCH",$J,APCLL)) D
.S V=$P(^TMP("APCLDM FETCH",$J,APCLL),U,5) Q:$D(^TMP("APCLDM V",$J,V)) S ^TMP("APCLDM 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 APCLC=APCLC+1,^TMP("APCLDM DXVS",$J,APCLC)=$P(^TMP("APCLDM FETCH",$J,APCLL),U,5)
S APCLTOT=APCLC K ^TMP("APCLDM V",$J),APCLC
I 'APCLTOT S APCLTOT=1
K APCLDX,APCL,^TMP("APCLDM FETCH",$J)
X1 Q
;
VISITS ; Get all visits for indicated time period
S APCLX=APCLPD_"^VISIT"_APCLDATE,APCLY="^TMP(""APCLDM FETCH"",$J," S APCLER=$$START1^APCLDF(APCLX,APCLY)
F APCLL=1:1 Q:'$D(^TMP("APCLDM FETCH",$J,APCLL)) S ^TMP("APCLDM VST",$J,$P(^TMP("APCLDM FETCH",$J,APCLL),U,5))=""
K APCL
Q
;
1 ;
TOBACCO ;
D TOBACCO^APCLDM6
Q
2 ;
FIRSTDX ;
K APCL
S APCLX=APCLPD_"^FIRST DX [SURVEILLANCE DIABETES" S APCLER=$$START1^APCLDF(APCLX,APCLY) S Y=$P($G(APCL(1)),U) I Y]"" D DD^%DT
S ^TMP("APCL",$J,2)=Y
X2 ;
S:APCLER ^TMP("APCL",$J,2)="*** SCRIPT ERROR IN FIRSTDX^APCLDM1. CONTACT SITE MANAGER"
K APCL
Q
4 ;DATE OF ONSET
D CMSFDX I $D(^TMP("APCL",$J,37)) G 41
D PLFDX I $D(^TMP("APCL",$J,37)) G 41
S ^TMP("APCL",$J,37)="Date of Onset not recorded"
41 ;
I ^TMP("APCL",$J,37)="Date of Onset not recorded" D G X4
. S APCLGOT1=1,APCLSUB=47 D CUML
. F APCLSUB=45,46 S APCLGOT1=0 D CUML
. Q
S X=^TMP("APCL",$J,37),%DT="" D ^%DT S X1=DT,X2=Y D ^%DTC S APCLGOT1=1,APCLSUB=$S(X'<3652.5:46,1:45) D CUML S APCLSUB=$S(APCLSUB=46:45,1:46),APCLGOT1=0 D CUML S APCLSUB=47,APCLGOT1=0 D CUML
X4 ;
K APCL,APCLSUB,APCLGOT1
Q
CMSFDX ;get first dm dx from case management
K APCLFDX
Q:'$G(APCLDMRG)
S APCLX=0 F S APCLX=$O(^ACM(44,"C",APCLPD,APCLX)) Q:APCLX'=+APCLX!($D(APCLFDX)) I $P(^ACM(44,APCLX,0),U,4)=APCLDMRG D
.S APCLFDX=$P($G(^ACM(44,APCLX,"SV")),U,2)
.Q:APCLFDX=""
.S APCL(1)=APCLFDX,Y=APCLFDX D DD^%DT S ^TMP("APCL",$J,37)=Y,^TMP("APCL",$J,40)="CMS"
.Q
Q
PLFDX ;get first dm dx from problem list
S APCLX=APCLPD_"^PROBLEM [DM AUDIT PROBLEM DIABETES DX" S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER PLFDXX I $D(APCL(1)) D
.S APCL(1)=$P(^AUPNPROB(+$P(APCL(1),U,4),0),U,13) I APCL(1)="" K APCL(1) Q
.S Y=APCL(1) D DD^%DT S ^TMP("APCL",$J,37)=Y,^TMP("APCL",$J,40)="PCC Problem List"
.Q
PLFDXX Q
3 ;
LASTHT S APCLX=APCLPD_"^LAST MEAS HT" S APCLER=$$START1^APCLDF(APCLX,APCLY) S (APCLHT,APCLHTKI)=$P($G(APCL(1)),U,2) I APCLHT]"" S APCLHT=(APCLHT\12)_" feet "_(APCLHT#12)_" inches"
S ^TMP("APCL",$J,3)=APCLHT
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,3)]"":1,1:0),APCLSUB=9 D CUML
Q
;
APCLDM1 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
EN ; - ENTRY POINT - from ^APCLASK
+1 SET APCLER=0
+2 ;header and patient ident
DO EN^APCLDM5
+3 DO CLINICAL
+4 DO CLEAN^APCLDM5
XIT QUIT
+1 ;
+2 ;
CUML ; - ENTRY POINT - Set cumulative nodes
+1 IF '$DATA(^TMP("APCLCUML",$JOB,APCLSUB))
SET ^TMP("APCLCUML",$JOB,APCLSUB)=APCLGOT1_"/"_1
+2 IF '$TEST
SET ^(APCLSUB)=$SELECT(APCLGOT1:$PIECE(^TMP("APCLCUML",$JOB,APCLSUB),"/")+1,1:$PIECE(^TMP("APCLCUML",$JOB,APCLSUB),"/"))_"/"_($PIECE(^(APCLSUB),"/",2)+1)
+3 QUIT
+4 ;
CLINICAL ; Get clinical data
+1 DO DMVISITS
+2 IF APCLER
GOTO X
+3 DO VISITS
+4 FOR APCLI=1:1
IF $TEXT(@APCLI)=""
QUIT
KILL APCLX
SET APCLY="APCL("
DO @APCLI
KILL APCL
+5 DO ^APCLDM1A
+6 DO ^APCLDM2
+7 DO ^APCLDM3
+8 DO ^APCLDM4
X KILL APCLY
QUIT
+1 ;
DMVISITS ; Gets all visits where dx was DM for indicated time period
+1 ;IHS/CMI/LAB - ADDED
KILL ^TMP("APCLDM FETCH",$JOB)
+2 SET APCLX=APCLPD_"^DX [SURVEILLANCE DIABETES"_APCLDATE
SET APCLY="^TMP(""APCLDM FETCH"",$J,"
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+3 IF APCLER
WRITE !,"*** SCRIPT ERROR IN DMVISITS^APCLDM1. CONTACT SITE MANAGER"
GOTO X1
+4 KILL ^TMP("APCLDM V",$JOB)
SET APCLC=0
FOR APCLL=1:1
IF '$DATA(^TMP("APCLDM FETCH",$JOB,APCLL))
QUIT
Begin DoDot:1
+5 SET V=$PIECE(^TMP("APCLDM FETCH",$JOB,APCLL),U,5)
IF $DATA(^TMP("APCLDM V",$JOB,V))
QUIT
SET ^TMP("APCLDM 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 APCLC=APCLC+1
SET ^TMP("APCLDM DXVS",$JOB,APCLC)=$PIECE(^TMP("APCLDM FETCH",$JOB,APCLL),U,5)
End DoDot:1
+9 SET APCLTOT=APCLC
KILL ^TMP("APCLDM V",$JOB),APCLC
+10 IF 'APCLTOT
SET APCLTOT=1
+11 KILL APCLDX,APCL,^TMP("APCLDM FETCH",$JOB)
X1 QUIT
+1 ;
VISITS ; Get all visits for indicated time period
+1 SET APCLX=APCLPD_"^VISIT"_APCLDATE
SET APCLY="^TMP(""APCLDM FETCH"",$J,"
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+2 FOR APCLL=1:1
IF '$DATA(^TMP("APCLDM FETCH",$JOB,APCLL))
QUIT
SET ^TMP("APCLDM VST",$JOB,$PIECE(^TMP("APCLDM FETCH",$JOB,APCLL),U,5))=""
+3 KILL APCL
+4 QUIT
+5 ;
1 ;
TOBACCO ;
+1 DO TOBACCO^APCLDM6
+2 QUIT
2 ;
FIRSTDX ;
+1 KILL APCL
+2 SET APCLX=APCLPD_"^FIRST DX [SURVEILLANCE DIABETES"
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
SET Y=$PIECE($GET(APCL(1)),U)
IF Y]""
DO DD^%DT
+3 SET ^TMP("APCL",$JOB,2)=Y
X2 ;
+1 IF APCLER
SET ^TMP("APCL",$JOB,2)="*** SCRIPT ERROR IN FIRSTDX^APCLDM1. CONTACT SITE MANAGER"
+2 KILL APCL
+3 QUIT
4 ;DATE OF ONSET
+1 DO CMSFDX
IF $DATA(^TMP("APCL",$JOB,37))
GOTO 41
+2 DO PLFDX
IF $DATA(^TMP("APCL",$JOB,37))
GOTO 41
+3 SET ^TMP("APCL",$JOB,37)="Date of Onset not recorded"
41 ;
+1 IF ^TMP("APCL",$JOB,37)="Date of Onset not recorded"
Begin DoDot:1
+2 SET APCLGOT1=1
SET APCLSUB=47
DO CUML
+3 FOR APCLSUB=45,46
SET APCLGOT1=0
DO CUML
+4 QUIT
End DoDot:1
GOTO X4
+5 SET X=^TMP("APCL",$JOB,37)
SET %DT=""
DO ^%DT
SET X1=DT
SET X2=Y
DO ^%DTC
SET APCLGOT1=1
SET APCLSUB=$SELECT(X'<3652.5:46,1:45)
DO CUML
SET APCLSUB=$SELECT(APCLSUB=46:45,1:46)
SET APCLGOT1=0
DO CUML
SET APCLSUB=47
SET APCLGOT1=0
DO CUML
X4 ;
+1 KILL APCL,APCLSUB,APCLGOT1
+2 QUIT
CMSFDX ;get first dm dx from case management
+1 KILL APCLFDX
+2 IF '$GET(APCLDMRG)
QUIT
+3 SET APCLX=0
FOR
SET APCLX=$ORDER(^ACM(44,"C",APCLPD,APCLX))
IF APCLX'=+APCLX!($DATA(APCLFDX))
QUIT
IF $PIECE(^ACM(44,APCLX,0),U,4)=APCLDMRG
Begin DoDot:1
+4 SET APCLFDX=$PIECE($GET(^ACM(44,APCLX,"SV")),U,2)
+5 IF APCLFDX=""
QUIT
+6 SET APCL(1)=APCLFDX
SET Y=APCLFDX
DO DD^%DT
SET ^TMP("APCL",$JOB,37)=Y
SET ^TMP("APCL",$JOB,40)="CMS"
+7 QUIT
End DoDot:1
+8 QUIT
PLFDX ;get first dm dx from problem list
+1 SET APCLX=APCLPD_"^PROBLEM [DM AUDIT PROBLEM DIABETES DX"
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
IF APCLER
GOTO PLFDXX
IF $DATA(APCL(1))
Begin DoDot:1
+2 SET APCL(1)=$PIECE(^AUPNPROB(+$PIECE(APCL(1),U,4),0),U,13)
IF APCL(1)=""
KILL APCL(1)
QUIT
+3 SET Y=APCL(1)
DO DD^%DT
SET ^TMP("APCL",$JOB,37)=Y
SET ^TMP("APCL",$JOB,40)="PCC Problem List"
+4 QUIT
End DoDot:1
PLFDXX QUIT
3 ;
LASTHT SET APCLX=APCLPD_"^LAST MEAS HT"
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
SET (APCLHT,APCLHTKI)=$PIECE($GET(APCL(1)),U,2)
IF APCLHT]""
SET APCLHT=(APCLHT\12)_" feet "_(APCLHT#12)_" inches"
+1 SET ^TMP("APCL",$JOB,3)=APCLHT
+2 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,3)]"":1,1:0)
SET APCLSUB=9
DO CUML
+3 QUIT
+4 ;
