- 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
