ICD1824C   ; ALB/JAT - FY 2007 UPDATE; 7/27/05 14:50;
 ;;18.0;DRG Grouper;**24**;Oct 13,2000;Build 5
 Q
 ;
DIAG ; - update diagnosis codes
 ; from Table 6A in Fed Reg - assumes new codes already added by Lexicon
 D BMES^XPDUTL(">>>Modifying new diagnosis codes - file 80")
 N LINE,X,ICDDIAG,ENTRY,DA,DIE,DR,IDENT,MDC,MDC25,FDA
 F LINE=1:1 S X=$T(REVD+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT"  D
 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0))
 .I ENTRY D
    ..;check for possible inactive dupe
 ..I $P($G(^ICD9(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I 'ENTRY Q 
 ..S DA=ENTRY,DIE="^ICD9("
 ..S IDENT=$P(ICDDIAG,U,2)
 ..S MDC=$P(ICDDIAG,U,3)
 ..;this would only apply to diagnoses who have no other MDC than a pre-MDC
 ..I MDC="PRE" S MDC=98
 ..S MDC25=$P(ICDDIAG,U,4)
 ..S DR="2///^S X=IDENT;5///^S X=MDC;5.9///^S X=MDC25"
 ..D ^DIE
 ..;check if already created in case patch being re-installed
 ..Q:$D(^ICD9(ENTRY,3,"B",3061001))
 ..; add 80.071 and 80.711 and 80.072 records
 ..N FDA
 ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
 ..S FDA(1820,80.071,"+2,?1,",.01)=3061001
 ..S FDA(1820,80.072,"+3,?1,",.01)=3061001
 ..S FDA(1820,80.072,"+3,?1,",1)=$P(ICDDIAG,U,3)
 ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
 ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
 ..S FDA(1820,80.071,"?2,?1,",.01)=3061001
 ..S FDA(1820,80.711,"+3,?2,?1,",.01)=$P(ICDDIAG,U,5)
 ..I $P(ICDDIAG,U,6) S FDA(1820,80.711,"+4,?2,?1,",.01)=$P(ICDDIAG,U,6)
 ..I $P(ICDDIAG,U,7) S FDA(1820,80.711,"+5,?2,?1,",.01)=$P(ICDDIAG,U,7)
 ..I $P(ICDDIAG,U,8) S FDA(1820,80.711,"+6,?2,?1,",.01)=$P(ICDDIAG,U,8)
 ..I $P(ICDDIAG,U,9) S FDA(1820,80.711,"+7,?2,?1,",.01)=$P(ICDDIAG,U,9)
 ..I $P(ICDDIAG,U,10) S FDA(1820,80.711,"+8,?2,?1,",.01)=$P(ICDDIAG,U,10)
 ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
 Q
 ;
REVD ;
 ;;052.2^Q^1^^543^561
 ;;053.14^Q^1^^543^561
 ;;054.74^Q^1^^543^561
 ;;238.71^^16^^398^399
 ;;238.72^^16^^395^396
 ;;238.73^^16^^395^396
 ;;238.74^^16^^395^396
 ;;238.75^^16^^395^396
 ;;238.76^^17^^401^402^403^404^539^540
 ;;238.79^^17^^401^402^403^404^539^540
 ;;277.30^^8^^240^241
 ;;277.31^^8^^240^241
 ;;277.39^^8^^240^241
 ;;284.01^^16^^574
 ;;284.09^^16^^574
 ;;284.1^^16^^395^396
 ;;284.2^^17^^401^402^403^404^539^540
 ;;288.00^^16^3^574^490
 ;;288.01^^16^3^574^490
 ;;288.02^^16^3^574^490
 ;;288.03^^16^3^574^490
 ;;288.04^^16^3^574^490
 ;;288.09^^16^3^574^490
 ;;288.4^^16^^398^399
 ;;288.50^^16^^398^399
 ;;288.51^^16^^398^399
 ;;288.59^^16^^398^399
 ;;288.60^^16^^398^398
 ;;288.61^^16^^398^398
 ;;288.62^^16^^398^398
 ;;288.63^^16^^398^398
 ;;288.64^^16^^398^398
 ;;288.65^^16^^398^398
 ;;288.69^^16^^398^398
 ;;289.53^^16^^398^399
 ;;289.83^^17^^401^402^403^404^539^540
 ;;323.01^Q^1^^543^561
 ;;323.02^Q^1^^543^561
 ;;323.41^Q^1^^543^561
 ;;323.42^Q^1^^543^561
 ;;323.51^Q^1^^543^561
 ;;323.52^Q^1^^543^561
 ;;323.61^Q^1^^543^561
 ;;323.62^Q^1^^543^561
 ;;323.63^Q^1^^543^561
 ;;323.71^Q^1^^34^35^543
 ;;323.72^Q^1^^34^35^543
 ;;323.81^Q^1^3^543^561^489
 ;;323.82^Q^1^3^543^561^489
 ;;331.83^^1^^12
 ;;333.71^^1^^12
 ;;333.72^^1^^34^35
 ;;333.79^^1^^34^35
 ;;333.85^^1^^34^35
 ;;333.94^^1^^12
 ;;338.0^^23^^463^464
 ;;338.11^^23^^463^464
 ;;338.12^^23^^463^464
 ;;338.18^^23^^463^464
 ;;338.19^^23^^463^464
 ;;338.21^^23^^463^464
 ;;338.22^^23^^463^464
 ;;338.28^^23^^463^464
 ;;338.29^^23^^463^464
 ;;338.3^^23^^463^464
 ;;338.4^^23^^463^464
 ;;341.20^^1^^543^561
 ;;341.21^^1^^543^561
 ;;341.22^^1^^543^561
 ;;377.43^^2^^45
 ;;379.60^^2^^46^47^48
 ;;379.61^^2^^46^47^48
 ;;379.62^^2^^46^47^48
 ;;379.63^^2^^46^47^48
 ;;389.15^^3^^73^74
 ;;389.16^^3^^73^74
 ;;429.83^^5^^144^145
 ;;478.11^^3^^73^74
 ;;478.19^^3^^73^74
 ;;518.7^^4^^101^102
 ;;519.11^Y^4^^96^97^98
 ;;519.19^Y^4^^96^97^98
 ;;521.81^Y^3^^185^186^187
 ;;521.89^Y^3^^185^186^187
 ;;523.00^Y^3^^185^186^187
 ;;523.01^Y^3^^185^186^187
 ;;523.10^Y^3^^185^186^187
 ;;523.11^Y^3^^185^186^187
 ;;523.30^Y^3^^185^186^187
 ;;523.31^Y^3^^185^186^187
 ;;523.32^Y^3^^185^186^187
 ;;523.33^Y^3^^185^186^187
 ;;523.40^Y^3^^185^186^187
 ;;523.41^Y^3^^185^186^187
 ;;523.42^Y^3^^185^186^187
 ;;525.60^Y^3^^185^186^187
 ;;525.61^Y^3^^185^186^187
 ;;525.62^Y^3^^185^186^187
 ;;525.63^Y^3^^185^186^187
 ;;525.64^Y^3^^185^186^187
 ;;525.65^Y^3^^185^186^187
 ;;525.66^Y^3^^185^186^187
 ;;525.67^Y^3^^185^186^187
 ;;525.69^Y^3^^185^186^187
 ;;526.61^Y^3^^185^186^187
 ;;526.62^Y^3^^185^186^187
 ;;526.63^Y^3^^185^186^187
 ;;526.69^Y^3^^185^186^187
 ;;528.00^Y^3^^185^186^187
 ;;528.01^Y^3^^185^186^187
 ;;528.02^Y^3^^185^186^187
 ;;528.09^Y^3^^185^186^187
 ;;538.^^6^^182^183^184
 ;;608.20^^12^^352
 ;;608.21^^12^^352
 ;;608.22^^12^^352
 ;;608.23^^12^^352
 ;;608.24^^12^^352
 ;;616.81^^13^^358^359^368
 ;;616.89^^13^^358^359^368
 ;;618.84^^13^^358^359^369
 ;;629.29^^13^^358^359^369
 ;;629.81^^13^^358^359^369
 ;;629.89^^13^^358^359^369
 ;;649.00^^14^^469
 ;;649.01^^14^^370^371^372^373^374^375
 ;;649.02^^14^^370^371^372^373^374^375
 ;;649.03^^14^^383^384
 ;;649.04^^14^^376^377
 ;;649.10^^14^^469
 ;;649.11^^14^^370^371^372^373^374^375
 ;;649.12^^14^^370^371^372^373^374^375
 ;;649.13^^14^^383^384
 ;;649.14^^14^^376^377
 ;;649.20^^14^^469
 ;;649.21^^14^^370^371^372^373^374^375
 ;;649.22^^14^^370^371^372^373^374^375
 ;;649.23^^14^^383^384
 ;;649.24^^14^^376^377
 ;;649.30^^14^^469
 ;;649.31^^14^^370^371^372^373^374^375
 ;;649.32^^14^^370^371^372^373^374^375
 ;;649.33^^14^^383^384
 ;;649.34^^14^^376^377
 ;;649.40^^14^^469
 ;;649.41^^14^^370^371^372^373^374^375
 ;;649.42^^14^^370^371^372^373^374^375
 ;;649.43^^14^^383^384
 ;;649.44^^14^^376^377
 ;;649.50^^14^^469
 ;;649.51^^14^^370^371^372^373^374^375
 ;;649.53^^14^^383^384
 ;;649.60^^14^^469
 ;;649.61^^14^^370^371^372^373^374^375
 ;;649.62^^14^^370^371^372^373^374^375
 ;;649.63^^14^^383^384
 ;;649.64^^14^^376^377
 ;;729.71^^8^^248
 ;;729.72^^8^^248
 ;;729.73^^8^^248
 ;;729.79^^8^^248
 ;;731.3^^8^^244^245
 ;;768.7^^15^^390
 ;;770.87^^15^^390
 ;;770.88^^15^^390
 ;;775.81^^15^^390
 ;;775.89^^15^^390
 ;;779.85^^15^^387^389
 ;;780.32^^1^^26^562^563
 ;;780.96^^23^^463^464
 ;;780.97^^23^^463^464
 ;;784.91^^3^^73^74
 ;;784.99^^3^^73^74
 ;;788.64^^11^^325^326^327
 ;;788.65^^11^^325^326^327
 ;;793.91^^23^^463^464
 ;;793.99^^23^^463^464
 ;;795.06^^13^^358^359^369
 ;;795.81^^23^^463^464
 ;;795.82^^23^^463^464
 ;;795.89^^23^^463^464
 ;;958.90^^21^^454^455
 ;;958.91^^21^^454^455
 ;;958.92^^21^^454^455
 ;;958.93^^21^^454^455
 ;;958.99^^21^^454^455
 ;;995.20^^21^^449^450^451
 ;;995.21^^21^^449^450^451
 ;;995.22^^21^^449^450^451
 ;;995.23^^21^^449^450^451
 ;;995.27^^21^^449^450^451
 ;;995.29^^21^^449^450^451
 ;;V18.51^^23^^467
 ;;V18.59^^23^^467
 ;;V26.34^^23^^467
 ;;V26.35^^23^^467
 ;;V26.39^^23^^467
 ;;V45.86^^23^^467
 ;;V58.30^^23^^467
 ;;V58.31^^23^^467
 ;;V58.32^^23^^467
 ;;V72.11^^23^^467
 ;;V72.19^^23^^467
 ;;V82.71^^23^^467
 ;;V82.79^^23^^467
 ;;V85.51^^23^^467
 ;;V85.52^^23^^467
 ;;V85.53^^23^^467
 ;;V85.54^^23^^467
 ;;V86.0^^23^^467
 ;;V86.1^^23^^467
 ;;EXIT