BGP21I.m

BGP21I ;IHS/CMI/LAB-CREATED BY ^ATXSTX ON OCT 14, 2011;

 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 ;;BGP PQA BIGUANIDE NDC

 ;

 ; This routine loads Taxonomy BGP PQA BIGUANIDE NDC

 ;

START ;

 K:'$G(ATXPGMC) ^TMP("ATX",$J)

 S ATXPGMC=$G(ATXPGMC)+1

 F ATXI=1:1 S X=$P($T(TMP+ATXI),";;",2,99) Q:X=""  S X="^TMP(""ATX"",$J,"_X,ATXI=ATXI+1,Y=$P($T(TMP+ATXI),";;",2,99) S @X=Y

 D OTHER

 I $O(^TMP("ATX",$J,3.6,0)) D BULL^ATXSTX2

 I $O(^TMP("ATX",$J,9002226,0)) D TAX^ATXSTX2

 D KILL^ATXSTX2

 Q

 ;

TMP ;;TAXONOMY (WITH BULLETIN)

 ;;21,"00003-4221-11 ")

 ;;897

 ;;21,"00003-4222-16 ")

 ;;895

 ;;21,"00003-4223-11 ")

 ;;896

 ;;21,"00006-0575-52 ")

 ;;906

 ;;21,"00006-0575-61 ")

 ;;907

 ;;21,"00006-0575-62 ")

 ;;908

 ;;21,"00006-0575-82 ")

 ;;909

 ;;21,"00006-0577-52 ")

 ;;899

 ;;21,"00006-0577-61 ")

 ;;900

 ;;21,"00006-0577-62 ")

 ;;901

 ;;21,"00006-0577-82 ")

 ;;902

 ;;21,"00007-3163-18 ")

 ;;1133

 ;;21,"00007-3164-18 ")

 ;;1142

 ;;21,"00007-3166-18 ")

 ;;1130

 ;;21,"00007-3166-20 ")

 ;;1132

 ;;21,"00007-3167-18 ")

 ;;1135

 ;;21,"00007-3167-20 ")

 ;;1141

 ;;21,"00007-3168-18 ")

 ;;1146

 ;;21,"00007-3168-20 ")

 ;;1150

 ;;21,"00087-6060-05 ")

 ;;231

 ;;21,"00087-6060-10 ")

 ;;232

 ;;21,"00087-6063-13 ")

 ;;754

 ;;21,"00087-6064-13 ")

 ;;861

 ;;21,"00087-6070-05 ")

 ;;554

 ;;21,"00087-6071-11 ")

 ;;13

 ;;21,"00087-6072-11 ")

 ;;957

 ;;21,"00087-6073-11 ")

 ;;994

 ;;21,"00087-6074-11 ")

 ;;1040

 ;;21,"00087-6077-31 ")

 ;;934

 ;;21,"00087-6078-31 ")

 ;;951

 ;;21,"00087-6081-31 ")

 ;;914

 ;;21,"00093-1048-01 ")

 ;;233

 ;;21,"00093-1048-05 ")

 ;;539

 ;;21,"00093-1048-10 ")

 ;;234

 ;;21,"00093-1048-19 ")

 ;;235

 ;;21,"00093-1048-93 ")

 ;;236

 ;;21,"00093-1048-98 ")

 ;;237

 ;;21,"00093-1049-01 ")

 ;;555

 ;;21,"00093-1049-05 ")

 ;;737

 ;;21,"00093-1049-10 ")

 ;;556

 ;;21,"00093-1049-19 ")

 ;;698

 ;;21,"00093-1049-93 ")

 ;;699

 ;;21,"00093-1049-98 ")

 ;;557

 ;;21,"00093-5710-01 ")

 ;;958

 ;;21,"00093-5710-05 ")

 ;;959

 ;;21,"00093-5710-19 ")

 ;;980

 ;;21,"00093-5710-83 ")

 ;;982

 ;;21,"00093-5710-93 ")

 ;;981

 ;;21,"00093-5711-01 ")

 ;;995

 ;;21,"00093-5711-05 ")

 ;;996

 ;;21,"00093-5711-19 ")

 ;;997

 ;;21,"00093-5711-93 ")

 ;;998

 ;;21,"00093-5712-01 ")

 ;;1041

 ;;21,"00093-5712-05 ")

 ;;1042

 ;;21,"00093-5712-19 ")

 ;;1098

 ;;21,"00093-5712-93 ")

 ;;1099

 ;;21,"00093-7212-01 ")

 ;;862

 ;;21,"00093-7214-01 ")

 ;;14

 ;;21,"00093-7214-05 ")

 ;;218

 ;;21,"00093-7214-10 ")

 ;;15

 ;;21,"00093-7214-98 ")

 ;;16

 ;;21,"00093-7260-01 ")

 ;;983

 ;;21,"00093-7261-01 ")

 ;;1030

 ;;21,"00093-7261-05 ")

 ;;1031

 ;;21,"00093-7262-01 ")

 ;;1117

 ;;21,"00093-7262-05 ")

 ;;1107

 ;;21,"00093-7267-01 ")

 ;;755

 ;;21,"00093-7267-10 ")

 ;;756

 ;;21,"00093-7455-01 ")

 ;;915

 ;;21,"00093-7456-01 ")

 ;;925

 ;;21,"00093-7457-01 ")

 ;;941

 ;;21,"00169-0092-01 ")

 ;;913

 ;;21,"00169-0093-01 ")

 ;;912

 ;;21,"00172-4330-00 ")

 ;;711

 ;;21,"00172-4330-10 ")

 ;;712

 ;;21,"00172-4330-60 ")

 ;;715

 ;;21,"00172-4330-70 ")

 ;;726

 ;;21,"00172-4330-80 ")

 ;;714

 ;;21,"00172-4331-00 ")

 ;;500

 ;;21,"00172-4331-10 ")

 ;;501

 ;;21,"00172-4331-60 ")

 ;;506

 ;;21,"00172-4331-70 ")

 ;;524

 ;;21,"00172-4331-80 ")

 ;;504

 ;;21,"00172-4331-88 ")

 ;;543

 ;;21,"00172-4432-00 ")

 ;;192

 ;;21,"00172-4432-10 ")

 ;;193

 ;;21,"00172-4432-60 ")

 ;;195

 ;;21,"00172-4432-70 ")

 ;;221

 ;;21,"00172-4432-80 ")

 ;;194

 ;;21,"00172-4435-00 ")

 ;;847

 ;;21,"00172-4435-10 ")

 ;;848

 ;;21,"00172-4435-60 ")

 ;;853

 ;;21,"00172-4435-70 ")

 ;;849

 ;;21,"00172-5710-00 ")

 ;;984

 ;;21,"00172-5710-10 ")

 ;;985

 ;;21,"00172-5710-60 ")

 ;;986

 ;;21,"00172-5710-70 ")

 ;;988

 ;;21,"00172-5710-84 ")

 ;;987

 ;;21,"00172-5711-00 ")

 ;;1032

 ;;21,"00172-5711-10 ")

 ;;1033

 ;;21,"00172-5711-60 ")

 ;;1036

 ;;21,"00172-5711-70 ")

 ;;1037

 ;;21,"00172-5711-88 ")

 ;;1035

 ;;21,"00172-5712-00 ")

 ;;1108

 ;;21,"00172-5712-10 ")

 ;;1109

 ;;21,"00172-5712-60 ")

 ;;1111

 ;;21,"00172-5712-70 ")

 ;;1112

 ;;21,"00172-5712-88 ")

 ;;1110

 ;;21,"00185-0213-01 ")

 ;;517

 ;;21,"00185-0213-05 ")

 ;;518

 ;;21,"00185-0215-01 ")

 ;;721

 ;;21,"00185-0215-05 ")

 ;;722

 ;;21,"00185-0221-01 ")

 ;;203

 ;;21,"00185-0221-05 ")

 ;;204

 ;;21,"00185-4416-01 ")

 ;;757

 ;;21,"00185-4416-05 ")

 ;;844

 ;;21,"00228-2657-11 ")

 ;;540

 ;;21,"00228-2657-50 ")

 ;;541

 ;;21,"00228-2715-11 ")

 ;;739

 ;;21,"00228-2715-50 ")

 ;;740

 ;;21,"00228-2718-11 ")

 ;;219

 ;;21,"00228-2718-50 ")

 ;;220

 ;;21,"00228-2728-11 ")

 ;;877

 ;;21,"00228-2740-11 ")

 ;;859

 ;;21,"00228-2751-11 ")

 ;;960

 ;;21,"00228-2751-50 ")

 ;;961

 ;;21,"00228-2752-11 ")

 ;;999

 ;;21,"00228-2752-50 ")

 ;;1000

 ;;21,"00228-2753-11 ")

 ;;1043

 ;;21,"00228-2753-50 ")

 ;;1044

 ;;21,"00247-1443-30 ")

 ;;238

 ;;21,"00378-0234-01 ")

 ;;239

 ;;21,"00378-0234-05 ")

 ;;240

 ;;21,"00378-0240-01 ")

 ;;558

 ;;21,"00378-0244-01 ")

 ;;17

 ;;21,"00378-0350-01 ")

 ;;863

 ;;21,"00378-0352-01 ")

 ;;758

 ;;21,"00378-0352-05 ")

 ;;759

 ;;21,"00378-3131-01 ")

 ;;916

 ;;21,"00378-3132-01 ")

 ;;926

 ;;21,"00378-3133-01 ")

 ;;942

 ;;21,"00378-7185-05 ")

 ;;241

 ;;21,"00378-7186-05 ")

 ;;559

 ;;21,"00378-7187-05 ")

 ;;18

 ;;21,"00406-2028-01 ")

 ;;242

 ;;21,"00406-2028-05 ")

 ;;243

 ;

