ICDTBL5D ;ALB/MJB - GROUPER UTILITY FUNCTIONS;08/09/2010
;;18.0;DRG Grouper;**56,69**;Oct 20, 2000;Build 4
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDTBL5D 2219 printed Dec 13, 2024@01:51:48 Page 2
ICDTBL5D ;ALB/MJB - GROUPER UTILITY FUNCTIONS;08/09/2010
+1 ;;18.0;DRG Grouper;**56,69**;Oct 20, 2000;Build 4
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
