BJPC1ECA.m

BJPC1ECA ; IHS/CMI/LAB - PCC Suite v1.0 patch 1 environment check

 ;;1.0;IHS PCC SUITE;**1**;MAR 14, 2008

 ;

 ;

TAXREAD ;EP

 S BJPCPNSP=""

 S BJPCTEXT="TAX" F BJPCX=1:1 S BJPCDATA=$P($T(@BJPCTEXT+BJPCX),";;",2) Q:BJPCDATA=""  D

 .S BJPCDA=$O(^ATXAX("B",$P(BJPCDATA,"|"),0))

 .Q:BJPCDA=""

 .S $P(^ATXAX(BJPCDA,0),U,4)="n" W !,$P(BJPCDATA,"|")  ;SET NO DELETE

 .S $P(^ATXAX(BJPCDA,0),U,22)=$P(BJPCDATA,"|",2) ;set read only

 .;set packages in multiple

 .K DIC,DA,DR

 .S BJPCP=$P(BJPCDATA,"|",3)

 .F BJPCN=1:1 S BJPCPP=$P(BJPCP,"*",BJPCN) Q:BJPCPP=""  D

 ..S BJPCPI=$O(^DIC(9.4,"C",BJPCPP,0))

 ..Q:BJPCPI=""  ;NO PACKAGE

 ..S X="`"_BJPCPI,DIC="^ATXAX("_BJPCDA_",41,",DIC(0)="L",DIC("P")=$P(^DD(9002226,4101,0),U,2),DA(1)=BJPCDA

 ..D ^DIC

 ..I Y=-1 W !,"updating package multiple for ",BJPCPP," entry ",$P(^ATXAX(BJPCDA,0),U)," failed"

 ..K DIC,DA,Y,X

 .Q

 ;

SETTAXL ;

 ;Q:'$D(^DD(9002228,4101,0))  ;taxonomy patch not yet installed

 S BJPCTEXT="LABTAX" F BJPCX=1:1 S BJPCDATA=$P($T(@BJPCTEXT+BJPCX),";;",2) Q:BJPCDATA=""  D

 .S BJPCDA=$O(^ATXLAB("B",$P(BJPCDATA,"|"),0))

 .Q:BJPCDA=""

 .S $P(^ATXLAB(BJPCDA,0),U,4)="n" W !,$P(BJPCDATA,"|")  ;SET NO DELETE

 .S $P(^ATXLAB(BJPCDA,0),U,22)=$P(BJPCDATA,"|",2) ;set read only

 .S $P(^ATXLAB(BJPCDA,0),U,11)=$P(BJPCDATA,"|",4) ;set panel yes/no

 .;set packages in multiple

 .K DIC,DA,DR

 .S BJPCP=$P(BJPCDATA,"|",3)

 .F BJPCN=1:1 S BJPCPP=$P(BJPCP,"*",BJPCN) Q:BJPCPP=""  D

 ..S BJPCPI=$O(^DIC(9.4,"C",BJPCPP,0))

 ..Q:BJPCPI=""  ;NO PACKAGE

 ..S X="`"_BJPCPI,DIC="^ATXLAB("_BJPCDA_",41,",DIC(0)="L",DIC("P")=$P(^DD(9002228,4101,0),U,2),DA(1)=BJPCDA

 ..D ^DIC

 ..I Y=-1 W !,"updating package multiple for ",BJPCPP," entry ",$P(^ATXLAB(BJPCDA,0),U)," failed"

 ..K DIC,DA,Y,X

 .Q

 Q

 ;

