|
Last change
on this file since 761 was 628, checked in by George Lilly, 15 years ago |
|
initial load of FOIAVistA 6/30/08 version
|
|
File size:
792 bytes
|
| Line | |
|---|
| 1 | ICDTLB61 ;SSI/ALA-GROUPER UTILITY FUNCTIONS [ 10/9/03 6:28 PM ] ; 10/23/00 11:50am
|
|---|
| 2 | ;;18.0;DRG Grouper;**10,22**;Oct 20, 2000
|
|---|
| 3 | DRG412 ;
|
|---|
| 4 | I $D(ICDDX(1))&(ICDOPCT=0) D Q:ICDRG=409
|
|---|
| 5 | .I ICDDX(1)=$O(^ICD9("AB","V58.0 ",0)) S ICDRG=409 Q
|
|---|
| 6 | .I ICDDX(1)=$O(^ICD9("AB","V67.1 ",0)) S ICDRG=409 Q
|
|---|
| 7 | .Q
|
|---|
| 8 | I $D(ICDDX(1))&(ICDOPCT=0) D Q:"410^492"[ICDRG
|
|---|
| 9 | .I ICDDX(1)=$O(^ICD9("AB","V58.11 ",0)) S ICDRG=$S(ICDSD["2":492,1:410) Q
|
|---|
| 10 | .I ICDDX(1)=$O(^ICD9("AB","V58.12 ",0)) S ICDRG=$S(ICDSD["2":492,1:410) Q
|
|---|
| 11 | .I ICDDX(1)=$O(^ICD9("AB","V67.2 ",0)) S ICDRG=$S(ICDSD["2":492,1:410) Q
|
|---|
| 12 | I ICDPD["L" D DRG539^ICDTLB6 Q
|
|---|
| 13 | I ICDOR["N"&($D(ICDPDRG(412))) S ICDRG=412 Q
|
|---|
| 14 | I $D(ICDPDRG(412))&(ICDPD'["L") S ICDRG=411 Q
|
|---|
| 15 | I ICDCC S ICDRG=413 Q
|
|---|
| 16 | S ICDRG=414
|
|---|
| 17 | ;I $O(ICDPDRG(0))<ICDRG S ICDRG=$O(ICDPDRG(0)) D DODRG^ICDDRG0
|
|---|
| 18 | Q
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
