source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDDRG14.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 828 bytes
Line 
1ICDDRG14 ;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)
7NOV 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 ;
14POST 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
Note: See TracBrowser for help on using the repository browser.