Routine: ICD10TB4

ICD10TB4 ;KUM - GROUPER UTILITY FUNCTIONS;08/04/2015

 ;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21

DRG400 ;

DRG401 ;

DRG402 ;

DRG403 ;

DRG404 ;

DRG405 ;

DRG406 ;

DRG407 S ICDRG=$S(ICDMCC=2:405,ICDMCC=1:406,1:407) Q

DRG408 ;

DRG409 ;

DRG410 ;

 S ICDRG=$S(ICDMCC=2:408,ICDMCC=1:409,1:410) Q

DRG411 ;

DRG412 ;

DRG413 ;

DRG414 ;

DRG415 ;

DRG416 ;

DRG417 ;

DRG418 ;

DRG419 ;

DRG420 ;

DRG421 ;

DRG422 ;

 S ICDRG=$S(ICDMCC=2:420,ICDMCC=1:421,1:422) Q

DRG423 ;

DRG424 ;

DRG425 S ICDRG=$S(ICDMCC=2:423,ICDMCC=1:424,1:425) Q

DRG426 ;

DRG427 ;

DRG428 ;

DRG429 ;

DRG430 ;

DRG431 ;

DRG432 ;

DRG433 ;

DRG434 S ICDRG=$S(ICDMCC=2:432,ICDMCC=1:433,1:434) Q

DRG435 ;

DRG436 ;

DRG437 ;

 S ICDRG=$S(ICDMCC=2:435,ICDMCC=1:436,1:437) Q

DRG438 ;

DRG439 ;

DRG440 ;

 S ICDRG=$S(ICDMCC=2:438,ICDMCC=1:439,1:440) Q

DRG441 ;

DRG442 ;

DRG443 S ICDRG=$S(ICDMCC=2:441,ICDMCC=1:442,1:443) Q

DRG444 ;

DRG445 ;

DRG446 S ICDRG=$S(ICDMCC=2:444,ICDMCC=1:445,1:446) Q

DRG447 ;

DRG448 ;

DRG449 ;

DRG450 ;

DRG451 ;

DRG452 ;

DRG453 ;

DRG454 ;

DRG455 ;

 S ICDRG=$S(ICDMCC=2:453,ICDMCC=1:454,1:455) Q

DRG456 ;

DRG457 ;

DRG458 ;

 S ICDRG=$S(ICDMCC=2:456,ICDMCC=1:457,1:458) Q

DRG459 ;

DRG460 S ICDRG=$S(ICDMCC=2:459,1:460) Q

DRG461 ;

DRG462 ;

 S ICDRG=$S(ICDMCC=2:461,1:462) Q

DRG463 ;

DRG464 ;

DRG465 S ICDRG=$S(ICDMCC=2:463,ICDMCC=1:464,1:465) Q

DRG466 ;

DRG467 ;

DRG468 S ICDRG=$S(ICDMCC=2:466,ICDMCC=1:467,1:468) Q

DRG469 ;

DRG470 ;

 S ICDRG=$S(ICDMCC=2:469,1:470) Q

DRG471 ;

DRG472 ;

DRG473 S ICDRG=$S(ICDMCC=2:471,ICDMCC=1:472,1:473) Q

DRG474 ;

DRG475 ;

DRG476 S ICDRG=$S(ICDMCC=2:474,ICDMCC=1:475,1:476) Q

DRG477 ;

DRG478 ;

DRG479 S ICDRG=$S(ICDMCC=2:477,ICDMCC=1:478,1:479) Q

DRG480 ;

DRG481 ;

DRG482 S ICDRG=$S(ICDMCC=2:480,ICDMCC=1:481,1:482) Q

DRG483 S ICDRG=483 Q

 ;DRG484 S ICDRG=$S(ICDMCC>0:483,1:484) Q

DRG485 ;

DRG486 ;

DRG487 ;

DRG488 ;

DRG489 ;

 I $D(ICD10PD("k")) S ICDRG=$S(ICDMCC=2:485,ICDMCC=1:486,1:487) Q

 S ICDRG=$S(ICDMCC>0:488,1:489)

 ;DRG490 ;

 ;DRG491 ;

DRG492 ;

DRG493 ;

DRG494 S ICDRG=$S(ICDMCC=2:492,ICDMCC=1:493,1:494) Q

DRG495 ;

DRG496 ;

DRG497 S ICDRG=$S(ICDMCC=2:495,ICDMCC=1:496,1:497) Q

DRG498 ;

DRG499 S ICDRG=$S(ICDMCC>0:498,1:499) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD10TB4   2278     printed  Sep 23, 2025@19:23:01                                                                                                                                                                                                    Page 2

ICD10TB4  ;KUM - GROUPER UTILITY FUNCTIONS;08/04/2015

 +1       ;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21

 +2       ;

DRG400    ;

DRG401    ;

DRG402    ;

DRG403    ;

DRG404    ;

 +1        QUIT

DRG405    ;

DRG406    ;