TAX ;

 ;;DM AUDIT INCRETIN MIMETIC|0|APCL*BDM

 ;;DM AUDIT DPP4 INHIBITOR DRUGS|0|APCL*BDM

 ;;DM AUDIT P/C RATIO LOINC|1|APCL*BDM

 ;;DM AUDIT P/C RATIO TAX|0|APCL*BDM

 ;;DM AUDIT A/C RATIO TAX|0|APCL*BDM

 ;;APCL DIABETES REG COMPLICATION|0|APCL*BDM

 ;;APCL DIABETES REG NEW CASE|0|APCL*BDM

 ;;DM AUDIT 75GM 2HR LOINC|1|APCL*APCH*BDM

 ;;DM AUDIT A/C RATIO LOINC|1|APCL*BDM

 ;;DM AUDIT ACARBOSE DRUGS|0|APCL*BDM

 ;;DM AUDIT ACE INHIBITORS|0|APCL*BDM

 ;;DM AUDIT ANTI-PLATELET DRUGS|0|APCL*BDM

 ;;DM AUDIT ASPIRIN DRUGS|0|APCL*BDM

 ;;DM AUDIT CESSATION HLTH FACTOR|0|APCL*BDM

 ;;DM AUDIT DENTAL EXAM ADA CODES|0|APCL*BDM

 ;;DM AUDIT DEPRESSIVE DISORDERS|1|APCL*BDM

 ;;DM AUDIT DIABETES EDUC TOPICS|0|APCL*BDM

 ;;DM AUDIT DIET EDUC TOPICS|0|APCL*BDM

 ;;DM AUDIT EKG CPTS|1|APCL*BDM

 ;;DM AUDIT ESTIMATED GFR LOINC|1|APCL*APCH

 ;;DM AUDIT EXCERCISE EDUC TOPICS|0|APCL*BDM

 ;;DM AUDIT EXERCISE EDUC TOPICS|0|APCL*BDM

 ;;DM AUDIT EYE EXAM DXS|1|APCL*BDM

 ;;DM AUDIT FASTING GLUC LOINC|1|APCL*APCH*BDM

 ;;DM AUDIT FLU CPTS|1|APCL*BDM

 ;;DM AUDIT INSULIN DRUGS|0|APCL*BDM

 ;;DM AUDIT LIPID LOWERING DRUGS|0|APCL*BDM

 ;;DM AUDIT MAMMOGRAM CPTS|1|APCL*BDM

 ;;DM AUDIT METFORMIN DRUGS|0|APCL*BDM

 ;;DM AUDIT ORAL HYPOGLYCEMICS|0|APCL*BDM

 ;;DM AUDIT OTHER EDUC TOPICS|0|APCL*BDM

 ;;DM AUDIT PAP CPTS|1|APCL*BDM

 ;;DM AUDIT PERIDONTAL ADA CODES|0|APCL*BDM

 ;;DM AUDIT PNEUMO CPTS|1|APCL*BDM

 ;;DM AUDIT PRE-DIABETES DXS|1|APCL*BDM*APCH

 ;;DM AUDIT PROBLEM DIABETES DX|1|APCL*BDM

 ;;DM AUDIT PROBLEM HTN DIAGNOSES|1|APCL*BDM

 ;;DM AUDIT PROBLEM SMOKING DXS|1|APCL*BDM

 ;;DM AUDIT PROBLEM TB DXS|1|APCL*BDM

 ;;DM AUDIT SDM PROVIDERS|0|APCL*BDM

 ;;DM AUDIT SELF MONITOR DRUGS|0|APCL*BDM

 ;;DM AUDIT SMOKING CESS EDUC|0|APCL*BDM

 ;;DM AUDIT SMOKING RELATED DXS|1|APCL*BDM

 ;;DM AUDIT STATIN DRUGS|0|APCL*BDM

 ;;DM AUDIT SULFONYLUREA DRUGS|0|APCL*BDM

 ;;DM AUDIT TB HEALTH FACTORS|0|APCL*BDM

 ;;DM AUDIT TD CPTS|1|APCL*BDM

 ;;DM AUDIT TOBACCO HLTH FACTORS|0|APCL*BDM

 ;;DM AUDIT GLITAZONE DRUGS|0|APCL*BDM

 ;;DM AUDIT TYPE I DXS|1|APCL*BDM

 ;;DM AUDIT TYPE II DXS|1|APCL*BDM

 ;;DM AUDIT MICROALBUMIN LOINC CODES|1|APCL*BDM

 ;;DM AUDIT URINALYSIS LOINC|1|APCL*BDM

 ;;DM AUDIT URINE PROTEIN LOINC|1|APCL*BDM

 ;;APCL CAR CNM|0|APCL

 ;;APCL CAR DENTISTS|0|APCL

 ;;APCL CAR FNP|0|APCL

 ;;APCL CAR LCSW|0|APCL

 ;;APCL CAR LVN|0|APCL

 ;;APCL CAR OTHER PROVIDERS|0|APCL

 ;;APCL CAR OTHER2|0|APCL

 ;;APCL CAR PA|0|APCL

 ;;APCL CAR PHYSICIANS|0|APCL

 ;;APCL CAR PSYCHIATRIST|0|APCL

 ;;APCL CAR PSYCHOLOGIST|0|APCL

 ;;APCL CAR PT ED|0|APCL

 ;;APCL CAR RDA|0|APCL

 ;;APCL CAR RN|0|APCL

 ;;

