BGPM3AET ;IHS/MSC/MMT-CREATED BY ^ATXSTX ON MAY 31, 2011;
;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
;;BGPMU VTE EXCLUDE-MECH DX
;
; This routine loads Taxonomy BGPMU VTE EXCLUDE-MECH DX
;
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,"286.7 ")
;;8
;;21,"286.9 ")
;;9
;;21,"289.84 ")
;;10
;;21,"431.2 ")
;;11
;;21,"434.91 ")
;;12
;;21,"443.9 ")
;;1
;;21,"459.0 ")
;;13
;;21,"459.9 ")
;;2
;;21,"593.9 ")
;;14
;;21,"790.99 ")
;;15
;;21,"897.6 ")
;;3
;;21,"959.7 ")
;;4
;;21,"995.27 ")
;;16
;;21,"V49.70 ")
;;5
;;21,"V49.75 ")
;;6
;;21,"V49.89 ")
;;7
;;9002226,803,.01)
;;BGPMU VTE EXCLUDE-MECH DX
;;9002226,803,.02)
;;DX codes for no mech VTE
;;9002226,803,.04)
;;@
;;9002226,803,.06)
;;@
;;9002226,803,.08)
;;@
;;9002226,803,.09)
;;@
;;9002226,803,.11)
;;@
;;9002226,803,.12)
;;@
;;9002226,803,.13)
;;@
;;9002226,803,.14)
;;@
;;9002226,803,.15)
;;80
;;9002226,803,.16)
;;@
;;9002226,803,.17)
;;@
;;9002226,803,3101)
;;@
;;9002226.02101,"803,286.7 ",.01)
;;286.7
;;9002226.02101,"803,286.7 ",.02)
;;286.7
;;9002226.02101,"803,286.9 ",.01)
;;286.9
;;9002226.02101,"803,286.9 ",.02)
;;286.9
;;9002226.02101,"803,289.84 ",.01)
;;289.84
;;9002226.02101,"803,289.84 ",.02)
;;289.84
;;9002226.02101,"803,431.2 ",.01)
;;431.2
;;9002226.02101,"803,431.2 ",.02)
;;431.2
;;9002226.02101,"803,434.91 ",.01)
;;434.91
;;9002226.02101,"803,434.91 ",.02)
;;434.91
;;9002226.02101,"803,443.9 ",.01)
;;443.9
;;9002226.02101,"803,443.9 ",.02)
;;443.9
;;9002226.02101,"803,459.0 ",.01)
;;459.0
;;9002226.02101,"803,459.0 ",.02)
;;459.0
;;9002226.02101,"803,459.9 ",.01)
;;459.9
;;9002226.02101,"803,459.9 ",.02)
;;459.9
;;9002226.02101,"803,593.9 ",.01)
;;593.9
;;9002226.02101,"803,593.9 ",.02)
;;593.9
;;9002226.02101,"803,790.99 ",.01)
;;790.99
;;9002226.02101,"803,790.99 ",.02)
;;790.99
;;9002226.02101,"803,897.6 ",.01)
;;897.6
;;9002226.02101,"803,897.6 ",.02)
;;897.7
;;9002226.02101,"803,959.7 ",.01)
;;959.7
;;9002226.02101,"803,959.7 ",.02)
;;959.7
;;9002226.02101,"803,995.27 ",.01)
;;995.27
;;9002226.02101,"803,995.27 ",.02)
;;995.27
;;9002226.02101,"803,V49.70 ",.01)
;;V49.70
;;9002226.02101,"803,V49.70 ",.02)
;;V49.70
;;9002226.02101,"803,V49.75 ",.01)
;;V49.75
;;9002226.02101,"803,V49.75 ",.02)
;;V49.76
;;9002226.02101,"803,V49.89 ",.01)
;;V49.89
;;9002226.02101,"803,V49.89 ",.02)
;;V49.89
;
OTHER ; OTHER ROUTINES
Q
BGPM3AET ;IHS/MSC/MMT-CREATED BY ^ATXSTX ON MAY 31, 2011;
+1 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
+2 ;;BGPMU VTE EXCLUDE-MECH DX
+3 ;
+4 ; This routine loads Taxonomy BGPMU VTE EXCLUDE-MECH DX
+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,"286.7 ")
+2 ;;8
+3 ;;21,"286.9 ")
+4 ;;9
+5 ;;21,"289.84 ")
+6 ;;10
+7 ;;21,"431.2 ")
+8 ;;11
+9 ;;21,"434.91 ")
+10 ;;12
+11 ;;21,"443.9 ")
+12 ;;1
+13 ;;21,"459.0 ")
+14 ;;13
+15 ;;21,"459.9 ")
+16 ;;2
+17 ;;21,"593.9 ")
+18 ;;14
+19 ;;21,"790.99 ")
+20 ;;15
+21 ;;21,"897.6 ")
+22 ;;3
+23 ;;21,"959.7 ")
+24 ;;4
+25 ;;21,"995.27 ")
+26 ;;16
+27 ;;21,"V49.70 ")
+28 ;;5
+29 ;;21,"V49.75 ")
+30 ;;6
+31 ;;21,"V49.89 ")
+32 ;;7
+33 ;;9002226,803,.01)
+34 ;;BGPMU VTE EXCLUDE-MECH DX
+35 ;;9002226,803,.02)
+36 ;;DX codes for no mech VTE
+37 ;;9002226,803,.04)
+38 ;;@
+39 ;;9002226,803,.06)
+40 ;;@
+41 ;;9002226,803,.08)
+42 ;;@
+43 ;;9002226,803,.09)
+44 ;;@
+45 ;;9002226,803,.11)
+46 ;;@
+47 ;;9002226,803,.12)
+48 ;;@
+49 ;;9002226,803,.13)
+50 ;;@
+51 ;;9002226,803,.14)
+52 ;;@
+53 ;;9002226,803,.15)
+54 ;;80
+55 ;;9002226,803,.16)
+56 ;;@
+57 ;;9002226,803,.17)
+58 ;;@
+59 ;;9002226,803,3101)
+60 ;;@
+61 ;;9002226.02101,"803,286.7 ",.01)
+62 ;;286.7
+63 ;;9002226.02101,"803,286.7 ",.02)
+64 ;;286.7
+65 ;;9002226.02101,"803,286.9 ",.01)
+66 ;;286.9
+67 ;;9002226.02101,"803,286.9 ",.02)
+68 ;;286.9
+69 ;;9002226.02101,"803,289.84 ",.01)
+70 ;;289.84
+71 ;;9002226.02101,"803,289.84 ",.02)
+72 ;;289.84
+73 ;;9002226.02101,"803,431.2 ",.01)
+74 ;;431.2
+75 ;;9002226.02101,"803,431.2 ",.02)
+76 ;;431.2
+77 ;;9002226.02101,"803,434.91 ",.01)
+78 ;;434.91
+79 ;;9002226.02101,"803,434.91 ",.02)
+80 ;;434.91
+81 ;;9002226.02101,"803,443.9 ",.01)
+82 ;;443.9
+83 ;;9002226.02101,"803,443.9 ",.02)
+84 ;;443.9
+85 ;;9002226.02101,"803,459.0 ",.01)
+86 ;;459.0
+87 ;;9002226.02101,"803,459.0 ",.02)
+88 ;;459.0
+89 ;;9002226.02101,"803,459.9 ",.01)
+90 ;;459.9
+91 ;;9002226.02101,"803,459.9 ",.02)
+92 ;;459.9
+93 ;;9002226.02101,"803,593.9 ",.01)
+94 ;;593.9
+95 ;;9002226.02101,"803,593.9 ",.02)
+96 ;;593.9
+97 ;;9002226.02101,"803,790.99 ",.01)
+98 ;;790.99
+99 ;;9002226.02101,"803,790.99 ",.02)
+100 ;;790.99
+101 ;;9002226.02101,"803,897.6 ",.01)
+102 ;;897.6
+103 ;;9002226.02101,"803,897.6 ",.02)
+104 ;;897.7
+105 ;;9002226.02101,"803,959.7 ",.01)
+106 ;;959.7
+107 ;;9002226.02101,"803,959.7 ",.02)
+108 ;;959.7
+109 ;;9002226.02101,"803,995.27 ",.01)
+110 ;;995.27
+111 ;;9002226.02101,"803,995.27 ",.02)
+112 ;;995.27
+113 ;;9002226.02101,"803,V49.70 ",.01)
+114 ;;V49.70
+115 ;;9002226.02101,"803,V49.70 ",.02)
+116 ;;V49.70
+117 ;;9002226.02101,"803,V49.75 ",.01)
+118 ;;V49.75
+119 ;;9002226.02101,"803,V49.75 ",.02)
+120 ;;V49.76
+121 ;;9002226.02101,"803,V49.89 ",.01)
+122 ;;V49.89
+123 ;;9002226.02101,"803,V49.89 ",.02)
+124 ;;V49.89
+125 ;
OTHER ; OTHER ROUTINES
+1 QUIT
