- ICDTLB3B ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2006; 10/23/00 11:48am ; 6/28/05 4:03pm
- ;;18.0;DRG Grouper;**20,27**;Oct 20, 2000;Build 2
- DRG164 S ICDRG=$S(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167) Q
- DRG165 S ICDRG=$S(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167) Q
- DRG166 S ICDRG=$S(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167) Q
- DRG167 S ICDRG=$S(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167) Q
- DRG168 S ICDRG=$S(ICDCC:168,1:169) Q
- DRG169 S ICDRG=$S(ICDCC:168,1:169) Q
- DRG170 S ICDRG=$S(ICDCC:170,1:171) Q
- DRG171 S ICDRG=$S(ICDCC:170,1:171) Q
- DRG172 S ICDRG=$S(ICDCC:172,1:173) Q
- DRG173 S ICDRG=$S(ICDCC:172,1:173) Q
- DRG174 S ICDRG=$S(ICDCC:174,1:175) Q
- DRG175 S ICDRG=$S(ICDCC:174,1:175) Q
- DRG177 S ICDRG=$S(ICDCC:177,1:178) Q
- DRG178 S ICDRG=$S(ICDCC:177,1:178) Q
- DRG180 S ICDRG=$S(ICDCC:180,1:181) Q
- DRG181 S ICDRG=$S(ICDCC:180,1:181) Q
- DRG182 S ICDRG=$S(AGE<18:184,ICDCC:182,1:183) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG183 S ICDRG=$S(AGE<18:184,ICDCC:182,1:183) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG184 S ICDRG=$S(AGE<18:184,ICDCC:182,1:183) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG185 S ICDRG=$S(ICDOR["e":187,AGE="":470,AGE<18:186,1:185),ICDRTC=$S(ICDRG=470:3,1:ICDRTC) Q
- DRG186 S ICDRG=$S(ICDOR["e":187,AGE="":470,AGE<18:186,1:185),ICDRTC=$S(ICDRG=470:3,1:ICDRTC) Q
- DRG187 S ICDRG=$S($D(ICDPDRG(187)):187,$D(ICDPDRG):ICDPDRG,1:"")
- I ICDRG?.N&(+ICDRG>0) Q
- I +ICDRG=0 S ICDRG=470 Q
- S ICDREF=$$RTABLE^ICDREF(+ICDRG,+ICDDATE)
- I ICDRG["^"&(ICDREF'="") X "D DRG"_+ICDRG_"^"_ICDREF Q
- S ICDRG=+ICDPDRG
- Q
- DRG188 S ICDRG=$S(AGE<18:190,ICDCC:188,1:189) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG189 S ICDRG=$S(AGE<18:190,ICDCC:188,1:189) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG190 S ICDRG=$S(AGE<18:190,ICDCC:188,1:189) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG191 S ICDRG=$S(ICDCC:191,1:192) Q
- DRG192 S ICDRG=$S(ICDCC:191,1:192) Q
- DRG193 ;
- ; ICD*18*27
- ;I ICDOR["T"&(ICDOR'["3"&(ICDOR'["h")) D Q:"195^196^197^198"[ICDRG
- ;.I ICDOR["E" S ICDRG=$S(ICDCC:195,1:196) Q
- ;.I ICDOR'["E" S ICDRG=$S(ICDCC:197,1:198)
- ;I ICDOR["3"!(ICDOR["E") S ICDRG=$S(ICDCC:193,1:194) Q
- I ICDOR["3" S ICDRG=$S(ICDCC:193,1:194) Q
- I ICDOR["E" I $D(ICDOP(" 51.21"))!$D(ICDOP(" 51.22"))!$D(ICDOP(" 51.23"))!$D(ICDOP(" 51.24")) S ICDRG=$S(ICDCC:195,1:196) Q
- I $D(ICDOP(" 51.21"))!$D(ICDOP(" 51.22")) S ICDRG=$S(ICDCC:197,1:198) Q
- I $D(ICDOP(" 51.23"))!$D(ICDOP(" 51.24")) S ICDRG=$S(ICDCC:493,1:494) Q
- ; end of ICD*18*27
- I ICDPD["M"&(ICDOR["h") S ICDRG=199 Q
- I ICDPD'["M"&(ICDOR["h") S ICDRG=200 Q
- I ICDPD["M"&(ICDOR'["h") S ICDRG=203 Q
- S ICDRG=204
- Q
- DRG194 D DRG193 Q
- DRG195 ;G:ICDOR["TT" DRG493^ICDTLB6B D DRG193 Q
- D DRG193 Q
- DRG196 D DRG193 Q
- DRG197 ;S ICDRG=$S(ICDCC:197,1:198) Q
- D DRG193 Q
- DRG198 ;S ICDRG=$S(ICDCC:197,1:198) Q
- D DRG193 Q
- DRG199 D DRG193 Q
- DRG200 D DRG193 Q
- DRG205 S ICDRG=$S(ICDCC:205,1:206) Q
- DRG206 S ICDRG=$S(ICDCC:205,1:206) Q
- DRG207 S ICDRG=$S(ICDCC:207,1:208) Q
- DRG208 S ICDRG=$S(ICDCC:207,1:208) Q
- DRG209 S ICDRG=$S($F($P(ICDOR,"M",2,99),"M"):471,1:209) Q
- DRG210 S ICDRG=$S(AGE<18:212,ICDCC:210,1:211) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG211 S ICDRG=$S(AGE<18:212,ICDCC:210,1:211) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG212 S ICDRG=$S(AGE<18:212,ICDCC:210,1:211) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG214 Q
- DRG215 Q
- DRG218 S ICDRG=$S(AGE<18:220,ICDCC:218,1:219) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG219 S ICDRG=$S(AGE<18:220,ICDCC:218,1:219) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG220 S ICDRG=$S(AGE<18:220,ICDCC:218,1:219) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG221 Q
- DRG222 Q
- DRG224 S ICDRG=$S(ICDCC:223,1:224) Q
- DRG226 S ICDRG=$S(ICDCC:226,1:227) Q
- DRG227 S ICDRG=$S(ICDCC:226,1:227) Q
- DRG228 S ICDRG=$S(ICDOR["O2":228,ICDCC:228,1:229) Q
- DRG229 S ICDRG=$S(ICDOR["O2":228,ICDCC:228,1:229) Q
- DRG232 S ICDRG=232 Q
- DRG233 S ICDRG=$S(ICDCC:233,1:234) Q
- DRG234 S ICDRG=$S(ICDCC:233,1:234) Q
- DRG240 S ICDRG=$S(ICDCC:240,1:241) Q
- DRG241 S ICDRG=$S(ICDCC:240,1:241) Q
- DRG244 S ICDRG=$S(ICDCC:244,1:245) Q
- DRG245 S ICDRG=$S(ICDCC:244,1:245) Q
- DRG250 S ICDRG=$S(AGE<18:252,ICDCC:250,1:251) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG251 S ICDRG=$S(AGE<18:252,ICDCC:250,1:251) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG252 S ICDRG=$S(AGE<18:252,ICDCC:250,1:251) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG253 S ICDRG=$S(AGE<18:255,ICDCC:253,1:254) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG254 S ICDRG=$S(AGE<18:255,ICDCC:253,1:254) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG255 S ICDRG=$S(AGE<18:255,ICDCC:253,1:254) I AGE="" S ICDRG=470,ICDRTC=3
- Q
- DRG256 S ICDRG=256 Q
- DRG257 I ICDOR'=""&(ICDOR["M") D
- .S ICDRG=$S(ICDPD["r"&(ICDCC):257,ICDSD["r"&(ICDCC):257,ICDPD["r":258,ICDSD["r":258,1:"")
- S:ICDRG="" ICDRG=261
- Q
- DRG258 D DRG257 Q
- DRG259 I ICDOR'=""&(ICDOR["m") D
- .S ICDRG=$S(ICDPD["r"&(ICDCC):259,ICDSD["r"&(ICDCC):259,ICDPD["r":260,ICDSD["r":260,ICDOR["L":262,1:"")
- .I $D(ICDOP("85.12 "))!$D(ICDOP("85.20 "))!$D(ICDOP("85.21 ")) S ICDRG=262
- S:ICDRG="" ICDRG=261
- Q
- DRG260 D DRG259 Q
- DRG262 D DRG259 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDTLB3B 5022 printed Feb 18, 2025@23:18:53 Page 2
- ICDTLB3B ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2006; 10/23/00 11:48am ; 6/28/05 4:03pm
- +1 ;;18.0;DRG Grouper;**20,27**;Oct 20, 2000;Build 2
- DRG164 SET ICDRG=$SELECT(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167)
- QUIT
- DRG165 SET ICDRG=$SELECT(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167)
- QUIT
- DRG166 SET ICDRG=$SELECT(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167)
- QUIT
- DRG167 SET ICDRG=$SELECT(ICDPD["X"&(ICDCC):164,ICDPD["X":165,ICDCC:166,1:167)
- QUIT
- DRG168 SET ICDRG=$SELECT(ICDCC:168,1:169)
- QUIT
- DRG169 SET ICDRG=$SELECT(ICDCC:168,1:169)
- QUIT
- DRG170 SET ICDRG=$SELECT(ICDCC:170,1:171)
- QUIT
- DRG171 SET ICDRG=$SELECT(ICDCC:170,1:171)
- QUIT
- DRG172 SET ICDRG=$SELECT(ICDCC:172,1:173)
- QUIT
- DRG173 SET ICDRG=$SELECT(ICDCC:172,1:173)
- QUIT
- DRG174 SET ICDRG=$SELECT(ICDCC:174,1:175)
- QUIT
- DRG175 SET ICDRG=$SELECT(ICDCC:174,1:175)
- QUIT
- DRG177 SET ICDRG=$SELECT(ICDCC:177,1:178)
- QUIT
- DRG178 SET ICDRG=$SELECT(ICDCC:177,1:178)
- QUIT
- DRG180 SET ICDRG=$SELECT(ICDCC:180,1:181)
- QUIT
- DRG181 SET ICDRG=$SELECT(ICDCC:180,1:181)
- QUIT
- DRG182 SET ICDRG=$SELECT(AGE<18:184,ICDCC:182,1:183)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG183 SET ICDRG=$SELECT(AGE<18:184,ICDCC:182,1:183)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG184 SET ICDRG=$SELECT(AGE<18:184,ICDCC:182,1:183)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG185 SET ICDRG=$SELECT(ICDOR["e":187,AGE="":470,AGE<18:186,1:185)
- SET ICDRTC=$SELECT(ICDRG=470:3,1:ICDRTC)
- QUIT
- DRG186 SET ICDRG=$SELECT(ICDOR["e":187,AGE="":470,AGE<18:186,1:185)
- SET ICDRTC=$SELECT(ICDRG=470:3,1:ICDRTC)
- QUIT
- DRG187 SET ICDRG=$SELECT($DATA(ICDPDRG(187)):187,$DATA(ICDPDRG):ICDPDRG,1:"")
- +1 IF ICDRG?.N&(+ICDRG>0)
- QUIT
- +2 IF +ICDRG=0
- SET ICDRG=470
- QUIT
- +3 SET ICDREF=$$RTABLE^ICDREF(+ICDRG,+ICDDATE)
- +4 IF ICDRG["^"&(ICDREF'="")
- XECUTE "D DRG"_+ICDRG_"^"_ICDREF
- QUIT
- +5 SET ICDRG=+ICDPDRG
- +6 QUIT
- DRG188 SET ICDRG=$SELECT(AGE<18:190,ICDCC:188,1:189)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG189 SET ICDRG=$SELECT(AGE<18:190,ICDCC:188,1:189)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG190 SET ICDRG=$SELECT(AGE<18:190,ICDCC:188,1:189)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG191 SET ICDRG=$SELECT(ICDCC:191,1:192)
- QUIT
- DRG192 SET ICDRG=$SELECT(ICDCC:191,1:192)
- QUIT
- DRG193 ;
- +1 ; ICD*18*27
- +2 ;I ICDOR["T"&(ICDOR'["3"&(ICDOR'["h")) D Q:"195^196^197^198"[ICDRG
- +3 ;.I ICDOR["E" S ICDRG=$S(ICDCC:195,1:196) Q
- +4 ;.I ICDOR'["E" S ICDRG=$S(ICDCC:197,1:198)
- +5 ;I ICDOR["3"!(ICDOR["E") S ICDRG=$S(ICDCC:193,1:194) Q
- +6 IF ICDOR["3"
- SET ICDRG=$SELECT(ICDCC:193,1:194)
- QUIT
- +7 IF ICDOR["E"
- IF $DATA(ICDOP(" 51.21"))!$DATA(ICDOP(" 51.22"))!$DATA(ICDOP(" 51.23"))!$DATA(ICDOP(" 51.24"))
- SET ICDRG=$SELECT(ICDCC:195,1:196)
- QUIT
- +8 IF $DATA(ICDOP(" 51.21"))!$DATA(ICDOP(" 51.22"))
- SET ICDRG=$SELECT(ICDCC:197,1:198)
- QUIT
- +9 IF $DATA(ICDOP(" 51.23"))!$DATA(ICDOP(" 51.24"))
- SET ICDRG=$SELECT(ICDCC:493,1:494)
- QUIT
- +10 ; end of ICD*18*27
- +11 IF ICDPD["M"&(ICDOR["h")
- SET ICDRG=199
- QUIT
- +12 IF ICDPD'["M"&(ICDOR["h")
- SET ICDRG=200
- QUIT
- +13 IF ICDPD["M"&(ICDOR'["h")
- SET ICDRG=203
- QUIT
- +14 SET ICDRG=204
- +15 QUIT
- DRG194 DO DRG193
- QUIT
- DRG195 ;G:ICDOR["TT" DRG493^ICDTLB6B D DRG193 Q
- +1 DO DRG193
- QUIT
- DRG196 DO DRG193
- QUIT
- DRG197 ;S ICDRG=$S(ICDCC:197,1:198) Q
- +1 DO DRG193
- QUIT
- DRG198 ;S ICDRG=$S(ICDCC:197,1:198) Q
- +1 DO DRG193
- QUIT
- DRG199 DO DRG193
- QUIT
- DRG200 DO DRG193
- QUIT
- DRG205 SET ICDRG=$SELECT(ICDCC:205,1:206)
- QUIT
- DRG206 SET ICDRG=$SELECT(ICDCC:205,1:206)
- QUIT
- DRG207 SET ICDRG=$SELECT(ICDCC:207,1:208)
- QUIT
- DRG208 SET ICDRG=$SELECT(ICDCC:207,1:208)
- QUIT
- DRG209 SET ICDRG=$SELECT($FIND($PIECE(ICDOR,"M",2,99),"M"):471,1:209)
- QUIT
- DRG210 SET ICDRG=$SELECT(AGE<18:212,ICDCC:210,1:211)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG211 SET ICDRG=$SELECT(AGE<18:212,ICDCC:210,1:211)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG212 SET ICDRG=$SELECT(AGE<18:212,ICDCC:210,1:211)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG214 QUIT
- DRG215 QUIT
- DRG218 SET ICDRG=$SELECT(AGE<18:220,ICDCC:218,1:219)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG219 SET ICDRG=$SELECT(AGE<18:220,ICDCC:218,1:219)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG220 SET ICDRG=$SELECT(AGE<18:220,ICDCC:218,1:219)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG221 QUIT
- DRG222 QUIT
- DRG224 SET ICDRG=$SELECT(ICDCC:223,1:224)
- QUIT
- DRG226 SET ICDRG=$SELECT(ICDCC:226,1:227)
- QUIT
- DRG227 SET ICDRG=$SELECT(ICDCC:226,1:227)
- QUIT
- DRG228 SET ICDRG=$SELECT(ICDOR["O2":228,ICDCC:228,1:229)
- QUIT
- DRG229 SET ICDRG=$SELECT(ICDOR["O2":228,ICDCC:228,1:229)
- QUIT
- DRG232 SET ICDRG=232
- QUIT
- DRG233 SET ICDRG=$SELECT(ICDCC:233,1:234)
- QUIT
- DRG234 SET ICDRG=$SELECT(ICDCC:233,1:234)
- QUIT
- DRG240 SET ICDRG=$SELECT(ICDCC:240,1:241)
- QUIT
- DRG241 SET ICDRG=$SELECT(ICDCC:240,1:241)
- QUIT
- DRG244 SET ICDRG=$SELECT(ICDCC:244,1:245)
- QUIT
- DRG245 SET ICDRG=$SELECT(ICDCC:244,1:245)
- QUIT
- DRG250 SET ICDRG=$SELECT(AGE<18:252,ICDCC:250,1:251)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG251 SET ICDRG=$SELECT(AGE<18:252,ICDCC:250,1:251)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG252 SET ICDRG=$SELECT(AGE<18:252,ICDCC:250,1:251)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG253 SET ICDRG=$SELECT(AGE<18:255,ICDCC:253,1:254)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG254 SET ICDRG=$SELECT(AGE<18:255,ICDCC:253,1:254)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG255 SET ICDRG=$SELECT(AGE<18:255,ICDCC:253,1:254)
- IF AGE=""
- SET ICDRG=470
- SET ICDRTC=3
- +1 QUIT
- DRG256 SET ICDRG=256
- QUIT
- DRG257 IF ICDOR'=""&(ICDOR["M")
- Begin DoDot:1
- +1 SET ICDRG=$SELECT(ICDPD["r"&(ICDCC):257,ICDSD["r"&(ICDCC):257,ICDPD["r":258,ICDSD["r":258,1:"")
- End DoDot:1
- +2 if ICDRG=""
- SET ICDRG=261
- +3 QUIT
- DRG258 DO DRG257
- QUIT
- DRG259 IF ICDOR'=""&(ICDOR["m")
- Begin DoDot:1
- +1 SET ICDRG=$SELECT(ICDPD["r"&(ICDCC):259,ICDSD["r"&(ICDCC):259,ICDPD["r":260,ICDSD["r":260,ICDOR["L":262,1:"")
- +2 IF $DATA(ICDOP("85.12 "))!$DATA(ICDOP("85.20 "))!$DATA(ICDOP("85.21 "))
- SET ICDRG=262
- End DoDot:1
- +3 if ICDRG=""
- SET ICDRG=261
- +4 QUIT
- DRG260 DO DRG259
- QUIT
- DRG262 DO DRG259
- QUIT
