[628] | 1 | ICDTBL2 ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS ; 11/13/07 4:13pm
|
---|
| 2 | ;;18.0;DRG Grouper;**31,32**;Oct 20, 2000;Build 9
|
---|
| 3 | DRG200 ;
|
---|
| 4 | DRG201 S ICDRG=$S(ICDMCC=2:199,ICDMCC=1:200,1:201) Q
|
---|
| 5 | DRG202 ;
|
---|
| 6 | DRG203 S ICDRG=$S(ICDMCC>0:202,1:203) Q
|
---|
| 7 | DRG204 S ICDRG=204 Q
|
---|
| 8 | DRG205 ;
|
---|
| 9 | DRG206 S ICDRG=$S(ICDMCC=2:205,1:206) Q
|
---|
| 10 | DRG207 S ICDRG=207 Q
|
---|
| 11 | DRG208 S ICDRG=208 Q
|
---|
| 12 | DRG215 S ICDRG=215 Q
|
---|
| 13 | DRG216 ;valve procedures
|
---|
| 14 | N ICDE1,ICDE2
|
---|
| 15 | S ICDE1=$S($D(ICDOP(" 37.95"))&($D(ICDOP(" 37.96"))):1,1:0),ICDE2=$S($D(ICDOP(" 37.97"))&($D(ICDOP(" 37.98"))):1,1:0)
|
---|
| 16 | S:ICDOR["H" ICDRG=$S(ICDOR["N"&ICDE1:218,ICDOR["N"&ICDE2:218,ICDOR["O":218,1:ICDRG)
|
---|
| 17 | S:ICDOR'["H" ICDRG=$S(ICDOR["N"&ICDE1:221,ICDOR["N"&ICDE2:221,ICDOR["O":221,1:ICDRG)
|
---|
| 18 | I ICDOR["P"&(ICDE1+ICDE2=0) S ICDRG=$S(ICDOR["H":218,1:221)
|
---|
| 19 | S:ICDRG=218 ICDRG=$S(ICDMCC=2:216,ICDMCC=1:217,1:218)
|
---|
| 20 | S:ICDRG=221 ICDRG=$S(ICDMCC=2:219,ICDMCC=1:220,1:221)
|
---|
| 21 | Q
|
---|
| 22 | DRG217 D DRG216 Q
|
---|
| 23 | DRG218 D DRG216 Q
|
---|
| 24 | DRG219 D DRG216 Q
|
---|
| 25 | DRG220 D DRG216 Q
|
---|
| 26 | DRG221 D DRG216 Q
|
---|
| 27 | DRG222 N ICDE1,ICDE2,ICDE3,ICDE4
|
---|
| 28 | S ICDE1=$S($D(ICDOP(" 37.95"))&(($D(ICDOP(" 37.96")))!($D(ICDOP(" 00.54")))):1,1:0)
|
---|
| 29 | S ICDE2=$S($D(ICDOP(" 37.97"))&(($D(ICDOP(" 37.98")))!($D(ICDOP(" 00.54")))):1,1:0)
|
---|
| 30 | S ICDE3=$S($D(ICDOP(" 00.52"))&($D(ICDOP(" 00.54"))):1,1:0)
|
---|
| 31 | ;S ICDE4=$S($D(ICDOP(" 00.54"))&($D(ICDOP(" 37.95"))):1,1:0)
|
---|
| 32 | S ICDE4=$S($D(ICDOP(" 37.74"))&(($D(ICDOP(" 37.96")))!($D(ICDOP(" 37.98")))!($D(ICDOP(" 00.54")))):1,1:0)
|
---|
| 33 | S ICDRG=999
|
---|
| 34 | I $D(ICDOP(" 37.94"))!$D(ICDOP(" 00.51")) I ICDE1+ICDE2+ICDE3+ICDE4=0 D
|
---|
| 35 | . S ICDRG=$S(ICDMCC=2:226,1:227)
|
---|
| 36 | I '$D(ICDOP(" 37.94"))&('$D(ICDOP(" 00.51"))) I ICDE1!ICDE2!ICDE3!ICDE4
|
---|
| 37 | D
|
---|
| 38 | . S ICDRG=$S(ICDMCC=2:226,1:227)
|
---|
| 39 | ; "HN" in ICDOR represents OR proc 37.21-.23, 37.26, 88.52-.58
|
---|
| 40 | I (ICDRG=226)!(ICDRG=227) I ICDOR["HN" I '$D(ICDOP(" 37.26")) S ICDRG=$S((ICDPD["A")&(ICDMCC=2):222,ICDPD["A":223,ICDMCC=2:224,1:225)
|
---|
| 41 | I ICDRG=470 D CMS115
|
---|
| 42 | Q
|
---|
| 43 | DRG223 D DRG222 Q
|
---|
| 44 | DRG224 ;
|
---|
| 45 | DRG225 D DRG222 Q
|
---|
| 46 | DRG226 ;
|
---|
| 47 | DRG227 D DRG222 Q
|
---|
| 48 | DRG228 ;
|
---|
| 49 | DRG229 ;
|
---|
| 50 | DRG230 ;DRGs 228-230 note ICDOR["Oo" = operation and DRG CMS108/MS230 procedure
|
---|
| 51 | I ICDOR["Oo"!($D(ICDOP(" 38.44"))&($D(ICDOP(" 38.45")))) D Q
|
---|
| 52 | . S ICDRG=$S(ICDMCC=2:228,ICDMCC=1:229,1:230) Q
|
---|
| 53 | G DRG237
|
---|
| 54 | DRG231 S ICDRG=999
|
---|
| 55 | I ICDOR["b" D DRG235
|
---|
| 56 | I ICDOR["b" I $D(ICDOP(" 35.96"))!($D(ICDOP(" 00.66"))) D Q
|
---|
| 57 | . S ICDRG=$S(ICDMCC=2:231,1:232)
|
---|
| 58 | I ICDOR["b" I $D(ICDOP(" 37.21"))!($D(ICDOP(" 37.22")))!($D(ICDOP(" 37.23"))) D DRG233 Q
|
---|
| 59 | I ICDOR["b" I $D(ICDOP(" 37.21"))!($D(ICDOP(" 37.22")))!($D(ICDOP(" 37.23"))) D DRG233 Q
|
---|
| 60 | I ICDRG'=231&(ICDRG'=232)&(ICDRG'=233)&(ICDRG'=234)&(ICDRG'=235)&(ICDRG'=236) S ICDRG=999 D DRG237
|
---|
| 61 | Q
|
---|
| 62 | DRG232 D DRG231 Q
|
---|
| 63 | DRG233 ; called from DRG231
|
---|
| 64 | D MCV
|
---|
| 65 | S ICDRG=$S(ICDMCV:233,ICDMCV1:233,1:234)
|
---|
| 66 | S ICDRG=$S(ICDMCC=2:233,1:234)
|
---|
| 67 | Q
|
---|
| 68 | DRG234 D DRG233 Q
|
---|
| 69 | DRG235 ;
|
---|
| 70 | DRG236 S ICDRG=$S(ICDMCC=2:235,1:236) Q
|
---|
| 71 | DRG237 I ICDOR["Oo" D DRG228
|
---|
| 72 | S ICDRG=$S((ICDMCC=2)&(ICDOR[7):237,ICDOR[7:238,1:ICDRG)
|
---|
| 73 | I $D(ICDOP(" 39.73")) S ICDRG=237
|
---|
| 74 | I "228^229^230^237^238"[ICDRG Q
|
---|
| 75 | ;I $D(ICDJJ(478))&('$D(ICDJJ(110))&'($D(ICDJJ(111)))) D DRG478^ICDTLB6C
|
---|
| 76 | D DRG239 I "239^240^241"[ICDRG Q
|
---|
| 77 | I ICDOR["p" D DRG260
|
---|
| 78 | I ICDOR["1" D CMS516
|
---|
| 79 | Q
|
---|
| 80 | DRG238 S ICDRG=$S(ICDMCC=2:237,1:238) D Q
|
---|
| 81 | . I $D(ICDOP(" 39.73")) S ICDRG=237
|
---|
| 82 | DRG239 ;239-241
|
---|
| 83 | DRG240 ;
|
---|
| 84 | DRG241 S ICDRG=$S($D(ICDJJ(241)):241,1:ICDRG)
|
---|
| 85 | I ICDRG=241 S ICDRG=$S(ICDMCC=2:239,ICDMCC=1:240,1:241)
|
---|
| 86 | Q
|
---|
| 87 | DRG242 ; called from CMS115
|
---|
| 88 | D MCV
|
---|
| 89 | I ICDMCV!(ICDMCV1) D
|
---|
| 90 | . S ICDRG=$S(ICDMCC=2:242,ICDMCC=1:243,1:244)
|
---|
| 91 | Q
|
---|
| 92 | DRG243 D CMS115 Q
|
---|
| 93 | DRG244 D CMS115 Q
|
---|
| 94 | DRG245 S ICDRG=245 Q
|
---|
| 95 | DRG246 ;
|
---|
| 96 | D MCV
|
---|
| 97 | I ICDMCV!ICDMCV1 S ICDRG=246
|
---|
| 98 | E S ICDRG=247
|
---|
| 99 | S ICDRG=$S(ICDMCC=2:246,1:ICDRG) D Q
|
---|
| 100 | . I $D(ICDOP(" 00.66")),$D(ICDOP(" 00.43")) S ICDRG=246
|
---|
| 101 | . I $D(ICDOP(" 36.07")),$D(ICDOP(" 00.43")) S ICDRG=246
|
---|
| 102 | . I $D(ICDOP(" 00.66")),$D(ICDOP(" 00.48")) S ICDRG=246
|
---|
| 103 | . I $D(ICDOP(" 36.07")),$D(ICDOP(" 00.48")) S ICDRG=246
|
---|
| 104 | Q
|
---|
| 105 | DRG247 D CMS516 Q
|
---|
| 106 | DRG248 ;Called from CMS516
|
---|
| 107 | D MCV
|
---|
| 108 | I ICDMCV!(ICDMCV1) S ICDRG=248
|
---|
| 109 | S ICDRG=$S(ICDMCC=2:248,1:ICDRG) D Q
|
---|
| 110 | . I $D(ICDOP(" 00.66")),$D(ICDOP(" 00.43")) S ICDRG=248
|
---|
| 111 | . I $D(ICDOP(" 00.66")),$D(ICDOP(" 00.43")) S ICDRG=248
|
---|
| 112 | . I $D(ICDOP(" 36.06")),$D(ICDOP(" 00.48")) S ICDRG=248
|
---|
| 113 | . I $D(ICDOP(" 36.06")),$D(ICDOP(" 00.48")) S ICDRG=248
|
---|
| 114 | Q
|
---|
| 115 | DRG249 ;Called from CMS516
|
---|
| 116 | D MCV
|
---|
| 117 | I 'ICDMCV&('ICDMCV1) S ICDRG=249
|
---|
| 118 | S ICDRG=$S(ICDMCC=2:248,1:ICDRG) D Q
|
---|
| 119 | . I $D(ICDOP(" 00.66")),$D(ICDOP(" 00.43")) S ICDRG=248
|
---|
| 120 | . I $D(ICDOP(" 00.66")),$D(ICDOP(" 00.43")) S ICDRG=248
|
---|
| 121 | . I $D(ICDOP(" 36.06")),$D(ICDOP(" 00.48")) S ICDRG=248
|
---|
| 122 | . I $D(ICDOP(" 36.06")),$D(ICDOP(" 00.48")) S ICDRG=248
|
---|
| 123 | Q
|
---|
| 124 | DRG250 ;
|
---|
| 125 | DRG251 D CMS516 Q ;S ICDRG=$S(ICDMCC=2:250,1:251) Q
|
---|
| 126 | DRG252 ;
|
---|
| 127 | DRG253 ;
|
---|
| 128 | DRG254 S ICDRG=$S(ICDMCC=2:252,ICDMCC=1:253,1:254) Q
|
---|
| 129 | DRG255 ;
|
---|
| 130 | DRG256 ;
|
---|
| 131 | DRG257 S ICDRG=$S(ICDMCC=2:255,ICDMCC=1:256,1:257) Q
|
---|
| 132 | DRG258 ;
|
---|
| 133 | DRG259 S ICDRG=$S(ICDMCC=2:258,1:259) Q
|
---|
| 134 | DRG260 ;
|
---|
| 135 | D CMS115 I "242^243^244^291^292^293"[ICDRG Q
|
---|
| 136 | D DRG258 I $D(ICDOP(" 00.56")) S ICDRG=264
|
---|
| 137 | I ICDOR["p" S ICDRG=$S(ICDMCC=2:260,ICDMCC=1:261,1:262)
|
---|
| 138 | Q
|
---|
| 139 | DRG261 D DRG260 Q
|
---|
| 140 | DRG262 D DRG260 Q
|
---|
| 141 | DRG263 S ICDRG=263 Q
|
---|
| 142 | DRG264 S ICDRG=264 Q
|
---|
| 143 | DRG280 ;
|
---|
| 144 | DRG281 ;
|
---|
| 145 | DRG282 S ICDRG=$S(ICDMCC=2:280,ICDMCC=1:281,1:282) Q
|
---|
| 146 | DRG283 ;
|
---|
| 147 | DRG284 ;
|
---|
| 148 | DRG285 S ICDRG=$S(ICDMCC=2:283,ICDMCC=1:284,1:285) Q
|
---|
| 149 | DRG286 ;
|
---|
| 150 | DRG287 S ICDRG=$S(ICDMCC=2:286,1:287) Q
|
---|
| 151 | DRG288 ;
|
---|
| 152 | DRG289 ;
|
---|
| 153 | DRG290 S ICDRG=$S(ICDMCC=2:288,ICDMCC=1:289,1:290) Q
|
---|
| 154 | DRG291 ;
|
---|
| 155 | DRG292 ;
|
---|
| 156 | DRG293 I (ICDDX(1)=5458!$D(ICDDXT("785.51"))),'ICDEXP S ICDMCC=2
|
---|
| 157 | S ICDRG=$S(ICDMCC=2:291,ICDMCC=1:292,1:293) Q
|
---|
| 158 | DRG294 ;
|
---|
| 159 | DRG295 S ICDRG=$S(ICDMCC>0:294,1:295) Q
|
---|
| 160 | DRG296 ;
|
---|
| 161 | DRG297 ;
|
---|
| 162 | DRG298 I (ICDDX(1)=2561!$D(ICDDXT(" 427.5"))),'ICDEXP S ICDMCC=2
|
---|
| 163 | S ICDRG=$S(ICDMCC=2:296,ICDMCC=1:297,1:298) Q
|
---|
| 164 | DRG299 S ICDRG=$S(ICDMCC=2:299,ICDMCC=1:300,1:301) Q
|
---|
| 165 | Q
|
---|
| 166 | CMS115 ;convert DRG115^ICDTLB2C code - no MS-DRG 115 existed
|
---|
| 167 | D EN1^ICDDRG5
|
---|
| 168 | I ICDPD'["I"&(ICDCC2=0)&(ICDCC3=0) D Q
|
---|
| 169 | . S ICDRG=$S(ICDMCC=2:291,ICDMCC=1:292,1:293)
|
---|
| 170 | I ICDCC2=1!(ICDCC3=1) D DRG242
|
---|
| 171 | I ((ICDRG>241)&(ICDRG<245)) Q
|
---|
| 172 | ; ICDCC2 identifies AICD LEAD OR GNRTR
|
---|
| 173 | I ICDCC2=1!(ICDCC3=1) D Q
|
---|
| 174 | . S ICDRG=$S(ICDMCC=2:242,ICDMCC=1:243,1:244)
|
---|
| 175 | Q
|
---|
| 176 | CMS516 ;convert DRG516^ICDTLB6C code - no MS-DRG 516 exists
|
---|
| 177 | S ICDRG=$S(ICDMCC=2:250,1:251)
|
---|
| 178 | D DRG248
|
---|
| 179 | I $D(ICDOP(" 36.06"))!$D(ICDOP(" 92.27")) D DRG249
|
---|
| 180 | I $D(ICDOP(" 36.07")) D DRG246
|
---|
| 181 | Q
|
---|
| 182 | MCV ; checks to see if case qualifies as an MCV (major cardiovascular complications or complex conditions)
|
---|
| 183 | S (ICDMCV,ICDMCV1,ICDMCV2)=0
|
---|
| 184 | ; ICDPD=identifier for prime dx ICDSD=identifier for any secondary dx
|
---|
| 185 | ; DGDX(1)=prime dx ICDDX(1)=ien of prime dx ICDDXT=any secondary dx
|
---|
| 186 | I ICDPD["c"!(ICDSD["c") S ICDMCV=1
|
---|
| 187 | I ICDSD["s" S ICDMCV=1
|
---|
| 188 | ;I DGDX(1)["426.0"!(DGDX(1)["426.53")!(DGDX(1)["426.54") S ICDMCV1=1
|
---|
| 189 | I $G(ICDDX(1))=9056!($G(ICDDX(1))=2548)!($G(ICDDX(1))=2549) S ICDMCV1=1
|
---|
| 190 | I $D(ICDDXT("426.0"))!($D(ICDDXT("426.53")))!($D(ICDDXT("426.54"))) S ICDMCV1=1
|
---|
| 191 | ;I DGDX(1)["411.1"!(DGDX(1)["411.81") S ICDMCV2=1
|
---|
| 192 | I $G(ICDDX(1))=2500!($G(ICDDX(1))=12477) S ICDMCV2=1
|
---|
| 193 | I $D(ICDDXT("411.1"))!($D(ICDDXT("411.81"))) S ICDMCV2=1
|
---|
| 194 | Q
|
---|