source: FOIAVistA/tag/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SBCR1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1LA7SBCR1 ;DALOI/JMC - Shipping Barcode Reader Utility ; 23 Feb 2004
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,64**;Sep 27, 1994
3 Q
4 ;
5PT(LA7,LA7PROM,LA7SCFG) ; Setup patient/ordering site info from barcode.
6 ; Input:
7 ; LA7=array to return values
8 ; LA7PROM=array of prompts to display to user
9 ; LA7SCFG=array of shipping configuration info
10 ;
11 ; Returns array LA7()
12 ; If successful DFN=ien of patient in #2, if DPF=2
13 ; DOB=patient's date of birth
14 ; DPF=source file (2, 67, or 537010)
15 ; CDT=collection date/time
16 ; ERROR=0
17 ; PNM=patient name
18 ; RSITE=sending site
19 ; RUID=specimen unique identifier
20 ; SEX=patient's sex
21 ; SSN=patient's SSN
22 ;
23 ; unsuccessful ERROR=>0
24 ;
25 N LA7BCS,LA7IEN,LA7X,LA7Y,LA7Z,Y
26 S LA7="",LA7BCS=0,LA7PNM=""
27 S LA7PROM=$G(LA7PROM,"Patient/Accession Info (PD)")
28 S Y=$$RD^LA7SBCR(.LA7PROM,1)
29 ;
30 I Y=0 D Q
31 . S LA7("ERROR")="1^User timeout/abort"
32 ;
33 I Y<1 D Q
34 . S LA7("ERROR")="2^Incorrect bar-code format"
35 ;
36 ; barcode info & longitudinal parity check
37 ; original style bar code
38 I $E(Y,1,9)="1^STX^PD^" D
39 . S LA7=$P(Y,"STX^PD^",2)
40 . S LA7=$P(LA7,"^ETX",1)
41 . S LA7("LPC")=$P(Y,"^ETX",2)
42 ; new style bar code
43 I $E(Y,1,5)="1^PD^" D
44 . S LA7=$P(Y,"^",3,6)
45 . S LA7("LPC")=$P(Y,"^",7)
46 . S LA7BCS=1
47 ;
48 I LA7="" D Q
49 . S LA7("ERROR")="2^Incorrect bar-code format"
50 ;
51 I $G(LA7("LPC"))'=$G(LA7SCFG("LPC")) D Q
52 . S LA7("ERROR")="9^Parity check does not match on (SM) and (PD) barcodes"
53 ;
54 S LA7("RSITE")=$P(LA7,"^",2)
55 I LA7("RSITE")'=$P(LA7SCFG("RSITE"),"^",3) D
56 . S LA7("ERROR")="31^Site in PD barcode does not match shipping configuration file"
57 ;
58 ; Remote specimen identifier
59 S LA7("RUID")=$P(LA7,"^",3)
60 ;
61 ; Specimen collection date, using either old or new style(LA7BCS=1) bar code
62 I 'LA7BCS,$P(LA7,"^",5) S LA7("CDT")=$$DT^LA7SBCR($P(LA7,"^",5))
63 I LA7BCS,$P(LA7,"^",4) S LA7("CDT")=$$DT^LA7SBCR($P(LA7,"^",4))
64 ;
65 ; Patient identifier
66 S LA7X=$P(LA7,"^") ; Patient's ID
67 ;
68 ; No SSN in first piece
69 I LA7X="" S LA7("ERROR")="3^No SSN in barcode" Q
70 S LA7("SSN")=LA7X
71 ;
72 ; Try LAB PENDING ORDERS file
73 D LPO(.LA7,LA7SCFG("SMID"))
74 ;
75 ; Check for patient in file #2.
76 I $G(LA7("ERROR")) D DPT(.LA7,LA7X)
77 ;
78 ; Else try Lab Referral file.
79 I $G(LA7("ERROR")) D LRT(.LA7,LA7X)
80 ;
81 ; Get additional info from PD1 bar code
82 I +$G(LA7("ERROR"))=4 D PD1
83 Q
84 ;
85 ;
86DPT(LA7,LA7X) ; Lookup in Patient file.
87 ; Check for patient in file #2.
88 S LA7Y=$O(^DPT("SSN",LA7X,0))
89 ; SSN not found.
90 I 'LA7Y S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
91 S LA7Y(0)=$G(^DPT(LA7Y,0))
92 ; SSN not found.
93 I LA7Y(0)="" S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
94 ;
95 D DPTSET(.LA7,LA7Y)
96 Q
97 ;
98 ;
99LRT(LA7,LA7X) ; Lookup in Lab Referral file.
100 ; Clear error flag.
101 S LA7("ERROR")=""
102 S LA7Y=$O(^LRT(67,"C",LA7X,0))
103 ; SSN not found.
104 I 'LA7Y S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
105 S LA7Y(0)=$G(^LRT(67,LA7Y,0))
106 ; SSN not found.
107 I LA7Y(0)="" S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
108 D LRTSET(.LA7,LA7Y)
109 Q
110 ;
111 ;
112LPO(LA7,LA7SM) ; Lookup in LAB PENDING ORDERS file #69.6
113 ;
114 N LA7696,LA7RUID
115 S LA7RUID=LA7("RUID"),LA7696=""
116 I LA7SM'="",LA7RUID'="" S LA7696=$O(^LRO(69.6,"AD",LA7SM,LA7RUID,0))
117 I 'LA7696 S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
118 D LPOSET(.LA7,LA7696)
119 Q
120 ;
121 ;
122DPTSET(LA7,LA7Y) ; Setup array from Patient file.
123 ;
124 N RACE,LA7ERR
125 S LA7Y(0)=$G(^DPT(LA7Y,0))
126 ; Zeroth node not found.
127 I LA7Y(0)="" S LA7("ERROR")="6^No zeroth node in file" Q
128 S LA7("DFN")=LA7Y
129 S LA7("DOB")=$P(LA7Y(0),"^",3)
130 ; Source file
131 S:LA7Y LA7("DPF")=2_U_"DPT("
132 S LA7("PNM")=$P(LA7Y(0),"^")
133 S LA7("RIEN")=+$G(^DPT(LA7Y,"LRT"))
134 S LA7("SEX")=$P(LA7Y(0),"^",2)
135 S LA7("SSN")=$P(LA7Y(0),"^",9)
136 D GETS^DIQ(2,LA7Y_",","2*","I","RACE","LA7ERR")
137 I '$D(LA7ERR) D
138 . S X=$Q(RACE(2.02)) Q:X=""
139 . S LA7("RACE")=$P(@X,"^")
140 Q
141 ;
142 ;
143LRTSET(LA7,LA7Y) ; Setup array from Lab Referral file.
144 S LA7Y(0)=$G(^LRT(67,LA7Y,0))
145 ; Zeroth node not found.
146 I LA7Y(0)="" S LA7("ERROR")="6^No zeroth node in file" Q
147 S LA7("DFN")=LA7Y
148 S LA7("DOB")=$P(LA7Y(0),"^",3)
149 ;
150 ; Source file
151 S:LA7Y LA7("DPF")=67_U_"LRT(67,"
152 ;
153 S LA7("PNM")=$P(LA7Y(0),"^")
154 S LA7("RIEN")=LA7Y
155 S LA7("SEX")=$P(LA7Y(0),"^",2)
156 S LA7("SSN")=$P(LA7Y(0),"^",9)
157 Q
158 ;
159 ;
160LPOSET(LA7,LA7Y) ; Setup array from LAB PENDING ORDERS file #69.6
161 ;
162 N I
163 F I=0,.1 S LA7Y(I)=$G(^LRO(69.6,LA7Y,I))
164 ; Zeroth node not found.
165 I LA7Y(0)="" D Q
166 . S LA7("ERROR")="6^No zeroth node in file"
167 ; Patient identifiers don't match
168 I LA7("SSN")'=$P(LA7Y(0),U,9) Q
169 ;
170 S LA7("PNM")=$P(LA7Y(0),U,1)
171 S LA7("DOB")=$P(LA7Y(0),U,3)
172 S LA7("SEX")=$P(LA7Y(0),U,2)
173 S LA7("DPF")="67^LRT(67,"
174 S LA7("RACE")=$P(LA7Y(.1),U)
175 S LA7("ERROR")=""
176 S LA7("RIEN")=$O(^LRT(67,"C",LA7("SSN"),0))
177 I $G(LA7("RIEN")),$G(^LRT(67,LA7("RIEN"),"LR")) D
178 . S LA7("LRDFN")=^LRT(67,LA7("RIEN"),"LR")
179 . S LA7("DFN")=LA7("RIEN")
180 Q
181 ;
182 ;
183PD1 ; Read PD1 bar code information
184 ;
185 N LA7PROM
186 ;
187 S LA7PROM="Scan Patient Name Barcode (PD1)"
188 S LA7PROM(1)="Patient Demographics not found"
189 S LA7("ERROR")="",LA7Z=""
190 S Y=$$RD^LA7SBCR(.LA7PROM,1)
191 I Y<1 D Q
192 . S LA7("ERROR")="2^Incorrect bar-code format"
193 ;
194 ; barcode info & longitudinal parity check
195 ; original style bar code
196 I $E(Y,1,10)="1^STX^PD1^" D
197 . S LA7Z=$P(Y,"STX^PD1^",2)
198 . S LA7Z=$P(LA7Z,"^ETX")
199 . S LA7Z("LPC")=$P(Y,"^ETX",2)
200 ; new style bar code
201 I $E(Y,1,6)="1^PD1^" D
202 . S LA7Z=$P(Y,"^",3,6)
203 . S LA7Z("LPC")=$P(Y,"^",7)
204 ;
205 I LA7Z="" D Q
206 . S LA7("ERROR")="2^Incorrect bar-code format"
207 ;
208 I $G(LA7Z("LPC"))'=$G(LA7SCFG("LPC")) D Q
209 . S LA7("ERROR")="10^Parity check does not match on (SM) and (PD1) barcodes"
210 ;
211 ; Name not found.
212 I $L($P(LA7Z,U,2))<2 D Q
213 . S LA7("ERROR")="21^Unsuccessful name scan"
214 ;
215 ; wrong patient scanned not found.
216 I $P(LA7Z,U)'=LA7("SSN") D Q
217 . S LA7("ERROR")="22^SSN does not match PD barcode"
218 ;
219 ; Wrong DOB format.
220 I $P(LA7Z,U,3)'?7N D Q
221 . S LA7("ERROR")="23^Incorrect DOB"
222 ;
223 S LA7("PNM")=$P(LA7Z,U,2)
224 S LA7("DOB")=$P(LA7Z,U,3)
225 S LA7("SEX")=$P(LA7Z,U,4)
226 S LA7("DPF")="67^LRT(67,"
227 S LA7("ERROR")=""
228 Q
Note: See TracBrowser for help on using the repository browser.