Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AICDPREI

AICDPREI.m

Go to the documentation of this file. 
  1. AICDPREI ; IHS/OIT/FBD&NKD - ICD-10 LOAD PRE-INIT ;   
  1.  ;;4.0;AICD;;DEC 12, 2014;Build 7
  1.  ;
  1.  ;
  1.  D:'$D(IOM) HOME^%ZIS
  1.  ;
  1.  D RESTORE  ; RESTORE FROM BACKUP GLOBALS IF RE-INSTALLING
  1.  D BACKUP   ; BACKUP ICD9 GLOBALS PRE-ICD10 CONTENT
  1.  D CONVERT  ; CONVERT ICD9 CONTENT TO INCOMING ICD10 FILE STRUCTURE
  1.  D DDDEL    ; DELETE ICD9 FILE STRUCTURE
  1.  ;
  1.  ; END OF PRE-INIT RUN LOGIC
  1.  Q
  1.  ;
  1. RESTORE ; PRE-LOAD RESTORE ON RE-INSTALLS
  1.  Q:'$$SYSCHK^AICDENV()  ; SKIP IF NOT A RE-INSTALL
  1.  ;
  1.  D MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: Creating backup of ICD10 content...",IOM))
  1.  K ^zzICD9,^zzICD0,^zzICD,^zzICM  ; REMOVE PREVIOUS ICD10 BACKUP
  1.  M ^zzICD9=^ICD9  ; FILE 80
  1.  M ^zzICD0=^ICD0  ; FILE 80.1
  1.  M ^zzICD=^ICD    ; FILE 80.2
  1.  M ^zzICM=^ICM    ; FILE 80.3
  1.  ;
  1.  D MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: 1) DELETE all existing ICD9 / ICD10 content",IOM))
  1.  K ^ICD9,^ICD0,^ICD,^ICM,^ICDS
  1.  ;
  1.  D MES^XPDUTL($$LJ^XLFSTR("AICD RE-INSTALL: 2) RESTORE ICD9 content from ^zICD9,^zICD0,^zICD,^zICM",IOM))
  1.  M ^ICD9=^zICD9  ; FILE 80
  1.  M ^ICD0=^zICD0  ; FILE 80.1
  1.  M ^ICD=^zICD    ; FILE 80.2
  1.  M ^ICM=^zICM    ; FILE 80.3
  1.  ;
  1.  Q
  1.  ;
  1. BACKUP ; PRE-LOAD BACKUP OF ^ICD* GLOBALS TO ^zICD* COUNTERPART
  1.  ;
  1.  ; CREATE BACKUP IF IT DOESN'T ALREADY EXIST - THIS IS ICD9 CONTENT ONLY
  1.  D MES^XPDUTL($$LJ^XLFSTR("Creating pre-install backup of ICD globals...",IOM))
  1.  I '$D(^zICD9) M ^zICD9=^ICD9  ; FILE 80
  1.  I '$D(^zICD0) M ^zICD0=^ICD0  ; FILE 80.1
  1.  I '$D(^zICD) M ^zICD=^ICD     ; FILE 80.2
  1.  I '$D(^zICM) M ^zICM=^ICM     ; FILE 80.3
  1.  D MES^XPDUTL($$LJ^XLFSTR("Pre-install backup of ICD globals complete.",IOM))
  1.  Q
  1.  ;
  1. CONVERT ; ADDRESS IHS/VA CONFLICTING DATA NODES
  1.  ;
  1.  N AICDCS,AICDDEDT,AICDLDT,AICDPTR,AICDDRG,AICD0
  1.  D MES^XPDUTL($$LJ^XLFSTR("Cleaning up IHS-added data nodes in conflict with VA file structure...",IOM))
  1.  S AICDDEDT=2851001  ; STARTER EFFECTIVE DATE FOR MISSING VERSIONED ICD9 FIELDS
  1.  S AICDLDT=3141001   ; LAST ICD9 FY UPDATED FOR SINGLE->VERSIONED ICD9 CONVERSION
  1.  ;
  1.  ; FILE 80
  1.  S AICDCS=$O(^AICDICDS("B","ICD-9-CM",""))  ; EXTRACT CODE SET REF FROM INSTALL GLOBAL COPY OF ICD CODING SYSTEMS FILE
  1.  S AICDPTR=0                                                                 ; SCAN ALL FILE 80 ICD-9 ENTRIES
  1.  F  S AICDPTR=$O(^ICD9(AICDPTR)) Q:(AICDPTR'=+AICDPTR)!(+AICDPTR>500000)  D  ;  ICD-10 IENS START AT 500001
  1.  . S AICD0=$G(^ICD9(AICDPTR,0)) Q:'$L(AICD0,U)  ; QUIT IF 0 NODE IS BLANK
  1.  . ;
  1.  . ; REMOVE DATA WE AREN'T KEEPING
  1.  . K ^ICD9(AICDPTR,1)        ; IHS-ADDED DESCRIPTION FIELD #10
  1.  . K ^ICD9(AICDPTR,2100000)  ; IHS-ADDED(?) UPDATE TRACKING FIELDS #2100000-21000002
  1.  . K ^ICD9(AICDPTR,9999999)  ; IHS-ADDED AGE RESTRICTION FIELDS #9999999.01-9999999.07
  1.  . K ^ICD9(AICDPTR,"DRG")    ; IHS-ADDED DRG FIELDS #61-65
  1.  . S AICDDRG=0 F  S AICDDRG=$O(^ICD9(AICDPTR,66,AICDDRG)) Q:+AICDDRG'=AICDDRG  D  ; SCAN ANY/ALL STATUS NODES...
  1.  . . K ^ICD9(AICDPTR,66,AICDDRG,"DRG")                                            ;  ...AND FLUSH STATUS-DEPENDENT DRGS
  1.  . ;
  1.  . ; TRANSFER MAPPED SINGLE->SINGLE VALUE FIELDS
  1.  . S ^ICD9(AICDPTR,1)=AICDCS  ; INSERT ICD-9 CM CODE SET REFERENCE
  1.  . S:$L($P(AICD0,U,2)) $P(^ICD9(AICDPTR,1),U,2)=$P(AICD0,U,2)    ; FIELD #2->#1.2 - IDENTIFIER
  1.  . S:$L($P(AICD0,U,4)) $P(^ICD9(AICDPTR,1),U,3)=$P(AICD0,U,4)    ; FIELD #101->#1.3 - UNACCEPTABLE AS PRINCIPAL DX
  1.  . S:$L($P(AICD0,U,6)) $P(^ICD9(AICDPTR,1),U,4)=$P(AICD0,U,6)    ; FIELD #5.5->#1.4 - MDC13
  1.  . S:$L($P(AICD0,U,12)) $P(^ICD9(AICDPTR,1),U,5)=$P(AICD0,U,12)  ; FIELD #5.7->#1.5 - MDC24
  1.  . S:$L($P(AICD0,U,13)) $P(^ICD9(AICDPTR,1),U,6)=$P(AICD0,U,13)  ; FIELD #5.9->#1.6 - MDC25
  1.  . S:$L($P(AICD0,U,8)) $P(^ICD9(AICDPTR,1),U,7)=$P(AICD0,U,8)    ; FIELD #8->#1.7 - ICD EXPANDED
  1.  . ;
  1.  . ; TRANSFER MAPPED SINGLE->VERSIONED VALUE FIELDS
  1.  . I +$O(^ICD9(AICDPTR,66,"B",AICDLDT,0)) D  ; WAS THIS CODE UPDATED IN THE LAST ICD9 FY UPDATE?
  1.  . . ; SEX (#9.5)
  1.  . . 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)
  1.  . . ; AGE LOW (#14)
  1.  . . 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)
  1.  . . ; AGE HIGH (#15)
  1.  . . 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)
  1.  . ;
  1.  . ; FIX MISSING FIELDS IF NEEDED
  1.  . ; STATUS - SET AS ACTIVE (1)
  1.  . S:'$D(^ICD9(AICDPTR,66)) ^ICD9(AICDPTR,66,0)="^80.066D^1^1",^ICD9(AICDPTR,66,1,0)=AICDDEDT_"^1"
  1.  . ; DIAGNOSIS - FORMER DIAGNOSIS FIELD #3 USED FOR STARTER DIAGNOSIS
  1.  . S:'$D(^ICD9(AICDPTR,67)) ^ICD9(AICDPTR,67,0)="^80.067D^1^1",^ICD9(AICDPTR,67,1,0)=AICDDEDT_U_$P(AICD0,U,3)
  1.  . ; DESCRIPTION - FORMER DIAGNOSIS FIELD #3 USED FOR STARTER DESCRIPTION
  1.  . 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)
  1.  . ;
  1.  . ; REMOVAL OF RELOCATED FIELDS
  1.  . S ^ICD9(AICDPTR,0)=$P(AICD0,U,1)
  1.  ;
  1.  ; FILE 80.1
  1.  S AICDCS=$O(^AICDICDS("B","ICD-9 Proc",""))  ; EXTRACT CODE SET REF FROM INSTALL GLOBAL COPY OF ICD CODING SYSTEMS FILE
  1.  S AICDPTR=0                                                                 ; SCAN ALL FILE 80.1 ICD-9 ENTRIES
  1.  F  S AICDPTR=$O(^ICD0(AICDPTR)) Q:(AICDPTR'=+AICDPTR)!(+AICDPTR>500000)  D  ;  ICD-10 IENS START AT 500001
  1.  . S AICD0=$G(^ICD0(AICDPTR,0)) Q:'$L(AICD0,U)  ; QUIT IF 0 NODE IS BLANK
  1.  . ;
  1.  . ; REMOVE DATA WE AREN'T KEEPING
  1.  . K ^ICD0(AICDPTR,1)        ; IHS-ADDED DESCRIPTION FIELD #10
  1.  . K ^ICD0(AICDPTR,2100000)  ; IHS-ADDED(?) UPDATE TRACKING FIELDS #2100000-21000002
  1.  . K ^ICD0(AICDPTR,9999999)  ; IHS-ADDED AGE RESTRICTION FIELDS #9999999.01-9999999.07
  1.  . K ^ICD0(AICDPTR,"MDC")    ; IHS-ADDED MDC/DRG FIELDS #7
  1.  . S AICDDRG=0 F  S AICDDRG=$O(^ICD0(AICDPTR,66,AICDDRG)) Q:+AICDDRG'=AICDDRG  D  ; SCAN ANY/ALL STATUS NODES...
  1.  . . K ^ICD0(AICDPTR,66,AICDDRG,"DRG")                                            ; ...AND FLUSH STATUS-DEPENDENT DRGS
  1.  . ;
  1.  . ; TRANSFER MAPPED SINGLE->SINGLE VALUE FIELDS
  1.  . S ^ICD0(AICDPTR,1)=AICDCS  ; INSERT ICD-9 PROCEDURE CODE SET REFERENCE
  1.  . S:$L($P(AICD0,U,2)) $P(^ICD0(AICDPTR,1),U,2)=$P(AICD0,U,2)  ; FIELD #2->#1.2 - IDENTIFIER
  1.  . S:$L($P(AICD0,U,3)) $P(^ICD0(AICDPTR,1),U,5)=$P(AICD0,U,3)  ; FIELD #5->#1.5 - MDC24
  1.  . S:$L($P(AICD0,U,8)) $P(^ICD0(AICDPTR,1),U,7)=$P(AICD0,U,8)  ; FIELD #8->#1.7 - ICD EXPANDED
  1.  . ;
  1.  . ; TRANSFER MAPPED SINGLE->VERSIONED VALUE FIELDS
  1.  . I +$O(^ICD0(AICDPTR,66,"B",AICDLDT,0)) D  ; WAS THIS CODE UPDATED IN THE LAST ICD9 FY UPDATE?
  1.  . . ; USE ONLY WITH SEX (#9.5)
  1.  . . 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)
  1.  . ;
  1.  . ; FIX MISSING FIELDS IF NEEDED
  1.  . ; STATUS - SET AS ACTIVE (1)
  1.  . S:'$D(^ICD0(AICDPTR,66)) ^ICD0(AICDPTR,66,0)="^80.166D^1^1",^ICD0(AICDPTR,66,1,0)=AICDDEDT_"^1"
  1.  . ; OPERATION/PROCEDURE - FORMER OPERATION/PROCEDURE FIELD #4 USED FOR STARTER OPERATION/PROCEDURE ENTRY
  1.  . S:'$D(^ICD0(AICDPTR,67)) ^ICD0(AICDPTR,67,0)="^80.167D^1^1",^ICD0(AICDPTR,67,1,0)=AICDDEDT_U_$P(AICD0,U,4)
  1.  . ; DESCRIPTION - FORMER OPERATION/PROCEDURE FIELD #4 USED FOR STARTER DESCRIPTION ENTRY
  1.  . 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)
  1.  . ;
  1.  . ; REMOVAL OF RELOCATED FIELDS
  1.  . S ^ICD0(AICDPTR,0)=$P(AICD0,U,1)
  1.  ;
  1.  D MES^XPDUTL($$LJ^XLFSTR("Data node cleanup complete.",IOM))
  1.  ;
  1.  Q
  1.  ;
  1. DDDEL ; FILE 80 & 80.1 DD CLEANUP
  1.  N DIU,AICDDD
  1.  D MES^XPDUTL($$LJ^XLFSTR("Deleting data dictionaries of affected ICD files...",IOM))
  1.  K DIU S DIU(0)="T"
  1.  F AICDDD=80,80.1 D  ;
  1.  . D MES^XPDUTL($$LJ^XLFSTR(" - File "_AICDDD,IOM))
  1.  .S DIU=AICDDD
  1.  .D EN^DIU2
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  D MES^XPDUTL($$LJ^XLFSTR("Aborting pre-init process.",IOM))
  1.  Q
  1.  ;