OTHER ; OTHER ROUTINES

 D ^BGP21I10

 D ^BGP21I11

 D ^BGP21I12

 D ^BGP21I13

 D ^BGP21I14

 D ^BGP21I15

 D ^BGP21I16

 D ^BGP21I17

 D ^BGP21I18

 D ^BGP21I19

 D ^BGP21I2

 D ^BGP21I20

 D ^BGP21I21

 D ^BGP21I22

 D ^BGP21I23

 D ^BGP21I24

 D ^BGP21I25

 D ^BGP21I26

 D ^BGP21I27

 D ^BGP21I28

 D ^BGP21I29

 D ^BGP21I3

 D ^BGP21I30

 D ^BGP21I31

 D ^BGP21I32

 D ^BGP21I33

 D ^BGP21I34

 D ^BGP21I35

 D ^BGP21I4

 D ^BGP21I5

 D ^BGP21I6

 D ^BGP21I7

 D ^BGP21I8

 D ^BGP21I9

 Q

BGP21I    ;IHS/CMI/LAB-CREATED BY ^ATXSTX ON OCT 14, 2011;

 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 +2       ;;BGP PQA BIGUANIDE NDC

 +3       ;

 +4       ; This routine loads Taxonomy BGP PQA BIGUANIDE NDC

 +5       ;

