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

ICD1831S.m

Go to the documentation of this file. 
  1. ICD1831S ;;ALB/EG/JAT - FY 2008 UPDATE; 6/19/05 4:08pm ; 11/14/07 5:22pm
  1.  ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
  1.  ;
  1.  Q
  1.  ;       
  1. PRO ;-update operation/procedure codes
  1.  ; from Table 6B in Fed Reg - assumes new codes already added by Lexicon
  1.  D BMES^XPDUTL(">>>Modifying new op/pro codes - file 80.1")
  1.  N LINE,X,ICDPROC,ENTRY,DA,DIE,DR,IDENT,MDC24,SUBLINE,DATA,FDA
  1.  F LINE=1:1 S X=$T(REV+LINE) S ICDPROC=$P(X,";;",2) Q:ICDPROC="EXIT"  D
  1.  .Q:ICDPROC["+"
  1.  .; check if already created in case patch being re-installed
  1.  .S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0))
  1.  .I $D(^ICD0(ENTRY,2,"B",3071001)) D
  1.  ..;kill existing entry for FY
  1.  .. S DA(1)=ENTRY,DA=$O(^ICD0(ENTRY,2,"B",3071001,0))
  1.  .. S DIK="^ICD0("_DA(1)_",2," D ^DIK K DIK,DA
  1.  .I ENTRY D
  1.  ..;check for possible inactive dupe
  1.  ..I $P($G(^ICD0(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",ENTRY)) I 'ENTRY Q
  1.  ..S DA=ENTRY,DIE="^ICD0("
  1.  ..S IDENT=$P(ICDPROC,U,2)
  1.  ..S MDC24=$P(ICDPROC,U,3)
  1.  ..S DR="2///^S X=IDENT;5///^S X=MDC24"
  1.  ..I IDENT=""&(MDC24="") Q
  1.  ..D ^DIE
  1.  ..;add 80.171, 80.1711 and 80.17111 records
  1.  ..F SUBLINE=1:1 S X=$T(REV+LINE+SUBLINE) S DATA=$P(X,";;",2) Q:DATA'["+"  D
  1.  ...I SUBLINE=1 D
  1.  ....S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
  1.  ....S FDA(1820,80.171,"+2,?1,",.01)=3071001
  1.  ....D UPDATE^DIE("","FDA(1820)") K FDA(1820)
  1.  ...S DATA=$E(DATA,2,99)
  1.  ...S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
  1.  ...S FDA(1820,80.171,"?2,?1,",.01)=3071001
  1.  ...S FDA(1820,80.1711,"+3,?2,?1,",.01)=$P(DATA,U)
  1.  ...D UPDATE^DIE("","FDA(1820)") K FDA(1820)
  1.  ...S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
  1.  ...S FDA(1820,80.171,"?2,?1,",.01)=3071001
  1.  ...S FDA(1820,80.1711,"?3,?2,?1,",.01)=$P(DATA,U)
  1.  ...S FDA(1820,80.17111,"+4,?3,?2,?1,",.01)=$P(DATA,U,2)
  1.  ...I $P(DATA,U,3) S FDA(1820,80.17111,"+5,?3,?2,?1,",.01)=$P(DATA,U,3)
  1.  ...I $P(DATA,U,4) S FDA(1820,80.17111,"+6,?3,?2,?1,",.01)=$P(DATA,U,4)
  1.  ...I $P(DATA,U,5) S FDA(1820,80.17111,"+7,?3,?2,?1,",.01)=$P(DATA,U,5)
  1.  ...I $P(DATA,U,6) S FDA(1820,80.17111,"+8,?3,?2,?1,",.01)=$P(DATA,U,6)
  1.  ...I $P(DATA,U,7) S FDA(1820,80.17111,"+9,?3,?2,?1,",.01)=$P(DATA,U,7)
  1.  ...I $P(DATA,U,8) S FDA(1820,80.17111,"+10,?3,?2,?1,",.01)=$P(DATA,U,8)
  1.  ...I $P(DATA,U,9) S FDA(1820,80.17111,"+11,?3,?2,?1,",.01)=$P(DATA,U,9)
  1.  ...D UPDATE^DIE("","FDA(1820)") K FDA(1820)
  1.  Q
  1.  ; 
  1. REV ;PROC/OP^IDENTIFIER^MDC24^DRG...
  1.  ;;39.72^OQK^
  1.  ;;+1^25^26^27^23^24^20^21^22
  1.  ;;+5^237^238
  1.  ;;+11^673^374^675
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;39.74^OQK^
  1.  ;;+1^25^26^27^23^24
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;39.79^OQK^
  1.  ;;+1^25^26^27^23^24^20^21^22
  1.  ;;+5^237^238
  1.  ;;+11^673^374^675
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;00.62^O^
  1.  ;;+1^25^26^27^23^24
  1.  ;;+5^237^238
  1.  ;;+11^673^374^675
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;00.83^OM^
  1.  ;;+8^485^486^487^488^489
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;00.84^OM^
  1.  ;;+8^485^486^487^488^489
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;84.59^O^
  1.  ;;+1^28^29^30
  1.  ;;+8^490^491
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;84.65^O^
  1.  ;;+1^28^29^30
  1.  ;;+8^490^491
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;84.62^O^
  1.  ;;+1^28^29^30
  1.  ;;+8^490^491
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;84.82^O^
  1.  ;;+1^28^29^30
  1.  ;;+8^490^491
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;00.52^O^
  1.  ;;+5^245
  1.  ;;00.54^O^
  1.  ;;+5^245
  1.  ;;37.95^O^
  1.  ;;+5^245
  1.  ;;37.96^O^
  1.  ;;+5^245
  1.  ;;37.97^O^
  1.  ;;+5^245
  1.  ;;37.98^O^
  1.  ;;+5^245
  1.  ;;57.83^O^
  1.  ;;+6^344^345^346
  1.  ;;+11^653^654^655
  1.  ;;+12^715^716^718
  1.  ;;+13^749^750
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;69.42^O^
  1.  ;;+6^344^345^346
  1.  ;;+13^736^737^743
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;70.75^O^
  1.  ;;+6^344^345^346
  1.  ;;+13^746^747
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;71.72^O^
  1.  ;;+6^344^345^346
  1.  ;;+13^746^747
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;53.00^OzJ^
  1.  ;;53.01^OzJ^
  1.  ;;53.02^OzJ^
  1.  ;;53.03^OzJ^
  1.  ;;53.04^OzJ^
  1.  ;;53.05^OzJ^
  1.  ;;53.10^OzJ^
  1.  ;;53.11^OzJ^
  1.  ;;53.12^OzJ^
  1.  ;;53.13^OzJ^
  1.  ;;53.14^OzJ^
  1.  ;;53.15^OzJ^
  1.  ;;53.16^OzJ^
  1.  ;;53.17^OzJ^
  1.  ;;53.21^OzJ^
  1.  ;;53.29^OzJ^
  1.  ;;53.31^OzJ^
  1.  ;;53.39^OzJ^
  1.  ;;81.00^O
  1.  ;;+1^28^29^30
  1.  ;;+8^456^457^458^459^460
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;81.01^O
  1.  ;;+8^471^472^473
  1.  ;;81.04^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;81.05^O
  1.  ;;+8^453^454^455^
  1.  ;;81.30^O
  1.  ;;+1^28^29^30
  1.  ;;+8^456^457^458^459^460
  1.  ;;+21+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;81.39^O
  1.  ;;+1^28^29^30
  1.  ;;+8^456^457^458^459^460
  1.  ;;+21+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;81.32^O
  1.  ;;+8^453^454^455^471^472^473
  1.  ;;81.34^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;81.36^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;81.03^O
  1.  ;;+8^453^454^455^471^472^473
  1.  ;;81.07^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;81.08^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;81.31^O
  1.  ;;+8^471^472^473
  1.  ;;81.33^O
  1.  ;;+8^453^454^455^471^472^473
  1.  ;;81.35^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;81.37^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;81.38^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;81.02^O
  1.  ;;+8^453^454^455^471^472^473
  1.  ;;81.06^O
  1.  ;;+8^453^454^455^456^457^458
  1.  ;;01.15^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+8^477^478^479
  1.  ;;+10^628^629^630
  1.  ;;01.19^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+8^477^478^479
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;01.6^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^495^496^497
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+24^955
  1.  ;;01.25^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^515^516^517
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;02.01^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^515^516^517
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;02.02^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^515^516^517
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;02.03^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^515^516^517
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;02.04^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^515^516^517
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;02.05^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^515^516^517
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;02.06^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^515^516^517
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;02.07^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+8^515^516^517
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;85.22^Om^
  1.  ;;+9^582^583^584^585
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;85.23^Om
  1.  ;;+9^582^583^584^585
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;EXIT