source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDAPIU.m@ 731

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

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1ICDAPIU ;DLS/DEK/KER - ICD UTILITIES FOR APIS ; 04/18/2004
2 ;;18.0;DRG Grouper;**6,11,12,15**;Oct 20, 2000
3 ;
4 ; External References
5 ; DBIA 10103 $$DT^XLFDT
6 ;
7DTBR(CDT,CS) ; Date Business Rules
8 ; Input:
9 ; CDT - Code Date to check (FileMan format, default=Today)
10 ; CS - Code System (0:ICD, 1:CPT/HCPCS, 2:DRG, Default=0)
11 ;
12 ; Output:
13 ; If CDT < 2781001 and CS=0, use 2781001
14 ; If CDT < 2890101 and CS=1, use 2890101
15 ; If CDT < 2821001 and CS=2, use 2821001
16 ; If CDT is year only, use first of the year
17 ; If CDT is year and month only, use first of the month
18 ;
19 Q:'$G(CDT) $$DT^XLFDT ;nothing passed - use today
20 Q:$L($P(CDT,"."))'=7 $$DT^XLFDT ;bad date format - use today
21 N BRDAT ;Business rule date
22 S CS=+$G(CS) S:CS>2!(CS<0) CS=0
23 S BRDAT=+$P("2781001^2890101^2821001","^",CS+1)
24 I CDT#10000=0 S CDT=CDT+101
25 S:CDT#100=0 CDT=CDT+1
26 Q $S(CDT<BRDAT:BRDAT,1:CDT)
27 ;
28MSG(CDT,CS) ; inform of code text inaccuracy
29 ; Input:
30 ; CDT - Code Date to check (FileMan format, Default = today)
31 ; CS - Code System (0:ICD, 1:CPT/HCPCS, 2:DRG, 3:LEX, Default=0)
32 ; Output: User Alert
33 ;
34 S CS=+$G(CS) S:CS>3!(CS<0) CS=0
35 S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR(CDT,CS))
36 N MSGTXT,MSGDAT S MSGDAT=3021001,MSGTXT="CODE TEXT MAY BE INACCURATE"
37 I CS<3 Q $S(CDT<MSGDAT:MSGTXT,1:"")
38 I CS=3,CDT'<3031001 Q ""
39 Q MSGTXT
40 ;
41STATCHK(CODE,CDT) ; Check Status of ICD Code
42 ; Input:
43 ; CODE - ICD Code REQUIRED
44 ; CDT - Date to screen against (FileMan format, default = today)
45 ; Output:
46 ; 2-Piece String containing the code's status
47 ; and the IEN if the code exists, else -1.
48 ; The following are possible outputs:
49 ; 1^IEN Active Code
50 ; 0^IEN Inactive Code
51 ; 0^-1 Code not Found
52 ;
53 ; This API requires the ACT Cross-Reference
54 ; ^ICD9("ACT",<code>,<status>,<date>,<ien>)
55 ; ^ICD0("ACT",<code>,<status>,<date>,<ien>)
56 ;
57 N ICDC,ICDD,ICDIEN,ICDI,ICDA,ICDG,ICDR,X
58 S ICDC=$G(CODE) Q:'$L(ICDC) "0^-1"
59 ; Case 1: Not Valid 0^-1
60 ; Fails Pattern Match for Code
61 S CODE=$$CODEN^ICDCODE(CODE),ICDG=$P(CODE,"~",2),ICDIEN=+CODE
62 Q:ICDIEN<1 "0^-1"
63 ; Case 2: Never Active 0^IEN
64 ; No Active/Inactive Date
65 S ICDD=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR($G(CDT),1)),ICDD=ICDD+.001
66 S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDD),ICDA=$O(@(ICDR_")"),-1)
67 I '$L(ICDA) D Q X
68 . S ICDA=$O(@(ICDR_")")),X="0^-1" Q:'$L(ICDA)
69 . S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDA)
70 . S ICDIEN=$O(@(ICDR_",0)")) S:+ICDIEN<1 ICDIEN=-1
71 . S X="0^"_ICDIEN
72 ; Case 3: Active, Never Inactive 1^IEN
73 ; Has an Activation Date
74 ; No Inactivation Date
75 S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDD),ICDI=$O(@(ICDR_")"),-1)
76 I $L(ICDA),'$L(ICDI) D Q X
77 . S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDA),ICDIEN=$O(@(ICDR_",0)"))
78 . S X=$S(+ICDIEN=0:"0^-1",1:"1^"_ICDIEN)
79 ; Case 4: Active, but later Inactivated 0^IEN
80 ; Has an Activation Date
81 ; Has an Inactivation Date
82 I $L(ICDA),$L(ICDI),ICDI>ICDA,ICDI<ICDD D Q X
83 . S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDI),ICDIEN=$O(@(ICDR_",0)"))
84 . S X=$S(+ICDIEN=0:"0^-1",1:"0^"_ICDIEN)
85 ; Case 5: Active, and not later Inactivated 1^IEN
86 ; Has an Activation Date
87 ; Has an Inactivation Date
88 ; Has a Newer Activation Date
89 I $L(ICDA),$L(ICDI),ICDI'>ICDA D Q X
90 . S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDI),ICDIEN=$O(@(ICDR_",1)"))
91 . S X=$S(+$O(@(ICDR_",0)"))=0:"0^-1",1:"1^"_ICDIEN)
92 ; Case 6: Fails Time Test 0^-1
93 Q ("0^"_$S(+($G(ICDIEN))>0:+($G(ICDIEN)),1:"-1"))
94 ;
95NEXT(CODE) ; Next ICD Code (active or inactive)
96 ; Input:
97 ; CODE = ICD Code REQUIRED
98 ; Output:
99 ; The Next ICD Code, Null if none
100 ;
101 N ICDC,ICDG S ICDC=$G(CODE) Q:'$L(ICDC) ""
102 Q:ICDC?1.9N "" ;app passed an IEN
103 S ICDG=$P($$CODEN^ICDCODE(ICDC),"~",2)
104 Q:ICDG="INVALID CODE" ""
105 S ICDC=$O(@(ICDG_"""BA"","""_ICDC_" "")"))
106 Q $S(ICDC="":"",1:$E(ICDC,1,$L(ICDC)-1))
107 ;
108PREV(CODE) ; Previous ICD Code (active or inactive)
109 ; Input:
110 ; CODE = ICD Code REQUIRED
111 ; Output:
112 ; The Previous ICD Code, Null if none
113 ;
114 N ICDC,ICDG
115 S ICDC=$G(CODE) Q:'$L(ICDC) ""
116 Q:ICDC?1.9N "" ;app passed an IEN
117 S ICDG=$P($$CODEN^ICDCODE(ICDC),"~",2)
118 Q:ICDG="INVALID CODE" ""
119 S ICDC=$O(@(ICDG_"""BA"","""_ICDC_" "")"),-1)
120 Q $S(ICDC="":"",1:$E(ICDC,1,$L(ICDC)-1))
121 ;
122HIST(CODE,ARY) ; Activation History
123 ; Input:
124 ; CODE - ICD Code REQUIRED
125 ; .ARY - Array, passed by Reference REQUIRED
126 ;
127 ; Output: Mirrors ARY(0) (or, -1 on error)
128 ; ARY(0) = Number of Activation History Entries
129 ; ARY(<date>) = status where: 1 is Active
130 ; ARY("IEN") = <ien>
131 ;
132 Q:$G(CODE)="" -1
133 N ICDC,ICDI,ICDA,ICDN,ICDD,ICDG,ICDF
134 S ICDI=$$CODEN^ICDCODE(CODE),ICDG=$P(ICDI,"~",2)
135 S ICDI=+ICDI Q:ICDI<1 -1
136 S ARY("IEN")=ICDI,ICDA="" M ICDA=@(ICDG_ICDI_",66)")
137 K ICDA("B") S ARY(0)=+($P($G(ICDA(0)),"^",4))
138 S:+ARY(0)=0 ARY(0)=-1 K:ARY(0)=-1 ARY("IEN")
139 S (ICDI,ICDC)=0 F S ICDI=$O(ICDA(ICDI)) Q:+ICDI=0 D
140 . S ICDD=$P($G(ICDA(ICDI,0)),"^",1) Q:+ICDD=0
141 . S ICDF=$P($G(ICDA(ICDI,0)),"^",2) Q:'$L(ICDF)
142 . S ICDC=ICDC+1,ARY(0)=ICDC,ARY(ICDD)=ICDF
143 Q ARY(0)
144 ;
145PERIOD(CODE,ARY) ; return Activation/Inactivation Period in ARY
146 ;
147 ; Input: CODE ICD Code (required)
148 ; ARY Array, passed by Reference (required)
149 ;
150 ; Output: ARY(0) = IEN^Selectable
151 ; Where IEN = -1 if error
152 ; Selectable = 0 for VA Only codes
153 ;
154 ; ARY(Activation Date) = Inactivation Date^Short Name
155 ;
156 ; Where the Short Name is the Versioned text (field 1 of the 67
157 ; multiple), and the text is versioned as follows:
158 ;
159 ; Period is active - Versioned text for TODAY's date
160 ; Period is inactive - Versioned text for inactivation date
161 ;
162 ; or
163 ;
164 ; -1^0 (no period or error)
165 ;
166 I $G(CODE)="" S ARY(0)="-1^0" Q
167 N ICDC,ICDI,ICDA,ICDG,ICDF,ICDBA,ICDBI,ICDST,ICDS,ICDZ,ICDV,ICDN,ICDCA
168 S ICDC=$$CODEN^ICDCODE(CODE),ICDG=$P(ICDC,"~",2),ICDC=+ICDC
169 I ICDC<1 S ARY(0)="-1^0" Q
170 S ICDI=$S(ICDG="^ICD9(":3,1:4),ICDZ=$G(@(ICDG_ICDC_",0)"))
171 ; Versioned text for TODAY
172 S ICDN=$$VST^ICDCODE(ICDC,$$DT^XLFDT,ICDG)
173 S ICDS=$P(ICDZ,"^",ICDI),ARY(0)=ICDC_"^"_'$P(ICDZ,"^",8)
174 S (ICDA,ICDBA)=0,ICDG=ICDG_ICDC_",66,"
175 F Q:ICDBA D
176 . S ICDA=$O(@(ICDG_"""B"","_ICDA_")"))
177 . I ICDA="" S ICDBA=1 Q
178 . S ICDF=$O(@(ICDG_"""B"","_ICDA_",0)"))
179 . I '+ICDF S ICDBA=1 Q
180 . S ICDST=$P($G(@(ICDG_ICDF_",0)")),"^",2)
181 . Q:'ICDST ;outer loop looks for active
182 . ; Versioned text for activation date
183 . S ICDV=$$VST^ICDCODE(ICDC,ICDA,ICDG),ICDCA=1
184 . S:$L(ICDV) ICDS=ICDV
185 . S ARY(ICDA)="^"_ICDS,ICDBI=0,ICDI=ICDA
186 . F Q:ICDBI D
187 . . S ICDI=$O(@(ICDG_"""B"","_ICDI_")"))
188 . . ; If no inactivation date for ICDA then use TODAY's text
189 . . I ICDI="" S ARY(ICDA)="^"_ICDN,(ICDBI,ICDBA)=1 Q
190 . . S ICDF=$O(@(ICDG_"""B"","_ICDI_",0)"))
191 . . ; If no effective date ICDF for ICDI then use TODAY's text
192 . . I '+ICDF S ARY(ICDA)="^"_ICDN,(ICDBI,ICDBA)=1 Q
193 . . S ICDST=$P($G(@(ICDG_ICDF_",0)")),"^",2)
194 . . ; If Status ICDST not Inactive then use TODAY's text
195 . . I ICDST S ARY(ICDA)="^"_ICDN,ICDBI=1 Q
196 . . ; Versioned text for inactive date
197 . . S ICDV=$$VST^ICDCODE(ICDC,ICDI,ICDG)
198 . . S:$L(ICDV) $P(ARY(ICDA),"^",2)=ICDV
199 . . S $P(ARY(ICDA),"^")=ICDI
200 . . S ICDBI=1,ICDA=ICDI,ICDCA=0
201 Q
202 ;
203ACTROOT(ICDG,ICDC,ICDS,ICDD) ; Return "ACT" root
204 Q (ICDG_"""ACT"","""_ICDC_" "","_ICDS_","_ICDD)
Note: See TracBrowser for help on using the repository browser.