source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1831O.m@ 839

ICD1831O ;ALB/ESD/JAT - FY 2007 UPDATE; 6/22/01 2:43pm ; 12/4/07 2:23pm
 ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
 Q
 ;
INACTDRG ;
 N LINE,X,ICDDRG,DESC,DA,DIE,DR,MDC,SURG,ICDFDA
 D BMES^XPDUTL(">>> Inactivating 108 DRGs...")
 F LINE=1:1 S X=$T(INAC+LINE) S ICDDRG=$P(X,";;",2) Q:ICDDRG="EXIT"  D
 .S DESC="NO LONGER VALID"
 .S DA(1)=$P(ICDDRG,U)
 .S DA=1
 .S DIE="^ICD("_DA(1)_",1,"
 .S DR=".01///^S X=DESC"
 .D ^DIE
 .; check if already done in case patch being re-installed
 .Q:$D(^ICD($P(ICDDRG,U),66,"B",3071001))
 .; add entry to 80.266
 .S MDC=$P(ICDDRG,U,2)
 .S SURG=$P(ICDDRG,U,3)
 .S ICDDRG=$P(ICDDRG,U)
 .S ICDFDA(80.2,"?1,",.01)=ICDDRG
 .S ICDFDA(80.266,"+2,?1,",.01)=3071001
 .S ICDFDA(80.266,"+2,?1,",.03)=0
 .S ICDFDA(80.266,"+2,?1,",.05)=MDC
 .S ICDFDA(80.266,"+2,?1,",.06)=SURG
 .D UPDATE^DIE("","ICDFDA") K ICDFDA
 .; add entry to 80.268 and 80.2681 
 .S ICDFDA(80.2,"?1,",.01)=ICDDRG
 .S ICDFDA(80.268,"+2,?1,",.01)=3071001
 .D UPDATE^DIE("","ICDFDA") K ICDFDA
 .S ICDFDA(80.2,"?1,",.01)=ICDDRG
 .S ICDFDA(80.268,"?2,?1,",.01)=3071001
 .S ICDFDA(80.2681,"+3,?2,?1,",.01)=DESC
 .D UPDATE^DIE("","ICDFDA") K ICDFDA
 Q
 ;
INAC ;
 ;;14^1^0
 ;;15^1^0
 ;;16^1^0
 ;;17^1^0
 ;;18^1^0
 ;;19^1^0
 ;;43^2^0
 ;;44^2^0
 ;;45^2^0
 ;;46^2^0
 ;;47^2^0
 ;;48^2^0
 ;;49^3^1
 ;;50^3^1
 ;;51^3^1
 ;;104^5^1
 ;;105^5^1
 ;;106^5^1
 ;;108^5^1
 ;;110^5^1
 ;;111^5^1
 ;;118^5^1
 ;;115^5^1
 ;;120^5^1
 ;;126^5^0
 ;;127^5^0
 ;;128^5^0
 ;;140^5^0
 ;;141^5^0
 ;;142^5^0
 ;;143^5^0
 ;;144^5^0
 ;;145^5^0
 ;;160^6^0
 ;;161^6^1
 ;;162^6^1
 ;;169^3^1
 ;;170^6^1
 ;;171^6^0
 ;;172^6^0
 ;;173^6^0
 ;;174^6^0
 ;;210^8^0
 ;;211^8^0
 ;;212^8^0
 ;;213^8^0
 ;;265^9^0
 ;;266^9^0
 ;;267^9^0
 ;;268^9^0
 ;;269^9^0
 ;;270^9^0
 ;;271^9^0
 ;;272^9^0
 ;;273^9^0
 ;;274^9^0
 ;;275^9^0
 ;;276^9^0
 ;;277^9^0
 ;;278^9^0
 ;;279^9^0
 ;;317^11^0
 ;;318^11^0
 ;;319^11^0
 ;;320^11^0
 ;;321^11^0
 ;;322^11^0
 ;;323^11^0
 ;;324^11^0
 ;;325^11^0
 ;;359^13^1
 ;;360^13^1
 ;;361^13^1
 ;;362^13^1
 ;;363^13^1
 ;;364^13^1
 ;;365^13^1
 ;;366^13^0
 ;;367^13^0
 ;;396^16^0
 ;;397^16^0
 ;;398^16^0
 ;;399^16^0
 ;;401^17^1
 ;;402^17^1
 ;;403^17^0
 ;;404^17^0
 ;;426^19^0
 ;;427^19^0
 ;;428^19^0
 ;;429^19^0
 ;;430^19^0
 ;;431^19^0
 ;;447^21^0
 ;;448^21^0
 ;;449^21^0
 ;;450^21^0
 ;;451^21^0
 ;;452^21^0
 ;;518^5^1
 ;;519^8^1
 ;;520^8^1
 ;;521^20^0
 ;;522^20^0
 ;;523^20^0
 ;;524^1^0
 ;;525^5^1
 ;;528^1^1
 ;;529^1^1
 ;;530^1^1
 ;;531^1^1
 ;;532^1^1
 ;;567^6^1
 ;;568^6^1
 ;;569^6^1
 ;;570^6^1
 ;;571^6^1
 ;;572^8^0
 ;;EXIT