source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFHLU.m@ 873

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

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1DGPFHLU ;ALB/RPM - PRF HL7 ORU/ACK PROCESSING ; 6/21/06 10:27am
2 ;;5.3;Registration;**425,718,650**;Aug 13, 1993;Build 3
3 ;
4BLDORU(DGPFA,DGHARR,DGHL,DGROOT) ;Build ORU~R01 Message/Segments
5 ;
6 ; Input:
7 ; DGPFA - (required) Assignment data array
8 ; DGHARR - (required) Assignment history IENs array
9 ; DGHL - (required) HL7 Kernel array passed by reference
10 ; DGROOT - (required) Closed root segment storage array name
11 ;
12 ; Output:
13 ; Function Value - IEN of last assignment history included in
14 ; message segments, 0 on failure
15 ; DGROOT - array of HL7 segments
16 ;
17 N DGADT ;assignment date
18 N DGHIEN ;function value
19 N DGLDT ;last assignment date
20 N DGPFAH ;assignment history data array
21 N DGSEG ;segment counter
22 N DGSEGSTR ;formatted segment string
23 N DGSET ;set id
24 N DGSTR ;field string
25 N DGTROOT ;text root
26 ;
27 S DGHIEN=0
28 S DGSEG=0
29 ;
30 I $D(DGPFA),$D(DGHARR),$G(DGROOT)]"" D
31 . ;
32 . ;build PID
33 . S DGSTR="1,2,3,5,7,8,19"
34 . S DGSEGSTR=$$EN^VAFHLPID(+DGPFA("DFN"),DGSTR,1,1)
35 . Q:(DGSEGSTR="")
36 . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
37 . ;
38 . ;build OBR
39 . S DGLDT=+$O(DGHARR(""),-1) ;get last assignment date
40 . Q:'$$GETHIST^DGPFAAH(DGHARR(DGLDT),.DGPFAH) ;load asgn hx array
41 . S DGSET=1
42 . S DGSTR="1,4,7,20,21"
43 . S DGSEGSTR=$$OBR^DGPFHLU1(DGSET,.DGPFA,.DGPFAH,DGSTR,.DGHL)
44 . Q:(DGSEGSTR="")
45 . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
46 . ;
47 . ;start OBX segments
48 . S DGSET=0
49 . ;
50 . ;build narrative OBX segments
51 . S DGTROOT="DGPFA(""NARR"")"
52 . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGSEG,.DGSET)
53 . ;
54 . ;for each history build status & comment OBX segments
55 . S DGADT=0
56 . F S DGADT=$O(DGHARR(DGADT)) Q:'DGADT D Q:'DGHIEN
57 . . N DGPFAH
58 . . S DGHIEN=0
59 . . Q:'$$GETHIST^DGPFAAH(DGHARR(DGADT),.DGPFAH)
60 . . ;
61 . . ;build status OBX segment
62 . . S DGSTR="1,2,3,5,11,14"
63 . . S DGSET=DGSET+1
64 . . S DGSEGSTR=$$OBX^DGPFHLU2(DGSET,"S","",$P($G(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL)
65 . . Q:(DGSEGSTR="")
66 . . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
67 . . ;
68 . . ;build review comment OBX segments
69 . . S DGTROOT="DGPFAH(""COMMENT"")"
70 . . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGSEG,.DGSET)
71 . . ;
72 . . ;success
73 . . S DGHIEN=DGHARR(DGADT)
74 ;
75 Q DGHIEN
76 ;
77PARSORU(DGWRK,DGHL,DGROOT,DGPFERR) ;Parse ORU~R01 Message/Segments
78 ;
79 ; Input:
80 ; DGWRK - Closed root work global reference
81 ; DGHL - HL7 environment array
82 ; DGROOT - Closed root ORU results array name
83 ;
84 ; Output:
85 ; DGROOT - ORU results array
86 ; Subscript Field name Fld# File#
87 ; ----------------------- -------------------- ---- -----
88 ; "SNDFAC" N/A N/A N/A
89 ; "DFN" PATIENT NAME .01 26.13
90 ; "FLAG" FLAG NAME .02 26.13
91 ; "OWNER" OWNER SITE .04 26.13
92 ; "ORIGSITE" ORIGINATING SITE .05 26.13
93 ; "NARR",line ASSIGNMENT NARRATIVE 1 26.13
94 ; assigndt,"ACTION" ACTION .03 26.13
95 ; assigndt,"COMMENT",line HISTORY COMMENTS 1 26.14
96 ; DGPFERR - Undefined on success, ERR segment data array on failure
97 ; Format: DGPFERR(seg_id,sequence,fld_pos)=error_code
98 ;
99 N DGFS ;field separator
100 N DGCS ;component separator
101 N DGRS ;repetition separator
102 N DGCURLIN ;current segment line
103 N DGSEG ;segment field data array
104 N DGERR ;error processing array
105 ;
106 S DGFS=DGHL("FS")
107 S DGCS=$E(DGHL("ECH"),1)
108 S DGRS=$E(DGHL("ECH"),2)
109 S DGCURLIN=0
110 ;
111 ;loop through message segments and retrieve field data
112 F D Q:'DGCURLIN
113 . N DGSEG
114 . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
115 . Q:'DGCURLIN
116 . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGROOT,.DGPFERR)")
117 ;
118MSH(DGSEG,DGCS,DGRS,DGORU,DGERR) ;
119 ;
120 ; Input:
121 ; DGSEG - MSH segment field array
122 ; DGCS - HL7 component separator
123 ; DGRS - HL7 repetition separator
124 ; DGORU - Closed root ORU results array name
125 ;
126 ; Output:
127 ; DGORU - ORU results array
128 ; Subscript
129 ; ---------
130 ; "SNDFAC"
131 ; DGERR - undefined on success, error array on failure
132 ; format: DGERR(seg_id,sequence,fld_pos)=error code
133 ;
134 S @DGORU@("SNDFAC")=$$IEN^XUAF4($P(DGSEG(4),DGCS,1))
135 Q
136 ;
137PID(DGSEG,DGCS,DGRS,DGORU,DGERR) ;
138 ;
139 ; Input:
140 ; DGSEG - PID segment field array
141 ; DGCS - HL7 component separator
142 ; DGRS - HL7 repetition separator
143 ; DGORU - Closed root ORU results array name
144 ;
145 ; Output:
146 ; DGORU - ORU results array
147 ; Subscript
148 ; ---------
149 ; "DFN"
150 ; DGERR - undefined on success, error array on failure
151 ; format: DGERR(seg_id,sequence,fld_pos)=error code
152 ;
153 N DGARR
154 N DGDFNERR
155 N DGICN
156 ;
157 S DGICN=+$P(DGSEG(3),DGCS,1)
158 S DGARR("DFN")=$$GETDFN^DGPFUT2(DGICN,"DGDFNERR")
159 I 'DGARR("DFN"),$G(DGDFNERR("DIERR",1))]"" D
160 . S DGERR("PID",DGSEG(1),3)=DGDFNERR("DIERR",1) ;no match
161 ;
162 ;load results array
163 S @DGORU@("DFN")=DGARR("DFN")
164 Q
165 ;
166OBR(DGSEG,DGCS,DGRS,DGORU,DGERR) ;
167 ;
168 ; Input:
169 ; DGSEG - OBR segment field array
170 ; DGCS - HL7 component separator
171 ; DGRS - HL7 repetition separator
172 ; DGORU - Closed root ORU results array name
173 ;
174 ; Output:
175 ; DGORU - ORU results array
176 ; Subscript
177 ; ----------------
178 ; "FLAG"
179 ; "OWNER"
180 ; "ORIGSITE"
181 ; DGERR - undefined on success, error array on failure
182 ; format: DGERR(seg_id,sequence,fld_pos)=error code
183 ;
184 N DGARR
185 ;
186 S DGARR("FLAG")=$P($G(DGSEG(4)),DGCS,1)_";DGPF(26.15,"
187 I '$$TESTVAL^DGPFUT(26.13,.02,DGARR("FLAG")) D
188 . S DGERR("OBR",DGSEG(1),4)=261111 ;invalid flag
189 ;
190 S DGARR("OWNER")=$$IEN^XUAF4(DGSEG(20))
191 I (DGARR("OWNER")="")!('$$TESTVAL^DGPFUT(26.13,.04,DGARR("OWNER"))) D
192 . S DGERR("OBR",DGSEG(1),20)=261126 ;invalid owner site
193 ;
194 S DGARR("ORIGSITE")=$$IEN^XUAF4($G(DGSEG(21)))
195 I DGARR("ORIGSITE")="" S DGARR("ORIGSITE")=@DGORU@("SNDFAC")
196 I (DGARR("ORIGSITE")="")!('$$TESTVAL^DGPFUT(26.13,.05,DGARR("ORIGSITE"))) D
197 . S DGERR("OBR",DGSEG(1),21)=261125 ;invalid originating site
198 ;
199 ;load results array
200 M @DGORU=DGARR
201 Q
202 ;
203OBX(DGSEG,DGCS,DGRS,DGORU,DGERR) ;
204 ;
205 ; Input:
206 ; DGSEG - OBX segment field array
207 ; DGCS - HL7 component separator
208 ; DGRS - HL7 repetition separator
209 ; DGORU - Closed root ORU results array name
210 ;
211 ; Output:
212 ; DGORU - ORU results array
213 ; Subscript
214 ; -----------------------
215 ; "NARR",line
216 ; assigndt,"ACTION"
217 ; assigndt,"COMMENT",line
218 ; DGERR - undefined on success, error array on failure
219 ; format: DGERR(seg_id,sequence,fld_pos)=error code
220 ;
221 N DGADT ;assignment date
222 N DGI
223 N DGLINE ;word processing line count
224 N DGRSLT
225 ;
226 ; Narrative Observation Identifier
227 I $P(DGSEG(3),DGCS,1)="N" D
228 . S DGLINE=$O(@DGORU@("NARR",""),-1)
229 . F DGI=1:1:$L(DGSEG(5),DGRS) D
230 . . S @DGORU@("NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)
231 ;
232 ; Status Observation Identifier
233 I $P(DGSEG(3),DGCS,1)="S" D
234 . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
235 . Q:+DGADT'>0
236 . D CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT)
237 . S @DGORU@(DGADT,"ACTION")=+DGRSLT
238 ;
239 ; Comment Observation Identifier
240 I $P(DGSEG(3),DGCS,1)="C" D
241 . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
242 . Q:+DGADT'>0
243 . S DGLINE=$O(@DGORU@(DGADT,"COMMENT",""),-1)
244 . F DGI=1:1:$L(DGSEG(5),DGRS) D
245 . . S @DGORU@(DGADT,"COMMENT",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)
246 Q
Note: See TracBrowser for help on using the repository browser.