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
