ICDTBL5D.m

ICDTBL5D ;ALB/MJB - GROUPER UTILITY FUNCTIONS;08/09/2010

 ;;18.0;DRG Grouper;**56,69**;Oct 20, 2000;Build 7

DRG500 ;

DRG501 ;

DRG502 S ICDRG=$S(ICDMCC=2:500,ICDMCC=1:501,1:502) Q

DRG503 ;

DRG504 ;

DRG505 S ICDRG=$S(ICDMCC=2:503,ICDMCC=1:504,1:505) Q

DRG506 I ICDOR["O2" D DRG513  Q

       S ICDRG=506 Q

DRG507 ;

DRG508 S ICDRG=$S(ICDMCC>0:507,1:508) Q

DRG509 S ICDRG=509 Q

DRG510 ;

DRG511 ;

DRG512 S ICDRG=$S(ICDMCC=2:510,ICDMCC=1:511,1:512) Q

DRG513 ;

DRG514 S ICDRG=$S(ICDMCC>0:513,1:514) Q

DRG515 ;

DRG516 ;

DRG517 S ICDRG=$S(ICDMCC=2:515,ICDMCC=1:516,1:517) Q

DRG533 ;

DRG534 S ICDRG=$S(ICDMCC=2:533,1:534) Q

DRG535 ;

DRG536 S ICDRG=$S(ICDMCC=2:535,1:536) Q

DRG537 ;

DRG538 S ICDRG=$S(ICDMCC>0:537,1:538) Q

DRG539 ;

DRG540 ;

DRG541 S ICDRG=$S(ICDMCC=2:539,ICDMCC=1:540,1:541) Q

DRG542 ;

DRG543 ;

DRG544 S ICDRG=$S(ICDMCC=2:542,ICDMCC=1:543,1:544) Q

DRG545 ;

DRG546 ;

DRG547 S ICDRG=$S(ICDMCC=2:545,ICDMCC=1:546,1:547) Q

DRG548 ;

DRG549 ;

DRG550 S ICDRG=$S(ICDMCC=2:548,ICDMCC=1:549,1:550) Q

DRG551 ;

DRG552 S ICDRG=$S(ICDMCC=2:551,1:552) Q

DRG553 ;

DRG554 S ICDRG=$S(ICDMCC=2:553,1:554) Q

DRG555 ;

DRG556 S ICDRG=$S(ICDMCC=2:555,1:556) Q

DRG557 ;

DRG558 S ICDRG=$S(ICDMCC=2:557,1:558) Q

DRG559 ;

DRG560 ;

DRG561 S ICDRG=$S(ICDMCC=2:559,ICDMCC=1:560,1:561) Q

DRG562 ;

DRG563 S ICDRG=$S(ICDMCC=2:562,1:563) Q

DRG564 ;

DRG565 ;

DRG566 S ICDRG=$S(ICDMCC=2:564,ICDMCC=1:565,1:566) Q

DRG570 ;

DRG571 ;

DRG572 S ICDRG=$S(ICDMCC=2:570,ICDMCC=1:571,1:572) Q

DRG573 ;

DRG574 ;

DRG575 I ICDOR'["O" D DRG592 Q 

       I ICDPD["U" S ICDRG=$S(ICDMCC=2:573,ICDMCC=1:574,1:575) Q

DRG576 ;

DRG577 ;

DRG578 S ICDRG=$S(ICDMCC=2:576,ICDMCC=1:577,1:578) Q

DRG579 ;

DRG580 ;

DRG581 S ICDRG=$S(ICDMCC=2:579,ICDMCC=1:580,1:581) Q

DRG582 ;

DRG583 I ICDPD["M"!(ICDSD["M") S ICDRG=$S(ICDMCC>0:582,1:583) Q

 E  G DRG584

DRG584 ;

DRG585 I ICDOR["M"!(ICDOR["m") S ICDRG=$S(ICDMCC>0:584,1:585) Q

 E  S ICDRG="" Q

DRG592 ;

DRG593 ;I ICDPD["U" S ICDRG=$S(ICDMCC>0:593,1:594) Q

DRG594 S ICDRG=$S(ICDMCC=2:592,ICDMCC=1:593,1:594) Q

DRG595 ;

DRG596 S ICDRG=$S(ICDMCC=2:595,1:596) Q

DRG597 ;

DRG598 ;

DRG599 I ICDPD["r" S ICDRG=$S(ICDMCC=2:597,ICDMCC=1:598,1:599) Q

 Q

ICDTBL5D  ;ALB/MJB - GROUPER UTILITY FUNCTIONS;08/09/2010

 +1       ;;18.0;DRG Grouper;**56,69**;Oct 20, 2000;Build 7

DRG500    ;

DRG501    ;

DRG502     SET ICDRG=$SELECT(ICDMCC=2:500,ICDMCC=1:501,1:502)

           QUIT 

DRG503    ;

DRG504    ;

DRG505     SET ICDRG=$SELECT(ICDMCC=2:503,ICDMCC=1:504,1:505)

           QUIT 

DRG506     IF ICDOR["O2"

               DO DRG513

               QUIT 

 +1        SET ICDRG=506

           QUIT 

DRG507    ;

DRG508     SET ICDRG=$SELECT(ICDMCC>0:507,1:508)

           QUIT 

DRG509     SET ICDRG=509

           QUIT 

DRG510    ;

DRG511    ;

DRG512     SET ICDRG=$SELECT(ICDMCC=2:510,ICDMCC=1:511,1:512)

           QUIT 

DRG513    ;

DRG514     SET ICDRG=$SELECT(ICDMCC>0:513,1:514)

           QUIT 

DRG515    ;

DRG516    ;

DRG517     SET ICDRG=$SELECT(ICDMCC=2:515,ICDMCC=1:516,1:517)

           QUIT 

DRG533    ;

DRG534     SET ICDRG=$SELECT(ICDMCC=2:533,1:534)

           QUIT 

DRG535    ;

DRG536     SET ICDRG=$SELECT(ICDMCC=2:535,1:536)

           QUIT 

DRG537    ;

DRG538     SET ICDRG=$SELECT(ICDMCC>0:537,1:538)

           QUIT 

DRG539    ;

DRG540    ;

DRG541     SET ICDRG=$SELECT(ICDMCC=2:539,ICDMCC=1:540,1:541)

           QUIT 

DRG542    ;

DRG543    ;

DRG544     SET ICDRG=$SELECT(ICDMCC=2:542,ICDMCC=1:543,1:544)

           QUIT 

DRG545    ;

DRG546    ;

DRG547     SET ICDRG=$SELECT(ICDMCC=2:545,ICDMCC=1:546,1:547)

           QUIT 

DRG548    ;

DRG549    ;

DRG550     SET ICDRG=$SELECT(ICDMCC=2:548,ICDMCC=1:549,1:550)

           QUIT 

DRG551    ;

DRG552     SET ICDRG=$SELECT(ICDMCC=2:551,1:552)

           QUIT 

DRG553    ;

DRG554     SET ICDRG=$SELECT(ICDMCC=2:553,1:554)

           QUIT 

DRG555    ;

DRG556     SET ICDRG=$SELECT(ICDMCC=2:555,1:556)

           QUIT 

DRG557    ;

DRG558     SET ICDRG=$SELECT(ICDMCC=2:557,1:558)

           QUIT 

DRG559    ;

DRG560    ;

DRG561     SET ICDRG=$SELECT(ICDMCC=2:559,ICDMCC=1:560,1:561)

           QUIT 

DRG562    ;

DRG563     SET ICDRG=$SELECT(ICDMCC=2:562,1:563)

           QUIT 

DRG564    ;

DRG565    ;

DRG566     SET ICDRG=$SELECT(ICDMCC=2:564,ICDMCC=1:565,1:566)

           QUIT 

DRG570    ;

DRG571    ;

DRG572     SET ICDRG=$SELECT(ICDMCC=2:570,ICDMCC=1:571,1:572)

           QUIT 

DRG573    ;

DRG574    ;

DRG575     IF ICDOR'["O"

               DO DRG592

               QUIT 

 +1        IF ICDPD["U"

               SET ICDRG=$SELECT(ICDMCC=2:573,ICDMCC=1:574,1:575)

               QUIT 

DRG576    ;

DRG577    ;

DRG578     SET ICDRG=$SELECT(ICDMCC=2:576,ICDMCC=1:577,1:578)

           QUIT 

DRG579    ;

DRG580    ;

DRG581     SET ICDRG=$SELECT(ICDMCC=2:579,ICDMCC=1:580,1:581)

           QUIT 

DRG582    ;

DRG583     IF ICDPD["M"!(ICDSD["M")

               SET ICDRG=$SELECT(ICDMCC>0:582,1:583)

               QUIT 

 +1       IF '$TEST

               GOTO DRG584

DRG584    ;

DRG585     IF ICDOR["M"!(ICDOR["m")

               SET ICDRG=$SELECT(ICDMCC>0:584,1:585)

               QUIT 

 +1       IF '$TEST

               SET ICDRG=""

               QUIT 

DRG592    ;

DRG593    ;I ICDPD["U" S ICDRG=$S(ICDMCC>0:593,1:594) Q

DRG594     SET ICDRG=$SELECT(ICDMCC=2:592,ICDMCC=1:593,1:594)

           QUIT 

DRG595    ;

DRG596     SET ICDRG=$SELECT(ICDMCC=2:595,1:596)

           QUIT 

DRG597    ;

DRG598    ;

DRG599     IF ICDPD["r"

               SET ICDRG=$SELECT(ICDMCC=2:597,ICDMCC=1:598,1:599)

               QUIT 

 +1        QUIT