ICD115O.m

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 ---ICD115O   1672     printed  Apr 09, 2024@20:57:37                                                                                                                                                                                                     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