ICD161P ;ALB/JDS - DRG GROUPER 16 PRE-INSTALL ; 09-DEC-98
;;16.0;DRG Grouper;**1**;Jan 15, 1999
;
; This routine makes modifications to ICD files
;
; These files must be reloaded upon completion of the
; patch installation.
;
EN ;
N I,XPDIDTOT,ICDX,ENTRY,DA,DIC,MDC22,DIE,DIK,DR,PROC,X
S MDC22=$P($T(MDC22),";;",2)
D BMES^XPDUTL(">>>> Updating MDC 22 Diagnosis Codes")
F I=1:1:$L(MDC22,U) D
.S ENTRY=$P(MDC22,U,I)
.S DA=+$O(^ICD9("BA",ENTRY_" ",0)) Q:'DA
.S DR="2///b;Q;2///@;61///510;60///511;5///22"
.S DIE="^ICD9(" D ^DIE
;MDC 1
D BMES^XPDUTL(">>>> Updating MDC 1 Procedure Codes")
F PROC=38.7,83.92,83.93 S ENTRY=+$O(^ICD0("BA",PROC_" ",0)) I ENTRY D
.I $D(^ICD0(ENTRY,"MDC",1)) S DIK="^DIK(ENTRY,""MDC"",",DA=1,DA(1)=ENTRY D ^DIK
.I '$D(^ICD0(ENTRY,"MDC",0)) S ^(0)="^80.12PA"
.S DIC="^ICD0(ENTRY,""MDC"",",X=1,DIC("DR")="1///7;2///8",DIC(0)="LM",DA(1)=ENTRY D ^DIC
;MDC 5
D BMES^XPDUTL(">>>> Updating MDC 5 Procedure Codes")
S ENTRY=+$O(^ICD0("BA","86.06 ",0)) I ENTRY D
.I $D(^ICD0(ENTRY,"MDC",5)) S DIK="^ICD0(ENTRY,""MDC"",",DA=5,DA(1)=ENTRY D ^DIK
.I '$D(^ICD0(ENTRY,"MDC",0)) S ^(0)="^80.12PA"
.S DIC="^ICD0(ENTRY,""MDC"",",X=5,DIC("DR")="1///120",DA(1)=ENTRY,DIC(0)="LM" D ^DIC
;MDC 4
D BMES^XPDUTL(">>> Updating MDC 4 Procedure Codes")
S ENTRY=+$O(^ICD0("BA","39.50 ",0)) I ENTRY D
.I $D(^ICD0(ENTRY,"MDC",4)) S DIK="^ICD0(ENTRY,""MDC"",",DA=4,DA(1)=ENTRY D ^DIK
.I '$D(^ICD0(ENTRY,"MDC",0)) S ^(0)="^80.12PA"
.S DIC="^ICD0(ENTRY,""MDC"",",X=4,DIC("DR")="1///76;2///77",DA(1)=ENTRY,DIC(0)="LM" D ^DIC
D BMES^XPDUTL(">>> Changing Diagnostic Code as Valid Principal Diagnoses")
S DA=+$O(^ICD9("BA","V71.9 ",0))
I DA S DIE="^ICD9(",DR="101///1;Q;101///@" D ^DIE
Q
MDC22 ;;948.90^948.80^948.70^948.60^948.50^948.40^948.30^948.20^948.10^948.00
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD161P 1832 printed Nov 22, 2024@16:57:50 Page 2
ICD161P ;ALB/JDS - DRG GROUPER 16 PRE-INSTALL ; 09-DEC-98
+1 ;;16.0;DRG Grouper;**1**;Jan 15, 1999
+2 ;
+3 ; This routine makes modifications to ICD files
+4 ;
+5 ; These files must be reloaded upon completion of the
+6 ; patch installation.
+7 ;
EN ;
+1 NEW I,XPDIDTOT,ICDX,ENTRY,DA,DIC,MDC22,DIE,DIK,DR,PROC,X
+2 SET MDC22=$PIECE($TEXT(MDC22),";;",2)
+3 DO BMES^XPDUTL(">>>> Updating MDC 22 Diagnosis Codes")
+4 FOR I=1:1:$LENGTH(MDC22,U)
Begin DoDot:1
+5 SET ENTRY=$PIECE(MDC22,U,I)
+6 SET DA=+$ORDER(^ICD9("BA",ENTRY_" ",0))
if 'DA
QUIT
+7 SET DR="2///b;Q;2///@;61///510;60///511;5///22"
+8 SET DIE="^ICD9("
DO ^DIE
End DoDot:1
+9 ;MDC 1
+10 DO BMES^XPDUTL(">>>> Updating MDC 1 Procedure Codes")
+11 FOR PROC=38.7,83.92,83.93
SET ENTRY=+$ORDER(^ICD0("BA",PROC_" ",0))
IF ENTRY
Begin DoDot:1
+12 IF $DATA(^ICD0(ENTRY,"MDC",1))
SET DIK="^DIK(ENTRY,""MDC"","
SET DA=1
SET DA(1)=ENTRY
DO ^DIK
+13 IF '$DATA(^ICD0(ENTRY,"MDC",0))
SET ^(0)="^80.12PA"
+14 SET DIC="^ICD0(ENTRY,""MDC"","
SET X=1
SET DIC("DR")="1///7;2///8"
SET DIC(0)="LM"
SET DA(1)=ENTRY
DO ^DIC
End DoDot:1
+15 ;MDC 5
+16 DO BMES^XPDUTL(">>>> Updating MDC 5 Procedure Codes")
+17 SET ENTRY=+$ORDER(^ICD0("BA","86.06 ",0))
IF ENTRY
Begin DoDot:1
+18 IF $DATA(^ICD0(ENTRY,"MDC",5))
SET DIK="^ICD0(ENTRY,""MDC"","
SET DA=5
SET DA(1)=ENTRY
DO ^DIK
+19 IF '$DATA(^ICD0(ENTRY,"MDC",0))
SET ^(0)="^80.12PA"
+20 SET DIC="^ICD0(ENTRY,""MDC"","
SET X=5
SET DIC("DR")="1///120"
SET DA(1)=ENTRY
SET DIC(0)="LM"
DO ^DIC
End DoDot:1
+21 ;MDC 4
+22 DO BMES^XPDUTL(">>> Updating MDC 4 Procedure Codes")
+23 SET ENTRY=+$ORDER(^ICD0("BA","39.50 ",0))
IF ENTRY
Begin DoDot:1
+24 IF $DATA(^ICD0(ENTRY,"MDC",4))
SET DIK="^ICD0(ENTRY,""MDC"","
SET DA=4
SET DA(1)=ENTRY
DO ^DIK
+25 IF '$DATA(^ICD0(ENTRY,"MDC",0))
SET ^(0)="^80.12PA"
+26 SET DIC="^ICD0(ENTRY,""MDC"","
SET X=4
SET DIC("DR")="1///76;2///77"
SET DA(1)=ENTRY
SET DIC(0)="LM"
DO ^DIC
End DoDot:1
+27 DO BMES^XPDUTL(">>> Changing Diagnostic Code as Valid Principal Diagnoses")
+28 SET DA=+$ORDER(^ICD9("BA","V71.9 ",0))
+29 IF DA
SET DIE="^ICD9("
SET DR="101///1;Q;101///@"
DO ^DIE
+30 QUIT
MDC22 ;;948.90^948.80^948.70^948.60^948.50^948.40^948.30^948.20^948.10^948.00
