BJPC2EV1 ; IHS/CMI/LAB - Non DX/PX Taxonomy Fix ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
START ;
S ATXFLG=1
D TOBACCO,TBHLTH,DMEDUC,DMADA,DMEDUC1,CESS
Q
TOBACCO ;add tobacco health factor taxonomy
S BJPCDA=0 S BJPCDA=$O(^ATXAX("B","DM AUDIT TOBACCO HLTH FACTORS",BJPCDA)) I BJPCDA Q
W !,"Creating Tobacco Health factors taxonomy... "
S X="DM AUDIT TOBACCO HLTH FACTORS",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 TOBACCO HLTH FACTORS TAX" Q
S BJPCTX=+Y,$P(^ATXAX(BJPCTX,0),U,2)="DM AUDIT TOBACCO HLTH FACTORS",$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(BJPCTX,21,0)="^9002226.02101A^0^0"
S BJPCTEXT="TOB" F BJPCX=1:1:5 S X=$P($T(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,BJPCX)=""
.Q
S DA=BJPCTX,DIK="^ATXAX(" D IX1^DIK
Q
DMEDUC ;
S BJPCDA=0 S BJPCDA=$O(^ATXAX("B","DM AUDIT DIABETES EDUC TOPICS",BJPCDA)) I BJPCDA Q
W !,"Creating Education topics taxonomy..."
S X="DM AUDIT DIABETES 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 DIABETES EDUC TOPICS TAX" Q
S BJPCTX=+Y,$P(^ATXAX(BJPCTX,0),U,2)="DM AUDIT DIABETES 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(BJPCTX,21,0)="^9002226.02101A^0^0"
S BJPCTEXT="EDUC" F BJPCX=1:1:10 S X=$P($T(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,BJPCX)=""
.Q
S DA=BJPCTX,DIK="^ATXAX(" D IX1^DIK
Q
DMADA ;
S BJPCDA=0 S BJPCDA=$O(^ATXAX("B","DM AUDIT DENTAL EXAM ADA CODES",BJPCDA)) I BJPCDA Q
W !,"Creating DM ADA Codes Taxonomy..."
S X="DM AUDIT DENTAL EXAM ADA CODES",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 DENTAL EXAM ADA CODES TAX" Q
S BJPCTX=+Y,$P(^ATXAX(BJPCTX,0),U,2)="DM AUDIT DENTAL EXAM ADA CODES",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=174,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.31,^ATXAX(BJPCTX,21,0)="^9002226.02101A^0^0"
S BJPCTEXT="ADA" F BJPCX=1:1:2 S X=$P($T(@BJPCTEXT+BJPCX),";;",2),DIC="^AUTTADA(",DIC(0)="M" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0 I $P(Y,U)>0 D
.S ^ATXAX(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,BJPCX)=""
.Q
S DA=BJPCTX,DIK="^ATXAX(" D IX1^DIK
Q
TBHLTH ;tb health factors taxonomy
S BJPCDA=0 S BJPCDA=$O(^ATXAX("B","DM AUDIT TB HEALTH FACTORS",BJPCDA)) I BJPCDA Q
W !,"Creating TB HF Taxonomy... "
S X="DM AUDIT TB HEALTH FACTORS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DIADD,DLAYGO,DA,DR,DO,D0
I Y=-1 W !!,"ERROR IN CREATING DM AUDIT TB HLTH FACTORS TAX" Q
S BJPCTX=+Y,$P(^ATXAX(BJPCTX,0),U,2)="TB TX STATUS HLTH FACTORS",$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
S ^ATXAX(BJPCTX,21,0)="^9002226.02101A^0^0"
S BJPCTEXT="TBHF" F BJPCX=1:1:4 S X=$P($T(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,BJPCX)=""
.Q
S DA=BJPCTX,DIK="^ATXAX(" D IX1^DIK
Q
DMEDUC1 ;
S BJPCDA=0 S BJPCDA=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",BJPCDA)) I 'BJPCDA D
.W !,"Creating Education topics taxonomy..."
.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 BJPCTX=+Y,$P(^ATXAX(BJPCTX,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(BJPCTX,21,0)="^9002226.02101A^0^0"
.S BJPCTEXT="DIET" F BJPCX=1:1:6 S X=$P($T(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
..Q
.S DA=BJPCTX,DIK="^ATXAX(" D IX1^DIK
S BJPCDA=0 S BJPCDA=$O(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",BJPCDA)) I 'BJPCDA 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 BJPCTX=+Y,$P(^ATXAX(BJPCTX,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(BJPCTX,21,0)="^9002226.02101A^0^0"
.S BJPCTEXT="EXC" F BJPCX=1:1:3 S X=$P($T(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
..Q
.S DA=BJPCTX,DIK="^ATXAX(" D IX1^DIK
S BJPCDA=0 S BJPCDA=$O(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",BJPCDA)) I 'BJPCDA 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 BJPCTX=+Y,$P(^ATXAX(BJPCTX,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(BJPCTX,21,0)="^9002226.02101A^0^0"
.S BJPCTEXT="OTHER" F BJPCX=1:1:79 S X=$P($T(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
..Q
.S DA=BJPCTX,DIK="^ATXAX(" D IX1^DIK
W !,"Creating Education topics taxonomy..."
S BJPCDA=0 S BJPCDA=$O(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",BJPCDA)) I 'BJPCDA D
.S X="DM AUDIT SMOKING CESS EDUC",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 SMOKING CESS EDUC TAX" Q
.S BJPCTX=+Y,$P(^ATXAX(BJPCTX,0),U,2)="DM AUDIT SMOKING CESS EDUC",$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(BJPCTX,21,0)="^9002226.02101A^0^0"
.S ^ATXAX(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
.S DA=BJPCTX,DIK="^ATXAX(" D IX1^DIK
Q
CESS ;
S BJPCDA=$O(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
Q:BJPCDA ;taxonomy already exists
W !,"Creating Tobacco Cessation Health factors taxonomy... "
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 BJPCTX=+Y,$P(^ATXAX(BJPCTX,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(BJPCTX,21,0)="^9002226.02101A^0^0"
S BJPCTEXT="CESSHF" F BJPCX=1:1:2 S X=$P($T(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y,$P(^ATXAX(BJPCTX,21,0),U,3)=BJPCX,$P(^(0),U,4)=BJPCX,^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
.Q
S DA=BJPCTX,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
;;
TBHF ;
;;TB - TX UNTREATED
;;TB - TX INCOMPLETE
;;TB - TX COMPLETE
;;TB - TX UNKNOWN
TOB ;
;;NON-TOBACCO USER
;;CURRENT SMOKER
;;CURRENT SMOKELESS
;;PREVIOUS SMOKER
;;PREVIOUS SMOKELESS
EDUC ;
;;DM-COMPLICATIONS
;;DM-DIET
;;DM-DISEASE PROCESS
;;DM-EXERCISE
;;DM-FOLLOW UP
;;DM-FOOT CARE
;;DM-GENERAL INFORMATION
;;DM-LIFESTYLE ADAPTATIONS
;;DM-MEDICATIONS
;;DM-NUTRITION
ADA ;
;;0110
;;0120
;;0150
;;9321
;;9320
;;
;;
;;
BJPC2EV1 ; IHS/CMI/LAB - Non DX/PX Taxonomy Fix ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
START ;
+1 SET ATXFLG=1
+2 DO TOBACCO
DO TBHLTH
DO DMEDUC
DO DMADA
DO DMEDUC1
DO CESS
+3 QUIT
TOBACCO ;add tobacco health factor taxonomy
+1 SET BJPCDA=0
SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT TOBACCO HLTH FACTORS",BJPCDA))
IF BJPCDA
QUIT
+2 WRITE !,"Creating Tobacco Health factors taxonomy... "
+3 SET X="DM AUDIT TOBACCO HLTH FACTORS"
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 TOBACCO HLTH FACTORS TAX"
QUIT
+5 SET BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,0),U,2)="DM AUDIT TOBACCO HLTH FACTORS"
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(BJPCTX,21,0)="^9002226.02101A^0^0"
+6 SET BJPCTEXT="TOB"
FOR BJPCX=1:1:5
SET X=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",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
+7 SET ^ATXAX(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,BJPCX)=""
+8 QUIT
End DoDot:1
+9 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
+10 QUIT
DMEDUC ;
+1 SET BJPCDA=0
SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT DIABETES EDUC TOPICS",BJPCDA))
IF BJPCDA
QUIT
+2 WRITE !,"Creating Education topics taxonomy..."
+3 SET X="DM AUDIT DIABETES 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 DIABETES EDUC TOPICS TAX"
QUIT
+5 SET BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,0),U,2)="DM AUDIT DIABETES 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(BJPCTX,21,0)="^9002226.02101A^0^0"
+6 SET BJPCTEXT="EDUC"
FOR BJPCX=1:1:10
SET X=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",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:1
+7 SET ^ATXAX(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,BJPCX)=""
+8 QUIT
End DoDot:1
+9 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
+10 QUIT
DMADA ;
+1 SET BJPCDA=0
SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT DENTAL EXAM ADA CODES",BJPCDA))
IF BJPCDA
QUIT
+2 WRITE !,"Creating DM ADA Codes Taxonomy..."
+3 SET X="DM AUDIT DENTAL EXAM ADA CODES"
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 DENTAL EXAM ADA CODES TAX"
QUIT
+5 SET BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,0),U,2)="DM AUDIT DENTAL EXAM ADA CODES"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=174
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=9999999.31
SET ^ATXAX(BJPCTX,21,0)="^9002226.02101A^0^0"
+6 SET BJPCTEXT="ADA"
FOR BJPCX=1:1:2
SET X=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",2)
SET DIC="^AUTTADA("
SET DIC(0)="M"
DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0
IF $PIECE(Y,U)>0
Begin DoDot:1
+7 SET ^ATXAX(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,BJPCX)=""
+8 QUIT
End DoDot:1
+9 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
+10 QUIT
TBHLTH ;tb health factors taxonomy
+1 SET BJPCDA=0
SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT TB HEALTH FACTORS",BJPCDA))
IF BJPCDA
QUIT
+2 WRITE !,"Creating TB HF Taxonomy... "
+3 SET X="DM AUDIT TB HEALTH FACTORS"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DIADD,DLAYGO,DA,DR,DO,D0
+4 IF Y=-1
WRITE !!,"ERROR IN CREATING DM AUDIT TB HLTH FACTORS TAX"
QUIT
+5 SET BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,0),U,2)="TB TX STATUS HLTH FACTORS"
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
+6 SET ^ATXAX(BJPCTX,21,0)="^9002226.02101A^0^0"
+7 SET BJPCTEXT="TBHF"
FOR BJPCX=1:1:4
SET X=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,BJPCX)=""
+9 QUIT
End DoDot:1
+10 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
+11 QUIT
DMEDUC1 ;
+1 SET BJPCDA=0
SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",BJPCDA))
IF 'BJPCDA
Begin DoDot:1
+2 WRITE !,"Creating Education topics taxonomy..."
+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 BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,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(BJPCTX,21,0)="^9002226.02101A^0^0"
+6 SET BJPCTEXT="DIET"
FOR BJPCX=1:1:6
SET X=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
+8 QUIT
End DoDot:2
+9 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+10 SET BJPCDA=0
SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",BJPCDA))
IF 'BJPCDA
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 BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,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(BJPCTX,21,0)="^9002226.02101A^0^0"
+14 SET BJPCTEXT="EXC"
FOR BJPCX=1:1:3
SET X=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
+16 QUIT
End DoDot:2
+17 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+18 SET BJPCDA=0
SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",BJPCDA))
IF 'BJPCDA
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 BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,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(BJPCTX,21,0)="^9002226.02101A^0^0"
+22 SET BJPCTEXT="OTHER"
FOR BJPCX=1:1:79
SET X=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
+24 QUIT
End DoDot:2
+25 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+26 WRITE !,"Creating Education topics taxonomy..."
+27 SET BJPCDA=0
SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",BJPCDA))
IF 'BJPCDA
Begin DoDot:1
+28 SET X="DM AUDIT SMOKING CESS EDUC"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+29 IF Y=-1
WRITE !!,"ERROR IN CREATING DM AUDIT SMOKING CESS EDUC TAX"
QUIT
+30 SET BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,0),U,2)="DM AUDIT SMOKING CESS EDUC"
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(BJPCTX,21,0)="^9002226.02101A^0^0"
+31 SET ^ATXAX(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
+32 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+33 QUIT
CESS ;
+1 SET BJPCDA=$ORDER(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
+2 ;taxonomy already exists
IF BJPCDA
QUIT
+3 WRITE !,"Creating Tobacco Cessation Health factors taxonomy... "
+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 BJPCTX=+Y
SET $PIECE(^ATXAX(BJPCTX,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(BJPCTX,21,0)="^9002226.02101A^0^0"
+7 SET BJPCTEXT="CESSHF"
FOR BJPCX=1:1:2
SET X=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",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(BJPCTX,21,BJPCX,0)=+Y
SET $PIECE(^ATXAX(BJPCTX,21,0),U,3)=BJPCX
SET $PIECE(^(0),U,4)=BJPCX
SET ^ATXAX(BJPCTX,21,"AA",+Y,+Y)=""
+9 QUIT
End DoDot:1
+10 SET DA=BJPCTX
SET DIK="^ATXAX("
DO IX1^DIK
+11 QUIT
+12 ;
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 ;;
TBHF ;
+1 ;;TB - TX UNTREATED
+2 ;;TB - TX INCOMPLETE
+3 ;;TB - TX COMPLETE
+4 ;;TB - TX UNKNOWN
TOB ;
+1 ;;NON-TOBACCO USER
+2 ;;CURRENT SMOKER
+3 ;;CURRENT SMOKELESS
+4 ;;PREVIOUS SMOKER
+5 ;;PREVIOUS SMOKELESS
EDUC ;
+1 ;;DM-COMPLICATIONS
+2 ;;DM-DIET
+3 ;;DM-DISEASE PROCESS
+4 ;;DM-EXERCISE
+5 ;;DM-FOLLOW UP
+6 ;;DM-FOOT CARE
+7 ;;DM-GENERAL INFORMATION
+8 ;;DM-LIFESTYLE ADAPTATIONS
+9 ;;DM-MEDICATIONS
+10 ;;DM-NUTRITION
ADA ;
+1 ;;0110
+2 ;;0120
+3 ;;0150
+4 ;;9321
+5 ;;9320
+6 ;;
+7 ;;
+8 ;;
