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

ICDEXC.m

Go to the documentation of this file. 
  1. ICDEXC ;SLC/KER - ICD Extractor - Code APIs ;04/19/2016
  1.  ;;18.0;DRG Grouper;**57,1**;Oct 20, 2000;Build 1
  1.  ; AICD*4.0*1 IHS/OIT/FBD&NKD - Optimizations: ICDDX, ICDOP, CODEN
  1.  ;                            - Cleanup: CODEBA
  1.  ;               
  1.  ; Global Variables
  1.  ;    None
  1.  ;               
  1.  ; External References
  1.  ;    $$DT^XLFDT          ICR  10103
  1.  ;    $$UP^XLFSTR         ICR  10104
  1.  ;               
  1. ICDDX(CODE,CDT,SYS,FMT,LOC) ; Return ICD Dx Code Info
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   CODE  Code/IEN (required)
  1.  ;    CDT  Date (default = TODAY)
  1.  ;    SYS  Coding System (taken from file 80.4)
  1.  ;           1 = ICD-9 Diagnosis
  1.  ;          30 = ICD-10 Diagnosis
  1.  ;    FMT  Input Format
  1.  ;           E = External (default)
  1.  ;           I = Internal Entry Number
  1.  ;           (Conditional, required if CODE is in internal format)
  1.  ;IHS Information: If used, the input variable CODE must
  1.  ;    be in the correct format or a -1 will be returned.
  1.  ;
  1.  ;IHS Modification: Format will not default to external
  1.  ;    if no value is passed in. Instead it will attempt to
  1.  ;    determine the format based on the input variable CODE.
  1.  ;
  1.  ;    LOC  Use Local codes
  1.  ;           1 = Yes
  1.  ;           0 = No (default)
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;  Returns an 22 piece string delimited by ^
  1.  ;  
  1.  ;    1  IEN of code in ^ICD9(
  1.  ;    2  ICD-9 Dx Code                (#.01)
  1.  ;    3  Identifier                   (#1.2)
  1.  ;    4  Versioned Dx                 (67 multiple)
  1.  ;    5  Unacceptable as Principal Dx (#1.3)
  1.  ;    6  Major Dx Cat                 (72 multiple)
  1.  ;    7  MDC13                        (#1.4)
  1.  ;    8  Compl/Comorb                 (103 multiple)
  1.  ;    9  ICD Expanded                 (#1.7)
  1.  ;    10 Status                       (66 multiple)
  1.  ;    11 Sex                          (10 multiple)
  1.  ;    12 Inactive Date                (66 multiple)
  1.  ;    13 MDC24                        (#1.5)
  1.  ;    14 MDC25                        (#1.6)
  1.  ;    15 Age Low                      (11 multiple)
  1.  ;    16 Age High                     (12 multiple)
  1.  ;    17 Activation Date              (66 multiple)
  1.  ;    18 Message                      
  1.  ;    19 Complication/Comorbidity     (103 multiple)
  1.  ;    20 Coding System                (#1.1)
  1.  ;    21 Primary CC Flag              (103 multiple)
  1.  ;    22 PDX Exclusion Code           (#1.11)
  1.  ;
  1.  ;    or
  1.  ;
  1.  ;    -1^Error Description
  1.  ;
  1.  N IEN,NODE,OUT,SAI,ROOT,SNAM,ICDY,UPC S FMT=$G(FMT) S:'$L(FMT) FMT=$$IE^ICDEX($G(CODE))  ;IHS/OIT/FBD&NKD - IMPROVED IEN/EXTERNAL DISCRIMINATION
  1.  ;N IEN,NODE,OUT,SAI,ROOT,SNAM,ICDY,UPC S FMT=$G(FMT) S:'$L(FMT) FMT="E"  ;IHS/OIT/FBD&NKD - ORIGINAL FIRST LINE - COMMENTED OUT
  1.  S ROOT=$$ROOT^ICDEX(80),CODE=$G(CODE) Q:'$L(CODE) "-1^No Code Selected"
  1.  Q:FMT="I"&(CODE'?1N.N) "-1^Code not in correct format"
  1.  I FMT="I",CODE?1N.N S IEN=CODE,CODE=$P($G(^ICD9(IEN,0)),"^",1)
  1.  ;Q:'$L(CODE) "-1^No Code Selected"  S SYS=$$SYS^ICDEX(+($G(SYS)))  ;IHS/OIT/FBD&NKD - INT SYS (OPT)
  1.  Q:'$L(CODE) "-1^No Code Selected" S SYS=$$SYS^ICDEX(+($G(SYS))) I +SYS'>0,+$G(IEN) S SYS=$$CSI^ICDEX(80,+$G(IEN))
  1.  S UPC=$$UP^XLFSTR(CODE) S:+SYS'>0 SYS=$$SYS^ICDEX($G(UPC))  I +SYS'>0 D
  1.  . N FILE S FILE=$$CODEFI^ICDEX(UPC),SYS=$P($$CODECS^ICDEX(UPC,FILE),"^",1)
  1.  Q:+SYS>0&('$D(@(ROOT_"""ABA"","_+SYS_")"))) "-1^Invalid Coding System"
  1.  S SNAM=$$SNAM^ICDEX(+SYS),LOC=+($G(LOC))
  1.  ;S IEN=$S(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))  ;IHS/OIT/FBD&NKD - INT IEN (OPT)
  1.  S IEN=$S(+$G(IEN):+IEN,+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
  1.  S:+IEN'>0 IEN=$S(+SYS>0:$$CODEABA(UPC,ROOT,SYS),1:$$CODEBA(UPC,ROOT))
  1.  S:+IEN'>0&(+($G(LOC))>0)&($D(^ICD9("AVA",(CODE_" ")))) IEN=$O(^ICD9("AVA",(CODE_" "),0))
  1.  Q:IEN<1&(+SYS>0)&($L(SNAM)) ("-1^Invalid Code (not found in the "_SNAM_" system)")
  1.  Q:IEN<1 "-1^Invalid Code"  Q:'$D(^ICD9(IEN,0)) "-1^Invalid Code (not found)"
  1.  S ICDY=$P($G(^ICD9(IEN,1)),"^",1) Q:+ICDY'>0 "-1^Invalid Coding System"
  1.  S CDT=$P($G(CDT),".",1) S:'$L($G(CDT)) CDT=$$DT^XLFDT
  1.  S CDT=$$DTBR^ICDEX($G(CDT),,ICDY) Q:CDT'?7N "-1^No Date Provided"
  1.  S NODE=$P($G(^ICD9(IEN,0)),"^",1) Q:'$L(NODE) "-1^Code not found"
  1.  Q:'$G(SRC)&($P(^ICD9(IEN,1),U,7)) ("-1^VA Local Code Selected ("_NODE_")")
  1.  N SRC S OUT=IEN_"^"_NODE,SAI=$$SAI^ICDEX(80,IEN,CDT)
  1.  S NODE=$G(^ICD9(IEN,1)) Q:'$L(NODE) "-1^Data not found"
  1.  S $P(OUT,"^",3)=$$IDSTR^ICDEX(80,IEN)
  1.  S $P(OUT,"^",4)=$$VSTD^ICDEX(IEN,CDT)
  1.  S $P(OUT,"^",5)=$P(NODE,"^",3)
  1.  S $P(OUT,"^",6)=$$VMDC^ICDEX(IEN,CDT)
  1.  S $P(OUT,"^",7)=$P(NODE,"^",4)
  1.  S $P(OUT,"^",8)=$$VCC^ICDEX(IEN,CDT)
  1.  S:$P(NODE,"^",7)>0 $P(OUT,"^",9)=$P(NODE,"^",7)
  1.  S $P(OUT,"^",10)=$S(+$P($G(SAI),"^",1)>0:1,1:0)
  1.  S $P(OUT,"^",11)=$$VSEX^ICDEX(80,IEN,CDT)
  1.  S $P(OUT,"^",12)=$S($P($G(SAI),"^",3)?7N:$P($G(SAI),"^",3),1:"")
  1.  S $P(OUT,"^",13)=$P(NODE,"^",5)
  1.  S $P(OUT,"^",14)=$P(NODE,"^",6)
  1.  S $P(OUT,"^",15)=$$VAGEL^ICDEX(IEN,CDT)
  1.  S $P(OUT,"^",16)=$$VAGEH^ICDEX(IEN,CDT)
  1.  S $P(OUT,"^",17)=$S($P($G(SAI),"^",2)?7N:$P($G(SAI),"^",2),1:"")
  1.  S $P(OUT,"^",18)=$$MSG^ICDEX(CDT)
  1.  ;S $P(OUT,"^",19)=$$VCC^ICDEX(IEN,CDT)  ;IHS/OIT/FBD&NKD - PIECE 8 (OPT)
  1.  S $P(OUT,"^",19)=$P(OUT,"^",8)
  1.  S:+($G(^ICD9(+IEN,1)))>0 $P(OUT,"^",20)=+($G(^ICD9(+IEN,1)))
  1.  S $P(OUT,"^",21)=$$VCCP^ICDEX(IEN,CDT)
  1.  S $P(OUT,"^",22)=$$PDXE^ICDEX(IEN)
  1.  Q OUT
  1.  ;
  1. ICDOP(CODE,CDT,SYS,FMT,LOC) ; Return ICD Operation/Procedure Code Info
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   CODE  Code/IEN (required)
  1.  ;    CDT  Date (default = TODAY)
  1.  ;    SYS  Coding System (taken from file 757.03)
  1.  ;           2 = ICD-9 Procedure
  1.  ;          31 = ICD-10 Procedure
  1.  ;    FMT  Format
  1.  ;           E = External (default)
  1.  ;           I = Internal Entry Number
  1.  ;    LOC  Use Local codes
  1.  ;           1 = Yes
  1.  ;           0 = No (default)
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;  Returns an 14 piece string delimited by ^
  1.  ;  
  1.  ;    1  IEN of code in ^ICD0(
  1.  ;    2  ICD procedure code           (#.01)
  1.  ;    3  Identifier                   (#1.2)
  1.  ;    4  MDC24                        (#1.5)
  1.  ;    5  Versioned Oper/Proc          (67 multiple)
  1.  ;    6  <null>
  1.  ;    7  <null>
  1.  ;    8  <null>
  1.  ;    9  ICD Expanded                 (#1.7)
  1.  ;    10 Status                       (66 multiple)
  1.  ;    11 Use with Sex                 (10 multiple)
  1.  ;    12 Inactive Date                (66 multiple)
  1.  ;    13 Activation Date              (66 multiple)
  1.  ;    14 Message
  1.  ;    15 Coding System                (#1.1)
  1.  ;
  1.  ;    or
  1.  ;
  1.  ;    -1^Error Description
  1.  ;
  1.  N IEN,NODE,OUT,ROOT,SNAM,SAI,ICDY S FMT=$G(FMT) S:'$L(FMT) FMT="E"
  1.  S ROOT=$$ROOT^ICDEX(80.1),CODE=$G(CODE) Q:'$L(CODE) "-1^No Code Selected"
  1.  Q:FMT="I"&(CODE'?1N.N) "-1^Code not in correct format"
  1.  ;I FMT="I",CODE?1N.N S IEN=CODE,CODE=$P($G(^ICD0(+IEN,0)),"^",1),FMT="E"  ;IHS/OIT/FBD&NKD - CLEANUP - REMOVED SETTING OF FMT
  1.  I FMT="I",CODE?1N.N S IEN=CODE,CODE=$P($G(^ICD0(IEN,0)),"^",1)
  1.  Q:'$L(CODE) "-1^No Code Selected"
  1.  ;S SYS=$$SYS^ICDEX(+($G(SYS))),LOC=+($G(LOC)) I +SYS'>0 D  ;IHS/OIT/FBD&NKD - INT SYS (OPT)
  1.  S SYS=$$SYS^ICDEX(+($G(SYS))),LOC=+($G(LOC)) S:+SYS'>0&(+$G(IEN)) SYS=$$CSI^ICDEX(80.1,+$G(IEN)) I +SYS'>0 D
  1.  . N FILE S FILE=$$CODEFI^ICDEX(CODE),SYS=$P($$CODECS^ICDEX(CODE,FILE),"^",1)
  1.  Q:+SYS>0&('$D(@(ROOT_"""ABA"","_+SYS_")"))) "-1^Invalid Coding System"
  1.  ;S SNAM=$$SNAM^ICDEX(+SYS),IEN=$S(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))  ;IHS/OIT/FBD&NKD - INT IEN (OPT)
  1.  S SNAM=$$SNAM^ICDEX(+SYS),IEN=$S(+$G(IEN):+IEN,+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
  1.  S:+IEN'>0&(+($G(LOC))>0)&($D(^ICD0("AVA",(CODE_" ")))) IEN=$O(^ICD0("AVA",(CODE_" "),0))
  1.  Q:IEN<1&(+SYS>0)&($L(SNAM)) ("-1^Invalid Code (not found in the "_SNAM_" system)")
  1.  Q:IEN<1 "-1^Invalid Code"  Q:'$D(^ICD0(IEN,0)) "-1^Invalid Code (not found)"
  1.  S ICDY=$P($G(^ICD0(IEN,1)),"^",1) Q:+ICDY'>0 "-1^Invalid Coding System"
  1.  S CDT=$P($G(CDT),".",1) S:'$L($G(CDT)) CDT=$$DT^XLFDT
  1.  S CDT=$$DTBR^ICDEX($G(CDT),,ICDY) Q:CDT'?7N "-1^No Date Provided"
  1.  S NODE=$P($G(^ICD0(+IEN,0)),"^",1) Q:'$L(NODE) "-1^Code not found"
  1.  Q:'$G(SRC)&($P(^ICD0(IEN,1),U,7)) ("-1^VA Local Code Selected ("_NODE_")")
  1.  N SRC S OUT=IEN_"^"_NODE,SAI=$$SAI^ICDEX(80.1,IEN,CDT)
  1.  S NODE=$G(^ICD0(IEN,1)) Q:'$L(NODE) "-1^Data not found"
  1.  S $P(OUT,"^",3)=$$IDSTR^ICDEX(80.1,IEN)
  1.  S $P(OUT,"^",4)=$P(NODE,"^",5)
  1.  S $P(OUT,"^",5)=$$VSTP^ICDEX(IEN,CDT)
  1.  S:$P(NODE,"^",7)>0 $P(OUT,"^",9)=$P(NODE,"^",7)
  1.  S $P(OUT,"^",10)=$S(+$P($G(SAI),"^",1)>0:1,1:0)
  1.  S $P(OUT,"^",11)=$$VSEX^ICDEX(80.1,IEN,CDT)
  1.  S $P(OUT,"^",12)=$S($P($G(SAI),"^",3)?7N:$P($G(SAI),"^",3),1:"")
  1.  S $P(OUT,"^",13)=$S($P($G(SAI),"^",2)?7N:$P($G(SAI),"^",2),1:"")
  1.  S $P(OUT,"^",14)=$$MSG^ICDEX(CDT)
  1.  S:+($G(^ICD0(+IEN,1)))>0 $P(OUT,"^",15)=+($G(^ICD0(+IEN,1)))
  1.  Q OUT
  1. ICDD(CODE,ARY,CDT,SYS,LEN) ; Returns ICD description in array
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   CODE  Code, external format (required)
  1.  ;   ARY   Array Name passed by reference (required)
  1.  ;   CDT   Date (optional, default = TODAY)
  1.  ;   SYS   Coding System (optional)
  1.  ;   LEN   Sting Length (optional, > 27, default 245)
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   #   Number of lines in array
  1.  ;
  1.  ;   ARY(1) - Versioned Description (68 multiple)
  1.  ;   
  1.  ;   If there is a warning message (ICD-9 only):
  1.  ;   
  1.  ;     ARY(n+1) - blank
  1.  ;     ARY(n+2) - warning message: CODE TEXT MAY BE INACCURATE
  1.  ;
  1.  ;   or
  1.  ;
  1.  ;   -1^Error Description
  1.  ;
  1.  ;
  1.  N ARR,END,I,N,ROOT,SNAM,VAR,IEN,ICDY
  1.  Q:'$L($G(CODE)) "-1^Missing required input parameter CODE"
  1.  S SYS=$$SYS^ICDEX(+($G(SYS))) I +SYS'>0 D
  1.  . N FILE S FILE=$$CODEFI^ICDEX(CODE),SYS=$P($$CODECS^ICDEX(CODE,FILE),"^",1)
  1.  S ROOT=$$ROOT^ICDEX(+SYS)
  1.  Q:"^ICD9(^ICD0(^"'[("^"_$E(ROOT,2,$L(ROOT))_"^")!('$L(ROOT)) "-1^Invalid Coding System"
  1.  Q:+SYS>0&('$D(@(ROOT_"""ABA"","_+SYS_")"))) "-1^Invalid Coding System"
  1.  S SNAM=$$SNAM^ICDEX(+SYS),IEN=$S(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
  1.  Q:+IEN<1!('$L(ROOT)) "-1^Invalid Code"  Q:'$D(@(ROOT_IEN_",0)")) "-1^Code not found"
  1.  S LEN=+($G(LEN)) S:LEN'>0 LEN=245  S:LEN<28 LEN=245 K ARY
  1.  S ICDY=$P($G(@(ROOT_+IEN_",1)")),"^",1)
  1.  Q:+ICDY'>0 "-1^Invalid Coding System"
  1.  S I=0,N=0
  1.  S CDT=$P($G(CDT),".",1) S:'$L($G(CDT)) CDT=$$DT^XLFDT
  1.  S CDT=$$DTBR^ICDEX($G(CDT),,ICDY) Q:CDT'?7N "-1^No Date Provided"
  1.  S ARY(1)=$$VLT^ICDEX(ROOT,IEN,CDT)
  1.  I LEN>27,LEN<245 D PAR^ICDEX(.ARY,LEN)
  1.  S N=$O(ARY(" "),-1) I +ICDY<3 D
  1.  . N MSG S MSG=$$MSG^ICDEX(CDT) Q:'$L(MSG)  S ARY(N+1)=" ",ARY(N+2)=MSG
  1.  S N=+($O(ARY(" "),-1))
  1.  Q N
  1. CODEN(CODE,FILE) ; Return IEN of ICD code
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;   CODE  ICD code (required)
  1.  ;   FILE  File Number to search for code
  1.  ;            80 = ICD Dx file
  1.  ;            80.1 = ICD Oper/Proc file
  1.  ;  
  1.  ; Output:
  1.  ; 
  1.  ;   IEN~Global Root    or    -1~error message
  1.  ;
  1.  N ROOT,IEN,ERR,SYS,EIEN,ICDU S ERR=""
  1.  Q:$G(CODE)="" "-1~Missing required input parameter CODE"
  1.  S CODE=$TR(CODE," ",""),ICDU=$$UP^XLFSTR(CODE)
  1.  S:"^80^80.1^"'[("^"_$G(FILE)_"^") FILE=$$CODEFI^ICDEX(CODE)
  1.  ;S SYS=$P($$CODECS^ICDEX(CODE,FILE),"^",1)  ;IHS/OIT/FBD&NKD - UNUSED CALL (OPT)
  1.  S ROOT=$$ROOT^ICDEX($G(FILE)) Q:'$L(ROOT) "-1~Invalid File"
  1.  S IEN=$$CODEBA(CODE,ROOT) S:+IEN'>0 ERR="-1~Invalid or Code not found"
  1.  I $D(ICDVP),CODE?1N.N,+ERR<0,$L(ROOT) S:$D(@(ROOT_+CODE_",0)")) IEN=+CODE,ERR="" N ICDVP
  1.  I +IEN>0,$D(@(ROOT_"""AEXC"","""_ICDU_" "","_+IEN_")")) D
  1.  . S ERR="-1~IEN "_+IEN_" is excluded from lookup"
  1.  Q:+ERR<0 ERR  Q (IEN_"~"_ROOT)
  1. CODE(FILE,IEN) ; Replaces Direct Global Read of Code
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;    IEN     Internal Entry Number (required)
  1.  ;    FILE    File Number 80 or 80.1 (required)
  1.  ;    
  1.  ; Output:
  1.  ; 
  1.  ;    $$CODE  An ICD Diagnosis or Procedure code
  1.  ;    
  1.  ;           or -1 ^ message on error
  1.  ;    
  1.  ;  Retire IA 280, 365, 582, 5388, 5404
  1.  ;  
  1.  N ICDC,ICDF,ICDI,ICDR,ICDE S ICDI=$G(IEN) Q:+ICDI'>0 "-1^Invalid IEN"
  1.  S ICDF=$G(FILE) Q:"^80^80.1^"'[("^"_ICDF_"^") "-1^Invalid File"
  1.  S ICDR=$$ROOT^ICDEX(ICDF) Q:'$L(ICDR) "-1^Invalid File Root"
  1.  Q:'$D(@(ICDR_+ICDI_")")) "-1^Invalid IEN for File"
  1.  S ICDC=$P($G(@(ICDR_+ICDI_",0)")),"^",1)
  1.  Q $S($L(ICDC):ICDC,1:"-1^Code Not Found")
  1. CODEBA(CODE,ROOT) ; Return IEN based on Code and Root
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   CODE  ICD Code, either ICD-9 or ICD-10 (required)
  1.  ;   ROOT  File Root or Number (required)
  1.  ;            ^ICD9( or 80
  1.  ;            ^ICD0( or 80.1
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   IEN   IEN for CODE in ROOT or -1 if not found
  1.  ;   
  1.  ;Q:'$L($G(CODE)) -1  S:$TR($G(ROOT),".","")?1N.N ROOT=$$ROOT^ICDEX(ROOT) Q:'$L($G(ROOT)) -1  ;IHS/OIT/FBD&NKD - CLEANUP
  1.  ;N IEN,OUT,FILE,TMP,ICDU,VIEN,EIEN S IEN=0,OUT="",FILE=$$FILE^ICDEX(ROOT) Q:+FILE'>0 -1  ;IHS/OIT/FBD&NKD - CLEANUP
  1.  N IEN,OUT,FILE,TMP,ICDU,VIEN,EIEN S IEN=0,OUT="",CODE=$G(CODE),ROOT=$$ROOT^ICDEX($G(ROOT)),FILE=$$FILE^ICDEX(ROOT) Q:'$L(CODE)!'$L(ROOT) -1
  1.  S ICDU=$$UP^XLFSTR(CODE) S EIEN=$O(@(ROOT_"""AEXC"","""_ICDU_" "",0)"))
  1.  S VIEN=$O(@(ROOT_"""AVA"","""_ICDU_" "",0)"))
  1.  I +IEN'>0,CODE?1N.N,$L(ROOT) D
  1.  . I $D(ICDVP) S:$D(@(ROOT_+CODE_",0)")) (IEN,OUT)=+CODE N ICDVP
  1.  I IEN'>0 S OUT="",IEN=0 F TMP=CODE,ICDU D
  1.  . S IEN=0 F  S IEN=$O(@(ROOT_"""BA"","""_TMP_" "","_IEN_")")) Q:+IEN'>0  Q:+OUT>0  D
  1.  . . N EXC S EXC=$$EXC^ICDEX(FILE,IEN) S:+EXC'>0 OUT=IEN
  1.  S IEN=+($G(OUT))
  1.  I +IEN>0,$D(@(ROOT_"""AEXC"","""_ICDU_" "","_+IEN_")")) Q ("-1^IEN "_+EIEN_" is excluded from lookup")
  1.  I +IEN'>0,+EIEN>0 Q ("-1^Code "_ICDU_", IEN "_+EIEN_" is excluded from lookup")
  1.  I +IEN'>0,+VIEN>0 Q ("-1^Code "_ICDU_", IEN "_+VIEN_" is a VA local code, not used")
  1.  Q $S('IEN:-1,1:IEN)
  1. CODEABA(CODE,ROOT,SYS) ; Return IEN based on Code, Root and Coding System
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   CODE  ICD Code, either ICD-9 or ICD-10 (required)
  1.  ;   ROOT  File Root or Number (Optional if SYS is supplied)
  1.  ;            ^ICD9( or 80
  1.  ;            ^ICD0( or 80.1
  1.  ;   SYS   Coding System (required)
  1.  ;           1 = ICD-9 Diagnosis
  1.  ;           2 = ICD-9 Procedure
  1.  ;          30 = ICD-10 Diagnosis
  1.  ;          31 = ICD-10 Procedure
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   IEN   IEN for CODE in ROOT for SYS 
  1.  ;         or 
  1.  ;         -1 ^ error message if not found
  1.  ;   
  1.  N IEN,ICDF,ICDR,ICDI,ICDS,ICDU,ICDE,ICDV S CODE=$TR($G(CODE)," ","")
  1.  Q:'$L(CODE) "-1^Code missing"  Q:CODE["""" "-1^Invalid code"
  1.  S (ICDS,SYS)=+($G(SYS)),ICDU=$$UP^XLFSTR(CODE)
  1.  I ICDS'>0 D
  1.  . N ICDF S ICDF=$$CODEFI^ICDEX(CODE),(ICDS,SYS)=$P($$CODECS^ICDEX(CODE,ICDF),"^",1)
  1.  Q:+ICDS'>0 "-1^Invalid coding system"
  1.  S ICDR="" S ICDR=$$ROOT^ICDEX($G(ROOT))
  1.  S:'$L(ICDR) ICDR=$$ROOT^ICDEX(+($G(SYS)))
  1.  S:'$L(ICDR) ICDR=$$ROOT^ICDEX(+($G(ICDS)))
  1.  Q:'$L(ICDR) "-1^Invalid file/root"
  1.  S ICDE=$O(@(ICDR_"""AEXC"","""_ICDU_" "",0)"))
  1.  S ICDV=$O(@(ICDR_"""AVA"","""_ICDU_" "",0)"))
  1.  S:+($G(IEN))'>0 IEN=$O(@(ICDR_"""ABA"","_+ICDS_","""_CODE_" "","" "")"),-1)
  1.  S:+($G(IEN))'>0 IEN=$O(@(ICDR_"""ABA"","_+ICDS_","""_ICDU_" "","" "")"),-1)
  1.  I IEN'>0,+ICDE>0 Q ("-1^IEN "_+ICDE_" is excluded from lookup")
  1.  I IEN'>0,+ICDV>0 Q ("-1^CODE "_ICDU_", IEN "_+ICDE_" is a VA local code, not used")
  1.  Q $S('IEN:"-1^IEN/Code not found",1:IEN)