source: WorldVistAEHR/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1827G.m@ 701

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1ICD1827G ;;BAY/JAT - FY 2007 UPDATE;
2 ;;18.0;DRG Grouper;**27**;Oct 13,2000;Build 2
3 ;
4 D PRO
5 D CC
6 D DEL
7 D KIL
8 D DRG
9 D ACCEPT
10 Q
11PRO ; update procedures with new identifier
12 N LINE,X,ICDPROC,ENTRY,IDENT,DA,DIE,DR,DUPE
13 F LINE=1:1 S X=$T(PROID+LINE) S ICDPROC=$P(X,";;",2) Q:ICDPROC="EXIT" D
14 .S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0)) I ENTRY D
15 ..; check for any dupe (there are some in MNTVBB)
16 ..S DUPE=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",ENTRY)) I DUPE Q
17 ..S IDENT=$P($G(^ICD0(ENTRY,0)),U,2)
18 ..;check if already done in case being reinstalled
19 ..I IDENT[$P(ICDPROC,U,2) Q
20 ..S IDENT=IDENT_$P(ICDPROC,U,2)
21 ..I $P(ICDPROC,U)="51.21" S IDENT="O"
22 ..I $P(ICDPROC,U)="51.24" S IDENT="O"
23 ..S DA=ENTRY,DIE="^ICD0("
24 ..S DR="2///^S X=IDENT"
25 ..D ^DIE
26 Q
27PROID ;
28 ;;53.61^z
29 ;;78.60^z
30 ;;78.61^z
31 ;;78.63^z
32 ;;78.64^z
33 ;;78.65^z
34 ;;78.68^z
35 ;;39.52^7
36 ;;51.21^999999
37 ;;51.24^999999
38 ;;EXIT
39CC ; update complications/comorbidities field in diag file
40 N LINE,X,ICDDIAG,ENTRY,IDENT,DA,DIE,DR,DUPE
41 F LINE=1:1 S X=$T(CCID+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
42 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0)) I ENTRY D
43 ..; check for any dupe (there are some in MNTVBB)
44 ..S DUPE=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I DUPE Q
45 ..S IDENT=1
46 ..S DA=ENTRY,DIE="^ICD9("
47 ..S DR="70///^S X=IDENT"
48 ..D ^DIE
49 Q
50CCID ;
51 ;;707.00^
52 ;;707.01^
53 ;;707.02^
54 ;;707.04^
55 ;;707.05^
56 ;;707.06^
57 ;;707.09^
58 ;;EXIT
59DEL ; delete DRG 496 in procedure file
60 N LINE,X,ICDPROC,ENTRY,ICIENS,FDA
61 F LINE=1:1 S X=$T(REV+LINE) S ICDPROC=$P(X,";;",2) Q:ICDPROC="EXIT" D
62 .S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0))
63 .I ENTRY D
64 ..;check for possible inactive dupe
65 ..I $P($G(^ICD0(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",ENTRY)) I 'ENTRY Q
66 ..; check if already done in case patch being re-installed
67 ..Q:'$D(^ICD0(ENTRY,2,1,1,2,1,"B",496,1))
68 ..S ICIENS=1,ICIENS(1)=2,ICIENS(2)=1,ICIENS(3)=ENTRY
69 ..S ICIENS=$$IENS^DILF(.ICIENS)
70 ..S FDA(80.17111,ICIENS,.01)="@"
71 ..D FILE^DIE("","FDA") K FDA
72 ; delete DRG 223 in procedure file
73 S ENTRY=+$O(^ICD0("BA",78.13_" ",0))
74 I ENTRY D
75 .;check for possible inactive dupe
76 .I $P($G(^ICD0(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD0("BA",78.13_" ",ENTRY)) I 'ENTRY Q
77 .; check if already done in case patch being re-installed
78 .Q:'$D(^ICD0(ENTRY,2,1,1,1,1,"B",223,1))
79 .S ICIENS=1,ICIENS(1)=1,ICIENS(2)=1,ICIENS(3)=ENTRY
80 .S ICIENS=$$IENS^DILF(.ICIENS)
81 .S FDA(80.17111,ICIENS,.01)="@"
82 .D FILE^DIE("","FDA") K FDA
83 Q
84REV ;
85 ;;81.02^
86 ;;81.03^
87 ;;81.32^
88 ;;81.33^
89 ;;EXIT
90KIL ; delete DRG 315 in diagnosis file
91 N LINE,X,ICDDIAG,ENTRY,ICIENS,FDA
92 F LINE=1:1 S X=$T(LIS+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
93 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0))
94 .I ENTRY D
95 ..;check for possible inactive dupe
96 ..I $P($G(^ICD9(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I 'ENTRY Q
97 ..; check if already done in case patch being re-installed
98 ..Q:'$D(^ICD9(ENTRY,3,1,1,"B",315,1))
99 ..S ICIENS=1,ICIENS(1)=1,ICIENS(2)=ENTRY
100 ..S ICIENS=$$IENS^DILF(.ICIENS)
101 ..S FDA(80.711,ICIENS,.01)="@"
102 ..D FILE^DIE("","FDA") K FDA
103 Q
104LIS ;
105 ;;585.1^
106 ;;585.2^
107 ;;585.3^
108 ;;585.4^
109 ;;585.5^
110 ;;585.6^
111 ;;585.9^
112 ;;EXIT
113DRG ; update DRG in diag file
114 N ENTRY,ICIENS,FDA
115 S ENTRY=+$O(^ICD9("BA","724.8 ",0))
116 I ENTRY D
117 .; check if already done in case patch being re-installed
118 .Q:$D(^ICD9(ENTRY,3,1,1,"B",243,1))
119 .S ICIENS=1,ICIENS(1)=1,ICIENS(2)=ENTRY
120 .S ICIENS=$$IENS^DILF(.ICIENS)
121 .S FDA(80.711,ICIENS,.01)=243
122 .D FILE^DIE("","FDA") K FDA
123 S ENTRY=+$O(^ICD9("BA","053.19 ",0))
124 I ENTRY D
125 .; check if already done in case patch being re-installed
126 .Q:$D(^ICD9(ENTRY,3,1,1,"B",18,1))
127 .S ICIENS=1,ICIENS(1)=1,ICIENS(2)=ENTRY
128 .S ICIENS=$$IENS^DILF(.ICIENS)
129 .S FDA(80.711,ICIENS,.01)=18
130 .D FILE^DIE("","FDA") K FDA
131 Q
132ACCEPT ; remove unacceptable as prime dx flag
133 N LINE,X,ICDDIAG,ENTRY,IDENT,DUPE,FDA
134 F LINE=1:1 S X=$T(ACPT+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
135 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0)) I ENTRY D
136 ..; check for any dupe (there are some in MNTVBB)
137 ..S DUPE=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I DUPE Q
138 ..S IDENT=$P($G(^ICD9(ENTRY,0)),U,4)
139 ..S FDA(80,ENTRY_",",101)="@"
140 ..D FILE^DIE("","FDA") K FDA
141 Q
142ACPT ;
143 ;;590.81^
144 ;;595.4^
145 ;;EXIT
Note: See TracBrowser for help on using the repository browser.