source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1824N.m@ 676

ICD1824N   ; ALB/JAT - FY 2007 UPDATE; 7/27/05 14:50;
 ;;18.0;DRG Grouper;**24**;Oct 13,2000;Build 5
 Q
 ;
DIAG ;
 D BMES^XPDUTL(">>>DRG Reclassification changes")
 D MES^XPDUTL(">>>Modifying diagnosis codes - file 80")
 D MES^XPDUTL(">>>for new DRGs")
 N LINE,X,ICDDIAG,ENTRY,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 
 ..;check if already created in case patch being re-installed
 ..Q:$D(^ICD9(ENTRY,3,"B",3061001))
 ..; add 80.071 and 80.711 records
 ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
 ..S FDA(1820,80.071,"+2,?1,",.01)=3061001
 ..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,2)
 ..I $P(ICDDIAG,U,3) S FDA(1820,80.711,"+4,?2,?1,",.01)=$P(ICDDIAG,U,3)
 ..I $P(ICDDIAG,U,4) S FDA(1820,80.711,"+5,?2,?1,",.01)=$P(ICDDIAG,U,4)
 ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
 Q
REVD ; 
 ;;100.81^561^ 
 ;;100.89^561^ 
 ;;112.83^561^489
 ;;114.2^561^489
 ;;115.01^561^489
 ;;115.11^561^489
 ;;115.91^561^489
 ;;320.0^560^
 ;;320.1^560^
 ;;320.2^560^
 ;;320.3^560^    
 ;;320.7^560^        
 ;;320.9^560^    
 ;;321.1^561^    
 ;;321.2^561^    
 ;;321.3^561^    
 ;;321.4^561^    
 ;;321.8^561^    
 ;;322.1^561^    
 ;;322.2^561^    
 ;;322.9^561^    
 ;;323.1^561^    
 ;;323.2^561^      
 ;;323.9^561^489
 ;;324.1^560^ 
 ;;324.9^560^    
 ;;003.21^560^489
 ;;006.5^561^
 ;;013.00^560^489
 ;;013.01^560^489
 ;;013.02^560^489
 ;;013.03^560^489
 ;;013.04^560^489
 ;;013.05^560^489
 ;;013.06^560^489
 ;;013.10^560^489
 ;;013.11^560^489
 ;;013.12^560^489
 ;;013.13^560^489
 ;;013.14^560^489
 ;;013.15^560^489
 ;;013.16^560^489
 ;;013.20^560^489
 ;;013.21^560^489
 ;;013.22^560^489
 ;;013.23^560^489
 ;;013.24^560^489
 ;;013.25^560^489
 ;;013.26^560^489
 ;;013.30^560^489
 ;;013.31^560^489
 ;;013.32^560^489
 ;;013.33^560^489
 ;;013.34^560^489
 ;;013.35^560^489
 ;;013.36^560^489
 ;;013.40^560^489
 ;;013.41^560^489
 ;;013.42^560^489
 ;;013.43^560^489
 ;;013.44^560^489
 ;;013.45^560^489
 ;;013.46^560^489
 ;;013.50^560^489
 ;;013.51^560^489
 ;;013.52^560^489
 ;;013.53^560^489
 ;;013.54^560^489
 ;;013.55^560^489
 ;;013.56^560^489
 ;;013.60^560^489
 ;;013.61^560^489
 ;;013.62^560^489
 ;;013.63^560^489
 ;;013.64^560^489
 ;;013.65^560^489
 ;;013.66^560^489
 ;;013.80^560^489
 ;;013.81^560^489
 ;;013.82^560^489
 ;;013.83^560^489
 ;;013.84^560^489
 ;;013.85^560^489
 ;;013.86^560^489
 ;;013.90^560^489
 ;;013.91^560^489
 ;;013.92^560^489
 ;;013.93^560^489
 ;;013.94^560^
 ;;013.95^560^
 ;;013.96^560^
 ;;036.0^560^
 ;;036.1^560^   
 ;;045.00^561^    
 ;;045.01^561^    
 ;;045.02^561^    
 ;;045.03^561^    
 ;;045.10^561^    
 ;;045.11^561^    
 ;;045.12^561^
 ;;045.13^561^
 ;;045.90^561^    
 ;;045.91^561^    
 ;;045.92^561^    
 ;;045.93^561^    
 ;;049.8^561^489
 ;;049.9^561^489
 ;;052.0^561^
 ;;054.3^561^489
 ;;055.0^561^ 
 ;;056.01^561^    
 ;;056.09^561^    
 ;;062.0^561^  
 ;;062.1^561^    
 ;;062.2^561^    
 ;;062.3^561^    
 ;;062.4^561^    
 ;;062.5^561^    
 ;;062.8^561^    
 ;;062.9^561^    
 ;;063.0^561^    
 ;;063.1^561^    
 ;;063.2^561^    
 ;;063.8^561^    
 ;;063.9^561^    
 ;;064.^561^  
 ;;066.2^561^    
 ;;071.^561^  
 ;;072.2^561^    
 ;;090.40^561^    
 ;;090.41^561^    
 ;;090.42^561^    
 ;;090.49^561^    
 ;;091.81^561^    
 ;;094.2^561^   
 ;;094.3^561^   
 ;;094.81^561^    
 ;;098.82^560^
 ;;130.0^561^489
 ;;321.0^561^ 
 ;;322.0^561^       
 ;;324.0^560^
 ;;357.0^560^
 ;;320.82^560^
 ;;320.81^560^
 ;;320.89^560^
 ;;307.81^26^564
 ;;310.2^26^564
 ;;345.2^26^562^563
 ;;345.3^26^562^563
 ;;348.2^26^564
 ;;437.4^26^564
 ;;349.0^26^564
 ;;784.0^26^564
 ;;345.00^26^562^563
 ;;345.01^26^562^563
 ;;345.10^26^562^563
 ;;345.11^26^562^563
 ;;345.40^26^562^563
 ;;345.41^26^562^563
 ;;345.50^26^562^563
 ;;345.51^26^562^563
 ;;345.60^26^562^563
 ;;345.61^26^562^563
 ;;345.70^26^562^563
 ;;345.71^26^562^563
 ;;345.80^26^562^563
 ;;345.81^26^562^563
 ;;345.90^26^562^563
 ;;345.91^26^562^563
 ;;346.01^26^564
 ;;346.11^26^564
 ;;346.21^26^564
 ;;346.81^26^564
 ;;346.91^26^564
 ;;346.00^26^564
 ;;346.10^26^564
 ;;346.20^26^564
 ;;346.80^26^564
 ;;346.90^26^564
 ;;780.31^26^562^563
 ;;780.39^26^562^563
 ;;017.80^571^489
 ;;017.81^571^489
 ;;017.82^571^489
 ;;017.83^571^489
 ;;017.84^571^489
 ;;017.85^571^489
 ;;017.86^571^489
 ;;112.84^571^489
 ;;456.0^571
 ;;456.1^571
 ;;456.20^571
 ;;530.4^571
 ;;530.7^571
 ;;530.82^571
 ;;530.84^571
 ;;750.3^571
 ;;750.4^571
 ;;862.22^571
 ;;947.2^571
 ;;001.0^572
 ;;001.1^572
 ;;001.9^572
 ;;003.0^572
 ;;004.0^572
 ;;004.1^572
 ;;004.2^572
 ;;004.3^572
 ;;004.8^572
 ;;004.9^572
 ;;005.0^572
 ;;005.2^572
 ;;005.3^572
 ;;005.4^572
 ;;005.81^572
 ;;005.89^572
 ;;006.0^572
 ;;006.1^572
 ;;006.2^572
 ;;007.0^572
 ;;007.1^572
 ;;007.2^572^489
 ;;007.3^572
 ;;007.4^572
 ;;007.5^572
 ;;007.8^572
 ;;007.9^572
 ;;008.00^572
 ;;008.01^572
 ;;008.02^572
 ;;008.03^572
 ;;008.04^572
 ;;008.09^572
 ;;008.1^572
 ;;008.2^572
 ;;008.3^572
 ;;008.41^572
 ;;008.42^572
 ;;008.43^572
 ;;008.44^572
 ;;008.45^572
 ;;008.46^572
 ;;008.47^572
 ;;008.49^572
 ;;008.5^572
 ;;4.00^572
 ;;014.01^572
 ;;014.02^572
 ;;014.03^572
 ;;014.04^572
 ;;014.05^572
 ;;014.06^572
 ;;014.80^572
 ;;014.81^572
 ;;014.82^572
 ;;014.83^572
 ;;014.84^572
 ;;014.85^572
 ;;014.86^572
 ;;021.1^572
 ;;022.2^572
 ;;032.83^572
 ;;039.2^572^489
 ;;095.2^572
 ;;098.86^572
 ;;123.1^572
 ;;123.5^572
 ;;123.6^572
 ;;123.8^572
 ;;123.9^572
 ;;126.0^572
 ;;126.1^572
 ;;126.2^572
 ;;126.3^572
 ;;126.8^572
 ;;126.9^572
 ;;540.0^572
 ;;540.1^572
 ;;567.0^572
 ;;567.1^572
 ;;567.21^572
 ;;567.22^572
 ;;567.23^572
 ;;567.29^572
 ;;567.31^572
 ;;567.38^572
 ;;7.39^572
 ;;567.89^572
 ;;567.9^572
 ;;569.5^572
 ;;279.11^574
 ;;279.12^574
 ;;279.13^574
 ;;279.19^574
 ;;279.2^574
 ;;283.0^574
 ;;283.10^574
 ;;283.19^574
 ;;283.2^574
 ;;283.9^574
 ;;284.8^574
 ;;284.9^574
 ;;288.1^574
 ;;288.2^574
 ;;996.85^574
 ;;EXIT