[628] | 1 | ICDTBL0 ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS ; 10/30/07 3:36pm
|
---|
| 2 | ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
|
---|
| 3 | DRG1 ;line tag for 001,002
|
---|
| 4 | DRG2 ;
|
---|
| 5 | S ICDRG=$S(ICDMCC=2:1,1:2) Q
|
---|
| 6 | DRG3 S ICDRG=3 Q
|
---|
| 7 | DRG4 S ICDRG=4 Q
|
---|
| 8 | DRG5 ;line tag for 005,006
|
---|
| 9 | DRG6 S ICDRG=$S(ICDMCC=2:5,1:6) D Q
|
---|
| 10 | . I $D(ICDOP(" 46.97")) S ICDRG=5
|
---|
| 11 | DRG7 S ICDRG=7 Q
|
---|
| 12 | DRG8 S ICDRG=8 Q
|
---|
| 13 | DRG9 S ICDRG=9 Q
|
---|
| 14 | DRG10 S ICDRG=10 Q
|
---|
| 15 | DRG11 ;line tag for 011,012,013
|
---|
| 16 | DRG12 ;
|
---|
| 17 | DRG13 ;
|
---|
| 18 | S ICDRG=$S(ICDMCC=2:11,ICDMCC=1:12,1:13) Q
|
---|
| 19 | DRG20 ;line tag for 020,021,022
|
---|
| 20 | DRG21 ;
|
---|
| 21 | DRG22 ;
|
---|
| 22 | S ICDRG=$S((ICDPD["K")&(ICDOR["K")&(ICDMCC=2):20,(ICDPD["K")&(ICDOR["K")&(ICDMCC=1):21,(ICDPD["K")&(ICDOR["K"):22,1:ICDRG) Q
|
---|
| 23 | DRG23 ;line tag for 023,024
|
---|
| 24 | DRG24 ;
|
---|
| 25 | S ICDRG=$S($D(ICDOP(" 00.10")):23,1:ICDRG) Q:(ICDRG=23)
|
---|
| 26 | S ICDRG=$S((ICDPD["Q")&(ICDOR["Q")&(ICDMCC=2):23,(ICDPD["Q")&(ICDOR["Q"):24,1:ICDRG) Q:(ICDRG=23)
|
---|
| 27 | S ICDRG=$S($D(ICDOP(" 02.93"))&($D(ICDOP(" 86.95")))&(ICDMCC=2):23,$D(ICDOP(" 02.93"))&($D(ICDOP(" 86.95"))):24,1:ICDRG)
|
---|
| 28 | Q
|
---|
| 29 | DRG25 ;line tag for 025,026,027
|
---|
| 30 | DRG26 ;
|
---|
| 31 | DRG27 ;
|
---|
| 32 | D DRG20 D:'((ICDRG>19)&(ICDRG<23)) DRG23 D:'((ICDRG>22)&(ICDRG<25)) DRG31
|
---|
| 33 | S ICDRG=$S(ICDRG=20:20,ICDRG=21:21,ICDRG=22:22,ICDRG=23:23,ICDRG=24:24,ICDRG=31:31,ICDRG=32:32,ICDRG=33:33,ICDMCC=2:25,ICDMCC=1:26,1:27)
|
---|
| 34 | I $D(ICDOP(" 00.62")),'$D(ICDOP(" 00.65")) S ICDRG=999
|
---|
| 35 | Q
|
---|
| 36 | DRG28 ;line tag for 028,029,030
|
---|
| 37 | DRG29 ;
|
---|
| 38 | DRG30 ;
|
---|
| 39 | S ICDRG=$S(ICDMCC=2:28,ICDMCC=1:29,1:30) D Q
|
---|
| 40 | . I $D(ICDOP(" 03.93")),$D(ICDOP(" 86.94")) S ICDRG=29
|
---|
| 41 | . I $D(ICDOP(" 03.93")),$D(ICDOP(" 86.95")) S ICDRG=29
|
---|
| 42 | . I $D(ICDOP(" 03.93")),$D(ICDOP(" 86.97")) S ICDRG=29
|
---|
| 43 | . I $D(ICDOP(" 03.93")),$D(ICDOP(" 86.98")) S ICDRG=29
|
---|
| 44 | DRG31 ;line tag for 031,032,033
|
---|
| 45 | DRG32 ;
|
---|
| 46 | DRG33 ;
|
---|
| 47 | S ICDRG=$S((ICDOR["S")&(ICDMCC=2):31,(ICDOR["S")&(ICDMCC=1):32,ICDOR["S":33,1:ICDRG) Q
|
---|
| 48 | DRG34 ;line tag for 034,035,036
|
---|
| 49 | DRG35 ;
|
---|
| 50 | DRG36 ;
|
---|
| 51 | S ICDRG=$S(ICDMCC=2:34,ICDMCC=1:35,1:36) Q
|
---|
| 52 | DRG37 ;line tag for 037,038,039
|
---|
| 53 | DRG38 ;
|
---|
| 54 | DRG39 ;
|
---|
| 55 | S ICDRG=$S(ICDMCC=2:37,ICDMCC=1:38,1:39) D Q
|
---|
| 56 | . I $D(ICDOP(" 00.61"))&($D(ICDOP(" 00.63")))&(ICDMCC=2) S ICDRG=34
|
---|
| 57 | . I $D(ICDOP(" 00.61"))&($D(ICDOP(" 00.63")))&(ICDMCC=1) S ICDRG=35
|
---|
| 58 | . I $D(ICDOP(" 00.61"))&($D(ICDOP(" 00.63"))) S ICDRG=36
|
---|
| 59 | DRG40 ;line tag for 040,041,042
|
---|
| 60 | DRG41 ;
|
---|
| 61 | DRG42 ;
|
---|
| 62 | S ICDRG=$S(ICDMCC=2:40,ICDMCC=1:41,1:42) D Q
|
---|
| 63 | . I $D(ICDOP(" 04.92")),$D(ICOP(" 86.94")) S ICDRG=41
|
---|
| 64 | . I $D(ICDOP(" 04.92")),$D(ICOP(" 86.95")) S ICDRG=41
|
---|
| 65 | . I $D(ICDOP(" 04.92")),$D(ICOP(" 86.97")) S ICDRG=41
|
---|
| 66 | . I $D(ICDOP(" 04.92")),$D(ICOP(" 86.98")) S ICDRG=41
|
---|
| 67 | DRG52 ;line tag for 052,053
|
---|
| 68 | DRG53 ;
|
---|
| 69 | S ICDRG=$S(ICDMCC>0:52,1:53) Q
|
---|
| 70 | DRG54 ;line tag for 054,055
|
---|
| 71 | DRG55 ;
|
---|
| 72 | S ICDRG=$S(ICDMCC=2:54,1:55) Q
|
---|
| 73 | DRG56 ;line taf for 056,057
|
---|
| 74 | DRG57 ;
|
---|
| 75 | S ICDRG=$S(ICDMCC=2:56,1:57) Q
|
---|
| 76 | DRG58 ;line tag for 058,059,060
|
---|
| 77 | DRG59 ;
|
---|
| 78 | DRG60 ;
|
---|
| 79 | S ICDRG=$S(ICDMCC=2:58,ICDMCC=1:59,1:60) Q
|
---|
| 80 | DRG61 ;line tag for 061,062,063
|
---|
| 81 | DRG62 ;
|
---|
| 82 | DRG63 ;
|
---|
| 83 | S ICDRG=$S(ICDMCC=2:61,ICDMCC=1:62,1:63) Q
|
---|
| 84 | DRG64 ;line tag for 064,065,066
|
---|
| 85 | DRG65 ;
|
---|
| 86 | DRG66 ;
|
---|
| 87 | S ICDRG=$S(ICDMCC=2:64,ICDMCC=1:65,1:66) Q
|
---|
| 88 | DRG67 ;line tag for 067,068
|
---|
| 89 | DRG68 ;
|
---|
| 90 | S ICDRG=$S(ICDMCC=2:67,1:68) Q
|
---|
| 91 | DRG69 S ICDRG=69 Q
|
---|
| 92 | DRG70 ;line tag for 070,071,072
|
---|
| 93 | DRG71 ;
|
---|
| 94 | DRG72 ;
|
---|
| 95 | S ICDRG=$S(ICDMCC=2:70,ICDMCC=1:71,1:72) Q
|
---|
| 96 | DRG73 ;line tag for 073,074
|
---|
| 97 | DRG74 ;
|
---|
| 98 | S ICDRG=$S(ICDMCC=2:73,1:74) Q
|
---|
| 99 | DRG75 ;line tag for 075,076
|
---|
| 100 | DRG76 ;
|
---|
| 101 | S ICDRG=$S(ICDMCC>0:75,1:76) Q
|
---|
| 102 | DRG77 ;line tag for 077,078,079
|
---|
| 103 | DRG78 ;
|
---|
| 104 | DRG79 ;
|
---|
| 105 | S ICDRG=$S(ICDMCC=2:77,ICDMCC=1:78,1:79) Q
|
---|
| 106 | DRG80 ;line tag for 080,081
|
---|
| 107 | DRG81 ;
|
---|
| 108 | S ICDRG=$S(ICDMCC=2:80,1:81) Q
|
---|
| 109 | DRG82 ;line tag for 082,083,084
|
---|
| 110 | DRG83 ;
|
---|
| 111 | DRG84 ;
|
---|
| 112 | S ICDRG=$S(ICDMCC=2:82,ICDMCC=1:83,1:84) Q
|
---|
| 113 | DRG85 ;line tag for 085,086,087
|
---|
| 114 | DRG86 ;
|
---|
| 115 | DRG87 ;
|
---|
| 116 | S ICDRG=$S(ICDMCC=2:85,ICDMCC=1:86,1:87) Q
|
---|
| 117 | DRG88 ;line tag for 088,089,090
|
---|
| 118 | DRG89 ;
|
---|
| 119 | DRG90 ;
|
---|
| 120 | S ICDRG=$S(ICDMCC=2:88,ICDMCC=1:89,1:90) Q
|
---|
| 121 | DRG91 ;line tag for 091,092,093
|
---|
| 122 | DRG92 ;
|
---|
| 123 | DRG93 ;
|
---|
| 124 | S ICDRG=$S(ICDMCC=2:91,ICDMCC=1:92,1:93) Q
|
---|
| 125 | DRG94 ;line tag for 094,095,096
|
---|
| 126 | DRG95 ;
|
---|
| 127 | DRG96 ;
|
---|
| 128 | S ICDRG=$S(ICDMCC=2:94,ICDMCC=1:95,1:96) Q
|
---|
| 129 | DRG97 ;line tag for 097,098,099
|
---|
| 130 | DRG98 ;
|
---|
| 131 | DRG99 ;
|
---|
| 132 | S ICDRG=$S(ICDMCC=2:97,ICDMCC=1:98,1:99) Q
|
---|
| 133 | Q
|
---|