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

ICD1856C.m

Go to the documentation of this file.
  1. ICD1856C ;ALB/MJB - YEARLY DRG UPDATE;8/9/2010
  1. ;;18.0;DRG Grouper;**56**;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",3111001)) D
  1. ..;kill existing entry for FY
  1. .. S DA(1)=ENTRY,DA=$O(^ICD0(ENTRY,2,"B",3111001,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)=3111001
  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)=3111001
  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)=3111001
  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^
  1. ; +MDC^DRG
  1. ;;02.21^KOS^
  1. ;;+1^23^24^25^26^27
  1. ;;+17^820^821^822^826^827^828
  1. ;;+21^907^908^909
  1. ;;+24^955
  1. ;;02.22^KOS^
  1. ;;+1^23^24^25^26^27
  1. ;;+17^820^821^822^826^827^828
  1. ;;+21^907^908^909
  1. ;;+24^955
  1. ;;12.67^O^
  1. ;;+2^116^117
  1. ;;+21^907^908^909
  1. ;;+24^957^958^959
  1. ;;17.53^O^
  1. ;;+1^34^35^36^37^38^39
  1. ;;+5^252^253^254
  1. ;;+21^907^908^909
  1. ;;+24^957^958^959
  1. ;;17.54^KO^
  1. ;;+1^23^24^25^26^27
  1. ;;+5^252^253^254
  1. ;;+21^907^908^909
  1. ;;+24^957^958^959
  1. ;;17.55^O^
  1. ;;+5^231^232^246^247^248^249^250^251
  1. ;;17.56^O^
  1. ;;+1^37^38^39
  1. ;;+4^166^167^168
  1. ;;+5^252^253^254
  1. ;;+6^356^357^358
  1. ;;+7^423^424^425
  1. ;;+8^515^516^517
  1. ;;+9^579^580^581
  1. ;;+10^628^629^630
  1. ;;+11^673^674^675
  1. ;;+21^907^908^909
  1. ;;+24^957^958^959
  1. ;;17.81^^
  1. ;;35.05^OP^
  1. ;;+5^216^217^218^219^220^221
  1. ;;35.06^OP^
  1. ;;+5^216^217^218^219^220^221
  1. ;;35.07^OP^
  1. ;;+5^216^217^218^219^220^221
  1. ;;35.08^OP^
  1. ;;+5^216^217^218^219^220^221
  1. ;;35.09^OP^
  1. ;;+5^216^217^218^219^220^221
  1. ;;38.26^O^
  1. ;;+5^264
  1. ;;39.77^KOQ^
  1. ;;+1^37^38^39
  1. ;;+5^252^253^254
  1. ;;+21^907^908^909
  1. ;;+24^957^958^959
  1. ;;39.78^KO^
  1. ;;+5^252^253^254
  1. ;;+24^957^958^959
  1. ;;43.82^O^
  1. ;;+5^264
  1. ;;+6^326^327^328
  1. ;;+10^619^620^621
  1. ;;+17^820^821^822^826^827^828
  1. ;;+21^907^908^909
  1. ;;+24^957^958^959
  1. ;;68.24^O^
  1. ;;+13^749^750
  1. ;;68.25^O^
  1. ;;+13^749^750
  1. ;;EXIT