- APCLDM4 ; IHS/CMI/LAB -CONTINUATION OF DM AUDIT RETRIEVAL ROUTINE ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;IHS/CMI/LAB - fixed EKG
- ;
- ;
- EN ; - EP - from ^APCLDM1
- ;
- F APCLII=1:1 Q:$T(@APCLII)="" K APCLX S APCLY="APCL(" D @APCLII K APCL
- K APCLII
- Q
- 1 ;
- URINE ;urinalysis done?
- S APCLX=APCLPD_"^LAST LAB [DM AUDIT URINALYSIS TAX"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY)
- I '$D(APCL(1)) S ^TMP("APCL",$J,23)="NO",^TMP("APCL",$J,24.1)="-" G UPRO
- S ^TMP("APCL",$J,23)="YES"
- UPRO ;
- S APCLX=APCLPD_"^LAST LAB [DM AUDIT URINE PROTEIN TAX"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY)
- I '$D(APCL(1)) S ^TMP("APCL",$J,24.1)="-" G X7
- S %A=$P(APCL(1),U,2) S ^TMP("APCL",$J,24.1)=$S(%A]"":$P(APCL(1),U,2),1:"-")
- I APCLCUML F %=24.1 I ^TMP("APCL",$J,%)["+" S APCLPOS=1 Q
- I APCLCUML S APCLGOT1=$S($G(APCLPOS):1,1:0),APCLSUB=35 D CUML^APCLDM1
- S ^TMP("APCL",$J,31)=$S($G(APCLPOS):"YES",1:"NO")
- X7 I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,23)="YES":1,1:0),APCLSUB=34 D CUML^APCLDM1
- K APCLPOS
- Q
- 2 ;
- CRTININE S APCLX=APCLPD_"^LAST DX V42.0" S APCLER=$$START1^APCLDF(APCLX,APCLY) I $D(APCL(1)) S APCLD1=+APCL(1) K APCL
- S APCLX=APCLPD_"^LAST DX V56.0" S APCLER=$$START1^APCLDF(APCLX,APCLY) I $D(APCL(1)) D I $D(^TMP("APCL",$J,25)) G CUM
- . I $D(APCLD1) S:APCLD1<+APCL(1) ^TMP("APCL",$J,25)="ON DIALYSIS"
- . I '$D(APCLD1) S ^TMP("APCL",$J,25)="ON DIALYSIS"
- K APCL
- S APCLX=APCLPD_"^LAST LAB [DM AUDIT CREATININE TAX"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) D
- . S ^TMP("APCL",$J,25)=$S($D(APCL(1)):"YES - "_$P(APCL(1),U,2),1:"NO") ;***
- CUM I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,25)["YES":1,1:0),APCLSUB=36 D CUML^APCLDM1
- I APCLCUML,APCLGOT1 S APCLGOT1=$S(+($P(^TMP("APCL",$J,25)," ",3))>2:1,1:0),APCLSUB=37 D CUML^APCLDM1
- X9 K APCLD1 Q ;***
- 3 ;
- CHOLES S APCLX=APCLPD_"^LAST LAB [DM AUDIT CHOLESTEROL TAX"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY)
- S ^TMP("APCL",$J,26)=$S($D(APCL(1)):"YES - "_$P(APCL(1),U,2),1:"NO") ;***
- I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,26)["YES":1,1:0),APCLSUB=38 D CUML^APCLDM1
- I APCLCUML,APCLGOT1 S APCLGOT1=$S(+($P(^TMP("APCL",$J,26)," ",3))>240:1,1:0),APCLSUB=39 D CUML^APCLDM1
- Q
- 4 ;
- TRIGLYC S APCLX=APCLPD_"^LAST LAB [DM AUDIT TRIGLYCERIDE TAX"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY)
- S ^TMP("APCL",$J,27)=$S($D(APCL(1)):"YES - "_$P(APCL(1),U,2),1:"NO") ;***
- I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,27)["YES":1,1:0),APCLSUB=40 D CUML^APCLDM1
- Q
- ;
- 5 ;
- D PPD^APCLDM8
- Q
- 6 ;ECG SUMMARY
- S APCLX=APCLPD_"^LAST DIAGNOSTIC ECG SUMMARY" S APCLER=$$START1^APCLDF(APCLX,APCLY) S ^TMP("APCL",$J,39)=$S($D(APCL(1)):"YES",1:"NO") ;IHS/CMI/LAB
- S APCLSUB=55,APCLGOT1=$S($D(APCL(1)):1,1:0) D CUML^APCLDM1
- ;S APCLSUB=55,APCLGOT1=1 D CUML^APCLDM1
- K APCLSUB,APCLX,APCLGOT1
- Q
- APCLDM4 ; IHS/CMI/LAB -CONTINUATION OF DM AUDIT RETRIEVAL ROUTINE ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;IHS/CMI/LAB - fixed EKG
- +3 ;
- +4 ;
- EN ; - EP - from ^APCLDM1
- +1 ;
- +2 FOR APCLII=1:1
- IF $TEXT(@APCLII)=""
- QUIT
- KILL APCLX
- SET APCLY="APCL("
- DO @APCLII
- KILL APCL
- +3 KILL APCLII
- +4 QUIT
- 1 ;
- URINE ;urinalysis done?
- +1 SET APCLX=APCLPD_"^LAST LAB [DM AUDIT URINALYSIS TAX"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- +2 IF '$DATA(APCL(1))
- SET ^TMP("APCL",$JOB,23)="NO"
- SET ^TMP("APCL",$JOB,24.1)="-"
- GOTO UPRO
- +3 SET ^TMP("APCL",$JOB,23)="YES"
- UPRO ;
- +1 SET APCLX=APCLPD_"^LAST LAB [DM AUDIT URINE PROTEIN TAX"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- +2 IF '$DATA(APCL(1))
- SET ^TMP("APCL",$JOB,24.1)="-"
- GOTO X7
- +3 SET %A=$PIECE(APCL(1),U,2)
- SET ^TMP("APCL",$JOB,24.1)=$SELECT(%A]"":$PIECE(APCL(1),U,2),1:"-")
- +4 IF APCLCUML
- FOR %=24.1
- IF ^TMP("APCL",$JOB,%)["+"
- SET APCLPOS=1
- QUIT
- +5 IF APCLCUML
- SET APCLGOT1=$SELECT($GET(APCLPOS):1,1:0)
- SET APCLSUB=35
- DO CUML^APCLDM1
- +6 SET ^TMP("APCL",$JOB,31)=$SELECT($GET(APCLPOS):"YES",1:"NO")
- X7 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,23)="YES":1,1:0)
- SET APCLSUB=34
- DO CUML^APCLDM1
- +1 KILL APCLPOS
- +2 QUIT
- 2 ;
- CRTININE SET APCLX=APCLPD_"^LAST DX V42.0"
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- IF $DATA(APCL(1))
- SET APCLD1=+APCL(1)
- KILL APCL
- +1 SET APCLX=APCLPD_"^LAST DX V56.0"
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- IF $DATA(APCL(1))
- Begin DoDot:1
- +2 IF $DATA(APCLD1)
- IF APCLD1<+APCL(1)
- SET ^TMP("APCL",$JOB,25)="ON DIALYSIS"
- +3 IF '$DATA(APCLD1)
- SET ^TMP("APCL",$JOB,25)="ON DIALYSIS"
- End DoDot:1
- IF $DATA(^TMP("APCL",$JOB,25))
- GOTO CUM
- +4 KILL APCL
- +5 SET APCLX=APCLPD_"^LAST LAB [DM AUDIT CREATININE TAX"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- Begin DoDot:1
- +6 ;***
- SET ^TMP("APCL",$JOB,25)=$SELECT($DATA(APCL(1)):"YES - "_$PIECE(APCL(1),U,2),1:"NO")
- End DoDot:1
- CUM IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,25)["YES":1,1:0)
- SET APCLSUB=36
- DO CUML^APCLDM1
- +1 IF APCLCUML
- IF APCLGOT1
- SET APCLGOT1=$SELECT(+($PIECE(^TMP("APCL",$JOB,25)," ",3))>2:1,1:0)
- SET APCLSUB=37
- DO CUML^APCLDM1
- X9 ;***
- KILL APCLD1
- QUIT
- 3 ;
- CHOLES SET APCLX=APCLPD_"^LAST LAB [DM AUDIT CHOLESTEROL TAX"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- +1 ;***
- SET ^TMP("APCL",$JOB,26)=$SELECT($DATA(APCL(1)):"YES - "_$PIECE(APCL(1),U,2),1:"NO")
- +2 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,26)["YES":1,1:0)
- SET APCLSUB=38
- DO CUML^APCLDM1
- +3 IF APCLCUML
- IF APCLGOT1
- SET APCLGOT1=$SELECT(+($PIECE(^TMP("APCL",$JOB,26)," ",3))>240:1,1:0)
- SET APCLSUB=39
- DO CUML^APCLDM1
- +4 QUIT
- 4 ;
- TRIGLYC SET APCLX=APCLPD_"^LAST LAB [DM AUDIT TRIGLYCERIDE TAX"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- +1 ;***
- SET ^TMP("APCL",$JOB,27)=$SELECT($DATA(APCL(1)):"YES - "_$PIECE(APCL(1),U,2),1:"NO")
- +2 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,27)["YES":1,1:0)
- SET APCLSUB=40
- DO CUML^APCLDM1
- +3 QUIT
- +4 ;
- 5 ;
- +1 DO PPD^APCLDM8
- +2 QUIT
- 6 ;ECG SUMMARY
- +1 ;IHS/CMI/LAB
- SET APCLX=APCLPD_"^LAST DIAGNOSTIC ECG SUMMARY"
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- SET ^TMP("APCL",$JOB,39)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
- +2 SET APCLSUB=55
- SET APCLGOT1=$SELECT($DATA(APCL(1)):1,1:0)
- DO CUML^APCLDM1
- +3 ;S APCLSUB=55,APCLGOT1=1 D CUML^APCLDM1
- +4 KILL APCLSUB,APCLX,APCLGOT1
- +5 QUIT
