ICD1890O.m

ICD1890O ;ALB/JDG - YEARLY DRG UPDATE;8/9/2010

 ;;18.0;DRG Grouper;**90**;Oct 20, 2000;Build 13

 ;

 ; Inactivating DRG(s) - will add an entry for fiscal year

 ; 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 2017...")

 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",3161001))

 .; 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)=3161001

 .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)=3161001

 .D UPDATE^DIE("","ICDFDA") K ICDFDA

 .S ICDFDA(80.2,"?1,",.01)=ICDDRG

 .S ICDFDA(80.2681,"?2,?1,",.01)=3161001

 .S ICDFDA(80.2681,"+3,?2,?1,",.01)=ICDDESC

 .D UPDATE^DIE("","ICDFDA") K ICDFDA

 ;

 ;

INAC ;DRG^MDC^SURG (1=surg, 0=med)

 ;;230^5^1

 ;;EXIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICD1890O   1406     printed  Apr 09, 2024@20:56:08                                                                                                                                                                                                    Page 2

ICD1890O  ;ALB/JDG - YEARLY DRG UPDATE;8/9/2010

 +1       ;;18.0;DRG Grouper;**90**;Oct 20, 2000;Build 13

 +2       ;

 +3       ; Inactivating DRG(s) - will add an entry for fiscal year

 +4       ; DRG is being inactivated with an inactive status.

 +5        QUIT 

 +6       ;

 +7       ;

INACTDRG  ;

 +1        NEW ICDLINE,ICDX,ICDDRG,ICDDESC,DA,DIE,DR,ICDMDC,ICDSURG,ICDFDA

 +2        DO BMES^XPDUTL(">>> Inactivating DRG(s) for FY 2017...")

 +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",3161001))

                       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)=3161001

 +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)=3161001

 +25               DO UPDATE^DIE("","ICDFDA")

                   KILL ICDFDA

 +26               SET ICDFDA(80.2,"?1,",.01)=ICDDRG

 +27               SET ICDFDA(80.2681,"?2,?1,",.01)=3161001

 +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       ;;230^5^1

 +2       ;;EXIT