- 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 Mar 13, 2025@20:52:02 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
