ICD1856O.m

ICD1856O ;ALB/MJB - YEARLY DRG UPDATE;8/9/2010

 ;;18.0;DRG Grouper;**56**;Oct 13, 2000;Build 7

 ;

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

 ; DRG is being inactivated with an inactive status.

 Q

 ;

INACTDRG ;

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

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

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

 .S DESC="NO LONGER VALID"

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

 .S DA=1

 .S DIE="^ICD("_DA(1)_",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",3111001))

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

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

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

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

 .S ICDFDA(80.268,"?2,?1,",.01)=3111001

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

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

 Q

 ;

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

 ;;15^98^1

 ;;EXIT

ICD1856O  ;ALB/MJB - YEARLY DRG UPDATE;8/9/2010

 +1       ;;18.0;DRG Grouper;**56**;Oct 13, 2000;Build 7

 +2       ;

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

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

 +5        QUIT 

 +6       ;

INACTDRG  ;

 +1        NEW LINE,X,ICDDRG,DESC,DA,DIE,DR,MDC,SURG,ICDFDA

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

 +3        FOR LINE=1:1

               SET X=$TEXT(INAC+LINE)

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

               IF ICDDRG="EXIT"

                   QUIT 

               Begin DoDot:1

 +4                SET DESC="NO LONGER VALID"

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

 +6                SET DA=1

 +7                SET DIE="^ICD("_DA(1)_",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",3111001))

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

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

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

                   KILL ICDFDA

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

 +27               SET ICDFDA(80.268,"?2,?1,",.01)=3111001

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

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

                   KILL ICDFDA

               End DoDot:1

 +30       QUIT 

 +31      ;

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

 +1       ;;15^98^1

 +2       ;;EXIT