ICD10TB2.m

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 ---ICD10TB2   3728     printed  Mar 13, 2025@20:51:39                                                                                                                                                                                                    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