| 1 | ICDCODE ;DLS/DEK/KER - ICD CODE APIS ; 10/20/04 8:54am
|
---|
| 2 | ;;18.0;DRG Grouper;**6,12,14**;Oct 20, 2000;Build 1
|
---|
| 3 | ;
|
---|
| 4 | ; External References
|
---|
| 5 | ; DBIA 10103 $$DT^XLFDT
|
---|
| 6 | ;
|
---|
| 7 | ICDDX(CODE,CDT,DFN,SRC) ; Return ICD Dx Code Info
|
---|
| 8 | ;Input: CODE Code/IEN (required)
|
---|
| 9 | ; CDT Date (default = TODAY)
|
---|
| 10 | ; DFN Not in use
|
---|
| 11 | ; SRC Source
|
---|
| 12 | ; 0 = exclude local codes
|
---|
| 13 | ; 1 = include local codes
|
---|
| 14 | ;
|
---|
| 15 | ;Output: Returns an 18 piece string delimited by ^
|
---|
| 16 | ; 1 IEN of code in ^ICD9(
|
---|
| 17 | ; 2 ICD-9 Dx Code (#.01)
|
---|
| 18 | ; 3 Id (#2)
|
---|
| 19 | ; 4 Versioned Dx (67 multiple)
|
---|
| 20 | ; 5 Unacceptable as Principal Dx (#101)
|
---|
| 21 | ; 6 Major Dx Cat (#5)
|
---|
| 22 | ; 7 MDC13 (5.5)
|
---|
| 23 | ; 8 Compl/Comorb (#70)
|
---|
| 24 | ; 9 ICD Expanded (#8) 1:Yes 0:No
|
---|
| 25 | ; 10 Status (66 multiple)
|
---|
| 26 | ; 11 Sex (#9.5)
|
---|
| 27 | ; 12 Inactive Date (66 multiple)
|
---|
| 28 | ; 13 MDC24 (#5.7)
|
---|
| 29 | ; 14 MDC25 (#5.9)
|
---|
| 30 | ; 15 Age Low (#14)
|
---|
| 31 | ; 16 Age High (#15)
|
---|
| 32 | ; 17 Activation Date (.01 of 66 multiple)
|
---|
| 33 | ; 18 Message
|
---|
| 34 | ;
|
---|
| 35 | ; or
|
---|
| 36 | ;
|
---|
| 37 | ; -1^Error Description
|
---|
| 38 | ;
|
---|
| 39 | N DATA,EFF,INV,MDC,DRGFY
|
---|
| 40 | I $G(CODE)="" Q "-1^NO CODE SELECTED"
|
---|
| 41 | S INV="-1^INVALID CODE",CODE=+$$CODEN(CODE,80)
|
---|
| 42 | I CODE<1 Q INV
|
---|
| 43 | I '$D(^ICD9(CODE)) Q INV
|
---|
| 44 | I '$G(SRC),$P(^ICD9(CODE,0),"^",8) Q "-1^VA LOCAL CODE SELECTED"
|
---|
| 45 | S DATA=$G(^ICD9(CODE,0)) I '$L(DATA) Q "-1^NO DATA"
|
---|
| 46 | S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICDAPIU(CDT))
|
---|
| 47 | S EFF=$$EFF^ICDSUPT(80,CODE,CDT)
|
---|
| 48 | S $P(DATA,"^",6)=$$VMDC^ICDREF(CODE)
|
---|
| 49 | S $P(DATA,"^",9)=$S(EFF<1:0,1:$P(EFF,"^"))
|
---|
| 50 | S $P(DATA,"^",11)=$P(EFF,"^",2),$P(DATA,"^",16)=$P(EFF,"^",3)
|
---|
| 51 | S $P(DATA,"^",3)=$$VSTD(CODE,CDT)
|
---|
| 52 | Q CODE_"^"_DATA_"^"_$$MSG^ICDAPIU(CDT)
|
---|
| 53 | ;
|
---|
| 54 | ICDOP(CODE,CDT,DFN,SRC) ; Return ICD Operation/Procedure Code Info
|
---|
| 55 | ; Input: CODE ICD code or IEN format, (required)
|
---|
| 56 | ; CDT Date (default = TODAY)
|
---|
| 57 | ; DFN Not in use
|
---|
| 58 | ; SRC Source
|
---|
| 59 | ; 0 = exclude local codes
|
---|
| 60 | ; 1 = include local codes
|
---|
| 61 | ;
|
---|
| 62 | ; Output: Returns an 14 piece string delimited by ^
|
---|
| 63 | ; 1 IEN of code in ^ICD9(
|
---|
| 64 | ; 2 ICD-9 code (#.01)
|
---|
| 65 | ; 3 Id (#2)
|
---|
| 66 | ; 4 MDC24 (#5)
|
---|
| 67 | ; 5 Versioned Oper/Proc (67 multiple)
|
---|
| 68 | ; 6 <null>
|
---|
| 69 | ; 7 <null>
|
---|
| 70 | ; 8 <null>
|
---|
| 71 | ; 9 ICD Expanded (#8) 1:Yes 0:No
|
---|
| 72 | ; 10 Status (66 multiple)
|
---|
| 73 | ; 11 Use with Sex (#9.5)
|
---|
| 74 | ; 12 Inactive Date (66 multiple)
|
---|
| 75 | ; 13 Activation Date (66 multiple)
|
---|
| 76 | ; 14 Message
|
---|
| 77 | ;
|
---|
| 78 | ; -or-
|
---|
| 79 | ;
|
---|
| 80 | ; -1^Error Description
|
---|
| 81 | ;
|
---|
| 82 | N DATA,EFF,STR,INV
|
---|
| 83 | I $G(CODE)="" Q "-1^NO CODE SELECTED"
|
---|
| 84 | S INV="-1^INVALID CODE",CODE=+$$CODEN(CODE,80.1)
|
---|
| 85 | I CODE<1 Q INV
|
---|
| 86 | I '$D(^ICD0(CODE)) Q INV
|
---|
| 87 | I '$G(SRC),$P(^ICD0(CODE,0),"^",8) Q "-1^VA LOCAL CODE SELECTED"
|
---|
| 88 | S DATA=$G(^ICD0(CODE,0)) I '$L(DATA) Q "-1^NO DATA"
|
---|
| 89 | S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICDAPIU(CDT))
|
---|
| 90 | S EFF=$$EFF^ICDSUPT(80.1,CODE,CDT)
|
---|
| 91 | S $P(DATA,"^",9)=$S(EFF<1:0,1:$P(EFF,"^"))
|
---|
| 92 | S $P(DATA,"^",11,12)=$P(EFF,"^",2,3)
|
---|
| 93 | S $P(DATA,"^",4)=$$VSTP(CODE,CDT)
|
---|
| 94 | Q CODE_"^"_DATA_"^"_$$MSG^ICDAPIU(CDT)
|
---|
| 95 | ;
|
---|
| 96 | ICDD(CODE,OUTARR,CDT) ; returns ICD description in array
|
---|
| 97 | ; Input: CODE ICD Code or IEN (required)
|
---|
| 98 | ; ARY Array Name for description
|
---|
| 99 | ; e.g. "ABC" or "ABC("TEST")"
|
---|
| 100 | ; Default = ^TMP("ICDD",$J)
|
---|
| 101 | ; CDT Date (default = TODAY)
|
---|
| 102 | ;
|
---|
| 103 | ; Output: # Number of lines in array
|
---|
| 104 | ;
|
---|
| 105 | ; @ARY(1:n) - Versioned Description (68 multiple)
|
---|
| 106 | ; @ARY(n+1) - blank
|
---|
| 107 | ; @ARY(n+1) - message: CODE TEXT MAY BE INACCURATE
|
---|
| 108 | ;
|
---|
| 109 | ; or
|
---|
| 110 | ;
|
---|
| 111 | ; -1^Error Description
|
---|
| 112 | ;
|
---|
| 113 | ; ** NOTE - USER MUST INITIALIZE ^TMP("ICDD",$J), IF USED **
|
---|
| 114 | ;
|
---|
| 115 | N ARR,END,I,N,GLOB,INV
|
---|
| 116 | I $G(CODE)="" Q "-1^NO CODE SELECTED"
|
---|
| 117 | S INV="-1^INVALID CODE"
|
---|
| 118 | I CODE?1.9N Q "-1^"_INV
|
---|
| 119 | S CODE=$$CODEN(CODE),GLOB=$P(CODE,"~",2),CODE=+CODE
|
---|
| 120 | I CODE<1!(GLOB["INVALID") Q INV ;if no code, return error
|
---|
| 121 | I '$D(@(GLOB_CODE_")")) Q INV ;if no code, return error
|
---|
| 122 | I $G(OUTARR)="" S OUTARR="^TMP(""ICDD"",$J,"
|
---|
| 123 | ;ensure OUTARR is proper format
|
---|
| 124 | I OUTARR'["(" S OUTARR=OUTARR_"("
|
---|
| 125 | I OUTARR[")" S OUTARR=$P(OUTARR,")")
|
---|
| 126 | S END=$E(OUTARR,$L(OUTARR)) I END'="("&(END'=",") S OUTARR=OUTARR_","
|
---|
| 127 | ;clear ^TMP("ICDD",$J - if used
|
---|
| 128 | I OUTARR="^TMP(""ICDD"",$J," K ^TMP("ICDD",$J)
|
---|
| 129 | S I=0,N=0,CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICDAPIU(CDT))
|
---|
| 130 | ;S N=N+1,ARR=OUTARR_N_")",@ARR=$G(@(GLOB_CODE_",1)"))
|
---|
| 131 | S N=N+1,ARR=OUTARR_N_")",@ARR=$$VLT(CODE,CDT,GLOB)
|
---|
| 132 | S N=N+1,ARR=OUTARR_N_")",@ARR=" "
|
---|
| 133 | S N=N+1,ARR=OUTARR_N_")",@ARR=$$MSG^ICDAPIU(CDT)
|
---|
| 134 | Q N
|
---|
| 135 | ;
|
---|
| 136 | CODEN(CODE,FILE) ; return ien of ICD code
|
---|
| 137 | ;
|
---|
| 138 | ; Input:
|
---|
| 139 | ; CODE - ICD code (required)
|
---|
| 140 | ; FILE - File Number to search for code
|
---|
| 141 | ; 80 = ICD Dx file
|
---|
| 142 | ; 80.1 = ICD Oper/Proc file
|
---|
| 143 | ;
|
---|
| 144 | ; Output: ien~global root
|
---|
| 145 | ; where global root is:
|
---|
| 146 | ; "^ICD9(" - File 80
|
---|
| 147 | ; "^ICD0(" - File 80.1
|
---|
| 148 | ; -or-
|
---|
| 149 | ; -1~error message
|
---|
| 150 | ;
|
---|
| 151 | I $G(CODE)="" Q "-1~NO CODE SELECTED"
|
---|
| 152 | N Y,GLOB,INV
|
---|
| 153 | S INV="INVALID ",CODE=$P(CODE," ")
|
---|
| 154 | ;use FILE if passed
|
---|
| 155 | I $G(FILE) D Q Y_"~"_GLOB
|
---|
| 156 | . S GLOB=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:INV_"FILE")
|
---|
| 157 | . I $E(GLOB)'="^" S Y=-1,GLOB=INV_"FILE" Q
|
---|
| 158 | . S Y=$S(CODE?1.9N:$$CODEZ(CODE,GLOB),1:$$CODEBA(CODE,GLOB))
|
---|
| 159 | ;FILE not passed - report where found
|
---|
| 160 | I CODE?1.9N S GLOB="^ICD9(",Y=$$CODEZ(CODE,GLOB) D G CODENQ
|
---|
| 161 | . I Y<1 S GLOB="^ICD0(",Y=$$CODEZ(CODE,GLOB)
|
---|
| 162 | S GLOB=$S(CODE?2N1"."1.3N:"^ICD0(",CODE?3N1".".3N!(CODE?1U2.3N1".".2N):"^ICD9(",1:-1)
|
---|
| 163 | S Y=$S('GLOB:$$CODEBA(CODE,GLOB),1:-1)
|
---|
| 164 | CODENQ I Y<1 S GLOB=INV_"CODE"
|
---|
| 165 | Q Y_"~"_GLOB
|
---|
| 166 | ;
|
---|
| 167 | CODEC(CODE,FILE) ;return the ICD code of an ien
|
---|
| 168 | ; Input:
|
---|
| 169 | ; CODE - IEN of ICD code REQUIRED
|
---|
| 170 | ; FILE - File Number to search for code
|
---|
| 171 | ; 80 = ICD Dx file
|
---|
| 172 | ; 80.1 = ICD Oper/Proc file
|
---|
| 173 | ;
|
---|
| 174 | ; Output: ICD code, -1 if not found
|
---|
| 175 | ;
|
---|
| 176 | S CODE=$G(CODE) Q:CODE'?1.9N -1
|
---|
| 177 | N Y,GLOB
|
---|
| 178 | I $G(FILE) D Q Y
|
---|
| 179 | . S GLOB=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:-1)
|
---|
| 180 | . S Y=$S(GLOB<0:-1,1:$$CODEZ(CODE,GLOB))
|
---|
| 181 | ;FILE not passed - Search for 1st match
|
---|
| 182 | S Y=$$CODEZ(CODE,"^ICD9(",1)
|
---|
| 183 | Q $S(+Y<0:$$CODEZ(CODE,"^ICD0(",1),1:Y)
|
---|
| 184 | ;
|
---|
| 185 | CODEZ(CODE,ROOT,FLG) ; Based on IEN/root:
|
---|
| 186 | N Y,ICDL ; if 'FLG return code existence, else zero node - piece 1
|
---|
| 187 | S Y=$P($G(@(ROOT_CODE_",0)")),"^"),ICDL=$L(Y) I ICDL,'$G(FLG) Q CODE
|
---|
| 188 | Q $S('ICDL:-1,1:Y)
|
---|
| 189 | ;
|
---|
| 190 | CODEBA(CODE,ROOT) ; Return IEN based on code/root
|
---|
| 191 | N IEN
|
---|
| 192 | S IEN=$O(@(ROOT_"""BA"","""_CODE_" "","""")"),-1)
|
---|
| 193 | Q $S('IEN:-1,1:IEN)
|
---|
| 194 | ;
|
---|
| 195 | VST(IEN,VDT,TYPE) ; Versioned Short Text
|
---|
| 196 | Q:TYPE["ICD9(" $$VSTD($G(IEN),$G(VDT))
|
---|
| 197 | Q:TYPE["ICD0(" $$VSTP($G(IEN),$G(VDT))
|
---|
| 198 | Q ""
|
---|
| 199 | VSTD(IEN,VDT) ; Versioned Short Text (Dx)
|
---|
| 200 | N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT S ICDI=+($G(IEN)) Q:+ICDI'>0 "" Q:'$D(^ICD9(+ICDI)) ""
|
---|
| 201 | 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) ""
|
---|
| 202 | S STD=$O(^ICD9("AST",(ICDC_" "),(ICDT+.000001)),-1)
|
---|
| 203 | I +STD>0 D Q:$L($G(TXT)) $G(TXT)
|
---|
| 204 | . S STI=$O(^ICD9("AST",(ICDC_" "),STD,+ICDI," "),-1),TXT=$$TRIM($P($G(^ICD9(+ICDI,67,+STI,0)),"^",2))
|
---|
| 205 | S STD=$O(^ICD9(+ICDI,67,"B",0)) I +STD>0 D Q:$L($G(TXT)) $G(TXT)
|
---|
| 206 | . S STI=$O(^ICD9(+ICDI,67,"B",STD,0)),TXT=$$TRIM($P($G(^ICD9(+ICDI,67,+STI,0)),"^",2))
|
---|
| 207 | Q $$TRIM($P(ICD0,"^",3))
|
---|
| 208 | VSTP(IEN,VDT) ; Versioned Short Text (Proc)
|
---|
| 209 | N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT S ICDI=+($G(IEN)) Q:+ICDI'>0 "" Q:'$D(^ICD0(+ICDI)) ""
|
---|
| 210 | 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) ""
|
---|
| 211 | S STD=$O(^ICD0("AST",(ICDC_" "),(ICDT+.000001)),-1)
|
---|
| 212 | I +STD>0 D Q:$L($G(TXT)) $G(TXT)
|
---|
| 213 | . S STI=$O(^ICD0("AST",(ICDC_" "),STD,+ICDI," "),-1),TXT=$$TRIM($P($G(^ICD0(+ICDI,67,+STI,0)),"^",2))
|
---|
| 214 | S STD=$O(^ICD0(+ICDI,67,"B",0)) I +STD>0 D Q:$L($G(TXT)) $G(TXT)
|
---|
| 215 | . S STI=$O(^ICD0(+ICDI,67,"B",STD,0)),TXT=$$TRIM($P($G(^ICD0(+ICDI,67,+STI,0)),"^",2))
|
---|
| 216 | Q $$TRIM($P(ICD0,"^",4))
|
---|
| 217 | VLT(IEN,VDT,TYPE) ; Version Description - Long Text
|
---|
| 218 | Q:TYPE["ICD9(" $$VLTD($G(IEN),$G(VDT))
|
---|
| 219 | Q:TYPE["ICD0(" $$VLTP($G(IEN),$G(VDT))
|
---|
| 220 | Q ""
|
---|
| 221 | VLTD(IEN,VDT) ; Versioned Description - Long Text (Dx)
|
---|
| 222 | N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
|
---|
| 223 | S ICDI=+($G(IEN)) Q:+ICDI'>0 "" Q:'$D(^ICD9(+ICDI)) ""
|
---|
| 224 | S ICDT=$G(VDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""
|
---|
| 225 | S ICD0=$G(^ICD9(+ICDI,0)),ICDC=$P(ICD0,"^",1) Q:'$L(ICDC) ""
|
---|
| 226 | S STD=$O(^ICD9("ADS",(ICDC_" "),(ICDT+.000001)),-1)
|
---|
| 227 | I +STD>0 D Q:$L($G(TXT)) $G(TXT)
|
---|
| 228 | . S STI=$O(^ICD9("ADS",(ICDC_" "),STD,+ICDI," "),-1)
|
---|
| 229 | . S TXT=$$TRIM($P($G(^ICD9(+ICDI,68,+STI,1)),"^",1))
|
---|
| 230 | S STD=$O(^ICD9(+ICDI,68,"B",0))
|
---|
| 231 | I +STD>0 D Q:$L($G(TXT)) $G(TXT)
|
---|
| 232 | . S STI=$O(^ICD9(+ICDI,68,"B",STD,0))
|
---|
| 233 | . S TXT=$$TRIM($P($G(^ICD9(+ICDI,68,+STI,1)),"^",1))
|
---|
| 234 | S TXT=$$TRIM($G(^ICD9(+ICDI,1))) Q:$L($G(TXT)) $G(TXT)
|
---|
| 235 | Q $$TRIM($P(ICD0,"^",3))
|
---|
| 236 | VLTP(IEN,VDT) ; Versioned Description - Long Text (Proc)
|
---|
| 237 | N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
|
---|
| 238 | S ICDI=+($G(IEN)) Q:+ICDI'>0 "" Q:'$D(^ICD0(+ICDI)) ""
|
---|
| 239 | S ICDT=$G(VDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""
|
---|
| 240 | S ICD0=$G(^ICD0(+ICDI,0)),ICDC=$P(ICD0,"^",1) Q:'$L(ICDC) ""
|
---|
| 241 | S STD=$O(^ICD0("ADS",(ICDC_" "),(ICDT+.000001)),-1)
|
---|
| 242 | I +STD>0 D Q:$L($G(TXT)) $G(TXT)
|
---|
| 243 | . S STI=$O(^ICD0("ADS",(ICDC_" "),STD,+ICDI," "),-1)
|
---|
| 244 | . S TXT=$$TRIM($P($G(^ICD0(+ICDI,68,+STI,1)),"^",1))
|
---|
| 245 | S STD=$O(^ICD0(+ICDI,68,"B",0))
|
---|
| 246 | I +STD>0 D Q:$L($G(TXT)) $G(TXT)
|
---|
| 247 | . S STI=$O(^ICD0(+ICDI,68,"B",STD,0))
|
---|
| 248 | . S TXT=$$TRIM($P($G(^ICD0(+ICDI,68,+STI,1)),"^",1))
|
---|
| 249 | S TXT=$$TRIM($G(^ICD0(+ICDI,1))) Q:$L($G(TXT)) $G(TXT)
|
---|
| 250 | Q $$TRIM($P(ICD0,"^",4))
|
---|
| 251 | TRIM(X) ; Trim Spaces
|
---|
| 252 | S X=$G(X) Q:X="" X F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
---|
| 253 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
---|
| 254 | F Q:X'[" " S X=$P(X," ",1)_" "_$P(X," ",2,229)
|
---|
| 255 | Q X
|
---|