Changeset 636 for FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG.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/ICDDRG.m (modified) (7 diffs)

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

@@ -1 @@
-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 +19 @@
  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 +30 @@
  ;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 +37 @@
  . 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 +46 @@
  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 +75 @@
  ;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 +101 @@
  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