- 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 Feb 18, 2025@23:19:03 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
