ICDDRGX2 ;MKN - GROUPER PROCESS ;06/04/12 3:45pm
;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21
;
VARIABLS ;Apply Variables for MDC 1-22
;
N ICDFI,ICDRGT,ICDN,ICDX,ICDREL
;Check if Procedure Codes related to Primary DX
S (ICDFI,ICDREL)=0,ICDN="" F S ICDN=$O(ICDPRC(ICDN)) Q:ICDN="" S ICDX=$$MDCT^ICDEX(ICDPRC(ICDN),ICDDATE,.ICDMDC) S:ICDX=1 ICDREL=1
I $D(ICD10OR(151)) S ICDRG=$S(ICDMCC=2:11,ICDMCC=1:12,1:13),ICDFI=1 G EXIT ;151=Tracheostomy for Face, Mouth and Neck Diagnoses
I $D(ICD10OR(60)) S ICDRG=$S(ICDMCC=2:20,ICDMCC=1:21,1:22),ICDFI=1 G EXIT ;60=Intracranial Vascualr Procedure
I ICDMDC=1 D
. I $D(ICD10OR("Q")) D Q:ICDFI ;Craniotomy
. . I $D(ICD10OR("C")) S ICDRG=23,ICDFI=1 Q ;C=Chemotherapy Implant
. . I $D(ICD10OR(77))!($D(ICD10PD(13))) D Q ;77=Major Device Implant or PDX of Acute Complex CNS
. . . S ICDRG=$S(ICDMCC=2:23,1:24),ICDFI=1 Q
. . I '($D(ICD10OR(77))!($D(ICD10PD(13)))) D Q
. . . S ICDRG=$S(ICDMCC=2:25,ICDMCC=1:26,1:27),ICDFI=1 Q
. I $D(ICD10OR(261)) D Q ;Spinal Procedures
. . I ICDMCC>0 S ICDRG=$S(ICDMCC=2:28,1:29),ICDFI=1 Q
. . S ICDRG=$S($D(ICD10OR(143)):29,1:30),ICDFI=1 Q ;143=Spinal NeuroStimulators
. I $D(ICD10OR(164)) S ICDRG=$S(ICDMCC=2:31,ICDMCC=1:32,1:33),ICDFI=1 Q ;164=Ventricualr Shunt Procedures
. I $D(ICD10OR(33)) S ICDRG=$S(ICDMCC=2:34,ICDMCC=1:35,1:36),ICDFI=1 Q ;33=Carotid Artery Stent Procedures
. I $D(ICD10OR(174)) S ICDRG=$S(ICDMCC=2:37,ICDMCC=1:38,1:39),ICDFI=1 Q ;Extracranial Procedures
. I $D(ICD10OR(239)) D Q ;239=Peripheral and Cranial Nerve and Other Nervous System Procedures
. . I ICDMCC>0 S ICDRG=$S(ICDMCC=2:40,1:41),ICDFI=1 Q
. . I $D(ICD10OR(123)) S ICDRG=41,ICDFI=1 Q ;123=Peripheral Neurostimulator Combinations
. . S ICDRG=42,ICDFI=1 Q
. I $D(ICD10OR(193)) S ICDRG=$S(ICDMCC=2:61,ICDMCC=1:62,1:63),ICDFI=1 Q ;193=Acute Ischemic Stroke with Use of Thrombolytic Agent
. I $D(ICD10PD(86)) D Q
. . I $D(ICD10SD(307)) S ICDRG=65,ICDFI=1 Q ;307=TPA WITHIN 24 HOURS
. . S ICDRG=$S(ICDMCC=2:64,ICDMCC=1:65,1:66),ICDFI=1 Q ;86=Intracranial Hemorrhage or Cerebral Infarction
. I $D(ICD10PD(310)) S ICDRG=$S(ICDMCC=2:82,ICDMCC=1:83,1:84),ICDFI=1 Q ;310=Traumatic Stupor and Coma, Coma > 1 Hour
. I $D(ICD10PD(309)) S ICDRG=$S(ICDMCC=2:85,ICDMCC=1:86,1:87),ICDFI=1 Q ;309=Traumatic Stupor and Coma, Coma < 1 Hour
. I $D(ICD10PD(43)) S ICDRG=$S(ICDMCC=2:88,ICDMCC=1:89,1:90),ICDFI=1 Q ;43=Concussion
. I $D(ICD10PD(155)) S ICDRG=$S(ICDMCC=2:91,ICDMCC=1:92,1:93),ICDFI=1 Q ;155=Other Disorders of Nervous System
. I $D(ICD10PD(234)) S ICDRG=$S(ICDMCC=2:94,ICDMCC=1:95,1:96),ICDFI=1 Q ;234=Bacterial and Tuberculous Infections of Nervous System
. I $D(ICD10PD(276)) S ICDRG=$S(ICDMCC=2:97,ICDMCC=1:98,1:99),ICDFI=1 Q ;276=Non-Bacterial Infections of Nervous System Except Viral Meningitis
. I $D(ICD10PD(188)) S ICDRG=$S(ICDMCC=2:100,1:101),ICDFI=1 Q ;188=Seizures
. I $D(ICD10PD(74)) S ICDRG=$S(ICDMCC=2:102,1:103),ICDFI=1 Q ;74=Headaches
G:ICDFI EXIT
I ICDMDC=2 D
. I $D(ICD10OR(99)) S ICDRG=$S(ICDMCC=2:113,1:114),ICDFI=1 Q ;Orbital Procedures
. I $D(ICD10OR(46)) S ICDRG=115,ICDFI=1 Q ;Extraocular Procedures
. I $D(ICD10OR(61)) S ICDRG=$S(ICDMCC=2:116,1:117),ICDFI=1 Q ;Intraocular Procedures
G:ICDFI EXIT
I ICDMDC=3,$D(ICD10OR(53)) D ;53=Head and Neck procedures
. I $D(ICD10OR(77)) S ICDRG=129,ICDFI=1 Q ;77=Major Device Implant
. S ICDRG=$S(ICDMCC>0:129,1:130),ICDFI=1 Q
. I $D(ICD10OR(207)) S ICDRG=$S(ICDMCC>0:131,1:132),ICDFI=1 Q ;207=Cranial/Facial Procedures
G:ICDFI EXIT
I $D(ICD10OR(76)) S ICDRG=$S(ICDMCC=2:163,ICDMCC=1:164,1:165),ICDFI=1 Q ;76=Major Chest Proc
G:ICDFI EXIT
I ICDMDC=4 D
. I $D(ICD10OR(225)) S ICDRG=207,ICDFI=1 Q ;225=Mechanical Ventilation 96+ hours
. I $D(ICD10OR(87)) S ICDRG=208,ICDFI=1 Q ;87=Mechanical Ventilation <96 hours
G:ICDFI EXIT
I $D(ICD10OR(32)),'$D(ICD10OR(38)) D ;32=Cardiac Valve and Other Major Cardiothoracic Proc 38=Coronary Bypass
. I $D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:216,ICDMCC=1:217,1:218),ICDFI=1 Q ;28=Cardiac Catherization
. S ICDRG=$S(ICDMCC=2:219,ICDMCC=1:220,1:221),ICDFI=1 Q
G:ICDFI EXIT
I $D(ICD10OR(29)) D ;29=Cardiac Defibrillator Implant
. I $D(ICD10PD(22)),$D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:222,1:223),ICDFI=1 Q ;22=AMI/HF/Shock and Cardiac Catheterization 28=Cardiac Catherization
. I '$D(ICD10PD(22)),$D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:224,1:225),ICDFI=1 Q
. I '$D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:226,1:227),ICDFI=1 Q
G:ICDFI EXIT
I $D(ICD10OR(38)) D ;38=Coronary Bypass
. I $D(ICD10OR(129)) S ICDRG=$S(ICDMCC=2:231,1:232),ICDFI=1 Q ;129=PTCA
. I $D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:233,1:234),ICDFI=1 Q ;28=Cardiac Catheterization
. S ICDRG=$S(ICDMCC=2:235,1:236),ICDFI=1 Q
G:ICDFI EXIT
I $D(ICD10OR(125)) S ICDRG=$S(ICDMCC=2:242,ICDMCC=1:243,1:244),ICDFI=1 G EXIT
I $D(ICD10OR(12)) S ICDRG=245,ICDFI=1 G EXIT
I $D(ICD10OR(237)) D ;237=Percutaneous Cardiovascular Procedures without Coronary Artery Stent
. I $D(ICD10OR(43)),ICDMCC=2 S ICDRG=246,ICDFI=1 Q ;Drug-Eluting Stent
. I $D(ICD10OR(43)),ICDMCC'=2,$D(ICD10OR(87)) S ICDRG=246,ICDFI=1 Q ;;Drug-Eluting Stent and 4+ Vessels / Stents
. I $D(ICD10OR(43)),ICDMCC'=2,'$D(ICD10OR(87)) S ICDRG=247,ICDFI=1 Q
. I '$D(ICD10OR(43)),$D(ICD10OR(92)) D G:ICDFI EXIT
. . I ICDMCC=2 S ICDRG=248,ICDFI=1 Q ;Non-Drug-Eluting Stent
. . S ICDRG=$S($D(ICD10OR(87)):248,1:249),ICDFI=1 Q
G:ICDFI EXIT
I ICDMDC=5,$D(ICD10OR(236)) S ICDRG=$S(ICDMCC=2:250,1:251),ICDFI=1 G EXIT ;Percutaneous Cardiovascular Procedures with Coronary Artery Stent
I $D(ICD10OR(31)),'$D(ICD10OR(101)) S ICDRG=$S(ICDMCC=2:260,ICDMCC=1:261,1:262),ICDFI=1 G EXIT ;31=Cardiac Pacemaker Revision Except Device Replacement
I ICDMDC=5,$D(ICD10OR(209)) S ICDRG=$S(ICDMCC=2:266,1:267),ICDFI=1 G EXIT
I ICDMDC=5,$D(ICD10OR(199)) S ICDRG=$S(ICDMCC=2:268,1:269),ICDFI=1 G EXIT ; AORTIC & HEART ASST PROC EXPT PULS BALLOON
I ICDMDC=5,$D(ICD10OR(75)) S ICDRG=$S(ICDMCC=2:270,ICDMCC=1:271,1:272),ICDFI=1 G EXIT ; MAJOR CARDIOVASCULAR PROC
I ICDMDC=5,$D(ICD10OR(238)) S ICDRG=$S(ICDMCC=2:273,1:274),ICDFI=1 G EXIT ;PERCUTANEOUS INTRACARDIAC PROC
I $D(ICD10PD(18)) D ;Acute Myocardial Infarction
. I 'ICDEXP S ICDRG=$S(ICDMCC=2:280,ICDMCC=1:281,1:282),ICDFI=1 Q ;If Discharged Alive
. S ICDRG=$S(ICDMCC=2:283,ICDMCC=1:284,1:285),ICDFI=1 Q
G:ICDFI EXIT
I ICDMDC=5,$D(ICD10OR(206)) S ICDRG=$S(ICDMCC=2:286,1:287),ICDFI=1 G EXIT ;Circulatory Disorders Except AMI with Cardiac Catheterization
I $D(ICD10PD(255)) S ICDRG=$S(ICDMCC=2:291,ICDMCC=1:292,1:293),ICDFI=1 G EXIT ;Heart Failure and Shock
I $D(ICD10PD(31)) S ICDRG=$S(ICDMCC=2:296,ICDMCC=1:297,1:298),ICDFI=1 G EXIT ;Cardiac Arrest, Unexplained
I $D(ICD10OR(130)) S ICDRG=$S(ICDMCC=2:332,ICDMCC=1:333,1:334),ICDFI=1 G EXIT ;Rectal Resection
I $D(ICD10OR(20)) D ;Appendectomy
. I $D(ICD10PD(41)) S ICDRG=$S(ICDMCC=2:338,ICDMCC=1:339,1:340),ICDFI=1 Q
. S ICDRG=$S(ICDMCC=2:341,ICDMCC=1:342,1:343),ICDFI=1 Q
G:ICDFI EXIT
I ICDMDC=6 D
. I $D(ICD10OR("J")) S ICDRG=$S(ICDMCC=2:350,ICDMCC=1:351,1:352),ICDFI=1 Q ;Inguinal and Femoral Hernia
. I $D(ICD10OR(55)) S ICDRG=$S(ICDMCC=2:353,ICDMCC=1:354,1:355),ICDFI=1 Q ;Hernia except Inguinal and Femoral
G:ICDFI EXIT
I $D(ICD10PD(94)) S ICDRG=$S(ICDMCC=2:368,ICDMCC=1:369,1:370),ICDFI=1 G EXIT ;Major Esophageal Disorders
I $D(ICD10PD(40)) S ICDRG=$S(ICDMCC=2:380,ICDMCC=1:381,1:382),ICDFI=1 G EXIT ;Complicated Peptic Ulcer
I $D(ICD10PD(218)) S ICDRG=$S(ICDMCC=2:383,1:384),ICDFI=1 G EXIT ;Uncomplicated Peptic Ulcer
I $D(ICD10OR(36))!($D(ICD10OR(65))) D
. I $D(ICD10OR(27)) S ICDRG=$S(ICDMCC=2:411,ICDMCC=1:412,1:413),ICDFI=1 Q
. I '$D(ICD10OR(27)),'$D(ICD10OR(65)) S ICDRG=$S(ICDMCC=2:414,ICDMCC=1:415,1:416),ICDFI=1 Q
. I '$D(ICD10OR(27)),$D(ICD10OR(65)) S ICDRG=$S(ICDMCC=2:417,ICDMCC=1:418,1:419),ICDFI=1 Q
G:ICDFI EXIT
I ICDMDC=7,$D(ICD10OR(54)) S ICDRG=$S(ICDMCC=2:420,ICDMCC=1:421,1:422),ICDFI=1 G EXIT ;54=Hepatobiliary Diagnostic Proc
I ICDMDC=8 D
. I $D(ICD10OR(19)),$D(ICD10OR(127)) S ICDRG=$S(ICDMCC=2:453,ICDMCC=1:454,1:455),ICDFI=1 Q ;19=Anterior Spinal Fusion 127=Posterior Spinal Fusion
. I $D(ICD10OR(142)),$D(ICD10PD(206)) S ICDRG=$S(ICDMCC=2:456,ICDMCC=1:457,1:458),ICDFI=1 Q ;142=Spinal Fusion except Cervical 206=Spinal Curvature / Malignancy / Infection
. I $D(ICD10OR(142)) S ICDRG=$S(ICDMCC=2:459,1:460),ICDFI=1 Q
. I $G(ICD10OR(201))=2 S ICDRG=$S(ICDMCC=2:461,1:462),ICDFI=1 Q ;201=Bilateral or Multiple Major Joint Procedures of Lower Extremity
. I $D(ICD10OR(79)) S ICDRG=$S(ICDMCC=2:469,1:470),ICDFI=1 Q ;79=Major Joint Replacement or Reattachment of Lower Extremity
. I $D(ICD10OR(34)) S ICDRG=$S(ICDMCC=2:471,ICDMCC=1:472,1:473),ICDFI=1 Q ;34=Cervical Spinal Fusion
G:ICDFI EXIT
I $D(ICD10OR(64)) D ;Knee procedures
. I $D(ICD10PD(64)) S ICDRG=$S(ICDMCC=2:485,ICDMCC=1:486,1:487),ICDFI=1 Q
. S ICDRG=$S(ICDMCC>0:488,1:489),ICDFI=1
G:ICDFI EXIT
I $D(ICD10OR(200)),'$D(ICD10OR(42)),'$D(ICD10OR(91)),ICDMCC=0 S ICDRG=520,ICDFI=1
I $D(ICD10OR(200)),ICDMCC>0 S ICDRG=519,ICDFI=1
I '$D(ICD10OR(200)),$D(ICD10OR(42)) S ICDRG=518,ICDFI=1
I '$D(ICD10OR(200)),'$D(ICD10OR(42)),$D(ICD10OR(91)) S ICDRG=518,ICDFI=1
G:ICDFI EXIT
I ICDMDC=8,$D(ICD10OR(84)) S ICDRG=506,ICDFI=1 G EXIT ;84=Major Thumb or Joint Procedures
I ICDMDC=8,$D(ICD10OR(211)) S ICDRG=513,ICDFI=1 G EXIT ;211=Hand or Wrist Procedures, Except Major Thumb or Joint Procedures
I ICDMDC=8,$D(ICD10PD(189)),ICDOTMP="" S ICDRG=$S(ICDMCC=2:548,ICDMCC=1:549,1:550),ICDFI=1 G EXIT
I ICDMDC=9,$D(ICD10OR(137)) S ICDRG=$S(ICDMCC=2:570,ICDMCC=1:571,1:572),ICDFI=1 G EXIT ;Skin Debridemeny
I ICDMDC=9,$D(ICD10OR("k")) D
. I $D(ICD10PD(205))!($D(ICD10PD(34))) S ICDRG=$S(ICDMCC=2:573,ICDMCC=1:574,1:575),ICDFI=1 Q ;205=Skin Ulcer 34=Cellulitis
. S ICDRG=$S(ICDMCC=2:576,ICDMCC=1:577,1:578),ICDFI=1 Q
G:ICDFI EXIT
I $D(ICD10OR(85)) S ICDRG=$S(ICDMCC>0:582,1:583),ICDFI=1 G EXIT
I ICDMDC=9,$D(ICD10PD(205)) S ICDRG=$S(ICDMCC=2:592,ICDMCC=1:593,1:594),ICDFI=1 G EXIT ;205=Skin Ulcers
I $D(ICD10PD(102)) S ICDRG=$S(ICDMCC=2:597,ICDMCC=1:598,1:599),ICDFI=1 G EXIT ;102=Malignant Breat Disorder
I $D(ICD10PD(142)) S ICDRG=$S(ICDMCC>0:600,1:601),ICDFI=1 G EXIT ;142=Non-Malignant Breast Disorders
I $D(ICD10PD(34)),$D(ICD10PD(204)) S ICDRG=$S(ICDMCC>1:602,1:603),ICDFI=1 G EXIT
I ICDMDC=10,$D(ICD10OR(197)) S ICDRG=$S(ICDMCC=2:616,ICDMCC=1:617,1:618),ICDFI=1 G EXIT ;197=Amputation of Lower Limb for Endocrine
I $D(ICD10OR(63)) S ICDRG=652,ICDFI=1 G EXIT ;Kidney Transplant
I ICDMDC=11,$D(ICD10OR(74)) S ICDRG=$S(ICDMCC=2:653,ICDMCC=1:654,1:655),ICDFI=1 G EXIT ;74=Major Bladder Procedures
I $D(ICD10OR(62)) D ;62=Kidney and Ureter Procedures
. I $D(ICD10PD(136)) S ICDRG=$S(ICDMCC=2:656,ICDMCC=1:657,1:658),ICDFI=1 Q ;136=Neoplasm
. I '$D(ICD10PD(136)) S ICDRG=$S(ICDMCC=2:659,ICDMCC=1:660,1:661),ICDFI=1 Q
G:ICDFI EXIT
I ICDMDC=11,$D(ICD10OR(88)) S ICDRG=$S(ICDMCC=2:662,ICDMCC=1:663,1:664),ICDFI=1 G EXIT ;88=Minor Bladder Procedures
I ICDMDC=11 D
. I $D(ICD10OR(128)) S ICDRG=$S(ICDMCC=2:665,ICDMCC=1:666,1:667),ICDFI=1 Q ;128=Prostatectomy
. I $D(ICD10OR(229)) S ICDRG=$S(ICDMCC=2:673,ICDMCC=1:674,1:675),ICDFI=1 Q ;229=Other Kidney and Urinary Tract Procedures
G:ICDFI EXIT
I $D(ICD10PD(184)) S ICDRG=$S(ICDMCC=2:682,ICDMCC=1:683,1:684),ICDFI=1 G EXIT ;184=Renal Failure
I $D(ICD10PD(259)) S ICDRG=$S(ICDMCC=2:686,ICDMCC=1:687,1:688),ICDFI=1 G EXIT ;Kidney and Urinary Tract Neoplasms
I $D(ICD10PD(220)) D ;220=Urinary Stones
. I $D(ICD10OR(45)) S ICDRG=$S(ICDMCC=2:691,1:692),ICDFI=1 Q ;ESW Lithotripsy
. S ICDRG=$S(ICDMCC=2:693,1:694),ICDFI=1 Q
I $D(ICD10PD(260)) S ICDRG=$S(ICDMCC=2:695,1:696),ICDFI=1 G EXIT ;Kidney and Urinary Tract Signs and Symptoms
G:ICDFI EXIT
G ^ICDDRGX3
;
EXIT ;
G EXIT^ICDDRGX3
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDDRGX2 11912 printed Dec 13, 2024@01:50:24 Page 2
ICDDRGX2 ;MKN - GROUPER PROCESS ;06/04/12 3:45pm
+1 ;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21
+2 ;
VARIABLS ;Apply Variables for MDC 1-22
+1 ;
+2 NEW ICDFI,ICDRGT,ICDN,ICDX,ICDREL
+3 ;Check if Procedure Codes related to Primary DX
+4 SET (ICDFI,ICDREL)=0
SET ICDN=""
FOR
SET ICDN=$ORDER(ICDPRC(ICDN))
if ICDN=""
QUIT
SET ICDX=$$MDCT^ICDEX(ICDPRC(ICDN),ICDDATE,.ICDMDC)
if ICDX=1
SET ICDREL=1
+5 ;151=Tracheostomy for Face, Mouth and Neck Diagnoses
IF $DATA(ICD10OR(151))
SET ICDRG=$SELECT(ICDMCC=2:11,ICDMCC=1:12,1:13)
SET ICDFI=1
GOTO EXIT
+6 ;60=Intracranial Vascualr Procedure
IF $DATA(ICD10OR(60))
SET ICDRG=$SELECT(ICDMCC=2:20,ICDMCC=1:21,1:22)
SET ICDFI=1
GOTO EXIT
+7 IF ICDMDC=1
Begin DoDot:1
+8 ;Craniotomy
IF $DATA(ICD10OR("Q"))
Begin DoDot:2
+9 ;C=Chemotherapy Implant
IF $DATA(ICD10OR("C"))
SET ICDRG=23
SET ICDFI=1
QUIT
+10 ;77=Major Device Implant or PDX of Acute Complex CNS
IF $DATA(ICD10OR(77))!($DATA(ICD10PD(13)))
Begin DoDot:3
+11 SET ICDRG=$SELECT(ICDMCC=2:23,1:24)
SET ICDFI=1
QUIT
End DoDot:3
QUIT
+12 IF '($DATA(ICD10OR(77))!($DATA(ICD10PD(13))))
Begin DoDot:3
+13 SET ICDRG=$SELECT(ICDMCC=2:25,ICDMCC=1:26,1:27)
SET ICDFI=1
QUIT
End DoDot:3
QUIT
End DoDot:2
if ICDFI
QUIT
+14 ;Spinal Procedures
IF $DATA(ICD10OR(261))
Begin DoDot:2
+15 IF ICDMCC>0
SET ICDRG=$SELECT(ICDMCC=2:28,1:29)
SET ICDFI=1
QUIT
+16 ;143=Spinal NeuroStimulators
SET ICDRG=$SELECT($DATA(ICD10OR(143)):29,1:30)
SET ICDFI=1
QUIT
End DoDot:2
QUIT
+17 ;164=Ventricualr Shunt Procedures
IF $DATA(ICD10OR(164))
SET ICDRG=$SELECT(ICDMCC=2:31,ICDMCC=1:32,1:33)
SET ICDFI=1
QUIT
+18 ;33=Carotid Artery Stent Procedures
IF $DATA(ICD10OR(33))
SET ICDRG=$SELECT(ICDMCC=2:34,ICDMCC=1:35,1:36)
SET ICDFI=1
QUIT
+19 ;Extracranial Procedures
IF $DATA(ICD10OR(174))
SET ICDRG=$SELECT(ICDMCC=2:37,ICDMCC=1:38,1:39)
SET ICDFI=1
QUIT
+20 ;239=Peripheral and Cranial Nerve and Other Nervous System Procedures
IF $DATA(ICD10OR(239))
Begin DoDot:2
+21 IF ICDMCC>0
SET ICDRG=$SELECT(ICDMCC=2:40,1:41)
SET ICDFI=1
QUIT
+22 ;123=Peripheral Neurostimulator Combinations
IF $DATA(ICD10OR(123))
SET ICDRG=41
SET ICDFI=1
QUIT
+23 SET ICDRG=42
SET ICDFI=1
QUIT
End DoDot:2
QUIT
+24 ;193=Acute Ischemic Stroke with Use of Thrombolytic Agent
IF $DATA(ICD10OR(193))
SET ICDRG=$SELECT(ICDMCC=2:61,ICDMCC=1:62,1:63)
SET ICDFI=1
QUIT
+25 IF $DATA(ICD10PD(86))
Begin DoDot:2
+26 ;307=TPA WITHIN 24 HOURS
IF $DATA(ICD10SD(307))
SET ICDRG=65
SET ICDFI=1
QUIT
+27 ;86=Intracranial Hemorrhage or Cerebral Infarction
SET ICDRG=$SELECT(ICDMCC=2:64,ICDMCC=1:65,1:66)
SET ICDFI=1
QUIT
End DoDot:2
QUIT
+28 ;310=Traumatic Stupor and Coma, Coma > 1 Hour
IF $DATA(ICD10PD(310))
SET ICDRG=$SELECT(ICDMCC=2:82,ICDMCC=1:83,1:84)
SET ICDFI=1
QUIT
+29 ;309=Traumatic Stupor and Coma, Coma < 1 Hour
IF $DATA(ICD10PD(309))
SET ICDRG=$SELECT(ICDMCC=2:85,ICDMCC=1:86,1:87)
SET ICDFI=1
QUIT
+30 ;43=Concussion
IF $DATA(ICD10PD(43))
SET ICDRG=$SELECT(ICDMCC=2:88,ICDMCC=1:89,1:90)
SET ICDFI=1
QUIT
+31 ;155=Other Disorders of Nervous System
IF $DATA(ICD10PD(155))
SET ICDRG=$SELECT(ICDMCC=2:91,ICDMCC=1:92,1:93)
SET ICDFI=1
QUIT
+32 ;234=Bacterial and Tuberculous Infections of Nervous System
IF $DATA(ICD10PD(234))
SET ICDRG=$SELECT(ICDMCC=2:94,ICDMCC=1:95,1:96)
SET ICDFI=1
QUIT
+33 ;276=Non-Bacterial Infections of Nervous System Except Viral Meningitis
IF $DATA(ICD10PD(276))
SET ICDRG=$SELECT(ICDMCC=2:97,ICDMCC=1:98,1:99)
SET ICDFI=1
QUIT
+34 ;188=Seizures
IF $DATA(ICD10PD(188))
SET ICDRG=$SELECT(ICDMCC=2:100,1:101)
SET ICDFI=1
QUIT
+35 ;74=Headaches
IF $DATA(ICD10PD(74))
SET ICDRG=$SELECT(ICDMCC=2:102,1:103)
SET ICDFI=1
QUIT
End DoDot:1
+36 if ICDFI
GOTO EXIT
+37 IF ICDMDC=2
Begin DoDot:1
+38 ;Orbital Procedures
IF $DATA(ICD10OR(99))
SET ICDRG=$SELECT(ICDMCC=2:113,1:114)
SET ICDFI=1
QUIT
+39 ;Extraocular Procedures
IF $DATA(ICD10OR(46))
SET ICDRG=115
SET ICDFI=1
QUIT
+40 ;Intraocular Procedures
IF $DATA(ICD10OR(61))
SET ICDRG=$SELECT(ICDMCC=2:116,1:117)
SET ICDFI=1
QUIT
End DoDot:1
+41 if ICDFI
GOTO EXIT
+42 ;53=Head and Neck procedures
IF ICDMDC=3
IF $DATA(ICD10OR(53))
Begin DoDot:1
+43 ;77=Major Device Implant
IF $DATA(ICD10OR(77))
SET ICDRG=129
SET ICDFI=1
QUIT
+44 SET ICDRG=$SELECT(ICDMCC>0:129,1:130)
SET ICDFI=1
QUIT
+45 ;207=Cranial/Facial Procedures
IF $DATA(ICD10OR(207))
SET ICDRG=$SELECT(ICDMCC>0:131,1:132)
SET ICDFI=1
QUIT
End DoDot:1
+46 if ICDFI
GOTO EXIT
+47 ;76=Major Chest Proc
IF $DATA(ICD10OR(76))
SET ICDRG=$SELECT(ICDMCC=2:163,ICDMCC=1:164,1:165)
SET ICDFI=1
QUIT
+48 if ICDFI
GOTO EXIT
+49 IF ICDMDC=4
Begin DoDot:1
+50 ;225=Mechanical Ventilation 96+ hours
IF $DATA(ICD10OR(225))
SET ICDRG=207
SET ICDFI=1
QUIT
+51 ;87=Mechanical Ventilation <96 hours
IF $DATA(ICD10OR(87))
SET ICDRG=208
SET ICDFI=1
QUIT
End DoDot:1
+52 if ICDFI
GOTO EXIT
+53 ;32=Cardiac Valve and Other Major Cardiothoracic Proc 38=Coronary Bypass
IF $DATA(ICD10OR(32))
IF '$DATA(ICD10OR(38))
Begin DoDot:1
+54 ;28=Cardiac Catherization
IF $DATA(ICD10OR(28))
SET ICDRG=$SELECT(ICDMCC=2:216,ICDMCC=1:217,1:218)
SET ICDFI=1
QUIT
+55 SET ICDRG=$SELECT(ICDMCC=2:219,ICDMCC=1:220,1:221)
SET ICDFI=1
QUIT
End DoDot:1
+56 if ICDFI
GOTO EXIT
+57 ;29=Cardiac Defibrillator Implant
IF $DATA(ICD10OR(29))
Begin DoDot:1
+58 ;22=AMI/HF/Shock and Cardiac Catheterization 28=Cardiac Catherization
IF $DATA(ICD10PD(22))
IF $DATA(ICD10OR(28))
SET ICDRG=$SELECT(ICDMCC=2:222,1:223)
SET ICDFI=1
QUIT
+59 IF '$DATA(ICD10PD(22))
IF $DATA(ICD10OR(28))
SET ICDRG=$SELECT(ICDMCC=2:224,1:225)
SET ICDFI=1
QUIT
+60 IF '$DATA(ICD10OR(28))
SET ICDRG=$SELECT(ICDMCC=2:226,1:227)
SET ICDFI=1
QUIT
End DoDot:1
+61 if ICDFI
GOTO EXIT
+62 ;38=Coronary Bypass
IF $DATA(ICD10OR(38))
Begin DoDot:1
+63 ;129=PTCA
IF $DATA(ICD10OR(129))
SET ICDRG=$SELECT(ICDMCC=2:231,1:232)
SET ICDFI=1
QUIT
+64 ;28=Cardiac Catheterization
IF $DATA(ICD10OR(28))
SET ICDRG=$SELECT(ICDMCC=2:233,1:234)
SET ICDFI=1
QUIT
+65 SET ICDRG=$SELECT(ICDMCC=2:235,1:236)
SET ICDFI=1
QUIT
End DoDot:1
+66 if ICDFI
GOTO EXIT
+67 IF $DATA(ICD10OR(125))
SET ICDRG=$SELECT(ICDMCC=2:242,ICDMCC=1:243,1:244)
SET ICDFI=1
GOTO EXIT
+68 IF $DATA(ICD10OR(12))
SET ICDRG=245
SET ICDFI=1
GOTO EXIT
+69 ;237=Percutaneous Cardiovascular Procedures without Coronary Artery Stent
IF $DATA(ICD10OR(237))
Begin DoDot:1
+70 ;Drug-Eluting Stent
IF $DATA(ICD10OR(43))
IF ICDMCC=2
SET ICDRG=246
SET ICDFI=1
QUIT
+71 ;;Drug-Eluting Stent and 4+ Vessels / Stents
IF $DATA(ICD10OR(43))
IF ICDMCC'=2
IF $DATA(ICD10OR(87))
SET ICDRG=246
SET ICDFI=1
QUIT
+72 IF $DATA(ICD10OR(43))
IF ICDMCC'=2
IF '$DATA(ICD10OR(87))
SET ICDRG=247
SET ICDFI=1
QUIT
+73 IF '$DATA(ICD10OR(43))
IF $DATA(ICD10OR(92))
Begin DoDot:2
+74 ;Non-Drug-Eluting Stent
IF ICDMCC=2
SET ICDRG=248
SET ICDFI=1
QUIT
+75 SET ICDRG=$SELECT($DATA(ICD10OR(87)):248,1:249)
SET ICDFI=1
QUIT
End DoDot:2
if ICDFI
GOTO EXIT
End DoDot:1
+76 if ICDFI
GOTO EXIT
+77 ;Percutaneous Cardiovascular Procedures with Coronary Artery Stent
IF ICDMDC=5
IF $DATA(ICD10OR(236))
SET ICDRG=$SELECT(ICDMCC=2:250,1:251)
SET ICDFI=1
GOTO EXIT
+78 ;31=Cardiac Pacemaker Revision Except Device Replacement
IF $DATA(ICD10OR(31))
IF '$DATA(ICD10OR(101))
SET ICDRG=$SELECT(ICDMCC=2:260,ICDMCC=1:261,1:262)
SET ICDFI=1
GOTO EXIT
+79 IF ICDMDC=5
IF $DATA(ICD10OR(209))
SET ICDRG=$SELECT(ICDMCC=2:266,1:267)
SET ICDFI=1
GOTO EXIT
+80 ; AORTIC & HEART ASST PROC EXPT PULS BALLOON
IF ICDMDC=5
IF $DATA(ICD10OR(199))
SET ICDRG=$SELECT(ICDMCC=2:268,1:269)
SET ICDFI=1
GOTO EXIT
+81 ; MAJOR CARDIOVASCULAR PROC
IF ICDMDC=5
IF $DATA(ICD10OR(75))
SET ICDRG=$SELECT(ICDMCC=2:270,ICDMCC=1:271,1:272)
SET ICDFI=1
GOTO EXIT
+82 ;PERCUTANEOUS INTRACARDIAC PROC
IF ICDMDC=5
IF $DATA(ICD10OR(238))
SET ICDRG=$SELECT(ICDMCC=2:273,1:274)
SET ICDFI=1
GOTO EXIT
+83 ;Acute Myocardial Infarction
IF $DATA(ICD10PD(18))
Begin DoDot:1
+84 ;If Discharged Alive
IF 'ICDEXP
SET ICDRG=$SELECT(ICDMCC=2:280,ICDMCC=1:281,1:282)
SET ICDFI=1
QUIT
+85 SET ICDRG=$SELECT(ICDMCC=2:283,ICDMCC=1:284,1:285)
SET ICDFI=1
QUIT
End DoDot:1
+86 if ICDFI
GOTO EXIT
+87 ;Circulatory Disorders Except AMI with Cardiac Catheterization
IF ICDMDC=5
IF $DATA(ICD10OR(206))
SET ICDRG=$SELECT(ICDMCC=2:286,1:287)
SET ICDFI=1
GOTO EXIT
+88 ;Heart Failure and Shock
IF $DATA(ICD10PD(255))
SET ICDRG=$SELECT(ICDMCC=2:291,ICDMCC=1:292,1:293)
SET ICDFI=1
GOTO EXIT
+89 ;Cardiac Arrest, Unexplained
IF $DATA(ICD10PD(31))
SET ICDRG=$SELECT(ICDMCC=2:296,ICDMCC=1:297,1:298)
SET ICDFI=1
GOTO EXIT
+90 ;Rectal Resection
IF $DATA(ICD10OR(130))
SET ICDRG=$SELECT(ICDMCC=2:332,ICDMCC=1:333,1:334)
SET ICDFI=1
GOTO EXIT
+91 ;Appendectomy
IF $DATA(ICD10OR(20))
Begin DoDot:1
+92 IF $DATA(ICD10PD(41))
SET ICDRG=$SELECT(ICDMCC=2:338,ICDMCC=1:339,1:340)
SET ICDFI=1
QUIT
+93 SET ICDRG=$SELECT(ICDMCC=2:341,ICDMCC=1:342,1:343)
SET ICDFI=1
QUIT
End DoDot:1
+94 if ICDFI
GOTO EXIT
+95 IF ICDMDC=6
Begin DoDot:1
+96 ;Inguinal and Femoral Hernia
IF $DATA(ICD10OR("J"))
SET ICDRG=$SELECT(ICDMCC=2:350,ICDMCC=1:351,1:352)
SET ICDFI=1
QUIT
+97 ;Hernia except Inguinal and Femoral
IF $DATA(ICD10OR(55))
SET ICDRG=$SELECT(ICDMCC=2:353,ICDMCC=1:354,1:355)
SET ICDFI=1
QUIT
End DoDot:1
+98 if ICDFI
GOTO EXIT
+99 ;Major Esophageal Disorders
IF $DATA(ICD10PD(94))
SET ICDRG=$SELECT(ICDMCC=2:368,ICDMCC=1:369,1:370)
SET ICDFI=1
GOTO EXIT
+100 ;Complicated Peptic Ulcer
IF $DATA(ICD10PD(40))
SET ICDRG=$SELECT(ICDMCC=2:380,ICDMCC=1:381,1:382)
SET ICDFI=1
GOTO EXIT
+101 ;Uncomplicated Peptic Ulcer
IF $DATA(ICD10PD(218))
SET ICDRG=$SELECT(ICDMCC=2:383,1:384)
SET ICDFI=1
GOTO EXIT
+102 IF $DATA(ICD10OR(36))!($DATA(ICD10OR(65)))
Begin DoDot:1
+103 IF $DATA(ICD10OR(27))
SET ICDRG=$SELECT(ICDMCC=2:411,ICDMCC=1:412,1:413)
SET ICDFI=1
QUIT
+104 IF '$DATA(ICD10OR(27))
IF '$DATA(ICD10OR(65))
SET ICDRG=$SELECT(ICDMCC=2:414,ICDMCC=1:415,1:416)
SET ICDFI=1
QUIT
+105 IF '$DATA(ICD10OR(27))
IF $DATA(ICD10OR(65))
SET ICDRG=$SELECT(ICDMCC=2:417,ICDMCC=1:418,1:419)
SET ICDFI=1
QUIT
End DoDot:1
+106 if ICDFI
GOTO EXIT
+107 ;54=Hepatobiliary Diagnostic Proc
IF ICDMDC=7
IF $DATA(ICD10OR(54))
SET ICDRG=$SELECT(ICDMCC=2:420,ICDMCC=1:421,1:422)
SET ICDFI=1
GOTO EXIT
+108 IF ICDMDC=8
Begin DoDot:1
+109 ;19=Anterior Spinal Fusion 127=Posterior Spinal Fusion
IF $DATA(ICD10OR(19))
IF $DATA(ICD10OR(127))
SET ICDRG=$SELECT(ICDMCC=2:453,ICDMCC=1:454,1:455)
SET ICDFI=1
QUIT
+110 ;142=Spinal Fusion except Cervical 206=Spinal Curvature / Malignancy / Infection
IF $DATA(ICD10OR(142))
IF $DATA(ICD10PD(206))
SET ICDRG=$SELECT(ICDMCC=2:456,ICDMCC=1:457,1:458)
SET ICDFI=1
QUIT
+111 IF $DATA(ICD10OR(142))
SET ICDRG=$SELECT(ICDMCC=2:459,1:460)
SET ICDFI=1
QUIT
+112 ;201=Bilateral or Multiple Major Joint Procedures of Lower Extremity
IF $GET(ICD10OR(201))=2
SET ICDRG=$SELECT(ICDMCC=2:461,1:462)
SET ICDFI=1
QUIT
+113 ;79=Major Joint Replacement or Reattachment of Lower Extremity
IF $DATA(ICD10OR(79))
SET ICDRG=$SELECT(ICDMCC=2:469,1:470)
SET ICDFI=1
QUIT
+114 ;34=Cervical Spinal Fusion
IF $DATA(ICD10OR(34))
SET ICDRG=$SELECT(ICDMCC=2:471,ICDMCC=1:472,1:473)
SET ICDFI=1
QUIT
End DoDot:1
+115 if ICDFI
GOTO EXIT
+116 ;Knee procedures
IF $DATA(ICD10OR(64))
Begin DoDot:1
+117 IF $DATA(ICD10PD(64))
SET ICDRG=$SELECT(ICDMCC=2:485,ICDMCC=1:486,1:487)
SET ICDFI=1
QUIT
+118 SET ICDRG=$SELECT(ICDMCC>0:488,1:489)
SET ICDFI=1
End DoDot:1
+119 if ICDFI
GOTO EXIT
+120 IF $DATA(ICD10OR(200))
IF '$DATA(ICD10OR(42))
IF '$DATA(ICD10OR(91))
IF ICDMCC=0
SET ICDRG=520
SET ICDFI=1
+121 IF $DATA(ICD10OR(200))
IF ICDMCC>0
SET ICDRG=519
SET ICDFI=1
+122 IF '$DATA(ICD10OR(200))
IF $DATA(ICD10OR(42))
SET ICDRG=518
SET ICDFI=1
+123 IF '$DATA(ICD10OR(200))
IF '$DATA(ICD10OR(42))
IF $DATA(ICD10OR(91))
SET ICDRG=518
SET ICDFI=1
+124 if ICDFI
GOTO EXIT
+125 ;84=Major Thumb or Joint Procedures
IF ICDMDC=8
IF $DATA(ICD10OR(84))
SET ICDRG=506
SET ICDFI=1
GOTO EXIT
+126 ;211=Hand or Wrist Procedures, Except Major Thumb or Joint Procedures
IF ICDMDC=8
IF $DATA(ICD10OR(211))
SET ICDRG=513
SET ICDFI=1
GOTO EXIT
+127 IF ICDMDC=8
IF $DATA(ICD10PD(189))
IF ICDOTMP=""
SET ICDRG=$SELECT(ICDMCC=2:548,ICDMCC=1:549,1:550)
SET ICDFI=1
GOTO EXIT
+128 ;Skin Debridemeny
IF ICDMDC=9
IF $DATA(ICD10OR(137))
SET ICDRG=$SELECT(ICDMCC=2:570,ICDMCC=1:571,1:572)
SET ICDFI=1
GOTO EXIT
+129 IF ICDMDC=9
IF $DATA(ICD10OR("k"))
Begin DoDot:1
+130 ;205=Skin Ulcer 34=Cellulitis
IF $DATA(ICD10PD(205))!($DATA(ICD10PD(34)))
SET ICDRG=$SELECT(ICDMCC=2:573,ICDMCC=1:574,1:575)
SET ICDFI=1
QUIT
+131 SET ICDRG=$SELECT(ICDMCC=2:576,ICDMCC=1:577,1:578)
SET ICDFI=1
QUIT
End DoDot:1
+132 if ICDFI
GOTO EXIT
+133 IF $DATA(ICD10OR(85))
SET ICDRG=$SELECT(ICDMCC>0:582,1:583)
SET ICDFI=1
GOTO EXIT
+134 ;205=Skin Ulcers
IF ICDMDC=9
IF $DATA(ICD10PD(205))
SET ICDRG=$SELECT(ICDMCC=2:592,ICDMCC=1:593,1:594)
SET ICDFI=1
GOTO EXIT
+135 ;102=Malignant Breat Disorder
IF $DATA(ICD10PD(102))
SET ICDRG=$SELECT(ICDMCC=2:597,ICDMCC=1:598,1:599)
SET ICDFI=1
GOTO EXIT
+136 ;142=Non-Malignant Breast Disorders
IF $DATA(ICD10PD(142))
SET ICDRG=$SELECT(ICDMCC>0:600,1:601)
SET ICDFI=1
GOTO EXIT
+137 IF $DATA(ICD10PD(34))
IF $DATA(ICD10PD(204))
SET ICDRG=$SELECT(ICDMCC>1:602,1:603)
SET ICDFI=1
GOTO EXIT
+138 ;197=Amputation of Lower Limb for Endocrine
IF ICDMDC=10
IF $DATA(ICD10OR(197))
SET ICDRG=$SELECT(ICDMCC=2:616,ICDMCC=1:617,1:618)
SET ICDFI=1
GOTO EXIT
+139 ;Kidney Transplant
IF $DATA(ICD10OR(63))
SET ICDRG=652
SET ICDFI=1
GOTO EXIT
+140 ;74=Major Bladder Procedures
IF ICDMDC=11
IF $DATA(ICD10OR(74))
SET ICDRG=$SELECT(ICDMCC=2:653,ICDMCC=1:654,1:655)
SET ICDFI=1
GOTO EXIT
+141 ;62=Kidney and Ureter Procedures
IF $DATA(ICD10OR(62))
Begin DoDot:1
+142 ;136=Neoplasm
IF $DATA(ICD10PD(136))
SET ICDRG=$SELECT(ICDMCC=2:656,ICDMCC=1:657,1:658)
SET ICDFI=1
QUIT
+143 IF '$DATA(ICD10PD(136))
SET ICDRG=$SELECT(ICDMCC=2:659,ICDMCC=1:660,1:661)
SET ICDFI=1
QUIT
End DoDot:1
+144 if ICDFI
GOTO EXIT
+145 ;88=Minor Bladder Procedures
IF ICDMDC=11
IF $DATA(ICD10OR(88))
SET ICDRG=$SELECT(ICDMCC=2:662,ICDMCC=1:663,1:664)
SET ICDFI=1
GOTO EXIT
+146 IF ICDMDC=11
Begin DoDot:1
+147 ;128=Prostatectomy
IF $DATA(ICD10OR(128))
SET ICDRG=$SELECT(ICDMCC=2:665,ICDMCC=1:666,1:667)
SET ICDFI=1
QUIT
+148 ;229=Other Kidney and Urinary Tract Procedures
IF $DATA(ICD10OR(229))
SET ICDRG=$SELECT(ICDMCC=2:673,ICDMCC=1:674,1:675)
SET ICDFI=1
QUIT
End DoDot:1
+149 if ICDFI
GOTO EXIT
+150 ;184=Renal Failure
IF $DATA(ICD10PD(184))
SET ICDRG=$SELECT(ICDMCC=2:682,ICDMCC=1:683,1:684)
SET ICDFI=1
GOTO EXIT
+151 ;Kidney and Urinary Tract Neoplasms
IF $DATA(ICD10PD(259))
SET ICDRG=$SELECT(ICDMCC=2:686,ICDMCC=1:687,1:688)
SET ICDFI=1
GOTO EXIT
+152 ;220=Urinary Stones
IF $DATA(ICD10PD(220))
Begin DoDot:1
+153 ;ESW Lithotripsy
IF $DATA(ICD10OR(45))
SET ICDRG=$SELECT(ICDMCC=2:691,1:692)
SET ICDFI=1
QUIT
+154 SET ICDRG=$SELECT(ICDMCC=2:693,1:694)
SET ICDFI=1
QUIT
End DoDot:1
+155 ;Kidney and Urinary Tract Signs and Symptoms
IF $DATA(ICD10PD(260))
SET ICDRG=$SELECT(ICDMCC=2:695,1:696)
SET ICDFI=1
GOTO EXIT
+156 if ICDFI
GOTO EXIT
+157 GOTO ^ICDDRGX3
+158 ;
EXIT ;
+1 GOTO EXIT^ICDDRGX3
+2 ;
