| 1 | ICDDRG14 ;ALB/GRR - FIX SURGERY HIERARCHY ; 9/29/04 3:48pm | 
|---|
| 2 | ;;18.0;DRG Grouper;**14,31**;Oct 20, 2000;Build 7 | 
|---|
| 3 | ; | 
|---|
| 4 | G POST:ICDPD'["D" I ICDOR["c" D  Q | 
|---|
| 5 | . I ICDDATE>3070930.9 S ICDRG=766 | 
|---|
| 6 | . E  S ICDRG=$S(ICDCC:370,1:371) | 
|---|
| 7 | NOV I ICDOR["s"!(ICDOR["g") D  Q | 
|---|
| 8 | . I ICDDATE>3070930.9 S ICDRG=$S(ICDOR["s":767,1:768) | 
|---|
| 9 | . E  S ICDRG=$S(ICDOR["s":374,1:375) | 
|---|
| 10 | ; | 
|---|
| 11 | I ICDDATE>3070930.9 S ICDRG=$S(ICDSD["n"!(ICDPD["n"):774,1:775) Q | 
|---|
| 12 | E  S ICDRG=$S(ICDSD["n"!(ICDPD["n"):372,1:373) Q | 
|---|
| 13 | ; | 
|---|
| 14 | POST N DRGFY,ICDREF | 
|---|
| 15 | S (DRGFY,ICDREF)="" | 
|---|
| 16 | I ICDPD["d" S ICDRG=$S(ICDOR["O":377,1:376) Q | 
|---|
| 17 | S ICDRG=$O(ICDRG(0)) I ICDRG'>0 S ICDRG=469 Q | 
|---|
| 18 | S DRGFY=$O(^ICD(ICDRG,2,"B",+ICDDATE),-1) | 
|---|
| 19 | S ICDREF=$O(^ICD(ICDRG,2,"B",$S($G(DRGFY):DRGFY,1:3041001),ICDREF)) | 
|---|
| 20 | S ICDREF=$P($G(^ICD(ICDRG,2,+ICDREF,0)),U,3) | 
|---|
| 21 | I ICDREF'="" S ICDREF="DRG"_ICDRG_"^"_ICDREF D @ICDREF K ICDREF | 
|---|
| 22 | Q | 
|---|