Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ICDDRGX2

ICDDRGX2.m

Go to the documentation of this file.
  1. ICDDRGX2 ;MKN - GROUPER PROCESS ;06/04/12 3:45pm
  1. ;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21
  1. ;
  1. VARIABLS ;Apply Variables for MDC 1-22
  1. ;
  1. N ICDFI,ICDRGT,ICDN,ICDX,ICDREL
  1. ;Check if Procedure Codes related to Primary DX
  1. 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
  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
  1. I $D(ICD10OR(60)) S ICDRG=$S(ICDMCC=2:20,ICDMCC=1:21,1:22),ICDFI=1 G EXIT ;60=Intracranial Vascualr Procedure
  1. I ICDMDC=1 D
  1. . I $D(ICD10OR("Q")) D Q:ICDFI ;Craniotomy
  1. . . I $D(ICD10OR("C")) S ICDRG=23,ICDFI=1 Q ;C=Chemotherapy Implant
  1. . . I $D(ICD10OR(77))!($D(ICD10PD(13))) D Q ;77=Major Device Implant or PDX of Acute Complex CNS
  1. . . . S ICDRG=$S(ICDMCC=2:23,1:24),ICDFI=1 Q
  1. . . I '($D(ICD10OR(77))!($D(ICD10PD(13)))) D Q
  1. . . . S ICDRG=$S(ICDMCC=2:25,ICDMCC=1:26,1:27),ICDFI=1 Q
  1. . I $D(ICD10OR(261)) D Q ;Spinal Procedures
  1. . . I ICDMCC>0 S ICDRG=$S(ICDMCC=2:28,1:29),ICDFI=1 Q
  1. . . S ICDRG=$S($D(ICD10OR(143)):29,1:30),ICDFI=1 Q ;143=Spinal NeuroStimulators
  1. . I $D(ICD10OR(164)) S ICDRG=$S(ICDMCC=2:31,ICDMCC=1:32,1:33),ICDFI=1 Q ;164=Ventricualr Shunt Procedures
  1. . I $D(ICD10OR(33)) S ICDRG=$S(ICDMCC=2:34,ICDMCC=1:35,1:36),ICDFI=1 Q ;33=Carotid Artery Stent Procedures
  1. . I $D(ICD10OR(174)) S ICDRG=$S(ICDMCC=2:37,ICDMCC=1:38,1:39),ICDFI=1 Q ;Extracranial Procedures
  1. . I $D(ICD10OR(239)) D Q ;239=Peripheral and Cranial Nerve and Other Nervous System Procedures
  1. . . I ICDMCC>0 S ICDRG=$S(ICDMCC=2:40,1:41),ICDFI=1 Q
  1. . . I $D(ICD10OR(123)) S ICDRG=41,ICDFI=1 Q ;123=Peripheral Neurostimulator Combinations
  1. . . S ICDRG=42,ICDFI=1 Q
  1. . 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
  1. . I $D(ICD10PD(86)) D Q
  1. . . I $D(ICD10SD(307)) S ICDRG=65,ICDFI=1 Q ;307=TPA WITHIN 24 HOURS
  1. . . S ICDRG=$S(ICDMCC=2:64,ICDMCC=1:65,1:66),ICDFI=1 Q ;86=Intracranial Hemorrhage or Cerebral Infarction
  1. . 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
  1. . 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
  1. . I $D(ICD10PD(43)) S ICDRG=$S(ICDMCC=2:88,ICDMCC=1:89,1:90),ICDFI=1 Q ;43=Concussion
  1. . I $D(ICD10PD(155)) S ICDRG=$S(ICDMCC=2:91,ICDMCC=1:92,1:93),ICDFI=1 Q ;155=Other Disorders of Nervous System
  1. . 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
  1. . 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
  1. . I $D(ICD10PD(188)) S ICDRG=$S(ICDMCC=2:100,1:101),ICDFI=1 Q ;188=Seizures
  1. . I $D(ICD10PD(74)) S ICDRG=$S(ICDMCC=2:102,1:103),ICDFI=1 Q ;74=Headaches
  1. G:ICDFI EXIT
  1. I ICDMDC=2 D
  1. . I $D(ICD10OR(99)) S ICDRG=$S(ICDMCC=2:113,1:114),ICDFI=1 Q ;Orbital Procedures
  1. . I $D(ICD10OR(46)) S ICDRG=115,ICDFI=1 Q ;Extraocular Procedures
  1. . I $D(ICD10OR(61)) S ICDRG=$S(ICDMCC=2:116,1:117),ICDFI=1 Q ;Intraocular Procedures
  1. G:ICDFI EXIT
  1. I ICDMDC=3,$D(ICD10OR(53)) D ;53=Head and Neck procedures
  1. . I $D(ICD10OR(77)) S ICDRG=129,ICDFI=1 Q ;77=Major Device Implant
  1. . S ICDRG=$S(ICDMCC>0:129,1:130),ICDFI=1 Q
  1. . I $D(ICD10OR(207)) S ICDRG=$S(ICDMCC>0:131,1:132),ICDFI=1 Q ;207=Cranial/Facial Procedures
  1. G:ICDFI EXIT
  1. I $D(ICD10OR(76)) S ICDRG=$S(ICDMCC=2:163,ICDMCC=1:164,1:165),ICDFI=1 Q ;76=Major Chest Proc
  1. G:ICDFI EXIT
  1. I ICDMDC=4 D
  1. . I $D(ICD10OR(225)) S ICDRG=207,ICDFI=1 Q ;225=Mechanical Ventilation 96+ hours
  1. . I $D(ICD10OR(87)) S ICDRG=208,ICDFI=1 Q ;87=Mechanical Ventilation <96 hours
  1. G:ICDFI EXIT
  1. I $D(ICD10OR(32)),'$D(ICD10OR(38)) D ;32=Cardiac Valve and Other Major Cardiothoracic Proc 38=Coronary Bypass
  1. . I $D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:216,ICDMCC=1:217,1:218),ICDFI=1 Q ;28=Cardiac Catherization
  1. . S ICDRG=$S(ICDMCC=2:219,ICDMCC=1:220,1:221),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. I $D(ICD10OR(29)) D ;29=Cardiac Defibrillator Implant
  1. . 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
  1. . I '$D(ICD10PD(22)),$D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:224,1:225),ICDFI=1 Q
  1. . I '$D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:226,1:227),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. I $D(ICD10OR(38)) D ;38=Coronary Bypass
  1. . I $D(ICD10OR(129)) S ICDRG=$S(ICDMCC=2:231,1:232),ICDFI=1 Q ;129=PTCA
  1. . I $D(ICD10OR(28)) S ICDRG=$S(ICDMCC=2:233,1:234),ICDFI=1 Q ;28=Cardiac Catheterization
  1. . S ICDRG=$S(ICDMCC=2:235,1:236),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. I $D(ICD10OR(125)) S ICDRG=$S(ICDMCC=2:242,ICDMCC=1:243,1:244),ICDFI=1 G EXIT
  1. I $D(ICD10OR(12)) S ICDRG=245,ICDFI=1 G EXIT
  1. I $D(ICD10OR(237)) D ;237=Percutaneous Cardiovascular Procedures without Coronary Artery Stent
  1. . I $D(ICD10OR(43)),ICDMCC=2 S ICDRG=246,ICDFI=1 Q ;Drug-Eluting Stent
  1. . I $D(ICD10OR(43)),ICDMCC'=2,$D(ICD10OR(87)) S ICDRG=246,ICDFI=1 Q ;;Drug-Eluting Stent and 4+ Vessels / Stents
  1. . I $D(ICD10OR(43)),ICDMCC'=2,'$D(ICD10OR(87)) S ICDRG=247,ICDFI=1 Q
  1. . I '$D(ICD10OR(43)),$D(ICD10OR(92)) D G:ICDFI EXIT
  1. . . I ICDMCC=2 S ICDRG=248,ICDFI=1 Q ;Non-Drug-Eluting Stent
  1. . . S ICDRG=$S($D(ICD10OR(87)):248,1:249),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. 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
  1. 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
  1. I ICDMDC=5,$D(ICD10OR(209)) S ICDRG=$S(ICDMCC=2:266,1:267),ICDFI=1 G EXIT
  1. 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
  1. I ICDMDC=5,$D(ICD10OR(75)) S ICDRG=$S(ICDMCC=2:270,ICDMCC=1:271,1:272),ICDFI=1 G EXIT ; MAJOR CARDIOVASCULAR PROC
  1. I ICDMDC=5,$D(ICD10OR(238)) S ICDRG=$S(ICDMCC=2:273,1:274),ICDFI=1 G EXIT ;PERCUTANEOUS INTRACARDIAC PROC
  1. I $D(ICD10PD(18)) D ;Acute Myocardial Infarction
  1. . I 'ICDEXP S ICDRG=$S(ICDMCC=2:280,ICDMCC=1:281,1:282),ICDFI=1 Q ;If Discharged Alive
  1. . S ICDRG=$S(ICDMCC=2:283,ICDMCC=1:284,1:285),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. 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
  1. I $D(ICD10PD(255)) S ICDRG=$S(ICDMCC=2:291,ICDMCC=1:292,1:293),ICDFI=1 G EXIT ;Heart Failure and Shock
  1. I $D(ICD10PD(31)) S ICDRG=$S(ICDMCC=2:296,ICDMCC=1:297,1:298),ICDFI=1 G EXIT ;Cardiac Arrest, Unexplained
  1. I $D(ICD10OR(130)) S ICDRG=$S(ICDMCC=2:332,ICDMCC=1:333,1:334),ICDFI=1 G EXIT ;Rectal Resection
  1. I $D(ICD10OR(20)) D ;Appendectomy
  1. . I $D(ICD10PD(41)) S ICDRG=$S(ICDMCC=2:338,ICDMCC=1:339,1:340),ICDFI=1 Q
  1. . S ICDRG=$S(ICDMCC=2:341,ICDMCC=1:342,1:343),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. I ICDMDC=6 D
  1. . I $D(ICD10OR("J")) S ICDRG=$S(ICDMCC=2:350,ICDMCC=1:351,1:352),ICDFI=1 Q ;Inguinal and Femoral Hernia
  1. . I $D(ICD10OR(55)) S ICDRG=$S(ICDMCC=2:353,ICDMCC=1:354,1:355),ICDFI=1 Q ;Hernia except Inguinal and Femoral
  1. G:ICDFI EXIT
  1. I $D(ICD10PD(94)) S ICDRG=$S(ICDMCC=2:368,ICDMCC=1:369,1:370),ICDFI=1 G EXIT ;Major Esophageal Disorders
  1. I $D(ICD10PD(40)) S ICDRG=$S(ICDMCC=2:380,ICDMCC=1:381,1:382),ICDFI=1 G EXIT ;Complicated Peptic Ulcer
  1. I $D(ICD10PD(218)) S ICDRG=$S(ICDMCC=2:383,1:384),ICDFI=1 G EXIT ;Uncomplicated Peptic Ulcer
  1. I $D(ICD10OR(36))!($D(ICD10OR(65))) D
  1. . I $D(ICD10OR(27)) S ICDRG=$S(ICDMCC=2:411,ICDMCC=1:412,1:413),ICDFI=1 Q
  1. . I '$D(ICD10OR(27)),'$D(ICD10OR(65)) S ICDRG=$S(ICDMCC=2:414,ICDMCC=1:415,1:416),ICDFI=1 Q
  1. . I '$D(ICD10OR(27)),$D(ICD10OR(65)) S ICDRG=$S(ICDMCC=2:417,ICDMCC=1:418,1:419),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. 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
  1. I ICDMDC=8 D
  1. . 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
  1. . 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
  1. . I $D(ICD10OR(142)) S ICDRG=$S(ICDMCC=2:459,1:460),ICDFI=1 Q
  1. . 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
  1. . I $D(ICD10OR(79)) S ICDRG=$S(ICDMCC=2:469,1:470),ICDFI=1 Q ;79=Major Joint Replacement or Reattachment of Lower Extremity
  1. . I $D(ICD10OR(34)) S ICDRG=$S(ICDMCC=2:471,ICDMCC=1:472,1:473),ICDFI=1 Q ;34=Cervical Spinal Fusion
  1. G:ICDFI EXIT
  1. I $D(ICD10OR(64)) D ;Knee procedures
  1. . I $D(ICD10PD(64)) S ICDRG=$S(ICDMCC=2:485,ICDMCC=1:486,1:487),ICDFI=1 Q
  1. . S ICDRG=$S(ICDMCC>0:488,1:489),ICDFI=1
  1. G:ICDFI EXIT
  1. I $D(ICD10OR(200)),'$D(ICD10OR(42)),'$D(ICD10OR(91)),ICDMCC=0 S ICDRG=520,ICDFI=1
  1. I $D(ICD10OR(200)),ICDMCC>0 S ICDRG=519,ICDFI=1
  1. I '$D(ICD10OR(200)),$D(ICD10OR(42)) S ICDRG=518,ICDFI=1
  1. I '$D(ICD10OR(200)),'$D(ICD10OR(42)),$D(ICD10OR(91)) S ICDRG=518,ICDFI=1
  1. G:ICDFI EXIT
  1. I ICDMDC=8,$D(ICD10OR(84)) S ICDRG=506,ICDFI=1 G EXIT ;84=Major Thumb or Joint Procedures
  1. I ICDMDC=8,$D(ICD10OR(211)) S ICDRG=513,ICDFI=1 G EXIT ;211=Hand or Wrist Procedures, Except Major Thumb or Joint Procedures
  1. I ICDMDC=8,$D(ICD10PD(189)),ICDOTMP="" S ICDRG=$S(ICDMCC=2:548,ICDMCC=1:549,1:550),ICDFI=1 G EXIT
  1. I ICDMDC=9,$D(ICD10OR(137)) S ICDRG=$S(ICDMCC=2:570,ICDMCC=1:571,1:572),ICDFI=1 G EXIT ;Skin Debridemeny
  1. I ICDMDC=9,$D(ICD10OR("k")) D
  1. . 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
  1. . S ICDRG=$S(ICDMCC=2:576,ICDMCC=1:577,1:578),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. I $D(ICD10OR(85)) S ICDRG=$S(ICDMCC>0:582,1:583),ICDFI=1 G EXIT
  1. I ICDMDC=9,$D(ICD10PD(205)) S ICDRG=$S(ICDMCC=2:592,ICDMCC=1:593,1:594),ICDFI=1 G EXIT ;205=Skin Ulcers
  1. I $D(ICD10PD(102)) S ICDRG=$S(ICDMCC=2:597,ICDMCC=1:598,1:599),ICDFI=1 G EXIT ;102=Malignant Breat Disorder
  1. I $D(ICD10PD(142)) S ICDRG=$S(ICDMCC>0:600,1:601),ICDFI=1 G EXIT ;142=Non-Malignant Breast Disorders
  1. I $D(ICD10PD(34)),$D(ICD10PD(204)) S ICDRG=$S(ICDMCC>1:602,1:603),ICDFI=1 G EXIT
  1. 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
  1. I $D(ICD10OR(63)) S ICDRG=652,ICDFI=1 G EXIT ;Kidney Transplant
  1. 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
  1. I $D(ICD10OR(62)) D ;62=Kidney and Ureter Procedures
  1. . I $D(ICD10PD(136)) S ICDRG=$S(ICDMCC=2:656,ICDMCC=1:657,1:658),ICDFI=1 Q ;136=Neoplasm
  1. . I '$D(ICD10PD(136)) S ICDRG=$S(ICDMCC=2:659,ICDMCC=1:660,1:661),ICDFI=1 Q
  1. G:ICDFI EXIT
  1. 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
  1. I ICDMDC=11 D
  1. . I $D(ICD10OR(128)) S ICDRG=$S(ICDMCC=2:665,ICDMCC=1:666,1:667),ICDFI=1 Q ;128=Prostatectomy
  1. . 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
  1. G:ICDFI EXIT
  1. I $D(ICD10PD(184)) S ICDRG=$S(ICDMCC=2:682,ICDMCC=1:683,1:684),ICDFI=1 G EXIT ;184=Renal Failure
  1. I $D(ICD10PD(259)) S ICDRG=$S(ICDMCC=2:686,ICDMCC=1:687,1:688),ICDFI=1 G EXIT ;Kidney and Urinary Tract Neoplasms
  1. I $D(ICD10PD(220)) D ;220=Urinary Stones
  1. . I $D(ICD10OR(45)) S ICDRG=$S(ICDMCC=2:691,1:692),ICDFI=1 Q ;ESW Lithotripsy
  1. . S ICDRG=$S(ICDMCC=2:693,1:694),ICDFI=1 Q
  1. I $D(ICD10PD(260)) S ICDRG=$S(ICDMCC=2:695,1:696),ICDFI=1 G EXIT ;Kidney and Urinary Tract Signs and Symptoms
  1. G:ICDFI EXIT
  1. G ^ICDDRGX3
  1. ;
  1. EXIT ;
  1. G EXIT^ICDDRGX3
  1. ;