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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1DGQEHLUT ;ALB/RPM - VIC REPLACEMENT HL7 UTILITIES ; 10/6/03
2 ;;5.3;Registration;**571**;Aug 13, 1993
3 ;This routine contains generic utilities used when building
4 ;or processing received VIC REPLACEMENT HL7 messages.
5 ;
6 Q ;no supported direct entry
7 ;
8INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper
9 ;
10 ; Supported Reference:
11 ; DBIA #2161: INIT^HLFNC2
12 ;
13 ; Input:
14 ; DGPROT - Event protocol name
15 ;
16 ; Output:
17 ; Function value - HLEID on success;0 on failure
18 ; DGHL - HL array from INIT^HLFNC2 Kernel call
19 ;
20 N DGHLEID
21 S DGHLEID=0
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 ;
28 ;
29HLEID(DGPROT) ;return IEN of HL7 protocol
30 ;
31 ; Input:
32 ; DGPROT - Protocol name
33 ;
34 ; Output:
35 ; Function value - IEN of protocol on success, 0 on failure
36 ;
37 I $G(DGPROT)="" Q 0
38 Q +$O(^ORD(101,"B",DGPROT,0))
39 ;
40 ;
41NXTSEG(DGROOT,DGCURR,DGFS,DGFLD) ;retrieves next sequential segment
42 ; This function retrieves the next segment in the work global, returns
43 ; an array of field values and the segment's work global index. If
44 ; the next segment does not exist, then the function returns a zero.
45 ;
46 ; Input:
47 ; DGROOT - close root name of work global
48 ; DGCURR - index of current segment
49 ; DGFS - HL7 field separator character
50 ;
51 ; Output:
52 ; Function Value - index of the next segment on success, 0 on failure
53 ; DGFLD - array of segment field values
54 ;
55 N NXTSEG
56 ;
57 S DGCURR=DGCURR+1
58 S NXTSEG=$G(@DGROOT@(DGCURR,0))
59 I NXTSEG]"" D
60 . D GETFLDS(NXTSEG,DGFS,.DGFLD)
61 E D
62 . S DGCURR=0
63 Q DGCURR
64 ;
65 ;
66GETFLDS(DGSEG,DGFS,DGFLD) ;retrieve HL7 segment fields into an array
67 ;This procedure parses a single HL7 segment and builds an array
68 ;subscripted by the field number that contains the data for that field.
69 ;An additional subscript node, "TYPE" is created containing the segment
70 ;type.
71 ;
72 ; Input:
73 ; DGSEG - HL7 segment to parse
74 ; DGFS - HL7 field separator
75 ;
76 ; Output:
77 ; DGFLD - array of segment field values subscripted by field #
78 ; Example: DGFLD(2)="DOE,JOHN"
79 ;
80 N DGI
81 ;
82 S DGFLD("TYPE")=$P(DGSEG,DGFS)
83 F DGI=2:1:$L(DGSEG,DGFS) D
84 . S DGFLD($S(DGFLD("TYPE")="MSH":DGI,1:DGI-1))=$P(DGSEG,DGFS,DGI)
85 Q
86 ;
87 ;
88BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder
89 ;
90 ; Input:
91 ; DGTYP - segment type
92 ; DGVAL - field data array [SUB1:field, SUB2:repetition,
93 ; SUB3:component, SUB4:sub-component]
94 ; DGHL - HL7 environment array
95 ;
96 ; Output:
97 ; Function Value - Formatted HL7 segment on success, "" on failure
98 ;
99 N DGCMP ;component subscript
100 N DGCMPVAL ;component value
101 N DGFLD ;field subscript
102 N DGFLDVAL ;field value
103 N DGREP ;repetition subscript
104 N DGREPVAL ;repetition value
105 N DGSUB ;sub-component subscript
106 N DGSUBVAL ;suc-component value
107 N DGFS ;field separator
108 N DGCS ;component separator
109 N DGRS ;repetition separator
110 N DGSS ;sub-component separator
111 N DGSEG
112 N DGSEP
113 ;
114 Q:($G(DGTYP)']"") ""
115 ;
116 S DGSEG=DGTYP
117 S DGFS=DGHL("FS")
118 S DGCS=$E(DGHL("ECH"))
119 S DGRS=$E(DGHL("ECH"),2)
120 S DGSS=$E(DGHL("ECH"),4)
121 ;
122 F DGFLD=1:1:$O(DGVAL(""),-1) D
123 . S DGFLDVAL=$G(DGVAL(DGFLD)),DGSEP=DGFS
124 . D ADD(DGFLDVAL,DGSEP,.DGSEG)
125 . F DGREP=1:1:$O(DGVAL(DGFLD,""),-1) D
126 . . S DGREPVAL=$G(DGVAL(DGFLD,DGREP))
127 . . S DGSEP=$S(DGREP=1:"",1:DGRS)
128 . . D ADD(DGREPVAL,DGSEP,.DGSEG)
129 . . F DGCMP=1:1:$O(DGVAL(DGFLD,DGREP,""),-1) D
130 . . . S DGCMPVAL=$G(DGVAL(DGFLD,DGREP,DGCMP))
131 . . . S DGSEP=$S(DGCMP=1:"",1:DGCS)
132 . . . D ADD(DGCMPVAL,DGSEP,.DGSEG)
133 . . . F DGSUB=1:1:$O(DGVAL(DGFLD,DGREP,DGCMP,""),-1) D
134 . . . . S DGSUBVAL=$G(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
135 . . . . S DGSEP=$S(DGSUB=1:"",1:DGSS)
136 . . . . D ADD(DGSUBVAL,DGSEP,.DGSEG)
137 Q DGSEG
138 ;
139 ;
140ADD(DGVAL,DGSEP,DGSEG) ;append a value onto segment
141 ;
142 ; Input:
143 ; DGVAL - value to append
144 ; DGSEP - HL7 separator
145 ;
146 ; Output:
147 ; DGSEG - segment passed by reference
148 ;
149 S DGSEP=$G(DGSEP)
150 S DGVAL=$G(DGVAL)
151 S DGSEG=DGSEG_DGSEP_DGVAL
152 Q
153 ;
154CKSTR(DGFLDS,DGSTR) ;validate comma-delimited HL7 field string
155 ;
156 ; Input:
157 ; DGFLDS - (required) comma delimited string of required fields
158 ; DGSTR - (optional) comma delimited string of fields to include
159 ; in an HL7 segment.
160 ;
161 ; Output:
162 ; Function Value - validated string of fields
163 ;
164 N DGI ;generic index
165 N DGREQ ;required field
166 ;
167 Q:($G(DGFLDS)']"") ""
168 S DGSTR=$G(DGSTR)
169 F DGI=1:1 S DGREQ=$P(DGFLDS,",",DGI) Q:DGREQ="" D
170 . I ","_DGSTR_","'[(","_DGREQ_",") S DGSTR=DGSTR_$S($L(DGSTR)>0:",",1:"")_DGREQ
171 Q DGSTR
Note: See TracBrowser for help on using the repository browser.