LABTAX ;;

 ;;APCH HCT/HGB TESTS|0|APCH|1

 ;;BGP QUANT URINE PROTEIN|0|APCL*BDM*BGP|1

 ;;DM AUDIT 2 HR GTT TAX|0|APCL*BDM|1

 ;;DM AUDIT LIPID PROFILE TAX|0|APCL*BDM|1

 ;;DM AUDIT PAP SMEAR TAX|0|APCL*BDM|1

 ;;DM AUDIT URINALYSIS TAX|0|APCL*BDM|1

 ;;

BJPC1ECA  ; IHS/CMI/LAB - PCC Suite v1.0 patch 1 environment check

 +1       ;;1.0;IHS PCC SUITE;**1**;MAR 14, 2008

 +2       ;

 +3       ;

TAXREAD   ;EP

 +1        SET BJPCPNSP=""

 +2        SET BJPCTEXT="TAX"

           FOR BJPCX=1:1

               SET BJPCDATA=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",2)

               IF BJPCDATA=""

                   QUIT 

               Begin DoDot:1

 +3                SET BJPCDA=$ORDER(^ATXAX("B",$PIECE(BJPCDATA,"|"),0))

 +4                IF BJPCDA=""

                       QUIT 

 +5       ;SET NO DELETE

                   SET $PIECE(^ATXAX(BJPCDA,0),U,4)="n"

                   WRITE !,$PIECE(BJPCDATA,"|")

 +6       ;set read only

                   SET $PIECE(^ATXAX(BJPCDA,0),U,22)=$PIECE(BJPCDATA,"|",2)

 +7       ;set packages in multiple

 +8                KILL DIC,DA,DR

 +9                SET BJPCP=$PIECE(BJPCDATA,"|",3)

 +10               FOR BJPCN=1:1

                       SET BJPCPP=$PIECE(BJPCP,"*",BJPCN)

                       IF BJPCPP=""

                           QUIT 

                       Begin DoDot:2

 +11                       SET BJPCPI=$ORDER(^DIC(9.4,"C",BJPCPP,0))

 +12      ;NO PACKAGE

                           IF BJPCPI=""

                               QUIT 

 +13                       SET X="`"_BJPCPI

                           SET DIC="^ATXAX("_BJPCDA_",41,"

                           SET DIC(0)="L"

                           SET DIC("P")=$PIECE(^DD(9002226,4101,0),U,2)

                           SET DA(1)=BJPCDA

 +14                       DO ^DIC

 +15                       IF Y=-1

                               WRITE !,"updating package multiple for ",BJPCPP," entry ",$PIECE(^ATXAX(BJPCDA,0),U)," failed"

 +16                       KILL DIC,DA,Y,X

                       End DoDot:2

 +17               QUIT 

               End DoDot:1

 +18      ;

