source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECV4RPC.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1ECV4RPC ;ALB/ACS;Event Capture Spreadsheet Data Validation ;Oct 13, 2000
2 ;;2.0; EVENT CAPTURE ;**25,33,49**;8 May 96
3 ;
4 ;-----------------------------------------------------------------------
5 ; Validates the following Event Capture Spreadsheet Upload fields:
6 ; 1. VOLUME
7 ; 2. ENCOUNTER DATE/TIME
8 ; 3. PROVIDER NAME
9 ;
10 ; Determines the following:
11 ; 1. PATIENT STATUS
12 ;-----------------------------------------------------------------------
13 ;
14 ;--Volume must be 1 thru 99--
15 N ECVOLVN,ECPDT
16 S ECVOLVN=ECVOLV
17 I (+ECVOLVN'=ECVOLVN)!(ECVOLVN<1)!(ECVOLVN>99)!(ECVOLVN?.E1"."1N.N) D
18 . S ECERRMSG=$P($T(VOL1^ECV4RPC),";;",2)
19 . S ECCOLERR=ECVOLPC
20 . D ERROR
21 . Q
22 I $L(ECVOLVN)'=$L(ECVOLV) D
23 . ; Volume must be numeric
24 . S ECERRMSG=$P($T(VOL2^ECV4RPC),";;",2)
25 . S ECCOLERR=ECVOLPC
26 . D ERROR
27 . Q
28 ;
29 ;--Encounter Date/Time--
30 S ECERRFLG=0
31 N ECRETVAL
32 S %DT(0)="-NOW",ECENCV=$TR(ECENCV," ","")
33 D CHK^DIE(721,2,"E",ECENCV,.ECRETVAL)
34 I $G(ECRETVAL)="^" D
35 . ; Invalid encounter date/time
36 . S ECERRMSG=$P($T(ENC1^ECV4RPC),";;",2)
37 . S ECCOLERR=ECENCPC
38 . D ERROR
39 . Q
40 I $G(ECRETVAL)'="^" D
41 . S %DT="XST",X=ECENCV
42 . D ^%DT
43 . S ECENCV=+Y
44 . Q
45 ;
46 ;--Provider Name or IEN must be on the New Person file--
47 ;--and provider must have active person class --
48 N ECPROV1
49 S ECERRFLG=0,ECPRVIEN=0
50 ; Remove punctuation if necessary
51 I ECPROVV?.E1P S ECPROVV=$E(ECPROVV,1,$L(ECPROVV)-1)
52 ; If provider ien passed in, find on file
53 S ECPROV1=ECPROVV
54 I +ECPROVV>0 D
55 . I '$D(^VA(200,ECPROVV)) D
56 . . ; Provider ien not found on New Person file
57 . . S ECERRMSG=$P($T(PROV4^ECV4RPC),";;",2)
58 . . S ECCOLERR=ECPRVLPC
59 . . D ERROR
60 . E S ECPRVIEN=ECPROVV
61 ;
62 ; If provider name passed in, find on B x-ref and
63 ; make sure there isn't more than 1 with same name
64 N ECPRVNXT,ECPRVMOR,ECPRVMNT
65 S (ECPRVMOR,ECPRVMNT)=0,ECCOLERR=ECPRVLPC
66 I +ECPROVV'>0,$D(^VA(200,"B",ECPROVV)) D
67 . S ECPRVIE2=$O(^VA(200,"B",ECPROVV,""))
68 . S ECPRVNXT=$O(^VA(200,"B",ECPROVV,ECPRVIE2))
69 . I ECPRVNXT'="" D
70 . . S ECERRMSG=$P($T(PROV5^ECV4RPC),";;",2)
71 . . S ECCOLERR=ECPRVLPC
72 . . D ERROR
73 . . S ECPRVMOR=1
74 . E S ECPRVIEN=ECPRVIE2
75 ;
76 I +ECPROVV'>0,'$D(^VA(200,"B",ECPROVV)) D
77 . ; Exact match not found on New Person file
78 . ; Generate standard error message
79 . S ECERRMSG=$P($T(PROV1^ECV4RPC),";;",2)
80 . S ECCOLERR=ECPRVLPC
81 . D ERROR
82 . S ECPRVMNT=1
83 ; If exact match not found, get provider info
84 I ECPRVMNT D
85 . ; look at next provider on file for 'close' match
86 . N ECINFO,ECLENPRV,NOMATCH,ECSPEC,ECSUBSP
87 . N ECCOUNT,ECFIRST,ECLAST,ECPRVNXT,ECPRVIE2,ECPRVIE3
88 . S ECLENPRV=$L(ECPROVV),(ECPRVIE2,ECPRVIE3)="",(ECCOUNT,NOMATCH)=0
89 . S ECPRVNXT=ECPROVV
90 . F S ECPRVNXT=$O(^VA(200,"B",ECPRVNXT)) Q:NOMATCH=1 D
91 . . F S ECPRVIE3=$O(^VA(200,"B",ECPRVNXT,ECPRVIE3)) Q:ECPRVIE3="" D
92 . . . I ECPROVV'=$E(ECPRVNXT,1,ECLENPRV) S NOMATCH=1
93 . . . E D
94 . . . . ;get provider info and add to end of error string
95 . . . . S ECINFO=$$GET^XUA4A72(ECPRVIE3,ECENCV)
96 . . . . I +ECINFO'>0 D
97 . . . . . S ECERRMSG=ECPRVNXT_"-"_ECPRVIE3_"-Inactive Provider for this encounter date"
98 . . . . . D ERROR
99 . . . . . ;S ECCOUNT=ECCOUNT+1
100 . . . . I +ECINFO>0 D
101 . . . . . S ECCOUNT=ECCOUNT+1
102 . . . . . S ECSPEC=$P(ECINFO,U,3)
103 . . . . . I ECSPEC=" " S ECSPEC=""
104 . . . . . S ECSUBSP=$P(ECINFO,U,4)
105 . . . . . I ECSUBSP=" " S ECSUBSP=""
106 . . . . . S ECPCLASS=$P(^VA(200,ECPRVIE3,"USC1",0),U,3)
107 . . . . . I ECPCLASS="" S ECPCLASS="PERSON CLASS NOT FOUND"
108 . . . . . S ECERRMSG=ECPRVNXT_"-"_ECPRVIE3_"-"_ECSPEC_"-"_ECSUBSP_"-"_ECPCLASS
109 . . . . . D ERROR
110 ; If more than one provider with that name, get info
111 I ECPRVMOR D
112 . N ECINFO,ECSPEC,ECSUBSP,ECPCLASS,ECCOUNT,ECFIRST,ECLAST,ECPRVIE2
113 . S ECCOUNT=0,ECPRVIE2=0
114 . ;look at each provider for exact match
115 . F S ECPRVIE2=$O(^VA(200,"B",ECPROVV,ECPRVIE2)) Q:ECPRVIE2="" D
116 . . S ECINFO=$$GET^XUA4A72(ECPRVIE2,ECENCV)
117 . . I +ECINFO'>0 D
118 . . . S ECERRMSG=ECPROVV_"-"_ECPRVIE2_"-Inactive Provider for this encounter date"
119 . . . D ERROR
120 . . I +ECINFO>0 D
121 . . . S ECCOUNT=ECCOUNT+1
122 . . . S ECSPEC=$P(ECINFO,U,3)
123 . . . I ECSPEC=" " S ECSPEC=""
124 . . . S ECSUBSP=$P(ECINFO,U,4)
125 . . . I ECSUBSP=" " S ECSUBSP=""
126 . . . S ECPCLASS=$P(^VA(200,ECPRVIE2,"USC1",0),U,3)
127 . . . I ECPCLASS="" S ECPCLASS="PERSON CLASS NOT FOUND"
128 . . . S ECERRMSG=ECPROVV_"-"_ECPRVIE2_"-"_ECSPEC_"-"_ECSUBSP_"-"_ECPCLASS
129 . . . D ERROR
130 ;
131 ; Check person class of valid provider
132 S ECPROVV=ECPROV1
133 S %DT="XST",X=ECENCV D ^%DT S ECPDT=$S(+Y>0:+Y,1:DT)
134 I 'ECERRFLG D
135 . I ECPRVIEN=0 S ECPRVIEN=$O(^VA(200,"B",ECPROVV,0))
136 . I '$D(^VA(200,ECPRVIEN,"USC1",0)) D
137 . . ; Person class xref doesn't exist
138 . . S ECERRMSG=$P($T(PROV2^ECV4RPC),";;",2)
139 . . S ECCOLERR=ECPRVLPC
140 . . D ERROR
141 . . Q
142 . Q
143 ;
144 I 'ECERRFLG D
145 . S ECPCLASS=$P(^VA(200,ECPRVIEN,"USC1",0),U,3)
146 . I ECPCLASS="" D
147 . . ; Person class field empty
148 . . S ECERRMSG=$P($T(PROV2^ECV4RPC),";;",2)
149 . . S ECCOLERR=ECPRVLPC
150 . . D ERROR
151 . . Q
152 . Q
153 ;
154 I 'ECERRFLG,'$D(^VA(200,ECPRVIEN,"USC1",ECPCLASS,0)) D
155 . ; Person class information missing
156 . S ECERRMSG=$P($T(PROV2^ECV4RPC),";;",2)
157 . S ECCOLERR=ECPRVLPC
158 . D ERROR
159 . Q
160 ;
161 ; Check for person class expiration date
162 I 'ECERRFLG,$$GET^XUA4A72(ECPRVIEN,ECPDT)<1 D
163 . ; Person class contains an expiration date
164 . S ECERRMSG=$P($T(PROV3^ECV4RPC),";;",2)
165 . S ECCOLERR=ECPRVLPC
166 . D ERROR
167 . Q
168 ;
169 I 'ECERRFLG D
170 . S ECPRVTYP=$P(^VA(200,ECPRVIEN,"USC1",ECPCLASS,0),U,1)
171 . I $P(^USC(8932.1,ECPRVTYP,0),U,4)'="a" D
172 . . ; Person class is not active
173 . . S ECERRMSG=$P($T(PROV3^ECV4RPC),";;",2)
174 . . S ECCOLERR=ECPRVLPC
175 . . D ERROR
176 . . Q
177 . Q
178 ;
179 ;--Determine Patient Status--
180 S ECPSTAT=""
181 I ECSSNIEN D
182 . S ECERRFLG=0
183 . S ECPSTAT=$$INOUTPT^ECUTL0(ECSSNIEN,+ECENCV)
184 . I ECPSTAT="" D
185 . . ; Unable to determine patient status
186 . . S ECERRMSG=$P($T(STAT1^ECV4RPC),";;",2)
187 . . S ECCOLERR=ECENCPC
188 . . D ERROR
189 . . Q
190 . I ECPSTAT="I",'ECPSTATV,'ECERRFLG D
191 . . ; Patient status is Inpatient and override flag is false
192 . . S ECERRMSG=$P($T(STAT2^ECV4RPC),";;",2)
193 . . S ECCOLERR=ECENCPC
194 . . D ERROR
195 . . Q
196 ;
197 ;--Check to see if the DSS Unit is 'send to PCE'--
198 S ECDXIEN="",ECCLNIEN=""
199 I ECPSTAT'="",ECDSSIEN'="" D
200 . N ECDSSDAT,ECDSSPCE
201 . S ECDSSDAT=$G(^ECD(ECDSSIEN,0))
202 . S ECDSSPCE=$P(ECDSSDAT,U,14)
203 . ; If Outpatient and send=O, or send=A
204 . I ((ECPSTAT="O")&(ECDSSPCE["O"))!(ECDSSPCE["A") D
205 . . ;Validate Diagnosis code and Associated Clinic
206 . . D VALDIAG^ECV5RPC
207 . . D VALCLIN^ECV5RPC
208 . Q
209 ;
210 ;--Check to see if DUZ is defined
211 S ECDUZ=$S($D(DUZ):DUZ,1:"")
212 I ECDUZ="" D
213 . ; Invalid DUZ
214 . S ECERRMSG=$P($T(DUZ^ECV4RPC),";;",2),ECCOLERR=0
215 . D ERROR
216 Q
217 ;;
218ERROR ;--Set up array entry to contain the following:
219 ;1. record number
220 ;2. column number on spreadsheet containing the record number
221 ;3. column number on spreadsheet containing the data in error
222 ;4. error message
223 ;
224 S ECINDEX=ECINDEX+1
225 S RESULTS(ECINDEX)=ECRECV_"^"_ECRECPC_"^"_ECCOLERR_"^"_ECERRMSG_"^"
226 S ECERRFLG=1
227 Q
228 ;
229 ;Error messages:
230 ;
231VOL1 ;;Volume must be a whole number from 1 to 99
232VOL2 ;;Volume must contain numeric characters only
233PROV1 ;;Provider has no B x-ref on New Person file(#200)
234PROV2 ;;Unable to determine person class
235PROV3 ;;Provider does not have an active person class
236PROV4 ;;Provider IEN not found on New Person file(#200)
237PROV5 ;;More than one provider with this name - use IEN
238ENC1 ;;Invalid encounter date/time. Date cannot be in the future.
239STAT1 ;;Unable to determine patient status
240STAT2 ;;The patient status is Inpatient
241DUZ ;;User DUZ not defined
Note: See TracBrowser for help on using the repository browser.