source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1831T.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1ICD1831T ; ALB/JAT - FY 2008 UPDATE; 7/27/05 14:50;
2 ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
3 Q
4 ;
5DIAG ;
6 D BMES^XPDUTL(">>>DRG Reclassification changes")
7 D MES^XPDUTL(">>>Modifying diagnosis codes - file 80")
8 D MES^XPDUTL(">>>for new DRGs")
9 N LINE,X,ICDDIAG,ENTRY,FDA
10 F LINE=1:1 S X=$T(REVD+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
11 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0))
12 .I ENTRY D
13 ..;check for possible inactive dupe
14 ..I $P($G(^ICD9(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I 'ENTRY Q
15 ..;check if already created in case patch being re-installed
16 ..I $D(^ICD9(ENTRY,3,"B",3071001)) D
17 ...S DA(1)=ENTRY,DA=$O(^ICD9(ENTRY,3,"B",3071001,0))
18 ...S DIK="^ICD9("_DA(1)_",3," D ^DIK
19 ..; add 80.071 and 80.711 records
20 ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
21 ..S FDA(1820,80.071,"+2,?1,",.01)=3071001
22 ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
23 ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
24 ..S FDA(1820,80.071,"?2,?1,",.01)=3071001
25 ..S FDA(1820,80.711,"+3,?2,?1,",.01)=$P(ICDDIAG,U,2)
26 ..I $P(ICDDIAG,U,3) S FDA(1820,80.711,"+4,?2,?1,",.01)=$P(ICDDIAG,U,3)
27 ..I $P(ICDDIAG,U,4) S FDA(1820,80.711,"+5,?2,?1,",.01)=$P(ICDDIAG,U,4)
28 ..I $P(ICDDIAG,U,5) S FDA(1820,80.711,"+6,?2,?1,",.01)=$P(ICDDIAG,U,5)
29 ..I $P(ICDDIAG,U,6) S FDA(1820,80.711,"+7,?2,?1,",.01)=$P(ICDDIAG,U,6)
30 ..I $P(ICDDIAG,U,7) S FDA(1820,80.711,"+8,?2,?1,",.01)=$P(ICDDIAG,U,7)
31 ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
32 Q
33REVD ; DIAG^DRG...
34 ;;015.02^456^457^458^459
35 ;;015.04^456^457^458^459
36 ;;015.05^456^457^458^459
37 ;;730.08^456^457^458^459
38 ;;730.18^456^457^458^459
39 ;;730.28^456^457^458^459
40 ;;V58.0^849
41 ;;V67.1^849
42 ;;V58.11^837^838^839^846^847^848
43 ;;V58.12^837^838^839^846^847^848
44 ;;V67.2^837^838^839^846^847^848
45 ;;958.3^856^857^858^862^863
46 ;;998.51^856^857^858^862^863
47 ;;998.59^856^857^858^862^863
48 ;;999.39^856^857^858^867^868^869
49 ;;EXIT
Note: See TracBrowser for help on using the repository browser.