SETTAXL   ;

 +1       ;Q:'$D(^DD(9002228,4101,0))  ;taxonomy patch not yet installed

 +2        SET BJPCTEXT="LABTAX"

           FOR BJPCX=1:1

               SET BJPCDATA=$PIECE($TEXT(@BJPCTEXT+BJPCX),";;",2)

               IF BJPCDATA=""

                   QUIT 

               Begin DoDot:1

 +3                SET BJPCDA=$ORDER(^ATXLAB("B",$PIECE(BJPCDATA,"|"),0))

 +4                IF BJPCDA=""

                       QUIT 

 +5       ;SET NO DELETE

                   SET $PIECE(^ATXLAB(BJPCDA,0),U,4)="n"

                   WRITE !,$PIECE(BJPCDATA,"|")

 +6       ;set read only

                   SET $PIECE(^ATXLAB(BJPCDA,0),U,22)=$PIECE(BJPCDATA,"|",2)

 +7       ;set panel yes/no

                   SET $PIECE(^ATXLAB(BJPCDA,0),U,11)=$PIECE(BJPCDATA,"|",4)

 +8       ;set packages in multiple

 +9                KILL DIC,DA,DR

 +10               SET BJPCP=$PIECE(BJPCDATA,"|",3)

 +11               FOR BJPCN=1:1

                       SET BJPCPP=$PIECE(BJPCP,"*",BJPCN)

                       IF BJPCPP=""

                           QUIT 

                       Begin DoDot:2

 +12                       SET BJPCPI=$ORDER(^DIC(9.4,"C",BJPCPP,0))

 +13      ;NO PACKAGE

                           IF BJPCPI=""

                               QUIT 

 +14                       SET X="`"_BJPCPI

                           SET DIC="^ATXLAB("_BJPCDA_",41,"

                           SET DIC(0)="L"

                           SET DIC("P")=$PIECE(^DD(9002228,4101,0),U,2)

                           SET DA(1)=BJPCDA

 +15                       DO ^DIC

 +16                       IF Y=-1

                               WRITE !,"updating package multiple for ",BJPCPP," entry ",$PIECE(^ATXLAB(BJPCDA,0),U)," failed"

 +17                       KILL DIC,DA,Y,X

                       End DoDot:2

 +18               QUIT 

               End DoDot:1

 +19       QUIT 

 +20      ;

