- ICDDRG5 ;ALB/GRR/EG/MRY/ADL - FIX SURGERY HIERARCHY ;3/20/03 10:36am
- ;;18.0;DRG Grouper;**2,5,7,10,20,22,31,37,64,77**;Oct 20, 2000;Build 2
- ;
- Q:$O(ICDODRG(0))'>0 K ICDJ,ICDJJ F ICDJ=0:0 S ICDJ=$O(ICDODRG(ICDJ)) Q:ICDJ'>0 S ICDJJ(ICDJ)="" D
- .I ICDDATE<3051001 D F Q
- .E I ICDDATE<3071001 D FY2007 Q
- .E I ICDDATE<3081001 D FY2008 Q
- .E I ICDDATE<3081001 D FY2009 Q
- .E D FY2015
- END S ICDJ=$O(ICDJ(0)) Q:ICDJ'>0 S ICDJ=ICDJ(ICDJ) K ICDODRG S ICDODRG(ICDJ)="" Q
- F I ICDJ=103 S ICDJ(1)=ICDJ Q
- I ICDJ=525 S ICDJ(2)=ICDJ Q
- I ICDJ=104 S ICDJ(3)=ICDJ Q
- I ICDJ=535 S ICDJ(4)=ICDJ Q
- I ICDJ=536 S ICDJ(5)=ICDJ Q
- I ICDJ=515 S ICDJ(6)=ICDJ Q
- I ICDJ=108 S ICDJ(7)=ICDJ Q
- I ICDJ=106 S ICDJ(8)=ICDJ Q
- I ICDJ=110 S ICDJ(9)=ICDJ Q
- I ICDJ=111 S ICDJ(10)=ICDJ Q
- I ICDJ=113 S ICDJ(11)=ICDJ Q
- I ICDJ=115 S ICDJ(12)=ICDJ Q
- I ICDJ=116 S ICDJ(13)=ICDJ Q
- I ICDJ=526 S ICDJ(14)=ICDJ Q
- I ICDJ=527 S ICDJ(15)=ICDJ Q
- I ICDJ=516 S ICDJ(16)=ICDJ Q
- I ICDJ=517 S ICDJ(17)=ICDJ Q
- I ICDJ=518 S ICDJ(18)=ICDJ Q
- I ICDJ=478 S ICDJ(19)=ICDJ Q
- I ICDJ=479 S ICDJ(20)=ICDJ Q
- ;I ICDJ=112 S ICDJ(13)=ICDJ Q
- I ICDJ=114 S ICDJ(21)=ICDJ Q
- I ICDJ=118 S ICDJ(22)=ICDJ Q
- I ICDJ=117 S ICDJ(23)=ICDJ Q
- I ICDJ=119 S ICDJ(24)=ICDJ Q
- I ICDJ=120 S ICDJ(25)=ICDJ
- Q
- FY2007 ;
- I ICDJ=103 S ICDJ(1)=ICDJ Q
- I ICDJ=525 S ICDJ(2)=ICDJ Q
- I ICDJ=104 S ICDJ(3)=ICDJ Q
- I ICDJ=535 S ICDJ(4)=ICDJ Q
- I ICDJ=536 S ICDJ(5)=ICDJ Q
- I ICDJ=515 S ICDJ(6)=ICDJ Q
- I ICDJ=108 S ICDJ(7)=ICDJ Q
- I ICDJ=106 S ICDJ(8)=ICDJ Q
- I ICDJ=110 S ICDJ(9)=ICDJ Q
- I ICDJ=111 S ICDJ(10)=ICDJ Q
- I ICDJ=547 S ICDJ(11)=ICDJ Q
- I ICDJ=548 S ICDJ(12)=ICDJ Q
- I ICDJ=549 S ICDJ(13)=ICDJ Q
- I ICDJ=550 S ICDJ(14)=ICDJ Q
- I ICDJ=113 S ICDJ(15)=ICDJ Q
- I ICDJ=551 S ICDJ(16)=ICDJ Q
- I ICDJ=552 S ICDJ(17)=ICDJ Q
- I ICDJ=557 S ICDJ(18)=ICDJ Q
- I ICDJ=555 S ICDJ(19)=ICDJ Q
- I ICDJ=558 S ICDJ(20)=ICDJ Q
- I ICDJ=556 S ICDJ(21)=ICDJ Q
- I ICDJ=518 S ICDJ(22)=ICDJ Q
- I ICDJ=553 S ICDJ(23)=ICDJ Q
- I ICDJ=554 S ICDJ(24)=ICDJ Q
- I ICDJ=478 S ICDJ(25)=ICDJ Q
- I ICDJ=479 S ICDJ(26)=ICDJ Q
- I ICDJ=114 S ICDJ(27)=ICDJ Q
- I ICDJ=118 S ICDJ(28)=ICDJ Q
- I ICDJ=117 S ICDJ(29)=ICDJ Q
- I ICDJ=119 S ICDJ(30)=ICDJ Q
- I ICDJ=120 S ICDJ(31)=ICDJ
- Q
- FY2008 ;
- I ICDJ=215 S ICDJ(1)=ICDJ Q
- I ICDJ=221 S ICDJ(2)=ICDJ Q
- I ICDJ=223 S ICDJ(3)=ICDJ Q
- I ICDJ=225 S ICDJ(4)=ICDJ Q
- I ICDJ=227 S ICDJ(5)=ICDJ Q
- I ICDJ=230 S ICDJ(6)=ICDJ Q
- I ICDJ=232 S ICDJ(7)=ICDJ Q
- I ICDJ=234 S ICDJ(8)=ICDJ Q
- I ICDJ=236 S ICDJ(9)=ICDJ Q
- I ICDJ=238 S ICDJ(10)=ICDJ Q
- I ICDJ=241 S ICDJ(11)=ICDJ Q
- I ICDJ=244 S ICDJ(12)=ICDJ Q
- I ICDJ=245 S ICDJ(13)=ICDJ Q
- I ICDJ=247 S ICDJ(14)=ICDJ Q
- I ICDJ=249 S ICDJ(15)=ICDJ Q
- I ICDJ=251 S ICDJ(16)=ICDJ Q
- I ICDJ=254 S ICDJ(17)=ICDJ Q
- I ICDJ=257 S ICDJ(18)=ICDJ Q
- I ICDJ=259 S ICDJ(19)=ICDJ Q
- I ICDJ=262 S ICDJ(20)=ICDJ Q
- I ICDJ=263 S ICDJ(21)=ICDJ Q
- I ICDJ=264 S ICDJ(22)=ICDJ Q
- Q
- FY2009 ;
- I ICDJ=215 S ICDJ(1)=ICDJ Q
- I ICDJ=221 S ICDJ(2)=ICDJ Q
- I ICDJ=223 S ICDJ(3)=ICDJ Q
- I ICDJ=225 S ICDJ(4)=ICDJ Q
- I ICDJ=227 S ICDJ(5)=ICDJ Q
- I ICDJ=230 S ICDJ(6)=ICDJ Q
- I ICDJ=232 S ICDJ(7)=ICDJ Q
- I ICDJ=234 S ICDJ(8)=ICDJ Q
- I ICDJ=236 S ICDJ(9)=ICDJ Q
- I ICDJ=238 S ICDJ(10)=ICDJ Q
- I ICDJ=241 S ICDJ(11)=ICDJ Q
- I ICDJ=244 S ICDJ(12)=ICDJ Q
- I ICDJ=245 S ICDJ(13)=ICDJ Q
- I ICDJ=265 S ICDJ(14)=ICDJ Q
- I ICDJ=247 S ICDJ(15)=ICDJ Q
- I ICDJ=249 S ICDJ(16)=ICDJ Q
- I ICDJ=251 S ICDJ(17)=ICDJ Q
- I ICDJ=254 S ICDJ(18)=ICDJ Q
- I ICDJ=257 S ICDJ(19)=ICDJ Q
- I ICDJ=259 S ICDJ(20)=ICDJ Q
- I ICDJ=262 S ICDJ(21)=ICDJ Q
- I ICDJ=263 S ICDJ(22)=ICDJ Q
- I ICDJ=264 S ICDJ(23)=ICDJ Q
- Q
- FY2015 ;
- I ICDJ=215 S ICDJ(1)=ICDJ Q
- I ICDJ=221 S ICDJ(2)=ICDJ Q
- I ICDJ=267 S ICDJ(3)=ICDJ Q
- I ICDJ=223 S ICDJ(4)=ICDJ Q
- I ICDJ=225 S ICDJ(5)=ICDJ Q
- I ICDJ=227 S ICDJ(6)=ICDJ Q
- I ICDJ=230 S ICDJ(7)=ICDJ Q
- I ICDJ=232 S ICDJ(8)=ICDJ Q
- I ICDJ=234 S ICDJ(9)=ICDJ Q
- I ICDJ=236 S ICDJ(10)=ICDJ Q
- I ICDJ=238 S ICDJ(11)=ICDJ Q
- I ICDJ=241 S ICDJ(12)=ICDJ Q
- I ICDJ=244 S ICDJ(13)=ICDJ Q
- I ICDJ=245 S ICDJ(14)=ICDJ Q
- I ICDJ=265 S ICDJ(15)=ICDJ Q
- I ICDJ=247 S ICDJ(16)=ICDJ Q
- I ICDJ=249 S ICDJ(17)=ICDJ Q
- I ICDJ=251 S ICDJ(18)=ICDJ Q
- I ICDJ=254 S ICDJ(19)=ICDJ Q
- I ICDJ=257 S ICDJ(20)=ICDJ Q
- I ICDJ=259 S ICDJ(21)=ICDJ Q
- I ICDJ=262 S ICDJ(22)=ICDJ Q
- I ICDJ=263 S ICDJ(23)=ICDJ Q
- I ICDJ=264 S ICDJ(24)=ICDJ Q
- Q
- EN1 S (ICDCC3,ICDCC2)=0
- I $D(ICDOP(" 00.50")) S ICDCC3=1
- I $D(ICDOP(" 00.52")) I $D(ICDOP(" 00.53")) S ICDCC3=1
- I $D(ICDOP(" 37.70"))!($D(ICDOP(" 37.71")))!($D(ICDOP(" 37.73"))) D MORE Q
- I $D(ICDOP(" 37.72")) I $D(ICDOP(" 37.80"))!($D(ICDOP(" 37.83"))) S ICDCC3=1 Q
- I $D(ICDOP(" 37.74")) I $D(ICDOP(" 37.80"))!($D(ICDOP(" 37.81")))!($D(ICDOP(" 37.82")))!($D(ICDOP(" 37.83")))!($D(ICDOP(" 37.85")))!($D(ICDOP(" 37.86")))!($D(ICDOP(" 37.87"))) S ICDCC3=1 Q
- I $D(ICDOP(" 37.76")) I $D(ICDOP(" 37.80"))!($D(ICDOP(" 37.85")))!($D(ICDOP(" 37.86")))!($D(ICDOP(" 37.87"))) S ICDCC3=1 Q
- I $D(ICDOP(" 00.53")) I $D(ICDOP(" 37.70"))!($D(ICDOP(" 37.71")))!($D(ICDOP(" 37.72")))!($D(ICDOP(" 37.73")))!($D(ICDOP("37.74 ")))!($D(ICDOP(" 37.76"))) S ICDCC3=1
- I $D(ICDOP(" 00.54"))!$D(ICDOP(" 37.95"))!$D(ICDOP(" 37.96"))!$D(ICDOP(" 37.97"))!$D(ICDOP(" 37.98"))!$D(ICDOP(" 00.52")) S ICDCC2=1
- Q
- MORE I $D(ICDOP(" 37.80"))!($D(ICDOP(" 37.81")))!($D(ICDOP(" 37.82")))!($D(ICDOP(" 37.85")))!($D(ICDOP(" 37.86")))!($D(ICDOP(" 37.87"))) S ICDCC3=1 Q
- Q
- VALV ;valve procedure
- N ICDTMP
- S (ICDCATH,ICDAJ)="" F ICDI=1:1 Q:'$D(ICDPRC(ICDI)) S ICDAJ=ICDPRC(ICDI),ICDTMP=$$ICDOP^ICDEX(+ICDAJ,$G(ICDDATE),2,"I"),$P(ICDTMP,"^",3)=$TR($P(ICDTMP,"^",3),";",""),ICDY(0)=$S((ICDTMP>0&$P(ICDTMP,U,10)):$P(ICDTMP,U,2,99),1:0) I ICDY(0) D
- . S ICDOP($P(ICDY(0),"^",1))="",ICDCATH=ICDCATH_$P(ICDY(0),"^",2)
- 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)
- Q
- S:ICDCATH["H" ICDRG=$S(ICDCATH["N"&ICDE1:104,ICDCATH["N"&ICDE2:104,ICDCATH["O":104,1:ICDRG)
- S:ICDCATH'["H" ICDRG=$S(ICDCATH["N"&ICDE1:105,ICDCATH["N"&ICDE2:105,ICDCATH["O":105,1:ICDRG)
- K ICDCATH,ICDAJ,ICDE1,ICDE2,ICDI,ICDOP,ICDY Q
- VALV1 ;dx combo's for DRG120
- 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)
- S ICDRG=$S((ICDE1&(ICDOR["H")):104,(ICDE1&(ICDOR'["H")):105,(ICDE2&(ICDOR["H")):104,(ICDE2&(ICDOR'["H")):105,1:120)
- K ICDE1,ICDE2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDDRG5 6432 printed Feb 18, 2025@23:16:39 Page 2
- ICDDRG5 ;ALB/GRR/EG/MRY/ADL - FIX SURGERY HIERARCHY ;3/20/03 10:36am
- +1 ;;18.0;DRG Grouper;**2,5,7,10,20,22,31,37,64,77**;Oct 20, 2000;Build 2
- +2 ;
- +3 if $ORDER(ICDODRG(0))'>0
- QUIT
- KILL ICDJ,ICDJJ
- FOR ICDJ=0:0
- SET ICDJ=$ORDER(ICDODRG(ICDJ))
- if ICDJ'>0
- QUIT
- SET ICDJJ(ICDJ)=""
- Begin DoDot:1
- +4 IF ICDDATE<3051001
- DO F
- QUIT
- +5 IF '$TEST
- IF ICDDATE<3071001
- DO FY2007
- QUIT
- +6 IF '$TEST
- IF ICDDATE<3081001
- DO FY2008
- QUIT
- +7 IF '$TEST
- IF ICDDATE<3081001
- DO FY2009
- QUIT
- +8 IF '$TEST
- DO FY2015
- End DoDot:1
- END SET ICDJ=$ORDER(ICDJ(0))
- if ICDJ'>0
- QUIT
- SET ICDJ=ICDJ(ICDJ)
- KILL ICDODRG
- SET ICDODRG(ICDJ)=""
- QUIT
- F IF ICDJ=103
- SET ICDJ(1)=ICDJ
- QUIT
- +1 IF ICDJ=525
- SET ICDJ(2)=ICDJ
- QUIT
- +2 IF ICDJ=104
- SET ICDJ(3)=ICDJ
- QUIT
- +3 IF ICDJ=535
- SET ICDJ(4)=ICDJ
- QUIT
- +4 IF ICDJ=536
- SET ICDJ(5)=ICDJ
- QUIT
- +5 IF ICDJ=515
- SET ICDJ(6)=ICDJ
- QUIT
- +6 IF ICDJ=108
- SET ICDJ(7)=ICDJ
- QUIT
- +7 IF ICDJ=106
- SET ICDJ(8)=ICDJ
- QUIT
- +8 IF ICDJ=110
- SET ICDJ(9)=ICDJ
- QUIT
- +9 IF ICDJ=111
- SET ICDJ(10)=ICDJ
- QUIT
- +10 IF ICDJ=113
- SET ICDJ(11)=ICDJ
- QUIT
- +11 IF ICDJ=115
- SET ICDJ(12)=ICDJ
- QUIT
- +12 IF ICDJ=116
- SET ICDJ(13)=ICDJ
- QUIT
- +13 IF ICDJ=526
- SET ICDJ(14)=ICDJ
- QUIT
- +14 IF ICDJ=527
- SET ICDJ(15)=ICDJ
- QUIT
- +15 IF ICDJ=516
- SET ICDJ(16)=ICDJ
- QUIT
- +16 IF ICDJ=517
- SET ICDJ(17)=ICDJ
- QUIT
- +17 IF ICDJ=518
- SET ICDJ(18)=ICDJ
- QUIT
- +18 IF ICDJ=478
- SET ICDJ(19)=ICDJ
- QUIT
- +19 IF ICDJ=479
- SET ICDJ(20)=ICDJ
- QUIT
- +20 ;I ICDJ=112 S ICDJ(13)=ICDJ Q
- +21 IF ICDJ=114
- SET ICDJ(21)=ICDJ
- QUIT
- +22 IF ICDJ=118
- SET ICDJ(22)=ICDJ
- QUIT
- +23 IF ICDJ=117
- SET ICDJ(23)=ICDJ
- QUIT
- +24 IF ICDJ=119
- SET ICDJ(24)=ICDJ
- QUIT
- +25 IF ICDJ=120
- SET ICDJ(25)=ICDJ
- +26 QUIT
- FY2007 ;
- +1 IF ICDJ=103
- SET ICDJ(1)=ICDJ
- QUIT
- +2 IF ICDJ=525
- SET ICDJ(2)=ICDJ
- QUIT
- +3 IF ICDJ=104
- SET ICDJ(3)=ICDJ
- QUIT
- +4 IF ICDJ=535
- SET ICDJ(4)=ICDJ
- QUIT
- +5 IF ICDJ=536
- SET ICDJ(5)=ICDJ
- QUIT
- +6 IF ICDJ=515
- SET ICDJ(6)=ICDJ
- QUIT
- +7 IF ICDJ=108
- SET ICDJ(7)=ICDJ
- QUIT
- +8 IF ICDJ=106
- SET ICDJ(8)=ICDJ
- QUIT
- +9 IF ICDJ=110
- SET ICDJ(9)=ICDJ
- QUIT
- +10 IF ICDJ=111
- SET ICDJ(10)=ICDJ
- QUIT
- +11 IF ICDJ=547
- SET ICDJ(11)=ICDJ
- QUIT
- +12 IF ICDJ=548
- SET ICDJ(12)=ICDJ
- QUIT
- +13 IF ICDJ=549
- SET ICDJ(13)=ICDJ
- QUIT
- +14 IF ICDJ=550
- SET ICDJ(14)=ICDJ
- QUIT
- +15 IF ICDJ=113
- SET ICDJ(15)=ICDJ
- QUIT
- +16 IF ICDJ=551
- SET ICDJ(16)=ICDJ
- QUIT
- +17 IF ICDJ=552
- SET ICDJ(17)=ICDJ
- QUIT
- +18 IF ICDJ=557
- SET ICDJ(18)=ICDJ
- QUIT
- +19 IF ICDJ=555
- SET ICDJ(19)=ICDJ
- QUIT
- +20 IF ICDJ=558
- SET ICDJ(20)=ICDJ
- QUIT
- +21 IF ICDJ=556
- SET ICDJ(21)=ICDJ
- QUIT
- +22 IF ICDJ=518
- SET ICDJ(22)=ICDJ
- QUIT
- +23 IF ICDJ=553
- SET ICDJ(23)=ICDJ
- QUIT
- +24 IF ICDJ=554
- SET ICDJ(24)=ICDJ
- QUIT
- +25 IF ICDJ=478
- SET ICDJ(25)=ICDJ
- QUIT
- +26 IF ICDJ=479
- SET ICDJ(26)=ICDJ
- QUIT
- +27 IF ICDJ=114
- SET ICDJ(27)=ICDJ
- QUIT
- +28 IF ICDJ=118
- SET ICDJ(28)=ICDJ
- QUIT
- +29 IF ICDJ=117
- SET ICDJ(29)=ICDJ
- QUIT
- +30 IF ICDJ=119
- SET ICDJ(30)=ICDJ
- QUIT
- +31 IF ICDJ=120
- SET ICDJ(31)=ICDJ
- +32 QUIT
- FY2008 ;
- +1 IF ICDJ=215
- SET ICDJ(1)=ICDJ
- QUIT
- +2 IF ICDJ=221
- SET ICDJ(2)=ICDJ
- QUIT
- +3 IF ICDJ=223
- SET ICDJ(3)=ICDJ
- QUIT
- +4 IF ICDJ=225
- SET ICDJ(4)=ICDJ
- QUIT
- +5 IF ICDJ=227
- SET ICDJ(5)=ICDJ
- QUIT
- +6 IF ICDJ=230
- SET ICDJ(6)=ICDJ
- QUIT
- +7 IF ICDJ=232
- SET ICDJ(7)=ICDJ
- QUIT
- +8 IF ICDJ=234
- SET ICDJ(8)=ICDJ
- QUIT
- +9 IF ICDJ=236
- SET ICDJ(9)=ICDJ
- QUIT
- +10 IF ICDJ=238
- SET ICDJ(10)=ICDJ
- QUIT
- +11 IF ICDJ=241
- SET ICDJ(11)=ICDJ
- QUIT
- +12 IF ICDJ=244
- SET ICDJ(12)=ICDJ
- QUIT
- +13 IF ICDJ=245
- SET ICDJ(13)=ICDJ
- QUIT
- +14 IF ICDJ=247
- SET ICDJ(14)=ICDJ
- QUIT
- +15 IF ICDJ=249
- SET ICDJ(15)=ICDJ
- QUIT
- +16 IF ICDJ=251
- SET ICDJ(16)=ICDJ
- QUIT
- +17 IF ICDJ=254
- SET ICDJ(17)=ICDJ
- QUIT
- +18 IF ICDJ=257
- SET ICDJ(18)=ICDJ
- QUIT
- +19 IF ICDJ=259
- SET ICDJ(19)=ICDJ
- QUIT
- +20 IF ICDJ=262
- SET ICDJ(20)=ICDJ
- QUIT
- +21 IF ICDJ=263
- SET ICDJ(21)=ICDJ
- QUIT
- +22 IF ICDJ=264
- SET ICDJ(22)=ICDJ
- QUIT
- +23 QUIT
- FY2009 ;
- +1 IF ICDJ=215
- SET ICDJ(1)=ICDJ
- QUIT
- +2 IF ICDJ=221
- SET ICDJ(2)=ICDJ
- QUIT
- +3 IF ICDJ=223
- SET ICDJ(3)=ICDJ
- QUIT
- +4 IF ICDJ=225
- SET ICDJ(4)=ICDJ
- QUIT
- +5 IF ICDJ=227
- SET ICDJ(5)=ICDJ
- QUIT
- +6 IF ICDJ=230
- SET ICDJ(6)=ICDJ
- QUIT
- +7 IF ICDJ=232
- SET ICDJ(7)=ICDJ
- QUIT
- +8 IF ICDJ=234
- SET ICDJ(8)=ICDJ
- QUIT
- +9 IF ICDJ=236
- SET ICDJ(9)=ICDJ
- QUIT
- +10 IF ICDJ=238
- SET ICDJ(10)=ICDJ
- QUIT
- +11 IF ICDJ=241
- SET ICDJ(11)=ICDJ
- QUIT
- +12 IF ICDJ=244
- SET ICDJ(12)=ICDJ
- QUIT
- +13 IF ICDJ=245
- SET ICDJ(13)=ICDJ
- QUIT
- +14 IF ICDJ=265
- SET ICDJ(14)=ICDJ
- QUIT
- +15 IF ICDJ=247
- SET ICDJ(15)=ICDJ
- QUIT
- +16 IF ICDJ=249
- SET ICDJ(16)=ICDJ
- QUIT
- +17 IF ICDJ=251
- SET ICDJ(17)=ICDJ
- QUIT
- +18 IF ICDJ=254
- SET ICDJ(18)=ICDJ
- QUIT
- +19 IF ICDJ=257
- SET ICDJ(19)=ICDJ
- QUIT
- +20 IF ICDJ=259
- SET ICDJ(20)=ICDJ
- QUIT
- +21 IF ICDJ=262
- SET ICDJ(21)=ICDJ
- QUIT
- +22 IF ICDJ=263
- SET ICDJ(22)=ICDJ
- QUIT
- +23 IF ICDJ=264
- SET ICDJ(23)=ICDJ
- QUIT
- +24 QUIT
- FY2015 ;
- +1 IF ICDJ=215
- SET ICDJ(1)=ICDJ
- QUIT
- +2 IF ICDJ=221
- SET ICDJ(2)=ICDJ
- QUIT
- +3 IF ICDJ=267
- SET ICDJ(3)=ICDJ
- QUIT
- +4 IF ICDJ=223
- SET ICDJ(4)=ICDJ
- QUIT
- +5 IF ICDJ=225
- SET ICDJ(5)=ICDJ
- QUIT
- +6 IF ICDJ=227
- SET ICDJ(6)=ICDJ
- QUIT
- +7 IF ICDJ=230
- SET ICDJ(7)=ICDJ
- QUIT
- +8 IF ICDJ=232
- SET ICDJ(8)=ICDJ
- QUIT
- +9 IF ICDJ=234
- SET ICDJ(9)=ICDJ
- QUIT
- +10 IF ICDJ=236
- SET ICDJ(10)=ICDJ
- QUIT
- +11 IF ICDJ=238
- SET ICDJ(11)=ICDJ
- QUIT
- +12 IF ICDJ=241
- SET ICDJ(12)=ICDJ
- QUIT
- +13 IF ICDJ=244
- SET ICDJ(13)=ICDJ
- QUIT
- +14 IF ICDJ=245
- SET ICDJ(14)=ICDJ
- QUIT
- +15 IF ICDJ=265
- SET ICDJ(15)=ICDJ
- QUIT
- +16 IF ICDJ=247
- SET ICDJ(16)=ICDJ
- QUIT
- +17 IF ICDJ=249
- SET ICDJ(17)=ICDJ
- QUIT
- +18 IF ICDJ=251
- SET ICDJ(18)=ICDJ
- QUIT
- +19 IF ICDJ=254
- SET ICDJ(19)=ICDJ
- QUIT
- +20 IF ICDJ=257
- SET ICDJ(20)=ICDJ
- QUIT
- +21 IF ICDJ=259
- SET ICDJ(21)=ICDJ
- QUIT
- +22 IF ICDJ=262
- SET ICDJ(22)=ICDJ
- QUIT
- +23 IF ICDJ=263
- SET ICDJ(23)=ICDJ
- QUIT
- +24 IF ICDJ=264
- SET ICDJ(24)=ICDJ
- QUIT
- +25 QUIT
- EN1 SET (ICDCC3,ICDCC2)=0
- +1 IF $DATA(ICDOP(" 00.50"))
- SET ICDCC3=1
- +2 IF $DATA(ICDOP(" 00.52"))
- IF $DATA(ICDOP(" 00.53"))
- SET ICDCC3=1
- +3 IF $DATA(ICDOP(" 37.70"))!($DATA(ICDOP(" 37.71")))!($DATA(ICDOP(" 37.73")))
- DO MORE
- QUIT
- +4 IF $DATA(ICDOP(" 37.72"))
- IF $DATA(ICDOP(" 37.80"))!($DATA(ICDOP(" 37.83")))
- SET ICDCC3=1
- QUIT
- +5 IF $DATA(ICDOP(" 37.74"))
- IF $DATA(ICDOP(" 37.80"))!($DATA(ICDOP(" 37.81")))!($DATA(ICDOP(" 37.82")))!($DATA(ICDOP(" 37.83")))!($DATA(ICDOP(" 37.85")))!($DATA(ICDOP(" 37.86")))!($DATA(ICDOP(" 37.87")))
- SET ICDCC3=1
- QUIT
- +6 IF $DATA(ICDOP(" 37.76"))
- IF $DATA(ICDOP(" 37.80"))!($DATA(ICDOP(" 37.85")))!($DATA(ICDOP(" 37.86")))!($DATA(ICDOP(" 37.87")))
- SET ICDCC3=1
- QUIT
- +7 IF $DATA(ICDOP(" 00.53"))
- IF $DATA(ICDOP(" 37.70"))!($DATA(ICDOP(" 37.71")))!($DATA(ICDOP(" 37.72")))!($DATA(ICDOP(" 37.73")))!($DATA(ICDOP("37.74 ")))!($DATA(ICDOP(" 37.76")))
- SET ICDCC3=1
- +8 IF $DATA(ICDOP(" 00.54"))!$DATA(ICDOP(" 37.95"))!$DATA(ICDOP(" 37.96"))!$DATA(ICDOP(" 37.97"))!$DATA(ICDOP(" 37.98"))!$DATA(ICDOP(" 00.52"))
- SET ICDCC2=1
- +9 QUIT
- MORE IF $DATA(ICDOP(" 37.80"))!($DATA(ICDOP(" 37.81")))!($DATA(ICDOP(" 37.82")))!($DATA(ICDOP(" 37.85")))!($DATA(ICDOP(" 37.86")))!($DATA(ICDOP(" 37.87")))
- SET ICDCC3=1
- QUIT
- +1 QUIT
- VALV ;valve procedure
- +1 NEW ICDTMP
- +2 SET (ICDCATH,ICDAJ)=""
- FOR ICDI=1:1
- if '$DATA(ICDPRC(ICDI))
- QUIT
- SET ICDAJ=ICDPRC(ICDI)
- SET ICDTMP=$$ICDOP^ICDEX(+ICDAJ,$GET(ICDDATE),2,"I")
- SET $PIECE(ICDTMP,"^",3)=$TRANSLATE($PIECE(ICDTMP,"^",3),";","")
- SET ICDY(0)=$SELECT((ICDTMP>0&$PIECE(ICDTMP,U,10)):$PIECE(ICDTMP,U,2,99),1:0)
- IF ICDY(0)
- Begin DoDot:1
- +3 SET ICDOP($PIECE(ICDY(0),"^",1))=""
- SET ICDCATH=ICDCATH_$PIECE(ICDY(0),"^",2)
- End DoDot:1
- +4 SET ICDE1=$SELECT($DATA(ICDOP(37.95))&($DATA(ICDOP(37.96))):1,1:0)
- SET ICDE2=$SELECT($DATA(ICDOP(37.97))&($DATA(ICDOP(37.98))):1,1:0)
- +5 QUIT
- +6 if ICDCATH["H"
- SET ICDRG=$SELECT(ICDCATH["N"&ICDE1:104,ICDCATH["N"&ICDE2:104,ICDCATH["O":104,1:ICDRG)
- +7 if ICDCATH'["H"
- SET ICDRG=$SELECT(ICDCATH["N"&ICDE1:105,ICDCATH["N"&ICDE2:105,ICDCATH["O":105,1:ICDRG)
- +8 KILL ICDCATH,ICDAJ,ICDE1,ICDE2,ICDI,ICDOP,ICDY
- QUIT
- VALV1 ;dx combo's for DRG120
- +1 SET ICDE1=$SELECT($DATA(ICDOP(" 37.95"))&($DATA(ICDOP(" 37.96"))):1,1:0)
- SET ICDE2=$SELECT($DATA(ICDOP(" 37.97"))&($DATA(ICDOP(" 37.98"))):1,1:0)
- +2 SET ICDRG=$SELECT((ICDE1&(ICDOR["H")):104,(ICDE1&(ICDOR'["H")):105,(ICDE2&(ICDOR["H")):104,(ICDE2&(ICDOR'["H")):105,1:120)
- +3 KILL ICDE1,ICDE2
- +4 QUIT