BGP9XXPB.m

BGP9XXPB ; IHS/CMI/LAB -CREATED BY ^ATXSTX ON MAR 25, 2009 ;

 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 ;

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

 Q

 ;

TMP ;;TAXONOMY (WITH BULLETIN)

 ;;9002226.02101,"329,45068-4 ",.02)

 ;;45068-4

 ;;9002226.02101,"329,45069-2 ",.01)

 ;;45069-2

 ;;9002226.02101,"329,45069-2 ",.02)

 ;;45069-2

 ;;9002226.02101,"329,45070-0 ",.01)

 ;;45070-0

 ;;9002226.02101,"329,45070-0 ",.02)

 ;;45070-0

 ;;9002226.02101,"329,45072-6 ",.01)

 ;;45072-6

 ;;9002226.02101,"329,45072-6 ",.02)

 ;;45072-6

 ;;9002226.02101,"329,45074-2 ",.01)

 ;;45074-2

 ;;9002226.02101,"329,45074-2 ",.02)

 ;;45074-2

 ;;9002226.02101,"329,45075-9 ",.01)

 ;;45075-9

 ;;9002226.02101,"329,45075-9 ",.02)

 ;;45075-9

 ;;9002226.02101,"329,45078-3 ",.01)

 ;;45078-3

 ;;9002226.02101,"329,45078-3 ",.02)

 ;;45078-3

 ;;9002226.02101,"329,45079-1 ",.01)

 ;;45079-1

 ;;9002226.02101,"329,45079-1 ",.02)

 ;;45079-1

 ;;9002226.02101,"329,45080-9 ",.01)

 ;;45080-9

 ;;9002226.02101,"329,45080-9 ",.02)

 ;;45080-9

 ;;9002226.02101,"329,45081-7 ",.01)

 ;;45081-7

 ;;9002226.02101,"329,45081-7 ",.02)

 ;;45081-7

 ;;9002226.02101,"329,45082-5 ",.01)

 ;;45082-5

 ;;9002226.02101,"329,45082-5 ",.02)

 ;;45082-5

 ;;9002226.02101,"329,45083-3 ",.01)

 ;;45083-3

 ;;9002226.02101,"329,45083-3 ",.02)

 ;;45083-3

 ;;9002226.02101,"329,45084-1 ",.01)

 ;;45084-1

 ;;9002226.02101,"329,45084-1 ",.02)

 ;;45084-1

 ;;9002226.02101,"329,45089-0 ",.01)

 ;;45089-0

 ;;9002226.02101,"329,45089-0 ",.02)

 ;;45089-0

 ;;9002226.02101,"329,45090-8 ",.01)

 ;;45090-8

 ;;9002226.02101,"329,45090-8 ",.02)

 ;;45090-8

 ;;9002226.02101,"329,45091-6 ",.01)

 ;;45091-6

 ;;9002226.02101,"329,45091-6 ",.02)

 ;;45091-6

 ;;9002226.02101,"329,45093-2 ",.01)

 ;;45093-2

 ;;9002226.02101,"329,45093-2 ",.02)

 ;;45093-2

 ;;9002226.02101,"329,45095-7 ",.01)

 ;;45095-7

 ;;9002226.02101,"329,45095-7 ",.02)

 ;;45095-7

 ;;9002226.02101,"329,45098-1 ",.01)

 ;;45098-1

 ;;9002226.02101,"329,45098-1 ",.02)

 ;;45098-1

 ;;9002226.02101,"329,45100-5 ",.01)

 ;;45100-5

 ;;9002226.02101,"329,45100-5 ",.02)

 ;;45100-5

 ;;9002226.02101,"329,45106-2 ",.01)

 ;;45106-2

 ;;9002226.02101,"329,45106-2 ",.02)

 ;;45106-2

 ;;9002226.02101,"329,45107-0 ",.01)

 ;;45107-0

 ;;9002226.02101,"329,45107-0 ",.02)

 ;;45107-0

 ;;9002226.02101,"329,45108-8 ",.01)

 ;;45108-8

 ;;9002226.02101,"329,45108-8 ",.02)

 ;;45108-8

 ;;9002226.02101,"329,45112-0 ",.01)

 ;;45112-0

 ;;9002226.02101,"329,45112-0 ",.02)

 ;;45112-0

 ;;9002226.02101,"329,557-9 ",.01)

 ;;557-9

 ;;9002226.02101,"329,557-9 ",.02)

 ;;557-9

 ;;9002226.02101,"329,6356-0 ",.01)

 ;;6356-0

 ;;9002226.02101,"329,6356-0 ",.02)

 ;;6356-0

 ;;9002226.02101,"329,6357-8 ",.01)

 ;;6357-8

 ;;9002226.02101,"329,6357-8 ",.02)

 ;;6357-8

BGP9XXPB  ; IHS/CMI/LAB -CREATED BY ^ATXSTX ON MAR 25, 2009 ;

 +1       ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 +2       ;

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        QUIT 

 +5       ;