TAX       ;

 +1       ;;DM AUDIT INCRETIN MIMETIC|0|APCL*BDM

 +2       ;;DM AUDIT DPP4 INHIBITOR DRUGS|0|APCL*BDM

 +3       ;;DM AUDIT P/C RATIO LOINC|1|APCL*BDM

 +4       ;;DM AUDIT P/C RATIO TAX|0|APCL*BDM

 +5       ;;DM AUDIT A/C RATIO TAX|0|APCL*BDM

 +6       ;;APCL DIABETES REG COMPLICATION|0|APCL*BDM

 +7       ;;APCL DIABETES REG NEW CASE|0|APCL*BDM

 +8       ;;DM AUDIT 75GM 2HR LOINC|1|APCL*APCH*BDM

 +9       ;;DM AUDIT A/C RATIO LOINC|1|APCL*BDM

 +10      ;;DM AUDIT ACARBOSE DRUGS|0|APCL*BDM

 +11      ;;DM AUDIT ACE INHIBITORS|0|APCL*BDM

 +12      ;;DM AUDIT ANTI-PLATELET DRUGS|0|APCL*BDM

 +13      ;;DM AUDIT ASPIRIN DRUGS|0|APCL*BDM

 +14      ;;DM AUDIT CESSATION HLTH FACTOR|0|APCL*BDM

 +15      ;;DM AUDIT DENTAL EXAM ADA CODES|0|APCL*BDM

 +16      ;;DM AUDIT DEPRESSIVE DISORDERS|1|APCL*BDM

 +17      ;;DM AUDIT DIABETES EDUC TOPICS|0|APCL*BDM

 +18      ;;DM AUDIT DIET EDUC TOPICS|0|APCL*BDM

 +19      ;;DM AUDIT EKG CPTS|1|APCL*BDM

 +20      ;;DM AUDIT ESTIMATED GFR LOINC|1|APCL*APCH

 +21      ;;DM AUDIT EXCERCISE EDUC TOPICS|0|APCL*BDM

 +22      ;;DM AUDIT EXERCISE EDUC TOPICS|0|APCL*BDM

 +23      ;;DM AUDIT EYE EXAM DXS|1|APCL*BDM

 +24      ;;DM AUDIT FASTING GLUC LOINC|1|APCL*APCH*BDM

 +25      ;;DM AUDIT FLU CPTS|1|APCL*BDM

 +26      ;;DM AUDIT INSULIN DRUGS|0|APCL*BDM

 +27      ;;DM AUDIT LIPID LOWERING DRUGS|0|APCL*BDM

 +28      ;;DM AUDIT MAMMOGRAM CPTS|1|APCL*BDM

 +29      ;;DM AUDIT METFORMIN DRUGS|0|APCL*BDM

 +30      ;;DM AUDIT ORAL HYPOGLYCEMICS|0|APCL*BDM

 +31      ;;DM AUDIT OTHER EDUC TOPICS|0|APCL*BDM

 +32      ;;DM AUDIT PAP CPTS|1|APCL*BDM

 +33      ;;DM AUDIT PERIDONTAL ADA CODES|0|APCL*BDM

 +34      ;;DM AUDIT PNEUMO CPTS|1|APCL*BDM

 +35      ;;DM AUDIT PRE-DIABETES DXS|1|APCL*BDM*APCH

 +36      ;;DM AUDIT PROBLEM DIABETES DX|1|APCL*BDM

 +37      ;;DM AUDIT PROBLEM HTN DIAGNOSES|1|APCL*BDM

 +38      ;;DM AUDIT PROBLEM SMOKING DXS|1|APCL*BDM

 +39      ;;DM AUDIT PROBLEM TB DXS|1|APCL*BDM

 +40      ;;DM AUDIT SDM PROVIDERS|0|APCL*BDM

 +41      ;;DM AUDIT SELF MONITOR DRUGS|0|APCL*BDM

 +42      ;;DM AUDIT SMOKING CESS EDUC|0|APCL*BDM

 +43      ;;DM AUDIT SMOKING RELATED DXS|1|APCL*BDM

 +44      ;;DM AUDIT STATIN DRUGS|0|APCL*BDM

 +45      ;;DM AUDIT SULFONYLUREA DRUGS|0|APCL*BDM

 +46      ;;DM AUDIT TB HEALTH FACTORS|0|APCL*BDM

 +47      ;;DM AUDIT TD CPTS|1|APCL*BDM

 +48      ;;DM AUDIT TOBACCO HLTH FACTORS|0|APCL*BDM

 +49      ;;DM AUDIT GLITAZONE DRUGS|0|APCL*BDM

 +50      ;;DM AUDIT TYPE I DXS|1|APCL*BDM

 +51      ;;DM AUDIT TYPE II DXS|1|APCL*BDM

 +52      ;;DM AUDIT MICROALBUMIN LOINC CODES|1|APCL*BDM

 +53      ;;DM AUDIT URINALYSIS LOINC|1|APCL*BDM

 +54      ;;DM AUDIT URINE PROTEIN LOINC|1|APCL*BDM

 +55      ;;APCL CAR CNM|0|APCL

 +56      ;;APCL CAR DENTISTS|0|APCL

 +57      ;;APCL CAR FNP|0|APCL

 +58      ;;APCL CAR LCSW|0|APCL

 +59      ;;APCL CAR LVN|0|APCL

 +60      ;;APCL CAR OTHER PROVIDERS|0|APCL

 +61      ;;APCL CAR OTHER2|0|APCL

 +62      ;;APCL CAR PA|0|APCL

 +63      ;;APCL CAR PHYSICIANS|0|APCL

 +64      ;;APCL CAR PSYCHIATRIST|0|APCL

 +65      ;;APCL CAR PSYCHOLOGIST|0|APCL

 +66      ;;APCL CAR PT ED|0|APCL

 +67      ;;APCL CAR RDA|0|APCL

 +68      ;;APCL CAR RN|0|APCL

 +69      ;;

LABTAX    ;;

 +1       ;;APCH HCT/HGB TESTS|0|APCH|1

 +2       ;;BGP QUANT URINE PROTEIN|0|APCL*BDM*BGP|1

 +3       ;;DM AUDIT 2 HR GTT TAX|0|APCL*BDM|1

 +4       ;;DM AUDIT LIPID PROFILE TAX|0|APCL*BDM|1

 +5       ;;DM AUDIT PAP SMEAR TAX|0|APCL*BDM|1

 +6       ;;DM AUDIT URINALYSIS TAX|0|APCL*BDM|1

 +7       ;;