Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD0IDX.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD0IDX.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD0IDX.m	(revision 636)
@@ -1,4 +1,4 @@
 ICD0IDX ;DLS/DEK - MUMPS Cross Reference Routine for History ; 04/28/2003
- ;;18.0;DRG Grouper;**6**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**6**;Oct 20, 2000;Build 1
  ;
  ; ICDCOD          ICD Code from Global
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD187PT.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD187PT.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD187PT.m	(revision 636)
@@ -1,4 +1,4 @@
 ICD187PT ; ALB/ADL - GROUPER DRIVER ; 04/11/03
- ;;18.0;DRG Grouper;**7**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**7**;Oct 20, 2000;Build 1
  ;;**routine to build the new DRG global levels required for the CSV project
  ;;**taken from routine created by DEK to add new "66" levels to ICD0 and ICD9
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD18PR.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD18PR.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD18PR.m	(revision 636)
@@ -1,4 +1,4 @@
 ICD18PR ;ALB/ESD - DRG GROUPER 16 PRE-INSTALL ; 10/23/00 11:56am
- ;;18.0;DRG Grouper;;Oct 20, 2000
+ ;;18.0;DRG Grouper;;Oct 20, 2000;Build 1
  ;
  ;  This routine kills the ICD9 and ICD0 globals 
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD18PT.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD18PT.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD18PT.m	(revision 636)
@@ -1,4 +1,4 @@
 ICD18PT ;ALB/ESD - DRG V16 POST-INSTALL ; 10/23/00 11:57am
- ;;18.0;DRG Grouper;;Oct 20, 2000
+ ;;18.0;DRG Grouper;;Oct 20, 2000;Build 1
  ;
  ;
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD9IDX.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD9IDX.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICD9IDX.m	(revision 636)
@@ -1,4 +1,4 @@
 ICD9IDX ;DLS/DEK - MUMPS Cross Reference Routine for History ; 04/28/2003
- ;;18.0;DRG Grouper;**6**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**6**;Oct 20, 2000;Build 1
  ;
  ; ICDCOD          ICD Code from Global
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDAPIU.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDAPIU.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDAPIU.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDAPIU ;DLS/DEK/KER - ICD UTILITIES FOR APIS ; 04/18/2004
- ;;18.0;DRG Grouper;**6,11,12,15**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**6,11,12,15**;Oct 20, 2000;Build 1
  ;
  ; External References
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDCOD.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDCOD.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDCOD.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDCOD ;ALB/ABR/ADL - INQUIRE TO ICD CODES ; 10/23/00 11:36am
- ;;18.0;DRG Grouper;**7**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**7**;Oct 20, 2000;Build 1
  ;;ADL;Update for CSV project - 03/20/03
  ;
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDCODE.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDCODE.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDCODE.m	(revision 636)
@@ -1,4 +1,4 @@
-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,37 +6,34 @@
  ;
 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,45 +42,41 @@
  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,32 +85,30 @@
  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,4 +128,5 @@
  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,17 +135,17 @@
  ;
 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,10 +154,10 @@
  ;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,17 +166,17 @@
  ;
 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,22 +185,11 @@
 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,20 +199,20 @@
 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,30 +223,30 @@
  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))
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG.m	(revision 636)
@@ -1,4 +1,4 @@
-ICDDRG ;ALB/GRR/EG/ADL - ASSIGNS DRG CODES ; 11/13/07 4:07pm
- ;;18.0;DRG Grouper;**2,7,10,14,20,31**;Oct 20, 2000;Build 7
+ICDDRG ;ALB/GRR/EG/ADL - ASSIGNS DRG CODES ; 5/19/05 12:52pm
+ ;;18.0;DRG Grouper;**2,7,10,14,20**;Oct 20, 2000;Build 1
  ;ADL - UPDATED FOR CSV;3/10/03
 TOP S (ICDDRG,ICDMDC,ICDRTC)=""
@@ -19,5 +19,5 @@
  I ICDTMP<0 S ICDRTC=1 G ERR
  S ICDY(0)=$P(ICDTMP,U,2,99) I $P(ICDY(0),"^",4)=1!($P(ICDY(0),"^",9)=0) S ICDRTC=1 G ERR  ;flag has changed from inactive flag to status flag
- S ICDMDC=$P(ICDY(0),"^",5),ICDPD=$P(ICDY(0),"^",2),ICDRG=0 I 'ICDMDC S ICDRTC=1 G ERR
+ S ICDMDC=$P(ICDY(0),"^",5),ICDPD=$P(ICDY(0),"^",2),ICDRG=0 I 'ICDMDC S ICDDRG=469,ICDRTC=1 G ERR
  D MDCG
  I $D(ICDMDC(12))!($D(ICDMDC(13))) S ICDMDC=$S(SEX="F":13,1:12) I SEX="" S ICDRTC=4 G ERR
@@ -30,5 +30,5 @@
  ;FOLLOWING ESTABLISHES SECONDARY DIAGNOSIS VARIABLES
  ;
- S (ICDCCT,ICDMCCT,ICDSD)="",ICDCC=0,ICDMCC=0,ICDI=1
+ S (ICDCCT,ICDSD)="",ICDCC=0,ICDI=1
  F ICDIZ=0:0 S ICDI=$O(ICDDX(ICDI)) Q:ICDI'>0  D  G:ICDRTC]"" ERR
  . S ICDTMP=$$ICDDX^ICDCODE(ICDDX(ICDI),ICDDATE) I ICDTMP<0!'($P(ICDTMP,U,10)) S ICDRTC=8 Q
@@ -37,5 +37,4 @@
  . D SEC,SEX9 G:ICDRTC]"" ERR
  S:$D(ICDCCT(1)) ICDCC=1 K ICDCCT
- S:$D(ICDMCCT(1)) ICDMCC=1 S:$D(ICDMCCT(2)) ICDMCC=2 K ICDMCCT
  ;********************************************************
  ;FOLLOWING ESTABLISHES OPERATION/PROCEDURE VARIABLES
@@ -47,8 +46,5 @@
  K ICDO24("N") G:ICDRTC]"" ERR
  G ^ICDDRG0
