- BGP7POS1 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 11 Aug 2016 1:25 PM ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- ;
- DRUGS ;EP set up drug taxonomies
- S ATXFLG=1
- S BGPX=$O(^ATXAX("B","BGP PQA ACEI ARB MEDS",0))
- I BGPX S DA=BGPX,DIE="^ATXAX(",DR=".01///BGP PQA RASA MEDS" D ^DIE K DR,DIE,DA
- S BGPX="BGP CMS ACEI MEDS",BGPTAX="BGP CMS ACEI MEDS CLASS",BGPNDCT="",BGPVAPI="" D DRUG1
- S BGPX="BGP CMS BETA BLOCKER MEDS",BGPTAX="BGP CMS BETA BLOCKER CLASS",BGPNDCT="BGP CMS BETA BLOCKER NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP CMS ANTIBIOTIC MEDS",BGPTAX="BGP CMS ANTIBIOTICS MEDS CLASS",BGPNDCT="",BGPVAPI="" D DRUG1
- S BGPX="BGP CMS ARB MEDS",BGPTAX="BGP CMS ARB MEDS CLASS",BGPNDCT="",BGPVAPI="" D DRUG1
- S BGPX="DM AUDIT ASPIRIN DRUGS",BGPTAX="",BGPNDCT="",BGPVAPI="" D DRUG1
- S BGPX="BGP ANTI-PLATELET DRUGS",BGPTAX="BGP CMS ANTI-PLATELET CLASS",BGPNDCT="",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS OSTEOPOROSIS DRUGS",BGPTAX="",BGPNDCT="BGP HEDIS OSTEOPOROSIS NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP ASTHMA CONTROLLERS",BGPTAX="",BGPNDCT="BGP ASTHMA CONTROLLER NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP ASTHMA INHALED STEROIDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP ASTHMA INHALED STEROID VAP" D DRUG1
- S BGPX="BGP ASTHMA LEUKOTRIENE",BGPTAX="",BGPNDCT="BGP ASTHMA LEUKOTRIENE NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ANTIDEPRESSANT MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTIDEPRESSANT NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP RA OA NSAID MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP RA OA NSAID VAPI" D DRUG1
- S BGPX="BGP RA GLUCOCORTICOIDS MEDS",BGPTAX="BGP RA GLUCOCORTICOIDS CLASS",BGPNDCT="",BGPVAPI="BGP RA GLUCOCORTICOIDS VAPI" D DRUG1
- S BGPX="BGP HEDIS ANTIBIOTICS MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTIBIOTICS NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ASTHMA LEUK MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ASTHMA LEUK NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ASTHMA MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ASTHMA NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS PRIMARY ASTHMA MEDS",BGPTAX="",BGPNDCT="BGP HEDIS PRIMARY ASTHMA NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ASTHMA INHALED MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ASTHMA INHALED NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS BETA BLOCKER MEDS",BGPTAX="",BGPNDCT="BGP HEDIS BETA BLOCKER NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP RA IM GOLD MEDS",BGPTAX="",BGPNDCT="BGP RA IM GOLD NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP RA AZATHIOPRINE MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP RA AZATHIOPRINE VAPI" D DRUG1
- S BGPX="BGP RA LEFLUNOMIDE MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP RA LEFLUNOMIDE VAPI" D DRUG1
- S BGPX="BGP RA ORAL GOLD MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP RA ORAL GOLD VAPI" D DRUG1
- S BGPX="BGP RA CYCLOSPORINE MEDS",BGPTAX="",BGPNDCT="BGP RA CYCLOSPORINE NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP RA METHOTREXATE MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP RA METHOTREXATE VAPI" D DRUG1
- S BGPX="BGP RA MYCOPHENOLATE MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP RA MYCOPHENOLATE VAPI" D DRUG1
- S BGPX="BGP RA PENICILLAMINE MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP RA PENICILLAMINE VAPI" D DRUG1
- S BGPX="BGP RA SULFASALAZINE MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP RA SULFASALAZINE VAPI" D DRUG1
- S BGPX="BGP CMS THROMBOLYTIC MEDS",BGPTAX="BGP THROMBOLYTIC AGENT CLASS",BGPNDCT="",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ANTICHOLINERGIC MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTICHOLINERGIC NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ANTITHROMBOTIC MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTITHROMBOTIC NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ANTI-INFECTIVE MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ANTI-INFECTIVE NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS CARDIOVASCULAR MEDS",BGPTAX="",BGPNDCT="BGP HEDIS CARDIOVASCULAR NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS CENTRAL NERVOUS MEDS",BGPTAX="",BGPNDCT="BGP HEDIS CENTRAL NERVOUS NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS NONBENZODIAZ MEDS",BGPTAX="",BGPNDCT="BGP HEDIS NONBENZODIAZ NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ENDOCRINE MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ENDOCRINE NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS GASTROINTESTINAL MED",BGPTAX="",BGPNDCT="BGP HEDIS GASTROINTESTINAL NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS PAIN MEDS",BGPTAX="",BGPNDCT="BGP HEDIS PAIN NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS SKL MUSCLE RELAX MED",BGPTAX="",BGPNDCT="BGP HEDIS SKL MUSCLE RELAX NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ACEI MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ACEI NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS ARB MEDS",BGPTAX="",BGPNDCT="BGP HEDIS ARB NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP HEDIS STATIN MEDS",BGPTAX="",BGPNDCT="BGP HEDIS STATIN NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP CMS WARFARIN MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP CMS WARFARIN VAPI" D DRUG1
- ;PQA
- S BGPX="BGP PQA BETA BLOCKER MEDS",BGPTAX="",BGPNDCT="BGP PQA BETA BLOCKER NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA RASA MEDS",BGPTAX="",BGPNDCT="BGP PQA RASA NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA CCB MEDS",BGPTAX="",BGPNDCT="BGP PQA CCB NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA BIGUANIDE MEDS",BGPTAX="",BGPNDCT="BGP PQA BIGUANIDE NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA SULFONYLUREA MEDS",BGPTAX="",BGPNDCT="BGP PQA SULFONYLUREA NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA THIAZOLIDINEDIONE MEDS",BGPTAX="",BGPNDCT="BGP PQA THIAZOLIDINEDIONE NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA STATIN MEDS",BGPTAX="",BGPNDCT="BGP PQA STATIN NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA ANTIRETROVIRAL MEDS",BGPTAX="",BGPNDCT="BGP PQA ANTIRETROVIRAL NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA SABA MEDS",BGPTAX="",BGPNDCT="BGP PQA SABA NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA CONTROLLER MEDS",BGPTAX="",BGPNDCT="BGP PQA CONTROLLER NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP ASTHMA LABA MEDS",BGPTAX="",BGPNDCT="BGP ASTHMA LABA NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA DPP IV MEDS",BGPTAX="",BGPNDCT="BGP PQA DPP IV NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA DIABETES ALL CLASS",BGPTAX="",BGPNDCT="BGP PQA DIABETES ALL CLASS NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA NON-WARF ANTICOAG MEDS",BGPTAX="",BGPNDCT="BGP PQA NON-WARF ANTICOAG NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA WARFARIN MEDS",BGPTAX="",BGPNDCT="BGP PQA WARFARIN NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA COPD MEDS",BGPTAX="",BGPNDCT="BGP PQA COPD NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA ASTHMA INHALE STER MED",BGPTAX="",BGPNDCT="BGP PQA ASTHMA INHALE STER NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA BENZODIAZ MEDS",BGPTAX="",BGPNDCT="BGP PQA BENZODIAZ NDC",BGPVAPI="" D DRUG1
- S BGPX="BGP PQA ARB NEPRILYSIN MEDS",BGPTAX="",BGPNDCT="BGP PQA ARB NEPRILYSIN NDC",BGPVAPI="" D DRUG1
- SM ;
- S ATXFLG=1,BGPX="BGP CMS SMOKING CESSATION MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="BGP CMS SMOKING CESSATION VAPI" D DRUG1
- D SMOKING
- ;
- S BGPX="BGP CMS SYSTEMIC CHEMO MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="" D DRUG1
- ;prepopulate this one
- D SYSCHEMO
- S BGPX="BGP CMS IMMUNOSUPPRESSIVE MEDS",BGPTAX="",BGPNDCT="",BGPVAPI="" D DRUG1
- D IMMUNO
- FIXA ;TAKE OUT ARB'S FROM ASPIRIN TAXONOMY
- S BGPT=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
- I BGPT D
- .S BGPX=0 F S BGPX=$O(^ATXAX(BGPT,21,BGPX)) Q:BGPX'=+BGPX D
- ..S BGPY=$P(^ATXAX(BGPT,21,BGPX,0),U)
- ..I $P($G(^PSDRUG(BGPY,0)),U,2)="CV805" D
- ...K ^ATXAX(BGPT,21,"B",BGPY),^ATXAX(BGPT,21,"AA",BGPY),^ATXAX(BGPT,21,BGPX,0)
- K ATXFLG,BGPX,BGPDA,BGPTX
- Q
- DRUG1 ;
- W !,BGPTAX," ",BGPNDCT," ",BGPVAPI
- W !,"Creating ",BGPX," Taxonomy..."
- S BGPTX=$O(^ATXAX("B",BGPX,0))
- I 'BGPTX D Q:Y=-1
- .S X=BGPX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
- .I Y=-1 W !!,"ERROR IN CREATING ",BGPX," TAX" Q
- .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"
- S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
- I $G(BGPTAX)]"" D
- .S A=0,B="" F S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A S B=A
- .S BGPC=B
- .S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- .S Z=$O(^ATXAX("B",BGPTAX,0))
- .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
- ..Q:$D(^ATXAX(BGPTX,21,"B",J))
- ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- I $G(BGPNDCT)]"" D
- .S A=0,B="" F S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A S B=A
- .S BGPC=B
- .S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- .S Z=$O(^ATXAX("B",BGPNDCT,0))
- .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
- ..Q:$D(^ATXAX(BGPTX,21,"B",J))
- ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- I $G(BGPVAPI)]"" D
- .S A=0,B="" F S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A S B=A
- .S BGPC=B
- .S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- .S Z=$O(^ATXAX("B",BGPVAPI,0))
- .S J=0 F S J=$O(^PSDRUG(J)) Q:J'=+J S C=$$VAPI(J,Z) I C]"",$D(^ATXAX(Z,21,"B",C)) D
- ..Q:$D(^ATXAX(BGPTX,21,"B",J))
- ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
- Q
- VAPI(D,B) ;
- NEW A,Y
- S A=$$GET1^DIQ(50,J,22,"I")
- I 'A Q ""
- S Y=$$GET1^DIQ(50.68,A,6)
- Q Y
- ;
- LAB ;EP
- S BGPX=$O(^ATXLAB("B","BGP PCR TAX",0))
- I BGPX S DA=BGPX,DR=".01///BGP HIV VIRAL LOAD TAX",DIE="^ATXLAB(" D ^DIE K DA,DR,DIE,DIV,DIU,DIC
- S BGPX="BGP HEP C CONF TEST TAX" D LAB1
- S BGPX="BGP HEP C TESTS TAX" D LAB1
- S BGPX="BGP CD4 TAX" D LAB1
- S BGPX="BGP CHLAMYDIA TESTS TAX" D LAB1
- S BGPX="BGP CMS ABG TESTS" D LAB1
- S BGPX="BGP GPRA ESTIMATED GFR TAX" D LAB1
- S BGPX="BGP GPRA FOB TESTS" D LAB1
- S BGPX="BGP HIV TEST TAX" D LAB1
- S BGPX="BGP HIV VIRAL LOAD TAX" D LAB1
- S BGPX="BGP PAP SMEAR TAX" D LAB1
- S BGPX="DM AUDIT A/C RATIO TAX" D LAB1
- S BGPX="DM AUDIT CHOLESTEROL TAX" D LAB1
- S BGPX="DM AUDIT CREATININE TAX" D LAB1
- S BGPX="DM AUDIT FASTING GLUCOSE TESTS" D LAB1
- S BGPX="DM AUDIT HDL TAX" D LAB1
- S BGPX="DM AUDIT HGB A1C TAX" D LAB1
- S BGPX="DM AUDIT LDL CHOLESTEROL TAX" D LAB1
- S BGPX="DM AUDIT MICROALBUMINURIA TAX" D LAB1
- S BGPX="DM AUDIT TRIGLYCERIDE TAX" D LAB1
- S BGPX="DM AUDIT URINE PROTEIN TAX" D LAB1
- S BGPX="BGP CBC TESTS" D LAB1
- S BGPX="DM AUDIT URINALYSIS TAX" D LAB1
- S BGPX="DM AUDIT AST TAX" D LAB1
- S BGPX="DM AUDIT ALT TAX" D LAB1
- S BGPX="BGP GROUP A STREP TESTS" D LAB1
- S BGPX="BGP LIVER FUNCTION TESTS" D LAB1
- S BGPX="BGP URINE GLUCOSE" D LAB1
- S BGPX="BGP POTASSIUM TESTS" D LAB1
- S BGPX="BGP CMS BLOOD CULTURE" D LAB1
- S BGPX="BGP QUANT URINE PROTEIN" D LAB1
- S BGPX="DM AUDIT GLUCOSE TESTS TAX" D LAB1
- S BGPX="BGP CREATINE KINASE TAX" D LAB1
- S BGPX="BGP HEP C TESTS TAX" D LAB1
- S BGPX="BGP HPV TESTS TAX" D LAB1
- S BGPX="BGP HIV-1 TEST TAX" D LAB1
- S BGPX="BGP HIV-2 TEST TAX" D LAB1
- S BGPX="BGP QUANT UACR TESTS",BGPPAN=1 D LAB1
- Q
- LAB1 ;
- S BGPDA=$O(^ATXLAB("B",BGPX,0))
- Q:BGPDA ;taxonomy already exists
- W !,"Creating ",BGPX," Taxonomy..."
- S X=BGPX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
- I Y=-1 W !!,"ERROR IN CREATING ",BGPX," TAX" Q
- 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,$P(^(0),U,11)=$G(BGPPAN)
- S ^ATXLAB(BGPTX,21,0)="^9002228.02101PA^0^0"
- S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
- Q
- ;
- CLTAX ;EP
- W !,"Creating Primary Clinics taxonomy..."
- 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
- S X="BGP PRIMARY CARE CLINICS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
- I Y=-1 W !!,"ERROR IN CREATING BGP PRIMARY CARE CLINICS TAX" Q
- 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"
- 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
- .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)=""
- .Q
- S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
- Q
- ;
- ;
- SYSCHEMO ;
- S BGPTX=$O(^ATXAX("B","BGP CMS SYSTEMIC CHEMO MEDS",0))
- Q:'BGPTX
- S A=0,B="" F S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A S B=A
- S BGPC=B
- S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- S J=0 F S J=$O(^PSDRUG(J)) Q:J'=+J D
- .S C=$P($G(^PSDRUG(J,0)),U,2)
- .I C["AN" D
- ..Q:$D(^ATXAX(BGPTX,21,"B",J))
- ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- ..S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
- ..Q
- .Q
- S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
- Q
- IMMUNO ;
- S BGPTX=$O(^ATXAX("B","BGP CMS IMMUNOSUPPRESSIVE MEDS",0))
- Q:'BGPTX
- S A=0,B="" F S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A S B=A
- S BGPC=B
- S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- S J=0 F S J=$O(^PSDRUG(J)) Q:J'=+J D
- .S C=$P($G(^PSDRUG(J,0)),U,2)
- .I C="IM600"!(C="MS190")!(C="MS109"&($$UP^XLFSTR($P(^PSDRUG(J,0),U))'["HYALURONATE")) D
- ..Q:$D(^ATXAX(BGPTX,21,"B",J))
- ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- ..S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
- ..Q
- .Q
- S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
- Q
- SMOKING ;
- S BGPTX=$O(^ATXAX("B","BGP CMS SMOKING CESSATION MEDS",0))
- Q:'BGPTX
- S A=0,B="" F S A=$O(^ATXAX(BGPTX,21,A)) Q:A'=+A S B=A
- S BGPC=B
- S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- S J=0 F S J=$O(^PSDRUG(J)) Q:J'=+J D
- .S C=$P($G(^PSDRUG(J,0)),U,1)
- .I C["NICOTINE PATCH"!(C["NICOTINE POLACRILEX")!(C["NICOTINE INHALER")!(C["NICOTINE NASAL SPRAY") D
- ..Q:$D(^ATXAX(BGPTX,21,"B",J))
- ..S BGPC=BGPC+1,^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- ..S ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
- ..Q
- .Q
- S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
- Q
- ;
- MHPROV ;
- ;;06
- ;;12
- ;;19
- ;;48
- ;;49
- ;;50
- ;;62
- ;;63
- ;;81
- ;;92
- ;;93
- ;;94
- ;;95
- ;;96
- ;;
- CLINICS ;
- ;;01
- ;;06
- ;;13
- ;;20
- ;;24
- ;;28
- ;;
- PRVS ;
- ;;00
- ;;11
- ;;16
- ;;17
- ;;18
- ;;21
- ;;25
- ;;33
- ;;41
- ;;44
- ;;45
- ;;49
- ;;64
- ;;68
- ;;69
- ;;70
- ;;71
- ;;72
- ;;73
- ;;74
- ;;75
- ;;76
- ;;77
- ;;78
- ;;79
- ;;80
- ;;81
- ;;82
- ;;83
- ;;84
- ;;85
- ;;86
- ;;A1
- ;;
- PREPROV ;;
- ;;00
- ;;08
- ;;11
- ;;16
- ;;17
- ;;18
- ;;21
- ;;24
- ;;25
- ;;30
- ;;33
- ;;41
- ;;44
- ;;45
- ;;47
- ;;49
- ;;64
- ;;67
- ;;68
- ;;70
- ;;71
- ;;72
- ;;73
- ;;74
- ;;75
- ;;76
- ;;77
- ;;78
- ;;79
- ;;80
- ;;81
- ;;82
- ;;83
- ;;85
- ;;86
- ;;A1
- ;;A9
- ;;B1
- ;;B2
- ;;B3
- ;;B4
- ;;B5
- ;;B6
- ;;
- ;
- BGP7POS1 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 11 Aug 2016 1:25 PM ;
- +1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- +2 ;
- +3 ;
- DRUGS ;EP set up drug taxonomies
- +1 SET ATXFLG=1
- +2 SET BGPX=$ORDER(^ATXAX("B","BGP PQA ACEI ARB MEDS",0))
- +3 IF BGPX
- SET DA=BGPX
- SET DIE="^ATXAX("
- SET DR=".01///BGP PQA RASA MEDS"
- DO ^DIE
- KILL DR,DIE,DA
- +4 SET BGPX="BGP CMS ACEI MEDS"
- SET BGPTAX="BGP CMS ACEI MEDS CLASS"
- SET BGPNDCT=""
- SET BGPVAPI=""
- DO DRUG1
- +5 SET BGPX="BGP CMS BETA BLOCKER MEDS"
- SET BGPTAX="BGP CMS BETA BLOCKER CLASS"
- SET BGPNDCT="BGP CMS BETA BLOCKER NDC"
- SET BGPVAPI=""
- DO DRUG1
- +6 SET BGPX="BGP CMS ANTIBIOTIC MEDS"
- SET BGPTAX="BGP CMS ANTIBIOTICS MEDS CLASS"
- SET BGPNDCT=""
- SET BGPVAPI=""
- DO DRUG1
- +7 SET BGPX="BGP CMS ARB MEDS"
- SET BGPTAX="BGP CMS ARB MEDS CLASS"
- SET BGPNDCT=""
- SET BGPVAPI=""
- DO DRUG1
- +8 SET BGPX="DM AUDIT ASPIRIN DRUGS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI=""
- DO DRUG1
- +9 SET BGPX="BGP ANTI-PLATELET DRUGS"
- SET BGPTAX="BGP CMS ANTI-PLATELET CLASS"
- SET BGPNDCT=""
- SET BGPVAPI=""
- DO DRUG1
- +10 SET BGPX="BGP HEDIS OSTEOPOROSIS DRUGS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS OSTEOPOROSIS NDC"
- SET BGPVAPI=""
- DO DRUG1
- +11 SET BGPX="BGP ASTHMA CONTROLLERS"
- SET BGPTAX=""
- SET BGPNDCT="BGP ASTHMA CONTROLLER NDC"
- SET BGPVAPI=""
- DO DRUG1
- +12 SET BGPX="BGP ASTHMA INHALED STEROIDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP ASTHMA INHALED STEROID VAP"
- DO DRUG1
- +13 SET BGPX="BGP ASTHMA LEUKOTRIENE"
- SET BGPTAX=""
- SET BGPNDCT="BGP ASTHMA LEUKOTRIENE NDC"
- SET BGPVAPI=""
- DO DRUG1
- +14 SET BGPX="BGP HEDIS ANTIDEPRESSANT MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ANTIDEPRESSANT NDC"
- SET BGPVAPI=""
- DO DRUG1
- +15 SET BGPX="BGP RA OA NSAID MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA OA NSAID VAPI"
- DO DRUG1
- +16 SET BGPX="BGP RA GLUCOCORTICOIDS MEDS"
- SET BGPTAX="BGP RA GLUCOCORTICOIDS CLASS"
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA GLUCOCORTICOIDS VAPI"
- DO DRUG1
- +17 SET BGPX="BGP HEDIS ANTIBIOTICS MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ANTIBIOTICS NDC"
- SET BGPVAPI=""
- DO DRUG1
- +18 SET BGPX="BGP HEDIS ASTHMA LEUK MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ASTHMA LEUK NDC"
- SET BGPVAPI=""
- DO DRUG1
- +19 SET BGPX="BGP HEDIS ASTHMA MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ASTHMA NDC"
- SET BGPVAPI=""
- DO DRUG1
- +20 SET BGPX="BGP HEDIS PRIMARY ASTHMA MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS PRIMARY ASTHMA NDC"
- SET BGPVAPI=""
- DO DRUG1
- +21 SET BGPX="BGP HEDIS ASTHMA INHALED MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ASTHMA INHALED NDC"
- SET BGPVAPI=""
- DO DRUG1
- +22 SET BGPX="BGP HEDIS BETA BLOCKER MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS BETA BLOCKER NDC"
- SET BGPVAPI=""
- DO DRUG1
- +23 SET BGPX="BGP RA IM GOLD MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP RA IM GOLD NDC"
- SET BGPVAPI=""
- DO DRUG1
- +24 SET BGPX="BGP RA AZATHIOPRINE MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA AZATHIOPRINE VAPI"
- DO DRUG1
- +25 SET BGPX="BGP RA LEFLUNOMIDE MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA LEFLUNOMIDE VAPI"
- DO DRUG1
- +26 SET BGPX="BGP RA ORAL GOLD MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA ORAL GOLD VAPI"
- DO DRUG1
- +27 SET BGPX="BGP RA CYCLOSPORINE MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP RA CYCLOSPORINE NDC"
- SET BGPVAPI=""
- DO DRUG1
- +28 SET BGPX="BGP RA METHOTREXATE MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA METHOTREXATE VAPI"
- DO DRUG1
- +29 SET BGPX="BGP RA MYCOPHENOLATE MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA MYCOPHENOLATE VAPI"
- DO DRUG1
- +30 SET BGPX="BGP RA PENICILLAMINE MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA PENICILLAMINE VAPI"
- DO DRUG1
- +31 SET BGPX="BGP RA SULFASALAZINE MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP RA SULFASALAZINE VAPI"
- DO DRUG1
- +32 SET BGPX="BGP CMS THROMBOLYTIC MEDS"
- SET BGPTAX="BGP THROMBOLYTIC AGENT CLASS"
- SET BGPNDCT=""
- SET BGPVAPI=""
- DO DRUG1
- +33 SET BGPX="BGP HEDIS ANTICHOLINERGIC MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ANTICHOLINERGIC NDC"
- SET BGPVAPI=""
- DO DRUG1
- +34 SET BGPX="BGP HEDIS ANTITHROMBOTIC MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ANTITHROMBOTIC NDC"
- SET BGPVAPI=""
- DO DRUG1
- +35 SET BGPX="BGP HEDIS ANTI-INFECTIVE MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ANTI-INFECTIVE NDC"
- SET BGPVAPI=""
- DO DRUG1
- +36 SET BGPX="BGP HEDIS CARDIOVASCULAR MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS CARDIOVASCULAR NDC"
- SET BGPVAPI=""
- DO DRUG1
- +37 SET BGPX="BGP HEDIS CENTRAL NERVOUS MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS CENTRAL NERVOUS NDC"
- SET BGPVAPI=""
- DO DRUG1
- +38 SET BGPX="BGP HEDIS NONBENZODIAZ MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS NONBENZODIAZ NDC"
- SET BGPVAPI=""
- DO DRUG1
- +39 SET BGPX="BGP HEDIS ENDOCRINE MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ENDOCRINE NDC"
- SET BGPVAPI=""
- DO DRUG1
- +40 SET BGPX="BGP HEDIS GASTROINTESTINAL MED"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS GASTROINTESTINAL NDC"
- SET BGPVAPI=""
- DO DRUG1
- +41 SET BGPX="BGP HEDIS PAIN MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS PAIN NDC"
- SET BGPVAPI=""
- DO DRUG1
- +42 SET BGPX="BGP HEDIS SKL MUSCLE RELAX MED"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS SKL MUSCLE RELAX NDC"
- SET BGPVAPI=""
- DO DRUG1
- +43 SET BGPX="BGP HEDIS ACEI MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ACEI NDC"
- SET BGPVAPI=""
- DO DRUG1
- +44 SET BGPX="BGP HEDIS ARB MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS ARB NDC"
- SET BGPVAPI=""
- DO DRUG1
- +45 SET BGPX="BGP HEDIS STATIN MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP HEDIS STATIN NDC"
- SET BGPVAPI=""
- DO DRUG1
- +46 SET BGPX="BGP CMS WARFARIN MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP CMS WARFARIN VAPI"
- DO DRUG1
- +47 ;PQA
- +48 SET BGPX="BGP PQA BETA BLOCKER MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA BETA BLOCKER NDC"
- SET BGPVAPI=""
- DO DRUG1
- +49 SET BGPX="BGP PQA RASA MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA RASA NDC"
- SET BGPVAPI=""
- DO DRUG1
- +50 SET BGPX="BGP PQA CCB MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA CCB NDC"
- SET BGPVAPI=""
- DO DRUG1
- +51 SET BGPX="BGP PQA BIGUANIDE MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA BIGUANIDE NDC"
- SET BGPVAPI=""
- DO DRUG1
- +52 SET BGPX="BGP PQA SULFONYLUREA MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA SULFONYLUREA NDC"
- SET BGPVAPI=""
- DO DRUG1
- +53 SET BGPX="BGP PQA THIAZOLIDINEDIONE MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA THIAZOLIDINEDIONE NDC"
- SET BGPVAPI=""
- DO DRUG1
- +54 SET BGPX="BGP PQA STATIN MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA STATIN NDC"
- SET BGPVAPI=""
- DO DRUG1
- +55 SET BGPX="BGP PQA ANTIRETROVIRAL MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA ANTIRETROVIRAL NDC"
- SET BGPVAPI=""
- DO DRUG1
- +56 SET BGPX="BGP PQA SABA MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA SABA NDC"
- SET BGPVAPI=""
- DO DRUG1
- +57 SET BGPX="BGP PQA CONTROLLER MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA CONTROLLER NDC"
- SET BGPVAPI=""
- DO DRUG1
- +58 SET BGPX="BGP ASTHMA LABA MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP ASTHMA LABA NDC"
- SET BGPVAPI=""
- DO DRUG1
- +59 SET BGPX="BGP PQA DPP IV MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA DPP IV NDC"
- SET BGPVAPI=""
- DO DRUG1
- +60 SET BGPX="BGP PQA DIABETES ALL CLASS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA DIABETES ALL CLASS NDC"
- SET BGPVAPI=""
- DO DRUG1
- +61 SET BGPX="BGP PQA NON-WARF ANTICOAG MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA NON-WARF ANTICOAG NDC"
- SET BGPVAPI=""
- DO DRUG1
- +62 SET BGPX="BGP PQA WARFARIN MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA WARFARIN NDC"
- SET BGPVAPI=""
- DO DRUG1
- +63 SET BGPX="BGP PQA COPD MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA COPD NDC"
- SET BGPVAPI=""
- DO DRUG1
- +64 SET BGPX="BGP PQA ASTHMA INHALE STER MED"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA ASTHMA INHALE STER NDC"
- SET BGPVAPI=""
- DO DRUG1
- +65 SET BGPX="BGP PQA BENZODIAZ MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA BENZODIAZ NDC"
- SET BGPVAPI=""
- DO DRUG1
- +66 SET BGPX="BGP PQA ARB NEPRILYSIN MEDS"
- SET BGPTAX=""
- SET BGPNDCT="BGP PQA ARB NEPRILYSIN NDC"
- SET BGPVAPI=""
- DO DRUG1
- SM ;
- +1 SET ATXFLG=1
- SET BGPX="BGP CMS SMOKING CESSATION MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI="BGP CMS SMOKING CESSATION VAPI"
- DO DRUG1
- +2 DO SMOKING
- +3 ;
- +4 SET BGPX="BGP CMS SYSTEMIC CHEMO MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI=""
- DO DRUG1
- +5 ;prepopulate this one
- +6 DO SYSCHEMO
- +7 SET BGPX="BGP CMS IMMUNOSUPPRESSIVE MEDS"
- SET BGPTAX=""
- SET BGPNDCT=""
- SET BGPVAPI=""
- DO DRUG1
- +8 DO IMMUNO
- FIXA ;TAKE OUT ARB'S FROM ASPIRIN TAXONOMY
- +1 SET BGPT=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
- +2 IF BGPT
- Begin DoDot:1
- +3 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^ATXAX(BGPT,21,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +4 SET BGPY=$PIECE(^ATXAX(BGPT,21,BGPX,0),U)
- +5 IF $PIECE($GET(^PSDRUG(BGPY,0)),U,2)="CV805"
- Begin DoDot:3
- +6 KILL ^ATXAX(BGPT,21,"B",BGPY),^ATXAX(BGPT,21,"AA",BGPY),^ATXAX(BGPT,21,BGPX,0)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +7 KILL ATXFLG,BGPX,BGPDA,BGPTX
- +8 QUIT
- DRUG1 ;
- +1 WRITE !,BGPTAX," ",BGPNDCT," ",BGPVAPI
- +2 WRITE !,"Creating ",BGPX," Taxonomy..."
- +3 SET BGPTX=$ORDER(^ATXAX("B",BGPX,0))
- +4 IF 'BGPTX
- Begin DoDot:1
- +5 SET X=BGPX
- SET DIC="^ATXAX("
- SET DIC(0)="L"
- SET DIADD=1
- SET DLAYGO=9002226
- DO ^DIC
- KILL DIC,DA,DIADD,DLAYGO,I
- +6 IF Y=-1
- WRITE !!,"ERROR IN CREATING ",BGPX," TAX"
- QUIT
- +7 SET BGPTX=+Y
- SET $PIECE(^ATXAX(BGPTX,0),U,2)=BGPX
- 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(BGPTX,21,0)="^9002226.02101A^0^0"
- End DoDot:1
- IF Y=-1
- QUIT
- +8 SET DA=BGPTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +9 IF $GET(BGPTAX)]""
- Begin DoDot:1
- +10 SET A=0
- SET B=""
- FOR
- SET A=$ORDER(^ATXAX(BGPTX,21,A))
- IF A'=+A
- QUIT
- SET B=A
- +11 SET BGPC=B
- +12 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- +13 SET Z=$ORDER(^ATXAX("B",BGPTAX,0))
- +14 SET J=0
- FOR
- SET J=$ORDER(^PSDRUG(J))
- IF J'=+J
- QUIT
- SET C=$PIECE($GET(^PSDRUG(J,0)),U,2)
- IF C]""
- IF $DATA(^ATXAX(Z,21,"B",C))
- Begin DoDot:2
- +15 IF $DATA(^ATXAX(BGPTX,21,"B",J))
- QUIT
- +16 SET BGPC=BGPC+1
- SET ^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- End DoDot:2
- End DoDot:1
- +17 IF $GET(BGPNDCT)]""
- Begin DoDot:1
- +18 SET A=0
- SET B=""
- FOR
- SET A=$ORDER(^ATXAX(BGPTX,21,A))
- IF A'=+A
- QUIT
- SET B=A
- +19 SET BGPC=B
- +20 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- +21 SET Z=$ORDER(^ATXAX("B",BGPNDCT,0))
- +22 SET J=0
- FOR
- SET J=$ORDER(^PSDRUG(J))
- IF J'=+J
- QUIT
- SET C=$PIECE($GET(^PSDRUG(J,2)),U,4)
- IF C]""
- IF $DATA(^ATXAX(Z,21,"B",C))
- Begin DoDot:2
- +23 IF $DATA(^ATXAX(BGPTX,21,"B",J))
- QUIT
- +24 SET BGPC=BGPC+1
- SET ^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- End DoDot:2
- End DoDot:1
- +25 IF $GET(BGPVAPI)]""
- Begin DoDot:1
- +26 SET A=0
- SET B=""
- FOR
- SET A=$ORDER(^ATXAX(BGPTX,21,A))
- IF A'=+A
- QUIT
- SET B=A
- +27 SET BGPC=B
- +28 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- +29 SET Z=$ORDER(^ATXAX("B",BGPVAPI,0))
- +30 SET J=0
- FOR
- SET J=$ORDER(^PSDRUG(J))
- IF J'=+J
- QUIT
- SET C=$$VAPI(J,Z)
- IF C]""
- IF $DATA(^ATXAX(Z,21,"B",C))
- Begin DoDot:2
- +31 IF $DATA(^ATXAX(BGPTX,21,"B",J))
- QUIT
- +32 SET BGPC=BGPC+1
- SET ^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- End DoDot:2
- End DoDot:1
- +33 SET DA=BGPTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +34 QUIT
- VAPI(D,B) ;
- +1 NEW A,Y
- +2 SET A=$$GET1^DIQ(50,J,22,"I")
- +3 IF 'A
- QUIT ""
- +4 SET Y=$$GET1^DIQ(50.68,A,6)
- +5 QUIT Y
- +6 ;
- LAB ;EP
- +1 SET BGPX=$ORDER(^ATXLAB("B","BGP PCR TAX",0))
- +2 IF BGPX
- SET DA=BGPX
- SET DR=".01///BGP HIV VIRAL LOAD TAX"
- SET DIE="^ATXLAB("
- DO ^DIE
- KILL DA,DR,DIE,DIV,DIU,DIC
- +3 SET BGPX="BGP HEP C CONF TEST TAX"
- DO LAB1
- +4 SET BGPX="BGP HEP C TESTS TAX"
- DO LAB1
- +5 SET BGPX="BGP CD4 TAX"
- DO LAB1
- +6 SET BGPX="BGP CHLAMYDIA TESTS TAX"
- DO LAB1
- +7 SET BGPX="BGP CMS ABG TESTS"
- DO LAB1
- +8 SET BGPX="BGP GPRA ESTIMATED GFR TAX"
- DO LAB1
- +9 SET BGPX="BGP GPRA FOB TESTS"
- DO LAB1
- +10 SET BGPX="BGP HIV TEST TAX"
- DO LAB1
- +11 SET BGPX="BGP HIV VIRAL LOAD TAX"
- DO LAB1
- +12 SET BGPX="BGP PAP SMEAR TAX"
- DO LAB1
- +13 SET BGPX="DM AUDIT A/C RATIO TAX"
- DO LAB1
- +14 SET BGPX="DM AUDIT CHOLESTEROL TAX"
- DO LAB1
- +15 SET BGPX="DM AUDIT CREATININE TAX"
- DO LAB1
- +16 SET BGPX="DM AUDIT FASTING GLUCOSE TESTS"
- DO LAB1
- +17 SET BGPX="DM AUDIT HDL TAX"
- DO LAB1
- +18 SET BGPX="DM AUDIT HGB A1C TAX"
- DO LAB1
- +19 SET BGPX="DM AUDIT LDL CHOLESTEROL TAX"
- DO LAB1
- +20 SET BGPX="DM AUDIT MICROALBUMINURIA TAX"
- DO LAB1
- +21 SET BGPX="DM AUDIT TRIGLYCERIDE TAX"
- DO LAB1
- +22 SET BGPX="DM AUDIT URINE PROTEIN TAX"
- DO LAB1
- +23 SET BGPX="BGP CBC TESTS"
- DO LAB1
- +24 SET BGPX="DM AUDIT URINALYSIS TAX"
- DO LAB1
- +25 SET BGPX="DM AUDIT AST TAX"
- DO LAB1
- +26 SET BGPX="DM AUDIT ALT TAX"
- DO LAB1
- +27 SET BGPX="BGP GROUP A STREP TESTS"
- DO LAB1
- +28 SET BGPX="BGP LIVER FUNCTION TESTS"
- DO LAB1
- +29 SET BGPX="BGP URINE GLUCOSE"
- DO LAB1
- +30 SET BGPX="BGP POTASSIUM TESTS"
- DO LAB1
- +31 SET BGPX="BGP CMS BLOOD CULTURE"
- DO LAB1
- +32 SET BGPX="BGP QUANT URINE PROTEIN"
- DO LAB1
- +33 SET BGPX="DM AUDIT GLUCOSE TESTS TAX"
- DO LAB1
- +34 SET BGPX="BGP CREATINE KINASE TAX"
- DO LAB1
- +35 SET BGPX="BGP HEP C TESTS TAX"
- DO LAB1
- +36 SET BGPX="BGP HPV TESTS TAX"
- DO LAB1
- +37 SET BGPX="BGP HIV-1 TEST TAX"
- DO LAB1
- +38 SET BGPX="BGP HIV-2 TEST TAX"
- DO LAB1
- +39 SET BGPX="BGP QUANT UACR TESTS"
- SET BGPPAN=1
- DO LAB1
- +40 QUIT
- LAB1 ;
- +1 SET BGPDA=$ORDER(^ATXLAB("B",BGPX,0))
- +2 ;taxonomy already exists
- IF BGPDA
- QUIT
- +3 WRITE !,"Creating ",BGPX," Taxonomy..."
- +4 SET X=BGPX
- 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 ",BGPX," TAX"
- QUIT
- +6 SET BGPTX=+Y
- SET $PIECE(^ATXLAB(BGPTX,0),U,2)=BGPX
- 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 $PIECE(^(0),U,11)=$GET(BGPPAN)
- +7 SET ^ATXLAB(BGPTX,21,0)="^9002228.02101PA^0^0"
- +8 SET DA=BGPTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +9 QUIT
- +10 ;
- CLTAX ;EP
- +1 WRITE !,"Creating Primary Clinics taxonomy..."
- +2 SET BGPDA=0
- SET BGPDA=$ORDER(^ATXAX("B","BGP PRIMARY CARE CLINICS",BGPDA))
- IF BGPDA
- SET DA=BGPDA
- SET DIK="^ATXAX("
- DO ^DIK
- KILL DA,DIK
- +3 SET X="BGP PRIMARY CARE CLINICS"
- 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 BGP PRIMARY CARE CLINICS TAX"
- QUIT
- +5 SET BGPTX=+Y
- SET $PIECE(^ATXAX(BGPTX,0),U,2)="BGP PRIMARY CARE CLINICS"
- SET $PIECE(^(0),U,5)=DUZ
- SET $PIECE(^(0),U,8)=0
- SET $PIECE(^(0),U,9)=DT
- SET $PIECE(^(0),U,12)=172
- SET $PIECE(^(0),U,13)=0
- SET $PIECE(^(0),U,15)=40.7
- SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^0^0"
- +6 DO ^XBFMK
- KILL DIADD,DLAYGO
- SET BGPTEXT="CLINICS"
- FOR BGPX=1:1:6
- SET X=$PIECE($TEXT(@BGPTEXT+BGPX),";;",2)
- SET Y=$ORDER(^DIC(40.7,"C",X,0))
- IF Y
- Begin DoDot:1
- +7 SET ^ATXAX(BGPTX,21,BGPX,0)=+Y
- SET $PIECE(^ATXAX(BGPTX,21,0),U,3)=BGPX
- SET $PIECE(^(0),U,4)=BGPX
- SET ^ATXAX(BGPTX,21,"AA",+Y,+Y)=""
- +8 QUIT
- End DoDot:1
- +9 SET DA=BGPTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +10 QUIT
- +11 ;
- +12 ;
- SYSCHEMO ;
- +1 SET BGPTX=$ORDER(^ATXAX("B","BGP CMS SYSTEMIC CHEMO MEDS",0))
- +2 IF 'BGPTX
- QUIT
- +3 SET A=0
- SET B=""
- FOR
- SET A=$ORDER(^ATXAX(BGPTX,21,A))
- IF A'=+A
- QUIT
- SET B=A
- +4 SET BGPC=B
- +5 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- +6 SET J=0
- FOR
- SET J=$ORDER(^PSDRUG(J))
- IF J'=+J
- QUIT
- Begin DoDot:1
- +7 SET C=$PIECE($GET(^PSDRUG(J,0)),U,2)
- +8 IF C["AN"
- Begin DoDot:2
- +9 IF $DATA(^ATXAX(BGPTX,21,"B",J))
- QUIT
- +10 SET BGPC=BGPC+1
- SET ^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- +11 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 SET DA=BGPTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +15 QUIT
- IMMUNO ;
- +1 SET BGPTX=$ORDER(^ATXAX("B","BGP CMS IMMUNOSUPPRESSIVE MEDS",0))
- +2 IF 'BGPTX
- QUIT
- +3 SET A=0
- SET B=""
- FOR
- SET A=$ORDER(^ATXAX(BGPTX,21,A))
- IF A'=+A
- QUIT
- SET B=A
- +4 SET BGPC=B
- +5 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- +6 SET J=0
- FOR
- SET J=$ORDER(^PSDRUG(J))
- IF J'=+J
- QUIT
- Begin DoDot:1
- +7 SET C=$PIECE($GET(^PSDRUG(J,0)),U,2)
- +8 IF C="IM600"!(C="MS190")!(C="MS109"&($$UP^XLFSTR($PIECE(^PSDRUG(J,0),U))'["HYALURONATE"))
- Begin DoDot:2
- +9 IF $DATA(^ATXAX(BGPTX,21,"B",J))
- QUIT
- +10 SET BGPC=BGPC+1
- SET ^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- +11 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 SET DA=BGPTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +15 QUIT
- SMOKING ;
- +1 SET BGPTX=$ORDER(^ATXAX("B","BGP CMS SMOKING CESSATION MEDS",0))
- +2 IF 'BGPTX
- QUIT
- +3 SET A=0
- SET B=""
- FOR
- SET A=$ORDER(^ATXAX(BGPTX,21,A))
- IF A'=+A
- QUIT
- SET B=A
- +4 SET BGPC=B
- +5 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_B_U_B
- +6 SET J=0
- FOR
- SET J=$ORDER(^PSDRUG(J))
- IF J'=+J
- QUIT
- Begin DoDot:1
- +7 SET C=$PIECE($GET(^PSDRUG(J,0)),U,1)
- +8 IF C["NICOTINE PATCH"!(C["NICOTINE POLACRILEX")!(C["NICOTINE INHALER")!(C["NICOTINE NASAL SPRAY")
- Begin DoDot:2
- +9 IF $DATA(^ATXAX(BGPTX,21,"B",J))
- QUIT
- +10 SET BGPC=BGPC+1
- SET ^ATXAX(BGPTX,21,BGPC,0)=J_U_J
- +11 SET ^ATXAX(BGPTX,21,0)="^9002226.02101A^"_BGPC_U_BGPC
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 SET DA=BGPTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +15 QUIT
- +16 ;
- MHPROV ;
- +1 ;;06
- +2 ;;12
- +3 ;;19
- +4 ;;48
- +5 ;;49
- +6 ;;50
- +7 ;;62
- +8 ;;63
- +9 ;;81
- +10 ;;92
- +11 ;;93
- +12 ;;94
- +13 ;;95
- +14 ;;96
- +15 ;;
- CLINICS ;
- +1 ;;01
- +2 ;;06
- +3 ;;13
- +4 ;;20
- +5 ;;24
- +6 ;;28
- +7 ;;
- PRVS ;
- +1 ;;00
- +2 ;;11
- +3 ;;16
- +4 ;;17
- +5 ;;18
- +6 ;;21
- +7 ;;25
- +8 ;;33
- +9 ;;41
- +10 ;;44
- +11 ;;45
- +12 ;;49
- +13 ;;64
- +14 ;;68
- +15 ;;69
- +16 ;;70
- +17 ;;71
- +18 ;;72
- +19 ;;73
- +20 ;;74
- +21 ;;75
- +22 ;;76
- +23 ;;77
- +24 ;;78
- +25 ;;79
- +26 ;;80
- +27 ;;81
- +28 ;;82
- +29 ;;83
- +30 ;;84
- +31 ;;85
- +32 ;;86
- +33 ;;A1
- +34 ;;
- PREPROV ;;
- +1 ;;00
- +2 ;;08
- +3 ;;11
- +4 ;;16
- +5 ;;17
- +6 ;;18
- +7 ;;21
- +8 ;;24
- +9 ;;25
- +10 ;;30
- +11 ;;33
- +12 ;;41
- +13 ;;44
- +14 ;;45
- +15 ;;47
- +16 ;;49
- +17 ;;64
- +18 ;;67
- +19 ;;68
- +20 ;;70
- +21 ;;71
- +22 ;;72
- +23 ;;73
- +24 ;;74
- +25 ;;75
- +26 ;;76
- +27 ;;77
- +28 ;;78
- +29 ;;79
- +30 ;;80
- +31 ;;81
- +32 ;;82
- +33 ;;83
- +34 ;;85
- +35 ;;86
- +36 ;;A1
- +37 ;;A9
- +38 ;;B1
- +39 ;;B2
- +40 ;;B3
- +41 ;;B4
- +42 ;;B5
- +43 ;;B6
- +44 ;;
- +45 ;