START     ;

 +1        IF '$GET(ATXPGMC)

               KILL ^TMP("ATX",$JOB)

 +2        SET ATXPGMC=$GET(ATXPGMC)+1

 +3        FOR ATXI=1:1

               SET X=$PIECE($TEXT(TMP+ATXI),";;",2,99)

               IF X=""

                   QUIT 

               SET X="^TMP(""ATX"",$J,"_X

               SET ATXI=ATXI+1

               SET Y=$PIECE($TEXT(TMP+ATXI),";;",2,99)

               SET @X=Y

 +4        DO OTHER

 +5        IF $ORDER(^TMP("ATX",$JOB,3.6,0))

               DO BULL^ATXSTX2

 +6        IF $ORDER(^TMP("ATX",$JOB,9002226,0))

               DO TAX^ATXSTX2

 +7        DO KILL^ATXSTX2

 +8        QUIT 

 +9       ;

TMP       ;;TAXONOMY (WITH BULLETIN)

 +1       ;;21,"00003-4221-11 ")

 +2       ;;897

 +3       ;;21,"00003-4222-16 ")

 +4       ;;895

 +5       ;;21,"00003-4223-11 ")

 +6       ;;896

 +7       ;;21,"00006-0575-52 ")

 +8       ;;906

 +9       ;;21,"00006-0575-61 ")

 +10      ;;907

 +11      ;;21,"00006-0575-62 ")

 +12      ;;908

 +13      ;;21,"00006-0575-82 ")

 +14      ;;909

 +15      ;;21,"00006-0577-52 ")

 +16      ;;899

 +17      ;;21,"00006-0577-61 ")

 +18      ;;900

 +19      ;;21,"00006-0577-62 ")

 +20      ;;901

 +21      ;;21,"00006-0577-82 ")

 +22      ;;902

 +23      ;;21,"00007-3163-18 ")

 +24      ;;1133

 +25      ;;21,"00007-3164-18 ")

 +26      ;;1142

 +27      ;;21,"00007-3166-18 ")

 +28      ;;1130

 +29      ;;21,"00007-3166-20 ")

 +30      ;;1132

 +31      ;;21,"00007-3167-18 ")

 +32      ;;1135

 +33      ;;21,"00007-3167-20 ")

 +34      ;;1141

 +35      ;;21,"00007-3168-18 ")

 +36      ;;1146

 +37      ;;21,"00007-3168-20 ")

 +38      ;;1150

 +39      ;;21,"00087-6060-05 ")

 +40      ;;231

 +41      ;;21,"00087-6060-10 ")

 +42      ;;232

 +43      ;;21,"00087-6063-13 ")

 +44      ;;754

 +45      ;;21,"00087-6064-13 ")

 +46      ;;861

 +47      ;;21,"00087-6070-05 ")

 +48      ;;554

 +49      ;;21,"00087-6071-11 ")

 +50      ;;13

 +51      ;;21,"00087-6072-11 ")

 +52      ;;957

 +53      ;;21,"00087-6073-11 ")

 +54      ;;994

 +55      ;;21,"00087-6074-11 ")

 +56      ;;1040

 +57      ;;21,"00087-6077-31 ")

 +58      ;;934

 +59      ;;21,"00087-6078-31 ")

 +60      ;;951

 +61      ;;21,"00087-6081-31 ")

 +62      ;;914

 +63      ;;21,"00093-1048-01 ")

 +64      ;;233

 +65      ;;21,"00093-1048-05 ")

 +66      ;;539

 +67      ;;21,"00093-1048-10 ")

 +68      ;;234

 +69      ;;21,"00093-1048-19 ")

 +70      ;;235

 +71      ;;21,"00093-1048-93 ")

 +72      ;;236

 +73      ;;21,"00093-1048-98 ")

 +74      ;;237

 +75      ;;21,"00093-1049-01 ")

 +76      ;;555

 +77      ;;21,"00093-1049-05 ")

 +78      ;;737

 +79      ;;21,"00093-1049-10 ")

 +80      ;;556

 +81      ;;21,"00093-1049-19 ")

 +82      ;;698

 +83      ;;21,"00093-1049-93 ")

 +84      ;;699

 +85      ;;21,"00093-1049-98 ")

 +86      ;;557

 +87      ;;21,"00093-5710-01 ")

 +88      ;;958

 +89      ;;21,"00093-5710-05 ")

 +90      ;;959

 +91      ;;21,"00093-5710-19 ")

 +92      ;;980

 +93      ;;21,"00093-5710-83 ")

 +94      ;;982

 +95      ;;21,"00093-5710-93 ")

 +96      ;;981

 +97      ;;21,"00093-5711-01 ")

 +98      ;;995

 +99      ;;21,"00093-5711-05 ")

 +100     ;;996

 +101     ;;21,"00093-5711-19 ")

 +102     ;;997

 +103     ;;21,"00093-5711-93 ")

 +104     ;;998

 +105     ;;21,"00093-5712-01 ")

 +106     ;;1041

 +107     ;;21,"00093-5712-05 ")

 +108     ;;1042

 +109     ;;21,"00093-5712-19 ")

 +110     ;;1098

 +111     ;;21,"00093-5712-93 ")

 +112     ;;1099

 +113     ;;21,"00093-7212-01 ")

 +114     ;;862

 +115     ;;21,"00093-7214-01 ")

 +116     ;;14

 +117     ;;21,"00093-7214-05 ")

 +118     ;;218

 +119     ;;21,"00093-7214-10 ")

 +120     ;;15

 +121     ;;21,"00093-7214-98 ")

 +122     ;;16

 +123     ;;21,"00093-7260-01 ")

 +124     ;;983

 +125     ;;21,"00093-7261-01 ")

 +126     ;;1030

 +127     ;;21,"00093-7261-05 ")

 +128     ;;1031

 +129     ;;21,"00093-7262-01 ")

 +130     ;;1117

 +131     ;;21,"00093-7262-05 ")

 +132     ;;1107

 +133     ;;21,"00093-7267-01 ")

 +134     ;;755

 +135     ;;21,"00093-7267-10 ")

 +136     ;;756

 +137     ;;21,"00093-7455-01 ")

 +138     ;;915

 +139     ;;21,"00093-7456-01 ")

 +140     ;;925

 +141     ;;21,"00093-7457-01 ")

 +142     ;;941

 +143     ;;21,"00169-0092-01 ")

 +144     ;;913

 +145     ;;21,"00169-0093-01 ")

 +146     ;;912

 +147     ;;21,"00172-4330-00 ")

 +148     ;;711

 +149     ;;21,"00172-4330-10 ")

 +150     ;;712

 +151     ;;21,"00172-4330-60 ")

 +152     ;;715

 +153     ;;21,"00172-4330-70 ")

 +154     ;;726

 +155     ;;21,"00172-4330-80 ")

 +156     ;;714

 +157     ;;21,"00172-4331-00 ")

 +158     ;;500

 +159     ;;21,"00172-4331-10 ")

 +160     ;;501

 +161     ;;21,"00172-4331-60 ")

 +162     ;;506

 +163     ;;21,"00172-4331-70 ")

 +164     ;;524

 +165     ;;21,"00172-4331-80 ")

 +166     ;;504

 +167     ;;21,"00172-4331-88 ")

 +168     ;;543

 +169     ;;21,"00172-4432-00 ")

 +170     ;;192

 +171     ;;21,"00172-4432-10 ")

 +172     ;;193

 +173     ;;21,"00172-4432-60 ")

 +174     ;;195

 +175     ;;21,"00172-4432-70 ")

 +176     ;;221

 +177     ;;21,"00172-4432-80 ")

 +178     ;;194

 +179     ;;21,"00172-4435-00 ")

 +180     ;;847

 +181     ;;21,"00172-4435-10 ")

 +182     ;;848

 +183     ;;21,"00172-4435-60 ")

 +184     ;;853

 +185     ;;21,"00172-4435-70 ")

 +186     ;;849

 +187     ;;21,"00172-5710-00 ")

 +188     ;;984

 +189     ;;21,"00172-5710-10 ")

 +190     ;;985

 +191     ;;21,"00172-5710-60 ")

 +192     ;;986

 +193     ;;21,"00172-5710-70 ")

 +194     ;;988

 +195     ;;21,"00172-5710-84 ")

 +196     ;;987

 +197     ;;21,"00172-5711-00 ")

 +198     ;;1032

 +199     ;;21,"00172-5711-10 ")

 +200     ;;1033

 +201     ;;21,"00172-5711-60 ")

 +202     ;;1036

 +203     ;;21,"00172-5711-70 ")

 +204     ;;1037

 +205     ;;21,"00172-5711-88 ")

 +206     ;;1035

 +207     ;;21,"00172-5712-00 ")

 +208     ;;1108

 +209     ;;21,"00172-5712-10 ")

 +210     ;;1109

 +211     ;;21,"00172-5712-60 ")

 +212     ;;1111

 +213     ;;21,"00172-5712-70 ")

 +214     ;;1112

 +215     ;;21,"00172-5712-88 ")

 +216     ;;1110

 +217     ;;21,"00185-0213-01 ")

 +218     ;;517

 +219     ;;21,"00185-0213-05 ")

 +220     ;;518

 +221     ;;21,"00185-0215-01 ")

 +222     ;;721

 +223     ;;21,"00185-0215-05 ")

 +224     ;;722

 +225     ;;21,"00185-0221-01 ")

 +226     ;;203

 +227     ;;21,"00185-0221-05 ")

 +228     ;;204

 +229     ;;21,"00185-4416-01 ")

 +230     ;;757

 +231     ;;21,"00185-4416-05 ")

 +232     ;;844

 +233     ;;21,"00228-2657-11 ")

 +234     ;;540

 +235     ;;21,"00228-2657-50 ")

 +236     ;;541

 +237     ;;21,"00228-2715-11 ")

 +238     ;;739

 +239     ;;21,"00228-2715-50 ")

 +240     ;;740

 +241     ;;21,"00228-2718-11 ")

 +242     ;;219

 +243     ;;21,"00228-2718-50 ")

 +244     ;;220

 +245     ;;21,"00228-2728-11 ")

 +246     ;;877

 +247     ;;21,"00228-2740-11 ")

 +248     ;;859

 +249     ;;21,"00228-2751-11 ")

 +250     ;;960

 +251     ;;21,"00228-2751-50 ")

 +252     ;;961

 +253     ;;21,"00228-2752-11 ")

 +254     ;;999

 +255     ;;21,"00228-2752-50 ")

 +256     ;;1000

 +257     ;;21,"00228-2753-11 ")

 +258     ;;1043

 +259     ;;21,"00228-2753-50 ")

 +260     ;;1044

 +261     ;;21,"00247-1443-30 ")

 +262     ;;238

 +263     ;;21,"00378-0234-01 ")

 +264     ;;239

 +265     ;;21,"00378-0234-05 ")

 +266     ;;240

 +267     ;;21,"00378-0240-01 ")

 +268     ;;558

 +269     ;;21,"00378-0244-01 ")

 +270     ;;17

 +271     ;;21,"00378-0350-01 ")

 +272     ;;863

 +273     ;;21,"00378-0352-01 ")

 +274     ;;758

 +275     ;;21,"00378-0352-05 ")

 +276     ;;759

 +277     ;;21,"00378-3131-01 ")

 +278     ;;916

 +279     ;;21,"00378-3132-01 ")

 +280     ;;926

 +281     ;;21,"00378-3133-01 ")

 +282     ;;942

 +283     ;;21,"00378-7185-05 ")

 +284     ;;241

 +285     ;;21,"00378-7186-05 ")

 +286     ;;559

 +287     ;;21,"00378-7187-05 ")

 +288     ;;18

 +289     ;;21,"00406-2028-01 ")

 +290     ;;242

 +291     ;;21,"00406-2028-05 ")

 +292     ;;243

 +293     ;

