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 ---[H[J[2J[HICDTLB61 811 printed Dec 13, 2024@01:52:42 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