DRG407     SET ICDRG=$SELECT(ICDMCC=2:405,ICDMCC=1:406,1:407)

           QUIT

DRG408    ;

DRG409    ;

DRG410    ;

 +1        SET ICDRG=$SELECT(ICDMCC=2:408,ICDMCC=1:409,1:410)

           QUIT

 +2        QUIT

DRG411    ;

DRG412    ;

DRG413    ;

DRG414    ;

DRG415    ;

DRG416    ;

DRG417    ;

DRG418    ;

DRG419    ;

 +1        QUIT

DRG420    ;

DRG421    ;

DRG422    ;

 +1        SET ICDRG=$SELECT(ICDMCC=2:420,ICDMCC=1:421,1:422)

           QUIT

DRG423    ;

DRG424    ;

DRG425     SET ICDRG=$SELECT(ICDMCC=2:423,ICDMCC=1:424,1:425)

           QUIT

DRG426    ;

DRG427    ;

DRG428    ;

DRG429    ;

DRG430    ;

DRG431    ;

 +1        QUIT

DRG432    ;

DRG433    ;

DRG434     SET ICDRG=$SELECT(ICDMCC=2:432,ICDMCC=1:433,1:434)

           QUIT

DRG435    ;

DRG436    ;

DRG437    ;

 +1        SET ICDRG=$SELECT(ICDMCC=2:435,ICDMCC=1:436,1:437)

           QUIT

DRG438    ;

DRG439    ;

DRG440    ;

 +1        SET ICDRG=$SELECT(ICDMCC=2:438,ICDMCC=1:439,1:440)

           QUIT

DRG441    ;

DRG442    ;

DRG443     SET ICDRG=$SELECT(ICDMCC=2:441,ICDMCC=1:442,1:443)

           QUIT

DRG444    ;

DRG445    ;

DRG446     SET ICDRG=$SELECT(ICDMCC=2:444,ICDMCC=1:445,1:446)

           QUIT

DRG447    ;

DRG448    ;

DRG449    ;

DRG450    ;

DRG451    ;

DRG452    ;

DRG453    ;

DRG454    ;

DRG455    ;

 +1        SET ICDRG=$SELECT(ICDMCC=2:453,ICDMCC=1:454,1:455)

           QUIT

DRG456    ;

DRG457    ;

DRG458    ;

 +1        SET ICDRG=$SELECT(ICDMCC=2:456,ICDMCC=1:457,1:458)

           QUIT

DRG459    ;

DRG460     SET ICDRG=$SELECT(ICDMCC=2:459,1:460)

           QUIT

DRG461    ;

DRG462    ;

 +1        SET ICDRG=$SELECT(ICDMCC=2:461,1:462)

           QUIT

DRG463    ;

DRG464    ;

DRG465     SET ICDRG=$SELECT(ICDMCC=2:463,ICDMCC=1:464,1:465)

           QUIT

DRG466    ;

DRG467    ;

DRG468     SET ICDRG=$SELECT(ICDMCC=2:466,ICDMCC=1:467,1:468)

           QUIT

DRG469    ;

DRG470    ;

 +1        SET ICDRG=$SELECT(ICDMCC=2:469,1:470)

           QUIT

DRG471    ;

DRG472    ;

DRG473     SET ICDRG=$SELECT(ICDMCC=2:471,ICDMCC=1:472,1:473)

           QUIT

DRG474    ;

DRG475    ;

DRG476     SET ICDRG=$SELECT(ICDMCC=2:474,ICDMCC=1:475,1:476)

           QUIT

DRG477    ;

DRG478    ;

DRG479     SET ICDRG=$SELECT(ICDMCC=2:477,ICDMCC=1:478,1:479)

           QUIT

DRG480    ;

DRG481    ;

DRG482     SET ICDRG=$SELECT(ICDMCC=2:480,ICDMCC=1:481,1:482)

           QUIT

DRG483     SET ICDRG=483

           QUIT

 +1       ;DRG484 S ICDRG=$S(ICDMCC>0:483,1:484) Q

DRG485    ;

DRG486    ;

DRG487    ;

DRG488    ;

DRG489    ;

 +1        IF $DATA(ICD10PD("k"))

               SET ICDRG=$SELECT(ICDMCC=2:485,ICDMCC=1:486,1:487)

               QUIT

 +2        SET ICDRG=$SELECT(ICDMCC>0:488,1:489)

 +3        QUIT

 +4       ;DRG490 ;

 +5       ;DRG491 ;

DRG492    ;

DRG493    ;

DRG494     SET ICDRG=$SELECT(ICDMCC=2:492,ICDMCC=1:493,1:494)

           QUIT

DRG495    ;

DRG496    ;

DRG497     SET ICDRG=$SELECT(ICDMCC=2:495,ICDMCC=1:496,1:497)

           QUIT

DRG498    ;

DRG499     SET ICDRG=$SELECT(ICDMCC>0:498,1:499)

           QUIT

 +1        QUIT

ICD10TB4.m