source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1832T.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1ICD1832T ; ALB/JAT - FY 2008 UPDATE; 7/27/05 14:50;
2 ;;18.0;DRG Grouper;**32**;Oct 13,2000;Build 9
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 ;;338.21^91^92^93
35 ;;338.22^91^92^93
36 ;;338.28^91^92^93
37 ;;338.29^91^92^93
38 ;;338.4^91^92^93
39 ;;403.00^682^683^684
40 ;;403.10^682^683^684
41 ;;403.90^682^683^684
42 ;;EXIT
Note: See TracBrowser for help on using the repository browser.