Changeset 636 for FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDCODE.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• DRG_GROUPER-ICD--ICPT/ICDCODE.m (modified) (11 diffs)

FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDCODE.m

@@ -1 @@
-ICDCODE ;DLS/DEK/KER/FJF - ICD CODE APIS ; 09/20/07 8:54am
- ;;18.0;DRG Grouper;**6,12,14,29**;Oct 20, 2000;Build 18
+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
@@ -6 +6 @@
  ;
 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 19 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
- ;    19 Versioned Complication/Comorbidity (#103)
- ;
- ;    or
- ;
- ;    -1^Error Description
+ ;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
@@ -45 +42 @@
  I CODE<1 Q INV
  I '$D(^ICD9(CODE)) Q INV
- I '$G(SRC),$P(^ICD9(CODE,0),U,8) Q "-1^VA LOCAL CODE SELECTED"
+ 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,U,6)=$$VMDC^ICDREF(CODE)
- S $P(DATA,U,9)=$S(EFF<1:0,1:$P(EFF,U))
- S $P(DATA,U,11)=$P(EFF,U,2),$P(DATA,U,16)=$P(EFF,U,3)
- S $P(DATA,U,3)=$$VSTD(CODE,CDT)
- S $P(DATA,U,17)=$$MSG^ICDAPIU(CDT)
- S $P(DATA,U,18)=$S($$COMCOM(CODE,CDT)'=-1:$$COMCOM(CODE,CDT),1:"")
- Q CODE_U_DATA
- ;
+ 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
+ ; 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
@@ -92 +85 @@
  I CODE<1 Q INV
  I '$D(^ICD0(CODE)) Q INV
- I '$G(SRC),$P(^ICD0(CODE,0),U,8) Q "-1^VA LOCAL CODE SELECTED"
+ 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,U,9)=$S(EFF<1:0,1:$P(EFF,U))
- S $P(DATA,U,11,12)=$P(EFF,U,2,3)
- S $P(DATA,U,4)=$$VSTP(CODE,CDT)
- Q CODE_U_DATA_U_$$MSG^ICDAPIU(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
- ;
+ ; 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 **
  ;
@@ -137 +128 @@
  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=" "
@@ -143 +135 @@
  ;
 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
+ ;
+ ; 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
+ ;           "^ICD9(" - File 80
+ ;           "^ICD0(" - File 80.1
+ ;    -or-
+ ;         -1~error message
  ;
  I $G(CODE)="" Q "-1~NO CODE SELECTED"
@@ -162 +154 @@
  ;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)'=U S Y=-1,GLOB=INV_"FILE" Q
- .S Y=$S(CODE?1.9N:$$CODEZ(CODE,GLOB),1:$$CODEBA(CODE,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)
+ . 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)
@@ -174 +166 @@
  ;
 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
+ ;  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))
+ . 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)
@@ -193 +185 @@
 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)")),U),ICDL=$L(Y) I ICDL,'$G(FLG) Q CODE
+ 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)
- ;
-COMCOM(IEN,VDT) ; Return versioned complication/comorbidity
- ;returns a code for complication/comorbidity
- ;  0 - non-CC
- ;  1 - CC
- ;  2 - MCC
- ;  -1 - versioned CC not on file for date
- N CCDATE,CCIEN
- S CCDATE=$O(^ICD9(IEN,69,"B",VDT+.0001),-1)
- I CCDATE="" Q -1
- S CCIEN=$O(^ICD9(IEN,69,"B",CCDATE,""),-1)
- Q $P(^ICD9(IEN,69,CCIEN,0),U,2)
  ;
 VST(IEN,VDT,TYPE)     ; Versioned Short Text
@@ -218 +199 @@
 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,U,1) Q:'$L(ICDC) ""
+ 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)),U,2))
+ . 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)),U,2))
- Q $$TRIM($P(ICD0,U,3))
+ . 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,U,1) Q:'$L(ICDC) ""
+ 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)),U,2))
+ . 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)),U,2))
- Q $$TRIM($P(ICD0,U,4))
+ . 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))
@@ -242 +223 @@
  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,U,1) Q:'$L(ICDC) ""
+ 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)),U,1))
+ . 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)),U,1))
+ . 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,U,3))
+ 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,U,1) Q:'$L(ICDC) ""
+ 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)),U,1))
+ . 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)),U,1))
+ . 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,U,4))
+ 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))