ICD115O ;ALB/DMR - YEARLY DRG UPDATE; October 01, 2020@15:42
;;18.0;DRG Grouper;**115**;October 20, 2000;Build 7
;Per VA Directive 6402, this routine should not be modified.
;
; Inactivating DRG(s) - will add an entry for fiscal year 2024
; DRG is being inactivated with an inactive status.
Q
;
;
INACTDRG ;
N ICDLINE,ICDX,ICDDRG,ICDDESC,DA,DIE,DR,ICDMDC,ICDSURG,ICDFDA
D BMES^XPDUTL(">>> Inactivating DRG(s) for FY 2024...")
F ICDLINE=1:1 S ICDX=$T(INAC+ICDLINE) S ICDDRG=$P(ICDX,";;",2) Q:ICDDRG="EXIT" D
.S ICDDESC="NO LONGER VALID"
.S DA(ICDLINE)=$P(ICDDRG,U)
.S DA=1
.S DIE="^ICD("_DA(ICDLINE)_",1,"
.S DR=".01///^S X=ICDDESC"
.D ^DIE
.; check if already done in case patch being re-installed
.Q:$D(^ICD($P(ICDDRG,U),66,"B",3231001))
.; add entry to 80.266
.S ICDMDC=$P(ICDDRG,U,2)
.S ICDSURG=$P(ICDDRG,U,3)
.S ICDDRG=$P(ICDDRG,U)
.S ICDFDA(80.2,"?1,",.01)=ICDDRG
.S ICDFDA(80.266,"+2,?1,",.01)=3231001
.S ICDFDA(80.266,"+2,?1,",.03)=0
.S ICDFDA(80.266,"+2,?1,",.05)=ICDMDC
.S ICDFDA(80.266,"+2,?1,",.06)=ICDSURG
.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)=3231001
.D UPDATE^DIE("","ICDFDA") K ICDFDA
.S ICDFDA(80.2,"?1,",.01)=ICDDRG
.S ICDFDA(80.2681,"?2,?1,",.01)=3231001
.S ICDFDA(80.2681,"+3,?2,?1,",.01)=ICDDESC
.D UPDATE^DIE("","ICDFDA") K ICDFDA
;
;
INAC ;DRG^MDC^SURG (1=surg, 0=med)
;;222^5^1
;;223^5^1
;;224^5^1
;;225^5^1
;;226^5^1
;;227^5^1
;;246^5^1
;;247^5^1
;;248^5^1
;;249^5^1
;;338^6^1
;;339^6^1
;;340^6^1
;;341^6^1
;;342^6^1
;;343^6^1
;;EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD115O 1672 printed Oct 16, 2024@17:48:13 Page 2
ICD115O ;ALB/DMR - YEARLY DRG UPDATE; October 01, 2020@15:42
+1 ;;18.0;DRG Grouper;**115**;October 20, 2000;Build 7
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Inactivating DRG(s) - will add an entry for fiscal year 2024
+5 ; DRG is being inactivated with an inactive status.
+6 QUIT
+7 ;
+8 ;
INACTDRG ;
+1 NEW ICDLINE,ICDX,ICDDRG,ICDDESC,DA,DIE,DR,ICDMDC,ICDSURG,ICDFDA
+2 DO BMES^XPDUTL(">>> Inactivating DRG(s) for FY 2024...")
+3 FOR ICDLINE=1:1
SET ICDX=$TEXT(INAC+ICDLINE)
SET ICDDRG=$PIECE(ICDX,";;",2)
if ICDDRG="EXIT"
QUIT
Begin DoDot:1
+4 SET ICDDESC="NO LONGER VALID"
+5 SET DA(ICDLINE)=$PIECE(ICDDRG,U)
+6 SET DA=1
+7 SET DIE="^ICD("_DA(ICDLINE)_",1,"
+8 SET DR=".01///^S X=ICDDESC"
+9 DO ^DIE
+10 ; check if already done in case patch being re-installed
+11 if $DATA(^ICD($PIECE(ICDDRG,U),66,"B",3231001))
QUIT
+12 ; add entry to 80.266
+13 SET ICDMDC=$PIECE(ICDDRG,U,2)
+14 SET ICDSURG=$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)=3231001
+18 SET ICDFDA(80.266,"+2,?1,",.03)=0
+19 SET ICDFDA(80.266,"+2,?1,",.05)=ICDMDC
+20 SET ICDFDA(80.266,"+2,?1,",.06)=ICDSURG
+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)=3231001
+25 DO UPDATE^DIE("","ICDFDA")
KILL ICDFDA
+26 SET ICDFDA(80.2,"?1,",.01)=ICDDRG
+27 SET ICDFDA(80.2681,"?2,?1,",.01)=3231001
+28 SET ICDFDA(80.2681,"+3,?2,?1,",.01)=ICDDESC
+29 DO UPDATE^DIE("","ICDFDA")
KILL ICDFDA
End DoDot:1
+30 ;
+31 ;
INAC ;DRG^MDC^SURG (1=surg, 0=med)
+1 ;;222^5^1
+2 ;;223^5^1
+3 ;;224^5^1
+4 ;;225^5^1
+5 ;;226^5^1
+6 ;;227^5^1
+7 ;;246^5^1
+8 ;;247^5^1
+9 ;;248^5^1
+10 ;;249^5^1
+11 ;;338^6^1
+12 ;;339^6^1
+13 ;;340^6^1
+14 ;;341^6^1
+15 ;;342^6^1
+16 ;;343^6^1
+17 ;;EXIT
