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

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1DGROHLQ3 ;DJH/AMA - ROM HL7 QRY/ORF PROCESSING ; 27 Apr 2004 4:50 PM
2 ;;5.3;Registration;**533,572**;Aug 13, 1993
3 ;
4PARSQRY(DGWRK,DGHL,DGQRY,DGROERR) ;Parse QRY~R02 Message/Segments
5 ;Called from RCVQRY^DGROHLR
6 ; Input:
7 ; DGWRK - Closed root global reference, ^TMP("DGROHL7",$J)
8 ; DGHL - VistA HL7 environment array
9 ;
10 ; Output:
11 ; DGQRY - Patient lookup components array
12 ; DGROERR - Undefined on success, ERR segment data array on failure
13 ; Format: DGROERR(seg_id,sequence,fld_pos)=error_code
14 ;
15 N DGFS ;field separator
16 N DGCS ;component separator
17 N DGRS ;repetition separator
18 N DGSS ;sub-component separator
19 N DGCURLIN ;current segment line
20 N DGSEG ;segment field data array
21 N DGROERR ;error processing array
22 ;
23 S DGFS=DGHL("FS")
24 S DGCS=$E(DGHL("ECH"),1)
25 S DGRS=$E(DGHL("ECH"),2)
26 S DGSS=$E(DGHL("ECH"),4)
27 S DGCURLIN=0
28 ;
29 ;loop through the message segments and retrieve the field data
30 F D Q:'DGCURLIN
31 . N DGSEG
32 . S DGCURLIN=$$NXTSEG^DGROHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
33 . Q:'DGCURLIN
34 . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGQRY,.DGROERR)")
35 Q
36 ;
37PARSORF(DGWRK,DGHL,DGORF,DGMSG,DGDATA) ;Parse ORF~R04 Message/Segments
38 ;Called RCVORF^DGROHLR
39 ; Input:
40 ; DGWRK - Closed root work global reference, ^TMP("DGROHL7",$J)
41 ; DGHL - HL7 environment array
42 ;
43 ; Output:
44 ; DGORF - array of ORF results
45 ; "ACKCODE" - acknowledgment code ("AA","AE","AR")
46 ; "DFN" - DFN
47 ; "ICN" - patient's Integrated Control Number
48 ; "MSGDTM" - message creation date/time in FileMan format
49 ; "MSGID" - Message ID for HL7
50 ; "RCVFAC" - receiving facility
51 ; "SNDFAC" - sending facility
52 ; DGDATA - array of patient data to upload, ^TMP("DGROFDA",$J)
53 ; DGMSG - undefined on success, array of MailMan text on failure
54 ;
55 N DGFS,DGCS,DGRS,DGSS,DGCURLIN
56 ;
57 S DGFS=DGHL("FS")
58 S DGCS=$E(DGHL("ECH"),1)
59 S DGRS=$E(DGHL("ECH"),2)
60 S DGSS=$E(DGHL("ECH"),4)
61 S DGCURLIN=0
62 ;
63 ;loop through the message segments and retrieve the field data
64 F D Q:'DGCURLIN
65 . N DGSEG
66 . S DGCURLIN=$$NXTSEG^DGROHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
67 . Q:'DGCURLIN
68 . I DGSEG("TYPE")'="FDA" D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGORF,.DGMSG)") I 1
69 . E D FDA^DGROHLU(DGWRK,.DGCURLIN,DGFS,DGCS,DGRS,.DGDATA)
70 Q
71 ;
72MSH(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
73 ;
74 ; Input:
75 ; DGSEG - MSH segment field array
76 ; DGCS - HL7 component separator
77 ; DGRS - HL7 repetition separator
78 ; DGSS - HL7 sub-component separator
79 ;
80 ; Output:
81 ; DGORF - array of ORF results
82 ; "SNDFAC" - sending facility
83 ; "RCVFAC" - receiving facility
84 ; "MSGDTM" - message creation date/time in FileMan format
85 ; DGERR - undefined on success, error array on failure
86 ;
87 D MSH^DGROHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGORF,.DGERR)
88 Q
89 ;
90MSA(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
91 ;
92 ; Input:
93 ; DGSEG - MSH segment field array
94 ; DGCS - HL7 component separator
95 ; DGRS - HL7 repetition separator
96 ; DGSS - HL7 sub-component separator
97 ;
98 ; Output:
99 ; DGORF - array of ORF results
100 ; "ACKCODE" - Acknowledgment code
101 ; "MSGID" - Message Control ID of the message being ACK'ed
102 ; DGERR - undefined on success, error array on failure
103 ;
104 D MSA^DGROHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGORF,.DGERR)
105 Q
106 ;
107ERR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ;
108 ;
109 ; Input:
110 ; DGSEG - MSH segment field array
111 ; DGCS - HL7 component separator
112 ; DGRS - HL7 repetition separator
113 ; DGSS - HL7 sub-component separator
114 ;
115 ; Output:
116 ; DGORF - array of ORF results
117 ; DGERR - undefined on success, error array on failure
118 ;
119 D ERR^DGROHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGORF,.DGERR)
120 Q
121 ;
122QRD(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ;
123 ;
124 ; Input:
125 ; DGSEG - MSH segment field array
126 ; DGCS - HL7 component separator
127 ; DGRS - HL7 repetition separator
128 ; DGSS - HL7 sub-component separator
129 ;
130 ; Output:
131 ; DGQRY("ICN") - Patient's Integrated Control Number
132 ; DGQRY("DFN") - Query ID
133 ; DGQRY("USER") - Query Site user's info ;DG*5.3*572
134 ; DGERR - undefined on success, error array on failure
135 ; format: DGERR(seg_id,sequence,fld_pos)=error code
136 ;
137 S DGQRY("DFN")=$P($G(DGSEG(4)),"~")
138 S DGQRY("USER")=$P($G(DGSEG(4)),"~",2,99)
139 S DGQRY("ICN")=+$P($G(DGSEG(8)),DGCS,1)
140 S DGQRY("PATCH")=$G(DGSEG(5))
141 I DGQRY("ICN")="" D
142 . S DGERR("QRD",1,8)="NM"
143 Q
144 ;
145QRF(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ;
146 ;
147 ; Input:
148 ; DGSEG - PID segment field array
149 ; DGCS - HL7 component separator
150 ; DGRS - HL7 repetition separator
151 ; DGSS - HL7 sub-component separator
152 ;
153 ; Output:
154 ; DGQRY("SSN") - Patient's Social Security Number
155 ; DGQRY("DOB") - Patient's Date of Birth
156 ; DGERR - undefined on success, error array on failure
157 ; format: DGERR(seg_id,sequence,fld_pos)=error code
158 ;
159 S DGQRY("SSN")=$G(DGSEG(4))
160 I DGQRY("SSN")="" S DGERR("QRF",1,4)="NM" ;no match
161 ;
162 S DGQRY("DOB")=+$$HL7TFM^XLFDT($G(DGSEG(5)))
163 I DGQRY("DOB")'>0 S DGERR("QRF",1,5)="NM" ;no match
164 Q
Note: See TracBrowser for help on using the repository browser.