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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1831O 2638 printed Apr 09, 2024@20:56:16 Page 2
ICD1831O ;ALB/ESD/JAT - FY 2007 UPDATE; 6/22/01 2:43pm ; 12/4/07 2:23pm
+1 ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
+2 QUIT
+3 ;
INACTDRG ;
+1 NEW LINE,X,ICDDRG,DESC,DA,DIE,DR,MDC,SURG,ICDFDA
+2 DO BMES^XPDUTL(">>> Inactivating 108 DRGs...")
+3 FOR LINE=1:1
SET X=$TEXT(INAC+LINE)
SET ICDDRG=$PIECE(X,";;",2)
if ICDDRG="EXIT"
QUIT
Begin DoDot:1
+4 SET DESC="NO LONGER VALID"
+5 SET DA(1)=$PIECE(ICDDRG,U)
+6 SET DA=1
+7 SET DIE="^ICD("_DA(1)_",1,"
+8 SET DR=".01///^S X=DESC"
+9 DO ^DIE
+10 ; check if already done in case patch being re-installed
+11 if $DATA(^ICD($PIECE(ICDDRG,U),66,"B",3071001))
QUIT
+12 ; add entry to 80.266
+13 SET MDC=$PIECE(ICDDRG,U,2)
+14 SET SURG=$PIECE(ICDDRG,U,3)
+15 SET ICDDRG=$PIECE(ICDDRG,U)
+16 SET ICDFDA(80.2,"?1,",.01)=ICDDRG
+17 SET ICDFDA(80.266,"+2,?1,",.01)=3071001
+18 SET ICDFDA(80.266,"+2,?1,",.03)=0
+19 SET ICDFDA(80.266,"+2,?1,",.05)=MDC
+20 SET ICDFDA(80.266,"+2,?1,",.06)=SURG
+21 DO UPDATE^DIE("","ICDFDA")
KILL ICDFDA
+22 ; add entry to 80.268 and 80.2681
+23 SET ICDFDA(80.2,"?1,",.01)=ICDDRG
+24 SET ICDFDA(80.268,"+2,?1,",.01)=3071001
+25 DO UPDATE^DIE("","ICDFDA")
KILL ICDFDA
+26 SET ICDFDA(80.2,"?1,",.01)=ICDDRG
+27 SET ICDFDA(80.268,"?2,?1,",.01)=3071001
+28 SET ICDFDA(80.2681,"+3,?2,?1,",.01)=DESC
+29 DO UPDATE^DIE("","ICDFDA")
KILL ICDFDA
End DoDot:1
+30 QUIT
+31 ;
INAC ;
+1 ;;14^1^0
+2 ;;15^1^0
+3 ;;16^1^0
+4 ;;17^1^0
+5 ;;18^1^0
+6 ;;19^1^0
+7 ;;43^2^0
+8 ;;44^2^0
+9 ;;45^2^0
+10 ;;46^2^0
+11 ;;47^2^0
+12 ;;48^2^0
+13 ;;49^3^1
+14 ;;50^3^1
+15 ;;51^3^1
+16 ;;104^5^1
+17 ;;105^5^1
+18 ;;106^5^1
+19 ;;108^5^1
+20 ;;110^5^1
+21 ;;111^5^1
+22 ;;118^5^1
+23 ;;115^5^1
+24 ;;120^5^1
+25 ;;126^5^0
+26 ;;127^5^0
+27 ;;128^5^0
+28 ;;140^5^0
+29 ;;141^5^0
+30 ;;142^5^0
+31 ;;143^5^0
+32 ;;144^5^0
+33 ;;145^5^0
+34 ;;160^6^0
+35 ;;161^6^1
+36 ;;162^6^1
+37 ;;169^3^1
+38 ;;170^6^1
+39 ;;171^6^0
+40 ;;172^6^0
+41 ;;173^6^0
+42 ;;174^6^0
+43 ;;210^8^0
+44 ;;211^8^0
+45 ;;212^8^0
+46 ;;213^8^0
+47 ;;265^9^0
+48 ;;266^9^0
+49 ;;267^9^0
+50 ;;268^9^0
+51 ;;269^9^0
+52 ;;270^9^0
+53 ;;271^9^0
+54 ;;272^9^0
+55 ;;273^9^0
+56 ;;274^9^0
+57 ;;275^9^0
+58 ;;276^9^0
+59 ;;277^9^0
+60 ;;278^9^0
+61 ;;279^9^0
+62 ;;317^11^0
+63 ;;318^11^0
+64 ;;319^11^0
+65 ;;320^11^0
+66 ;;321^11^0
+67 ;;322^11^0
+68 ;;323^11^0
+69 ;;324^11^0
+70 ;;325^11^0
+71 ;;359^13^1
+72 ;;360^13^1
+73 ;;361^13^1
+74 ;;362^13^1
+75 ;;363^13^1
+76 ;;364^13^1
+77 ;;365^13^1
+78 ;;366^13^0
+79 ;;367^13^0
+80 ;;396^16^0
+81 ;;397^16^0
+82 ;;398^16^0
+83 ;;399^16^0
+84 ;;401^17^1
+85 ;;402^17^1
+86 ;;403^17^0
+87 ;;404^17^0
+88 ;;426^19^0
+89 ;;427^19^0
+90 ;;428^19^0
+91 ;;429^19^0
+92 ;;430^19^0
+93 ;;431^19^0
+94 ;;447^21^0
+95 ;;448^21^0
+96 ;;449^21^0
+97 ;;450^21^0
+98 ;;451^21^0
+99 ;;452^21^0
+100 ;;518^5^1
+101 ;;519^8^1
+102 ;;520^8^1
+103 ;;521^20^0
+104 ;;522^20^0
+105 ;;523^20^0
+106 ;;524^1^0
+107 ;;525^5^1
+108 ;;528^1^1
+109 ;;529^1^1
+110 ;;530^1^1
+111 ;;531^1^1
+112 ;;532^1^1
+113 ;;567^6^1
+114 ;;568^6^1
+115 ;;569^6^1
+116 ;;570^6^1
+117 ;;571^6^1
+118 ;;572^8^0
+119 ;;EXIT
