ICDTLB61.m

ICDTLB61 ;SSI/ALA-GROUPER UTILITY FUNCTIONS [ 10/9/03  6:28 PM ] ; 10/23/00 11:50am

 ;;18.0;DRG Grouper;**10,22**;Oct 20, 2000;Build 7

DRG412 ;

 I $D(ICDDX(1))&(ICDOPCT=0) D  Q:ICDRG=409

 .I ICDDX(1)=$O(^ICD9("AB","V58.0 ",0)) S ICDRG=409 Q

 .I ICDDX(1)=$O(^ICD9("AB","V67.1 ",0)) S ICDRG=409 Q

 .Q

 I $D(ICDDX(1))&(ICDOPCT=0) D  Q:"410^492"[ICDRG

 .I ICDDX(1)=$O(^ICD9("AB","V58.11 ",0)) S ICDRG=$S(ICDSD["2":492,1:410) Q

 .I ICDDX(1)=$O(^ICD9("AB","V58.12 ",0)) S ICDRG=$S(ICDSD["2":492,1:410) Q

 .I ICDDX(1)=$O(^ICD9("AB","V67.2 ",0)) S ICDRG=$S(ICDSD["2":492,1:410) Q

 I ICDPD["L" D DRG539^ICDTLB6 Q

 I ICDOR["N"&($D(ICDPDRG(412))) S ICDRG=412 Q

 I $D(ICDPDRG(412))&(ICDPD'["L") S ICDRG=411 Q

 I ICDCC S ICDRG=413 Q

 S ICDRG=414

 ;I $O(ICDPDRG(0))<ICDRG S ICDRG=$O(ICDPDRG(0)) D DODRG^ICDDRG0

 Q

ICDTLB61  ;SSI/ALA-GROUPER UTILITY FUNCTIONS [ 10/9/03  6:28 PM ] ; 10/23/00 11:50am

 +1       ;;18.0;DRG Grouper;**10,22**;Oct 20, 2000;Build 7

DRG412    ;

 +1        IF $DATA(ICDDX(1))&(ICDOPCT=0)

               Begin DoDot:1

 +2                IF ICDDX(1)=$ORDER(^ICD9("AB","V58.0 ",0))

                       SET ICDRG=409

                       QUIT 

 +3                IF ICDDX(1)=$ORDER(^ICD9("AB","V67.1 ",0))

                       SET ICDRG=409

                       QUIT 

 +4                QUIT 

               End DoDot:1

               IF ICDRG=409

                   QUIT 

 +5        IF $DATA(ICDDX(1))&(ICDOPCT=0)

               Begin DoDot:1

 +6                IF ICDDX(1)=$ORDER(^ICD9("AB","V58.11 ",0))

                       SET ICDRG=$SELECT(ICDSD["2":492,1:410)

                       QUIT 

 +7                IF ICDDX(1)=$ORDER(^ICD9("AB","V58.12 ",0))

                       SET ICDRG=$SELECT(ICDSD["2":492,1:410)

                       QUIT 

 +8                IF ICDDX(1)=$ORDER(^ICD9("AB","V67.2 ",0))

                       SET ICDRG=$SELECT(ICDSD["2":492,1:410)

                       QUIT 

               End DoDot:1

               IF "410^492"[ICDRG

                   QUIT 

 +9        IF ICDPD["L"

               DO DRG539^ICDTLB6

               QUIT 

 +10       IF ICDOR["N"&($DATA(ICDPDRG(412)))

               SET ICDRG=412

               QUIT 

 +11       IF $DATA(ICDPDRG(412))&(ICDPD'["L")

               SET ICDRG=411

               QUIT 

 +12       IF ICDCC

               SET ICDRG=413

               QUIT 

 +13       SET ICDRG=414

 +14      ;I $O(ICDPDRG(0))<ICDRG S ICDRG=$O(ICDPDRG(0)) D DODRG^ICDDRG0

 +15       QUIT