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

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

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1DGROHLUT ;DJH/AMA - ROM HL7 UTILITIES ; 24 Jun 2003 3:53 PM
2 ;;5.3;Registration;**533**;Aug 13, 1993
3 ;This routine contains generic utilities used when building
4 ;or processing received patient record flag HL7 messages.
5 ;
6 Q ;no supported direct entry
7 ;
8INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper
9 ;Called from SNDQRY^DGROHLS
10 ; Supported DBIA #2161: The supported DBIA is used to access the
11 ; VistA HL7 API to initialize the HL7 environ-
12 ; ment variables.
13 ;
14 ; Input:
15 ; DGPROT - Event protocol name
16 ;
17 ; Output:
18 ; Function value - HLEID on success;0 on failure
19 ; DGHL - HL array from INIT^HLFNC2 Kernel call
20 ;
21 N DGHLEID
22 S DGHLEID=$$HLEID(DGPROT)
23 I DGHLEID D
24 . D INIT^HLFNC2(DGHLEID,.DGHL)
25 . I $O(DGHL(""))="" S DGHLEID=0
26 Q DGHLEID
27 ;
28HLEID(DGPROT) ;return IEN of HL7 protocol
29 ;
30 ; Input:
31 ; DGPROT - Protocol name
32 ;
33 ; Output:
34 ; Function value - IEN of protocol on success, 0 on failure
35 ;
36 I $G(DGPROT)="" Q 0
37 Q +$$FIND1^DIC(101,,"B",DGPROT)
38 ;
39GETLINK(DGINST) ;retrieve a single link for a given institution
40 ;Called from SNDQRY^DGROHLS
41 ; Supported DBIA #2271: The supported DBIA is used to access the
42 ; VistA HL7 API to retrieve logical links
43 ; given a pointer to the INSTITUTION (#4) file.
44 ;
45 ; Input:
46 ; DGINST - IEN of site in INSTITUTION (#4) file
47 ;
48 ; Output:
49 ; Function Value - HL Logical link on success, 0 on failure
50 ;
51 N DGLINKS,DGLNK,DGRSLT
52 ;
53 S DGRSLT=0
54 I $G(DGINST)>0 D
55 . D LINK^HLUTIL3(DGINST,.DGLINKS,"I")
56 . S DGLNK=$O(DGLINKS(0))
57 . S DGRSLT=$S(DGLNK>0:DGLINKS(DGLNK),1:0)
58 Q DGRSLT
59 ;
60NXTSEG(DGROOT,DGCURR,DGFS,DGFLD) ;retrieves next sequential segment
61 ;This function retrieves the next segment in the work global, returns
62 ;an array of field values and the segment's work global index. If
63 ;the next segment does not exist, then the function returns a zero.
64 ; Called from PARSQRY and PARSORF^DGROHLQ3,
65 ; RCV^DGROHLR, and PARSACK^DGROHLU4
66 ;
67 ; Input:
68 ; DGROOT - close root name of work global
69 ; DGCURR - index of current segment
70 ; DGFS - HL7 field separator character
71 ;
72 ; Output:
73 ; Function Value - index of the next segment on success, 0 on failure
74 ; DGFLD - array of segment field values
75 ;
76 N NXTSEG
77 ;
78 S DGCURR=DGCURR+1
79 S NXTSEG=$G(@DGROOT@(DGCURR,0))
80 I NXTSEG]"" D
81 . D GETFLDS(NXTSEG,DGFS,.DGFLD)
82 E D
83 . S DGCURR=0
84 Q DGCURR
85 ;
86GETFLDS(DGSEG,DGFS,DGFLD) ;retrieve HL7 segment fields into an array
87 ;This procedure parses a single HL7 segment and builds an array
88 ;subscripted by the field number that contains the data for that
89 ;field. An additional subscript node, "TYPE" is created containing
90 ;the segment type.
91 ;
92 ; Input:
93 ; DGSEG - HL7 segment to parse
94 ; DGFS - HL7 field separator
95 ;
96 ; Output:
97 ; DGFLD - array of segment field values subscripted by field #
98 ; Example: DGFLD(2)="DOE,JOHN"
99 ;
100 N DGI
101 ;
102 S DGFLD("TYPE")=$P(DGSEG,DGFS)
103 F DGI=2:1:$L(DGSEG,DGFS) D
104 . S DGFLD($S(DGFLD("TYPE")="MSH":DGI,1:DGI-1))=$P(DGSEG,DGFS,DGI)
105 Q
106 ;
107STRIPTS(DGSTR) ;Strip trailing spaces from a line of text
108 ;
109 ; Input:
110 ; DGSTR - Text string
111 ;
112 ; Output:
113 ; Function Value - Input text string with trailing spaces removed
114 ;
115 N SPACE
116 S SPACE=$C(32)
117 F Q:$E(DGSTR,$L(DGSTR))'=SPACE S DGSTR=$E(DGSTR,1,$L(DGSTR)-1)
118 Q DGSTR
119 ;
120BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder
121 ;Called from QRD^DGROHLQ1, QRF^DGROHLQ2, and MSA and ERR^DGROHLU3
122 ; Input:
123 ; DGTYP - segment type
124 ; DGVAL - field data array [SUB1:field, SUB2:repetition,
125 ; SUB3:component, SUB4:sub-component]
126 ; DGHL - HL7 environment array
127 ;
128 ; Output:
129 ; Function Value - Formatted HL7 segment on success, "" on failure
130 ;
131 N DGCMP ;component subscript
132 N DGCMPVAL ;component value
133 N DGFLD ;field subscript
134 N DGFLDVAL ;field value
135 N DGREP ;repetition subscript
136 N DGREPVAL ;repetition value
137 N DGSUB ;sub-component subscript
138 N DGSUBVAL ;sub-component value
139 N DGFS ;field separator
140 N DGCS ;component separator
141 N DGRS ;repetition separator
142 N DGSS ;sub-component separator
143 N DGSEG,DGSEP
144 ;
145 Q:($G(DGTYP)']"") ""
146 ;
147 S DGSEG=DGTYP
148 S DGFS=DGHL("FS")
149 S DGCS=$E(DGHL("ECH"))
150 S DGRS=$E(DGHL("ECH"),2)
151 S DGSS=$E(DGHL("ECH"),4)
152 ;
153 F DGFLD=1:1:$O(DGVAL(""),-1) D
154 . S DGFLDVAL=$G(DGVAL(DGFLD)),DGSEP=DGFS
155 . D ADD(DGFLDVAL,DGSEP,.DGSEG)
156 . F DGREP=1:1:$O(DGVAL(DGFLD,""),-1) D
157 . . S DGREPVAL=$G(DGVAL(DGFLD,DGREP))
158 . . S DGSEP=$S(DGREP=1:"",1:DGRS)
159 . . D ADD(DGREPVAL,DGSEP,.DGSEG)
160 . . F DGCMP=1:1:$O(DGVAL(DGFLD,DGREP,""),-1) D
161 . . . S DGCMPVAL=$G(DGVAL(DGFLD,DGREP,DGCMP))
162 . . . S DGSEP=$S(DGCMP=1:"",1:DGCS)
163 . . . D ADD(DGCMPVAL,DGSEP,.DGSEG)
164 . . . F DGSUB=1:1:$O(DGVAL(DGFLD,DGREP,DGCMP,""),-1) D
165 . . . . S DGSUBVAL=$G(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
166 . . . . S DGSEP=$S(DGSUB=1:"",1:DGSS)
167 . . . . D ADD(DGSUBVAL,DGSEP,.DGSEG)
168 Q DGSEG
169 ;
170ADD(DGVAL,DGSEP,DGSEG) ;append a value onto segment
171 ;
172 ; Input:
173 ; DGVAL - value to append
174 ; DGSEP - HL7 separator
175 ;
176 ; Output:
177 ; DGSEG - segment passed by reference
178 ;
179 S DGSEP=$G(DGSEP)
180 S DGVAL=$G(DGVAL)
181 S DGSEG=DGSEG_DGSEP_DGVAL
182 Q
183 ;
184CKSTR(DGFLDS,DGSTR) ;validate comma-delimited HL7 field string
185 ;Called from QRD^DGROHLQ1, QRF^DGROHLQ2, and MSA and ERR^DGROHLU3
186 ; Input:
187 ; DGFLDS - (required) comma delimited string of required fields
188 ; DGSTR - (optional) comma delimited string of fields to include
189 ; in an HL7 segment.
190 ;
191 ; Output:
192 ; Function Value - validated string of fields
193 ;
194 N DGI ;generic index
195 N DGREQ ;required field
196 ;
197 Q:($G(DGFLDS)']"") ""
198 S DGSTR=$G(DGSTR)
199 F DGI=1:1 S DGREQ=$P(DGFLDS,",",DGI) Q:DGREQ="" D
200 . I ","_DGSTR_","'[(","_DGREQ_",") S DGSTR=DGSTR_$S($L(DGSTR)>0:",",1:"")_DGREQ
201 Q DGSTR
Note: See TracBrowser for help on using the repository browser.