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

ICD1831V.m

Go to the documentation of this file. 
  1. ICD1831V ;;ALB/EG/JAT - FY 2008 UPDATE; 6/19/05 4:08pm ; 11/14/07 5:25pm
  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.  ;;07.13^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.14^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.15^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.17^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.51^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.52^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.53^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.54^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.59^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.61^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.62^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.63^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+9^579^580^581
  1.  ;;+10^614^615
  1.  ;;07.64^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+9^579^580^581
  1.  ;;+10^614^615
  1.  ;;07.65^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+9^579^580^581
  1.  ;;+10^614^615
  1.  ;;07.68^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+9^579^580^581
  1.  ;;+10^614^615
  1.  ;;07.69^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+9^579^580^581
  1.  ;;+10^614^615
  1.  ;;07.71^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+10^614^615
  1.  ;;07.72^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+9^579^580^581
  1.  ;;+10^614^615
  1.  ;;07.79^OQ^
  1.  ;;+1^23^24^25^26^27
  1.  ;;+9^579^580^581
  1.  ;;+10^614^615
  1.  ;;51.23^OT
  1.  ;;+6^356^357^358
  1.  ;;+7^411^412^413^417^418^419
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;57.6^O
  1.  ;;+11^653^654^655
  1.  ;;+12^707^708
  1.  ;;+13^749^750
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;57.71^O
  1.  ;;+11^653^654^655
  1.  ;;+12^707^708
  1.  ;;+13^749^750
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;57.79^O
  1.  ;;+11^653^654^655
  1.  ;;+12^707^708
  1.  ;;+13^749^750
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;57.71^O
  1.  ;;+11^653^654^655
  1.  ;;+12^707^708
  1.  ;;+13^749^750
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;57.88^O
  1.  ;;+11^653^654^655
  1.  ;;+12^707^708
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;01.12^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;01.14^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;01.42^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+24^955
  1.  ;;01.51^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+24^955
  1.  ;;01.52^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+24^955
  1.  ;;01.53^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+24^955
  1.  ;;01.59^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+24^955
  1.  ;;02.99^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.91^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;01.18^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^957^958^959
  1.  ;;01.23^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;01.24^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+3^131^132
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;01.31^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;01.32^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;01.39^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;01.41^OQ
  1.  ;;+1^23^24^25^26^27
  1.  ;;+17^820^821^822^826^827^828
  1.  ;;+21^907^908^909
  1.  ;;+24^955
  1.  ;;EXIT