source: WorldVistAEHR/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTLB61.m@ 1800

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

initial load of WorldVistAEHR

File size: 800 bytes
RevLine 
[613]1ICDTLB61 ;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;Build 1
3DRG412 ;
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.