Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP1POS1

BGP1POS1.m

Go to the documentation of this file. 
  1. BGP1POS1 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 28 Jan 2005 1:34 PM ;
  1.  ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
  1.  ;
  1.  ;
  1. DRUGS ;EP set up drug taxonomies
  1.  S ATXFLG=1
  1.  S BGPX="BGP CMS WARFARIN MEDS",BGPTAX="",BGPNDCT="" D DRUG1 D
  1.  .S BGPTX=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
  1.  .Q:'BGPTX
  1.  .S A=0,B="" F  S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A  S B=A
  1.  .S BGPC=B
  1.  .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P(^PSDRUG(J,0),U,1) I C["WARFARIN" D
  1.  ..Q:$D(^ATXAX(BGPTX,21,"B",J))
  1.  ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J,^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
  1.  .S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  S BGPX="BGP CMS ACEI MEDS",BGPTAX="BGP CMS ACEI MEDS CLASS",BGPNDCT="" D DRUG1
  1.  S BGPX="BGP CMS BETA BLOCKER MEDS",BGPTAX="BGP CMS BETA BLOCKER CLASS",BGPNDCT="BGP CMS BETA BLOCKER NDC" D DRUG1
  1.  S BGPX="BGP CMS ANTIBIOTIC MEDS",BGPTAX="BGP CMS ANTIBIOTICS MEDS CLASS",BGPNDCT="" D DRUG1
  1.  S BGPX="BGP CMS ARB MEDS",BGPTAX="BGP CMS ARB MEDS CLASS",BGPNDCT="" D DRUG1
  1.  S BGPX="DM AUDIT ASPIRIN DRUGS",BGPTAX="",BGPNDCT="" D DRUG1
  1.  S BGPX="BGP ANTI-PLATELET DRUGS",BGPTAX="BGP CMS ANTI-PLATELET CLASS",BGPNDCT="" D DRUG1
  1.  S BGPX="BGP HEDIS OSTEOPOROSIS DRUGS",BGPTAX="",BGPNDCT="BGP HEDIS OSTEOPOROSIS NDC" D DRUG1
  1.  S BGPX="BGP ASTHMA CONTROLLERS",BGPTAX="",BGPNDCT="BGP ASTHMA CONTROLLER NDC" D DRUG1
  1.  S BGPX="BGP ASTHMA INHALED STEROIDS",BGPTAX="",BGPNDCT="BGP ASTHMA INHALED STEROID NDC" D DRUG1
  1.  S BGPX="BGP ASTHMA LEUKOTRIENE",BGPTAX="",BGPNDCT="BGP ASTHMA LEUKOTRIENE NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ANTIDEPRESSANT MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTIDEPRESSANT NDC" D DRUG1
  1.  S BGPX="BGP RA OA NSAID MEDS",BGPTAX="",BGPNDCT="BGP RA OA NSAID NDC" D DRUG1
  1.  S BGPX="BGP RA GLUCOCORTICOIDS MEDS",BGPTAX="BGP RA GLUCOCORTICOIDS CLASS",BGPNDCT="" D DRUG1
  1.  S BGPX="BGP HEDIS ANTIBIOTICS MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTIBIOTICS NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ASTHMA LEUK MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ASTHMA LEUK NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ASTHMA MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ASTHMA NDC" D DRUG1
  1.  S BGPX="BGP HEDIS PRIMARY ASTHMA MEDS",BGPTAX="",BGPNDCT="BGP HEDIS PRIMARY ASTHMA NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ASTHMA INHALED MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ASTHMA INHALED NDC" D DRUG1
  1.  S BGPX="BGP HEDIS BETA BLOCKER MEDS",BGPTAX="",BGPNDCT="BGP HEDIS BETA BLOCKER NDC" D DRUG1
  1.  S BGPX="BGP RA IM GOLD MEDS",BGPTAX="",BGPNDCT="BGP RA IM GOLD NDC" D DRUG1
  1.  S BGPX="BGP RA AZATHIOPRINE MEDS",BGPTAX="",BGPNDCT="BGP RA AZATHIOPRINE NDC" D DRUG1
  1.  S BGPX="BGP RA LEFLUNOMIDE MEDS",BGPTAX="",BGPNDCT="BGP RA LEFLUNOMIDE NDC" D DRUG1
  1.  S BGPX="BGP RA ORAL GOLD MEDS",BGPTAX="",BGPNDCT="" D DRUG1
  1.  S BGPX="BGP RA CYCLOSPORINE MEDS",BGPTAX="",BGPNDCT="BGP RA CYCLOSPORINE NDC" D DRUG1
  1.  S BGPX="BGP RA METHOTREXATE MEDS",BGPTAX="",BGPNDCT="BGP RA METHOTREXATE NDC" D DRUG1
  1.  S BGPX="BGP RA MYCOPHENOLATE MEDS",BGPTAX="",BGPNDCT="BGP RA MYCOPHENOLATE NDC" D DRUG1
  1.  S BGPX="BGP RA PENICILLAMINE MEDS",BGPTAX="",BGPNDCT="BGP RA PENICILLAMINE NDC" D DRUG1
  1.  S BGPX="BGP RA SULFASALAZINE MEDS",BGPTAX="",BGPNDCT="BGP RA SULFASALAZINE NDC" D DRUG1
  1.  S BGPX="BGP CMS THROMBOLYTIC MEDS",BGPTAX="BGP THROMBOLYTIC AGENT CLASS",BGPNDCT="" D DRUG1
  1.  S BGPX="BGP HEDIS ANTIANXIETY MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTIANXIETY NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ANTIEMETIC MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTIEMETIC NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ANALGESIC MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANALGESIC NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ANTIHISTAMINE MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTIHISTAMINE NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ANTIPSYCHOTIC MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTIPSYCHOTIC NDC" D DRUG1
  1.  S BGPX="BGP HEDIS AMPHETAMINE MEDS",BGPTAX="",BGPNDCT="BGP HEDIS AMPHETAMINE NDC" D DRUG1
  1.  S BGPX="BGP HEDIS BARBITURATE MEDS",BGPTAX="",BGPNDCT="BGP HEDIS BARBITURATE NDC" D DRUG1
  1.  S BGPX="BGP HEDIS BENZODIAZEPINE MEDS",BGPTAX="",BGPNDCT="BGP HEDIS BENZODIAZEPINE NDC" D DRUG1
  1.  ;S BGPX="BGP HEDIS OTHER BENZODIAZEPINE",BGPTAX="",BGPNDCT="BGP HEDIS OTHER BENZO NDC" D DRUG1
  1.  S BGPX="BGP HEDIS CALCIUM CHANNEL MEDS",BGPTAX="",BGPNDCT="BGP HEDIS CALCIUM CHANNEL NDC" D DRUG1
  1.  S BGPX="BGP HEDIS GASTRO ANTISPASM MED",BGPTAX="",BGPNDCT="BGP HEDIS GASTRO ANTISPASM NDC" D DRUG1
  1.  S BGPX="BGP HEDIS BELLADONNA ALKA MEDS",BGPTAX="",BGPNDCT="BGP HEDIS BELLADONNA ALKA NDC" D DRUG1
  1.  S BGPX="BGP HEDIS SKL MUSCLE RELAX MED",BGPTAX="",BGPNDCT="BGP HEDIS SKL MUSCLE RELAX NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ORAL ESTROGEN MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ORAL ESTROGEN NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ORAL HYPOGLYCEMIC RX",BGPTAX="",BGPNDCT="BGP HEDIS ORAL HYPOGLYCEMIC ND" D DRUG1
  1.  S BGPX="BGP HEDIS VASODILATOR MEDS",BGPTAX="",BGPNDCT="BGP HEDIS VASODILATOR NDC" D DRUG1
  1.  S BGPX="BGP HEDIS OTHER MEDS AVOID ELD",BGPTAX="",BGPNDCT="BGP HEDIS OTHER NDC AVOID ELD" D DRUG1
  1.  S BGPX="BGP HEDIS NARCOTIC MEDS",BGPTAX="",BGPNDCT="BGP HEDIS NARCOTIC NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ACEI MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ACEI NDC" D DRUG1
  1.  S BGPX="BGP HEDIS ARB MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ARB NDC" D DRUG1
  1.  S BGPX="BGP HEDIS STATIN MEDS",BGPTAX="",BGPNDCT="BGP HEDIS STATIN NDC" D DRUG1
  1.  ;PQA
  1.  S BGPX="BGP PQA BETA BLOCKER MEDS",BGPTAX="",BGPNDCT="BGP PQA BETA BLOCKER NDC" D DRUG1
  1.  S BGPX="BGP PQA ACEI ARB MEDS",BGPTAX="",BGPNDCT="BGP PQA ACEI ARB NDC" D DRUG1
  1.  S BGPX="BGP PQA CCB MEDS",BGPTAX="",BGPNDCT="BGP PQA CCB NDC" D DRUG1
  1.  S BGPX="BGP PQA BIGUANIDE MEDS",BGPTAX="",BGPNDCT="BGP PQA BIGUANIDE NDC" D DRUG1
  1.  S BGPX="BGP PQA SULFONYLUREA MEDS",BGPTAX="",BGPNDCT="BGP PQA SULFONYLUREA NDC" D DRUG1
  1.  S BGPX="BGP PQA THIAZOLIDINEDIONE MEDS",BGPTAX="",BGPNDCT="BGP PQA THIAZOLIDINEDIONE NDC" D DRUG1
  1.  S BGPX="BGP PQA STATIN MEDS",BGPTAX="",BGPNDCT="BGP PQA STATIN NDC" D DRUG1
  1.  S BGPX="BGP PQA ANTIRETROVIRAL MEDS",BGPTAX="",BGPNDCT="BGP PQA ANTIRETROVIRAL NDC" D DRUG1
  1.  S BGPX="BGP PQA SABA MEDS",BGPTAX="",BGPNDCT="BGP PQA SABA NDC" D DRUG1
  1.  S BGPX="BGP PQA CONTROLLER MEDS",BGPTAX="",BGPNDCT="BGP PQA CONTROLLER NDC" D DRUG1
  1. SM ;
  1.  S ATXFLG=1,BGPX="BGP CMS SMOKING CESSATION MEDS",BGPTAX="",BGPNDCT="BGP CMS SMOKING CESSATION NDC" D DRUG1
  1.  D SMOKING
  1.  ;
  1.  S BGPX="BGP CMS SYSTEMIC CHEMO MEDS",BGPTAX="",BGPNDCT="" D DRUG1
  1.  ;prepopulate this one
  1.  D SYSCHEMO
  1.  S BGPX="BGP CMS IMMUNOSUPPRESSIVE MEDS",BGPTAX="",BGPNDCT="" D DRUG1
  1.  D IMMUNO
  1. FIXA ;TAKE OUT ARB'S FROM ASPIRIN TAXONOMY
  1.  S BGPT=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
  1.  I BGPT D
  1.  .S BGPX=0 F  S BGPX=$O(^ATXAX(BGPT,21,BGPX)) Q:BGPX'=+BGPX  D
  1.  ..S BGPY=$P(^ATXAX(BGPT,21,BGPX,0),U)
  1.  ..I $P($G(^PSDRUG(BGPY,0)),U,2)="CV805" D
  1.  ...K ^ATXAX(BGPT,21,"B",BGPY),^ATXAX(BGPT,21,"AA",BGPY),^ATXAX(BGPT,21,BGPX,0)
  1.  K ATXFLG,BGPX,BGPDA,BGPTX
  1.  Q
  1. DRUG1 ;
  1.  W !,"Creating ",BGPX," Taxonomy..."
  1.  S BGPTX=$O(^ATXAX("B",BGPX,0))
  1.  I 'BGPTX D  Q:Y=-1
  1.  .S X=BGPX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  .I Y=-1 W !!,"ERROR IN CREATING ",BGPX," TAX" Q
  1.  .S BGPTX=+Y,$P(^ATXAX(BGPTX,0),U,2)=BGPX,$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(BGPTX,21,0)="^9002226.02101A^0^0"
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  I $G(BGPTAX)]"" D
  1.  .S A=0,B="" F  S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A  S B=A
  1.  .S BGPC=B
  1.  .S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
  1.  .S Z=$O(^ATXAX("B",BGPTAX,0))
  1.  .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P($G(^PSDRUG(J,0)),U,2) I C]"",$D(^ATXAX(Z,21,"B",C)) D
  1.  ..Q:$D(^ATXAX(BGPTX,21,"B",J))
  1.  ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
  1.  I $G(BGPNDCT)]"" D
  1.  .S A=0,B="" F  S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A  S B=A
  1.  .S BGPC=B
  1.  .S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
  1.  .S Z=$O(^ATXAX("B",BGPNDCT,0))
  1.  .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P($G(^PSDRUG(J,2)),U,4) I C]"",$D(^ATXAX(Z,21,"B",C)) D
  1.  ..Q:$D(^ATXAX(BGPTX,21,"B",J))
  1.  ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. LAB ;EP
  1.  S BGPX=$O(^ATXLAB("B","BGP PCR TAX",0))
  1.  I BGPX S DA=BGPX,DR=".01///BGP HIV VIRAL LOAD TAX",DIE="^ATXLAB(" D ^DIE K DA,DR,DIE,DIV,DIU,DIC
  1.  S BGPX="BGP CD4 TAX" D LAB1
  1.  S BGPX="BGP CHLAMYDIA TESTS TAX" D LAB1
  1.  S BGPX="BGP CMS ABG TESTS" D LAB1
  1.  S BGPX="BGP GPRA ESTIMATED GFR TAX" D LAB1
  1.  S BGPX="BGP GPRA FOB TESTS" D LAB1
  1.  S BGPX="BGP HIV TEST TAX" D LAB1
  1.  S BGPX="BGP HIV VIRAL LOAD TAX" D LAB1
  1.  S BGPX="BGP PAP SMEAR TAX" D LAB1
  1.  S BGPX="DM AUDIT A/C RATIO TAX" D LAB1
  1.  S BGPX="DM AUDIT CHOLESTEROL TAX" D LAB1
  1.  S BGPX="DM AUDIT CREATININE TAX" D LAB1
  1.  S BGPX="DM AUDIT FASTING GLUCOSE TESTS" D LAB1
  1.  S BGPX="DM AUDIT HDL TAX" D LAB1
  1.  S BGPX="DM AUDIT HGB A1C TAX" D LAB1
  1.  S BGPX="DM AUDIT LDL CHOLESTEROL TAX" D LAB1
  1.  S BGPX="DM AUDIT MICROALBUMINURIA TAX" D LAB1
  1.  S BGPX="DM AUDIT TRIGLYCERIDE TAX" D LAB1
  1.  S BGPX="DM AUDIT URINE PROTEIN TAX" D LAB1
  1.  S BGPX="BGP CBC TESTS" D LAB1
  1.  S BGPX="DM AUDIT URINALYSIS TAX" D LAB1
  1.  S BGPX="DM AUDIT AST TAX" D LAB1
  1.  S BGPX="DM AUDIT ALT TAX" D LAB1
  1.  S BGPX="BGP GROUP A STREP TESTS" D LAB1
  1.  S BGPX="BGP LIVER FUNCTION TESTS" D LAB1
  1.  S BGPX="BGP URINE GLUCOSE" D LAB1
  1.  S BGPX="BGP POTASSIUM TESTS" D LAB1
  1.  S BGPX="BGP CMS BLOOD CULTURE" D LAB1
  1.  S BGPX="BGP QUANT URINE PROTEIN" D LAB1
  1.  S BGPX="DM AUDIT GLUCOSE TESTS TAX" D LAB1
  1.  S BGPX="BGP CREATINE KINASE TAX" D LAB1
  1.  Q
  1. LAB1 ;
  1.  S BGPDA=$O(^ATXLAB("B",BGPX,0))
  1.  Q:BGPDA  ;taxonomy already exisits
  1.  W !,"Creating ",BGPX," Taxonomy..."
  1.  S X=BGPX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  I Y=-1 W !!,"ERROR IN CREATING ",BGPX," TAX" Q
  1.  S BGPTX=+Y,$P(^ATXLAB(BGPTX,0),U,2)=BGPX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60
  1.  S ^ATXLAB(BGPTX,21,0)="^9002228.02101PA^0^0"
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. CLTAX ;EP
  1.  W !,"Creating Primary Care Clinics taxonomy..."
  1.  S BGPDA=0 S BGPDA=$O(^ATXAX("B","BGP PRIMARY CARE CLINICS",BGPDA)) I BGPDA S DA=BGPDA S DIK="^ATXAX(" D ^DIK K DA,DIK
  1.  S X="BGP PRIMARY CARE CLINICS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  I Y=-1 W !!,"ERROR IN CREATING BGP PRIMARY CARE CLINICS TAX" Q
  1.  S BGPTX=+Y,$P(^ATXAX(BGPTX,0),U,2)="BGP PRIMARY CARE CLINICS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=172,$P(^(0),U,13)=0,$P(^(0),U,15)=40.7,^ATXAX(BGPTX,21,0)="^9002226.02101A^0^0"
  1.  D ^XBFMK K DIADD,DLAYGO S BGPTEXT="CLINICS" F BGPX=1:1:6 S X=$P($T(@BGPTEXT+BGPX),";;",2),Y=$O(^DIC(40.7,"C",X,0)) I Y D
  1.  .S ^ATXAX(BGPTX,21,BGPX,0)=+Y,$P(^ATXAX(BGPTX,21,0),U,3)=BGPX,$P(^(0),U,4)=BGPX,^ATXAX(BGPTX,21,"AA",+Y,+Y)=""
  1.  .Q
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. PRVTAX ;EP
  1.  S ATXFLG=1
  1.  W !,"Creating Prescribing provider taxonomy..."
  1.  S BGPDA=0 S BGPDA=$O(^ATXAX("B","BGP PRESCRIBING PROVIDER CLASS",BGPDA)) I BGPDA S DA=BGPDA S DIK="^ATXAX(" D ^DIK K DA,DIK
  1.  S X="BGP PRESCRIBING PROVIDER CLASS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  I Y=-1 W !!,"ERROR IN CREATING BGP PRESCRIBING PROVIDER CLASS TAX" Q
  1.  S BGPTX=+Y,$P(^ATXAX(BGPTX,0),U,2)="BGP PRESCRIBING PROVIDER CLASS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=210,$P(^(0),U,13)=0,$P(^(0),U,15)=7,^ATXAX(BGPTX,21,0)="^9002226.02101A^0^0"
  1.  D ^XBFMK K DIADD,DLAYGO S BGPTEXT="PREPROV" F BGPX=1:1:43 S X=$P($T(@BGPTEXT+BGPX),";;",2),Y=$O(^DIC(7,"D",X,0)) I Y D
  1.  .S ^ATXAX(BGPTX,21,BGPX,0)=+Y,$P(^ATXAX(BGPTX,21,0),U,3)=BGPX,$P(^(0),U,4)=BGPX,^ATXAX(BGPTX,21,"AA",+Y,+Y)=""
  1.  .Q
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. SYSCHEMO ;
  1.  S BGPTX=$O(^ATXAX("B","BGP CMS SYSTEMIC CHEMO MEDS",0))
  1.  Q:'BGPTX
  1.  S A=0,B="" F  S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A  S B=A
  1.  S BGPC=B
  1.  S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
  1.  S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  D
  1.  .S C=$P($G(^PSDRUG(J,0)),U,2)
  1.  .I C["AN" D
  1.  ..Q:$D(^ATXAX(BGPTX,21,"B",J))
  1.  ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
  1.  ..S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
  1.  ..Q
  1.  .Q
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1. IMMUNO ;
  1.  S BGPTX=$O(^ATXAX("B","BGP CMS IMMUNOSUPPRESSIVE MEDS",0))
  1.  Q:'BGPTX
  1.  S A=0,B="" F  S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A  S B=A
  1.  S BGPC=B
  1.  S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
  1.  S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  D
  1.  .S C=$P($G(^PSDRUG(J,0)),U,2)
  1.  .I C="IM600"!(C="MS190")!(C="MS109"&($$UP^XLFSTR($P(^PSDRUG(J,0),U))'["HYALURONATE")) D
  1.  ..Q:$D(^ATXAX(BGPTX,21,"B",J))
  1.  ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
  1.  ..S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
  1.  ..Q
  1.  .Q
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1. SMOKING ;
  1.  S BGPTX=$O(^ATXAX("B","BGP CMS SMOKING CESSATION MEDS",0))
  1.  Q:'BGPTX
  1.  S A=0,B="" F  S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A  S B=A
  1.  S BGPC=B
  1.  S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
  1.  S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  D
  1.  .S C=$P($G(^PSDRUG(J,0)),U,1)
  1.  .I C["NICOTINE PATCH"!(C["NICOTINE POLACRILEX")!(C["NICOTINE INHALER")!(C["NICOTINE NASAL SPRAY") D
  1.  ..Q:$D(^ATXAX(BGPTX,21,"B",J))
  1.  ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
  1.  ..S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
  1.  ..Q
  1.  .Q
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1. MHTAX ;EP
  1.  S ATXFLG=1
  1.  W !,"Creating Mental Health provider taxonomy..."
  1.  S BGPDA=0 S BGPDA=$O(^ATXAX("B","BGP MENTAL HEALTH PROV CLASS",BGPDA)) I BGPDA S DA=BGPDA S DIK="^ATXAX(" D ^DIK K DA,DIK
  1.  S X="BGP MENTAL HEALTH PROV CLASS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  I Y=-1 W !!,"ERROR IN CREATING BGP MENTAL HEALTH PROV CLASS TAX" Q
  1.  S BGPTX=+Y,$P(^ATXAX(BGPTX,0),U,2)="BGP MENTAL HEALTH PROV CLASS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=210,$P(^(0),U,13)=0,$P(^(0),U,15)=7,^ATXAX(BGPTX,21,0)="^9002226.02101A^0^0"
  1.  D ^XBFMK K DIADD,DLAYGO S BGPTEXT="MHPROV" F BGPX=1:1:14 S X=$P($T(@BGPTEXT+BGPX),";;",2),Y=$O(^DIC(7,"D",X,0)) I Y D
  1.  .S ^ATXAX(BGPTX,21,BGPX,0)=+Y,$P(^ATXAX(BGPTX,21,0),U,3)=BGPX,$P(^(0),U,4)=BGPX,^ATXAX(BGPTX,21,"AA",+Y,+Y)=""
  1.  .Q
  1.  S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. MHPROV ;
  1.  ;;06
  1.  ;;12
  1.  ;;19
  1.  ;;48
  1.  ;;49
  1.  ;;50
  1.  ;;62
  1.  ;;63
  1.  ;;81
  1.  ;;92
  1.  ;;93
  1.  ;;94
  1.  ;;95
  1.  ;;96
  1.  ;;
  1. CLINICS ;
  1.  ;;01
  1.  ;;06
  1.  ;;13
  1.  ;;20
  1.  ;;24
  1.  ;;28
  1.  ;;
  1. PRVS ;
  1.  ;;00
  1.  ;;11
  1.  ;;16
  1.  ;;17
  1.  ;;18
  1.  ;;21
  1.  ;;25
  1.  ;;33
  1.  ;;41
  1.  ;;44
  1.  ;;45
  1.  ;;49
  1.  ;;64
  1.  ;;68
  1.  ;;69
  1.  ;;70
  1.  ;;71
  1.  ;;72
  1.  ;;73
  1.  ;;74
  1.  ;;75
  1.  ;;76
  1.  ;;77
  1.  ;;78
  1.  ;;79
  1.  ;;80
  1.  ;;81
  1.  ;;82
  1.  ;;83
  1.  ;;84
  1.  ;;85
  1.  ;;86
  1.  ;;A1
  1.  ;;
  1. PREPROV ;;
  1.  ;;00
  1.  ;;08
  1.  ;;11
  1.  ;;16
  1.  ;;17
  1.  ;;18
  1.  ;;21
  1.  ;;24
  1.  ;;25
  1.  ;;30
  1.  ;;33
  1.  ;;41
  1.  ;;44
  1.  ;;45
  1.  ;;47
  1.  ;;49
  1.  ;;64
  1.  ;;67
  1.  ;;68
  1.  ;;70
  1.  ;;71
  1.  ;;72
  1.  ;;73
  1.  ;;74
  1.  ;;75
  1.  ;;76
  1.  ;;77
  1.  ;;78
  1.  ;;79
  1.  ;;80
  1.  ;;81
  1.  ;;82
  1.  ;;83
  1.  ;;85
  1.  ;;86
  1.  ;;A1
  1.  ;;A9
  1.  ;;B1
  1.  ;;B2
  1.  ;;B3
  1.  ;;B4
  1.  ;;B5
  1.  ;;B6
  1.  ;;
  1.  ;