source: WorldVistAEHR/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG14.m@ 1046

Last change on this file since 1046 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 647 bytes
Line 
1ICDDRG14 ;ALB/GRR - FIX SURGERY HIERARCHY ; 9/29/04 3:48pm
2 ;;18.0;DRG Grouper;**14**;Oct 20, 2000;Build 1
3 ;
4 G POST:ICDPD'["D" I ICDOR["c" S ICDRG=$S(ICDCC:370,1:371) Q
5NOV I ICDOR["s"!(ICDOR["g") S ICDRG=$S(ICDOR["s":374,1:375) Q
6 ;
7 S ICDRG=$S(ICDSD["n"!(ICDPD["n"):372,1:373) Q
8 ;
9POST N DRGFY,ICDREF
10 S (DRGFY,ICDREF)=""
11 I ICDPD["d" S ICDRG=$S(ICDOR["O":377,1:376) Q
12 S ICDRG=$O(ICDRG(0)) I ICDRG'>0 S ICDRG=469 Q
13 S DRGFY=$O(^ICD(ICDRG,2,"B",+ICDDATE),-1)
14 S ICDREF=$O(^ICD(ICDRG,2,"B",$S($G(DRGFY):DRGFY,1:3041001),ICDREF))
15 S ICDREF=$P($G(^ICD(ICDRG,2,+ICDREF,0)),U,3)
16 I ICDREF'="" S ICDREF="DRG"_ICDRG_"^"_ICDREF D @ICDREF K ICDREF
17 Q
Note: See TracBrowser for help on using the repository browser.