Last change
on this file since 752 was 636, checked in by George Lilly, 15 years ago |
WorldVistAEHR overlayed on FOIAVistA
|
File size:
647 bytes
|
Line | |
---|
1 | ICDDRG14 ;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
|
---|
5 | NOV 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 | ;
|
---|
9 | POST 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.