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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1DGPFHLQ4 ;ALB/RPM - PRF HL7 ORF PROCESSING ; 12/13/04
2 ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
3 ;
4PARSORF(DGWRK,DGHL,DGROOT,DGMSG) ;Parse ORF~R04 Message/Segments
5 ;
6 ; Input:
7 ; DGWRK - Closed root work global reference
8 ; DGHL - HL7 environment array
9 ; DGROOT - Closed root ORF results array
10 ;
11 ; Output:
12 ; DGROOT - array of ORF results
13 ; OBRsetID,assigndt,"ACTION"
14 ; OBRsetID,assigndt,"COMMENT",line#
15 ; OBRsetID,"FLAG"
16 ; OBRsetID,"NARR",line#
17 ; OBRsetID,"OWNER"
18 ; "ACKCODE" - acknowledgment code ("AA","AE","AR")
19 ; "ICN" - patient's Integrated Control Number
20 ; "MSGDTM" - message creation date/time in FileMan format
21 ; "MSGID" -
22 ; "QID" - query ID (DFN)
23 ; "RCVFAC" - receiving facility
24 ; "SNDFAC" - sending facility
25 ;
26 ; DGMSG - undefined on success, array of MailMan text on failure
27 ;
28 N DGFS ;field separator
29 N DGCS ;component separator
30 N DGRS ;repitition separator
31 N DGSS ;sub-component separator
32 N DGCURLIN ;current line
33 ;
34 S DGFS=DGHL("FS")
35 S DGCS=$E(DGHL("ECH"),1)
36 S DGRS=$E(DGHL("ECH"),2)
37 S DGSS=$E(DGHL("ECH"),4)
38 S DGCURLIN=0
39 ;
40 ;loop through the message segments and retrieve the field data
41 F D Q:'DGCURLIN
42 . N DGSEG
43 . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
44 . Q:'DGCURLIN
45 . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,DGROOT,.DGMSG)")
46 Q
47 ;
48MSH(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
49 ;
50 ; Input:
51 ; DGSEG - MSH segment field array
52 ; DGCS - HL7 component separator
53 ; DGRS - HL7 repetition separator
54 ; DGSS - HL7 sub-component separator
55 ;
56 ; Output:
57 ; DGORF - array of ORF results
58 ; "SNDFAC" - sending facility
59 ; "RCVFAC" - receiving facility
60 ; "MSGDTM" - message creation date/time in FileMan format
61 ; DGERR - undefined on success, error array on failure
62 ;
63 N DGARR
64 D MSH^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
65 I $D(DGARR) M @DGORF=DGARR
66 Q
67 ;
68MSA(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
69 ;
70 ; Input:
71 ; DGSEG - MSH segment field array
72 ; DGCS - HL7 component separator
73 ; DGRS - HL7 repetition separator
74 ; DGSS - HL7 sub-component separator
75 ;
76 ; Output:
77 ; DGORF - array of ORF results
78 ; "ACKCODE" - Acknowledgment code
79 ; "MSGID" - Message Control ID of the message being ACK'ed
80 ; DGERR - undefined on success, error array on failure
81 ;
82 N DGARR
83 D MSA^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
84 I $D(DGARR) M @DGORF=DGARR
85 Q
86 ;
87ERR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
88 ;
89 ; Input:
90 ; DGSEG - MSH segment field array
91 ; DGCS - HL7 component separator
92 ; DGRS - HL7 repetition separator
93 ; DGSS - HL7 sub-component separator
94 ;
95 ; Output:
96 ; DGORF - array of ORF results
97 ; DGERR - undefined on success, error array on failure
98 ;
99 N DGARR
100 D ERR^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR)
101 I $D(DGARR) M @DGORF=DGARR
102 Q
103 ;
104QRD(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ;
105 ;
106 ; Input:
107 ; DGSEG - MSH segment field array
108 ; DGCS - HL7 component separator
109 ; DGRS - HL7 repetition separator
110 ; DGSS - HL7 sub-component separator
111 ;
112 ; Output:
113 ; DGQRY("ICN") - Patient's Integrated Control Number
114 ; DGQRY("QID") - Query ID
115 ; DGERR - undefined on success, error array on failure
116 ; format: DGERR(seg_id,sequence,fld_pos)=error code
117 ;
118 S @DGQRY@("QID")=$G(DGSEG(4))
119 S @DGQRY@("ICN")=+$P($G(DGSEG(8)),DGCS,1)
120 Q
121 ;
122OBR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
123 ;
124 ; Input:
125 ; DGSEG - OBR segment field array
126 ; DGCS - HL7 component separator
127 ; DGRS - HL7 repetition separator
128 ; DGSS - HL7 sub-component separator
129 ;
130 ; Output:
131 ; DGORF(setid,"FLAG") - FLAG NAME (.02) field, file #26.13
132 ; DGORF(setid,"OWNER") - OWNER SITE (.04) field, file #26.13
133 ; DGORF(setid,"ORIGSITE") - ORIGINATING SITE (.05) field, file #26.13
134 ; DGORF("SETID") - OBR segment Set ID
135 ; DGERR - undefined on success, error array on failure
136 ; format: DGERR(seg_id,sequence,fld_pos)=error code
137 N DGSETID ;OBR segment Set ID
138 ;
139 S (@DGORF@("SETID"),DGSETID)=+$G(DGSEG(1))
140 I DGSETID>0 D
141 . S @DGORF@(DGSETID,"FLAG")=$P($G(DGSEG(4)),DGCS,1)_";DGPF(26.15,"
142 . S @DGORF@(DGSETID,"OWNER")=$$IEN^XUAF4($G(DGSEG(20)))
143 . S @DGORF@(DGSETID,"ORIGSITE")=$$IEN^XUAF4($G(DGSEG(21)))
144 Q
145 ;
146OBX(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
147 ;
148 ; Input:
149 ; DGSEG - OBX segment field array
150 ; DGCS - HL7 component separator
151 ; DGRS - HL7 repetition separator
152 ; DGSS - HL7 sub-component separator
153 ;
154 ; Output:
155 ; DGORF(setid,"NARR",line) - ASSIGNMENT NARRATIVE (1) field,
156 ; file #26.13
157 ; DGORF(setid,assigndt,"ACTION") - ACTION (.03) field,
158 ; file #26.14
159 ; DGORF(setid,assigndt,"COMMENT",line) - HISTORY COMMENTS (1) field,
160 ; file #26.14
161 ; DGERR - undefined on success, error array on failure
162 ; format: DGERR(seg_id,sequence,fld_pos)=error code
163 ;
164 N DGADT ;assignment date
165 N DGI
166 N DGLINE ;text line counter
167 N DGRSLT
168 N DGSETID ;OBR segment Set ID
169 ;
170 S DGSETID=+$G(@DGORF@("SETID"))
171 Q:(DGSETID'>0)
172 ;
173 ; Narrative Observation Identifier
174 I $P(DGSEG(3),DGCS,1)="N" D
175 . S DGLINE=$O(@DGORF@(DGSETID,"NARR",""),-1)
176 . F DGI=1:1:$L(DGSEG(5),DGRS) D
177 . . S @DGORF@(DGSETID,"NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)
178 ;
179 ; Status Observation Identifier
180 I $P(DGSEG(3),DGCS,1)="S" D
181 . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
182 . Q:(+DGADT'>0)
183 . D CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT)
184 . S @DGORF@(DGSETID,DGADT,"ACTION")=+DGRSLT
185 ;
186 ; Comment Observation Identifier
187 I $P(DGSEG(3),DGCS,1)="C" D
188 . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L")
189 . Q:(+DGADT'>0)
190 . S DGLINE=$O(@DGORF@(DGSETID,DGADT,"COMMENT",""),-1)
191 . F DGI=1:1:$L(DGSEG(5),DGRS) D
192 . . S @DGORF@(DGSETID,DGADT,"COMMENT",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI)
193 Q
Note: See TracBrowser for help on using the repository browser.