ICDEXC ;SLC/KER - ICD Extractor - Code APIs ;04/19/2016
;;18.0;DRG Grouper;**57,1**;Oct 20, 2000;Build 1
; AICD*4.0*1 IHS/OIT/FBD&NKD - Optimizations: ICDDX, ICDOP, CODEN
; - Cleanup: CODEBA
;
; Global Variables
; None
;
; External References
; $$DT^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
;
ICDDX(CODE,CDT,SYS,FMT,LOC) ; Return ICD Dx Code Info
;
; Input:
;
; CODE Code/IEN (required)
; CDT Date (default = TODAY)
; SYS Coding System (taken from file 80.4)
; 1 = ICD-9 Diagnosis
; 30 = ICD-10 Diagnosis
; FMT Input Format
; E = External (default)
; I = Internal Entry Number
; (Conditional, required if CODE is in internal format)
;IHS Information: If used, the input variable CODE must
; be in the correct format or a -1 will be returned.
;
;IHS Modification: Format will not default to external
; if no value is passed in. Instead it will attempt to
; determine the format based on the input variable CODE.
;
; LOC Use Local codes
; 1 = Yes
; 0 = No (default)
;
; Output:
;
; Returns an 22 piece string delimited by ^
;
; 1 IEN of code in ^ICD9(
; 2 ICD-9 Dx Code (#.01)
; 3 Identifier (#1.2)
; 4 Versioned Dx (67 multiple)
; 5 Unacceptable as Principal Dx (#1.3)
; 6 Major Dx Cat (72 multiple)
; 7 MDC13 (#1.4)
; 8 Compl/Comorb (103 multiple)
; 9 ICD Expanded (#1.7)
; 10 Status (66 multiple)
; 11 Sex (10 multiple)
; 12 Inactive Date (66 multiple)
; 13 MDC24 (#1.5)
; 14 MDC25 (#1.6)
; 15 Age Low (11 multiple)
; 16 Age High (12 multiple)
; 17 Activation Date (66 multiple)
; 18 Message
; 19 Complication/Comorbidity (103 multiple)
; 20 Coding System (#1.1)
; 21 Primary CC Flag (103 multiple)
; 22 PDX Exclusion Code (#1.11)
;
; or
;
; -1^Error Description
;
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
;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
S ROOT=$$ROOT^ICDEX(80),CODE=$G(CODE) Q:'$L(CODE) "-1^No Code Selected"
Q:FMT="I"&(CODE'?1N.N) "-1^Code not in correct format"
I FMT="I",CODE?1N.N S IEN=CODE,CODE=$P($G(^ICD9(IEN,0)),"^",1)
;Q:'$L(CODE) "-1^No Code Selected" S SYS=$$SYS^ICDEX(+($G(SYS))) ;IHS/OIT/FBD&NKD - INT SYS (OPT)
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))
S UPC=$$UP^XLFSTR(CODE) S:+SYS'>0 SYS=$$SYS^ICDEX($G(UPC)) I +SYS'>0 D
. N FILE S FILE=$$CODEFI^ICDEX(UPC),SYS=$P($$CODECS^ICDEX(UPC,FILE),"^",1)
Q:+SYS>0&('$D(@(ROOT_"""ABA"","_+SYS_")"))) "-1^Invalid Coding System"
S SNAM=$$SNAM^ICDEX(+SYS),LOC=+($G(LOC))
;S IEN=$S(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT)) ;IHS/OIT/FBD&NKD - INT IEN (OPT)
S IEN=$S(+$G(IEN):+IEN,+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
S:+IEN'>0 IEN=$S(+SYS>0:$$CODEABA(UPC,ROOT,SYS),1:$$CODEBA(UPC,ROOT))
S:+IEN'>0&(+($G(LOC))>0)&($D(^ICD9("AVA",(CODE_" ")))) IEN=$O(^ICD9("AVA",(CODE_" "),0))
Q:IEN<1&(+SYS>0)&($L(SNAM)) ("-1^Invalid Code (not found in the "_SNAM_" system)")
Q:IEN<1 "-1^Invalid Code" Q:'$D(^ICD9(IEN,0)) "-1^Invalid Code (not found)"
S ICDY=$P($G(^ICD9(IEN,1)),"^",1) Q:+ICDY'>0 "-1^Invalid Coding System"
S CDT=$P($G(CDT),".",1) S:'$L($G(CDT)) CDT=$$DT^XLFDT
S CDT=$$DTBR^ICDEX($G(CDT),,ICDY) Q:CDT'?7N "-1^No Date Provided"
S NODE=$P($G(^ICD9(IEN,0)),"^",1) Q:'$L(NODE) "-1^Code not found"
Q:'$G(SRC)&($P(^ICD9(IEN,1),U,7)) ("-1^VA Local Code Selected ("_NODE_")")
N SRC S OUT=IEN_"^"_NODE,SAI=$$SAI^ICDEX(80,IEN,CDT)
S NODE=$G(^ICD9(IEN,1)) Q:'$L(NODE) "-1^Data not found"
S $P(OUT,"^",3)=$$IDSTR^ICDEX(80,IEN)
S $P(OUT,"^",4)=$$VSTD^ICDEX(IEN,CDT)
S $P(OUT,"^",5)=$P(NODE,"^",3)
S $P(OUT,"^",6)=$$VMDC^ICDEX(IEN,CDT)
S $P(OUT,"^",7)=$P(NODE,"^",4)
S $P(OUT,"^",8)=$$VCC^ICDEX(IEN,CDT)
S:$P(NODE,"^",7)>0 $P(OUT,"^",9)=$P(NODE,"^",7)
S $P(OUT,"^",10)=$S(+$P($G(SAI),"^",1)>0:1,1:0)
S $P(OUT,"^",11)=$$VSEX^ICDEX(80,IEN,CDT)
S $P(OUT,"^",12)=$S($P($G(SAI),"^",3)?7N:$P($G(SAI),"^",3),1:"")
S $P(OUT,"^",13)=$P(NODE,"^",5)
S $P(OUT,"^",14)=$P(NODE,"^",6)
S $P(OUT,"^",15)=$$VAGEL^ICDEX(IEN,CDT)
S $P(OUT,"^",16)=$$VAGEH^ICDEX(IEN,CDT)
S $P(OUT,"^",17)=$S($P($G(SAI),"^",2)?7N:$P($G(SAI),"^",2),1:"")
S $P(OUT,"^",18)=$$MSG^ICDEX(CDT)
;S $P(OUT,"^",19)=$$VCC^ICDEX(IEN,CDT) ;IHS/OIT/FBD&NKD - PIECE 8 (OPT)
S $P(OUT,"^",19)=$P(OUT,"^",8)
S:+($G(^ICD9(+IEN,1)))>0 $P(OUT,"^",20)=+($G(^ICD9(+IEN,1)))
S $P(OUT,"^",21)=$$VCCP^ICDEX(IEN,CDT)
S $P(OUT,"^",22)=$$PDXE^ICDEX(IEN)
Q OUT
;
ICDOP(CODE,CDT,SYS,FMT,LOC) ; Return ICD Operation/Procedure Code Info
;
; Input:
;
; CODE Code/IEN (required)
; CDT Date (default = TODAY)
; SYS Coding System (taken from file 757.03)
; 2 = ICD-9 Procedure
; 31 = ICD-10 Procedure
; FMT Format
; E = External (default)
; I = Internal Entry Number
; LOC Use Local codes
; 1 = Yes
; 0 = No (default)
;
; Output:
;
; Returns an 14 piece string delimited by ^
;
; 1 IEN of code in ^ICD0(
; 2 ICD procedure code (#.01)
; 3 Identifier (#1.2)
; 4 MDC24 (#1.5)
; 5 Versioned Oper/Proc (67 multiple)
; 6 <null>
; 7 <null>
; 8 <null>
; 9 ICD Expanded (#1.7)
; 10 Status (66 multiple)
; 11 Use with Sex (10 multiple)
; 12 Inactive Date (66 multiple)
; 13 Activation Date (66 multiple)
; 14 Message
; 15 Coding System (#1.1)
;
; or
;
; -1^Error Description
;
N IEN,NODE,OUT,ROOT,SNAM,SAI,ICDY S FMT=$G(FMT) S:'$L(FMT) FMT="E"
S ROOT=$$ROOT^ICDEX(80.1),CODE=$G(CODE) Q:'$L(CODE) "-1^No Code Selected"
Q:FMT="I"&(CODE'?1N.N) "-1^Code not in correct format"
;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
I FMT="I",CODE?1N.N S IEN=CODE,CODE=$P($G(^ICD0(IEN,0)),"^",1)
Q:'$L(CODE) "-1^No Code Selected"
;S SYS=$$SYS^ICDEX(+($G(SYS))),LOC=+($G(LOC)) I +SYS'>0 D ;IHS/OIT/FBD&NKD - INT SYS (OPT)
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
. N FILE S FILE=$$CODEFI^ICDEX(CODE),SYS=$P($$CODECS^ICDEX(CODE,FILE),"^",1)
Q:+SYS>0&('$D(@(ROOT_"""ABA"","_+SYS_")"))) "-1^Invalid Coding System"
;S SNAM=$$SNAM^ICDEX(+SYS),IEN=$S(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT)) ;IHS/OIT/FBD&NKD - INT IEN (OPT)
S SNAM=$$SNAM^ICDEX(+SYS),IEN=$S(+$G(IEN):+IEN,+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
S:+IEN'>0&(+($G(LOC))>0)&($D(^ICD0("AVA",(CODE_" ")))) IEN=$O(^ICD0("AVA",(CODE_" "),0))
Q:IEN<1&(+SYS>0)&($L(SNAM)) ("-1^Invalid Code (not found in the "_SNAM_" system)")
Q:IEN<1 "-1^Invalid Code" Q:'$D(^ICD0(IEN,0)) "-1^Invalid Code (not found)"
S ICDY=$P($G(^ICD0(IEN,1)),"^",1) Q:+ICDY'>0 "-1^Invalid Coding System"
S CDT=$P($G(CDT),".",1) S:'$L($G(CDT)) CDT=$$DT^XLFDT
S CDT=$$DTBR^ICDEX($G(CDT),,ICDY) Q:CDT'?7N "-1^No Date Provided"
S NODE=$P($G(^ICD0(+IEN,0)),"^",1) Q:'$L(NODE) "-1^Code not found"
Q:'$G(SRC)&($P(^ICD0(IEN,1),U,7)) ("-1^VA Local Code Selected ("_NODE_")")
N SRC S OUT=IEN_"^"_NODE,SAI=$$SAI^ICDEX(80.1,IEN,CDT)
S NODE=$G(^ICD0(IEN,1)) Q:'$L(NODE) "-1^Data not found"
S $P(OUT,"^",3)=$$IDSTR^ICDEX(80.1,IEN)
S $P(OUT,"^",4)=$P(NODE,"^",5)
S $P(OUT,"^",5)=$$VSTP^ICDEX(IEN,CDT)
S:$P(NODE,"^",7)>0 $P(OUT,"^",9)=$P(NODE,"^",7)
S $P(OUT,"^",10)=$S(+$P($G(SAI),"^",1)>0:1,1:0)
S $P(OUT,"^",11)=$$VSEX^ICDEX(80.1,IEN,CDT)
S $P(OUT,"^",12)=$S($P($G(SAI),"^",3)?7N:$P($G(SAI),"^",3),1:"")
S $P(OUT,"^",13)=$S($P($G(SAI),"^",2)?7N:$P($G(SAI),"^",2),1:"")
S $P(OUT,"^",14)=$$MSG^ICDEX(CDT)
S:+($G(^ICD0(+IEN,1)))>0 $P(OUT,"^",15)=+($G(^ICD0(+IEN,1)))
Q OUT
ICDD(CODE,ARY,CDT,SYS,LEN) ; Returns ICD description in array
;
; Input:
;
; CODE Code, external format (required)
; ARY Array Name passed by reference (required)
; CDT Date (optional, default = TODAY)
; SYS Coding System (optional)
; LEN Sting Length (optional, > 27, default 245)
;
; Output:
;
; # Number of lines in array
;
; ARY(1) - Versioned Description (68 multiple)
;
; If there is a warning message (ICD-9 only):
;
; ARY(n+1) - blank
; ARY(n+2) - warning message: CODE TEXT MAY BE INACCURATE
;
; or
;
; -1^Error Description
;
;
N ARR,END,I,N,ROOT,SNAM,VAR,IEN,ICDY
Q:'$L($G(CODE)) "-1^Missing required input parameter CODE"
S SYS=$$SYS^ICDEX(+($G(SYS))) I +SYS'>0 D
. N FILE S FILE=$$CODEFI^ICDEX(CODE),SYS=$P($$CODECS^ICDEX(CODE,FILE),"^",1)
S ROOT=$$ROOT^ICDEX(+SYS)
Q:"^ICD9(^ICD0(^"'[("^"_$E(ROOT,2,$L(ROOT))_"^")!('$L(ROOT)) "-1^Invalid Coding System"
Q:+SYS>0&('$D(@(ROOT_"""ABA"","_+SYS_")"))) "-1^Invalid Coding System"
S SNAM=$$SNAM^ICDEX(+SYS),IEN=$S(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
Q:+IEN<1!('$L(ROOT)) "-1^Invalid Code" Q:'$D(@(ROOT_IEN_",0)")) "-1^Code not found"
S LEN=+($G(LEN)) S:LEN'>0 LEN=245 S:LEN<28 LEN=245 K ARY
S ICDY=$P($G(@(ROOT_+IEN_",1)")),"^",1)
Q:+ICDY'>0 "-1^Invalid Coding System"
S I=0,N=0
S CDT=$P($G(CDT),".",1) S:'$L($G(CDT)) CDT=$$DT^XLFDT
S CDT=$$DTBR^ICDEX($G(CDT),,ICDY) Q:CDT'?7N "-1^No Date Provided"
S ARY(1)=$$VLT^ICDEX(ROOT,IEN,CDT)
I LEN>27,LEN<245 D PAR^ICDEX(.ARY,LEN)
S N=$O(ARY(" "),-1) I +ICDY<3 D
. N MSG S MSG=$$MSG^ICDEX(CDT) Q:'$L(MSG) S ARY(N+1)=" ",ARY(N+2)=MSG
S N=+($O(ARY(" "),-1))
Q N
CODEN(CODE,FILE) ; Return IEN of ICD code
;
; Input:
;
; CODE ICD code (required)
; FILE File Number to search for code
; 80 = ICD Dx file
; 80.1 = ICD Oper/Proc file
;
; Output:
;
; IEN~Global Root or -1~error message
;
N ROOT,IEN,ERR,SYS,EIEN,ICDU S ERR=""
Q:$G(CODE)="" "-1~Missing required input parameter CODE"
S CODE=$TR(CODE," ",""),ICDU=$$UP^XLFSTR(CODE)
S:"^80^80.1^"'[("^"_$G(FILE)_"^") FILE=$$CODEFI^ICDEX(CODE)
;S SYS=$P($$CODECS^ICDEX(CODE,FILE),"^",1) ;IHS/OIT/FBD&NKD - UNUSED CALL (OPT)
S ROOT=$$ROOT^ICDEX($G(FILE)) Q:'$L(ROOT) "-1~Invalid File"
S IEN=$$CODEBA(CODE,ROOT) S:+IEN'>0 ERR="-1~Invalid or Code not found"
I $D(ICDVP),CODE?1N.N,+ERR<0,$L(ROOT) S:$D(@(ROOT_+CODE_",0)")) IEN=+CODE,ERR="" N ICDVP
I +IEN>0,$D(@(ROOT_"""AEXC"","""_ICDU_" "","_+IEN_")")) D
. S ERR="-1~IEN "_+IEN_" is excluded from lookup"
Q:+ERR<0 ERR Q (IEN_"~"_ROOT)
CODE(FILE,IEN) ; Replaces Direct Global Read of Code
;
; Input:
;
; IEN Internal Entry Number (required)
; FILE File Number 80 or 80.1 (required)
;
; Output:
;
; $$CODE An ICD Diagnosis or Procedure code
;
; or -1 ^ message on error
;
; Retire IA 280, 365, 582, 5388, 5404
;
N ICDC,ICDF,ICDI,ICDR,ICDE S ICDI=$G(IEN) Q:+ICDI'>0 "-1^Invalid IEN"
S ICDF=$G(FILE) Q:"^80^80.1^"'[("^"_ICDF_"^") "-1^Invalid File"
S ICDR=$$ROOT^ICDEX(ICDF) Q:'$L(ICDR) "-1^Invalid File Root"
Q:'$D(@(ICDR_+ICDI_")")) "-1^Invalid IEN for File"
S ICDC=$P($G(@(ICDR_+ICDI_",0)")),"^",1)
Q $S($L(ICDC):ICDC,1:"-1^Code Not Found")
CODEBA(CODE,ROOT) ; Return IEN based on Code and Root
;
; Input:
;
; CODE ICD Code, either ICD-9 or ICD-10 (required)
; ROOT File Root or Number (required)
; ^ICD9( or 80
; ^ICD0( or 80.1
;
; Output:
;
; IEN IEN for CODE in ROOT or -1 if not found
;
;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
;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
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
S ICDU=$$UP^XLFSTR(CODE) S EIEN=$O(@(ROOT_"""AEXC"","""_ICDU_" "",0)"))
S VIEN=$O(@(ROOT_"""AVA"","""_ICDU_" "",0)"))
I +IEN'>0,CODE?1N.N,$L(ROOT) D
. I $D(ICDVP) S:$D(@(ROOT_+CODE_",0)")) (IEN,OUT)=+CODE N ICDVP
I IEN'>0 S OUT="",IEN=0 F TMP=CODE,ICDU D
. S IEN=0 F S IEN=$O(@(ROOT_"""BA"","""_TMP_" "","_IEN_")")) Q:+IEN'>0 Q:+OUT>0 D
. . N EXC S EXC=$$EXC^ICDEX(FILE,IEN) S:+EXC'>0 OUT=IEN
S IEN=+($G(OUT))
I +IEN>0,$D(@(ROOT_"""AEXC"","""_ICDU_" "","_+IEN_")")) Q ("-1^IEN "_+EIEN_" is excluded from lookup")
I +IEN'>0,+EIEN>0 Q ("-1^Code "_ICDU_", IEN "_+EIEN_" is excluded from lookup")
I +IEN'>0,+VIEN>0 Q ("-1^Code "_ICDU_", IEN "_+VIEN_" is a VA local code, not used")
Q $S('IEN:-1,1:IEN)
CODEABA(CODE,ROOT,SYS) ; Return IEN based on Code, Root and Coding System
;
; Input:
;
; CODE ICD Code, either ICD-9 or ICD-10 (required)
; ROOT File Root or Number (Optional if SYS is supplied)
; ^ICD9( or 80
; ^ICD0( or 80.1
; SYS Coding System (required)
; 1 = ICD-9 Diagnosis
; 2 = ICD-9 Procedure
; 30 = ICD-10 Diagnosis
; 31 = ICD-10 Procedure
;
; Output:
;
; IEN IEN for CODE in ROOT for SYS
; or
; -1 ^ error message if not found
;
N IEN,ICDF,ICDR,ICDI,ICDS,ICDU,ICDE,ICDV S CODE=$TR($G(CODE)," ","")
Q:'$L(CODE) "-1^Code missing" Q:CODE["""" "-1^Invalid code"
S (ICDS,SYS)=+($G(SYS)),ICDU=$$UP^XLFSTR(CODE)
I ICDS'>0 D
. N ICDF S ICDF=$$CODEFI^ICDEX(CODE),(ICDS,SYS)=$P($$CODECS^ICDEX(CODE,ICDF),"^",1)
Q:+ICDS'>0 "-1^Invalid coding system"
S ICDR="" S ICDR=$$ROOT^ICDEX($G(ROOT))
S:'$L(ICDR) ICDR=$$ROOT^ICDEX(+($G(SYS)))
S:'$L(ICDR) ICDR=$$ROOT^ICDEX(+($G(ICDS)))
Q:'$L(ICDR) "-1^Invalid file/root"
S ICDE=$O(@(ICDR_"""AEXC"","""_ICDU_" "",0)"))
S ICDV=$O(@(ICDR_"""AVA"","""_ICDU_" "",0)"))
S:+($G(IEN))'>0 IEN=$O(@(ICDR_"""ABA"","_+ICDS_","""_CODE_" "","" "")"),-1)
S:+($G(IEN))'>0 IEN=$O(@(ICDR_"""ABA"","_+ICDS_","""_ICDU_" "","" "")"),-1)
I IEN'>0,+ICDE>0 Q ("-1^IEN "_+ICDE_" is excluded from lookup")
I IEN'>0,+ICDV>0 Q ("-1^CODE "_ICDU_", IEN "_+ICDE_" is a VA local code, not used")
Q $S('IEN:"-1^IEN/Code not found",1:IEN)
ICDEXC ;SLC/KER - ICD Extractor - Code APIs ;04/19/2016
+1 ;;18.0;DRG Grouper;**57,1**;Oct 20, 2000;Build 1
+2 ; AICD*4.0*1 IHS/OIT/FBD&NKD - Optimizations: ICDDX, ICDOP, CODEN
+3 ; - Cleanup: CODEBA
+4 ;
+5 ; Global Variables
+6 ; None
+7 ;
+8 ; External References
+9 ; $$DT^XLFDT ICR 10103
+10 ; $$UP^XLFSTR ICR 10104
+11 ;
ICDDX(CODE,CDT,SYS,FMT,LOC) ; Return ICD Dx Code Info
+1 ;
+2 ; Input:
+3 ;
+4 ; CODE Code/IEN (required)
+5 ; CDT Date (default = TODAY)
+6 ; SYS Coding System (taken from file 80.4)
+7 ; 1 = ICD-9 Diagnosis
+8 ; 30 = ICD-10 Diagnosis
+9 ; FMT Input Format
+10 ; E = External (default)
+11 ; I = Internal Entry Number
+12 ; (Conditional, required if CODE is in internal format)
+13 ;IHS Information: If used, the input variable CODE must
+14 ; be in the correct format or a -1 will be returned.
+15 ;
+16 ;IHS Modification: Format will not default to external
+17 ; if no value is passed in. Instead it will attempt to
+18 ; determine the format based on the input variable CODE.
+19 ;
+20 ; LOC Use Local codes
+21 ; 1 = Yes
+22 ; 0 = No (default)
+23 ;
+24 ; Output:
+25 ;
+26 ; Returns an 22 piece string delimited by ^
+27 ;
+28 ; 1 IEN of code in ^ICD9(
+29 ; 2 ICD-9 Dx Code (#.01)
+30 ; 3 Identifier (#1.2)
+31 ; 4 Versioned Dx (67 multiple)
+32 ; 5 Unacceptable as Principal Dx (#1.3)
+33 ; 6 Major Dx Cat (72 multiple)
+34 ; 7 MDC13 (#1.4)
+35 ; 8 Compl/Comorb (103 multiple)
+36 ; 9 ICD Expanded (#1.7)
+37 ; 10 Status (66 multiple)
+38 ; 11 Sex (10 multiple)
+39 ; 12 Inactive Date (66 multiple)
+40 ; 13 MDC24 (#1.5)
+41 ; 14 MDC25 (#1.6)
+42 ; 15 Age Low (11 multiple)
+43 ; 16 Age High (12 multiple)
+44 ; 17 Activation Date (66 multiple)
+45 ; 18 Message
+46 ; 19 Complication/Comorbidity (103 multiple)
+47 ; 20 Coding System (#1.1)
+48 ; 21 Primary CC Flag (103 multiple)
+49 ; 22 PDX Exclusion Code (#1.11)
+50 ;
+51 ; or
+52 ;
+53 ; -1^Error Description
+54 ;
+55 ;IHS/OIT/FBD&NKD - IMPROVED IEN/EXTERNAL DISCRIMINATION
NEW IEN,NODE,OUT,SAI,ROOT,SNAM,ICDY,UPC
SET FMT=$GET(FMT)
IF '$LENGTH(FMT)
SET FMT=$$IE^ICDEX($GET(CODE))
+56 ;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
+57 SET ROOT=$$ROOT^ICDEX(80)
SET CODE=$GET(CODE)
IF '$LENGTH(CODE)
QUIT "-1^No Code Selected"
+58 IF FMT="I"&(CODE'?1N.N)
QUIT "-1^Code not in correct format"
+59 IF FMT="I"
IF CODE?1N.N
SET IEN=CODE
SET CODE=$PIECE($GET(^ICD9(IEN,0)),"^",1)
+60 ;Q:'$L(CODE) "-1^No Code Selected" S SYS=$$SYS^ICDEX(+($G(SYS))) ;IHS/OIT/FBD&NKD - INT SYS (OPT)
+61 IF '$LENGTH(CODE)
QUIT "-1^No Code Selected"
SET SYS=$$SYS^ICDEX(+($GET(SYS)))
IF +SYS'>0
IF +$GET(IEN)
SET SYS=$$CSI^ICDEX(80,+$GET(IEN))
+62 SET UPC=$$UP^XLFSTR(CODE)
IF +SYS'>0
SET SYS=$$SYS^ICDEX($GET(UPC))
IF +SYS'>0
Begin DoDot:1
+63 NEW FILE
SET FILE=$$CODEFI^ICDEX(UPC)
SET SYS=$PIECE($$CODECS^ICDEX(UPC,FILE),"^",1)
End DoDot:1
+64 IF +SYS>0&('$DATA(@(ROOT_"""ABA"","_+SYS_")")))
QUIT "-1^Invalid Coding System"
+65 SET SNAM=$$SNAM^ICDEX(+SYS)
SET LOC=+($GET(LOC))
+66 ;S IEN=$S(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT)) ;IHS/OIT/FBD&NKD - INT IEN (OPT)
+67 SET IEN=$SELECT(+$GET(IEN):+IEN,+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
+68 IF +IEN'>0
SET IEN=$SELECT(+SYS>0:$$CODEABA(UPC,ROOT,SYS),1:$$CODEBA(UPC,ROOT))
+69 IF +IEN'>0&(+($GET(LOC))>0)&($DATA(^ICD9("AVA",(CODE_" "))))
SET IEN=$ORDER(^ICD9("AVA",(CODE_" "),0))
+70 IF IEN<1&(+SYS>0)&($LENGTH(SNAM))
QUIT ("-1^Invalid Code (not found in the "_SNAM_" system)")
+71 IF IEN<1
QUIT "-1^Invalid Code"
IF '$DATA(^ICD9(IEN,0))
QUIT "-1^Invalid Code (not found)"
+72 SET ICDY=$PIECE($GET(^ICD9(IEN,1)),"^",1)
IF +ICDY'>0
QUIT "-1^Invalid Coding System"
+73 SET CDT=$PIECE($GET(CDT),".",1)
IF '$LENGTH($GET(CDT))
SET CDT=$$DT^XLFDT
+74 SET CDT=$$DTBR^ICDEX($GET(CDT),,ICDY)
IF CDT'?7N
QUIT "-1^No Date Provided"
+75 SET NODE=$PIECE($GET(^ICD9(IEN,0)),"^",1)
IF '$LENGTH(NODE)
QUIT "-1^Code not found"
+76 IF '$GET(SRC)&($PIECE(^ICD9(IEN,1),U,7))
QUIT ("-1^VA Local Code Selected ("_NODE_")")
+77 NEW SRC
SET OUT=IEN_"^"_NODE
SET SAI=$$SAI^ICDEX(80,IEN,CDT)
+78 SET NODE=$GET(^ICD9(IEN,1))
IF '$LENGTH(NODE)
QUIT "-1^Data not found"
+79 SET $PIECE(OUT,"^",3)=$$IDSTR^ICDEX(80,IEN)
+80 SET $PIECE(OUT,"^",4)=$$VSTD^ICDEX(IEN,CDT)
+81 SET $PIECE(OUT,"^",5)=$PIECE(NODE,"^",3)
+82 SET $PIECE(OUT,"^",6)=$$VMDC^ICDEX(IEN,CDT)
+83 SET $PIECE(OUT,"^",7)=$PIECE(NODE,"^",4)
+84 SET $PIECE(OUT,"^",8)=$$VCC^ICDEX(IEN,CDT)
+85 IF $PIECE(NODE,"^",7)>0
SET $PIECE(OUT,"^",9)=$PIECE(NODE,"^",7)
+86 SET $PIECE(OUT,"^",10)=$SELECT(+$PIECE($GET(SAI),"^",1)>0:1,1:0)
+87 SET $PIECE(OUT,"^",11)=$$VSEX^ICDEX(80,IEN,CDT)
+88 SET $PIECE(OUT,"^",12)=$SELECT($PIECE($GET(SAI),"^",3)?7N:$PIECE($GET(SAI),"^",3),1:"")
+89 SET $PIECE(OUT,"^",13)=$PIECE(NODE,"^",5)
+90 SET $PIECE(OUT,"^",14)=$PIECE(NODE,"^",6)
+91 SET $PIECE(OUT,"^",15)=$$VAGEL^ICDEX(IEN,CDT)
+92 SET $PIECE(OUT,"^",16)=$$VAGEH^ICDEX(IEN,CDT)
+93 SET $PIECE(OUT,"^",17)=$SELECT($PIECE($GET(SAI),"^",2)?7N:$PIECE($GET(SAI),"^",2),1:"")
+94 SET $PIECE(OUT,"^",18)=$$MSG^ICDEX(CDT)
+95 ;S $P(OUT,"^",19)=$$VCC^ICDEX(IEN,CDT) ;IHS/OIT/FBD&NKD - PIECE 8 (OPT)
+96 SET $PIECE(OUT,"^",19)=$PIECE(OUT,"^",8)
+97 IF +($GET(^ICD9(+IEN,1)))>0
SET $PIECE(OUT,"^",20)=+($GET(^ICD9(+IEN,1)))
+98 SET $PIECE(OUT,"^",21)=$$VCCP^ICDEX(IEN,CDT)
+99 SET $PIECE(OUT,"^",22)=$$PDXE^ICDEX(IEN)
+100 QUIT OUT
+101 ;
ICDOP(CODE,CDT,SYS,FMT,LOC) ; Return ICD Operation/Procedure Code Info
+1 ;
+2 ; Input:
+3 ;
+4 ; CODE Code/IEN (required)
+5 ; CDT Date (default = TODAY)
+6 ; SYS Coding System (taken from file 757.03)
+7 ; 2 = ICD-9 Procedure
+8 ; 31 = ICD-10 Procedure
+9 ; FMT Format
+10 ; E = External (default)
+11 ; I = Internal Entry Number
+12 ; LOC Use Local codes
+13 ; 1 = Yes
+14 ; 0 = No (default)
+15 ;
+16 ; Output:
+17 ;
+18 ; Returns an 14 piece string delimited by ^
+19 ;
+20 ; 1 IEN of code in ^ICD0(
+21 ; 2 ICD procedure code (#.01)
+22 ; 3 Identifier (#1.2)
+23 ; 4 MDC24 (#1.5)
+24 ; 5 Versioned Oper/Proc (67 multiple)
+25 ; 6 <null>
+26 ; 7 <null>
+27 ; 8 <null>
+28 ; 9 ICD Expanded (#1.7)
+29 ; 10 Status (66 multiple)
+30 ; 11 Use with Sex (10 multiple)
+31 ; 12 Inactive Date (66 multiple)
+32 ; 13 Activation Date (66 multiple)
+33 ; 14 Message
+34 ; 15 Coding System (#1.1)
+35 ;
+36 ; or
+37 ;
+38 ; -1^Error Description
+39 ;
+40 NEW IEN,NODE,OUT,ROOT,SNAM,SAI,ICDY
SET FMT=$GET(FMT)
IF '$LENGTH(FMT)
SET FMT="E"
+41 SET ROOT=$$ROOT^ICDEX(80.1)
SET CODE=$GET(CODE)
IF '$LENGTH(CODE)
QUIT "-1^No Code Selected"
+42 IF FMT="I"&(CODE'?1N.N)
QUIT "-1^Code not in correct format"
+43 ;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
+44 IF FMT="I"
IF CODE?1N.N
SET IEN=CODE
SET CODE=$PIECE($GET(^ICD0(IEN,0)),"^",1)
+45 IF '$LENGTH(CODE)
QUIT "-1^No Code Selected"
+46 ;S SYS=$$SYS^ICDEX(+($G(SYS))),LOC=+($G(LOC)) I +SYS'>0 D ;IHS/OIT/FBD&NKD - INT SYS (OPT)
+47 SET SYS=$$SYS^ICDEX(+($GET(SYS)))
SET LOC=+($GET(LOC))
IF +SYS'>0&(+$GET(IEN))
SET SYS=$$CSI^ICDEX(80.1,+$GET(IEN))
IF +SYS'>0
Begin DoDot:1
+48 NEW FILE
SET FILE=$$CODEFI^ICDEX(CODE)
SET SYS=$PIECE($$CODECS^ICDEX(CODE,FILE),"^",1)
End DoDot:1
+49 IF +SYS>0&('$DATA(@(ROOT_"""ABA"","_+SYS_")")))
QUIT "-1^Invalid Coding System"
+50 ;S SNAM=$$SNAM^ICDEX(+SYS),IEN=$S(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT)) ;IHS/OIT/FBD&NKD - INT IEN (OPT)
+51 SET SNAM=$$SNAM^ICDEX(+SYS)
SET IEN=$SELECT(+$GET(IEN):+IEN,+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
+52 IF +IEN'>0&(+($GET(LOC))>0)&($DATA(^ICD0("AVA",(CODE_" "))))
SET IEN=$ORDER(^ICD0("AVA",(CODE_" "),0))
+53 IF IEN<1&(+SYS>0)&($LENGTH(SNAM))
QUIT ("-1^Invalid Code (not found in the "_SNAM_" system)")
+54 IF IEN<1
QUIT "-1^Invalid Code"
IF '$DATA(^ICD0(IEN,0))
QUIT "-1^Invalid Code (not found)"
+55 SET ICDY=$PIECE($GET(^ICD0(IEN,1)),"^",1)
IF +ICDY'>0
QUIT "-1^Invalid Coding System"
+56 SET CDT=$PIECE($GET(CDT),".",1)
IF '$LENGTH($GET(CDT))
SET CDT=$$DT^XLFDT
+57 SET CDT=$$DTBR^ICDEX($GET(CDT),,ICDY)
IF CDT'?7N
QUIT "-1^No Date Provided"
+58 SET NODE=$PIECE($GET(^ICD0(+IEN,0)),"^",1)
IF '$LENGTH(NODE)
QUIT "-1^Code not found"
+59 IF '$GET(SRC)&($PIECE(^ICD0(IEN,1),U,7))
QUIT ("-1^VA Local Code Selected ("_NODE_")")
+60 NEW SRC
SET OUT=IEN_"^"_NODE
SET SAI=$$SAI^ICDEX(80.1,IEN,CDT)
+61 SET NODE=$GET(^ICD0(IEN,1))
IF '$LENGTH(NODE)
QUIT "-1^Data not found"
+62 SET $PIECE(OUT,"^",3)=$$IDSTR^ICDEX(80.1,IEN)
+63 SET $PIECE(OUT,"^",4)=$PIECE(NODE,"^",5)
+64 SET $PIECE(OUT,"^",5)=$$VSTP^ICDEX(IEN,CDT)
+65 IF $PIECE(NODE,"^",7)>0
SET $PIECE(OUT,"^",9)=$PIECE(NODE,"^",7)
+66 SET $PIECE(OUT,"^",10)=$SELECT(+$PIECE($GET(SAI),"^",1)>0:1,1:0)
+67 SET $PIECE(OUT,"^",11)=$$VSEX^ICDEX(80.1,IEN,CDT)
+68 SET $PIECE(OUT,"^",12)=$SELECT($PIECE($GET(SAI),"^",3)?7N:$PIECE($GET(SAI),"^",3),1:"")
+69 SET $PIECE(OUT,"^",13)=$SELECT($PIECE($GET(SAI),"^",2)?7N:$PIECE($GET(SAI),"^",2),1:"")
+70 SET $PIECE(OUT,"^",14)=$$MSG^ICDEX(CDT)
+71 IF +($GET(^ICD0(+IEN,1)))>0
SET $PIECE(OUT,"^",15)=+($GET(^ICD0(+IEN,1)))
+72 QUIT OUT
ICDD(CODE,ARY,CDT,SYS,LEN) ; Returns ICD description in array
+1 ;
+2 ; Input:
+3 ;
+4 ; CODE Code, external format (required)
+5 ; ARY Array Name passed by reference (required)
+6 ; CDT Date (optional, default = TODAY)
+7 ; SYS Coding System (optional)
+8 ; LEN Sting Length (optional, > 27, default 245)
+9 ;
+10 ; Output:
+11 ;
+12 ; # Number of lines in array
+13 ;
+14 ; ARY(1) - Versioned Description (68 multiple)
+15 ;
+16 ; If there is a warning message (ICD-9 only):
+17 ;
+18 ; ARY(n+1) - blank
+19 ; ARY(n+2) - warning message: CODE TEXT MAY BE INACCURATE
+20 ;
+21 ; or
+22 ;
+23 ; -1^Error Description
+24 ;
+25 ;
+26 NEW ARR,END,I,N,ROOT,SNAM,VAR,IEN,ICDY
+27 IF '$LENGTH($GET(CODE))
QUIT "-1^Missing required input parameter CODE"
+28 SET SYS=$$SYS^ICDEX(+($GET(SYS)))
IF +SYS'>0
Begin DoDot:1
+29 NEW FILE
SET FILE=$$CODEFI^ICDEX(CODE)
SET SYS=$PIECE($$CODECS^ICDEX(CODE,FILE),"^",1)
End DoDot:1
+30 SET ROOT=$$ROOT^ICDEX(+SYS)
+31 IF "^ICD9(^ICD0(^"'[("^"_$EXTRACT(ROOT,2,$LENGTH(ROOT))_"^")!('$LENGTH(ROOT))
QUIT "-1^Invalid Coding System"
+32 IF +SYS>0&('$DATA(@(ROOT_"""ABA"","_+SYS_")")))
QUIT "-1^Invalid Coding System"
+33 SET SNAM=$$SNAM^ICDEX(+SYS)
SET IEN=$SELECT(+SYS>0:$$CODEABA(CODE,ROOT,SYS),1:$$CODEBA(CODE,ROOT))
+34 IF +IEN<1!('$LENGTH(ROOT))
QUIT "-1^Invalid Code"
IF '$DATA(@(ROOT_IEN_",0)"))
QUIT "-1^Code not found"
+35 SET LEN=+($GET(LEN))
IF LEN'>0
SET LEN=245
IF LEN<28
SET LEN=245
KILL ARY
+36 SET ICDY=$PIECE($GET(@(ROOT_+IEN_",1)")),"^",1)
+37 IF +ICDY'>0
QUIT "-1^Invalid Coding System"
+38 SET I=0
SET N=0
+39 SET CDT=$PIECE($GET(CDT),".",1)
IF '$LENGTH($GET(CDT))
SET CDT=$$DT^XLFDT
+40 SET CDT=$$DTBR^ICDEX($GET(CDT),,ICDY)
IF CDT'?7N
QUIT "-1^No Date Provided"
+41 SET ARY(1)=$$VLT^ICDEX(ROOT,IEN,CDT)
+42 IF LEN>27
IF LEN<245
DO PAR^ICDEX(.ARY,LEN)
+43 SET N=$ORDER(ARY(" "),-1)
IF +ICDY<3
Begin DoDot:1
+44 NEW MSG
SET MSG=$$MSG^ICDEX(CDT)
IF '$LENGTH(MSG)
QUIT
SET ARY(N+1)=" "
SET ARY(N+2)=MSG
End DoDot:1
+45 SET N=+($ORDER(ARY(" "),-1))
+46 QUIT N
CODEN(CODE,FILE) ; Return IEN of ICD code
+1 ;
+2 ; Input:
+3 ;
+4 ; CODE ICD code (required)
+5 ; FILE File Number to search for code
+6 ; 80 = ICD Dx file
+7 ; 80.1 = ICD Oper/Proc file
+8 ;
+9 ; Output:
+10 ;
+11 ; IEN~Global Root or -1~error message
+12 ;
+13 NEW ROOT,IEN,ERR,SYS,EIEN,ICDU
SET ERR=""
+14 IF $GET(CODE)=""
QUIT "-1~Missing required input parameter CODE"
+15 SET CODE=$TRANSLATE(CODE," ","")
SET ICDU=$$UP^XLFSTR(CODE)
+16 IF "^80^80.1^"'[("^"_$GET(FILE)_"^")
SET FILE=$$CODEFI^ICDEX(CODE)
+17 ;S SYS=$P($$CODECS^ICDEX(CODE,FILE),"^",1) ;IHS/OIT/FBD&NKD - UNUSED CALL (OPT)
+18 SET ROOT=$$ROOT^ICDEX($GET(FILE))
IF '$LENGTH(ROOT)
QUIT "-1~Invalid File"
+19 SET IEN=$$CODEBA(CODE,ROOT)
IF +IEN'>0
SET ERR="-1~Invalid or Code not found"
+20 IF $DATA(ICDVP)
IF CODE?1N.N
IF +ERR<0
IF $LENGTH(ROOT)
IF $DATA(@(ROOT_+CODE_",0)"))
SET IEN=+CODE
SET ERR=""
NEW ICDVP
+21 IF +IEN>0
IF $DATA(@(ROOT_"""AEXC"","""_ICDU_" "","_+IEN_")"))
Begin DoDot:1
+22 SET ERR="-1~IEN "_+IEN_" is excluded from lookup"
End DoDot:1
+23 IF +ERR<0
QUIT ERR
QUIT (IEN_"~"_ROOT)
CODE(FILE,IEN) ; Replaces Direct Global Read of Code
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number (required)
+5 ; FILE File Number 80 or 80.1 (required)
+6 ;
+7 ; Output:
+8 ;
+9 ; $$CODE An ICD Diagnosis or Procedure code
+10 ;
+11 ; or -1 ^ message on error
+12 ;
+13 ; Retire IA 280, 365, 582, 5388, 5404
+14 ;
+15 NEW ICDC,ICDF,ICDI,ICDR,ICDE
SET ICDI=$GET(IEN)
IF +ICDI'>0
QUIT "-1^Invalid IEN"
+16 SET ICDF=$GET(FILE)
IF "^80^80.1^"'[("^"_ICDF_"^")
QUIT "-1^Invalid File"
+17 SET ICDR=$$ROOT^ICDEX(ICDF)
IF '$LENGTH(ICDR)
QUIT "-1^Invalid File Root"
+18 IF '$DATA(@(ICDR_+ICDI_")"))
QUIT "-1^Invalid IEN for File"
+19 SET ICDC=$PIECE($GET(@(ICDR_+ICDI_",0)")),"^",1)
+20 QUIT $SELECT($LENGTH(ICDC):ICDC,1:"-1^Code Not Found")
CODEBA(CODE,ROOT) ; Return IEN based on Code and Root
+1 ;
+2 ; Input:
+3 ;
+4 ; CODE ICD Code, either ICD-9 or ICD-10 (required)
+5 ; ROOT File Root or Number (required)
+6 ; ^ICD9( or 80
+7 ; ^ICD0( or 80.1
+8 ;
+9 ; Output:
+10 ;
+11 ; IEN IEN for CODE in ROOT or -1 if not found
+12 ;
+13 ;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
+14 ;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
+15 NEW IEN,OUT,FILE,TMP,ICDU,VIEN,EIEN
SET IEN=0
SET OUT=""
SET CODE=$GET(CODE)
SET ROOT=$$ROOT^ICDEX($GET(ROOT))
SET FILE=$$FILE^ICDEX(ROOT)
IF '$LENGTH(CODE)!'$LENGTH(ROOT)
QUIT -1
+16 SET ICDU=$$UP^XLFSTR(CODE)
SET EIEN=$ORDER(@(ROOT_"""AEXC"","""_ICDU_" "",0)"))
+17 SET VIEN=$ORDER(@(ROOT_"""AVA"","""_ICDU_" "",0)"))
+18 IF +IEN'>0
IF CODE?1N.N
IF $LENGTH(ROOT)
Begin DoDot:1
+19 IF $DATA(ICDVP)
IF $DATA(@(ROOT_+CODE_",0)"))
SET (IEN,OUT)=+CODE
NEW ICDVP
End DoDot:1
+20 IF IEN'>0
SET OUT=""
SET IEN=0
FOR TMP=CODE,ICDU
Begin DoDot:1
+21 SET IEN=0
FOR
SET IEN=$ORDER(@(ROOT_"""BA"","""_TMP_" "","_IEN_")"))
IF +IEN'>0
QUIT
IF +OUT>0
QUIT
Begin DoDot:2
+22 NEW EXC
SET EXC=$$EXC^ICDEX(FILE,IEN)
IF +EXC'>0
SET OUT=IEN
End DoDot:2
End DoDot:1
+23 SET IEN=+($GET(OUT))
+24 IF +IEN>0
IF $DATA(@(ROOT_"""AEXC"","""_ICDU_" "","_+IEN_")"))
QUIT ("-1^IEN "_+EIEN_" is excluded from lookup")
+25 IF +IEN'>0
IF +EIEN>0
QUIT ("-1^Code "_ICDU_", IEN "_+EIEN_" is excluded from lookup")
+26 IF +IEN'>0
IF +VIEN>0
QUIT ("-1^Code "_ICDU_", IEN "_+VIEN_" is a VA local code, not used")
+27 QUIT $SELECT('IEN:-1,1:IEN)
CODEABA(CODE,ROOT,SYS) ; Return IEN based on Code, Root and Coding System
+1 ;
+2 ; Input:
+3 ;
+4 ; CODE ICD Code, either ICD-9 or ICD-10 (required)
+5 ; ROOT File Root or Number (Optional if SYS is supplied)
+6 ; ^ICD9( or 80
+7 ; ^ICD0( or 80.1
+8 ; SYS Coding System (required)
+9 ; 1 = ICD-9 Diagnosis
+10 ; 2 = ICD-9 Procedure
+11 ; 30 = ICD-10 Diagnosis
+12 ; 31 = ICD-10 Procedure
+13 ;
+14 ; Output:
+15 ;
+16 ; IEN IEN for CODE in ROOT for SYS
+17 ; or
+18 ; -1 ^ error message if not found
+19 ;
+20 NEW IEN,ICDF,ICDR,ICDI,ICDS,ICDU,ICDE,ICDV
SET CODE=$TRANSLATE($GET(CODE)," ","")
+21 IF '$LENGTH(CODE)
QUIT "-1^Code missing"
IF CODE[""""
QUIT "-1^Invalid code"
+22 SET (ICDS,SYS)=+($GET(SYS))
SET ICDU=$$UP^XLFSTR(CODE)
+23 IF ICDS'>0
Begin DoDot:1
+24 NEW ICDF
SET ICDF=$$CODEFI^ICDEX(CODE)
SET (ICDS,SYS)=$PIECE($$CODECS^ICDEX(CODE,ICDF),"^",1)
End DoDot:1
+25 IF +ICDS'>0
QUIT "-1^Invalid coding system"
+26 SET ICDR=""
SET ICDR=$$ROOT^ICDEX($GET(ROOT))
+27 IF '$LENGTH(ICDR)
SET ICDR=$$ROOT^ICDEX(+($GET(SYS)))
+28 IF '$LENGTH(ICDR)
SET ICDR=$$ROOT^ICDEX(+($GET(ICDS)))
+29 IF '$LENGTH(ICDR)
QUIT "-1^Invalid file/root"
+30 SET ICDE=$ORDER(@(ICDR_"""AEXC"","""_ICDU_" "",0)"))
+31 SET ICDV=$ORDER(@(ICDR_"""AVA"","""_ICDU_" "",0)"))
+32 IF +($GET(IEN))'>0
SET IEN=$ORDER(@(ICDR_"""ABA"","_+ICDS_","""_CODE_" "","" "")"),-1)
+33 IF +($GET(IEN))'>0
SET IEN=$ORDER(@(ICDR_"""ABA"","_+ICDS_","""_ICDU_" "","" "")"),-1)
+34 IF IEN'>0
IF +ICDE>0
QUIT ("-1^IEN "_+ICDE_" is excluded from lookup")
+35 IF IEN'>0
IF +ICDV>0
QUIT ("-1^CODE "_ICDU_", IEN "_+ICDE_" is a VA local code, not used")
+36 QUIT $SELECT('IEN:"-1^IEN/Code not found",1:IEN)
