ICDCODE ;DLS/DEK/KER - ICD CODE APIS ; 10/20/04 8:54am
 ;;18.0;DRG Grouper;**6,12,14**;Oct 20, 2000;Build 1
 ;
 ; External References
 ;   DBIA 10103  $$DT^XLFDT
 ;
ICDDX(CODE,CDT,DFN,SRC) ; Return ICD Dx Code Info
 ;Input:   CODE  Code/IEN (required)
 ;         CDT   Date (default = TODAY)
 ;         DFN   Not in use
 ;         SRC   Source
 ;               0 = exclude local codes
 ;               1 = include local codes
 ;
 ;Output:  Returns an 18 piece string delimited by ^
 ;           1  IEN of code in ^ICD9(
 ;           2  ICD-9 Dx Code (#.01)
 ;           3  Id (#2)
 ;           4  Versioned Dx (67 multiple)
 ;           5  Unacceptable as Principal Dx (#101)
 ;           6  Major Dx Cat (#5)
 ;           7  MDC13 (5.5)
 ;           8  Compl/Comorb (#70)
 ;           9  ICD Expanded (#8) 1:Yes 0:No
 ;          10  Status (66 multiple)
 ;          11  Sex (#9.5)
 ;          12  Inactive Date (66 multiple)
 ;          13  MDC24 (#5.7)
 ;          14  MDC25 (#5.9)
 ;          15  Age Low (#14)
 ;          16  Age High (#15)
 ;          17  Activation Date (.01 of 66 multiple)
 ;          18  Message
 ;
 ;           or
 ;
 ;         -1^Error Description
 ;
 N DATA,EFF,INV,MDC,DRGFY
 I $G(CODE)="" Q "-1^NO CODE SELECTED"
 S INV="-1^INVALID CODE",CODE=+$$CODEN(CODE,80)
 I CODE<1 Q INV
 I '$D(^ICD9(CODE)) Q INV
 I '$G(SRC),$P(^ICD9(CODE,0),"^",8) Q "-1^VA LOCAL CODE SELECTED"
 S DATA=$G(^ICD9(CODE,0)) I '$L(DATA) Q "-1^NO DATA"
 S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICDAPIU(CDT))
 S EFF=$$EFF^ICDSUPT(80,CODE,CDT)
 S $P(DATA,"^",6)=$$VMDC^ICDREF(CODE)
 S $P(DATA,"^",9)=$S(EFF<1:0,1:$P(EFF,"^"))
 S $P(DATA,"^",11)=$P(EFF,"^",2),$P(DATA,"^",16)=$P(EFF,"^",3)
 S $P(DATA,"^",3)=$$VSTD(CODE,CDT)
 Q CODE_"^"_DATA_"^"_$$MSG^ICDAPIU(CDT)
 ;           
ICDOP(CODE,CDT,DFN,SRC) ; Return ICD Operation/Procedure Code Info
 ; Input:   CODE  ICD code or IEN format, (required)
 ;          CDT   Date (default = TODAY)
 ;          DFN   Not in use
 ;          SRC   Source
 ;                0 = exclude local codes
 ;                1 = include local codes
 ;
 ; Output:  Returns an 14 piece string delimited by ^
 ;            1  IEN of code in ^ICD9(
 ;            2  ICD-9 code (#.01)
 ;            3  Id (#2)
 ;            4  MDC24 (#5)
 ;            5  Versioned Oper/Proc (67 multiple)
 ;            6  <null>
 ;            7  <null>
 ;            8  <null>
 ;            9  ICD Expanded (#8) 1:Yes 0:No
 ;           10  Status (66 multiple)
 ;           11  Use with Sex (#9.5)
 ;           12  Inactive Date (66 multiple)
 ;           13  Activation Date (66 multiple)
 ;           14  Message
 ;
 ;           -or-
 ;
 ;          -1^Error Description
 ;
 N DATA,EFF,STR,INV
 I $G(CODE)="" Q "-1^NO CODE SELECTED"
 S INV="-1^INVALID CODE",CODE=+$$CODEN(CODE,80.1)
 I CODE<1 Q INV
 I '$D(^ICD0(CODE)) Q INV
 I '$G(SRC),$P(^ICD0(CODE,0),"^",8) Q "-1^VA LOCAL CODE SELECTED"
 S DATA=$G(^ICD0(CODE,0)) I '$L(DATA) Q "-1^NO DATA"
 S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICDAPIU(CDT))
 S EFF=$$EFF^ICDSUPT(80.1,CODE,CDT)
 S $P(DATA,"^",9)=$S(EFF<1:0,1:$P(EFF,"^"))
 S $P(DATA,"^",11,12)=$P(EFF,"^",2,3)
 S $P(DATA,"^",4)=$$VSTP(CODE,CDT)
 Q CODE_"^"_DATA_"^"_$$MSG^ICDAPIU(CDT)
 ;
ICDD(CODE,OUTARR,CDT) ; returns ICD description in array
 ; Input:   CODE   ICD Code or IEN (required)
 ;          ARY    Array Name for description 
 ;                 e.g. "ABC" or "ABC("TEST")" 
 ;                 Default = ^TMP("ICDD",$J)
 ;          CDT    Date (default = TODAY)
 ; 
 ; Output:  #      Number of lines in array
 ; 
 ;          @ARY(1:n) - Versioned Description (68 multiple)
 ;          @ARY(n+1) - blank
 ;          @ARY(n+1) - message: CODE TEXT MAY BE INACCURATE
 ; 
 ;           or
 ; 
 ;          -1^Error Description
 ;          
 ; ** NOTE - USER MUST INITIALIZE ^TMP("ICDD",$J), IF USED **
 ;
 N ARR,END,I,N,GLOB,INV
 I $G(CODE)="" Q "-1^NO CODE SELECTED"
 S INV="-1^INVALID CODE"
 I CODE?1.9N Q "-1^"_INV
 S CODE=$$CODEN(CODE),GLOB=$P(CODE,"~",2),CODE=+CODE
 I CODE<1!(GLOB["INVALID") Q INV ;if no code, return error
 I '$D(@(GLOB_CODE_")")) Q INV ;if no code, return error
 I $G(OUTARR)="" S OUTARR="^TMP(""ICDD"",$J,"
 ;ensure OUTARR is proper format
 I OUTARR'["(" S OUTARR=OUTARR_"("
 I OUTARR[")" S OUTARR=$P(OUTARR,")")
 S END=$E(OUTARR,$L(OUTARR)) I END'="("&(END'=",") S OUTARR=OUTARR_","
 ;clear ^TMP("ICDD",$J - if used
 I OUTARR="^TMP(""ICDD"",$J," K ^TMP("ICDD",$J)
 S I=0,N=0,CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICDAPIU(CDT))
 ;S N=N+1,ARR=OUTARR_N_")",@ARR=$G(@(GLOB_CODE_",1)"))
 S N=N+1,ARR=OUTARR_N_")",@ARR=$$VLT(CODE,CDT,GLOB)
 S N=N+1,ARR=OUTARR_N_")",@ARR=" "
 S N=N+1,ARR=OUTARR_N_")",@ARR=$$MSG^ICDAPIU(CDT)
 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
 ;    where global root is:
 ;           "^ICD9(" - File 80
 ;           "^ICD0(" - File 80.1
 ;    -or-
 ;         -1~error message
 ;
 I $G(CODE)="" Q "-1~NO CODE SELECTED"
 N Y,GLOB,INV
 S INV="INVALID ",CODE=$P(CODE," ")
 ;use FILE if passed
 I $G(FILE) D  Q Y_"~"_GLOB
 . S GLOB=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:INV_"FILE")
 . I $E(GLOB)'="^" S Y=-1,GLOB=INV_"FILE" Q
 . S Y=$S(CODE?1.9N:$$CODEZ(CODE,GLOB),1:$$CODEBA(CODE,GLOB))
 ;FILE not passed - report where found
 I CODE?1.9N S GLOB="^ICD9(",Y=$$CODEZ(CODE,GLOB) D  G CODENQ
 . I Y<1 S GLOB="^ICD0(",Y=$$CODEZ(CODE,GLOB)
 S GLOB=$S(CODE?2N1"."1.3N:"^ICD0(",CODE?3N1".".3N!(CODE?1U2.3N1".".2N):"^ICD9(",1:-1)
 S Y=$S('GLOB:$$CODEBA(CODE,GLOB),1:-1)
CODENQ I Y<1 S GLOB=INV_"CODE"
 Q Y_"~"_GLOB
 ;
CODEC(CODE,FILE) ;return the ICD code of an ien
 ;  Input:
 ;    CODE - IEN of ICD code    REQUIRED
 ;    FILE - File Number to search for code
 ;           80 = ICD Dx file
 ;           80.1 = ICD Oper/Proc file
 ;
 ; Output: ICD code, -1 if not found
 ;
 S CODE=$G(CODE) Q:CODE'?1.9N -1
 N Y,GLOB
 I $G(FILE) D  Q Y
 . S GLOB=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:-1)
 . S Y=$S(GLOB<0:-1,1:$$CODEZ(CODE,GLOB))
 ;FILE not passed - Search for 1st match
 S Y=$$CODEZ(CODE,"^ICD9(",1)
 Q $S(+Y<0:$$CODEZ(CODE,"^ICD0(",1),1:Y)
 ;
CODEZ(CODE,ROOT,FLG) ; Based on IEN/root:
 N Y,ICDL            ; if 'FLG return code existence, else zero node - piece 1
 S Y=$P($G(@(ROOT_CODE_",0)")),"^"),ICDL=$L(Y) I ICDL,'$G(FLG) Q CODE
 Q $S('ICDL:-1,1:Y)
 ;
CODEBA(CODE,ROOT) ; Return IEN based on code/root
 N IEN
 S IEN=$O(@(ROOT_"""BA"","""_CODE_" "","""")"),-1)
 Q $S('IEN:-1,1:IEN)
 ;
VST(IEN,VDT,TYPE)     ; Versioned Short Text
 Q:TYPE["ICD9(" $$VSTD($G(IEN),$G(VDT))
 Q:TYPE["ICD0(" $$VSTP($G(IEN),$G(VDT))
 Q ""
VSTD(IEN,VDT)  ; Versioned Short Text (Dx)
 N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT S ICDI=+($G(IEN)) Q:+ICDI'>0 ""  Q:'$D(^ICD9(+ICDI)) ""
 S ICDT=$G(VDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""  S ICD0=$G(^ICD9(+ICDI,0)),ICDC=$P(ICD0,"^",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)),"^",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)),"^",2))
 Q $$TRIM($P(ICD0,"^",3))
VSTP(IEN,VDT) ; Versioned Short Text (Proc)
 N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT S ICDI=+($G(IEN)) Q:+ICDI'>0 ""  Q:'$D(^ICD0(+ICDI)) ""
 S ICDT=$G(VDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""  S ICD0=$G(^ICD0(+ICDI,0)),ICDC=$P(ICD0,"^",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)),"^",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)),"^",2))
 Q $$TRIM($P(ICD0,"^",4))
VLT(IEN,VDT,TYPE) ; Version Description - Long Text
 Q:TYPE["ICD9(" $$VLTD($G(IEN),$G(VDT))
 Q:TYPE["ICD0(" $$VLTP($G(IEN),$G(VDT))
 Q ""
VLTD(IEN,VDT) ; Versioned Description - Long Text (Dx)
 N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
 S ICDI=+($G(IEN)) Q:+ICDI'>0 ""  Q:'$D(^ICD9(+ICDI)) ""
 S ICDT=$G(VDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""
 S ICD0=$G(^ICD9(+ICDI,0)),ICDC=$P(ICD0,"^",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)),"^",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)),"^",1))
 S TXT=$$TRIM($G(^ICD9(+ICDI,1))) Q:$L($G(TXT)) $G(TXT)
 Q $$TRIM($P(ICD0,"^",3))
VLTP(IEN,VDT) ; Versioned Description - Long Text (Proc)
 N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
 S ICDI=+($G(IEN)) Q:+ICDI'>0 ""  Q:'$D(^ICD0(+ICDI)) ""
 S ICDT=$G(VDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""
 S ICD0=$G(^ICD0(+ICDI,0)),ICDC=$P(ICD0,"^",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)),"^",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)),"^",1))
 S TXT=$$TRIM($G(^ICD0(+ICDI,1))) Q:$L($G(TXT)) $G(TXT)
 Q $$TRIM($P(ICD0,"^",4))
TRIM(X) ; Trim Spaces
 S X=$G(X) Q:X="" X F  Q:$E(X,1)'=" "  S X=$E(X,2,$L(X))
 F  Q:$E(X,$L(X))'=" "  S X=$E(X,1,($L(X)-1))
 F  Q:X'["  "  S X=$P(X,"  ",1)_" "_$P(X,"  ",2,229)
 Q X