ICDTLB61.m

ICDTLB61 ;SSI/ALA/KUM - GROUPER UTILITY FUNCTIONS ;10/23/00 11:50am

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

 ;

DRG412 ;

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

 .I ICDDX(1)=$$CODEBA^ICDEX("V58.0",80) S ICDRG=409 Q

 .I ICDDX(1)=$$CODEBA^ICDEX("V67.1",80) S ICDRG=409 Q

 .Q

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

 .I ICDDX(1)=$$CODEBA^ICDEX("V58.11",80) S ICDRG=$S(ICDSD["2":492,1:410) Q

 .I ICDDX(1)=$$CODEBA^ICDEX("V58.12",80) S ICDRG=$S(ICDSD["2":492,1:410) Q

 .I ICDDX(1)=$$CODEBA^ICDEX("V67.2",80) 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICDTLB61   811     printed  Apr 09, 2024@20:55:14                                                                                                                                                                                                     Page 2

ICDTLB61  ;SSI/ALA/KUM - GROUPER UTILITY FUNCTIONS ;10/23/00 11:50am

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

 +2       ;

DRG412    ;

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

               Begin DoDot:1

 +2                IF ICDDX(1)=$$CODEBA^ICDEX("V58.0",80)

                       SET ICDRG=409

                       QUIT 

 +3                IF ICDDX(1)=$$CODEBA^ICDEX("V67.1",80)

                       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)=$$CODEBA^ICDEX("V58.11",80)

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

                       QUIT 

 +7                IF ICDDX(1)=$$CODEBA^ICDEX("V58.12",80)

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

                       QUIT 

 +8                IF ICDDX(1)=$$CODEBA^ICDEX("V67.2",80)

                       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