AICDPREI ; IHS/OIT/FBD&NKD - ICD-10 LOAD PRE-INIT ;
;;4.0;AICD;;DEC 12, 2014;Build 7
;
;
D:'$D(IOM) HOME^%ZIS
;
D RESTORE ; RESTORE FROM BACKUP GLOBALS IF RE-INSTALLING
D BACKUP ; BACKUP ICD9 GLOBALS PRE-ICD10 CONTENT
D CONVERT ; CONVERT ICD9 CONTENT TO INCOMING ICD10 FILE STRUCTURE
D DDDEL ; DELETE ICD9 FILE STRUCTURE
;
; END OF PRE-INIT RUN LOGIC
Q
;
RESTORE ; PRE-LOAD RESTORE ON RE-INSTALLS
Q:'$$SYSCHK^AICDENV() ; SKIP IF NOT A RE-INSTALL
;
D MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: Creating backup of ICD10 content...",IOM))
K ^zzICD9,^zzICD0,^zzICD,^zzICM ; REMOVE PREVIOUS ICD10 BACKUP
M ^zzICD9=^ICD9 ; FILE 80
M ^zzICD0=^ICD0 ; FILE 80.1
M ^zzICD=^ICD ; FILE 80.2
M ^zzICM=^ICM ; FILE 80.3
;
D MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: 1) DELETE all existing ICD9 / ICD10 content",IOM))
K ^ICD9,^ICD0,^ICD,^ICM,^ICDS
;
D MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: 2) RESTORE ICD9 content from ^zICD9,^zICD0,^zICD,^zICM",IOM))
M ^ICD9=^zICD9 ; FILE 80
M ^ICD0=^zICD0 ; FILE 80.1
M ^ICD=^zICD ; FILE 80.2
M ^ICM=^zICM ; FILE 80.3
;
Q
;
BACKUP ; PRE-LOAD BACKUP OF ^ICD* GLOBALS TO ^zICD* COUNTERPART
;
; CREATE BACKUP IF IT DOESN'T ALREADY EXIST - THIS IS ICD9 CONTENT ONLY
D MES^XPDUTL($$LJ^XLFSTR("Creating pre-install backup of ICD globals...",IOM))
I '$D(^zICD9) M ^zICD9=^ICD9 ; FILE 80
I '$D(^zICD0) M ^zICD0=^ICD0 ; FILE 80.1
I '$D(^zICD) M ^zICD=^ICD ; FILE 80.2
I '$D(^zICM) M ^zICM=^ICM ; FILE 80.3
D MES^XPDUTL($$LJ^XLFSTR("Pre-install backup of ICD globals complete.",IOM))
Q
;
CONVERT ; ADDRESS IHS/VA CONFLICTING DATA NODES
;
N AICDCS,AICDDEDT,AICDLDT,AICDPTR,AICDDRG,AICD0
D MES^XPDUTL($$LJ^XLFSTR("Cleaning up IHS-added data nodes in conflict with VA file structure...",IOM))
S AICDDEDT=2851001 ; STARTER EFFECTIVE DATE FOR MISSING VERSIONED ICD9 FIELDS
S AICDLDT=3141001 ; LAST ICD9 FY UPDATED FOR SINGLE->VERSIONED ICD9 CONVERSION
;
; FILE 80
S AICDCS=$O(^AICDICDS("B","ICD-9-CM","")) ; EXTRACT CODE SET REF FROM INSTALL GLOBAL COPY OF ICD CODING SYSTEMS FILE
S AICDPTR=0 ; SCAN ALL FILE 80 ICD-9 ENTRIES
F S AICDPTR=$O(^ICD9(AICDPTR)) Q:(AICDPTR'=+AICDPTR)!(+AICDPTR>500000) D ; ICD-10 IENS START AT 500001
. S AICD0=$G(^ICD9(AICDPTR,0)) Q:'$L(AICD0,U) ; QUIT IF 0 NODE IS BLANK
. ;
. ; REMOVE DATA WE AREN'T KEEPING
. K ^ICD9(AICDPTR,1) ; IHS-ADDED DESCRIPTION FIELD #10
. K ^ICD9(AICDPTR,2100000) ; IHS-ADDED(?) UPDATE TRACKING FIELDS #2100000-21000002
. K ^ICD9(AICDPTR,9999999) ; IHS-ADDED AGE RESTRICTION FIELDS #9999999.01-9999999.07
. K ^ICD9(AICDPTR,"DRG") ; IHS-ADDED DRG FIELDS #61-65
. S AICDDRG=0 F S AICDDRG=$O(^ICD9(AICDPTR,66,AICDDRG)) Q:+AICDDRG'=AICDDRG D ; SCAN ANY/ALL STATUS NODES...
. . K ^ICD9(AICDPTR,66,AICDDRG,"DRG") ; ...AND FLUSH STATUS-DEPENDENT DRGS
. ;
. ; TRANSFER MAPPED SINGLE->SINGLE VALUE FIELDS
. S ^ICD9(AICDPTR,1)=AICDCS ; INSERT ICD-9 CM CODE SET REFERENCE
. S:$L($P(AICD0,U,2)) $P(^ICD9(AICDPTR,1),U,2)=$P(AICD0,U,2) ; FIELD #2->#1.2 - IDENTIFIER
. S:$L($P(AICD0,U,4)) $P(^ICD9(AICDPTR,1),U,3)=$P(AICD0,U,4) ; FIELD #101->#1.3 - UNACCEPTABLE AS PRINCIPAL DX
. S:$L($P(AICD0,U,6)) $P(^ICD9(AICDPTR,1),U,4)=$P(AICD0,U,6) ; FIELD #5.5->#1.4 - MDC13
. S:$L($P(AICD0,U,12)) $P(^ICD9(AICDPTR,1),U,5)=$P(AICD0,U,12) ; FIELD #5.7->#1.5 - MDC24
. S:$L($P(AICD0,U,13)) $P(^ICD9(AICDPTR,1),U,6)=$P(AICD0,U,13) ; FIELD #5.9->#1.6 - MDC25
. S:$L($P(AICD0,U,8)) $P(^ICD9(AICDPTR,1),U,7)=$P(AICD0,U,8) ; FIELD #8->#1.7 - ICD EXPANDED
. ;
. ; TRANSFER MAPPED SINGLE->VERSIONED VALUE FIELDS
. I +$O(^ICD9(AICDPTR,66,"B",AICDLDT,0)) D ; WAS THIS CODE UPDATED IN THE LAST ICD9 FY UPDATE?
. . ; SEX (#9.5)
. . S:$L($P(AICD0,U,10)) ^ICD9(AICDPTR,5,0)="^80.04D^1^1",^ICD9(AICDPTR,5,1,0)=AICDLDT_U_$P(AICD0,U,10)
. . ; AGE LOW (#14)
. . S:$L($P(AICD0,U,14)) ^ICD9(AICDPTR,6,0)="^80.011D^1^1",^ICD9(AICDPTR,6,1,0)=AICDLDT_U_(+$P(AICD0,U,14)\365)
. . ; AGE HIGH (#15)
. . S:$L($P(AICD0,U,15)) ^ICD9(AICDPTR,7,0)="^80.012D^1^1",^ICD9(AICDPTR,7,1,0)=AICDLDT_U_(+$P(AICD0,U,15)\365)
. ;
. ; FIX MISSING FIELDS IF NEEDED
. ; STATUS - SET AS ACTIVE (1)
. S:'$D(^ICD9(AICDPTR,66)) ^ICD9(AICDPTR,66,0)="^80.066D^1^1",^ICD9(AICDPTR,66,1,0)=AICDDEDT_"^1"
. ; DIAGNOSIS - FORMER DIAGNOSIS FIELD #3 USED FOR STARTER DIAGNOSIS
. S:'$D(^ICD9(AICDPTR,67)) ^ICD9(AICDPTR,67,0)="^80.067D^1^1",^ICD9(AICDPTR,67,1,0)=AICDDEDT_U_$P(AICD0,U,3)
. ; DESCRIPTION - FORMER DIAGNOSIS FIELD #3 USED FOR STARTER DESCRIPTION
. S:'$D(^ICD9(AICDPTR,68)) ^ICD9(AICDPTR,68,0)="^80.068D^1^1",^ICD9(AICDPTR,68,1,0)=AICDDEDT,^ICD9(AICDPTR,68,1,1)=$P(AICD0,U,3)
. ;
. ; REMOVAL OF RELOCATED FIELDS
. S ^ICD9(AICDPTR,0)=$P(AICD0,U,1)
;
; FILE 80.1
S AICDCS=$O(^AICDICDS("B","ICD-9 Proc","")) ; EXTRACT CODE SET REF FROM INSTALL GLOBAL COPY OF ICD CODING SYSTEMS FILE
S AICDPTR=0 ; SCAN ALL FILE 80.1 ICD-9 ENTRIES
F S AICDPTR=$O(^ICD0(AICDPTR)) Q:(AICDPTR'=+AICDPTR)!(+AICDPTR>500000) D ; ICD-10 IENS START AT 500001
. S AICD0=$G(^ICD0(AICDPTR,0)) Q:'$L(AICD0,U) ; QUIT IF 0 NODE IS BLANK
. ;
. ; REMOVE DATA WE AREN'T KEEPING
. K ^ICD0(AICDPTR,1) ; IHS-ADDED DESCRIPTION FIELD #10
. K ^ICD0(AICDPTR,2100000) ; IHS-ADDED(?) UPDATE TRACKING FIELDS #2100000-21000002
. K ^ICD0(AICDPTR,9999999) ; IHS-ADDED AGE RESTRICTION FIELDS #9999999.01-9999999.07
. K ^ICD0(AICDPTR,"MDC") ; IHS-ADDED MDC/DRG FIELDS #7
. S AICDDRG=0 F S AICDDRG=$O(^ICD0(AICDPTR,66,AICDDRG)) Q:+AICDDRG'=AICDDRG D ; SCAN ANY/ALL STATUS NODES...
. . K ^ICD0(AICDPTR,66,AICDDRG,"DRG") ; ...AND FLUSH STATUS-DEPENDENT DRGS
. ;
. ; TRANSFER MAPPED SINGLE->SINGLE VALUE FIELDS
. S ^ICD0(AICDPTR,1)=AICDCS ; INSERT ICD-9 PROCEDURE CODE SET REFERENCE
. S:$L($P(AICD0,U,2)) $P(^ICD0(AICDPTR,1),U,2)=$P(AICD0,U,2) ; FIELD #2->#1.2 - IDENTIFIER
. S:$L($P(AICD0,U,3)) $P(^ICD0(AICDPTR,1),U,5)=$P(AICD0,U,3) ; FIELD #5->#1.5 - MDC24
. S:$L($P(AICD0,U,8)) $P(^ICD0(AICDPTR,1),U,7)=$P(AICD0,U,8) ; FIELD #8->#1.7 - ICD EXPANDED
. ;
. ; TRANSFER MAPPED SINGLE->VERSIONED VALUE FIELDS
. I +$O(^ICD0(AICDPTR,66,"B",AICDLDT,0)) D ; WAS THIS CODE UPDATED IN THE LAST ICD9 FY UPDATE?
. . ; USE ONLY WITH SEX (#9.5)
. . S:$L($P(AICD0,U,10)) ^ICD0(AICDPTR,3,0)="^80.11D^1^1",^ICD0(AICDPTR,3,1,0)=AICDLDT_U_$P(AICD0,U,10)
. ;
. ; FIX MISSING FIELDS IF NEEDED
. ; STATUS - SET AS ACTIVE (1)
. S:'$D(^ICD0(AICDPTR,66)) ^ICD0(AICDPTR,66,0)="^80.166D^1^1",^ICD0(AICDPTR,66,1,0)=AICDDEDT_"^1"
. ; OPERATION/PROCEDURE - FORMER OPERATION/PROCEDURE FIELD #4 USED FOR STARTER OPERATION/PROCEDURE ENTRY
. S:'$D(^ICD0(AICDPTR,67)) ^ICD0(AICDPTR,67,0)="^80.167D^1^1",^ICD0(AICDPTR,67,1,0)=AICDDEDT_U_$P(AICD0,U,4)
. ; DESCRIPTION - FORMER OPERATION/PROCEDURE FIELD #4 USED FOR STARTER DESCRIPTION ENTRY
. S:'$D(^ICD0(AICDPTR,68)) ^ICD0(AICDPTR,68,0)="^80.168D^1^1",^ICD0(AICDPTR,68,1,0)=AICDDEDT,^ICD0(AICDPTR,68,1,1)=$P(AICD0,U,4)
. ;
. ; REMOVAL OF RELOCATED FIELDS
. S ^ICD0(AICDPTR,0)=$P(AICD0,U,1)
;
D MES^XPDUTL($$LJ^XLFSTR("Data node cleanup complete.",IOM))
;
Q
;
DDDEL ; FILE 80 & 80.1 DD CLEANUP
N DIU,AICDDD
D MES^XPDUTL($$LJ^XLFSTR("Deleting data dictionaries of affected ICD files...",IOM))
K DIU S DIU(0)="T"
F AICDDD=80,80.1 D ;
. D MES^XPDUTL($$LJ^XLFSTR(" - File "_AICDDD,IOM))
.S DIU=AICDDD
.D EN^DIU2
D ^XBFMK
Q
;
SORRY(X) ;
KILL DIFQ
I X=3 S XPDQUIT=2 Q
S XPDQUIT=X
D MES^XPDUTL($$LJ^XLFSTR("Aborting pre-init process.",IOM))
Q
;
AICDPREI ; IHS/OIT/FBD&NKD - ICD-10 LOAD PRE-INIT ;
+1 ;;4.0;AICD;;DEC 12, 2014;Build 7
+2 ;
+3 ;
+4 IF '$DATA(IOM)
DO HOME^%ZIS
+5 ;
+6 ; RESTORE FROM BACKUP GLOBALS IF RE-INSTALLING
DO RESTORE
+7 ; BACKUP ICD9 GLOBALS PRE-ICD10 CONTENT
DO BACKUP
+8 ; CONVERT ICD9 CONTENT TO INCOMING ICD10 FILE STRUCTURE
DO CONVERT
+9 ; DELETE ICD9 FILE STRUCTURE
DO DDDEL
+10 ;
+11 ; END OF PRE-INIT RUN LOGIC
+12 QUIT
+13 ;
RESTORE ; PRE-LOAD RESTORE ON RE-INSTALLS
+1 ; SKIP IF NOT A RE-INSTALL
IF '$$SYSCHK^AICDENV()
QUIT
+2 ;
+3 DO MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: Creating backup of ICD10 content...",IOM))
+4 ; REMOVE PREVIOUS ICD10 BACKUP
KILL ^zzICD9,^zzICD0,^zzICD,^zzICM
+5 ; FILE 80
MERGE ^zzICD9=^ICD9
+6 ; FILE 80.1
MERGE ^zzICD0=^ICD0
+7 ; FILE 80.2
MERGE ^zzICD=^ICD
+8 ; FILE 80.3
MERGE ^zzICM=^ICM
+9 ;
+10 DO MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: 1) DELETE all existing ICD9 / ICD10 content",IOM))
+11 KILL ^ICD9,^ICD0,^ICD,^ICM,^ICDS
+12 ;
+13 DO MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: 2) RESTORE ICD9 content from ^zICD9,^zICD0,^zICD,^zICM",IOM))
+14 ; FILE 80
MERGE ^ICD9=^zICD9
+15 ; FILE 80.1
MERGE ^ICD0=^zICD0
+16 ; FILE 80.2
MERGE ^ICD=^zICD
+17 ; FILE 80.3
MERGE ^ICM=^zICM
+18 ;
+19 QUIT
+20 ;
BACKUP ; PRE-LOAD BACKUP OF ^ICD* GLOBALS TO ^zICD* COUNTERPART
+1 ;
+2 ; CREATE BACKUP IF IT DOESN'T ALREADY EXIST - THIS IS ICD9 CONTENT ONLY
+3 DO MES^XPDUTL($$LJ^XLFSTR("Creating pre-install backup of ICD globals...",IOM))
+4 ; FILE 80
IF '$DATA(^zICD9)
MERGE ^zICD9=^ICD9
+5 ; FILE 80.1
IF '$DATA(^zICD0)
MERGE ^zICD0=^ICD0
+6 ; FILE 80.2
IF '$DATA(^zICD)
MERGE ^zICD=^ICD
+7 ; FILE 80.3
IF '$DATA(^zICM)
MERGE ^zICM=^ICM
+8 DO MES^XPDUTL($$LJ^XLFSTR("Pre-install backup of ICD globals complete.",IOM))
+9 QUIT
+10 ;
CONVERT ; ADDRESS IHS/VA CONFLICTING DATA NODES
+1 ;
+2 NEW AICDCS,AICDDEDT,AICDLDT,AICDPTR,AICDDRG,AICD0
+3 DO MES^XPDUTL($$LJ^XLFSTR("Cleaning up IHS-added data nodes in conflict with VA file structure...",IOM))
+4 ; STARTER EFFECTIVE DATE FOR MISSING VERSIONED ICD9 FIELDS
SET AICDDEDT=2851001
+5 ; LAST ICD9 FY UPDATED FOR SINGLE->VERSIONED ICD9 CONVERSION
SET AICDLDT=3141001
+6 ;
+7 ; FILE 80
+8 ; EXTRACT CODE SET REF FROM INSTALL GLOBAL COPY OF ICD CODING SYSTEMS FILE
SET AICDCS=$ORDER(^AICDICDS("B","ICD-9-CM",""))
+9 ; SCAN ALL FILE 80 ICD-9 ENTRIES
SET AICDPTR=0
+10 ; ICD-10 IENS START AT 500001
FOR
SET AICDPTR=$ORDER(^ICD9(AICDPTR))
IF (AICDPTR'=+AICDPTR)!(+AICDPTR>500000)
QUIT
Begin DoDot:1
+11 ; QUIT IF 0 NODE IS BLANK
SET AICD0=$GET(^ICD9(AICDPTR,0))
IF '$LENGTH(AICD0,U)
QUIT
+12 ;
+13 ; REMOVE DATA WE AREN'T KEEPING
+14 ; IHS-ADDED DESCRIPTION FIELD #10
KILL ^ICD9(AICDPTR,1)
+15 ; IHS-ADDED(?) UPDATE TRACKING FIELDS #2100000-21000002
KILL ^ICD9(AICDPTR,2100000)
+16 ; IHS-ADDED AGE RESTRICTION FIELDS #9999999.01-9999999.07
KILL ^ICD9(AICDPTR,9999999)
+17 ; IHS-ADDED DRG FIELDS #61-65
KILL ^ICD9(AICDPTR,"DRG")
+18 ; SCAN ANY/ALL STATUS NODES...
SET AICDDRG=0
FOR
SET AICDDRG=$ORDER(^ICD9(AICDPTR,66,AICDDRG))
IF +AICDDRG'=AICDDRG
QUIT
Begin DoDot:2
+19 ; ...AND FLUSH STATUS-DEPENDENT DRGS
KILL ^ICD9(AICDPTR,66,AICDDRG,"DRG")
End DoDot:2
+20 ;
+21 ; TRANSFER MAPPED SINGLE->SINGLE VALUE FIELDS
+22 ; INSERT ICD-9 CM CODE SET REFERENCE
SET ^ICD9(AICDPTR,1)=AICDCS
+23 ; FIELD #2->#1.2 - IDENTIFIER
IF $LENGTH($PIECE(AICD0,U,2))
SET $PIECE(^ICD9(AICDPTR,1),U,2)=$PIECE(AICD0,U,2)
+24 ; FIELD #101->#1.3 - UNACCEPTABLE AS PRINCIPAL DX
IF $LENGTH($PIECE(AICD0,U,4))
SET $PIECE(^ICD9(AICDPTR,1),U,3)=$PIECE(AICD0,U,4)
+25 ; FIELD #5.5->#1.4 - MDC13
IF $LENGTH($PIECE(AICD0,U,6))
SET $PIECE(^ICD9(AICDPTR,1),U,4)=$PIECE(AICD0,U,6)
+26 ; FIELD #5.7->#1.5 - MDC24
IF $LENGTH($PIECE(AICD0,U,12))
SET $PIECE(^ICD9(AICDPTR,1),U,5)=$PIECE(AICD0,U,12)
+27 ; FIELD #5.9->#1.6 - MDC25
IF $LENGTH($PIECE(AICD0,U,13))
SET $PIECE(^ICD9(AICDPTR,1),U,6)=$PIECE(AICD0,U,13)
+28 ; FIELD #8->#1.7 - ICD EXPANDED
IF $LENGTH($PIECE(AICD0,U,8))
SET $PIECE(^ICD9(AICDPTR,1),U,7)=$PIECE(AICD0,U,8)
+29 ;
+30 ; TRANSFER MAPPED SINGLE->VERSIONED VALUE FIELDS
+31 ; WAS THIS CODE UPDATED IN THE LAST ICD9 FY UPDATE?
IF +$ORDER(^ICD9(AICDPTR,66,"B",AICDLDT,0))
Begin DoDot:2
+32 ; SEX (#9.5)
+33 IF $LENGTH($PIECE(AICD0,U,10))
SET ^ICD9(AICDPTR,5,0)="^80.04D^1^1"
SET ^ICD9(AICDPTR,5,1,0)=AICDLDT_U_$PIECE(AICD0,U,10)
+34 ; AGE LOW (#14)
+35 IF $LENGTH($PIECE(AICD0,U,14))
SET ^ICD9(AICDPTR,6,0)="^80.011D^1^1"
SET ^ICD9(AICDPTR,6,1,0)=AICDLDT_U_(+$PIECE(AICD0,U,14)\365)
+36 ; AGE HIGH (#15)
+37 IF $LENGTH($PIECE(AICD0,U,15))
SET ^ICD9(AICDPTR,7,0)="^80.012D^1^1"
SET ^ICD9(AICDPTR,7,1,0)=AICDLDT_U_(+$PIECE(AICD0,U,15)\365)
End DoDot:2
+38 ;
+39 ; FIX MISSING FIELDS IF NEEDED
+40 ; STATUS - SET AS ACTIVE (1)
+41 IF '$DATA(^ICD9(AICDPTR,66))
SET ^ICD9(AICDPTR,66,0)="^80.066D^1^1"
SET ^ICD9(AICDPTR,66,1,0)=AICDDEDT_"^1"
+42 ; DIAGNOSIS - FORMER DIAGNOSIS FIELD #3 USED FOR STARTER DIAGNOSIS
+43 IF '$DATA(^ICD9(AICDPTR,67))
SET ^ICD9(AICDPTR,67,0)="^80.067D^1^1"
SET ^ICD9(AICDPTR,67,1,0)=AICDDEDT_U_$PIECE(AICD0,U,3)
+44 ; DESCRIPTION - FORMER DIAGNOSIS FIELD #3 USED FOR STARTER DESCRIPTION
+45 IF '$DATA(^ICD9(AICDPTR,68))
SET ^ICD9(AICDPTR,68,0)="^80.068D^1^1"
SET ^ICD9(AICDPTR,68,1,0)=AICDDEDT
SET ^ICD9(AICDPTR,68,1,1)=$PIECE(AICD0,U,3)
+46 ;
+47 ; REMOVAL OF RELOCATED FIELDS
+48 SET ^ICD9(AICDPTR,0)=$PIECE(AICD0,U,1)
End DoDot:1
+49 ;
+50 ; FILE 80.1
+51 ; EXTRACT CODE SET REF FROM INSTALL GLOBAL COPY OF ICD CODING SYSTEMS FILE
SET AICDCS=$ORDER(^AICDICDS("B","ICD-9 Proc",""))
+52 ; SCAN ALL FILE 80.1 ICD-9 ENTRIES
SET AICDPTR=0
+53 ; ICD-10 IENS START AT 500001
FOR
SET AICDPTR=$ORDER(^ICD0(AICDPTR))
IF (AICDPTR'=+AICDPTR)!(+AICDPTR>500000)
QUIT
Begin DoDot:1
+54 ; QUIT IF 0 NODE IS BLANK
SET AICD0=$GET(^ICD0(AICDPTR,0))
IF '$LENGTH(AICD0,U)
QUIT
+55 ;
+56 ; REMOVE DATA WE AREN'T KEEPING
+57 ; IHS-ADDED DESCRIPTION FIELD #10
KILL ^ICD0(AICDPTR,1)
+58 ; IHS-ADDED(?) UPDATE TRACKING FIELDS #2100000-21000002
KILL ^ICD0(AICDPTR,2100000)
+59 ; IHS-ADDED AGE RESTRICTION FIELDS #9999999.01-9999999.07
KILL ^ICD0(AICDPTR,9999999)
+60 ; IHS-ADDED MDC/DRG FIELDS #7
KILL ^ICD0(AICDPTR,"MDC")
+61 ; SCAN ANY/ALL STATUS NODES...
SET AICDDRG=0
FOR
SET AICDDRG=$ORDER(^ICD0(AICDPTR,66,AICDDRG))
IF +AICDDRG'=AICDDRG
QUIT
Begin DoDot:2
+62 ; ...AND FLUSH STATUS-DEPENDENT DRGS
KILL ^ICD0(AICDPTR,66,AICDDRG,"DRG")
End DoDot:2
+63 ;
+64 ; TRANSFER MAPPED SINGLE->SINGLE VALUE FIELDS
+65 ; INSERT ICD-9 PROCEDURE CODE SET REFERENCE
SET ^ICD0(AICDPTR,1)=AICDCS
+66 ; FIELD #2->#1.2 - IDENTIFIER
IF $LENGTH($PIECE(AICD0,U,2))
SET $PIECE(^ICD0(AICDPTR,1),U,2)=$PIECE(AICD0,U,2)
+67 ; FIELD #5->#1.5 - MDC24
IF $LENGTH($PIECE(AICD0,U,3))
SET $PIECE(^ICD0(AICDPTR,1),U,5)=$PIECE(AICD0,U,3)
+68 ; FIELD #8->#1.7 - ICD EXPANDED
IF $LENGTH($PIECE(AICD0,U,8))
SET $PIECE(^ICD0(AICDPTR,1),U,7)=$PIECE(AICD0,U,8)
+69 ;
+70 ; TRANSFER MAPPED SINGLE->VERSIONED VALUE FIELDS
+71 ; WAS THIS CODE UPDATED IN THE LAST ICD9 FY UPDATE?
IF +$ORDER(^ICD0(AICDPTR,66,"B",AICDLDT,0))
Begin DoDot:2
+72 ; USE ONLY WITH SEX (#9.5)
+73 IF $LENGTH($PIECE(AICD0,U,10))
SET ^ICD0(AICDPTR,3,0)="^80.11D^1^1"
SET ^ICD0(AICDPTR,3,1,0)=AICDLDT_U_$PIECE(AICD0,U,10)
End DoDot:2
+74 ;
+75 ; FIX MISSING FIELDS IF NEEDED
+76 ; STATUS - SET AS ACTIVE (1)
+77 IF '$DATA(^ICD0(AICDPTR,66))
SET ^ICD0(AICDPTR,66,0)="^80.166D^1^1"
SET ^ICD0(AICDPTR,66,1,0)=AICDDEDT_"^1"
+78 ; OPERATION/PROCEDURE - FORMER OPERATION/PROCEDURE FIELD #4 USED FOR STARTER OPERATION/PROCEDURE ENTRY
+79 IF '$DATA(^ICD0(AICDPTR,67))
SET ^ICD0(AICDPTR,67,0)="^80.167D^1^1"
SET ^ICD0(AICDPTR,67,1,0)=AICDDEDT_U_$PIECE(AICD0,U,4)
+80 ; DESCRIPTION - FORMER OPERATION/PROCEDURE FIELD #4 USED FOR STARTER DESCRIPTION ENTRY
+81 IF '$DATA(^ICD0(AICDPTR,68))
SET ^ICD0(AICDPTR,68,0)="^80.168D^1^1"
SET ^ICD0(AICDPTR,68,1,0)=AICDDEDT
SET ^ICD0(AICDPTR,68,1,1)=$PIECE(AICD0,U,4)
+82 ;
+83 ; REMOVAL OF RELOCATED FIELDS
+84 SET ^ICD0(AICDPTR,0)=$PIECE(AICD0,U,1)
End DoDot:1
+85 ;
+86 DO MES^XPDUTL($$LJ^XLFSTR("Data node cleanup complete.",IOM))
+87 ;
+88 QUIT
+89 ;
DDDEL ; FILE 80 & 80.1 DD CLEANUP
+1 NEW DIU,AICDDD
+2 DO MES^XPDUTL($$LJ^XLFSTR("Deleting data dictionaries of affected ICD files...",IOM))
+3 KILL DIU
SET DIU(0)="T"
+4 ;
FOR AICDDD=80,80.1
Begin DoDot:1
+5 DO MES^XPDUTL($$LJ^XLFSTR(" - File "_AICDDD,IOM))
+6 SET DIU=AICDDD
+7 DO EN^DIU2
End DoDot:1
+8 DO ^XBFMK
+9 QUIT
+10 ;
SORRY(X) ;
+1 KILL DIFQ
+2 IF X=3
SET XPDQUIT=2
QUIT
+3 SET XPDQUIT=X
+4 DO MES^XPDUTL($$LJ^XLFSTR("Aborting pre-init process.",IOM))
+5 QUIT
+6 ;
