1 | ACKQUTL8 ;HCIOFO/AG -QUASAR Utility Routine ; [ 04/25/96 10:03 ]
|
---|
2 | ;;3.0;QUASAR;**1,2,8**;Feb 11, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | CHKVST(ACKVIEN,ACKARR,ACKFULL) ; check a visit for missing fields
|
---|
7 | ; this function will validate a visit to determine if there are any
|
---|
8 | ; missing required fields.
|
---|
9 | ; required inputs: ACKVIEN - visit ien number
|
---|
10 | ; ACKARR - array to hold errors (must be passed by ref ie ".ACKARR")
|
---|
11 | ; ACKFULL - if true, the visit will be checked in full and may
|
---|
12 | ; return type 0 errors, and type 1 and type 2. if false, the
|
---|
13 | ; function will only look for type 1s if there are no type 0s etc.
|
---|
14 | ; output:
|
---|
15 | ; ACKARR=typ - type of error found
|
---|
16 | ; -1 = Error - unable to process visit
|
---|
17 | ; 0 = visit does not have minimum data required
|
---|
18 | ; for Quasar
|
---|
19 | ; 1 = visit has minimum for Quasar but some additional
|
---|
20 | ; required fields are missing
|
---|
21 | ; 2 = all Quasar required fields are present but one
|
---|
22 | ; or more PCE fields are missing (ie will not be
|
---|
23 | ; accepted by PCE if the interface is on).
|
---|
24 | ; 3 = everything ok
|
---|
25 | ; ACKARR(typ)=num - number of fields in error
|
---|
26 | ; ACKARR(typ,1-num)=field - free text name of field
|
---|
27 | ; example:
|
---|
28 | ; ACKARR=0 - visit does not have minimum reqd by Quasar
|
---|
29 | ; and ACKARR(0)=2,ACKARR(0,1)="Clinic",ACKARR(0,2)="Patient"
|
---|
30 | ; this visit does not have a clinic or a patient
|
---|
31 | ;
|
---|
32 | N ACKDATA
|
---|
33 | S ACKFULL=+$G(ACKFULL)
|
---|
34 | K ACKARR S ACKARR=3
|
---|
35 | ;
|
---|
36 | ; if visit number not passed in then exit
|
---|
37 | I +$G(ACKVIEN)=0 S ACKARR=-1 G CHKVSTX
|
---|
38 | ;
|
---|
39 | ; get quasar minimum fields for the visit (level 0)
|
---|
40 | GET0 D GETS^DIQ(509850.6,ACKVIEN_",",".01;1;2.6;5;60","I","ACKDATA")
|
---|
41 | ;
|
---|
42 | ; if nothing returned by fileman then exit
|
---|
43 | I '$D(ACKDATA(509850.6,ACKVIEN_",")) S ACKARR=-1 G CHKVSTX
|
---|
44 | ;
|
---|
45 | ; check visit date
|
---|
46 | CHK0 I $G(ACKDATA(509850.6,ACKVIEN_",",.01,"I"))'?7N D
|
---|
47 | . S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
|
---|
48 | . S ACKARR(0,ACKARR(0))="Visit Date"
|
---|
49 | ; check Patient
|
---|
50 | ; I $G(ACKDATA(509850.6,ACKVIEN_",",1,"I"))'?1.N D
|
---|
51 | ; . ; S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
|
---|
52 | ; . ; S ACKARR(0,ACKARR(0))="Patient"
|
---|
53 | ; check Clinic
|
---|
54 | I $G(ACKDATA(509850.6,ACKVIEN_",",2.6,"I"))'?1.N D
|
---|
55 | . S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
|
---|
56 | . S ACKARR(0,ACKARR(0))="Clinic"
|
---|
57 | ; check CDR Account
|
---|
58 | I $G(ACKDATA(509850.6,ACKVIEN_",",5,"I"))'?1.N D
|
---|
59 | . S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
|
---|
60 | . S ACKARR(0,ACKARR(0))="CDR Account"
|
---|
61 | ; check Division
|
---|
62 | I $G(ACKDATA(509850.6,ACKVIEN_",",60,"I"))'?1.N D
|
---|
63 | . S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
|
---|
64 | . S ACKARR(0,ACKARR(0))="Division"
|
---|
65 | ;
|
---|
66 | END0 ; if errors found and we're not doing a full check then exit
|
---|
67 | I ACKARR<3,'ACKFULL G CHKVSTX
|
---|
68 | ;
|
---|
69 | GET1 ; get data for level 1 check
|
---|
70 | K ACKDATA
|
---|
71 | D GETS^DIQ(509850.6,ACKVIEN_",","55;6;7;.09;4.01;.07","I","ACKDATA")
|
---|
72 | ;
|
---|
73 | ; check Appointment Time
|
---|
74 | CHK1 I $G(ACKDATA(509850.6,ACKVIEN_",",55,"I"))'?1"."1.N D
|
---|
75 | . S:ACKARR>1 ACKARR=1
|
---|
76 | . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Appointment Time"
|
---|
77 | ;
|
---|
78 | ; check Primary Provider
|
---|
79 | N ACKPRV
|
---|
80 | S ACKPRV=$G(ACKDATA(509850.6,ACKVIEN_",",6,"I")) ; prim
|
---|
81 | I ACKPRV'?1.N D
|
---|
82 | . S:ACKARR>1 ACKARR=1
|
---|
83 | . S ACKARR(1)=+$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Primary Provider"
|
---|
84 | ;
|
---|
85 | ; check procedure
|
---|
86 | I 'ACKEVENT D
|
---|
87 | . N ACKCPT
|
---|
88 | . N ACKP S ACKP=$O(^ACK(509850.6,ACKVIEN,3,0)),ACKCPT=""
|
---|
89 | . I ACKP S ACKCPT=$P($G(^ACK(509850.6,ACKVIEN,3,ACKP,0)),U,1)
|
---|
90 | . I ACKCPT'?1N.N D
|
---|
91 | . . S:ACKARR>1 ACKARR=1
|
---|
92 | . . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="CPT Procedure"
|
---|
93 | . K ACKCPT
|
---|
94 | ;
|
---|
95 | I ACKEVENT D
|
---|
96 | . N ACKEV S ACKEV=""
|
---|
97 | . N ACKP S ACKP=$O(^ACK(509850.6,ACKVIEN,7,0)),ACKEV=""
|
---|
98 | . I ACKP S ACKEV=$P($G(^ACK(509850.6,ACKVIEN,7,ACKP,0)),U,1)
|
---|
99 | . I ACKEV="" D
|
---|
100 | . . S:ACKARR>1 ACKARR=1
|
---|
101 | . . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Event Capture Procedure"
|
---|
102 | . K ACKEV
|
---|
103 | ;
|
---|
104 | ; check Diagnosis
|
---|
105 | N ACKICD,ACKFROM
|
---|
106 | ; D LIST^DIC(509850.63,","_ACKVIEN_",","","",1,.ACKFROM,"","","","","ACKICD")
|
---|
107 | ; I $P($G(ACKICD("DILIST",0)),U,1)'=1 D ; LIST call removed - too slow!
|
---|
108 | N ACKD S ACKD=$O(^ACK(509850.6,ACKVIEN,1,0)),ACKICD=""
|
---|
109 | I ACKD S ACKICD=$P($G(^ACK(509850.6,ACKVIEN,1,ACKD,0)),U,1)
|
---|
110 | I ACKICD'?1N.N D
|
---|
111 | . S:ACKARR>1 ACKARR=1
|
---|
112 | . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Diagnosis"
|
---|
113 | ; check to see that a diagnosis has been allocated as the Primary
|
---|
114 | I '$$PRIMARY^ACKQASU5(ACKVIEN,"") D
|
---|
115 | . S:ACKARR>1 ACKARR=1
|
---|
116 | . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Primary Diagnosis"
|
---|
117 | K ACKICD
|
---|
118 | ;
|
---|
119 | ; check C and P status (CHECK FOR OPEN REQUEST?)
|
---|
120 | N ACKCP
|
---|
121 | S ACKCP=$G(ACKDATA(509850.6,ACKVIEN_",",.09,"I"))
|
---|
122 | I ACKCP'="",ACKCP'?1N D
|
---|
123 | . S:ACKARR>1 ACKARR=1
|
---|
124 | . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="C and P Status"
|
---|
125 | ;
|
---|
126 | ; check first audiometric field
|
---|
127 | I ACKCP,$G(ACKDATA(509850.6,ACKVIEN_",",4.01,"I"))'?1.N D
|
---|
128 | . S:ACKARR>1 ACKARR=1
|
---|
129 | . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Audiometric Data"
|
---|
130 | ;
|
---|
131 | ; check Time Spent
|
---|
132 | I $G(ACKDATA(509850.6,ACKVIEN_",",.07,"I"))'?1N.N D
|
---|
133 | . S:ACKARR>1 ACKARR=1
|
---|
134 | . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Time Spent"
|
---|
135 | ;
|
---|
136 | END1 ; if errors found and we're not doing a full check then exit
|
---|
137 | I ACKARR<3,'ACKFULL G CHKVSTX
|
---|
138 | ;
|
---|
139 | ; get data for level 2
|
---|
140 | GET2 K ACKDATA
|
---|
141 | D GETS^DIQ(509850.6,ACKVIEN_",","1;80;20;25;30;35","I","ACKDATA")
|
---|
142 | ;
|
---|
143 | ; check visit eligibility
|
---|
144 | CHK2 I $G(ACKDATA(509850.6,ACKVIEN_",",80,"I"))'?1.N D
|
---|
145 | . S:ACKARR>2 ACKARR=2
|
---|
146 | . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Visit Eligibility"
|
---|
147 | ;
|
---|
148 | ; get service connected data
|
---|
149 | N DFN,VAEL,VASV,ACKSC,ACKSCV,ACKAO,ACKIR,ACKENV
|
---|
150 | S DFN=$G(ACKDATA(509850.6,ACKVIEN_",",1,"I"))
|
---|
151 | S (ACKSC,ACKAO,ACKIR,ACKEC)=0
|
---|
152 | I DFN?1.N D ELIG^VADPT,SVC^VADPT D
|
---|
153 | . S ACKSC=$S(+VAEL(3)=1:1,1:0) ; patient service connected
|
---|
154 | . S ACKAO=$S(+VASV(2)=1:1,1:0) ; patient agent orange
|
---|
155 | . S ACKIR=$S(+VASV(3)=1:1,1:0) ; patient radiation
|
---|
156 | . S ACKEC=$S($$GET1^DIQ(2,DFN_",",.322013,"I")="Y":1,1:0) ; pat env cont
|
---|
157 | S ACKSCV=$G(ACKDATA(509850.6,ACKVIEN_",",20,"I")) ; serv conn visit
|
---|
158 | ;
|
---|
159 | ; check service connected status
|
---|
160 | I ACKSC=1,ACKSCV'?1N D
|
---|
161 | . S:ACKARR>2 ACKARR=2
|
---|
162 | . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Service Connected"
|
---|
163 | ;
|
---|
164 | ; check Agent Orange
|
---|
165 | I ACKSCV'=1,ACKAO,$G(ACKDATA(509850.6,ACKVIEN_",",25,"I"))'?1N D
|
---|
166 | . S:ACKARR>2 ACKARR=2
|
---|
167 | . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Agent Orange"
|
---|
168 | ;
|
---|
169 | ; check Radiation
|
---|
170 | I ACKSCV'=1,ACKIR,$G(ACKDATA(509850.6,ACKVIEN_",",30,"I"))'?1N D
|
---|
171 | . S:ACKARR>2 ACKARR=2
|
---|
172 | . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Ionizing Radiation"
|
---|
173 | ;
|
---|
174 | ; check Environmental contaminants
|
---|
175 | I ACKSCV'=1,ACKEC,$G(ACKDATA(509850.6,ACKVIEN_",",35,"I"))'?1N D
|
---|
176 | . S:ACKARR>2 ACKARR=2
|
---|
177 | . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Environmental Contaminants"
|
---|
178 | ;
|
---|
179 | ;
|
---|
180 | CHKVSTX ; that'll do
|
---|
181 | Q
|
---|
182 | ;
|
---|
183 | ;
|
---|
184 | DIAGTXT(ACKQDCDS,ACKCVD) ; Get Short ICD9 Description
|
---|
185 | N DIAGTXT
|
---|
186 | I $G(ACKCVD)="" S ACKCVD=$$DATE
|
---|
187 | ; S DIAGTXT=$$GET1^DIQ(80,ACKQDCDS,3)
|
---|
188 | S DIAGTXT=$$ICDDX^ICDCODE(ACKQDCDS,ACKCVD)
|
---|
189 | S DIAGTXT=$P(DIAGTXT,"^",4)
|
---|
190 | Q DIAGTXT
|
---|
191 | ;
|
---|
192 | LDIAGTXT(ACKQDCDS,ACKCVD) ; Get Long ICD9 Description
|
---|
193 | N LDIAGTXT,LST,RET
|
---|
194 | S ACKQDCDS=$$CONV(ACKQDCDS)
|
---|
195 | S LST="LST"
|
---|
196 | I $G(ACKCVD)="" S ACKCVD=$$DATE
|
---|
197 | ; S LDIAGTXT=$$GET1^DIQ(80,ACKQDCDS,10)
|
---|
198 | S RET=$$ICDD^ICDCODE(ACKQDCDS,LST,ACKCVD)
|
---|
199 | I $P(RET,"^",1)="-1" S LDIAGTXT=$P(RET,"^",2)
|
---|
200 | I $P(RET,"^",1)'="-1" S LDIAGTXT=LST(1)
|
---|
201 | Q LDIAGTXT
|
---|
202 | ;
|
---|
203 | PROCTXT(ACKQDCDS,ACKCVD) ; Get Short CPT Description
|
---|
204 | N PROCTXT
|
---|
205 | I $G(ACKCVD)="" S ACKCVD=$$DATE
|
---|
206 | ; S PROCTXT=$$GET1^DIQ(81,ACKQDCDS,2)
|
---|
207 | S PROCTXT=$$CPT^ICPTCOD(ACKQDCDS,ACKCVD)
|
---|
208 | S PROCTXT=$P(PROCTXT,"^",3)
|
---|
209 | Q PROCTXT
|
---|
210 | ;
|
---|
211 | MODTXT(ACKQMCDS,ACKCVD) ; Get Short CPT Modifier Description
|
---|
212 | N MODTXT
|
---|
213 | I $G(ACKCVD)="" S ACKCVD=$$DATE
|
---|
214 | ; S MODTXT=$$GET1^DIQ(81.3,ACKQMCDS,.02)
|
---|
215 | S MODTXT=$$MOD^ICPTMOD(ACKQMCDS,"I",ACKCVD)
|
---|
216 | S MODTXT=$P(MODTXT,"^",3)
|
---|
217 | Q MODTXT
|
---|
218 | ;
|
---|
219 | CONV(ACKQDCDS) ;
|
---|
220 | N CODE
|
---|
221 | S CODE=$P($G(^ICD9(ACKQDCDS,0)),"^",1)
|
---|
222 | Q CODE
|
---|
223 | ;
|
---|
224 | DATE() ;
|
---|
225 | D NOW^%DTC
|
---|
226 | Q $P(%,".",1)
|
---|
227 | ;
|
---|
228 | ;
|
---|