[628] | 1 | ICD1832U ; ALB/DHH - FY 2008 UPDATE; 7/27/05 14:50;
|
---|
| 2 | ;;18.0;DRG Grouper;**32**;Oct 13,2000;Build 9
|
---|
| 3 | Q
|
---|
| 4 | ;
|
---|
| 5 | DIAG ; - update diagnosis codes
|
---|
| 6 | ; from Table 6A in Fed Reg - assumes new codes already added by Lexicon
|
---|
| 7 | D BMES^XPDUTL(">>>Modifying new diagnosis codes - file 80")
|
---|
| 8 | N LINE,X,ICDDIAG,ENTRY,DA,DIE,DR,IDENT,MDC,MDC25,FDA
|
---|
| 9 | F LINE=1:1 S X=$T(REVD+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
|
---|
| 10 | .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0))
|
---|
| 11 | .I ENTRY D
|
---|
| 12 | ..;check for possible inactive dupe
|
---|
| 13 | ..I $P($G(^ICD9(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I 'ENTRY Q
|
---|
| 14 | ..S DA=ENTRY,DIE="^ICD9("
|
---|
| 15 | ..S IDENT=$P(ICDDIAG,U,2)
|
---|
| 16 | ..S MDC=$P(ICDDIAG,U,3)
|
---|
| 17 | ..;this would only apply to diagnoses who have no other MDC than a pre-MDC
|
---|
| 18 | ..I MDC="PRE" S MDC=98
|
---|
| 19 | ..S MDC25=$P(ICDDIAG,U,4)
|
---|
| 20 | ..S MDC24=$P(ICDDIAG,U,5)
|
---|
| 21 | ..S DR="2///^S X=IDENT;5///^S X=MDC;5.9///^S X=MDC25;5.7///^S X=MDC24"
|
---|
| 22 | ..D ^DIE
|
---|
| 23 | ..Q:$D(^ICD9(ENTRY,4,"B",3071001))
|
---|
| 24 | ..N FDA
|
---|
| 25 | ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
|
---|
| 26 | ..S FDA(1820,80.072,"+3,?1,",.01)=3071001
|
---|
| 27 | ..S FDA(1820,80.072,"+3,?1,",1)=$P(ICDDIAG,U,3)
|
---|
| 28 | ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
|
---|
| 29 | Q
|
---|
| 30 | ;
|
---|
| 31 | REVD ;DIAG^IDEN^MDC^MDC25
|
---|
| 32 | ;;338.4^^1
|
---|
| 33 | ;;040.41^^18
|
---|
| 34 | ;;040.42^^18
|
---|
| 35 | ;;058.10^^18
|
---|
| 36 | ;;058.11^^18
|
---|
| 37 | ;;058.12^^18
|
---|
| 38 | ;;058.81^^9
|
---|
| 39 | ;;058.82^^9
|
---|
| 40 | ;;058.89^^9
|
---|
| 41 | ;;079.83^^18
|
---|
| 42 | ;;233.30^^13
|
---|
| 43 | ;;233.31^^13
|
---|
| 44 | ;;233.32^^13
|
---|
| 45 | ;;233.39^^13
|
---|
| 46 | ;;255.41^^10
|
---|
| 47 | ;;255.42^^10
|
---|
| 48 | ;;258.01^^10
|
---|
| 49 | ;;258.02^^10
|
---|
| 50 | ;;258.03^^10
|
---|
| 51 | ;;288.66^^16
|
---|
| 52 | ;;315.34^^19
|
---|
| 53 | ;;331.5^^1
|
---|
| 54 | ;;359.21^^1
|
---|
| 55 | ;;359.22^^1
|
---|
| 56 | ;;359.23^^1
|
---|
| 57 | ;;359.24^^1
|
---|
| 58 | ;;359.29^^1
|
---|
| 59 | ;;364.81^^2
|
---|
| 60 | ;;364.89^^2
|
---|
| 61 | ;;388.45^^19
|
---|
| 62 | ;;389.05^^3
|
---|
| 63 | ;;389.06^^3
|
---|
| 64 | ;;389.13^^3
|
---|
| 65 | ;;389.17^^3
|
---|
| 66 | ;;389.20^^3
|
---|
| 67 | ;;389.21^^3
|
---|
| 68 | ;;389.22^^3
|
---|
| 69 | ;;414.2^^4
|
---|
| 70 | ;;415.12^^4
|
---|
| 71 | ;;423.3^^5
|
---|
| 72 | ;;440.4^^5
|
---|
| 73 | ;;449.^^5
|
---|
| 74 | ;;488.^^3
|
---|
| 75 | ;;525.71^^3
|
---|
| 76 | ;;525.72^^3
|
---|
| 77 | ;;525.73^^3
|
---|
| 78 | ;;525.79^^3
|
---|
| 79 | ;;569.43^^6
|
---|
| 80 | ;;624.01^^13
|
---|
| 81 | ;;624.02^^13
|
---|
| 82 | ;;624.09^^13
|
---|
| 83 | ;;664.60^^14
|
---|
| 84 | ;;664.61^^14
|
---|
| 85 | ;;664.64^^14
|
---|
| 86 | ;;733.45^^8
|
---|
| 87 | ;;787.20^^6
|
---|
| 88 | ;;787.21^^6
|
---|
| 89 | ;;787.22^^6
|
---|
| 90 | ;;787.23^^6
|
---|
| 91 | ;;787.24^^6
|
---|
| 92 | ;;787.29^^6
|
---|
| 93 | ;;789.51^^23
|
---|
| 94 | ;;789.59^^23
|
---|
| 95 | ;;999.31^^5
|
---|
| 96 | ;;999.39^^18
|
---|
| 97 | ;;V12.53^^23
|
---|
| 98 | ;;V12.54^^23
|
---|
| 99 | ;;V13.22^^17
|
---|
| 100 | ;;V16.52^^23
|
---|
| 101 | ;;V17.41^^23
|
---|
| 102 | ;;V17.49^^23
|
---|
| 103 | ;;V18.11^^23
|
---|
| 104 | ;;V18.19^^23
|
---|
| 105 | ;;V25.04^^23
|
---|
| 106 | ;;V26.41^^23
|
---|
| 107 | ;;V26.49^^23
|
---|
| 108 | ;;V26.81^^23
|
---|
| 109 | ;;V26.89^^23
|
---|
| 110 | ;;V49.85^^23
|
---|
| 111 | ;;V68.01^^23
|
---|
| 112 | ;;V68.09^^23
|
---|
| 113 | ;;V72.12^^23
|
---|
| 114 | ;;V73.81^^23
|
---|
| 115 | ;;V84.81^^23
|
---|
| 116 | ;;V84.89^^23
|
---|
| 117 | ;;EXIT
|
---|