OTHER     ; OTHER ROUTINES

 +1        DO ^BGP21I10

 +2        DO ^BGP21I11

 +3        DO ^BGP21I12

 +4        DO ^BGP21I13

 +5        DO ^BGP21I14

 +6        DO ^BGP21I15

 +7        DO ^BGP21I16

 +8        DO ^BGP21I17

 +9        DO ^BGP21I18

 +10       DO ^BGP21I19

 +11       DO ^BGP21I2

 +12       DO ^BGP21I20

 +13       DO ^BGP21I21

 +14       DO ^BGP21I22

 +15       DO ^BGP21I23

 +16       DO ^BGP21I24

 +17       DO ^BGP21I25

 +18       DO ^BGP21I26

 +19       DO ^BGP21I27

 +20       DO ^BGP21I28

 +21       DO ^BGP21I29

 +22       DO ^BGP21I3

 +23       DO ^BGP21I30

 +24       DO ^BGP21I31

 +25       DO ^BGP21I32

 +26       DO ^BGP21I33

 +27       DO ^BGP21I34

 +28       DO ^BGP21I35

 +29       DO ^BGP21I4

 +30       DO ^BGP21I5

 +31       DO ^BGP21I6

 +32       DO ^BGP21I7

 +33       DO ^BGP21I8

 +34       DO ^BGP21I9

 +35       QUIT