ICDEXC3 ;SLC/KER - ICD Extractor - Code APIs (cont) ;04/21/2014
;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
;
; Global Variables
; ^ICD0("ADS") N/A
; ^ICD0("AST") N/A
; ^ICD9("ADS") N/A
; ^ICD9("AST") N/A
; ^UTILITY($J) ICR 10011
;
; External References
; $$DT^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
; ^DIWP ICR 10011
;
Q
VST(FILE,IEN,CDT) ; Versioned Short Text
;
; Input:
;
; FILE Global Root/File #/Coding System/SAB
; IEN IEN (required)
; CDT Date to use to Extract Text (default TODAY)
;
; Output:
;
; VST Short Text from either file 80 or 80.1
;
N ICDF,ICDR S ICDR=$$ROOT^ICDEX($G(FILE)) Q:'$L(ICDR) ""
S ICDF=$$FILE^ICDEX(ICDR) Q:+ICDF'>0 ""
Q:ICDF=80 $$VSTD($G(IEN),$G(CDT))
Q:ICDF=80.1 $$VSTP($G(IEN),$G(CDT))
Q ""
VLT(FILE,IEN,CDT) ; Versioned Long Text
;
; Input:
;
; FILE Global Root/File #/Coding System/SAB
; IEN IEN (required)
; CDT Date to use to Extract Text (default TODAY)
;
; Output:
;
; VLT Long Text (description) from either file 80 or 80.1
;
N ICDF,ICDR S ICDR=$$ROOT^ICDEX($G(FILE)) Q:'$L(ICDR) ""
S ICDF=$$FILE^ICDEX(ICDR) Q:+ICDF'>0 ""
Q:ICDF=80 $$VLTD($G(IEN),$G(CDT))
Q:ICDF=80.1 $$VLTP($G(IEN),$G(CDT))
Q ""
VSTD(IEN,CDT) ; Versioned Short Text (Dx)
;
; Input:
;
; IEN IEN (required)
; CDT Date to use to Extract Text (default TODAY)
;
; Output:
;
; VST Short Text from file 80
;
N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT S ICDI=+($G(IEN)) Q:+ICDI'>0 "" Q:'$D(^ICD9(+ICDI)) ""
S ICDT=$G(CDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N "" S ICD0=$G(^ICD9(+ICDI,0)),ICDC=$P(ICD0,U,1) Q:'$L(ICDC) ""
S STD=$O(^ICD9("AST",(ICDC_" "),(ICDT+.000001)),-1)
I +STD>0 D Q:$L($G(TXT)) $G(TXT)
.S STI=$O(^ICD9("AST",(ICDC_" "),STD,+ICDI," "),-1),TXT=$$TRIM($P($G(^ICD9(+ICDI,67,+STI,0)),U,2))
S STD=$O(^ICD9(+ICDI,67,"B",0)) I +STD>0 D Q:$L($G(TXT)) $G(TXT)
.S STI=$O(^ICD9(+ICDI,67,"B",STD,0)),TXT=$$TRIM($P($G(^ICD9(+ICDI,67,+STI,0)),U,2))
Q $$TRIM($P(ICD0,U,3))
VSTP(IEN,CDT) ; Return versioned Short Text (Proc)
;
; Input:
;
; IEN IEN (required)
; CDT Date to use to Extract Text (default TODAY)
;
; Output:
;
; VST Short Text from file 80.1
;
N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT S ICDI=+($G(IEN)) Q:+ICDI'>0 "" Q:'$D(^ICD0(+ICDI)) ""
S ICDT=$G(CDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N "" S ICD0=$G(^ICD0(+ICDI,0)),ICDC=$P(ICD0,U,1) Q:'$L(ICDC) ""
S STD=$O(^ICD0("AST",(ICDC_" "),(ICDT+.000001)),-1)
I +STD>0 D Q:$L($G(TXT)) $G(TXT)
.S STI=$O(^ICD0("AST",(ICDC_" "),STD,+ICDI," "),-1),TXT=$$TRIM($P($G(^ICD0(+ICDI,67,+STI,0)),U,2))
S STD=$O(^ICD0(+ICDI,67,"B",0)) I +STD>0 D Q:$L($G(TXT)) $G(TXT)
.S STI=$O(^ICD0(+ICDI,67,"B",STD,0)),TXT=$$TRIM($P($G(^ICD0(+ICDI,67,+STI,0)),U,2))
Q $$TRIM($P(ICD0,U,4))
VLTD(IEN,CDT) ; Versioned Description - Long Text (Dx)
;
; Input:
;
; IEN IEN (required)
; CDT Date to use to Extract Text (default TODAY)
;
; Output:
;
; VLT Long Text from file 80
;
N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
S ICDI=+($G(IEN)) Q:+ICDI'>0 "" Q:'$D(^ICD9(+ICDI)) ""
S ICDT=$G(CDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""
S ICD0=$G(^ICD9(+ICDI,0)),ICDC=$P(ICD0,U,1) Q:'$L(ICDC) ""
S STD=$O(^ICD9("ADS",(ICDC_" "),(ICDT+.000001)),-1)
I +STD>0 D Q:$L($G(TXT)) $G(TXT)
.S STI=$O(^ICD9("ADS",(ICDC_" "),STD,+ICDI," "),-1)
.S TXT=$$TRIM($P($G(^ICD9(+ICDI,68,+STI,1)),U,1))
S STD=$O(^ICD9(+ICDI,68,"B",0))
I +STD>0 D Q:$L($G(TXT)) $G(TXT)
.S STI=$O(^ICD9(+ICDI,68,"B",STD,0))
.S TXT=$$TRIM($P($G(^ICD9(+ICDI,68,+STI,1)),U,1))
S TXT=$$TRIM($G(^ICD9(+ICDI,1))) Q:$L($G(TXT)) $G(TXT)
Q $$TRIM($P(ICD0,U,3))
VLTP(IEN,CDT) ; Versioned Description - Long Text (Proc)
;
; Input:
;
; IEN IEN (required)
; CDT Date to use to Extract Text (default TODAY)
;
; Output:
;
; VLT Long Text from file 80.1
;
N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
S ICDI=+($G(IEN)) Q:+ICDI'>0 "" Q:'$D(^ICD0(+ICDI)) ""
S ICDT=$G(CDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""
S ICD0=$G(^ICD0(+ICDI,0)),ICDC=$P(ICD0,U,1) Q:'$L(ICDC) ""
S STD=$O(^ICD0("ADS",(ICDC_" "),(ICDT+.000001)),-1)
I +STD>0 D Q:$L($G(TXT)) $G(TXT)
.S STI=$O(^ICD0("ADS",(ICDC_" "),STD,+ICDI," "),-1)
.S TXT=$$TRIM($P($G(^ICD0(+ICDI,68,+STI,1)),U,1))
S STD=$O(^ICD0(+ICDI,68,"B",0))
I +STD>0 D Q:$L($G(TXT)) $G(TXT)
.S STI=$O(^ICD0(+ICDI,68,"B",STD,0))
.S TXT=$$TRIM($P($G(^ICD0(+ICDI,68,+STI,1)),U,1))
S TXT=$$TRIM($G(^ICD0(+ICDI,1))) Q:$L($G(TXT)) $G(TXT)
Q $$TRIM($P(ICD0,U,4))
SD(FILE,IEN,CDT,ARY,LEN) ; Short Description (formatted)
;
; Input:
;
; IEN Internal Entry Number (Required)
; FILE File Number (Required)
; CDT Date, Default TODAY (Optional)
; .ARY Array Passed by Reference (Optional)
; LEN Text Length (15-79, default 60) (Optional)
;
; Output:
;
; $$SD Short Description OR -1 ^ Error Message
; ARY Description in segment lengths specified
;
K ARY N EFF,HIS,NOD,ROOT,TXT S IEN=+($G(IEN)),FILE=$$FILE^ICDEX($G(FILE)) Q:"^80^80.1^"'[("^"_FILE_"^") "-1^File not found"
S CDT=$G(CDT) S:CDT'?7N CDT=$$DT^XLFDT S LEN=+($G(LEN)) S:+LEN'>0 LEN=100
S:LEN>0&(LEN<15) LEN=15 S ROOT=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")
Q:'$L(ROOT) "-1^File not found" S (EFF,HIS,TXT)=""
S NOD="-1^No description found for date "_$$FMTE^XLFDT($G(CDT),"5DZ")
S EFF=+($O(@(ROOT_+IEN_",67,""B"","_(CDT+.000001)_")"),-1))
Q:EFF'?7N NOD S HIS=+($O(@(ROOT_+IEN_",67,""B"","_EFF_","" "")"),-1))
Q:+HIS'>0 NOD S TXT=$P($G(@(ROOT_+IEN_",67,"_+HIS_",0)")),"^",2)
Q:'$L(TXT) NOD S ARY(1)=TXT D:+LEN>0&(LEN'=100) PAR(.ARY,LEN)
S IEN=$O(ARY(" "),-1),ARY(0)=+IEN
S:EFF?7N ARY(0)=$G(ARY(0))_"^"_EFF S IEN=TXT
Q IEN
LD(FILE,IEN,CDT,ARY,LEN) ; Long Description (formatted)
;
; Input:
;
; IEN Internal Entry Number (Required)
; FILE File Number (Required)
; CDT Date, Default TODAY (Optional)
; .ARY Array Passed by Reference (Optional)
; LEN Text Length (15-79, default 245) (Optional)
;
; Output:
;
; $$LD Long Description OR -1 ^ Error Message
; ARY Description in lengths specified
;
K ARY N EFF,HIS,NOD,ROOT,TXT S IEN=+($G(IEN)),FILE=$$FILE^ICDEX($G(FILE)) Q:"^80^80.1^"'[("^"_FILE_"^") "-1^File not found"
S CDT=$G(CDT) S:CDT'?7N CDT=$$DT^XLFDT S LEN=+($G(LEN)) S:+LEN'>0 LEN=300
S:LEN>0&(LEN<15) LEN=15 S ROOT=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")
Q:'$L(ROOT) "-1^File not found" S (EFF,HIS,TXT)=""
S NOD="-1^No long description found for date "_$$FMTE^XLFDT($G(CDT),"5DZ")
S EFF=+($O(@(ROOT_+IEN_",68,""B"","_(CDT+.000001)_")"),-1)) Q:EFF'?7N NOD
S HIS=+($O(@(ROOT_+IEN_",68,""B"","_EFF_","" "")"),-1)) Q:+HIS'>0 NOD
S TXT=$G(@(ROOT_+IEN_",68,"_+HIS_",1)")) Q:'$L(TXT) NOD
S ARY(1)=TXT D:+($G(LEN))>0&(LEN'=300) PAR(.ARY,LEN)
S IEN=$O(ARY(" "),-1),ARY(0)=+IEN
S:EFF?7N ARY(0)=$G(ARY(0))_"^"_EFF S IEN=TXT
Q IEN
CC(IEN,CDT) ; Complication/Comorbidity (C/C)
;
; Input
;
; IEN Internal Entry Number (Required)
; CDT Date, Default TODAY (Optional)
;
; Output
;
; $$CC A code for C/C or Error
; 0 Non-CC
; 1 CC
; 2 Major CC
; -1 ^ error
;
N CEFF,CIEN S CDT=$S($G(CDT)?7N:$G(CDT),1:$$DT^XLFDT)
S CEFF=$O(^ICD9(+$G(IEN),69,"B",(CDT+.000001)),-1)
Q:CEFF'?7N ("-1^No CC for "_$$FMTE^XLFDT($G(CDT),"5DZ"))
S CIEN=$O(^ICD9(+$G(IEN),69,"B",CEFF," "),-1)
Q:+CIEN'>0 ("-1^No CC for "_$$FMTE^XLFDT($G(CDT),"5DZ"))
S IEN=$P(^ICD9(+$G(IEN),69,CIEN,0),U,2)
Q:'$L(IEN) ("-1^No CC for "_$$FMTE^XLFDT($G(CDT),"5DZ"))
Q IEN
PAR(ARY,LEN) ; Parse Array
;
; Input:
;
; .ARY Array passed by reference (required)
; LEN Array String Length
;
; Output:
;
; ARY Array parse with string lengths of LEN
;
N %,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,Z,I,IEN,CTR,X
K ^UTILITY($J,"W") Q:'$D(ARY) S LEN=+($G(LEN)) S:+LEN'>0 LEN=79
S DIWL=1,DIWF="C"_+LEN S IEN=0
F S IEN=$O(ARY(IEN)) Q:+IEN=0 S X=$G(ARY(IEN)) D ^DIWP
K ARY S (CTR,IEN)=0 F S IEN=$O(^UTILITY($J,"W",1,IEN)) Q:+IEN=0 D
. S ARY(IEN)=$$TRIM($G(^UTILITY($J,"W",1,IEN,0))," "),CTR=CTR+1
K ^UTILITY($J,"W")
Q
IEN(CODE,ROOT,SYS) ; Return IEN based on Code, Root and Coding System
;
; This API is similar to $$CODEABA^ICDEX except it will
; also return IENs for codes excluded from lookup and
; VA Local Codes. Use with caution, and do not use in
; any application that requires codes and text to be
; versioned (date sensitive).
;
; Input:
;
; CODE ICD Code, either ICD-9 or ICD-10 (required)
; ROOT File Root (optional)
; ^ICD9( or 80
; ^ICD0( or 80.1
; SYS Coding System (optional)
; 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 if not found
;
N ICDC,ICDFR,ICDFS,ICDI,ICDIX,ICDR,ICDS,ICDTR,ICDTS,ICDU
S ICDC=$TR($G(CODE)," ","") Q:'$L(ICDC) -1 Q:ICDC["""" -1
S ICDS=+($G(SYS)),ICDU=$$UP^XLFSTR(ICDC)
S ICDR=$$ROOT^ICDEX($G(ROOT))
I "^ICD9(^ICD0(^"'[("^"_$E(ICDR,2,$L(ICDR))_"^") D
. N ICDTR,ICDFR S ICDFR="" F ICDTR="^ICD9(","^ICD0(" D Q:$L(ICDFR)
. . N ICDIX S ICDIX=" " Q:'$L($O(@(ICDTR_""""_ICDIX_""")")))
. . F S ICDIX=$O(@(ICDTR_""""_ICDIX_""")")) Q:'$L(ICDIX) D Q:$L(ICDFR)
. . . I $D(@(ICDTR_""""_ICDIX_""","""_(ICDU_" ")_""")")) S ICDFR=ICDTR
. S:$L(ICDFR) ICDR=ICDFR
Q:"^ICD9(^ICD0(^"'[("^"_$E(ICDR,2,$L(ICDR))_"^") -1
I +($G(ICDS))'>0 D
. N ICDTS,ICDFS S ICDFS="" S ICDTS=0
. F S ICDTS=$O(@(ICDR_"""ABA"","_+ICDTS_")")) Q:+ICDTS'>0 D Q:ICDFS>0
. . S:$D(@(ICDR_"""ABA"","_+ICDTS_","""_ICDC_" "")")) ICDFS=ICDTS
. S:$L(ICDFS) ICDS=ICDFS
S:+($G(ICDI))'>0&(+ICDS>0) ICDI=$O(@(ICDR_"""ABA"","_+ICDS_","""_ICDC_" "","" "")"),-1)
S:+($G(ICDI))'>0&(+ICDS>0) ICDI=$O(@(ICDR_"""ABA"","_+ICDS_","""_ICDU_" "","" "")"),-1)
S:+($G(ICDI))'>0 ICDI=$O(@(ICDR_"""BA"","""_ICDC_" "","" "")"),-1)
S:+($G(ICDI))'>0 ICDI=$O(@(ICDR_"""AVA"","""_ICDC_" "","" "")"),-1)
S:+($G(ICDI))'>0 ICDI=$O(@(ICDR_"""AEXC"","""_ICDC_" "","" "")"),-1)
Q $S('ICDI:-1,1:ICDI)
TRIM(X,Y) ; Trim Character
;
; Input:
;
; X Input String
; Y Character to Trim (default " ")
;
; Output:
;
; X String without Leading/Trailing character Y
;
S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" "
F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDEXC3 11018 printed Mar 13, 2025@20:55:12 Page 2
ICDEXC3 ;SLC/KER - ICD Extractor - Code APIs (cont) ;04/21/2014
+1 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^ICD0("ADS") N/A
+5 ; ^ICD0("AST") N/A
+6 ; ^ICD9("ADS") N/A
+7 ; ^ICD9("AST") N/A
+8 ; ^UTILITY($J) ICR 10011
+9 ;
+10 ; External References
+11 ; $$DT^XLFDT ICR 10103
+12 ; $$FMTE^XLFDT ICR 10103
+13 ; $$UP^XLFSTR ICR 10104
+14 ; ^DIWP ICR 10011
+15 ;
+16 QUIT
VST(FILE,IEN,CDT) ; Versioned Short Text
+1 ;
+2 ; Input:
+3 ;
+4 ; FILE Global Root/File #/Coding System/SAB
+5 ; IEN IEN (required)
+6 ; CDT Date to use to Extract Text (default TODAY)
+7 ;
+8 ; Output:
+9 ;
+10 ; VST Short Text from either file 80 or 80.1
+11 ;
+12 NEW ICDF,ICDR
SET ICDR=$$ROOT^ICDEX($GET(FILE))
if '$LENGTH(ICDR)
QUIT ""
+13 SET ICDF=$$FILE^ICDEX(ICDR)
if +ICDF'>0
QUIT ""
+14 if ICDF=80
QUIT $$VSTD($GET(IEN),$GET(CDT))
+15 if ICDF=80.1
QUIT $$VSTP($GET(IEN),$GET(CDT))
+16 QUIT ""
VLT(FILE,IEN,CDT) ; Versioned Long Text
+1 ;
+2 ; Input:
+3 ;
+4 ; FILE Global Root/File #/Coding System/SAB
+5 ; IEN IEN (required)
+6 ; CDT Date to use to Extract Text (default TODAY)
+7 ;
+8 ; Output:
+9 ;
+10 ; VLT Long Text (description) from either file 80 or 80.1
+11 ;
+12 NEW ICDF,ICDR
SET ICDR=$$ROOT^ICDEX($GET(FILE))
if '$LENGTH(ICDR)
QUIT ""
+13 SET ICDF=$$FILE^ICDEX(ICDR)
if +ICDF'>0
QUIT ""
+14 if ICDF=80
QUIT $$VLTD($GET(IEN),$GET(CDT))
+15 if ICDF=80.1
QUIT $$VLTP($GET(IEN),$GET(CDT))
+16 QUIT ""
VSTD(IEN,CDT) ; Versioned Short Text (Dx)
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN IEN (required)
+5 ; CDT Date to use to Extract Text (default TODAY)
+6 ;
+7 ; Output:
+8 ;
+9 ; VST Short Text from file 80
+10 ;
+11 NEW ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
SET ICDI=+($GET(IEN))
if +ICDI'>0
QUIT ""
if '$DATA(^ICD9(+ICDI))
QUIT ""
+12 SET ICDT=$GET(CDT)
if '$LENGTH(ICDT)!(+ICDT'>0)
SET ICDT=$$DT^XLFDT
if $PIECE(ICDT,".",1)'?7N
QUIT ""
SET ICD0=$GET(^ICD9(+ICDI,0))
SET ICDC=$PIECE(ICD0,U,1)
if '$LENGTH(ICDC)
QUIT ""
+13 SET STD=$ORDER(^ICD9("AST",(ICDC_" "),(ICDT+.000001)),-1)
+14 IF +STD>0
Begin DoDot:1
+15 SET STI=$ORDER(^ICD9("AST",(ICDC_" "),STD,+ICDI," "),-1)
SET TXT=$$TRIM($PIECE($GET(^ICD9(+ICDI,67,+STI,0)),U,2))
End DoDot:1
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+16 SET STD=$ORDER(^ICD9(+ICDI,67,"B",0))
IF +STD>0
Begin DoDot:1
+17 SET STI=$ORDER(^ICD9(+ICDI,67,"B",STD,0))
SET TXT=$$TRIM($PIECE($GET(^ICD9(+ICDI,67,+STI,0)),U,2))
End DoDot:1
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+18 QUIT $$TRIM($PIECE(ICD0,U,3))
VSTP(IEN,CDT) ; Return versioned Short Text (Proc)
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN IEN (required)
+5 ; CDT Date to use to Extract Text (default TODAY)
+6 ;
+7 ; Output:
+8 ;
+9 ; VST Short Text from file 80.1
+10 ;
+11 NEW ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
SET ICDI=+($GET(IEN))
if +ICDI'>0
QUIT ""
if '$DATA(^ICD0(+ICDI))
QUIT ""
+12 SET ICDT=$GET(CDT)
if '$LENGTH(ICDT)!(+ICDT'>0)
SET ICDT=$$DT^XLFDT
if $PIECE(ICDT,".",1)'?7N
QUIT ""
SET ICD0=$GET(^ICD0(+ICDI,0))
SET ICDC=$PIECE(ICD0,U,1)
if '$LENGTH(ICDC)
QUIT ""
+13 SET STD=$ORDER(^ICD0("AST",(ICDC_" "),(ICDT+.000001)),-1)
+14 IF +STD>0
Begin DoDot:1
+15 SET STI=$ORDER(^ICD0("AST",(ICDC_" "),STD,+ICDI," "),-1)
SET TXT=$$TRIM($PIECE($GET(^ICD0(+ICDI,67,+STI,0)),U,2))
End DoDot:1
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+16 SET STD=$ORDER(^ICD0(+ICDI,67,"B",0))
IF +STD>0
Begin DoDot:1
+17 SET STI=$ORDER(^ICD0(+ICDI,67,"B",STD,0))
SET TXT=$$TRIM($PIECE($GET(^ICD0(+ICDI,67,+STI,0)),U,2))
End DoDot:1
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+18 QUIT $$TRIM($PIECE(ICD0,U,4))
VLTD(IEN,CDT) ; Versioned Description - Long Text (Dx)
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN IEN (required)
+5 ; CDT Date to use to Extract Text (default TODAY)
+6 ;
+7 ; Output:
+8 ;
+9 ; VLT Long Text from file 80
+10 ;
+11 NEW ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
+12 SET ICDI=+($GET(IEN))
if +ICDI'>0
QUIT ""
if '$DATA(^ICD9(+ICDI))
QUIT ""
+13 SET ICDT=$GET(CDT)
if '$LENGTH(ICDT)!(+ICDT'>0)
SET ICDT=$$DT^XLFDT
if $PIECE(ICDT,".",1)'?7N
QUIT ""
+14 SET ICD0=$GET(^ICD9(+ICDI,0))
SET ICDC=$PIECE(ICD0,U,1)
if '$LENGTH(ICDC)
QUIT ""
+15 SET STD=$ORDER(^ICD9("ADS",(ICDC_" "),(ICDT+.000001)),-1)
+16 IF +STD>0
Begin DoDot:1
+17 SET STI=$ORDER(^ICD9("ADS",(ICDC_" "),STD,+ICDI," "),-1)
+18 SET TXT=$$TRIM($PIECE($GET(^ICD9(+ICDI,68,+STI,1)),U,1))
End DoDot:1
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+19 SET STD=$ORDER(^ICD9(+ICDI,68,"B",0))
+20 IF +STD>0
Begin DoDot:1
+21 SET STI=$ORDER(^ICD9(+ICDI,68,"B",STD,0))
+22 SET TXT=$$TRIM($PIECE($GET(^ICD9(+ICDI,68,+STI,1)),U,1))
End DoDot:1
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+23 SET TXT=$$TRIM($GET(^ICD9(+ICDI,1)))
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+24 QUIT $$TRIM($PIECE(ICD0,U,3))
VLTP(IEN,CDT) ; Versioned Description - Long Text (Proc)
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN IEN (required)
+5 ; CDT Date to use to Extract Text (default TODAY)
+6 ;
+7 ; Output:
+8 ;
+9 ; VLT Long Text from file 80.1
+10 ;
+11 NEW ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
+12 SET ICDI=+($GET(IEN))
if +ICDI'>0
QUIT ""
if '$DATA(^ICD0(+ICDI))
QUIT ""
+13 SET ICDT=$GET(CDT)
if '$LENGTH(ICDT)!(+ICDT'>0)
SET ICDT=$$DT^XLFDT
if $PIECE(ICDT,".",1)'?7N
QUIT ""
+14 SET ICD0=$GET(^ICD0(+ICDI,0))
SET ICDC=$PIECE(ICD0,U,1)
if '$LENGTH(ICDC)
QUIT ""
+15 SET STD=$ORDER(^ICD0("ADS",(ICDC_" "),(ICDT+.000001)),-1)
+16 IF +STD>0
Begin DoDot:1
+17 SET STI=$ORDER(^ICD0("ADS",(ICDC_" "),STD,+ICDI," "),-1)
+18 SET TXT=$$TRIM($PIECE($GET(^ICD0(+ICDI,68,+STI,1)),U,1))
End DoDot:1
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+19 SET STD=$ORDER(^ICD0(+ICDI,68,"B",0))
+20 IF +STD>0
Begin DoDot:1
+21 SET STI=$ORDER(^ICD0(+ICDI,68,"B",STD,0))
+22 SET TXT=$$TRIM($PIECE($GET(^ICD0(+ICDI,68,+STI,1)),U,1))
End DoDot:1
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+23 SET TXT=$$TRIM($GET(^ICD0(+ICDI,1)))
if $LENGTH($GET(TXT))
QUIT $GET(TXT)
+24 QUIT $$TRIM($PIECE(ICD0,U,4))
SD(FILE,IEN,CDT,ARY,LEN) ; Short Description (formatted)
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number (Required)
+5 ; FILE File Number (Required)
+6 ; CDT Date, Default TODAY (Optional)
+7 ; .ARY Array Passed by Reference (Optional)
+8 ; LEN Text Length (15-79, default 60) (Optional)
+9 ;
+10 ; Output:
+11 ;
+12 ; $$SD Short Description OR -1 ^ Error Message
+13 ; ARY Description in segment lengths specified
+14 ;
+15 KILL ARY
NEW EFF,HIS,NOD,ROOT,TXT
SET IEN=+($GET(IEN))
SET FILE=$$FILE^ICDEX($GET(FILE))
if "^80^80.1^"'[("^"_FILE_"^")
QUIT "-1^File not found"
+16 SET CDT=$GET(CDT)
if CDT'?7N
SET CDT=$$DT^XLFDT
SET LEN=+($GET(LEN))
if +LEN'>0
SET LEN=100
+17 if LEN>0&(LEN<15)
SET LEN=15
SET ROOT=$SELECT(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")
+18 if '$LENGTH(ROOT)
QUIT "-1^File not found"
SET (EFF,HIS,TXT)=""
+19 SET NOD="-1^No description found for date "_$$FMTE^XLFDT($GET(CDT),"5DZ")
+20 SET EFF=+($ORDER(@(ROOT_+IEN_",67,""B"","_(CDT+.000001)_")"),-1))
+21 if EFF'?7N
QUIT NOD
SET HIS=+($ORDER(@(ROOT_+IEN_",67,""B"","_EFF_","" "")"),-1))
+22 if +HIS'>0
QUIT NOD
SET TXT=$PIECE($GET(@(ROOT_+IEN_",67,"_+HIS_",0)")),"^",2)
+23 if '$LENGTH(TXT)
QUIT NOD
SET ARY(1)=TXT
if +LEN>0&(LEN'=100)
DO PAR(.ARY,LEN)
+24 SET IEN=$ORDER(ARY(" "),-1)
SET ARY(0)=+IEN
+25 if EFF?7N
SET ARY(0)=$GET(ARY(0))_"^"_EFF
SET IEN=TXT
+26 QUIT IEN
LD(FILE,IEN,CDT,ARY,LEN) ; Long Description (formatted)
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number (Required)
+5 ; FILE File Number (Required)
+6 ; CDT Date, Default TODAY (Optional)
+7 ; .ARY Array Passed by Reference (Optional)
+8 ; LEN Text Length (15-79, default 245) (Optional)
+9 ;
+10 ; Output:
+11 ;
+12 ; $$LD Long Description OR -1 ^ Error Message
+13 ; ARY Description in lengths specified
+14 ;
+15 KILL ARY
NEW EFF,HIS,NOD,ROOT,TXT
SET IEN=+($GET(IEN))
SET FILE=$$FILE^ICDEX($GET(FILE))
if "^80^80.1^"'[("^"_FILE_"^")
QUIT "-1^File not found"
+16 SET CDT=$GET(CDT)
if CDT'?7N
SET CDT=$$DT^XLFDT
SET LEN=+($GET(LEN))
if +LEN'>0
SET LEN=300
+17 if LEN>0&(LEN<15)
SET LEN=15
SET ROOT=$SELECT(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")
+18 if '$LENGTH(ROOT)
QUIT "-1^File not found"
SET (EFF,HIS,TXT)=""
+19 SET NOD="-1^No long description found for date "_$$FMTE^XLFDT($GET(CDT),"5DZ")
+20 SET EFF=+($ORDER(@(ROOT_+IEN_",68,""B"","_(CDT+.000001)_")"),-1))
if EFF'?7N
QUIT NOD
+21 SET HIS=+($ORDER(@(ROOT_+IEN_",68,""B"","_EFF_","" "")"),-1))
if +HIS'>0
QUIT NOD
+22 SET TXT=$GET(@(ROOT_+IEN_",68,"_+HIS_",1)"))
if '$LENGTH(TXT)
QUIT NOD
+23 SET ARY(1)=TXT
if +($GET(LEN))>0&(LEN'=300)
DO PAR(.ARY,LEN)
+24 SET IEN=$ORDER(ARY(" "),-1)
SET ARY(0)=+IEN
+25 if EFF?7N
SET ARY(0)=$GET(ARY(0))_"^"_EFF
SET IEN=TXT
+26 QUIT IEN
CC(IEN,CDT) ; Complication/Comorbidity (C/C)
+1 ;
+2 ; Input
+3 ;
+4 ; IEN Internal Entry Number (Required)
+5 ; CDT Date, Default TODAY (Optional)
+6 ;
+7 ; Output
+8 ;
+9 ; $$CC A code for C/C or Error
+10 ; 0 Non-CC
+11 ; 1 CC
+12 ; 2 Major CC
+13 ; -1 ^ error
+14 ;
+15 NEW CEFF,CIEN
SET CDT=$SELECT($GET(CDT)?7N:$GET(CDT),1:$$DT^XLFDT)
+16 SET CEFF=$ORDER(^ICD9(+$GET(IEN),69,"B",(CDT+.000001)),-1)
+17 if CEFF'?7N
QUIT ("-1^No CC for "_$$FMTE^XLFDT($GET(CDT),"5DZ"))
+18 SET CIEN=$ORDER(^ICD9(+$GET(IEN),69,"B",CEFF," "),-1)
+19 if +CIEN'>0
QUIT ("-1^No CC for "_$$FMTE^XLFDT($GET(CDT),"5DZ"))
+20 SET IEN=$PIECE(^ICD9(+$GET(IEN),69,CIEN,0),U,2)
+21 if '$LENGTH(IEN)
QUIT ("-1^No CC for "_$$FMTE^XLFDT($GET(CDT),"5DZ"))
+22 QUIT IEN
PAR(ARY,LEN) ; Parse Array
+1 ;
+2 ; Input:
+3 ;
+4 ; .ARY Array passed by reference (required)
+5 ; LEN Array String Length
+6 ;
+7 ; Output:
+8 ;
+9 ; ARY Array parse with string lengths of LEN
+10 ;
+11 NEW %,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,Z,I,IEN,CTR,X
+12 KILL ^UTILITY($JOB,"W")
if '$DATA(ARY)
QUIT
SET LEN=+($GET(LEN))
if +LEN'>0
SET LEN=79
+13 SET DIWL=1
SET DIWF="C"_+LEN
SET IEN=0
+14 FOR
SET IEN=$ORDER(ARY(IEN))
if +IEN=0
QUIT
SET X=$GET(ARY(IEN))
DO ^DIWP
+15 KILL ARY
SET (CTR,IEN)=0
FOR
SET IEN=$ORDER(^UTILITY($JOB,"W",1,IEN))
if +IEN=0
QUIT
Begin DoDot:1
+16 SET ARY(IEN)=$$TRIM($GET(^UTILITY($JOB,"W",1,IEN,0))," ")
SET CTR=CTR+1
End DoDot:1
+17 KILL ^UTILITY($JOB,"W")
+18 QUIT
IEN(CODE,ROOT,SYS) ; Return IEN based on Code, Root and Coding System
+1 ;
+2 ; This API is similar to $$CODEABA^ICDEX except it will
+3 ; also return IENs for codes excluded from lookup and
+4 ; VA Local Codes. Use with caution, and do not use in
+5 ; any application that requires codes and text to be
+6 ; versioned (date sensitive).
+7 ;
+8 ; Input:
+9 ;
+10 ; CODE ICD Code, either ICD-9 or ICD-10 (required)
+11 ; ROOT File Root (optional)
+12 ; ^ICD9( or 80
+13 ; ^ICD0( or 80.1
+14 ; SYS Coding System (optional)
+15 ; 1 = ICD-9 Diagnosis
+16 ; 2 = ICD-9 Procedure
+17 ; 30 = ICD-10 Diagnosis
+18 ; 31 = ICD-10 Procedure
+19 ;
+20 ; Output:
+21 ;
+22 ; IEN IEN for CODE in ROOT for SYS or -1 if not found
+23 ;
+24 NEW ICDC,ICDFR,ICDFS,ICDI,ICDIX,ICDR,ICDS,ICDTR,ICDTS,ICDU
+25 SET ICDC=$TRANSLATE($GET(CODE)," ","")
if '$LENGTH(ICDC)
QUIT -1
if ICDC[""""
QUIT -1
+26 SET ICDS=+($GET(SYS))
SET ICDU=$$UP^XLFSTR(ICDC)
+27 SET ICDR=$$ROOT^ICDEX($GET(ROOT))
+28 IF "^ICD9(^ICD0(^"'[("^"_$EXTRACT(ICDR,2,$LENGTH(ICDR))_"^")
Begin DoDot:1
+29 NEW ICDTR,ICDFR
SET ICDFR=""
FOR ICDTR="^ICD9(","^ICD0("
Begin DoDot:2
+30 NEW ICDIX
SET ICDIX=" "
if '$LENGTH($ORDER(@(ICDTR_""""_ICDIX_""")")))
QUIT
+31 FOR
SET ICDIX=$ORDER(@(ICDTR_""""_ICDIX_""")"))
if '$LENGTH(ICDIX)
QUIT
Begin DoDot:3
+32 IF $DATA(@(ICDTR_""""_ICDIX_""","""_(ICDU_" ")_""")"))
SET ICDFR=ICDTR
End DoDot:3
if $LENGTH(ICDFR)
QUIT
End DoDot:2
if $LENGTH(ICDFR)
QUIT
+33 if $LENGTH(ICDFR)
SET ICDR=ICDFR
End DoDot:1
+34 if "^ICD9(^ICD0(^"'[("^"_$EXTRACT(ICDR,2,$LENGTH(ICDR))_"^")
QUIT -1
+35 IF +($GET(ICDS))'>0
Begin DoDot:1
+36 NEW ICDTS,ICDFS
SET ICDFS=""
SET ICDTS=0
+37 FOR
SET ICDTS=$ORDER(@(ICDR_"""ABA"","_+ICDTS_")"))
if +ICDTS'>0
QUIT
Begin DoDot:2
+38 if $DATA(@(ICDR_"""ABA"","_+ICDTS_","""_ICDC_" "")"))
SET ICDFS=ICDTS
End DoDot:2
if ICDFS>0
QUIT
+39 if $LENGTH(ICDFS)
SET ICDS=ICDFS
End DoDot:1
+40 if +($GET(ICDI))'>0&(+ICDS>0)
SET ICDI=$ORDER(@(ICDR_"""ABA"","_+ICDS_","""_ICDC_" "","" "")"),-1)
+41 if +($GET(ICDI))'>0&(+ICDS>0)
SET ICDI=$ORDER(@(ICDR_"""ABA"","_+ICDS_","""_ICDU_" "","" "")"),-1)
+42 if +($GET(ICDI))'>0
SET ICDI=$ORDER(@(ICDR_"""BA"","""_ICDC_" "","" "")"),-1)
+43 if +($GET(ICDI))'>0
SET ICDI=$ORDER(@(ICDR_"""AVA"","""_ICDC_" "","" "")"),-1)
+44 if +($GET(ICDI))'>0
SET ICDI=$ORDER(@(ICDR_"""AEXC"","""_ICDC_" "","" "")"),-1)
+45 QUIT $SELECT('ICDI:-1,1:ICDI)
TRIM(X,Y) ; Trim Character
+1 ;
+2 ; Input:
+3 ;
+4 ; X Input String
+5 ; Y Character to Trim (default " ")
+6 ;
+7 ; Output:
+8 ;
+9 ; X String without Leading/Trailing character Y
+10 ;
+11 SET X=$GET(X)
if X=""
QUIT X
SET Y=$GET(Y)
if '$LENGTH(Y)
SET Y=" "
+12 FOR
if $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+13 FOR
if $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+14 QUIT X
