source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMSVUT4.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1SCMSVUT4 ;BPFO/JRP - IEMM Utilities (cont);6/18/2002
2 ;;5.3;Scheduling;**245**;Aug 13, 1993
3 ;
4 Q
5 ;
6CNVRTHLQ(STRING,HLQ) ;Convert HL7 null designation to null
7 ;Input : STRING - String to perform conversion on
8 ; HLQ - HL7 null designation (defaults to "")
9 ;Output : STRING with HLQ converted to null
10 ;
11 ;Declare variables
12 N X,L
13 S STRING=$G(STRING)
14 I (STRING="") Q ""
15 S:('$D(HLQ)) HLQ=$C(34,34)
16 S:HLQ="" HLQ=$C(34,34)
17 S L=$L(HLQ)
18 ;Convert by removing all instances of HLQ
19 F S X=$F(STRING,HLQ) Q:'X D
20 .S STRING=$E(STRING,1,(X-L-1))_$E(STRING,X,$L(STRING))
21 Q STRING
22 ;
23PARFLD(FLD,OUTARR,HL,SUBS) ;Parse HL7 field by component
24 ;Input : FLD - Field to parse
25 ; OUTARR - Array to put parsed field into (pass by value)
26 ; HL - Array containing HL7 variables (pass by reference)
27 ; Using HL("FS"), HL("ECH"), HL("Q")
28 ; This is output by $$INIT^HLFNC2()
29 ; SUBS - Flag indicating if sub-components should also
30 ; be broken out
31 ; 0 = No (default)
32 ; 1 = Yes
33 ;Output : None
34 ; OUTARR = Value (if field not broken into components)
35 ; OUTARR(Cmp#) = Value
36 ; OUTARR(Cmp#,Sub#) = Value (if sub-component requested)
37 ;Notes : Existance and validity of input is assumed
38 ; : OUTARR initialized (KILLed) on entry
39 ; : FLD can not be a repeating field
40 ;Declare variables
41 N CS,COMP,SS,VALUE,SUB
42 S FLD=$G(FLD)
43 Q:FLD=""
44 Q:'$D(HL)
45 S CNVRT=+$G(CNVRT)
46 K @OUTARR
47 ;Get component & sub-component separators
48 S CS=$E(HL("ECH"),1)
49 S SS=$E(HL("ECH"),4)
50 ;No components - set field at main level
51 I FLD'[CS S @OUTARR=FLD Q
52 ;Parse out components
53 F COMP=1:1:$L(FLD,CS) D
54 .S VALUE=$P(FLD,CS,COMP)
55 .I 'SUBS S @OUTARR@(COMP)=VALUE Q
56 .;Parse out sub-components
57 .I VALUE'[SS S @OUTARR@(COMP)=VALUE Q
58 .F SUB=1:1:$L(VALUE,SS) D
59 ..S @OUTARR@(COMP,SUB)=$P(VALUE,SS,SUB)
60 Q
61 ;
62PARSEG(SEGARR,OUTARR,HL,PARCOMP,CNVRT) ;Parse HL7 segment by field
63 ;Input : SEGARR - Array containing segment (pass by value)
64 ; SEGARR = First 245 characters of segment
65 ; SEGARR(1..n) = Continuation nodes
66 ; OR
67 ; SEGARR(0) = First 245 characters of segment
68 ; SEGARR(1..n) = Continuation nodes
69 ; OUTARR - Array to put parsed segment into (pass by value)
70 ; HL - Array containing HL7 variables (pass by reference)
71 ; Using HL("FS"), HL("ECH"), HL("Q")
72 ; This is output by $$INIT^HLFNC2()
73 ; PARCOMP - Flag indicating if fields should be parsed into
74 ; their components
75 ; 0 = No (default)
76 ; 10 = Yes - components only
77 ; 11 = Yes - component and sub-components
78 ; CNVRT - Flag indicating if HL7 null designation should be
79 ; converted to MUMPS null (optional)
80 ; 0 = No (default)
81 ; 1 = Yes
82 ;Output : None
83 ; OUTARR will be in the following format:
84 ; OUTARR(0) = Segment name
85 ; OUTARR(Seq#,Rpt#) = Value
86 ; OUTARR(Seq#,Rpt#,Cmp#) = Value
87 ; OUTARR(Seq#,Rpt#,Cmp#,Sub#) = Value
88 ;
89 ;Notes : Existance and validity of input is assumed
90 ; : OUTARR initialized (KILLed) on entry
91 ; : Assumes no field in segment greater than 245 characters
92 ; : Data stored with the least number of subscripts in OUTARR.
93 ; If field not broken into components then the component
94 ; subscript will not be used. Same is true of the
95 ; sub-component subscript.
96 ;
97 ;Declare variables
98 N SEQ,CURNODE,CURDATA,NXTNODE,NXTDATA,VALUE,RS,REP,STOP,SEG
99 Q:'$D(SEGARR)
100 Q:'$D(@SEGARR)
101 Q:'$D(OUTARR)
102 Q:'$D(HL)
103 S PARCOMP=+$G(PARCOMP)
104 S CNVRT=+$G(CNVRT)
105 K @OUTARR
106 ;Get repetition separator
107 S RS=$E(HL("ECH"),2)
108 ;Get initial and next nodes
109 S CURNODE=$S($D(@SEGARR)#2:"",1:$O(@SEGARR@("")))
110 S CURDATA=$S(CURNODE="":@SEGARR,1:@SEGARR@(CURNODE))
111 S NXTNODE=$O(@SEGARR@(CURNODE))
112 S NXTDATA=$S(NXTNODE="":"",1:$G(@SEGARR@(NXTNODE)))
113 ;Get/strip segment name
114 S SEG=$P(CURDATA,HL("FS"),1)
115 Q:($L(SEG)'=3)
116 S CURDATA=$P(CURDATA,HL("FS"),2,99999)
117 S @OUTARR@(0)=SEG
118 ;Parse out fields
119 S STOP=0
120 S SEQ=1
121 F D Q:STOP
122 .S VALUE=$P(CURDATA,HL("FS"),1)
123 .;Account for continuation of data on next node
124 .I CURDATA'[HL("FS") D
125 ..S VALUE=VALUE_$P(NXTDATA,HL("FS"),1)
126 ..S NXTDATA=$P(NXTDATA,HL("FS"),2,99999)
127 .;Convert HL7 null to MUMPS null
128 .I CNVRT S VALUE=$$CNVRTHLQ(VALUE,HL("Q"))
129 .;Parse out repetitions
130 .F REP=1:1:$L(VALUE,RS) D
131 ..;Parse out components
132 ..I PARCOMP D Q
133 ...D PARFLD($P(VALUE,RS,REP),$NA(@OUTARR@(SEQ,REP)),.HL,(PARCOMP#2))
134 ..;Don't parse out components
135 ..S @OUTARR@(SEQ,REP)=$P(VALUE,RS,REP)
136 .;Increment sequence number
137 .S SEQ=SEQ+1
138 .;No more fields on current node - move to next node
139 .I CURDATA'[HL("FS") D Q
140 ..;No more fields - stop parsing
141 ..I NXTDATA="" S STOP=1 Q
142 ..;Update current node and get next node
143 ..S CURDATA=NXTDATA
144 ..S CURNODE=NXTNODE
145 ..S NXTNODE=$O(@SEGARR@(CURNODE))
146 ..S NXTDATA=$S(NXTNODE="":"",1:$G(@SEGARR@(NXTNODE)))
147 .;Remove current field from node
148 .S CURDATA=$P(CURDATA,HL("FS"),2,99999)
149 Q
150 ;
151PARMSG(MSGARR,OUTARR,HL,PARCOMP,CNVRT) ;Parse HL7 message by segment
152 ; and field
153 ;Input : MSGARR - Array containing message (pass by value)
154 ; MSGARR(x) = First 245 characters of Xth segment
155 ; MSGARR(x,1..n) = Continuation nodes for Xth segment
156 ; OUTARR - Array to put parsed message into (pass by value)
157 ; HL - Array containing HL7 variables (pass by reference)
158 ; Using HL("FS"), HL("ECH"), HL("Q")
159 ; This is output by $$INIT^HLFNC2()
160 ; PARCOMP - Flag indicating if fields should be parsed into
161 ; their components
162 ; 0 = No (default)
163 ; 1 = Yes
164 ; CNVRT - Flag indicating if HL7 null designation should be
165 ; converted to MUMPS null (optional)
166 ; 0 = No (default)
167 ; 10 = Yes - components only
168 ; 11 = Yes - component and sub-components
169 ;Output : None
170 ; OUTARR will be in the following format:
171 ; OUTARR(0) = Segment name
172 ; OUTARR(SegName,Rpt#)=Seg#
173 ; OUTARR(Seg#,Seq#,Rpt#) = Value
174 ; OUTARR(Seg#,Seq#,Rpt#,Cmp#) = Value
175 ; OUTARR(Seg#,Seq#,Rpt#,Cmp#,Sub#) = Value
176 ;
177 ;Notes : Existance and validity of input is assumed
178 ; : OUTARR initialized (KILLed) on entry
179 ; : Assumes no field in segment greater than 245 characters
180 ; : Data stored with the least number of subscripts in OUTARR.
181 ; If field not broken into components then the component
182 ; subscript will not be used. Same is true of the
183 ; sub-component subscript.
184 ;
185 ;Declare variables
186 N SEG,SEGNAME,REP
187 Q:'$D(MSGARR)
188 Q:'$D(@MSGARR)
189 Q:'$D(OUTARR)
190 Q:'$D(HL)
191 S PARCOMP=+$G(PARCOMP)
192 S CNVRT=+$G(CNVRT)
193 K @OUTARR
194 ;Parse message by segment
195 S SEG=""
196 F S SEG=$O(@MSGARR@(SEG)) Q:SEG="" D
197 .;Parse segment
198 .D PARSEG($NA(@MSGARR@(SEG)),$NA(@OUTARR@(SEG)),.HL,PARCOMP,CNVRT)
199 .;Set up segment index
200 .S SEGNAME=$G(@OUTARR@(SEG,0))
201 .Q:SEGNAME=""
202 .S REP=$O(@OUTARR@(SEGNAME,""),-1)+1
203 .S @OUTARR@(SEGNAME,REP)=SEG
204 Q
Note: See TracBrowser for help on using the repository browser.