source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQUTL8.m@ 1073

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

initial load of WorldVistAEHR
File size: 7.7 KB
Line 
1ACKQUTL8 ;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 ;
6CHKVST(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)
40GET0 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
46CHK0 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 ;
66END0 ; if errors found and we're not doing a full check then exit
67 I ACKARR<3,'ACKFULL G CHKVSTX
68 ;
69GET1 ; 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
74CHK1 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 ;
136END1 ; 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
140GET2 K ACKDATA
141 D GETS^DIQ(509850.6,ACKVIEN_",","1;80;20;25;30;35","I","ACKDATA")
142 ;
143 ; check visit eligibility
144CHK2 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 ;
180CHKVSTX ; that'll do
181 Q
182 ;
183 ;
184DIAGTXT(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 ;
192LDIAGTXT(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 ;
203PROCTXT(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 ;
211MODTXT(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 ;
219CONV(ACKQDCDS) ;
220 N CODE
221 S CODE=$P($G(^ICD9(ACKQDCDS,0)),"^",1)
222 Q CODE
223 ;
224DATE() ;
225 D NOW^%DTC
226 Q $P(%,".",1)
227 ;
228 ;
Note: See TracBrowser for help on using the repository browser.