ICD1882O.m

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

 ;;18.0;DRG Grouper;**82**;Oct 20, 2000;Build 21

 ;

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

 ; DRG is being inactivated with an inactive status.

 Q

 ;

 ;

INACTDRG ;

 N LINE,ICDX,ICDDRG,DESC,DA,DIE,DR,MDC,SURG,ICDFDA

 D BMES^XPDUTL(">>> Inactivating DRG(s)...")

 F LINE=1:1 S ICDX=$T(INAC+LINE) S ICDDRG=$P(ICDX,";;",2) Q:ICDDRG="EXIT"  D

 .S DESC="NO LONGER VALID"

 .S DA(LINE)=$P(ICDDRG,U)

 .S DA=1

 .S DIE="^ICD("_DA(LINE)_",1,"

 .S DR=".01///^S X=DESC"

 .D ^DIE

 .; check if already done in case patch being re-installed

 .Q:$D(^ICD($P(ICDDRG,U),66,"B",3151001))

 .; add entry to 80.266

 .S MDC=$P(ICDDRG,U,2)

 .S SURG=$P(ICDDRG,U,3)

 .S ICDDRG=$P(ICDDRG,U)

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

 .S ICDFDA(80.266,"+2,?1,",.01)=3151001

 .S ICDFDA(80.266,"+2,?1,",.03)=0

 .S ICDFDA(80.266,"+2,?1,",.05)=MDC

 .S ICDFDA(80.266,"+2,?1,",.06)=SURG

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

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

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

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

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

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

 ;

 ;

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

 ;;237^8^1

 ;;238^8^1

 ;;EXIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICD1882O   1361     printed  Apr 09, 2024@20:55:47                                                                                                                                                                                                    Page 2

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

 +1       ;;18.0;DRG Grouper;**82**;Oct 20, 2000;Build 21

 +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 LINE,ICDX,ICDDRG,DESC,DA,DIE,DR,MDC,SURG,ICDFDA

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

 +3        FOR LINE=1:1

               SET ICDX=$TEXT(INAC+LINE)

               SET ICDDRG=$PIECE(ICDX,";;",2)

               if ICDDRG="EXIT"

                   QUIT 

               Begin DoDot:1

 +4                SET DESC="NO LONGER VALID"

 +5                SET DA(LINE)=$PIECE(ICDDRG,U)

 +6                SET DA=1

 +7                SET DIE="^ICD("_DA(LINE)_",1,"

 +8                SET DR=".01///^S X=DESC"

 +9                DO ^DIE

 +10      ; check if already done in case patch being re-installed

 +11               if $DATA(^ICD($PIECE(ICDDRG,U),66,"B",3151001))

                       QUIT 

 +12      ; add entry to 80.266

 +13               SET MDC=$PIECE(ICDDRG,U,2)

 +14               SET SURG=$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)=3151001

 +18               SET ICDFDA(80.266,"+2,?1,",.03)=0

 +19               SET ICDFDA(80.266,"+2,?1,",.05)=MDC

 +20               SET ICDFDA(80.266,"+2,?1,",.06)=SURG

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

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

                   KILL ICDFDA

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

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

 +28               SET ICDFDA(80.2681,"+3,?2,?1,",.01)=DESC

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

                   KILL ICDFDA

               End DoDot:1

 +30      ;

 +31      ;

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

 +1       ;;237^8^1

 +2       ;;238^8^1

 +3       ;;EXIT