source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMSVUT0.m@ 1739

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

initial load of WorldVistAEHR
File size: 8.8 KB
Line 
1SCMSVUT0 ;ALB/ESD HL7 Segment Validation Utilities ; 7/8/04 5:06pm
2 ;;5.3;Scheduling;**44,55,66,132,245,254,293,345,472**;Aug 13, 1993
3 ;
4 ;
5CONVERT(SEG,HLFS,HLQ) ; Convert HLQ ("") to null in segment
6 ; Input: SEG = HL7 segment
7 ; HLFS = HL7 field separator
8 ; HLQ = HL7 "" character
9 ;
10 ; Output: SEG = Segment where HLQ replaced with null
11 ;
12 ;
13 N I
14 F I=1:1:55 I $P(SEG,HLFS,I)=HLQ S $P(SEG,HLFS,I)=""
15 Q SEG
16 ;
17SETID(SDOE,SDDELOE) ; Set PCE Unique Visit Number in field #.2 of #409.68
18 ; Input: SDOE = IEN of Outpatient Encounter (#409.68) file
19 ; SDDELOE = IEN of Deleted Outpatient Encounter (#409.74) file
20 ;
21 ; Output: Unique Visit Number set in field #.2 of #409.68
22 ; or field #.2 of #409.74
23 ;
24 ;
25 N SDOEC,SDARRY
26 S SDOEC=0
27 S SDOE=+$G(SDOE)
28 S SDDELOE=+$G(SDDELOE)
29 ;
30 ;-Outpatient Enc pointer passed in; use file #409.68
31 S SDARRY="^SCE("_SDOE_",0)"
32 ;
33 ;-Deleted Outpatient Enc pointer passed in; use file #409.74
34 S:(SDDELOE) SDARRY="^SD(409.74,"_SDDELOE_",1)"
35 ;
36 ;-Quit if no encounter record or deleted encounter record
37 Q:($G(@SDARRY)="")
38 ;-Add unique ID to parent
39 D GETID
40 ;
41 ;-Add unique ID to children for Outpatient Enc only (quit if no child encounter record)
42 I (SDOE) F S SDOEC=+$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC S SDARRY="^SCE("_SDOEC_",0)" Q:($G(@SDARRY)="") D GETID
43 Q
44 ;
45GETID ;Get unique visit ID
46 S:$P($G(@SDARRY),"^",20)="" $P(@SDARRY,"^",20)=$$IEN2VID^VSIT($P(@SDARRY,"^",5))
47 Q
48 ;
49SETPRTY(SDOE) ;Set outpatient provider type in field #.06 of V PROVIDER
50 ; Input: SDOE = IEN of Outpatient Encounter (#409.68) file
51 ;
52 ; Output: Provider Type set in field #.06 of V PROVIDER
53 ;
54 ;
55 N SDPRTYP,SDVPRV,SDPRVS
56 S SDOE=+$G(SDOE),SDVPRV=0
57 ;
58 ;- Get all provider IENs for encounter
59 D GETPRV^SDOE(SDOE,"SDPRVS")
60 F S SDVPRV=+$O(SDPRVS(SDVPRV)) Q:'SDVPRV D
61 . S SDPRTYP=0
62 . ;
63 . ;- If no prov type, call API and add provider type to record
64 . S:$P(SDPRVS(SDVPRV),"^",6)="" SDPRTYP=$$GET^XUA4A72(+SDPRVS(SDVPRV),+$G(^SCE(SDOE,0)))
65 . I +$G(SDPRTYP)>0 D PCLASS^PXAPIOE(SDVPRV)
66 Q
67 ;
68SETMAR(PIDSEG,HLQ,HLFS) ; Set marital status prior to PID segment validation
69 ;Input: PIDSEG = Array containing PID segment (pass by reference)
70 ; PIDSEG = First 245 characters
71 ; PIDSEG(1..n) = Continuation nodes
72 ; HLQ = HL7 null variable
73 ; HLFS = HL7 field separator
74 ;Output: Marital status changed from null to "U" (UNKNOWN) prior to
75 ; validation of PID segment and transmittal to AAC
76 ;Note: Assumes all input exists and is valid
77 ;
78 ;Declare variables
79 N REBLD,TMPARR,X
80 ;Parse segment
81 D SEGPRSE^SCMSVUT5($NA(PIDSEG),"TMPARR",HLFS)
82 ;Change marital status (if needed)
83 S REBLD=0
84 S X=$G(TMPARR(16))
85 I ((X="")!(X=HLQ)) S TMPARR(16)="U",REBLD=1
86 ;Rebuild segment (if needed)
87 I REBLD K TMPARR(0),PIDSEG D MAKEIT^VAFHLU("PID",.TMPARR,.PIDSEG,.PIDSEG)
88 Q
89 ;
90SETPOW(DFN,ZPDSEG,HLQ,HLFS) ; Set POW Status Indicated field prior to ZPD segment validation
91 ;
92 ; Input: DFN = IEN of Patient (#2) file
93 ; ZPDSEG = Array containing ZPD segment (pass by reference)
94 ; ZPDSEG = First 245 characters
95 ; ZPDSEG(1..n) = Continuation nodes
96 ; HLQ = HL7 null variable
97 ; HLFS = HL7 field separator
98 ;
99 ; Output: If Veteran and POW Status Indicated field = null, set to
100 ; U (Unknown)
101 ; If Non-Veteran, set to null
102 ;
103 S DFN=$G(DFN)
104 G SETPOWQ:(DFN="")!($G(ZPDSEG)="")
105 ;Declare variables
106 N REBLD,TMPARR,X
107 ;Parse segment
108 D SEGPRSE^SCMSVUT5($NA(ZPDSEG),"TMPARR",HLFS)
109 ;Change POW status (if needed)
110 S REBLD=0
111 S X=$G(TMPARR(17))
112 I $P($G(^DPT(DFN,"VET")),"^")="Y",(X=""!(X=HLQ)) S TMPARR(17)="U",REBLD=1
113 I $P($G(^DPT(DFN,"VET")),"^")="N" S TMPARR(17)=HLQ,REBLD=1
114 ;Rebuild segment (if needed)
115 I REBLD K TMPARR(0),ZPDSEG D MAKEIT^VAFHLU("ZPD",.TMPARR,.ZPDSEG,.ZPDSEG)
116 ;
117SETPOWQ Q
118 ;
119 ;
120SETVSI(DFN,ZSPSEG,HLQ,HLFS) ;Set Vietnam Service Indicated field prior to ZSP segment validation
121 ;
122 ; Input: DFN = IEN of Patient (#2) file
123 ; ZSPSEG = HL7 ZSP segment
124 ; HLQ = HL7 null variable
125 ; HLFS = HL7 field separator
126 ;
127 ; Output: If Veteran and Vietnam Service Indicated field = null,
128 ; set to U (Unknown)
129 ; If Non-Veteran, set to null
130 ;
131 S DFN=$G(DFN),ZSPSEG=$G(ZSPSEG)
132 G SETVSIQ:(DFN="")!(ZSPSEG="")
133 I $P($G(^DPT(DFN,"VET")),"^")="Y",($P(ZSPSEG,HLFS,6)=""!($P(ZSPSEG,HLFS,6)=HLQ)) S $P(ZSPSEG,HLFS,6)="U"
134 I $P($G(^DPT(DFN,"VET")),"^")="N" S $P(ZSPSEG,HLFS,6)=HLQ
135 ;
136SETVSIQ Q ZSPSEG
137 ;
138 ;
139 ;
140 ;The following subroutines all have to do with the validation of
141 ;data using the same edit checks that are used by Austin.
142 ;
143HL7SEGNM(SEG,DATA) ;checks the validity of the HL7 segment name passed in.
144 ;INPUT SEG - the HL7 segment name
145 ; DATA - the data to compare. In this case the HL7 segment name.
146 ;
147 ;OUTPUT 0 (ZERO) if not validate
148 ; 1 if validated
149 ;
150 I '$D(SEG)!('$D(DATA)) Q 0
151 Q $S(SEG=DATA:1,1:0)
152 ;
153EVTTYP(SEG,DATA) ;checks the event type of the segment passed in.
154 ;INPUT SEG - The HL7 segment name in question
155 ; DATA - The event type from the HL7 segment in question.
156 ;
157 ;OUTPUT 0 (ZERO) if not validate
158 ; 1 if validated
159 ;
160 I '$D(SEG)!('$D(DATA)) Q 0
161 I SEG="EVN"&(DATA="A08"!(DATA="A23")) Q 1
162 Q 0
163 ;
164EVTDTTM(DATA) ;Checks the date and time to ensure it is correct.
165 ;INPUT DATA - this is the date and time in quesiton.
166 ;
167 ;OUTPUT 0 (ZERO) if not validate
168 ; 1 if validated
169 ;
170 I '$D(DATA) Q 0
171 N STRTDT,%DT,X,Y
172 S STRTDT=+$O(^SD(404.91,0))
173 S STRTDT=$P($G(^SD(404.91,STRTDT,"AMB")),U,2)
174 I 'STRTDT Q 0
175 S %DT="T",%DT(0)=STRTDT,X=DATA
176 D ^%DT
177 Q $S(Y=-1:0,1:1)
178 ;
179VALIDATE(SEG,DATA,ERRCOD,VALERR,CTR) ;
180 ;
181 N ERRIEN,ERRCHK,RES
182 S ERRIEN=+$O(^SD(409.76,"B",ERRCOD,""))
183 I 'ERRIEN S @VALERR@(SEG,CTR)=ERRCOD D INCR Q
184 S ERRCHK=$G(^SD(409.76,ERRIEN,"CHK"))
185 I ERRCHK="" S @VALERR@(SEG,CTR)=ERRCOD D INCR Q
186 X ERRCHK
187 I 'RES S @VALERR@(SEG,CTR)=ERRCOD D INCR
188 Q
189 ;
190DFN(DATA) ;
191 ;INPUT DATA - the DFN of the patient
192 ;
193 I '$D(DATA) Q 0
194 I DATA=""!(DATA=0) Q 0
195 I DATA'?1.N.".".N Q 0
196 Q 1
197 ;
198PATNM(DATA) ;
199 ;INPUT DATA - The name of the patient
200 ;
201 I '$D(DATA) Q 0
202 I DATA="" Q 0
203 I DATA?.N.",".N Q 0
204 I DATA?1.C Q 0
205 Q 1
206 ;
207DOB(DATA,ENCDT) ;
208 ;INPUT DATA - The DOB to be tested.
209 ; ENCDT - The date/time of the encounter
210 ;
211 N %DT,X,Y
212 I '$D(DATA) Q 0
213 I '$D(ENCDT) Q 0
214 I DATA'?1.N Q 0
215 S %DT="T",%DT(0)=-ENCDT,X=DATA
216 D ^%DT
217 Q $S(Y=-1:0,1:1)
218 ;
219SEX(DATA) ;
220 ;INPUT DATA - The sex code to be validated
221 ;
222 I '$D(DATA) Q 0
223 I "FMUO"'[DATA Q 0
224 Q 1
225 ;
226RACE(DATA) ;
227 ;INPUT DATA - the race code to be validated (NNNN-C-XXX)
228 ;
229 N VAL,MTHD
230 I '$D(DATA) Q 0
231 I DATA="" Q 1
232 S VAL=$P(DATA,"-",1,2)
233 S MTHD=$P(DATA,"-",3)
234 I VAL'?4N1"-"1N Q 0
235 I ",SLF,UNK,PRX,OBS,"'[MTHD Q 0
236 Q 1
237 ;
238STR1(DATA) ;
239 ;INPUT DATA - Street address line 1
240 ;
241 N LP,VAR
242 I '$D(DATA) Q 0
243 I DATA="" Q 0
244 I DATA?1.N Q 0
245 I DATA=" " Q 0
246 F LP=1:1:$L(DATA) S VAR=$E(DATA,LP,LP) I $A(VAR)>32,($A(VAR)<127) S LP="Y" Q
247 Q $S(LP="Y":1,1:0)
248 ;
249STR2(DATA) ;
250 ;INPUT DATA - Street address line 2
251 I DATA?1.N Q 0
252 Q 1
253 ;
254CITY(DATA) ;
255 ;INPUT DATA - The city code to be validated
256 ;
257 I DATA="" Q 0
258 I DATA?1.N Q 0
259 Q 1
260 ;
261STATE(DATA) ;
262 ;INPUT DATA - State code to be validated.
263 ;
264 I '$D(DATA) Q 0
265 I DATA="" Q 0
266 I '$D(^DIC(5,"C",DATA)) Q 0
267 Q 1
268 ;
269ZIP(DATA) ;
270 ;INPUT DATA - The zipo code to be validated
271 ;
272 I '$D(DATA) Q 0
273 I $E(DATA,1,5)="00000" Q 0
274 I DATA'?5N."-".4N Q 0
275 Q 1
276 ;
277COUNTY(DATA,STATE) ;
278 ;INPUT DATA - The county code to be validated
279 ; STATE - STATE file IEN
280 ;
281 I DATA="" Q 0
282 I STATE="" Q 0
283 I '$D(^DIC(5,+$G(STATE),1,"C",DATA)) Q 0
284 Q 1
285 ;
286MARITAL(DATA) ;
287 ;INPUT DATA - The marital status code to be validated.
288 ;
289 I $L(DATA)>1 Q 0
290 I "ADMSWU"'[DATA Q 0
291 Q 1
292 ;
293REL(DATA) ;
294 ;INPUT DATA - The religion abbreviation to the validated
295 ;
296 I '$D(DATA) Q 0
297 I DATA="" Q 0
298 I '$D(^DIC(13,"C",+DATA)) Q 0
299 Q 1
300 ;
301SSN(DATA,NOPCHK,NULLOK) ; SD*5.3*345 added optional parameter NULLOK
302 ;INPUT DATA - The SSN to be validated
303 ; NOPCHK - O = Check pseudo indicator (default)
304 ; 1 = Don't check pseudo indicator
305 ; NULLOK (optional) - 1 = Allow SSN to be null
306 ; 2 = Don't allow null SSNs (default)
307 ;
308 I $G(DATA)="" Q +$G(NULLOK) ; SD*5.3*345
309 I '$D(DATA) Q 0
310 N SSN,PSD
311 S SSN=$E(DATA,1,9),PSD=$E(DATA,10)
312 I SSN'?9N Q 0
313 I '$G(NOPCHK) I (PSD'=" "),(PSD'=""),(PSD'="P") Q 0
314 I $E(SSN,1,5)="00000" Q 0
315 Q 1
316 ;
317INCR ;increases the counter
318 S CTR=CTR+1
319 Q
320 ;
321REMOVE(SEG,ERR,VALERR,CNT) ;
322 ;INPUT SEG - The segment being worked on
323 ; VALERR - The array holding the information
324 ; CNT - the counter to use
325 ; ERR - error code to remove
326 ;
327 N LP
328 F LP=1:1:CNT I $G(@VALERR@(SEG,LP))=ERR K @VALERR@(SEG,LP)
329 Q
330 ;
331DECR(CNT) ;
332 S CNT=CNT-1
333 Q
334 ;
Note: See TracBrowser for help on using the repository browser.