TMP       ;;TAXONOMY (WITH BULLETIN)

 +1       ;;9002226.02101,"329,45068-4 ",.02)

 +2       ;;45068-4

 +3       ;;9002226.02101,"329,45069-2 ",.01)

 +4       ;;45069-2

 +5       ;;9002226.02101,"329,45069-2 ",.02)

 +6       ;;45069-2

 +7       ;;9002226.02101,"329,45070-0 ",.01)

 +8       ;;45070-0

 +9       ;;9002226.02101,"329,45070-0 ",.02)

 +10      ;;45070-0

 +11      ;;9002226.02101,"329,45072-6 ",.01)

 +12      ;;45072-6

 +13      ;;9002226.02101,"329,45072-6 ",.02)

 +14      ;;45072-6

 +15      ;;9002226.02101,"329,45074-2 ",.01)

 +16      ;;45074-2

 +17      ;;9002226.02101,"329,45074-2 ",.02)

 +18      ;;45074-2

 +19      ;;9002226.02101,"329,45075-9 ",.01)

 +20      ;;45075-9

 +21      ;;9002226.02101,"329,45075-9 ",.02)

 +22      ;;45075-9

 +23      ;;9002226.02101,"329,45078-3 ",.01)

 +24      ;;45078-3

 +25      ;;9002226.02101,"329,45078-3 ",.02)

 +26      ;;45078-3

 +27      ;;9002226.02101,"329,45079-1 ",.01)

 +28      ;;45079-1

 +29      ;;9002226.02101,"329,45079-1 ",.02)

 +30      ;;45079-1

 +31      ;;9002226.02101,"329,45080-9 ",.01)

 +32      ;;45080-9

 +33      ;;9002226.02101,"329,45080-9 ",.02)

 +34      ;;45080-9

 +35      ;;9002226.02101,"329,45081-7 ",.01)

 +36      ;;45081-7

 +37      ;;9002226.02101,"329,45081-7 ",.02)

 +38      ;;45081-7

 +39      ;;9002226.02101,"329,45082-5 ",.01)

 +40      ;;45082-5

 +41      ;;9002226.02101,"329,45082-5 ",.02)

 +42      ;;45082-5

 +43      ;;9002226.02101,"329,45083-3 ",.01)

 +44      ;;45083-3

 +45      ;;9002226.02101,"329,45083-3 ",.02)

 +46      ;;45083-3

 +47      ;;9002226.02101,"329,45084-1 ",.01)

 +48      ;;45084-1

 +49      ;;9002226.02101,"329,45084-1 ",.02)

 +50      ;;45084-1

 +51      ;;9002226.02101,"329,45089-0 ",.01)

 +52      ;;45089-0

 +53      ;;9002226.02101,"329,45089-0 ",.02)

 +54      ;;45089-0

 +55      ;;9002226.02101,"329,45090-8 ",.01)

 +56      ;;45090-8

 +57      ;;9002226.02101,"329,45090-8 ",.02)

 +58      ;;45090-8

 +59      ;;9002226.02101,"329,45091-6 ",.01)

 +60      ;;45091-6

 +61      ;;9002226.02101,"329,45091-6 ",.02)

 +62      ;;45091-6

 +63      ;;9002226.02101,"329,45093-2 ",.01)

 +64      ;;45093-2

 +65      ;;9002226.02101,"329,45093-2 ",.02)

 +66      ;;45093-2

 +67      ;;9002226.02101,"329,45095-7 ",.01)

 +68      ;;45095-7

 +69      ;;9002226.02101,"329,45095-7 ",.02)

 +70      ;;45095-7

 +71      ;;9002226.02101,"329,45098-1 ",.01)

 +72      ;;45098-1

 +73      ;;9002226.02101,"329,45098-1 ",.02)

 +74      ;;45098-1

 +75      ;;9002226.02101,"329,45100-5 ",.01)

 +76      ;;45100-5

 +77      ;;9002226.02101,"329,45100-5 ",.02)

 +78      ;;45100-5

 +79      ;;9002226.02101,"329,45106-2 ",.01)

 +80      ;;45106-2

 +81      ;;9002226.02101,"329,45106-2 ",.02)

 +82      ;;45106-2

 +83      ;;9002226.02101,"329,45107-0 ",.01)

 +84      ;;45107-0

 +85      ;;9002226.02101,"329,45107-0 ",.02)

 +86      ;;45107-0

 +87      ;;9002226.02101,"329,45108-8 ",.01)

 +88      ;;45108-8

 +89      ;;9002226.02101,"329,45108-8 ",.02)

 +90      ;;45108-8

 +91      ;;9002226.02101,"329,45112-0 ",.01)

 +92      ;;45112-0

 +93      ;;9002226.02101,"329,45112-0 ",.02)

 +94      ;;45112-0

 +95      ;;9002226.02101,"329,557-9 ",.01)

 +96      ;;557-9

 +97      ;;9002226.02101,"329,557-9 ",.02)

 +98      ;;557-9

 +99      ;;9002226.02101,"329,6356-0 ",.01)

 +100     ;;6356-0

 +101     ;;9002226.02101,"329,6356-0 ",.02)

 +102     ;;6356-0

 +103     ;;9002226.02101,"329,6357-8 ",.01)

 +104     ;;6357-8

 +105     ;;9002226.02101,"329,6357-8 ",.02)

 +106     ;;6357-8