ICD120O ;ALB/RFS - YEARLY DRG UPDATE; August 15, 2024@15:42
;;18.0;DRG Grouper;**120**;October 20, 2000;Build 4
;Per VA Directive 6402, this routine should not be modified.
;
; Inactivating DRG(s) - will add an entry for fiscal year 2025
; 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 2025...")
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",3241001))
.; 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)=3241001
.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)=3241001
.D UPDATE^DIE("","ICDFDA") K ICDFDA
.S ICDFDA(80.2,"?1,",.01)=ICDDRG
.S ICDFDA(80.2681,"?2,?1,",.01)=3241001
.S ICDFDA(80.2681,"+3,?2,?1,",.01)=ICDDESC
.D UPDATE^DIE("","ICDFDA") K ICDFDA
;
;
INAC ;DRG^MDC^SURG (1=surg, 0=med)
;;453^08^SURG^COMBINED ANTERIOR AND POSTERIOR SPINAL FUSION WITH MCC^8.8614^7.3
;;454^08^SURG^COMBINED ANTERIOR AND POSTERIOR SPINAL FUSION WITH CC^6.1163^3.7
;;455^08^SURG^COMBINED ANTERIOR AND POSTERIOR SPINAL FUSION WITHOUT CC/MCC^4.6056^2.3
;;459^08^SURG^SPINAL FUSION EXCEPT CERVICAL WITH MCC^6.6323^7.6
;;460^08^SURG^SPINAL FUSION EXCEPT CERVICAL WITHOUT MCC^3.6579^2.8
;;EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD120O 1865 printed Dec 13, 2024@01:47:32 Page 2
ICD120O ;ALB/RFS - YEARLY DRG UPDATE; August 15, 2024@15:42
+1 ;;18.0;DRG Grouper;**120**;October 20, 2000;Build 4
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Inactivating DRG(s) - will add an entry for fiscal year 2025
+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 2025...")
+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",3241001))
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)=3241001
+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)=3241001
+25 DO UPDATE^DIE("","ICDFDA")
KILL ICDFDA
+26 SET ICDFDA(80.2,"?1,",.01)=ICDDRG
+27 SET ICDFDA(80.2681,"?2,?1,",.01)=3241001
+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 ;;453^08^SURG^COMBINED ANTERIOR AND POSTERIOR SPINAL FUSION WITH MCC^8.8614^7.3
+2 ;;454^08^SURG^COMBINED ANTERIOR AND POSTERIOR SPINAL FUSION WITH CC^6.1163^3.7
+3 ;;455^08^SURG^COMBINED ANTERIOR AND POSTERIOR SPINAL FUSION WITHOUT CC/MCC^4.6056^2.3
+4 ;;459^08^SURG^SPINAL FUSION EXCEPT CERVICAL WITH MCC^6.6323^7.6
+5 ;;460^08^SURG^SPINAL FUSION EXCEPT CERVICAL WITHOUT MCC^3.6579^2.8
+6 ;;EXIT
