- APCLP7 ; IHS/CMI/LAB - apcl patch 7 ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- PRE ;EP - pre init
- D RENAME^XPDMENU("APCL M DM AUDIT","APCL M MAIN DM MENU")
- Q
- EN ;
- S ATXFLG=1
- D ^APCLP71X
- D ^APCLP72
- D ^APCLP73
- D ^APCLP74
- D ^APCLP75
- D ^APCLP76
- S ATXFLG=1
- D CESS
- D DRUGS
- D SDM
- D DMEDUC
- D LAB
- XIT ;
- D EN^XBVK("APCL"),EN^XBVK("ATX")
- Q
- ;
- LAB ;
- S APCLX="DM AUDIT CREATININE TAX" D LAB1
- S APCLX="DM AUDIT CHOLESTEROL TAX" D LAB1
- S APCLX="DM AUDIT GLUCOSE TESTS TAX" D LAB1
- S APCLX="DM AUDIT URINE PROTEIN TAX" D LAB1
- S APCLX="DM AUDIT HGB A1C TAX" D LAB1
- S APCLX="DM AUDIT TRIGLYCERIDE TAX" D LAB1
- S APCLX="DM AUDIT URINALYSIS TAX" D LAB1
- S APCLX="DM AUDIT MICROALBUMINURIA TAX" D LAB1
- S APCLX="DM AUDIT AST TAX" D LAB1
- S APCLX="DM AUDIT ALT TAX" D LAB1
- S APCLX="DM AUDIT LDL CHOLESTEROL TAX" D LAB1
- Q
- LAB1 ;
- W !,"Creating ",APCLX," Taxonomy..."
- S APCLDA=$O(^ATXLAB("B",APCLX,0))
- Q:APCLDA ;taxonomy already exisits
- S X=APCLX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
- I Y=-1 W !!,"ERROR IN CREATING ",APCLX," TAX" Q
- S APCLTX=+Y,$P(^ATXLAB(APCLTX,0),U,2)=APCLX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60,^ATXLAB(APCLTX,21,0)="^9002228.02101PA^0^0"
- S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- Q
- DRUGS ;set up drug taxonomies
- S APCLX="DM AUDIT ACE INHIBITORS" D DRUG1
- S APCLX="DM AUDIT INSULIN DRUGS" D DRUG1
- S APCLX="DM AUDIT SELF MONITOR DRUGS" D DRUG1
- S APCLX="DM AUDIT SULFONYLUREA DRUGS" D DRUG1
- S APCLX="DM AUDIT METFORMIN DRUGS" D DRUG1
- S APCLX="DM AUDIT ACARBOSE DRUGS" D DRUG1
- S APCLX="DM AUDIT TROGLITAZONE DRUGS" D DRUG1
- S APCLX="DM AUDIT ASPIRIN DRUGS" D DRUG1
- Q
- DRUG1 ;
- W !,"Creating ",APCLX," Taxonomy..."
- S APCLDA=$O(^ATXAX("B",APCLX,0))
- Q:APCLDA ;taxonomy already exisits
- S X=APCLX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
- I Y=-1 W !!,"ERROR IN CREATING ",APCLX," TAX" Q
- S APCLTX=+Y,$P(^ATXAX(APCLTX,0),U,2)=APCLX,$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(APCLTX,21,0)="^9002226.02101A^0^0"
- S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- Q
- SDM ;
- W !,"Creating DM SDM Provider Taxonomy..."
- S APCLDA=$O(^ATXAX("B","DM AUDIT SDM PROVIDERS",0))
- Q:APCLDA ;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 APCLTX=+Y,$P(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- Q
- CESS ;
- W !,"Creating Tobacco Cessation Health factors taxonomy... "
- S APCLDA=$O(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
- Q:APCLDA ;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 APCLTX=+Y,$P(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- S APCLTEXT="CESSHF" F APCLX=1:1:2 S X=$P($T(@APCLTEXT+APCLX),";;",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(APCLTX,21,APCLX,0)=+Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLX,$P(^(0),U,4)=APCLX,^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- .Q
- S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- Q
- ;
- DMEDUC ;
- W !,"Creating Education topics taxonomy..."
- S APCLDA=0 S APCLDA=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",APCLDA)) I 'APCLDA 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 APCLTX=+Y,$P(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- .S APCLTEXT="DIET" F APCLX=1:1:6 S X=$P($T(@APCLTEXT+APCLX),";;",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(APCLTX,21,APCLX,0)=+Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLX,$P(^(0),U,4)=APCLX,^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- ..Q
- .S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- S APCLDA=0 S APCLDA=$O(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",APCLDA)) I 'APCLDA 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 APCLTX=+Y,$P(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- .S APCLTEXT="EXC" F APCLX=1:1:3 S X=$P($T(@APCLTEXT+APCLX),";;",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(APCLTX,21,APCLX,0)=+Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLX,$P(^(0),U,4)=APCLX,^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- ..Q
- .S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- S APCLDA=0 S APCLDA=$O(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",APCLDA)) I 'APCLDA 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 APCLTX=+Y,$P(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- .S APCLTEXT="OTHER" F APCLX=1:1:79 S X=$P($T(@APCLTEXT+APCLX),";;",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(APCLTX,21,APCLX,0)=+Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLX,$P(^(0),U,4)=APCLX,^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- ..Q
- .S DA=APCLTX,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
- ;;
- APCLP7 ; IHS/CMI/LAB - apcl patch 7 ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- PRE ;EP - pre init
- +1 DO RENAME^XPDMENU("APCL M DM AUDIT","APCL M MAIN DM MENU")
- +2 QUIT
- EN ;
- +1 SET ATXFLG=1
- +2 DO ^APCLP71X
- +3 DO ^APCLP72
- +4 DO ^APCLP73
- +5 DO ^APCLP74
- +6 DO ^APCLP75
- +7 DO ^APCLP76
- +8 SET ATXFLG=1
- +9 DO CESS
- +10 DO DRUGS
- +11 DO SDM
- +12 DO DMEDUC
- +13 DO LAB
- XIT ;
- +1 DO EN^XBVK("APCL")
- DO EN^XBVK("ATX")
- +2 QUIT
- +3 ;
- LAB ;
- +1 SET APCLX="DM AUDIT CREATININE TAX"
- DO LAB1
- +2 SET APCLX="DM AUDIT CHOLESTEROL TAX"
- DO LAB1
- +3 SET APCLX="DM AUDIT GLUCOSE TESTS TAX"
- DO LAB1
- +4 SET APCLX="DM AUDIT URINE PROTEIN TAX"
- DO LAB1
- +5 SET APCLX="DM AUDIT HGB A1C TAX"
- DO LAB1
- +6 SET APCLX="DM AUDIT TRIGLYCERIDE TAX"
- DO LAB1
- +7 SET APCLX="DM AUDIT URINALYSIS TAX"
- DO LAB1
- +8 SET APCLX="DM AUDIT MICROALBUMINURIA TAX"
- DO LAB1
- +9 SET APCLX="DM AUDIT AST TAX"
- DO LAB1
- +10 SET APCLX="DM AUDIT ALT TAX"
- DO LAB1
- +11 SET APCLX="DM AUDIT LDL CHOLESTEROL TAX"
- DO LAB1
- +12 QUIT
- LAB1 ;
- +1 WRITE !,"Creating ",APCLX," Taxonomy..."
- +2 SET APCLDA=$ORDER(^ATXLAB("B",APCLX,0))
- +3 ;taxonomy already exisits
- IF APCLDA
- QUIT
- +4 SET X=APCLX
- 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 ",APCLX," TAX"
- QUIT
- +6 SET APCLTX=+Y
- SET $PIECE(^ATXLAB(APCLTX,0),U,2)=APCLX
- 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(APCLTX,21,0)="^9002228.02101PA^0^0"
- +7 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +8 QUIT
- DRUGS ;set up drug taxonomies
- +1 SET APCLX="DM AUDIT ACE INHIBITORS"
- DO DRUG1
- +2 SET APCLX="DM AUDIT INSULIN DRUGS"
- DO DRUG1
- +3 SET APCLX="DM AUDIT SELF MONITOR DRUGS"
- DO DRUG1
- +4 SET APCLX="DM AUDIT SULFONYLUREA DRUGS"
- DO DRUG1
- +5 SET APCLX="DM AUDIT METFORMIN DRUGS"
- DO DRUG1
- +6 SET APCLX="DM AUDIT ACARBOSE DRUGS"
- DO DRUG1
- +7 SET APCLX="DM AUDIT TROGLITAZONE DRUGS"
- DO DRUG1
- +8 SET APCLX="DM AUDIT ASPIRIN DRUGS"
- DO DRUG1
- +9 QUIT
- DRUG1 ;
- +1 WRITE !,"Creating ",APCLX," Taxonomy..."
- +2 SET APCLDA=$ORDER(^ATXAX("B",APCLX,0))
- +3 ;taxonomy already exisits
- IF APCLDA
- QUIT
- +4 SET X=APCLX
- 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 ",APCLX," TAX"
- QUIT
- +6 SET APCLTX=+Y
- SET $PIECE(^ATXAX(APCLTX,0),U,2)=APCLX
- 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(APCLTX,21,0)="^9002226.02101A^0^0"
- +7 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +8 QUIT
- SDM ;
- +1 WRITE !,"Creating DM SDM Provider Taxonomy..."
- +2 SET APCLDA=$ORDER(^ATXAX("B","DM AUDIT SDM PROVIDERS",0))
- +3 ;taxonomy already exisits
- IF APCLDA
- 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 APCLTX=+Y
- SET $PIECE(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- +7 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +8 QUIT
- CESS ;
- +1 WRITE !,"Creating Tobacco Cessation Health factors taxonomy... "
- +2 SET APCLDA=$ORDER(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
- +3 ;taxonomy already exists
- IF APCLDA
- 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 APCLTX=+Y
- SET $PIECE(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- +7 SET APCLTEXT="CESSHF"
- FOR APCLX=1:1:2
- SET X=$PIECE($TEXT(@APCLTEXT+APCLX),";;",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(APCLTX,21,APCLX,0)=+Y
- SET $PIECE(^ATXAX(APCLTX,21,0),U,3)=APCLX
- SET $PIECE(^(0),U,4)=APCLX
- SET ^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- +9 QUIT
- End DoDot:1
- +10 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +11 QUIT
- +12 ;
- DMEDUC ;
- +1 WRITE !,"Creating Education topics taxonomy..."
- +2 SET APCLDA=0
- SET APCLDA=$ORDER(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",APCLDA))
- IF 'APCLDA
- 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 APCLTX=+Y
- SET $PIECE(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- +6 SET APCLTEXT="DIET"
- FOR APCLX=1:1:6
- SET X=$PIECE($TEXT(@APCLTEXT+APCLX),";;",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(APCLTX,21,APCLX,0)=+Y
- SET $PIECE(^ATXAX(APCLTX,21,0),U,3)=APCLX
- SET $PIECE(^(0),U,4)=APCLX
- SET ^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- +8 QUIT
- End DoDot:2
- +9 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- End DoDot:1
- +10 SET APCLDA=0
- SET APCLDA=$ORDER(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",APCLDA))
- IF 'APCLDA
- 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 APCLTX=+Y
- SET $PIECE(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- +14 SET APCLTEXT="EXC"
- FOR APCLX=1:1:3
- SET X=$PIECE($TEXT(@APCLTEXT+APCLX),";;",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(APCLTX,21,APCLX,0)=+Y
- SET $PIECE(^ATXAX(APCLTX,21,0),U,3)=APCLX
- SET $PIECE(^(0),U,4)=APCLX
- SET ^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- +16 QUIT
- End DoDot:2
- +17 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- End DoDot:1
- +18 SET APCLDA=0
- SET APCLDA=$ORDER(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",APCLDA))
- IF 'APCLDA
- 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 APCLTX=+Y
- SET $PIECE(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- +22 SET APCLTEXT="OTHER"
- FOR APCLX=1:1:79
- SET X=$PIECE($TEXT(@APCLTEXT+APCLX),";;",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(APCLTX,21,APCLX,0)=+Y
- SET $PIECE(^ATXAX(APCLTX,21,0),U,3)=APCLX
- SET $PIECE(^(0),U,4)=APCLX
- SET ^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- +24 QUIT
- End DoDot:2
- +25 SET DA=APCLTX
- 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 ;;