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