BDMP7 ; IHS/CMI/LAB - BDM patch 7 ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
;
PRE ;EP - pre init
D RENAME^XPDMENU("BDM M DM AUDIT","BDM M MAIN DM MENU")
Q
EN ;
S ATXFLG=1
D ^BDMP71X
D ^BDMP72
D ^BDMP73
D ^BDMP74
D ^BDMP75
D ^BDMP76
S ATXFLG=1
D CESS
D DRUGS
D SDM
D DMEDUC
D LAB
XIT ;
I '$D(BDMGUI) D EN^XBVK("BDM"),EN^XBVK("ATX")
Q
;
LAB ;
S BDMX="DM AUDIT CREATININE TAX" D LAB1
S BDMX="DM AUDIT CHOLESTEROL TAX" D LAB1
S BDMX="DM AUDIT GLUCOSE TESTS TAX" D LAB1
S BDMX="DM AUDIT URINE PROTEIN TAX" D LAB1
S BDMX="DM AUDIT HGB A1C TAX" D LAB1
S BDMX="DM AUDIT TRIGLYCERIDE TAX" D LAB1
S BDMX="DM AUDIT URINALYSIS TAX" D LAB1
S BDMX="DM AUDIT MICROALBUMINURIA TAX" D LAB1
S BDMX="DM AUDIT AST TAX" D LAB1
S BDMX="DM AUDIT ALT TAX" D LAB1
S BDMX="DM AUDIT LDL CHOLESTEROL TAX" D LAB1
Q
LAB1 ;
W !,"Creating ",BDMX," Taxonomy..."
S BDMDA=$O(^ATXLAB("B",BDMX,0))
Q:BDMDA ;taxonomy already exisits
S X=BDMX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
I Y=-1 W !!,"ERROR IN CREATING ",BDMX," TAX" Q
S BDMTX=+Y,$P(^ATXLAB(BDMTX,0),U,2)=BDMX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60,^ATXLAB(BDMTX,21,0)="^9002228.02101PA^0^0"
S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
Q
DRUGS ;set up drug taxonomies
S BDMX="DM AUDIT ACE INHIBITORS" D DRUG1
S BDMX="DM AUDIT INSULIN DRUGS" D DRUG1
S BDMX="DM AUDIT SELF MONITOR DRUGS" D DRUG1
S BDMX="DM AUDIT SULFONYLUREA DRUGS" D DRUG1
S BDMX="DM AUDIT METFORMIN DRUGS" D DRUG1
S BDMX="DM AUDIT ACARBOSE DRUGS" D DRUG1
S BDMX="DM AUDIT TROGLITAZONE DRUGS" D DRUG1
S BDMX="DM AUDIT ASPIRIN DRUGS" D DRUG1
Q
DRUG1 ;
W !,"Creating ",BDMX," Taxonomy..."
S BDMDA=$O(^ATXAX("B",BDMX,0))
Q:BDMDA ;taxonomy already exisits
S X=BDMX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
I Y=-1 W !!,"ERROR IN CREATING ",BDMX," TAX" Q
S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)=BDMX,$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=173,$P(^(0),U,13)=0,$P(^(0),U,15)=50,^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
Q
SDM ;
W !,"Creating DM SDM Provider Taxonomy..."
S BDMDA=$O(^ATXAX("B","DM AUDIT SDM PROVIDERS",0))
Q:BDMDA ;taxonomy already exisits
S X="DM AUDIT SDM PROVIDERS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
I Y=-1 W !!,"ERROR IN CREATING DM AUDIT SDM PROVIDERS TAX" Q
S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)="DM AUDIT SDM PROVIDERS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=209,$P(^(0),U,13)=0,$P(^(0),U,15)=16,^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
Q
CESS ;
W !,"Creating Tobacco Cessation Health factors taxonomy... "
S BDMDA=$O(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
Q:BDMDA ;taxonomy already exists
S X="DM AUDIT CESSATION HLTH FACTOR",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
I Y=-1 W !!,"ERROR IN CREATING DM AUDIT CESSATION HLTH FACTORS TAX" Q
S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)="DM AUDIT CESSATION HLTH FACTOR",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=78,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.64,^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
S BDMTEXT="CESSHF" F BDMX=1:1:2 S X=$P($T(@BDMTEXT+BDMX),";;",2),DIC="^AUTTHF(",DIC(0)="M" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0 I $P(Y,U)>0 D
.S ^ATXAX(BDMTX,21,BDMX,0)=+Y,$P(^ATXAX(BDMTX,21,0),U,3)=BDMX,$P(^(0),U,4)=BDMX,^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
.Q
S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
Q
;
DMEDUC ;
W !,"Creating Education topics taxonomy..."
S BDMDA=0 S BDMDA=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",BDMDA)) I 'BDMDA D
.S X="DM AUDIT DIET EDUC TOPICS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
.I Y=-1 W !!,"ERROR IN CREATING DM AUDIT DIET EDUC TOPICS TAX" Q
.S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)="DM AUDIT DIET EDUC TOPICS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=280,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.09,^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
.S BDMTEXT="DIET" F BDMX=1:1:6 S X=$P($T(@BDMTEXT+BDMX),";;",2),DIC="^AUTTEDT(",DIC(0)="M" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0 I $P(Y,U)>0 D
..S ^ATXAX(BDMTX,21,BDMX,0)=+Y,$P(^ATXAX(BDMTX,21,0),U,3)=BDMX,$P(^(0),U,4)=BDMX,^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
..Q
.S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
S BDMDA=0 S BDMDA=$O(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",BDMDA)) I 'BDMDA D
.S X="DM AUDIT EXERCISE EDUC TOPICS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
.I Y=-1 W !!,"ERROR IN CREATING DM AUDIT EXERCISE EDUC TOPICS TAX" Q
.S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)="DM AUDIT EXERCISE EDUC TOPICS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=280,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.09,^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
.S BDMTEXT="EXC" F BDMX=1:1:3 S X=$P($T(@BDMTEXT+BDMX),";;",2),DIC="^AUTTEDT(",DIC(0)="M" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0 I $P(Y,U)>0 D
..S ^ATXAX(BDMTX,21,BDMX,0)=+Y,$P(^ATXAX(BDMTX,21,0),U,3)=BDMX,$P(^(0),U,4)=BDMX,^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
..Q
.S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
S BDMDA=0 S BDMDA=$O(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",BDMDA)) I 'BDMDA D
.S X="DM AUDIT OTHER EDUC TOPICS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
.I Y=-1 W !!,"ERROR IN CREATING DM AUDIT OTHER EDUC TOPICS TAX" Q
.S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)="DM AUDIT OTHER EDUC TOPICS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=280,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.09,^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
.S BDMTEXT="OTHER" F BDMX=1:1:79 S X=$P($T(@BDMTEXT+BDMX),";;",2),DIC="^AUTTEDT(",DIC(0)="M" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0 I $P(Y,U)>0 D
..S ^ATXAX(BDMTX,21,BDMX,0)=+Y,$P(^ATXAX(BDMTX,21,0),U,3)=BDMX,$P(^(0),U,4)=BDMX,^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
..Q
.S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
Q
CESSHF ;;
;;CESSATION-SMOKELESS
;;CESSATION-SMOKER
;;
DIET ;
;;DIABETES NUTRITION
;;DM-DIET
;;DM-NUTRITION
;;DM DIET
;;DM-CHOLESTEROL NU EDUCATION
;;DM NUTRITION PROTEIN
;;
EXC ;;
;;DM-EXERCISE
;;DM EXERCISE
;;DIABETES EXERCISE
;;
OTHER ;
;;DM-DISEASE PROCESS
;;DM DISEASE PROCESS
;;DM-FOLLOW UP
;;DM FOLLOWUP
;;DM-FOOT CARE
;;DM FOOT CARE
;;DIABETES FOOT CARE
;;DM-GENERAL INFORMATION
;;DM-INFORMATION
;;DIABETES GENERAL INFORMATION
;;DM-LIFESTYLE ADAPTATIONS
;;DM LIFESTYLE ADAPTATIONS
;;DM-MEDICATIONS
;;DM MEDICATIONS
;;DIABETES MEDICATIONS
;;DM-KNOW YOUR NUMBER
;;DM-PSYCH ED
;;DM-COMPLICATIONS
;;DM UTI
;;DM SMOKING CESSATION
;;DM SELF MONITORING TEST TAPES
;;DM SELF MONITORING CHEM STRIPS
;;DM PREGNANCY COUNSELING
;;DM NEUROPATHY
;;DM NEPHROPATHY
;;DM-NEPHROPATHY
;;DM-NEUROPATHY
;;DM-ORAL AGENTS
;;DM-RETINOPATHY/EYE
;;DM-SELF-GLUCOSE
;;DM-SEXUAL/REPRODUCTIVE
;;DM-SICK DAY MANAGEMENT
;;DM-WEIGHT CONTROL
;;DM HYPERTENSION
;;DM GESTATIONAL
;;DM EMOTIONAL ASPECTS
;;DM COMPLICATIONS
;;DIABETIC RETINOPATHY TEACHING
;;DIABETES-SICK DAYS
;;DIABETES DENTAL HYGIENE
;;DM - GLUCOMETER USE
;;DM MODULE 1
;;DM MODULE 10
;;DM MODULE 11
;;DM MODULE 12
;;DM MODULE 13
;;DM MODULE 14
;;DM MODULE 15
;;DM MODULE 16
;;DM MODULE 17
;;DM MODULE 18
;;DM MODULE 2
;;DM MODULE 3
;;DM MODULE 4
;;DM MODULE 5
;;DM MODULE 6
;;DM MODULE 7
;;DM MODULE 8
;;DM MODULE 9
;;DM WELLNESS 1
;;DM WELLNESS 2
;;DM WELLNESS 3
;;DM WELLNESS 4
;;DM WELLNESS 5
;;DM WELLNESS 6
;;DM WELLNESS 7
;;DM WELLNESS 8
;;DM-HOME MANAGEMENT
;;DM-KIDNEY DISEASE
;;DM-PATIENT LITERATURE
;;DM-PREVENTION
;;DM-CARDIOVASCULAR PROBLEMS
;;DM-TREATMENT
;;DM-DENTAL
;;DM-HYPERGLYCEMIA
;;DM-HYPOGLYCEMIA
;;DM-INFECTION
;;DM-INFORMATIN
;;DM-INSULIN ADMINISTRATION
;;
BDMP7 ; IHS/CMI/LAB - BDM patch 7 ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
+2 ;
PRE ;EP - pre init
+1 DO RENAME^XPDMENU("BDM M DM AUDIT","BDM M MAIN DM MENU")
+2 QUIT
EN ;
+1 SET ATXFLG=1
+2 DO ^BDMP71X
+3 DO ^BDMP72
+4 DO ^BDMP73
+5 DO ^BDMP74
+6 DO ^BDMP75
+7 DO ^BDMP76
+8 SET ATXFLG=1
+9 DO CESS
+10 DO DRUGS
+11 DO SDM
+12 DO DMEDUC
+13 DO LAB
XIT ;
+1 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
DO EN^XBVK("ATX")
+2 QUIT
+3 ;
LAB ;
+1 SET BDMX="DM AUDIT CREATININE TAX"
DO LAB1
+2 SET BDMX="DM AUDIT CHOLESTEROL TAX"
DO LAB1
+3 SET BDMX="DM AUDIT GLUCOSE TESTS TAX"
DO LAB1
+4 SET BDMX="DM AUDIT URINE PROTEIN TAX"
DO LAB1
+5 SET BDMX="DM AUDIT HGB A1C TAX"
DO LAB1
+6 SET BDMX="DM AUDIT TRIGLYCERIDE TAX"
DO LAB1
+7 SET BDMX="DM AUDIT URINALYSIS TAX"
DO LAB1
+8 SET BDMX="DM AUDIT MICROALBUMINURIA TAX"
DO LAB1
+9 SET BDMX="DM AUDIT AST TAX"
DO LAB1
+10 SET BDMX="DM AUDIT ALT TAX"
DO LAB1
+11 SET BDMX="DM AUDIT LDL CHOLESTEROL TAX"
DO LAB1
+12 QUIT
LAB1 ;
+1 WRITE !,"Creating ",BDMX," Taxonomy..."
+2 SET BDMDA=$ORDER(^ATXLAB("B",BDMX,0))
+3 ;taxonomy already exisits
IF BDMDA
QUIT
+4 SET X=BDMX
SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002228
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+5 IF Y=-1
WRITE !!,"ERROR IN CREATING ",BDMX," TAX"
QUIT
+6 SET BDMTX=+Y
SET $PIECE(^ATXLAB(BDMTX,0),U,2)=BDMX
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,6)=DT
SET $PIECE(^(0),U,8)="B"
SET $PIECE(^(0),U,9)=60
SET ^ATXLAB(BDMTX,21,0)="^9002228.02101PA^0^0"
+7 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
+8 QUIT
DRUGS ;set up drug taxonomies
+1 SET BDMX="DM AUDIT ACE INHIBITORS"
DO DRUG1
+2 SET BDMX="DM AUDIT INSULIN DRUGS"
DO DRUG1
+3 SET BDMX="DM AUDIT SELF MONITOR DRUGS"
DO DRUG1
+4 SET BDMX="DM AUDIT SULFONYLUREA DRUGS"
DO DRUG1
+5 SET BDMX="DM AUDIT METFORMIN DRUGS"
DO DRUG1
+6 SET BDMX="DM AUDIT ACARBOSE DRUGS"
DO DRUG1
+7 SET BDMX="DM AUDIT TROGLITAZONE DRUGS"
DO DRUG1
+8 SET BDMX="DM AUDIT ASPIRIN DRUGS"
DO DRUG1
+9 QUIT
DRUG1 ;
+1 WRITE !,"Creating ",BDMX," Taxonomy..."
+2 SET BDMDA=$ORDER(^ATXAX("B",BDMX,0))
+3 ;taxonomy already exisits
IF BDMDA
QUIT
+4 SET X=BDMX
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+5 IF Y=-1
WRITE !!,"ERROR IN CREATING ",BDMX," TAX"
QUIT
+6 SET BDMTX=+Y
SET $PIECE(^ATXAX(BDMTX,0),U,2)=BDMX
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=173
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=50
SET ^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
+7 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
+8 QUIT
SDM ;
+1 WRITE !,"Creating DM SDM Provider Taxonomy..."
+2 SET BDMDA=$ORDER(^ATXAX("B","DM AUDIT SDM PROVIDERS",0))
+3 ;taxonomy already exisits
IF BDMDA
QUIT
+4 SET X="DM AUDIT SDM PROVIDERS"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+5 IF Y=-1
WRITE !!,"ERROR IN CREATING DM AUDIT SDM PROVIDERS TAX"
QUIT
+6 SET BDMTX=+Y
SET $PIECE(^ATXAX(BDMTX,0),U,2)="DM AUDIT SDM PROVIDERS"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=209
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=16
SET ^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
+7 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
+8 QUIT
CESS ;
+1 WRITE !,"Creating Tobacco Cessation Health factors taxonomy... "
+2 SET BDMDA=$ORDER(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
+3 ;taxonomy already exists
IF BDMDA
QUIT
+4 SET X="DM AUDIT CESSATION HLTH FACTOR"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+5 IF Y=-1
WRITE !!,"ERROR IN CREATING DM AUDIT CESSATION HLTH FACTORS TAX"
QUIT
+6 SET BDMTX=+Y
SET $PIECE(^ATXAX(BDMTX,0),U,2)="DM AUDIT CESSATION HLTH FACTOR"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=78
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=9999999.64
SET ^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
+7 SET BDMTEXT="CESSHF"
FOR BDMX=1:1:2
SET X=$PIECE($TEXT(@BDMTEXT+BDMX),";;",2)
SET DIC="^AUTTHF("
SET DIC(0)="M"
DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0
IF $PIECE(Y,U)>0
Begin DoDot:1
+8 SET ^ATXAX(BDMTX,21,BDMX,0)=+Y
SET $PIECE(^ATXAX(BDMTX,21,0),U,3)=BDMX
SET $PIECE(^(0),U,4)=BDMX
SET ^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
+9 QUIT
End DoDot:1
+10 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
+11 QUIT
+12 ;
DMEDUC ;
+1 WRITE !,"Creating Education topics taxonomy..."
+2 SET BDMDA=0
SET BDMDA=$ORDER(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",BDMDA))
IF 'BDMDA
Begin DoDot:1
+3 SET X="DM AUDIT DIET EDUC TOPICS"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+4 IF Y=-1
WRITE !!,"ERROR IN CREATING DM AUDIT DIET EDUC TOPICS TAX"
QUIT
+5 SET BDMTX=+Y
SET $PIECE(^ATXAX(BDMTX,0),U,2)="DM AUDIT DIET EDUC TOPICS"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=280
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=9999999.09
SET ^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
+6 SET BDMTEXT="DIET"
FOR BDMX=1:1:6
SET X=$PIECE($TEXT(@BDMTEXT+BDMX),";;",2)
SET DIC="^AUTTEDT("
SET DIC(0)="M"
DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0
IF $PIECE(Y,U)>0
Begin DoDot:2
+7 SET ^ATXAX(BDMTX,21,BDMX,0)=+Y
SET $PIECE(^ATXAX(BDMTX,21,0),U,3)=BDMX
SET $PIECE(^(0),U,4)=BDMX
SET ^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
+8 QUIT
End DoDot:2
+9 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+10 SET BDMDA=0
SET BDMDA=$ORDER(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",BDMDA))
IF 'BDMDA
Begin DoDot:1
+11 SET X="DM AUDIT EXERCISE EDUC TOPICS"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+12 IF Y=-1
WRITE !!,"ERROR IN CREATING DM AUDIT EXERCISE EDUC TOPICS TAX"
QUIT
+13 SET BDMTX=+Y
SET $PIECE(^ATXAX(BDMTX,0),U,2)="DM AUDIT EXERCISE EDUC TOPICS"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=280
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=9999999.09
SET ^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
+14 SET BDMTEXT="EXC"
FOR BDMX=1:1:3
SET X=$PIECE($TEXT(@BDMTEXT+BDMX),";;",2)
SET DIC="^AUTTEDT("
SET DIC(0)="M"
DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0
IF $PIECE(Y,U)>0
Begin DoDot:2
+15 SET ^ATXAX(BDMTX,21,BDMX,0)=+Y
SET $PIECE(^ATXAX(BDMTX,21,0),U,3)=BDMX
SET $PIECE(^(0),U,4)=BDMX
SET ^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
+16 QUIT
End DoDot:2
+17 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+18 SET BDMDA=0
SET BDMDA=$ORDER(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",BDMDA))
IF 'BDMDA
Begin DoDot:1
+19 SET X="DM AUDIT OTHER EDUC TOPICS"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+20 IF Y=-1
WRITE !!,"ERROR IN CREATING DM AUDIT OTHER EDUC TOPICS TAX"
QUIT
+21 SET BDMTX=+Y
SET $PIECE(^ATXAX(BDMTX,0),U,2)="DM AUDIT OTHER EDUC TOPICS"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=280
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=9999999.09
SET ^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
+22 SET BDMTEXT="OTHER"
FOR BDMX=1:1:79
SET X=$PIECE($TEXT(@BDMTEXT+BDMX),";;",2)
SET DIC="^AUTTEDT("
SET DIC(0)="M"
DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0
IF $PIECE(Y,U)>0
Begin DoDot:2
+23 SET ^ATXAX(BDMTX,21,BDMX,0)=+Y
SET $PIECE(^ATXAX(BDMTX,21,0),U,3)=BDMX
SET $PIECE(^(0),U,4)=BDMX
SET ^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
+24 QUIT
End DoDot:2
+25 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+26 QUIT
CESSHF ;;
+1 ;;CESSATION-SMOKELESS
+2 ;;CESSATION-SMOKER
+3 ;;
DIET ;
+1 ;;DIABETES NUTRITION
+2 ;;DM-DIET
+3 ;;DM-NUTRITION
+4 ;;DM DIET
+5 ;;DM-CHOLESTEROL NU EDUCATION
+6 ;;DM NUTRITION PROTEIN
+7 ;;
EXC ;;
+1 ;;DM-EXERCISE
+2 ;;DM EXERCISE
+3 ;;DIABETES EXERCISE
+4 ;;
OTHER ;
+1 ;;DM-DISEASE PROCESS
+2 ;;DM DISEASE PROCESS
+3 ;;DM-FOLLOW UP
+4 ;;DM FOLLOWUP
+5 ;;DM-FOOT CARE
+6 ;;DM FOOT CARE
+7 ;;DIABETES FOOT CARE
+8 ;;DM-GENERAL INFORMATION
+9 ;;DM-INFORMATION
+10 ;;DIABETES GENERAL INFORMATION
+11 ;;DM-LIFESTYLE ADAPTATIONS
+12 ;;DM LIFESTYLE ADAPTATIONS
+13 ;;DM-MEDICATIONS
+14 ;;DM MEDICATIONS
+15 ;;DIABETES MEDICATIONS
+16 ;;DM-KNOW YOUR NUMBER
+17 ;;DM-PSYCH ED
+18 ;;DM-COMPLICATIONS
+19 ;;DM UTI
+20 ;;DM SMOKING CESSATION
+21 ;;DM SELF MONITORING TEST TAPES
+22 ;;DM SELF MONITORING CHEM STRIPS
+23 ;;DM PREGNANCY COUNSELING
+24 ;;DM NEUROPATHY
+25 ;;DM NEPHROPATHY
+26 ;;DM-NEPHROPATHY
+27 ;;DM-NEUROPATHY
+28 ;;DM-ORAL AGENTS
+29 ;;DM-RETINOPATHY/EYE
+30 ;;DM-SELF-GLUCOSE
+31 ;;DM-SEXUAL/REPRODUCTIVE
+32 ;;DM-SICK DAY MANAGEMENT
+33 ;;DM-WEIGHT CONTROL
+34 ;;DM HYPERTENSION
+35 ;;DM GESTATIONAL
+36 ;;DM EMOTIONAL ASPECTS
+37 ;;DM COMPLICATIONS
+38 ;;DIABETIC RETINOPATHY TEACHING
+39 ;;DIABETES-SICK DAYS
+40 ;;DIABETES DENTAL HYGIENE
+41 ;;DM - GLUCOMETER USE
+42 ;;DM MODULE 1
+43 ;;DM MODULE 10
+44 ;;DM MODULE 11
+45 ;;DM MODULE 12
+46 ;;DM MODULE 13
+47 ;;DM MODULE 14
+48 ;;DM MODULE 15
+49 ;;DM MODULE 16
+50 ;;DM MODULE 17
+51 ;;DM MODULE 18
+52 ;;DM MODULE 2
+53 ;;DM MODULE 3
+54 ;;DM MODULE 4
+55 ;;DM MODULE 5
+56 ;;DM MODULE 6
+57 ;;DM MODULE 7
+58 ;;DM MODULE 8
+59 ;;DM MODULE 9
+60 ;;DM WELLNESS 1
+61 ;;DM WELLNESS 2
+62 ;;DM WELLNESS 3
+63 ;;DM WELLNESS 4
+64 ;;DM WELLNESS 5
+65 ;;DM WELLNESS 6
+66 ;;DM WELLNESS 7
+67 ;;DM WELLNESS 8
+68 ;;DM-HOME MANAGEMENT
+69 ;;DM-KIDNEY DISEASE
+70 ;;DM-PATIENT LITERATURE
+71 ;;DM-PREVENTION
+72 ;;DM-CARDIOVASCULAR PROBLEMS
+73 ;;DM-TREATMENT
+74 ;;DM-DENTAL
+75 ;;DM-HYPERGLYCEMIA
+76 ;;DM-HYPOGLYCEMIA
+77 ;;DM-INFECTION
+78 ;;DM-INFORMATIN
+79 ;;DM-INSULIN ADMINISTRATION
+80 ;;
