ICD10TB2 ;KUM - GROUPER UTILITY FUNCTIONS;08/04/2015
;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21
;
;DRG200 ; D DRG200^ICDTBL2D -- See ICD10TB1
;DRG201 ;I ICDSD["c" S ICDRG=200 Q -- See ICD10TB1
DRG202 ;
DRG203 S ICDRG=$S(ICDMCC>0:202,1:203) Q
DRG204 S ICDRG=204 Q
DRG205 ;
DRG206 S ICDRG=$S(ICDMCC=2:205,1:206) Q
DRG207 ;
DRG208 ;
DRG209 ;
DRG210 ;
Q
DRG211 ;
Q
DRG212 ;
Q
DRG214 ;
DRG215 ;
DRG216 ;
DRG217 ;
DRG218 ;
DRG219 ;
DRG220 ;
Q
DRG221 ;
DRG222 ;
DRG223 ;
DRG224 ;
DRG225 ;
DRG226 ;
DRG227 ;
Q
DRG228 ;
DRG229 ;
DRG230 ;
S ICDRG=$S(ICDMCC=2:228,ICDMCC=1:229,1:230)
Q
DRG231 ;
DRG232 ;
DRG233 ;
DRG234 ;
DRG235 ;
DRG236 ;
Q
;DRG237 ;
;DRG238 ;
;S ICDRG=$S(ICDMCC=2:237,1:238)
;Q
DRG239 ;
DRG240 ;
DRG241 ;
S ICDRG=$S(ICDMCC=2:239,ICDMCC=1:240,1:241)
Q
DRG242 ; called from CMS115
DRG243 ;
DRG244 ;
S ICDRG=$S(ICDMCC=2:242,ICDMCC=1:243,1:244)
Q
DRG245 ;
S ICDRG=245 Q
DRG246 ;
DRG247 ;
DRG248 ;
DRG249 ;
Q
DRG250 ;
DRG251 S ICDRG=$S(ICDMCC=2:250,1:251) Q
DRG252 ;
DRG253 ;
DRG254 S ICDRG=$S(ICDMCC=2:252,ICDMCC=1:253,1:254) Q
DRG255 ;
DRG256 ;
DRG257 S ICDRG=$S(ICDMCC=2:255,ICDMCC=1:256,1:257) Q
DRG258 ;
DRG259 ;
S ICDRG=$S(ICDMCC=2:258,1:259) Q
DRG260 ;
DRG261 ;
DRG262 ;
S ICDRG=$S(ICDMCC=2:260,ICDMCC=1:261,1:262)
Q
DRG263 S ICDRG=263 Q
DRG264 S ICDRG=264 Q
DRG265 S ICDRG=265 Q
DRG266 ;
S ICDRG=266 Q
DRG267 ;
S ICDRG=267 Q
DRG268 ;
S ICDRG=268 Q
DRG269 ;
S ICDRG=269 Q
DRG270 ;
S ICDRG=270 Q
DRG271 ;
S ICDRG=271 Q
DRG272 ;
S ICDRG=272 Q
DRG273 ;
S ICDRG=273 Q
DRG274 ;
S ICDRG=274 Q
DRG275 ;
S ICDRG=275 Q
DRG276 ;
S ICDRG=276 Q
DRG277 ;
S ICDRG=277 Q
DRG278 ;
S ICDRG=278 Q
DRG279 ;
S ICDRG=279 Q
DRG280 ;
DRG281 ;
DRG282 ;
DRG283 ;
DRG284 ;
DRG285 ;
Q
DRG286 ;
DRG287 ;
S ICDRG=$S(ICDMCC=2:286,1:287) Q
DRG288 ;
DRG289 ;
DRG290 S ICDRG=$S(ICDMCC=2:288,ICDMCC=1:289,1:290) Q
DRG291 ;
DRG292 ;
DRG293 ;
S ICDRG=$S(ICDMCC=2:291,ICDMCC=1:292,1:293) Q
DRG294 ;
DRG295 S ICDRG=$S(ICDMCC>0:294,1:295) Q
DRG296 ;
DRG297 ;
DRG298 ;
S ICDRG=$S(ICDMCC=2:296,ICDMCC=1:297,1:298) Q
DRG299 ;
DRG300 ;
DRG301 ;
S ICDRG=$S(ICDMCC=2:299,ICDMCC=1:300,1:301) Q
Q
CMS115 ;convert DRG115^ICDTLB2C code - no MS-DRG 115 existed
D EN1^ICDDRG5
I ICDOR[7 S ICDRG=$S(ICDMCC=2:260,ICDMCC=1:261,1:262) Q
I ICDPD'["I"&(ICDOR'["p")&(ICDCC2=0)&(ICDCC3=0) D Q
.I ICDSD["V" S ICDMCC=0
.S ICDRG=$S(ICDMCC=2:291,ICDMCC=1:292,1:293)
I ICDCC2=1!(ICDCC3=1) D DRG242
I ((ICDRG>241)&(ICDRG<245)) Q
; ICDCC2 identifies AICD LEAD OR GNRTR
I ICDCC2=1!(ICDCC3=1) D Q
. S ICDRG=$S(ICDMCC=2:242,ICDMCC=1:243,1:244) Q
I ICDOR["p" D Q
. S ICDRG=$S(ICDMCC=2:242,ICDMCC=1:243,1:244) Q
Q
CMS516 ;convert DRG516^ICDTLB6C code - no MS-DRG 516 exists
S ICDRG=250
I '$D(ICDOP(" 36.06"))&'$D(ICDOP(" 92.27"))&'$D(ICDOP(" 36.07")) D DRG251
E D DRG248
I $D(ICDOP(" 36.07")) D DRG246
Q
MCV ; checks to see if case qualifies as an MCV (major cardiovascular complications or complex conditions)
S (ICDMCV,ICDMCV1,ICDMCV2)=0
; ICDPD=identifier for prime dx ICDSD=identifier for any secondary dx
; DGDX(1)=prime dx ICDDX(1)=ien of prime dx ICDDXT=any secondary dx
I ICDPD["c"!(ICDSD["c") S ICDMCV=1
I ICDSD["s" S ICDMCV=1
;I DGDX(1)["426.0"!(DGDX(1)["426.53")!(DGDX(1)["426.54") S ICDMCV1=1
I $G(ICDDX(1))=9056!($G(ICDDX(1))=2548)!($G(ICDDX(1))=2549) S ICDMCV1=1
I $D(ICDDXT("426.0"))!($D(ICDDXT("426.53")))!($D(ICDDXT("426.54"))) S ICDMCV1=1
;I DGDX(1)["411.1"!(DGDX(1)["411.81") S ICDMCV2=1
I $G(ICDDX(1))=2500!($G(ICDDX(1))=12477) S ICDMCV2=1
I $D(ICDDXT("411.1"))!($D(ICDDXT("411.81"))) S ICDMCV2=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD10TB2 3728 printed Apr 09, 2024@20:52:40 Page 2
ICD10TB2 ;KUM - GROUPER UTILITY FUNCTIONS;08/04/2015
+1 ;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21
+2 ;
+3 ;DRG200 ; D DRG200^ICDTBL2D -- See ICD10TB1
+4 ;DRG201 ;I ICDSD["c" S ICDRG=200 Q -- See ICD10TB1
DRG202 ;
DRG203 SET ICDRG=$SELECT(ICDMCC>0:202,1:203)
QUIT
DRG204 SET ICDRG=204
QUIT
DRG205 ;
DRG206 SET ICDRG=$SELECT(ICDMCC=2:205,1:206)
QUIT
DRG207 ;
DRG208 ;
DRG209 ;
DRG210 ;
+1 QUIT
DRG211 ;
+1 QUIT
DRG212 ;
+1 QUIT
DRG214 ;
DRG215 ;
DRG216 ;
DRG217 ;
DRG218 ;
DRG219 ;
DRG220 ;
+1 QUIT
DRG221 ;
DRG222 ;
DRG223 ;
DRG224 ;
DRG225 ;
DRG226 ;
DRG227 ;
+1 QUIT
DRG228 ;
DRG229 ;
DRG230 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:228,ICDMCC=1:229,1:230)
+2 QUIT
DRG231 ;
DRG232 ;
DRG233 ;
DRG234 ;
DRG235 ;
DRG236 ;
+1 QUIT
+2 ;DRG237 ;
+3 ;DRG238 ;
+4 ;S ICDRG=$S(ICDMCC=2:237,1:238)
+5 ;Q
DRG239 ;
DRG240 ;
DRG241 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:239,ICDMCC=1:240,1:241)
+2 QUIT
DRG242 ; called from CMS115
DRG243 ;
DRG244 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:242,ICDMCC=1:243,1:244)
+2 QUIT
DRG245 ;
+1 SET ICDRG=245
QUIT
DRG246 ;
DRG247 ;
DRG248 ;
DRG249 ;
+1 QUIT
DRG250 ;
DRG251 SET ICDRG=$SELECT(ICDMCC=2:250,1:251)
QUIT
DRG252 ;
DRG253 ;
DRG254 SET ICDRG=$SELECT(ICDMCC=2:252,ICDMCC=1:253,1:254)
QUIT
DRG255 ;
DRG256 ;
DRG257 SET ICDRG=$SELECT(ICDMCC=2:255,ICDMCC=1:256,1:257)
QUIT
DRG258 ;
DRG259 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:258,1:259)
QUIT
DRG260 ;
DRG261 ;
DRG262 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:260,ICDMCC=1:261,1:262)
+2 QUIT
DRG263 SET ICDRG=263
QUIT
DRG264 SET ICDRG=264
QUIT
DRG265 SET ICDRG=265
QUIT
DRG266 ;
+1 SET ICDRG=266
QUIT
DRG267 ;
+1 SET ICDRG=267
QUIT
DRG268 ;
+1 SET ICDRG=268
QUIT
DRG269 ;
+1 SET ICDRG=269
QUIT
DRG270 ;
+1 SET ICDRG=270
QUIT
DRG271 ;
+1 SET ICDRG=271
QUIT
DRG272 ;
+1 SET ICDRG=272
QUIT
DRG273 ;
+1 SET ICDRG=273
QUIT
DRG274 ;
+1 SET ICDRG=274
QUIT
DRG275 ;
+1 SET ICDRG=275
QUIT
DRG276 ;
+1 SET ICDRG=276
QUIT
DRG277 ;
+1 SET ICDRG=277
QUIT
DRG278 ;
+1 SET ICDRG=278
QUIT
DRG279 ;
+1 SET ICDRG=279
QUIT
DRG280 ;
DRG281 ;
DRG282 ;
DRG283 ;
DRG284 ;
DRG285 ;
+1 QUIT
DRG286 ;
DRG287 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:286,1:287)
QUIT
DRG288 ;
DRG289 ;
DRG290 SET ICDRG=$SELECT(ICDMCC=2:288,ICDMCC=1:289,1:290)
QUIT
DRG291 ;
DRG292 ;
DRG293 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:291,ICDMCC=1:292,1:293)
QUIT
DRG294 ;
DRG295 SET ICDRG=$SELECT(ICDMCC>0:294,1:295)
QUIT
DRG296 ;
DRG297 ;
DRG298 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:296,ICDMCC=1:297,1:298)
QUIT
DRG299 ;
DRG300 ;
DRG301 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:299,ICDMCC=1:300,1:301)
QUIT
+2 QUIT
CMS115 ;convert DRG115^ICDTLB2C code - no MS-DRG 115 existed
+1 DO EN1^ICDDRG5
+2 IF ICDOR[7
SET ICDRG=$SELECT(ICDMCC=2:260,ICDMCC=1:261,1:262)
QUIT
+3 IF ICDPD'["I"&(ICDOR'["p")&(ICDCC2=0)&(ICDCC3=0)
Begin DoDot:1
+4 IF ICDSD["V"
SET ICDMCC=0
+5 SET ICDRG=$SELECT(ICDMCC=2:291,ICDMCC=1:292,1:293)
End DoDot:1
QUIT
+6 IF ICDCC2=1!(ICDCC3=1)
DO DRG242
+7 IF ((ICDRG>241)&(ICDRG<245))
QUIT
+8 ; ICDCC2 identifies AICD LEAD OR GNRTR
+9 IF ICDCC2=1!(ICDCC3=1)
Begin DoDot:1
+10 SET ICDRG=$SELECT(ICDMCC=2:242,ICDMCC=1:243,1:244)
QUIT
End DoDot:1
QUIT
+11 IF ICDOR["p"
Begin DoDot:1
+12 SET ICDRG=$SELECT(ICDMCC=2:242,ICDMCC=1:243,1:244)
QUIT
End DoDot:1
QUIT
+13 QUIT
CMS516 ;convert DRG516^ICDTLB6C code - no MS-DRG 516 exists
+1 SET ICDRG=250
+2 IF '$DATA(ICDOP(" 36.06"))&'$DATA(ICDOP(" 92.27"))&'$DATA(ICDOP(" 36.07"))
DO DRG251
+3 IF '$TEST
DO DRG248
+4 IF $DATA(ICDOP(" 36.07"))
DO DRG246
+5 QUIT
MCV ; checks to see if case qualifies as an MCV (major cardiovascular complications or complex conditions)
+1 SET (ICDMCV,ICDMCV1,ICDMCV2)=0
+2 ; ICDPD=identifier for prime dx ICDSD=identifier for any secondary dx
+3 ; DGDX(1)=prime dx ICDDX(1)=ien of prime dx ICDDXT=any secondary dx
+4 IF ICDPD["c"!(ICDSD["c")
SET ICDMCV=1
+5 IF ICDSD["s"
SET ICDMCV=1
+6 ;I DGDX(1)["426.0"!(DGDX(1)["426.53")!(DGDX(1)["426.54") S ICDMCV1=1
+7 IF $GET(ICDDX(1))=9056!($GET(ICDDX(1))=2548)!($GET(ICDDX(1))=2549)
SET ICDMCV1=1
+8 IF $DATA(ICDDXT("426.0"))!($DATA(ICDDXT("426.53")))!($DATA(ICDDXT("426.54")))
SET ICDMCV1=1
+9 ;I DGDX(1)["411.1"!(DGDX(1)["411.81") S ICDMCV2=1
+10 IF $GET(ICDDX(1))=2500!($GET(ICDDX(1))=12477)
SET ICDMCV2=1
+11 IF $DATA(ICDDXT("411.1"))!($DATA(ICDDXT("411.81")))
SET ICDMCV2=1
+12 QUIT
