APCLDM3 ; IHS/CMI/LAB -CONTINUATION OF DM AUDIT RETRIEVAL ROUTINE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;IHS/CMI/LAB - patch 4 new imm package
;
EN ; - EP - from ^APCLDM1
;
F APCLI=1:1 Q:$T(@APCLI)="" K APCLX S APCLY="APCL(" D @APCLI K APCL
Q
1 ;
EDUC S APCLX=APCLPD_"^EDUC [DM AUDIT DIABETES EDUC TOPICS"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY)
I APCLER G X5
NEW %
I '$D(APCL(1)) F %=15.1,15.2,15.3 S ^TMP("APCL",$J,%)="NO"
I '$D(APCL(1)) G X5
S %=0 F S %=$O(APCL(%)) Q:'% S APCLDIET($P(APCL(%),U,3),%)=""
S %="" F S %=$O(APCLDIET(%)) Q:%=""!($D(^TMP("APCL",$J,15.3))) I %'="DM-DIET"&(%'="DM-NUTRITION")&(%'="DM-EXCERCISE") S ^TMP("APCL",$J,15.3)="YES"
I '$D(^TMP("APCL",$J,15.3)) S ^TMP("APCL",$J,15.3)="NO"
I $D(APCLDIET("DM-DIET"))!($D(APCLDIET("DM-NUTRITION"))) D I 1
. S APCLPCL=$O(^DIC(7,"D",29,""))
. S APCLL=0 F S APCLL=$O(^TMP("APCLDM VST",$J,APCLL)) Q:'APCLL!($G(^TMP("APCL",$J,15.1))="RD and OTHER") S APCLPRD=0 F S APCLPRD=$O(^AUPNVPRV("AD",APCLL,APCLPRD)) Q:'APCLPRD!($G(^TMP("APCL",$J,15.1))="RD and OTHER") D
.. S APCLPRV=$P(^AUPNVPRV(APCLPRD,0),U)
.. I APCLPCL]"",$S($P(^DD(9000010.06,.01,0),U,2)[200:$$PROVCLS^XBFUNC1(APCLPRV,"I"),1:$P(^DIC(6,APCLPRV,0),U,4))=APCLPCL S ^TMP("APCL",$J,15.1)=$S($G(^TMP("APCL",$J,15.1))="OTHER":"RD and OTHER",1:"RD")
.. E S ^TMP("APCL",$J,15.1)="OTHER"
E S ^TMP("APCL",$J,15.1)="NO"
I $D(APCLDIET("DM-EXERCISE")) S ^TMP("APCL",$J,15.2)="YES"
E S ^TMP("APCL",$J,15.2)="NO"
X5 I APCLER S ^TMP("APCL",$J,15.1)="*** SCRIPT ERROR IN EDUC^APCLDM3. CONTACT SITE MANAGER" Q
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,15.1)="NO":0,1:1),APCLSUB=25 D CUML^APCLDM1
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,15.2)="NO":0,1:1),APCLSUB=26 D CUML^APCLDM1
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,15.3)="NO":0,1:1),APCLSUB=27 D CUML^APCLDM1
K APCLDIET,APCL
Q
2 ;
THERAPY ;
S X=APCLEDT,%DT="" D ^%DT S X1=$S(Y>DT:DT,1:Y),X2=-122 D C^%DTC S Y=X D DD^%DT S APCLHTNE=Y
S APCLX=APCLPD_"^MEDS [DM AUDIT INSULIN DRUGS"_";DURING "_APCLHTNE_"-"_APCLEDT S APCLER=$$START1^APCLDF(APCLX,APCLY)
I APCLER G X10
S ^TMP("APCL",$J,30)=$S($D(APCL(1)):"Insulin",1:"") K APCL
S APCLX=APCLPD_"^MEDS [DM AUDIT ORAL HYPOGLYCEMICS"_";DURING "_APCLHTNE_"-"_APCLEDT S APCLER=$$START1^APCLDF(APCLX,APCLY)
I APCLER G X10
S ^(30)=$S($D(APCL(1))&(^TMP("APCL",$J,30)]""):"Oral Agent & Insulin",'$D(APCL(1))&(^(30)]""):^(30),$D(APCL(1))&(^(30)=""):"Oral Agent",1:"Diet Alone")
I APCLCUML S APCLTX=^TMP("APCL",$J,30) D
. I APCLTX="Oral Agent & Insulin" S APCLGOT1=1,APCLSUB=6 D CUML^APCLDM1 S APCLGOT1=0 F APCLSUB=3,4,5 D CUML^APCLDM1
. I APCLTX="Oral Agent" S APCLGOT1=1,APCLSUB=5 D CUML^APCLDM1 S APCLGOT1=0 F APCLSUB=3,4,6 D CUML^APCLDM1
. I APCLTX="Insulin" S APCLGOT1=1,APCLSUB=4 D CUML^APCLDM1 S APCLGOT1=0 F APCLSUB=3,5,6 D CUML^APCLDM1
. I APCLTX="Diet Alone" S APCLGOT1=1,APCLSUB=3 D CUML^APCLDM1 S APCLGOT1=0 F APCLSUB=4:1:6 D CUML^APCLDM1
. K APCLTX
X10 I APCLER S ^TMP("APCL",$J,30)="*** SCRIPT ERROR IN THERAPY^APCLDM3. CONTACT SITE MANAGER"
Q
;IHS/CMI/LAB - new sub routine for new imm package
BI() ; check to see if running new imm package
Q $S($O(^AUTTIMM(0))>100:1,1:0)
;end new subroutine IHS/CMI/LAB
3 ;
FLU S APCLX=APCLPD_"^LAST IMM "_$S($$BI:88,1:12)_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) ;IHS/CMI/LAB - changed line for new imm package
I $D(APCL(1)) S Y=+APCL(1) D DD^%DT
S ^TMP("APCL",$J,29)=$S($D(APCL(1)):"YES - "_Y,1:"NO")
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,29)="NO":0,1:1),APCLSUB=28 D CUML^APCLDM1
Q
4 ;
PNEUMOVX S APCLX=APCLPD_"^LAST IMM "_$S($$BI:33,1:19) S APCLER=$$START1^APCLDF(APCLX,APCLY) ;IHS/CMI/LAB - changed line for new imm package
S ^TMP("APCL",$J,18)=$S($D(APCL(1)):"YES",1:"NO")
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,18)="NO":0,1:1),APCLSUB=29 D CUML^APCLDM1
Q
5 ;
TD S X=APCLTDTE D ^%DT S X1=Y,X2=-3652 D C^%DTC S Y=X D DD^%DT S APCLTD=";DURING "_Y_"-"_APCLTDTE
S APCLX=APCLPD_"^LAST IMM "_$S($$BI:9,1:"02")_APCLTD S APCLER=$$START1^APCLDF(APCLX,APCLY) ;IHS/CMI/LAB -changed line for new imm package
S ^TMP("APCL",$J,19)=$S($D(APCL(1)):"YES",1:"NO")
I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,19)="NO":0,1:1),APCLSUB=30 D CUML^APCLDM1
Q
6 ;
EKG ;
Q
7 ;ACE INHIBITOR
S APCLX=APCLPD_"^MEDS [DM AUDIT ACE INHIBITORS"_";DURING "_APCLHTNE_"-"_APCLEDT S APCLER=$$START1^APCLDF(APCLX,APCLY)
I APCLER G X7
S APCLGOT=0 D C7
S ^TMP("APCL",$J,41)=$S('APCLGOT:"Does not currently use/undetermined",1:"Currently uses (is prescribed)")
I APCLCUML D
.I APCLGOT S APCLGOT1=1,APCLSUB=80 D CUML^APCLDM1 S APCLGOT1=0,APCLSUB=82 D CUML^APCLDM1
.I 'APCLGOT S APCLGOT1=0,APCLSUB=80 D CUML^APCLDM1 S APCLGOT1=1,APCLSUB=82 D CUML^APCLDM1
.Q
X7 ;XIT ACE 7
I APCLER S ^TMP("APCL",$J,41)="ACE INHIBITOR TAXONOMY MISSING"
Q
C7 ;check for currently prescribed
S APCLX=0 F S APCLX=$O(APCL(APCLX)) Q:APCLX'=+APCLX!(APCLGOT) D
.S APCLVMED=+$P(APCL(APCLX),U,4),APCLDAYS=$P(^AUPNVMED(APCLVMED,0),U,7),APCLDP=$P(APCL(APCLX),U)
.Q:'APCLDAYS
.S B=$$FMADD^XLFDT(APCLDP,APCLDAYS)
.I B'<APCLUED S APCLGOT=1
.Q
Q
APCLDM3 ; IHS/CMI/LAB -CONTINUATION OF DM AUDIT RETRIEVAL ROUTINE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;IHS/CMI/LAB - patch 4 new imm package
+3 ;
EN ; - EP - from ^APCLDM1
+1 ;
+2 FOR APCLI=1:1
IF $TEXT(@APCLI)=""
QUIT
KILL APCLX
SET APCLY="APCL("
DO @APCLI
KILL APCL
+3 QUIT
1 ;
EDUC SET APCLX=APCLPD_"^EDUC [DM AUDIT DIABETES EDUC TOPICS"_APCLDATE
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+1 IF APCLER
GOTO X5
+2 NEW %
+3 IF '$DATA(APCL(1))
FOR %=15.1,15.2,15.3
SET ^TMP("APCL",$JOB,%)="NO"
+4 IF '$DATA(APCL(1))
GOTO X5
+5 SET %=0
FOR
SET %=$ORDER(APCL(%))
IF '%
QUIT
SET APCLDIET($PIECE(APCL(%),U,3),%)=""
+6 SET %=""
FOR
SET %=$ORDER(APCLDIET(%))
IF %=""!($DATA(^TMP("APCL",$JOB,15.3)))
QUIT
IF %'="DM-DIET"&(%'="DM-NUTRITION")&(%'="DM-EXCERCISE")
SET ^TMP("APCL",$JOB,15.3)="YES"
+7 IF '$DATA(^TMP("APCL",$JOB,15.3))
SET ^TMP("APCL",$JOB,15.3)="NO"
+8 IF $DATA(APCLDIET("DM-DIET"))!($DATA(APCLDIET("DM-NUTRITION")))
Begin DoDot:1
+9 SET APCLPCL=$ORDER(^DIC(7,"D",29,""))
+10 SET APCLL=0
FOR
SET APCLL=$ORDER(^TMP("APCLDM VST",$JOB,APCLL))
IF 'APCLL!($GET(^TMP("APCL",$JOB,15.1))="RD and OTHER")
QUIT
SET APCLPRD=0
FOR
SET APCLPRD=$ORDER(^AUPNVPRV("AD",APCLL,APCLPRD))
IF 'APCLPRD!($GET(^TMP("APCL",$JOB,15.1))="RD and OTHER")
QUIT
Begin DoDot:2
+11 SET APCLPRV=$PIECE(^AUPNVPRV(APCLPRD,0),U)
+12 IF APCLPCL]""
IF $SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$$PROVCLS^XBFUNC1(APCLPRV,"I"),1:$PIECE(^DIC(6,APCLPRV,0),U,4))=APCLPCL
SET ^TMP("APCL",$JOB,15.1)=$SELECT($GET(^TMP("APCL",$JOB,15.1))="OTHER":"RD and OTHER",1:"RD")
+13 IF '$TEST
SET ^TMP("APCL",$JOB,15.1)="OTHER"
End DoDot:2
End DoDot:1
IF 1
+14 IF '$TEST
SET ^TMP("APCL",$JOB,15.1)="NO"
+15 IF $DATA(APCLDIET("DM-EXERCISE"))
SET ^TMP("APCL",$JOB,15.2)="YES"
+16 IF '$TEST
SET ^TMP("APCL",$JOB,15.2)="NO"
X5 IF APCLER
SET ^TMP("APCL",$JOB,15.1)="*** SCRIPT ERROR IN EDUC^APCLDM3. CONTACT SITE MANAGER"
QUIT
+1 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,15.1)="NO":0,1:1)
SET APCLSUB=25
DO CUML^APCLDM1
+2 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,15.2)="NO":0,1:1)
SET APCLSUB=26
DO CUML^APCLDM1
+3 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,15.3)="NO":0,1:1)
SET APCLSUB=27
DO CUML^APCLDM1
+4 KILL APCLDIET,APCL
+5 QUIT
2 ;
THERAPY ;
+1 SET X=APCLEDT
SET %DT=""
DO ^%DT
SET X1=$SELECT(Y>DT:DT,1:Y)
SET X2=-122
DO C^%DTC
SET Y=X
DO DD^%DT
SET APCLHTNE=Y
+2 SET APCLX=APCLPD_"^MEDS [DM AUDIT INSULIN DRUGS"_";DURING "_APCLHTNE_"-"_APCLEDT
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+3 IF APCLER
GOTO X10
+4 SET ^TMP("APCL",$JOB,30)=$SELECT($DATA(APCL(1)):"Insulin",1:"")
KILL APCL
+5 SET APCLX=APCLPD_"^MEDS [DM AUDIT ORAL HYPOGLYCEMICS"_";DURING "_APCLHTNE_"-"_APCLEDT
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+6 IF APCLER
GOTO X10
+7 SET ^(30)=$SELECT($DATA(APCL(1))&(^TMP("APCL",$JOB,30)]""):"Oral Agent & Insulin",'$DATA(APCL(1))&(^(30)]""):^(30),$DATA(APCL(1))&(^(30)=""):"Oral Agent",1:"Diet Alone")
+8 IF APCLCUML
SET APCLTX=^TMP("APCL",$JOB,30)
Begin DoDot:1
+9 IF APCLTX="Oral Agent & Insulin"
SET APCLGOT1=1
SET APCLSUB=6
DO CUML^APCLDM1
SET APCLGOT1=0
FOR APCLSUB=3,4,5
DO CUML^APCLDM1
+10 IF APCLTX="Oral Agent"
SET APCLGOT1=1
SET APCLSUB=5
DO CUML^APCLDM1
SET APCLGOT1=0
FOR APCLSUB=3,4,6
DO CUML^APCLDM1
+11 IF APCLTX="Insulin"
SET APCLGOT1=1
SET APCLSUB=4
DO CUML^APCLDM1
SET APCLGOT1=0
FOR APCLSUB=3,5,6
DO CUML^APCLDM1
+12 IF APCLTX="Diet Alone"
SET APCLGOT1=1
SET APCLSUB=3
DO CUML^APCLDM1
SET APCLGOT1=0
FOR APCLSUB=4:1:6
DO CUML^APCLDM1
+13 KILL APCLTX
End DoDot:1
X10 IF APCLER
SET ^TMP("APCL",$JOB,30)="*** SCRIPT ERROR IN THERAPY^APCLDM3. CONTACT SITE MANAGER"
+1 QUIT
+2 ;IHS/CMI/LAB - new sub routine for new imm package
BI() ; check to see if running new imm package
+1 QUIT $SELECT($ORDER(^AUTTIMM(0))>100:1,1:0)
+2 ;end new subroutine IHS/CMI/LAB
3 ;
FLU ;IHS/CMI/LAB - changed line for new imm package
SET APCLX=APCLPD_"^LAST IMM "_$SELECT($$BI:88,1:12)_APCLDATE
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+1 IF $DATA(APCL(1))
SET Y=+APCL(1)
DO DD^%DT
+2 SET ^TMP("APCL",$JOB,29)=$SELECT($DATA(APCL(1)):"YES - "_Y,1:"NO")
+3 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,29)="NO":0,1:1)
SET APCLSUB=28
DO CUML^APCLDM1
+4 QUIT
4 ;
PNEUMOVX ;IHS/CMI/LAB - changed line for new imm package
SET APCLX=APCLPD_"^LAST IMM "_$SELECT($$BI:33,1:19)
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+1 SET ^TMP("APCL",$JOB,18)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
+2 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,18)="NO":0,1:1)
SET APCLSUB=29
DO CUML^APCLDM1
+3 QUIT
5 ;
TD SET X=APCLTDTE
DO ^%DT
SET X1=Y
SET X2=-3652
DO C^%DTC
SET Y=X
DO DD^%DT
SET APCLTD=";DURING "_Y_"-"_APCLTDTE
+1 ;IHS/CMI/LAB -changed line for new imm package
SET APCLX=APCLPD_"^LAST IMM "_$SELECT($$BI:9,1:"02")_APCLTD
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+2 SET ^TMP("APCL",$JOB,19)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
+3 IF APCLCUML
SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,19)="NO":0,1:1)
SET APCLSUB=30
DO CUML^APCLDM1
+4 QUIT
6 ;
EKG ;
+1 QUIT
7 ;ACE INHIBITOR
+1 SET APCLX=APCLPD_"^MEDS [DM AUDIT ACE INHIBITORS"_";DURING "_APCLHTNE_"-"_APCLEDT
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+2 IF APCLER
GOTO X7
+3 SET APCLGOT=0
DO C7
+4 SET ^TMP("APCL",$JOB,41)=$SELECT('APCLGOT:"Does not currently use/undetermined",1:"Currently uses (is prescribed)")
+5 IF APCLCUML
Begin DoDot:1
+6 IF APCLGOT
SET APCLGOT1=1
SET APCLSUB=80
DO CUML^APCLDM1
SET APCLGOT1=0
SET APCLSUB=82
DO CUML^APCLDM1
+7 IF 'APCLGOT
SET APCLGOT1=0
SET APCLSUB=80
DO CUML^APCLDM1
SET APCLGOT1=1
SET APCLSUB=82
DO CUML^APCLDM1
+8 QUIT
End DoDot:1
X7 ;XIT ACE 7
+1 IF APCLER
SET ^TMP("APCL",$JOB,41)="ACE INHIBITOR TAXONOMY MISSING"
+2 QUIT
C7 ;check for currently prescribed
+1 SET APCLX=0
FOR
SET APCLX=$ORDER(APCL(APCLX))
IF APCLX'=+APCLX!(APCLGOT)
QUIT
Begin DoDot:1
+2 SET APCLVMED=+$PIECE(APCL(APCLX),U,4)
SET APCLDAYS=$PIECE(^AUPNVMED(APCLVMED,0),U,7)
SET APCLDP=$PIECE(APCL(APCLX),U)
+3 IF 'APCLDAYS
QUIT
+4 SET B=$$FMADD^XLFDT(APCLDP,APCLDAYS)
+5 IF B'<APCLUED
SET APCLGOT=1
+6 QUIT
End DoDot:1
+7 QUIT