-SEC I ICDDATE>3070930.9 D
- .S ICDMCC=$S($D(^ICD9("ACC",ICDDX(ICDI),ICDDX(1))):0,$P(ICDY(0),"^",18)=2:2,($P(ICDY(0),"^",18)=1)&(ICDMCC'=2):1,1:ICDMCC),ICDMCCT(ICDMCC)=""
- E  D
- .S ICDCC=$S($D(^ICD9("ACC",ICDDX(ICDI),ICDDX(1))):0,$P(ICDY(0),"^",7)=1:1,1:ICDCC),ICDCCT(ICDCC)=""
+SEC S ICDCC=$S($D(^ICD9("ACC",ICDDX(ICDI),ICDDX(1))):0,$P(ICDY(0),"^",7)=1:1,1:ICDCC),ICDCCT(ICDCC)=""
  ;Group ICD identifiers in one variable
  S ICDSD=ICDSD_$P(ICDY(0),"^",2)
@@ -79,5 +75,5 @@
  ;translate specific identifiers into common symbol, check for symbol
  S ICD104=$S($P(ICDY(0),"^",2)["P":1,1:0),ICDNMDC($S($TR($P(ICDY(0),"^",2),"lqtrB","\\\\")["\":1,1:0))="" Q
-ERR S ICDDRG=$S(ICDDATE>3070930.9:999,1:470)
+ERR S ICDDRG=470
  Q  ;ERR
 SEX9 ;get sex for dx or proc
@@ -105,5 +101,5 @@
  Q 1
 KILL K ICD104,ICDJ,ICDJJ,ICDOCNT,ICDOR,ICDNOR,ICDP15,ICDPDRG,ICDRG,ICDSEX
- K ICDSDRG,ICDODRG,ICDCC,ICDMCC,ICDOP,ICDORNR,ICDORNI,ICDP24,ICDP25,ICDPD
+ K ICDSDRG,ICDODRG,ICDCC,ICDOP,ICDORNR,ICDORNI,ICDP24,ICDP25,ICDPD
  K ICDSD,ICDI,ICDK,ICDF,ICDFX,ICDFK,ICDY,ICDDXT,ICDIZ,ICDONR,ICDOPCT
  K ICD,ICDCC2,ICDCC3,ICDGH,ICDL39,ICDMAJ,ICDNMDC,ICDNSD,ICDORNA,ICDREF,ICDS25
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG0.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG0.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG0.m	(revision 636)
@@ -1,51 +1,42 @@
-ICDDRG0 ;ALB/GRR/EG/ADL - DRG GROUPER PROCESSING BEGINS ; 11/13/07 4:06pm
- ;;18.0;DRG Grouper;**1,2,7,10,14,17,20,24,27,30,31,32**;Oct 20, 2000;Build 9
+ICDDRG0 ;ALB/GRR/EG/ADL - DRG GROUPER PROCESSING BEGINS ; 5/16/05 9:05pm
+ ;;18.0;DRG Grouper;**1,2,7,10,14,17,20,24,27,30**;Oct 20, 2000;Build 5
  ;GROUPING PROCESS BEGINS
  ;
 GROUP ;
- I $D(ICDSEX(1))&($D(ICDSEX(2))) S ICDRTC=4,ICDDRG=$S(ICDDATE>3070930.9:999,1:470) G KILL^ICDDRG
- I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15 D:ICDOPCT<2  I ((ICDDATE'>3070930.9)&("468^476^477"[ICDRG))!((ICDDATE>3070930.9)&("983^986^989"[ICDRG)) G END
+ I $D(ICDSEX(1))&($D(ICDSEX(2))) S ICDRTC=4,ICDDRG=470 G KILL^ICDDRG
+ I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15 D:ICDOPCT<2  I "468^476^477"[ICDRG G END
+ . ;I ICDPD["M",ICDOR'["a" S ICDPDRG(344)="",ICDOPCT=0
  . I $D(ICDF) Q
  . I ICDPD["M",ICDOR'["y" S ICDOPCT=0 Q
- . I ICDDATE>3070930.9 D
- . . I ICDORNI["O",ICDNOR=ICDONR,ICDNOR>0,'$D(ICDPDRG(769)),ICDORNI'["p" S ICDRG=$S($D(ICDORNI("O")):983,ICDORNI["y":986,ICDORNI["z":989,1:983) Q
- . . I ICDOPNR S ICDRG=$S(ICDORNI["y":986,1:983),ICDOPNR=0 Q
- . E  D
- . . I ICDORNI["O",ICDNOR=ICDONR,ICDNOR>0,'$D(ICDPDRG(377)),ICDORNI'["p" S ICDRG=$S($D(ICDORNI("O")):468,ICDORNI["y":476,ICDORNI["z":477,1:468) Q
- . . I ICDOPNR S ICDRG=$S(ICDORNI["y":476,1:468),ICDOPNR=0 Q
+ .I ICDORNI["O",ICDNOR=ICDONR,ICDNOR>0,'$D(ICDPDRG(377)),ICDORNI'["p" S ICDRG=$S($D(ICDORNI("O")):468,ICDORNI["y":476,ICDORNI["z":477,1:468) Q
+ .I ICDOPNR S ICDRG=$S(ICDORNI["y":476,1:468),ICDOPNR=0 Q
  ;
  ;if number of non-extensive ORs eqs # OR, 477
  ;
- I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDORNI'["y"&(ICDORNI'="")&(ICDORNI["z") D  I ((ICDDATE'>3070930.9)&(ICDRG=477))!((ICDDATE>3070930.9)&(ICDRG=989)) G END
+ I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDORNI'["y"&(ICDORNI'="")&(ICDORNI["z") D  I ICDRG=477 G END
  . I $D(ICDF) Q
- . NEW K S K=$$ORNI(ICDORNI) I K=ICDOPCT S ICDRG=$S(ICDDATE>3070930.9:989,1:477) Q
+ . NEW K S K=$$ORNI(ICDORNI) I K=ICDOPCT S ICDRG=477 Q
  ;
  ;if number of non-extensive ORs+prostatics eqs # OR, 476
  ;
- I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDORNI["y"&(ICDORNI'="") D  I ((ICDDATE'>3070930.9)&(ICDRG=476))!((ICDDATE>3070930.9)&(ICDRG=986)) G END
- .N K S K=$$ORNI(ICDORNI) I K=ICDOPCT&(ICDNOR=ICDONR) S ICDRG=$S(ICDDATE>3070930.9:986,1:476) Q
- I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDNOR=ICDONR&(ICDOPCT>0) S ICDRG=$S(ICDDATE>3070930.9:983,1:468) G END
- I ICDMDC=5,ICDOR'["O" S ICDRTC=$S(ICDEXP="":5,1:"") S:ICDRTC'="" ICDRG=$S(ICDDATE>3070930.9:999,1:470) D:ICDRTC="" MI G END
+ I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDORNI["y"&(ICDORNI'="") D  I ICDRG=476 G END
+ .N K S K=$$ORNI(ICDORNI) I K=ICDOPCT&(ICDNOR=ICDONR) S ICDRG=476 Q
+ I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDNOR=ICDONR&(ICDOPCT>0) S ICDRG=468 G END
+ I ICDMDC=5,ICDOR'["O" S ICDRTC=$S(ICDEXP="":5,1:"") S:ICDRTC'="" ICDRG=470 D:ICDRTC="" MI G END
  ;I ICDMDC=18,ICDOR["O"!(ICDORNI["O") S ICDRG=415 G END  ;;disabled by ICD*18*24 and new DRGs 578/579 - see ICDTLB6C
- I ICDMDC=19,ICDOCNT>0,ICDOR["O" S (ICDRG,HICDRG)=$S(ICDDATE>3070930.9:876,1:424) D CKDRG
- I ICDMDC=23,ICDOR["O"!(ICDORNI["O") S ICDRG=$S(ICDDATE>3070930.9:941,1:461) G END
+ I ICDMDC=19,ICDOCNT>0,ICDOR["O" S (ICDRG,HICDRG)=424 D CKDRG
+ I ICDMDC=23,ICDOR["O"!(ICDORNI["O") S ICDRG=461 G END
  I ICDMDC=14 D ^ICDDRG14 I ICDRG]"" G END
- I ICDMDC=20 S ICDRTC=$S(ICDDMS="":7,1:"") I ICDDMS'=0 D  G END
- . I ICDDATE>3070930.9 S ICDRG=$S(ICDDMS="":999,1:894) Q
- . S ICDRG=$S(ICDDMS="":470,1:433)
- I ICDMDC=22 S ICDRTC=$S(ICDTRS="":6,1:"") S:ICDRTC'="" ICDRG=$S(ICDDATE>3070930.9:999,1:470) D:ICDRTC="" CKBURN G END
- I ICDMDC=15 S ICDRTC=$S(ICDEXP="":5,ICDTRS="":6,1:"") I ICDTRS'=0 D  G END
- . I ICDDATE>3070930.9 S ICDRG=$S(ICDRTC'="":999,1:789) Q
- . S ICDRG=$S(ICDRTC'="":470,1:385)
-NEONATE I 'ICDNOR!('$D(ICDODRG)) S ICDRG=$O(ICDPDRG(0)) X "I ICDMDC=15,$D(ICDSDRG),$O(ICDSDRG(0))<ICDRG D NEONATF^ICDDRG0" D  D DODRG G GETMOR:ICDRG="",END
+ I ICDMDC=20 S ICDRTC=$S(ICDDMS="":7,1:"") I ICDDMS'=0 S ICDRG=$S(ICDDMS="":470,1:433) G END
+ I ICDMDC=22 S ICDRTC=$S(ICDTRS="":6,1:"") S:ICDRTC'="" ICDRG=470 D:ICDRTC="" CKBURN G END
+ I ICDMDC=15 S ICDRTC=$S(ICDEXP="":5,ICDTRS="":6,1:"") I ICDTRS'=0 S ICDRG=$S(ICDRTC'="":470,1:385) G END
+NEONATE I 'ICDNOR!('$D(ICDODRG)) S ICDRG=$O(ICDPDRG(0)) X "I ICDMDC=15,$D(ICDSDRG),$O(ICDSDRG(0))<ICDRG S ICDRG=$S($D(ICDPDRG(391)):391,$D(ICDPDRG(387)):387,1:$O(ICDSDRG(0)))" D  D DODRG G GETMOR:ICDRG="",END
  . N X,X1,X2,%
  . S X1=$S($G(DGADM):$G(DGADM),1:DT),X2=$G(DOB) I X1,X2 D ^%DTC I X<29 D NBCOMP Q
- . I ICDDATE'>3070930.9 I ICDRG<385!(ICDRG>391) Q
- . I ICDDATE>3070930.9 I ICDRG<789!(ICDRG>795) Q
+ . I ICDRG<385!(ICDRG>391) Q
  .; I "^11917^11918^11921^"[("^"_ICDDX(1)_"^") S ICDRG=395 Q
- . I ICDDATE'>3070930.9 I $O(ICDRG(391)) S ICDRG=$O(ICDRG(391)) Q
- . I ICDDATE>3070930.9 I $O(ICDRG(795)) S ICDRG=$O(ICDRG(795)) Q
- . I 'ICDRG S ICDRG=$S(ICDDATE>3070930.9:999,1:470),ICDRTC=8
- I AGE="",ICDMDC=3 S ICDRTC=3 S ICDRG=$S(ICDDATE>3070930.9:999,1:470) G END
+ . I $O(ICDRG(391)) S ICDRG=$O(ICDRG(391)) Q
+ . I 'ICDRG S ICDRG=470,ICDRTC=8
+ I AGE="",ICDMDC=3 S ICDRTC=3,ICDRG=470 G END
  D ^ICDDRG1:ICDMDC=1,^ICDDRG2:ICDMDC=2,^ICDDRG3:ICDMDC=3,^ICDDRG5:ICDMDC=5,^ICDDRG6:ICDMDC=6,^ICDDRG7:ICDMDC=7,^ICDDRG8:ICDMDC=8,^ICDDRG9:ICDMDC=9,^ICDDRG10:ICDMDC=10,^ICDDRG11:ICDMDC=11,^ICDDRG12:ICDMDC=12,^ICDDRG13:ICDMDC=13
  D ^ICDDRG17:ICDMDC=17
@@ -53,6 +44,6 @@
  D DODRG
  G:ICDRG'>0 LOOK8:ICDMDC=8,AGAIN G END
-ENTER I 'ICDNOR,ICDORNR'=0,ICDMDC'=20,ICDMDC'=15 S ICDRG=$S(ICDDATE>3070930.9:983,1:468) G END
-GETMOR S (ICDRG,HICDRG)=$O(ICDPDRG(0)) S:ICDRG'>0 (ICDRG,HICDRG)=$S(ICDDATE>3070930.9:998,1:469)
+ENTER I 'ICDNOR,ICDORNR'=0,ICDMDC'=20,ICDMDC'=15 S ICDRG=468 G END
+GETMOR S (ICDRG,HICDRG)=$O(ICDPDRG(0)) S:ICDRG'>0 (ICDRG,HICDRG)=469 ;I ICDMDC=15,'$D(ICDODRG),$D(ICDSDRG),$O(ICDSDRG(0))<ICDRG S (ICDRG,HICDRG)=$O(ICDSDRG(0))
 CKDRG D DODRG
  I ICDRG="" K ICDPDRG(HICDRG) G GETMOR
@@ -61,5 +52,5 @@
  N DRGFY,ICDREF S (DRGFY,ICDREF)=""
  I ICDRG S DRGFY=$O(^ICD(ICDRG,2,"B",$P(+$G(ICDDATE),".")_.01),-1)
- I 'DRGFY S DRGFY=3071001 ;default to current fiscal year
+ I 'DRGFY S DRGFY=3061001 ;default to current fiscal year
  S ICDREF=$O(^ICD(+ICDRG,2,"B",+DRGFY,ICDREF))
  I ICDREF'="" D
@@ -75,64 +66,44 @@
  D:ICDP24'=""!($D(ICDS24)) CKMST^ICDDRGX S ICDDRG=ICDRG
  ;ICD*18*24 check for higher numbered DRG (such as new DRG 561) before checking for 489 in CKHIV^ICDDRGX
- I ICDDATE<3071001 I ICDRG=489!(ICDRG=490)!(ICDRG=543&($G(ICDOR)="")) S ICDRG=$P($G(ICDPDRG),U,2) I ICDRG=543 S ICDRG=561
- I ICDDATE'<3071001 I ICDRG=976!(ICDRG=977)!(ICDRG=24&($G(ICDOR)="")) S ICDRG=$P($G(ICDPDRG),U,2) I ICDRG=24 S ICDRG=99
+ I ICDRG=489!(ICDRG=490)!(ICDRG=543&($G(ICDOR)="")) S ICDRG=$P($G(ICDPDRG),U,2) I ICDRG=543 S ICDRG=561
  D:$G(ICDP25)=1!(($G(ICDP25)>1)&($D(ICDS25(1)))) CKHIV^ICDDRGX S ICDDRG=ICDRG
  ; this will effectively make DRG 103 into a pre-MDC (ICD*18*1)
- I $D(ICDOP(" 33.6"))!$D(ICDOP(" 37.5"))!(ICDDATE>3030930.9&($D(ICDOP(" 37.51"))!$D(ICDOP(" 37.66")))) S ICDRG=$S(ICDDATE>3070930.9:2,1:103),ICDNMDC(1)="" D DODRG
- I (ICDDATE>3050930.9)&($D(ICDOP(" 37.64")))&($D(ICDOP(" 37.65"))) S ICDRG=$S(ICDDATE>3070930.9:2,1:103),ICDNMDC(1)="" D DODRG
- I (ICDDATE>3060930.9)&($D(ICDOP(" 37.63")))&($D(ICDOP(" 37.64"))) S ICDRG=$S(ICDDATE>3070930.9:2,1:103),ICDNMDC(1)="" D DODRG
- I $D(ICDOP(" 39.65")) S ICDRG=$S(ICDDATE>3070930.9:3,1:541),ICDNMDC(1)=""
- I (ICDDATE>3070930.9)&($D(ICDOP(" 46.97"))) S ICDRG=5,ICDNMDC(1)=""
+ I $D(ICDOP(" 33.6"))!$D(ICDOP(" 37.5"))!(ICDDATE>3030930.9&($D(ICDOP(" 37.51"))!$D(ICDOP(" 37.66")))) S ICDRG=103,ICDNMDC(1)=""
+ I (ICDDATE>3050930.9)&($D(ICDOP(" 37.64")))&($D(ICDOP(" 37.65"))) S ICDRG=103,ICDNMDC(1)=""
+ I (ICDDATE>3060930.9)&($D(ICDOP(" 37.63")))&($D(ICDOP(" 37.64"))) S ICDRG=103,ICDNMDC(1)=""
+ I $D(ICDOP(" 39.65")) S ICDRG=541,ICDNMDC(1)=""
  ; this will create DRGs 512/513 as pre-MDC
- I $D(ICDOP(" 52.80"))!$D(ICDOP(" 52.82")) S ICDRG=$S(ICDDATE>3070930.9:10,1:513),ICDNMDC(1)=""
- I (ICDDATE>3070930.9) D
- . I ICDRG=10 I $D(ICDOP(" 55.69")) S ICDRG=8
- E  I ICDRG=513 I $D(ICDOP(" 55.69")) S ICDRG=512
+ I $D(ICDOP(" 52.80"))!$D(ICDOP(" 52.82")) S ICDRG=513,ICDNMDC(1)=""
+ I ICDRG=513 I $D(ICDOP(" 55.69")) S ICDRG=512
  ; this will create DRG 481 as pre-MDC - loops thru 41.00 thru .09
- N X S X=0 F  S X=$O(ICDOP(X)) Q:X=""  I X["41.0" S ICDRG=$S(ICDDATE>3070930.9:9,1:481),ICDNMDC(1)=""
+ N X S X=0 F  S X=$O(ICDOP(X)) Q:X=""  I X["41.0" S ICDRG=481,ICDNMDC(1)=""
  I $D(ICDNMDC(1)) I ICDNMDC(1)="" D CKNMDC^ICDDRGX S ICDDRG=ICDRG K ICDNMDC
- I ICDDATE>3070930.9 D
- . I ICDRG=983 D CHKMDC4^ICDDRGX
- . D DODRG S ICDDRG=ICDRG ;check for MCC/CC
- E  I ICDRG=468 D CHKMDC4^ICDDRGX D DODRG S ICDDRG=ICDRG
+ I ICDRG=468 D CHKMDC4^ICDDRGX D DODRG S ICDDRG=ICDRG
  S:ICDRTC="" ICDRTC=0
- S ICDTMP=$$DRG^ICDGTDRG(ICDDRG,ICDDATE) I '$P(ICDTMP,U,14) S ICDDRG=$S(ICDDATE>3070930.9:999,1:470)
+ S ICDTMP=$$DRG^ICDGTDRG(ICDDRG,ICDDATE) I '$P(ICDTMP,U,14) S ICDDRG=470
  G KILL^ICDDRG
 MI ;
  ; if PTCA and not a bypass
- I ICDOR["1"!($D(ICDOP(" 37.90"))) I ICDOR'["b"&(ICDOR'["6") D  Q
- . I ICDDATE>3070930.9 D CMS516^ICDTBL2 Q
- . E  D DRG516^ICDTLB6B
+ I ICDOR["1"!($D(ICDOP(" 37.90"))) I ICDOR'["b"&(ICDOR'["6") I ICDDATE>3050930.9 D DRG516^ICDTLB6B Q
  I ICDPD["A" D EN1^ICDDRG5 I ICDCC3 S ICDRG=$O(ICDODRG(0)) D DODRG Q
  I ICDPD["AI"!(ICDSD["AI") D  Q
- . I ICDDATE>3070930.9 D
- . . S ICDRG=$S($S($D(ICDEXP):ICDEXP,1:0):285,ICDPD["V"!(ICDSD["V"):280,1:282)
- . E  D 
- . . I $D(ICDOP(" 36.07")) I $D(ICDOP(" 37.26"))!($D(ICDOP(" 37.27"))) S ICDRG=526 Q
- . . S ICDRG=$S($S($D(ICDEXP):ICDEXP,1:0):123,ICDPD["V"!(ICDSD["V"):121,1:122)
- I $D(ICDOP(" 37.26"))&($D(ICDOP(" 39.61"))) S ICDRG=$S(ICDDATE>3070930.9:230,1:108) Q
+ . I $D(ICDOP(" 36.07")) I $D(ICDOP(" 37.26"))!($D(ICDOP(" 37.27"))) S ICDRG=526 Q
+ . S ICDRG=$S($S($D(ICDEXP):ICDEXP,1:0):123,ICDPD["V"!(ICDSD["V"):121,1:122)
+ I $D(ICDOP(" 37.26"))&($D(ICDOP(" 39.61"))) S ICDRG=108 Q
  ;I $D(ICDOP(" 37.26")) S ICDRG=112 Q
- I ICDDATE<3071001 I $D(ICDOP(" 36.07")) I $D(ICDOP(" 37.26"))!($D(ICDOP(" 37.27"))) S ICDRG=527 Q
- I ICDDATE<3071001 I $D(ICDOP(" 36.06")) I $D(ICDOP(" 37.26"))!$D(ICDOP(" 37.27")) S ICDRG=517 Q
- I $D(ICDOP(" 37.26"))!$D(ICDOP(" 37.27")) S ICDRG=$S(ICDDATE>3070930.9:251,1:518) Q
- I ICDOR["H" D  Q
- . I ICDDATE>3070930.9  S ICDRG=$S(ICDPD["X"!(ICDSD["X"):286,1:287) Q
- . E  S ICDRG=$S(ICDPD["X"!(ICDSD["X"):124,1:125) Q
- I ICDDATE>3070930.9 K ICDPDRG(286),ICDPDRG(287)
- E  K ICDPDRG(124)
+ I $D(ICDOP(" 36.07")) I $D(ICDOP(" 37.26"))!($D(ICDOP(" 37.27"))) S ICDRG=527 Q
+ I $D(ICDOP(" 36.06")) I $D(ICDOP(" 37.26"))!$D(ICDOP(" 37.27")) S ICDRG=517 Q
+ I $D(ICDOP(" 37.26"))!$D(ICDOP(" 37.27")) S ICDRG=518 Q 
+ I ICDOR["H" S ICDRG=$S(ICDPD["X"!(ICDSD["X"):124,1:125) Q
+ K ICDPDRG(124)
  I ICDOR["p" S ICDRG=$O(ICDODRG(0)) D DODRG Q
  I ICDOR["F" S ICDRG=$O(ICDODRG(0)) D DODRG Q
- E  D  Q
- . I ICDDATE>3070930.9 K ICDPDRG(280),ICDPDRG(281),ICDPDRG(282) S ICDRG=$O(ICDPDRG(0)) D DODRG Q
- . E  K ICDPDRG(121) S ICDRG=$O(ICDPDRG(0)) D DODRG Q
+ E  K ICDPDRG(121) S ICDRG=$O(ICDPDRG(0)) D DODRG Q
  ;
 CKBURN ; MDC22 - Burns (extensive, full thickness, or non-extensive)
  D
- . I ICDPD["*"!(ICDSD["*") D  Q
- . . I ICDDATE>3070930.9 S ICDRG=$S(ICDOR["k":927,1:933) Q
- . . E  S ICDRG=$S(ICDOR["k":504,1:505) Q
+ . I ICDPD["*"!(ICDSD["*") S ICDRG=$S(ICDOR["k":504,1:505) Q
  . I ICDPD["b"!(ICDSD["b") D FTBURN Q
- . I ICDDATE>3070930.9 S ICDRG=$S(ICDCC!(ICDPD["T")!(ICDSD["T"):935,1:935)
- . E  S ICDRG=$S(ICDCC!(ICDPD["T")!(ICDSD["T"):510,1:511)
+ . S ICDRG=$S(ICDCC!(ICDPD["T")!(ICDSD["T"):510,1:511)
  Q
  ;
@@ -151,23 +122,14 @@
  N ICDSDXCK
  S ICDSDXCK=$O(ICDSDRG(0))
- I ICDDATE>3070930.9 D
- . I ICDSDXCK<ICDRG,ICDSDXCK>788,ICDSDXCK<796 D
- .. S ICDRG=$S($D(ICDPDRG(795)):795,$D(ICDPDRG(791)):791,1:$O(ICDSDRG(0)))
- E  D
- . I ICDSDXCK<ICDRG,ICDSDXCK>384,ICDSDXCK<392 D
- .. S ICDRG=$S($D(ICDPDRG(391)):391,$D(ICDPDRG(387)):387,1:$O(ICDSDRG(0)))
+ I ICDSDXCK<ICDRG,ICDSDXCK>384,ICDSDXCK<392 D
+ . S ICDRG=$S($D(ICDPDRG(391)):391,$D(ICDPDRG(387)):387,1:$O(ICDSDRG(0)))
  Q
  ;
 FTBURN ; full thickness burn check
  I ICDSD["j"!(ICDOR["k") D
- . I ICDCC!(ICDPD["T")!(ICDSD["T") S ICDRG=$S(ICDDATE>3070930.9:928,1:506)
- . E  S ICDRG=$S(ICDDATE>3070930.9:929,1:507)
+ . I ICDCC!(ICDPD["T")!(ICDSD["T") S ICDRG=506
+ . E  S ICDRG=507
  E  D
- . I ICDCC!(ICDPD["T")!(ICDSD["T") S ICDRG=$S(ICDDATE>3070930.9:934,1:508)
- . E  S ICDRG=$S(ICDDATE>3070930.9:934,1:509)
+ . I ICDCC!(ICDPD["T")!(ICDSD["T") S ICDRG=508
+ . E  S ICDRG=509
  Q
- ;
-NEONATF ;NEONATE - Continuation of xecute line
- I ICDDATE>3070930.9 S ICDRG=$S($D(ICDPDRG(795)):795,$D(ICDPDRG(791)):791,1:$O(ICDSDRG(0))) Q
- S ICDRG=$S($D(ICDPDRG(391)):391,$D(ICDPDRG(387)):387,1:$O(ICDSDRG(0)))
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG1.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG1.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG1.m	(revision 636)
@@ -1,8 +1,7 @@
-ICDDRG1 ;ALB/MRY - FIX SURGERY HIERARCHY ; 11/14/07 5:30pm
- ;;18.0;DRG Grouper;**10,17,24,31**;Oct 20, 2000;Build 7
+ICDDRG1 ;ALB/MRY - FIX SURGERY HIERARCHY ; 6/15/05 7:07pm
+ ;;18.0;DRG Grouper;**10,17,24**;Oct 20, 2000;Build 5
  Q:$O(ICDODRG(0))'>0  K ICDJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  D
- . I ICDDATE<3061001 D F Q
- . E  I ICDDATE<3071001 D FY2007 Q
- . E  D FY2008
+ .I ICDDATE<3061001 D F
+ .E  D FY2007
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" K ICDJ Q
 F I ICDJ=3 S ICDJ(1)=ICDJ Q
@@ -86,13 +85,2 @@
  I ICDJ=35 S ICDJ(39)=ICDJ Q
  Q
-FY2008 ;MS-DRG
- I ICDJ=27 S ICDJ(1)=ICDJ Q
- I ICDJ=22 S ICDJ(2)=ICDJ Q
- I ICDJ=24 S ICDJ(3)=ICDJ Q
- ;I ICDJ=27 S ICDJ(3)=ICDJ Q
- I ICDJ=30 S ICDJ(4)=ICDJ Q
- I ICDJ=33 S ICDJ(5)=ICDJ Q
- I ICDJ=36 S ICDJ(6)=ICDJ Q
- I ICDJ=39 S ICDJ(7)=ICDJ Q
- I ICDJ=42 S ICDJ(8)=ICDJ Q
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG10.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG10.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG10.m	(revision 636)
@@ -1,8 +1,7 @@
 ICDDRG10 ;ALB/GRR - FIX SURGERY HIERARCHY ; 11/6/00 2:03pm
- ;;18.0;DRG Grouper;**24,31**;Oct 20, 2000;Build 7
+ ;;18.0;DRG Grouper;**24**;Oct 20, 2000;Build 5
  Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D
- . I ICDDATE<3061001 D F Q
- . E  I ICDDATE<3071001 D FY2007 Q
- . E  D FY2008
+ . I ICDDATE<3061001 D F
+ . E  D FY2007
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" Q
 F I ICDJ=286 S ICDJ(1)=ICDJ Q
@@ -15,10 +14,2 @@
  I ICDJ=288 S ICDJ(3)=ICDJ
  Q
-FY2008 ;MS-DRG
- I ICDJ=615 S ICDJ(1)=ICDJ Q
- I ICDJ=618 S ICDJ(2)=ICDJ Q
- I ICDJ=621 S ICDJ(3)=ICDJ Q
- I ICDJ=624 S ICDJ(4)=ICDJ Q
- I ICDJ=627 S ICDJ(5)=ICDJ Q
- I ICDJ=630 S ICDJ(6)=ICDJ
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG11.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG11.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG11.m	(revision 636)
@@ -1,7 +1,5 @@
 ICDDRG11 ;ALB/GRR/EG - FIX SURGERY HIERARCHY ; 10/23/00 11:42am
- ;;18.0;DRG Grouper;**24,31**;Oct 20, 2000;Build 7
- Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D
- . I ICDDATE<3071001 D F Q
- . E  D FY2008
+ ;;18.0;DRG Grouper;**24**;Oct 20, 2000;Build 5
+ Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D F
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" Q
 F I ICDJ=302 S ICDJ(1)=ICDJ Q
@@ -9,12 +7,2 @@
  I ICDJ=303 S ICDJ(3)=ICDJ Q
  Q
-FY2008 ;MS-DRG
- I ICDJ=652 S ICDJ(1)=ICDJ Q
- I ICDJ=655 S ICDJ(2)=ICDJ Q
- I ICDJ=658 S ICDJ(3)=ICDJ Q
- I ICDJ=661 S ICDJ(4)=ICDJ Q
- I ICDJ=667 S ICDJ(5)=ICDJ Q
- I ICDJ=670 S ICDJ(6)=ICDJ Q
- I ICDJ=672 S ICDJ(7)=ICDJ Q
- I ICDJ=675 S ICDJ(8)=ICDJ
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG12.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG12.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG12.m	(revision 636)
@@ -1,7 +1,5 @@
 ICDDRG12 ;ALB/GRR - FIX SURGERY HIERARCHY ; 10/23/00 11:37am
- ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
- Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D
- . I ICDDATE<3071001 D F Q
- . E  D FY2008
+ ;;18.0;DRG Grouper;;Oct 20, 2000;Build 1
+ Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D F
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" Q
 F I ICDJ=334 S ICDJ(1)=ICDJ Q
@@ -13,9 +11,2 @@
  I ICDJ=344 S ICDJ(7)=ICDJ
  Q
-FY2008 ;MS-DRG
- I ICDJ=708 S ICDJ(1)=ICDJ Q
- I ICDJ=710 S ICDJ(2)=ICDJ Q
- I ICDJ=712 S ICDJ(3)=ICDJ Q
- I ICDJ=714 S ICDJ(4)=ICDJ Q
- I ICDJ=718 S ICDJ(5)=ICDJ Q
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG13.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG13.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG13.m	(revision 636)
@@ -1,8 +1,7 @@
 ICDDRG13 ;ALB/GRR/EG - FIX SURGERY HIERARCHY ; 10/23/00 11:38am
- ;;18.0;DRG Grouper;**24,31**;Oct 20, 2000;Build 7
+ ;;18.0;DRG Grouper;**24**;Oct 20, 2000;Build 5
  Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D
- . I ICDDATE<3061001 D F Q
- . E  I ICDDATE<3071001 D FY2007 Q
- . E  D FY2008
+ . I ICDDATE<3061001 D F
+ . E  D FY2007
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" Q
 F I ICDJ=353 S ICDJ(1)=ICDJ Q
@@ -35,12 +34,2 @@
  I ICDJ=365 S ICDJ(13)=ICDJ
  Q
-FY2008 ;
- I ICDJ=735 S ICDJ(1)=ICDJ Q
- I ICDJ=738 S ICDJ(2)=ICDJ Q
- I ICDJ=741 S ICDJ(3)=ICDJ Q
- I ICDJ=743 S ICDJ(4)=ICDJ Q
- I ICDJ=745 S ICDJ(5)=ICDJ Q
- I ICDJ=747 S ICDJ(6)=ICDJ Q
- I ICDJ=748 S ICDJ(7)=ICDJ Q
- I ICDJ=750 S ICDJ(8)=ICDJ
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG14.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG14.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG14.m	(revision 636)
@@ -1,14 +1,9 @@
 ICDDRG14 ;ALB/GRR - FIX SURGERY HIERARCHY ; 9/29/04 3:48pm
- ;;18.0;DRG Grouper;**14,31**;Oct 20, 2000;Build 7
+ ;;18.0;DRG Grouper;**14**;Oct 20, 2000;Build 1
  ;
- G POST:ICDPD'["D" I ICDOR["c" D  Q
- . I ICDDATE>3070930.9 S ICDRG=766
- . E  S ICDRG=$S(ICDCC:370,1:371)
-NOV I ICDOR["s"!(ICDOR["g") D  Q
- . I ICDDATE>3070930.9 S ICDRG=$S(ICDOR["s":767,1:768)
- . E  S ICDRG=$S(ICDOR["s":374,1:375)
+ G POST:ICDPD'["D" I ICDOR["c" S ICDRG=$S(ICDCC:370,1:371) Q
+NOV I ICDOR["s"!(ICDOR["g") S ICDRG=$S(ICDOR["s":374,1:375) Q
  ;
- I ICDDATE>3070930.9 S ICDRG=$S(ICDSD["n"!(ICDPD["n"):774,1:775) Q
- E  S ICDRG=$S(ICDSD["n"!(ICDPD["n"):372,1:373) Q
+ S ICDRG=$S(ICDSD["n"!(ICDPD["n"):372,1:373) Q
  ;
 POST N DRGFY,ICDREF
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG17.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG17.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG17.m	(revision 636)
@@ -1,7 +1,5 @@
 ICDDRG17 ;ALB/EG - FIX SURGERY HIERARCHY ; 10/9/03 11:41am
- ;;18.0;DRG Grouper;**10,31**;Oct 20, 2000;Build 7
- Q:$O(ICDODRG(0))'>0  K ICDJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  D
- . I ICDDATE<3071001 D F Q
- . E  D FY2008
+ ;;18.0;DRG Grouper;**10**;Oct 20, 2000;Build 1
+ Q:$O(ICDODRG(0))'>0  K ICDJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  D F
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" K ICDJ Q
 F I ICDJ=539 S ICDJ(1)=ICDJ Q
@@ -24,8 +22,2 @@
  I ICDJ=414 S ICDJ(18)=ICDJ Q
  Q
-FY2008 ;
- I ICDJ=822 S ICDJ(1)=ICDJ Q
- I ICDJ=825 S ICDJ(2)=ICDJ Q
- I ICDJ=828 S ICDJ(3)=ICDJ Q
- I ICDJ=830 S ICDJ(4)=ICDJ
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG2.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG2.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG2.m	(revision 636)
@@ -1,8 +1,7 @@
 ICDDRG2 ;ALB/GRR/EG - FIX SURGERY HIERARCHY ; 10/23/00 11:39am
- ;;18.0;DRG Grouper;**24,31**;Oct 20, 2000;Build 7
+ ;;18.0;DRG Grouper;**24**;Oct 20, 2000;Build 5
  Q:$O(ICDODRG(0))'>0  K ICDJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  D
- .I ICDDATE<3061001 D F Q
- .E  I ICDDATE<3071001 D FY2007 Q
- .E  D FY2008
+ .I ICDDATE<3061001 D F
+ .E  D FY2007
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" K ICDJ Q
 F I ICDJ=37 S ICDJ(1)=ICDJ Q
@@ -21,9 +20,4 @@
  I ICDJ=38 S ICDJ(6)=ICDJ Q
  Q
-FY2008 ;
- I ICDJ=114 S ICDJ(1)=ICDJ Q
- I ICDJ=115 S ICDJ(2)=ICDJ Q
- I ICDJ=117 S ICDJ(3)=ICDJ Q
- Q
 VER S ICDF="",ICDL39=0 F ICDFZ=1:1 S ICDF=$O(ICDOP(ICDF)) Q:ICDF=""  S ICD=$P(ICDF," ",2) I "12.91^12.92^14.71^14.72^14.73^14.74^14.75^14.79"'[ICD S ICDL39=1 Q
  S ICDRG=$S(ICDL39:39,1:42)
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG3.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG3.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG3.m	(revision 636)
@@ -1,8 +1,7 @@
 ICDDRG3 ;ALB/GRR/EG - FIX SURGERY HIERARCHY ; 10/23/00 11:39am
- ;;18.0;DRG Grouper;**24,31**;Oct 20, 2000;Build 7
+ ;;18.0;DRG Grouper;**24**;Oct 20, 2000;Build 5
  Q:$O(ICDODRG(0))'>0  K ICDJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  D
- .I ICDDATE<3061001 D F Q
- .E  I ICDDATE<3071001 D FY2007 Q
- .E  D FY2008
+ .I ICDDATE<3061001 D F
+ .E  D FY2007
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" K ICDJ Q
 F I ICDJ=49 S ICDJ(1)=ICDJ Q
@@ -43,12 +42,4 @@
  I ICDJ=63 S ICDJ(17)=ICDJ Q
  Q
-FY2008 ;MS-DRG
- I ICDJ=130 S ICDJ(1)=ICDJ Q
- I ICDJ=132 S ICDJ(2)=ICDJ Q
- I ICDJ=134 S ICDJ(3)=ICDJ Q
- I ICDJ=136 S ICDJ(4)=ICDJ Q
- I ICDJ=138 S ICDJ(5)=ICDJ Q
- I ICDJ=139 S ICDJ(6)=ICDJ Q
- Q
 EN1 ;
  I $D(ICDOP(" 28.2"))!($D(ICDOP(" 28.3")))!($D(ICDOP(" 28.6"))) S ICDRG=$S(ICDOCNT>1:$S(AGE>17:57,1:58),1:ICDRG)
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG5.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG5.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG5.m	(revision 636)
@@ -1,8 +1,7 @@
 ICDDRG5 ;ALB/GRR/EG/MRY/ADL - FIX SURGERY HIERARCHY ; 3/20/03 10:36am
- ;;18.0;DRG Grouper;**2,5,7,10,20,22,31**;Oct 20, 2000;Build 7
+ ;;18.0;DRG Grouper;**2,5,7,10,20,22**;Oct 20, 2000;Build 1
  Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D
- .I ICDDATE<3051001 D F Q
- .E  I ICDDATE<3071001 D FY2007 Q
- .E  D FY2008
+ .I ICDDATE<3051001 D F
+ .E  D FY2006
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" Q
 F I ICDJ=103 S ICDJ(1)=ICDJ Q
@@ -33,5 +32,5 @@
  I ICDJ=120 S ICDJ(25)=ICDJ
  Q
-FY2007 ;
+FY2006 ;
  I ICDJ=103 S ICDJ(1)=ICDJ Q
  I ICDJ=525 S ICDJ(2)=ICDJ Q
@@ -66,28 +65,4 @@
  I ICDJ=120 S ICDJ(31)=ICDJ
  Q
-FY2008 ;
- I ICDJ=215 S ICDJ(1)=ICDJ Q
- I ICDJ=221 S ICDJ(2)=ICDJ Q
- I ICDJ=223 S ICDJ(3)=ICDJ Q
- I ICDJ=225 S ICDJ(4)=ICDJ Q
- I ICDJ=227 S ICDJ(5)=ICDJ Q
- I ICDJ=230 S ICDJ(6)=ICDJ Q
- I ICDJ=232 S ICDJ(7)=ICDJ Q
- I ICDJ=234 S ICDJ(8)=ICDJ Q
- I ICDJ=236 S ICDJ(9)=ICDJ Q
- I ICDJ=238 S ICDJ(10)=ICDJ Q
- I ICDJ=241 S ICDJ(11)=ICDJ Q
- I ICDJ=244 S ICDJ(12)=ICDJ Q
- I ICDJ=245 S ICDJ(13)=ICDJ Q
- I ICDJ=247 S ICDJ(14)=ICDJ Q
- I ICDJ=249 S ICDJ(15)=ICDJ Q
- I ICDJ=251 S ICDJ(16)=ICDJ Q
- I ICDJ=254 S ICDJ(17)=ICDJ Q
- I ICDJ=257 S ICDJ(18)=ICDJ Q
- I ICDJ=259 S ICDJ(19)=ICDJ Q
- I ICDJ=262 S ICDJ(20)=ICDJ Q
- I ICDJ=263 S ICDJ(21)=ICDJ Q
- I ICDJ=264 S ICDJ(22)=ICDJ Q
- Q
 EN1 S (ICDCC3,ICDCC2)=0
  I $D(ICDOP(" 00.50")) S ICDCC3=1
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG6.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG6.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG6.m	(revision 636)
@@ -1,8 +1,7 @@
 ICDDRG6 ;ALB/GRR - FIX SURGERY HIERARCHY ; 10/23/00 11:40am
- ;;18.0;DRG Grouper;**24,27,31**;Oct 20, 2000;Build 7
+ ;;18.0;DRG Grouper;**24,27**;Oct 20, 2000;Build 2
  Q:$O(ICDODRG(0))'>0  K ICDJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  D
- .I ICDDATE<3061001 D F Q
- .E  I ICDDATE<3071001 D FY2007 Q
- .E  D FY2008
+ .I ICDDATE<3061001 D F
+ .E  D FY2007
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" K ICDJ Q
 F I ICDJ=154 S ICDJ(1)=ICDJ Q
@@ -40,15 +39,2 @@
  I ICDJ=170 S ICDJ(19)=ICDJ
  Q
-FY2008 ;
- I ICDJ=328 S ICDJ(1)=ICDJ Q
- I ICDJ=331 S ICDJ(2)=ICDJ Q
- I ICDJ=334 S ICDJ(3)=ICDJ Q
- I ICDJ=337 S ICDJ(4)=ICDJ Q
- I ICDJ=340 S ICDJ(5)=ICDJ Q
- I ICDJ=343 S ICDJ(6)=ICDJ Q
- I ICDJ=346 S ICDJ(7)=ICDJ Q
- I ICDJ=349 S ICDJ(8)=ICDJ Q
- I ICDJ=352 S ICDJ(9)=ICDJ Q
- I ICDJ=355 S ICDJ(10)=ICDJ Q
- I ICDJ=358 S ICDJ(11)=ICDJ Q
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG7.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG7.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG7.m	(revision 636)
@@ -1,7 +1,5 @@
 ICDDRG7 ;ALB/EG - FIX SURGERY HIERARCHY ; 10/23/00 11:41am
- ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
- Q:$O(ICDODRG(0))'>0  K ICDJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  D
- .I ICDDATE<3071001 D F Q
- .E  D FY2008
+ ;;18.0;DRG Grouper;;Oct 20, 2000;Build 1
+ Q:$O(ICDODRG(0))'>0  K ICDJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  D F
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" K ICDJ Q
 F I ICDJ=191 S ICDJ(1)=ICDJ Q
@@ -19,11 +17,2 @@
  I ICDJ=201 S ICDJ(13)=ICDJ
  Q
-FY2008 ;
- I ICDJ=407 S ICDJ(1)=ICDJ Q
- I ICDJ=410 S ICDJ(2)=ICDJ Q
- I ICDJ=413 S ICDJ(3)=ICDJ Q
- I ICDJ=416 S ICDJ(4)=ICDJ Q
- I ICDJ=419 S ICDJ(5)=ICDJ Q
- I ICDJ=422 S ICDJ(6)=ICDJ Q
- I ICDJ=423 S ICDJ(7)=ICDJ Q
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG8.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG8.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG8.m	(revision 636)
@@ -1,9 +1,8 @@
 ICDDRG8 ;ALB/GRR/EG - FIX SURGERY HIERARCHY ; 7/18/01 10:40am
- ;;18.0;DRG Grouper;**1,2,10,20,24,31**;Oct 20, 2000;Build 7
+ ;;18.0;DRG Grouper;**1,2,10,20,24**;Oct 20, 2000;Build 5
  Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D
- .I ICDDATE<3051001 D F Q
- .E  I ICDDATE<3061001 D FY2006 Q
- .E  I ICDDATE<3071001 D FY2007 Q
- .E  D FY2008
+ .I ICDDATE<3051001 D F
+ .E  I ICDDATE<3061001 D FY2006
+ .E  D FY2007
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" Q
 F I ICDJ=471 S ICDJ(1)=ICDJ Q
@@ -111,32 +110,4 @@
  I ICDJ=234 S ICDJ(37)=ICDJ Q
  Q
-FY2008 ;
- I ICDJ=455 S ICDJ(1)=ICDJ Q
- I ICDJ=458 S ICDJ(2)=ICDJ Q
- I ICDJ=460 S ICDJ(3)=ICDJ Q
- I ICDJ=462 S ICDJ(4)=ICDJ Q
- I ICDJ=465 S ICDJ(5)=ICDJ Q
- I ICDJ=468 S ICDJ(6)=ICDJ Q
- I ICDJ=470 S ICDJ(7)=ICDJ Q
- I ICDJ=473 S ICDJ(8)=ICDJ Q
- I ICDJ=476 S ICDJ(9)=ICDJ Q
- I ICDJ=479 S ICDJ(10)=ICDJ Q
- I ICDJ=482 S ICDJ(11)=ICDJ Q
- I ICDJ=484 S ICDJ(12)=ICDJ Q
- I ICDJ=487 S ICDJ(13)=ICDJ Q
- I ICDJ=489 S ICDJ(14)=ICDJ Q
- I ICDJ=491 S ICDJ(15)=ICDJ Q
- I ICDJ=494 S ICDJ(16)=ICDJ Q
- I ICDJ=497 S ICDJ(17)=ICDJ Q
- I ICDJ=499 S ICDJ(18)=ICDJ Q
- I ICDJ=502 S ICDJ(19)=ICDJ Q 
- I ICDJ=505 S ICDJ(20)=ICDJ Q
- I ICDJ=506 S ICDJ(21)=ICDJ Q
- I ICDJ=508 S ICDJ(22)=ICDJ Q
- I ICDJ=509 S ICDJ(23)=ICDJ Q
- I ICDJ=512 S ICDJ(24)=ICDJ Q
- I ICDJ=514 S ICDJ(25)=ICDJ Q
- I ICDJ=517 S ICDJ(26)=ICDJ Q
- Q
 EN1 ; paired spinal fusion codes
  S ICDCC3=0
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG9.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG9.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG9.m	(revision 636)
@@ -1,7 +1,5 @@
 ICDDRG9 ;ALB/GRR/EG - FIX SURGERY HIERARCHY ; 10/23/00 11:42am
- ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
- Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D
- . I ICDDATE<3071001 D F Q
- .E  D FY2008
+ ;;18.0;DRG Grouper;;Oct 20, 2000;Build 1
+ Q:$O(ICDODRG(0))'>0  K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0  S ICDJJ(ICDJ)="" D F
 END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0  S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" Q
 F I ICDJ=263 S ICDJ(1)=ICDJ Q
@@ -20,9 +18,2 @@
  I ICDJ=270 S ICDJ(14)=ICDJ
  Q
-FY2008 ;
- I ICDJ=575 S ICDJ(1)=ICDJ Q
- I ICDJ=578 S ICDJ(2)=ICDJ Q
- I ICDJ=581 S ICDJ(3)=ICDJ Q
- I ICDJ=583 S ICDJ(4)=ICDJ Q
- I ICDJ=585 S ICDJ(5)=ICDJ Q
- Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRGM.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRGM.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRGM.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDDRGM ;ALB/GRR/EG/ADL - GROUPER DRIVER ; 10/23/00 11:45am
- ;;18.0;DRG Grouper;**7**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**7**;Oct 20, 2000;Build 1
  ;;ADL;Add Date prompt and passing of effective date for DRG CSV project
  ;;ADL;Update DIC("S") code to screen using new function calls
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRGX.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRGX.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRGX.m	(revision 636)
@@ -1,6 +1,5 @@
-ICDDRGX ;ALB/EG/MRY/ADL - GROUPER PROCESS ; 11/13/07 3:44pm
- ;;18.0;DRG Grouper;**1,2,5,7,10,14,20,24,27,31**;Oct 20, 2000;Build 7
+ICDDRGX ;ALB/EG/MRY/ADL - GROUPER PROCESS ; 3/14/05 1:38pm
+ ;;18.0;DRG Grouper;**1,2,5,7,10,14,20,24,27**;Oct 20, 2000;Build 2
 CKHIV ;MDC25 grouping
- I ICDDATE>3070930.9 G CKHIV^ICDDRGXM ;MS-DRG
  ;Q:ICDP25=""
  I ICDPD'["h"&(ICDSD'["h") Q
@@ -26,26 +25,17 @@
  S:(ICDRG=488)!(ICDRG=489)!(ICDRG=490) ICDRTC=0
  K ICDGH,ICDP25,ICDS25,ICDORNA Q
-CKMST ;MDC24 grouping; MS-DRG additions
+CKMST ;MDC24 grouping
  S ICDAJ=0 F ICDS24K=1:1 S ICDAJ=$O(ICDS24(ICDAJ)) Q:ICDAJ=""
  S ICDS24K=ICDS24K-1,ICDS24L=0 F ICDI=1:1:8 S:$D(ICDS24(ICDI))&(ICDI'=ICDP24) ICDS24L=$S($D(ICDS24(ICDI)):1,1:0)
  I ICDOR["u" S ICDS24K=ICDS24K+1
  G:((ICDP24=0)&(ICDS24K<2))!((ICDP24>0)&('ICDS24L)) CKMSTE
- N CKMST S CKMST=0
- I ICDDATE>3070930.9 D  Q:CKMST  ;MS-DRG
- . S ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(1))):955,ICDP24>0&($D(ICDO24(1)))&(ICDS24L):955,1:ICDRG) I ICDRG=955 D CKMSTE S CKMST=1 Q
- . S:ICDRG'=955 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(2))):956,ICDP24>0&($D(ICDO24(2)))&(ICDS24L):956,1:ICDRG) I ICDRG=956 D CKMSTE S CKMST=1 Q
- . S:ICDRG'=956 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(3))):959,ICDP24>0&($D(ICDO24(3)))&(ICDS24L):959,1:ICDRG) I ICDRG=959 D CKMSTE S CKMST=1 Q
- . S ICDRG=$S(ICDP24=0&(ICDS24K>1):965,ICDP24>0&ICDS24L:965,1:ICDRG)
- . S:(ICDRG>954)&(ICDRG<966) ICDRTC=0
- E  D  Q:CKMST  ;CMS-DRG
- . S ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(1))):484,ICDP24>0&($D(ICDO24(1)))&(ICDS24L):484,1:ICDRG) I ICDRG=484 D CKMSTE S CKMST=1 Q
- . S:ICDRG'=484 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(2))):485,ICDP24>0&($D(ICDO24(2)))&(ICDS24L):485,1:ICDRG) I ICDRG=485 D CKMSTE S CKMST=1 Q
- . S:ICDRG'=485 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(3))):486,ICDP24>0&($D(ICDO24(3)))&(ICDS24L):486,1:ICDRG) I ICDRG=486 D CKMSTE S CKMST=1 Q
- . S ICDRG=$S(ICDP24=0&(ICDS24K>1):487,ICDP24>0&ICDS24L:487,1:ICDRG)
- . S:(ICDRG>483)&(ICDRG<488) ICDRTC=0
+ S ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(1))):484,ICDP24>0&($D(ICDO24(1)))&(ICDS24L):484,1:ICDRG) I ICDRG=484 D CKMSTE Q
+ S:ICDRG'=484 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(2))):485,ICDP24>0&($D(ICDO24(2)))&(ICDS24L):485,1:ICDRG) I ICDRG=485 D CKMSTE Q
+ S:ICDRG'=485 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(3))):486,ICDP24>0&($D(ICDO24(3)))&(ICDS24L):486,1:ICDRG) I ICDRG=486 D CKMSTE Q
+ S ICDRG=$S(ICDP24=0&(ICDS24K>1):487,ICDP24>0&ICDS24L:487,1:ICDRG)
+ S:(ICDRG>483)&(ICDRG<488) ICDRTC=0
 CKMSTE K ICDAJ,ICDP24,ICDS24,ICDO24,ICDS24K,ICDO24,ICDS24L
  Q
 CKNMDC ;non MDC drg's
- I ICDDATE>3070930.9 G CKNMDC^ICDDRGXM ;MS-DRG
  S:(ICDRG>479)&(ICDRG<484) ICDRG=470
  ; ICD*18*1 - reorder drg 103 higher than all Pre-MDCs 480-83 & 495
@@ -65,5 +55,5 @@
  S ICDRG=$S(ICDOR["r":495,1:ICDRG) I ICDRG=495 S ICDRTC=0 Q  ;check for lung tx
  S ICDRG=$S(ICDOR["q":103,1:ICDRG) I ICDRG=103 S ICDRTC=0 Q  ;check for heart tx
- S ICDRG=$S(ICDOR["B":481,1:ICDRG) I ICDRG=481 S ICDRTC=0 Q
+ S ICDRG=$S(ICDOR["B":481,1:ICDDRG) I ICDRG=481 S ICDRTC=0 Q
  S ICDRG=$S($D(ICDOP(" 30.3"))!$D(ICDOP(" 30.4")):482,1:ICDRG) I ICDRG=482 S ICDRTC=0 Q
  S ICDRG=$S(ICDOR["t"&($P($$ICDDX^ICDCODE(ICDDX(1),ICDDATE),"^",3)["Y"):482,1:ICDRG) I ICDRG=482 S ICDRTC=0 Q
@@ -72,11 +62,6 @@
  ;
 CHKMDC4 ;MDC 4 drg's
- I ICDDATE>3070930.9 D  ;MS-DRG
- . I (ICDMDC=4!(ICDMDC=98)),(ICDOR["f") S ICDRG=168
- . I ICDDRG=983,$G(ICDMDC)=5,$D(ICDOP(" 86.06")) S ICDRG=264
- . I ICDDRG=983,$G(ICDMDC)=5,$D(ICDOP(" 92.27")),ICDNOR=1 S ICDRG=264 ;ICD*18*5
- E  D  ;CMS-DRG
- . I (ICDMDC=4!(ICDMDC=98)),(ICDOR["f") S ICDRG=76
- . I ICDDRG=468,$G(ICDMDC)=5,$D(ICDOP(" 86.06")) S ICDRG=120
- . I ICDDRG=468,$G(ICDMDC)=5,$D(ICDOP(" 92.27")),ICDNOR=1 S ICDRG=120 ;ICD*18*5
+ I (ICDMDC=4!(ICDMDC=98)),(ICDOR["f") S ICDRG=76
+ I ICDDRG=468,$G(ICDMDC)=5,$D(ICDOP(" 86.06")) S ICDRG=120
+ I ICDDRG=468,$G(ICDMDC)=5,$D(ICDOP(" 92.27")),ICDNOR=1 S ICDRG=120 ;ICD*18*5
  Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDGTDRG.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDGTDRG.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDGTDRG.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDGTDRG  ;ALB/ADL/KER - COLLECTION OF DRG APIS ; 04/18/2004
- ;;18.0;DRG Grouper;**7,12,14,17**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**7,12,14,17**;Oct 20, 2000;Build 1
  ;   Collection of API's for accessing new "DRG" level
  ;   of files #80, #80.1, and #80.2.  These new levels
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDHLPO.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDHLPO.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDHLPO.m	(revision 636)
@@ -1,4 +1,4 @@
-ICDHLPO ;ALB/GRR/EG-HELP DISPLAY FOR OPERATION IDENTIFIERS ; 11/9/07 12:52pm
- ;;18.0;DRG Grouper;**10,14,31**;Oct 20, 2000;Build 7
+ICDHLPO ;ALB/GRR/EG-HELP DISPLAY FOR OPERATION IDENTIFIERS ; 9/22/04 9:38am
+ ;;18.0;DRG Grouper;**10,14**;Oct 20, 2000;Build 1
 EN ;revised 12/94  abr
  N ICDID,I,J,ID
@@ -57,5 +57,4 @@
  ;;Q=Craniotomy
  ;;I=injectable/infusion (injection or infusion of drugs)
- ;;J=Inguinal and femoral hernia procedures
  ;;EXIT
  Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDID.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDID.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDID.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDID ;SLC/KER - ICD IDENTIFIERS ; 04/18/2004
- ;;18.0;DRG Grouper;**12,15**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**12,15**;Oct 20, 2000;Build 1
  ;
  ;
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDREF.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDREF.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDREF.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDREF ;ALB/EG - GROUPER UTILITY FUNCTIONS ; 5/20/05 8:35pm
- ;;18.0;DRG Grouper;** 14,17 **;Oct 20, 2000
+ ;;18.0;DRG Grouper;** 14,17 **;Oct 20, 2000;Build 1
 RTABLE(ICDRG,ICDDATE) ; Return Reference Table
  ;  Input:      ICDRG - DRG entry
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDSUPT.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDSUPT.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDSUPT.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDSUPT ;DLS/DEK - ICD SUPPORT FOR APIS ; 04/28/2003
- ;;18.0;DRG Grouper;**6**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**6**;Oct 20, 2000;Build 1
  ;
  ; External References
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB1.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB1.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB1.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB1 ;ALB/EG - GROUPER UTILITY FUNCTIONS ; 9/29/03 11:47am
- ;;18.0;DRG Grouper;**10**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**10**;Oct 20, 2000;Build 1
 DRG1 D DRG528 D:ICDRG'=528 DRG529
  S ICDRG=$S(AGE<18:3,ICDRG=528:528,ICDRG=529:529,ICDRG=530:530,ICDCC:1,1:2) I AGE="" S ICDRTC=3,ICDRG=470
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB1A.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB1A.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB1A.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB1A ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2005; 8/19/04 3:19pm ; 6/15/05 6:35pm
- ;;18.0;DRG Grouper;**14,17**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**14,17**;Oct 20, 2000;Build 1
 DRG1 D DRG528 D:ICDRG'=528 DRG543^ICDTLB6A D:ICDRG'=543 DRG529
  S ICDRG=$S(AGE<18:3,ICDRG=528:528,ICDRG=543:543,ICDRG=529:529,ICDRG=530:530,ICDCC:1,1:2) I AGE="" S ICDRTC=3,ICDRG=470
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB1B.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB1B.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB1B.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB1B ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2006; 8/19/04 3:19pm ; 6/28/05 4:01pm
- ;;18.0;DRG Grouper;**20**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**20**;Oct 20, 2000;Build 1
 DRG1 D DRG528 D:ICDRG'=528 DRG543^ICDTLB6B D:ICDRG'=543 DRG529
  S ICDRG=$S(AGE<18:3,ICDRG=528:528,ICDRG=543:543,ICDRG=529:529,ICDRG=530:530,ICDCC:1,1:2) I AGE="" S ICDRTC=3,ICDRG=470
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB2.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB2.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB2.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB2 ;ALB/EG - GROUPER UTILITY FUNCTIONS ; 9/19/03 1:09pm
- ;;18.0;DRG Grouper;**2,10**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**2,10**;Oct 20, 2000;Build 1
 DRG95 S ICDRG=$S(ICDCC:94,1:95) Q
 DRG96 S ICDRG=$S(AGE<18:98,ICDCC:96,1:97) I AGE="" S ICDRG=470,ICDRTC=3
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB2A.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB2A.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB2A.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB2A ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2005; 9/19/03 1:09pm ; 11/19/04 10:13am
- ;;18.0;DRG Grouper;**14**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**14**;Oct 20, 2000;Build 1
 DRG95 S ICDRG=$S(ICDCC:94,1:95) Q
 DRG96 S ICDRG=$S(AGE<18:98,ICDCC:96,1:97) I AGE="" S ICDRG=470,ICDRTC=3
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB2B.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB2B.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB2B.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB2B ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2006; 9/19/03 1:09pm ; 6/28/05 4:02pm
- ;;18.0;DRG Grouper;**20**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**20**;Oct 20, 2000;Build 1
 DRG95 S ICDRG=$S(ICDCC:94,1:95) Q
 DRG96 S ICDRG=$S(AGE<18:98,ICDCC:96,1:97) I AGE="" S ICDRG=470,ICDRTC=3
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB3.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB3.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB3.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB3 ;ALB/EG - GROUPER UTILITY FUNCTIONS ; 9/29/04 3:38pm
- ;;18.0;DRG Grouper;**14**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**14**;Oct 20, 2000;Build 1
 DRG164 S ICDRG=$S(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167) Q
 DRG165 S ICDRG=$S(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB3A.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB3A.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB3A.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB3A ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2005; 10/23/00 11:48am ; 4/1/05 11:05am
- ;;18.0;DRG Grouper;**14,16**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**14,16**;Oct 20, 2000;Build 1
 DRG164 S ICDRG=$S(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167) Q
 DRG165 S ICDRG=$S(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB4.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB4.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB4.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB4 ;ALB/EG - GROUPER UTILITY FUNCTIONS ; 10/23/00 11:48am
- ;;18.0;DRG Grouper;;Oct 20, 2000
+ ;;18.0;DRG Grouper;;Oct 20, 2000;Build 1
 DRG263 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
 DRG264 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB4A.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB4A.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB4A.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB4A ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2005; 10/23/00 11:48am ; 10/4/04 10:23am
- ;;18.0;DRG Grouper;**14**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**14**;Oct 20, 2000;Build 1
 DRG263 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
 DRG264 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB4B.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB4B.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB4B.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB4B ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2006; 10/23/00 11:48am ; 6/28/05 4:04pm
- ;;18.0;DRG Grouper;**20**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**20**;Oct 20, 2000;Build 1
 DRG263 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
 DRG264 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB5.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB5.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB5.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB5 ;ALB/EG/ADL - GROUPER UTILITY FUNCTIONS ; 10/23/00 11:49am
- ;;18.0;DRG Grouper;**7**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**7**;Oct 20, 2000;Build 1
  ;;ADL;UPDATE FOR CSV PROJECT;Mar 12, 2003
 DRG334 S ICDRG=$S(ICDCC:334,1:335) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB5A.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB5A.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB5A.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB5A ;ALB/EG/ADL - GROUPER UTILITY FUNCTIONS FY 2005; 10/23/00 11:49am ; 8/23/04 11:31am
- ;;18.0;DRG Grouper;**14**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**14**;Oct 20, 2000;Build 1
  ;;ADL;UPDATE FOR CSV PROJECT;Mar 12, 2003
 DRG334 S ICDRG=$S(ICDCC:334,1:335) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB5B.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB5B.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB5B.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB5B ;ALB/EG/ADL - GROUPER UTILITY FUNCTIONS FY 2006; 10/23/00 11:49am ; 6/28/05 4:05pm
- ;;18.0;DRG Grouper;**20**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**20**;Oct 20, 2000;Build 1
  ;;ADL;UPDATE FOR CSV PROJECT;Mar 12, 2003
 DRG334 S ICDRG=$S(ICDCC:334,1:335) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB6.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB6.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB6.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB6 ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS ; 9/29/03 2:47pm
- ;;18.0;DRG Grouper;**2,5,10**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**2,5,10**;Oct 20, 2000;Build 1
 DRG403 S ICDRG=$S(ICDPD["l":$S(AGE="":470,AGE<18:405,1:473),ICDOR["O"!(ICDORNI["O"):$S(ICDCC:401,1:402),ICDCC:403,1:404),ICDRTC=$S(ICDRG=470:3,1:ICDRTC) Q
 DRG404 S ICDRG=$S(ICDPD["l":$S(AGE="":470,AGE<18:405,1:473),ICDOR["O"!(ICDORNI["O"):$S(ICDCC:401,1:402),ICDCC:403,1:404),ICDRTC=$S(ICDRG=470:3,1:ICDRTC) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB61.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB61.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB61.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB61 ;SSI/ALA-GROUPER UTILITY FUNCTIONS [ 10/9/03  6:28 PM ] ; 10/23/00 11:50am
- ;;18.0;DRG Grouper;**10,22**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**10,22**;Oct 20, 2000;Build 1
 DRG412 ;
  I $D(ICDDX(1))&(ICDOPCT=0) D  Q:ICDRG=409
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB6A.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB6A.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB6A.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB6A ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS FY 2005; 9/29/03 2:47pm ; 6/16/05 1:31pm
- ;;18.0;DRG Grouper;**14,17**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**14,17**;Oct 20, 2000;Build 1
 DRG403 S ICDRG=$S(ICDPD["l":$S(AGE="":470,AGE<18:405,1:473),ICDOR["O"!(ICDORNI["O"):$S(ICDCC:401,1:402),ICDCC:403,1:404),ICDRTC=$S(ICDRG=470:3,1:ICDRTC) Q
 DRG404 S ICDRG=$S(ICDPD["l":$S(AGE="":470,AGE<18:405,1:473),ICDOR["O"!(ICDORNI["O"):$S(ICDCC:401,1:402),ICDCC:403,1:404),ICDRTC=$S(ICDRG=470:3,1:ICDRTC) Q
Index: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB6B.m
===================================================================
--- FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB6B.m	(revision 631)
+++ FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTLB6B.m	(revision 636)
@@ -1,4 +1,4 @@
 ICDTLB6B ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS FY 2006; 9/29/03 2:47pm ; 6/28/05 4:06pm
- ;;18.0;DRG Grouper;**20,22**;Oct 20, 2000
+ ;;18.0;DRG Grouper;**20,22**;Oct 20, 2000;Build 1
 DRG403 S ICDRG=$S(ICDPD["l":$S(AGE="":470,AGE<18:405,1:473),ICDOR["O"!(ICDORNI["O"):$S(ICDCC:401,1:402),ICDCC:403,1:404),ICDRTC=$S(ICDRG=470:3,1:ICDRTC) Q
 DRG404 S ICDRG=$S(ICDPD["l":$S(AGE="":470,AGE<18:405,1:473),ICDOR["O"!(ICDORNI["O"):$S(ICDCC:401,1:402),ICDCC:403,1:404),ICDRTC=$S(ICDRG=470:3,1:ICDRTC) Q
