source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOPRS.m@ 945

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

initial load of FOIAVistA 6/30/08 version

File size: 7.1 KB
Line 
1HLOPRS ;IRMFO-ALB/CJM -RTNs for parsing messages;03/24/2004 14:43 ;12/11/2006
2 ;;1.6;HEALTH LEVEL SEVEN;**118,126,133,132,134**;Oct 13, 1995;Build 30
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5STARTMSG(MSG,IEN,HDR) ;
6 ;Description: This function begins the parsing of the message, parsing
7 ;the header and returning the individual values in the array HDR().
8 ;Input:
9 ; IEN - The internal entry number of the message in file 778.
10 ;Output:
11 ; Function returns 1 on success, 0 on failure. Failure would indicate that the message was not found.
12 ; MSG - (pass by reference, required) This array is used by the HL7 package to track the progress of parsing the message. The application MUST NOT touch it!
13 ; HDR (pass by reference, optional) This array contains the results of parsing the message header.
14 K MSG,HDR
15 Q:'$G(IEN) 0
16 Q:'$$GETMSG^HLOMSG(IEN,.MSG) 0
17 M HDR=MSG("HDR")
18 Q:'$$PARSEHDR(.HDR) 0
19 M MSG("HDR")=HDR
20 Q 1
21 ;
22NEXTSEG(MSG,SEG) ;
23 ;Description: Advances parsing to the next segment and returns the parsed values from that segment.
24 ;Input:
25 ; MSG - (pass by reference, required) This array is used by the HL7 package to track the current position in the message. The application MUST NOT touch it!
26 ;Output:
27 ; Function returns 1 on success, 0 if there are no more segments in this message. For batch messages, a return value of 0 does not preclude the possibility that there are additional individual messages within the batch.
28 ; MSG - (pass by reference, required)
29 ; SEG - (pass by reference, required) The segment is returned in this array.
30 ;
31 N TEMP,CODES
32 K SEG
33 I '$$HLNEXT^HLOMSG(.MSG,.TEMP) Q 0
34 S CODES=MSG("HDR","ENCODING CHARACTERS")
35 Q $$PARSE^HLOPRS1(MSG("HDR","FIELD SEPARATOR"),$E(CODES,2),$E(CODES,1),$E(CODES,4),$E(CODES,3),.TEMP,.SEG)
36 ;
37NEXTMSG(MSG,MSH) ;
38 ;Description: Advances to the next message within the batch, with the MSH segment returned.
39 ;Input:
40 ; MSG (pass by reference, required) This array is used by the HL7 package to track the current position in the message. The application MUST NOT touch it!
41 ;OUTPUT:
42 ; Function returns 1 on success, 0 if there are no more messages
43 ; MSG - (pass by reference)
44 ; MSH - (pass by reference, required) Returns the parsed message header
45 ;
46 K MSH
47 N NODE
48 Q:'$$NEXTMSG^HLOMSG(.MSG,.MSH) 0
49 Q:'$$PARSEHDR(.MSH) 0
50 S MSG("BATCH","CURRENT MESSAGE","EVENT")=MSH("EVENT")
51 S MSG("BATCH","CURRENT MESSAGE","MESSAGE CONTROL ID")=MSH("MESSAGE CONTROL ID")
52 S NODE=$G(^HLB(MSG("IEN"),3,MSG("BATCH","CURRENT MESSAGE"),0))
53 S MSG("BATCH","CURRENT MESSAGE","ACK TO")=$P(NODE,"^",3)
54 S MSG("BATCH","CURRENT MESSAGE","ACK BY")=$P(NODE,"^",4)
55 ;
56 I MSG("BATCH","CURRENT MESSAGE","ACK TO")]"" S MSG("BATCH","CURRENT MESSAGE","ACK TO IEN")=$$ACKTOIEN^HLOMSG1(MSG("MESSAGE CONTROL ID"),MSG("BATCH","CURRENT MESSAGE","ACK TO"))
57 I MSG("BATCH","CURRENT MESSAGE","ACK BY")]"" S MSG("BATCH","CURRENT MESSAGE","ACK BY IEN")=$$ACKBYIEN^HLOMSG1(MSG("MESSAGE CONTROL ID"),MSG("BATCH","CURRENT MESSAGE","ACK BY"))
58 ;
59 Q 1
60 ;
61PARSEHDR(HDR) ;
62 ;Parses the segment (HDR, pass by reference) into the HDR() array using meaningful subscripts.
63 ;Input:
64 ; HDR (pass by reference, required) contains the segment in the format HDR(1),HDR(2), etc..
65 ;Output:
66 ; HDR (pass by reference, required) This array will contain all the individual values. Also will contain HDR(1) with components 1-6 and HDR(2) with components 1-end
67 ; Function - returns 1 if the segment is indeed an MSH or BHS segment, 0 otherwise
68 ;
69 N VALUE,FS,CS,REP,SUBCOMP,ESCAPE
70 S VALUE=$E(HDR(1),1,3)
71 I VALUE'="MSH",VALUE'="BHS" Q 0
72 S HDR("SEGMENT TYPE")=VALUE
73 S FS=$E(HDR(1),4)
74 Q:FS="" 0
75 S HDR("ENCODING CHARACTERS")=$P(HDR(1),FS,2)
76 S CS=$E(HDR("ENCODING CHARACTERS"),1)
77 S REP=$E(HDR("ENCODING CHARACTERS"),2)
78 S ESCAPE=$E(HDR("ENCODING CHARACTERS"),3)
79 S SUBCOMP=$E(HDR("ENCODING CHARACTERS"),4)
80 Q:REP="" 0
81 S HDR("FIELD SEPARATOR")=FS
82 S HDR("COMPONENT SEPARATOR")=CS
83 S HDR("REPETITION SEPARATOR")=REP
84 S HDR("ESCAPE CHARACTER")=ESCAPE
85 S HDR("SUBCOMPONENT SEPARATOR")=SUBCOMP
86 S HDR("SENDING APPLICATION")=$$DESCAPE($P($P(HDR(1),FS,3),CS))
87 S VALUE=$P(HDR(1),FS,4)
88 S HDR("SENDING FACILITY",1)=$$DESCAPE($P(VALUE,CS))
89 S HDR("SENDING FACILITY",2)=$$DESCAPE($P(VALUE,CS,2))
90 S HDR("SENDING FACILITY",3)=$$DESCAPE($P(VALUE,CS,3))
91 S HDR("RECEIVING APPLICATION")=$$DESCAPE($P($P(HDR(1),FS,5),CS))
92 S VALUE=$P(HDR(1),FS,6)
93 S HDR("RECEIVING FACILITY",1)=$$DESCAPE($P(VALUE,CS))
94 S HDR("RECEIVING FACILITY",2)=$$DESCAPE($P(VALUE,CS,2))
95 S HDR("RECEIVING FACILITY",3)=$$DESCAPE($P(VALUE,CS,3))
96 S HDR("DT/TM OF MESSAGE")=$$FMDATE^HLFNC($$DESCAPE($P($P(HDR(2),FS,2),CS)))
97 S HDR("SECURITY")=$$DESCAPE($P($P(HDR(2),FS,3),CS))
98 ;
99 I HDR("SEGMENT TYPE")="MSH" D
100 .S VALUE=$P(HDR(2),FS,4)
101 .S HDR("MESSAGE TYPE")=$P(VALUE,CS)
102 .S HDR("EVENT")=$P(VALUE,CS,2)
103 .S HDR("MESSAGE STRUCTURE")=$$DESCAPE($P(VALUE,CS,3))
104 .S HDR("MESSAGE CONTROL ID")=$$DESCAPE($P($P(HDR(2),FS,5),CS))
105 .S VALUE=$P(HDR(2),FS,6)
106 .S HDR("PROCESSING ID")=$P(VALUE,CS)
107 .S HDR("PROCESSING MODE")=$$DESCAPE($P(VALUE,CS,2))
108 .S HDR("VERSION")=$$DESCAPE($P($P(HDR(2),FS,7),CS))
109 .S HDR("CONTINUATION POINTER")=$$DESCAPE($P($P(HDR(2),FS,9),CS))
110 .S HDR("ACCEPT ACK TYPE")=$P($P(HDR(2),FS,10),CS)
111 .S HDR("APP ACK TYPE")=$P($P(HDR(2),FS,11),CS)
112 .S HDR("COUNTRY")=$$DESCAPE($P($P(HDR(2),FS,12),CS))
113 ;
114 I HDR("SEGMENT TYPE")="BHS" D
115 .S VALUE=$P(HDR(2),FS,4)
116 .S HDR("BATCH NAME/ID/TYPE")=$$DESCAPE(VALUE)
117 .S HDR("PROCESSING ID")=$E($P(VALUE,"PROCESSING ID=",2),1)
118 .S HDR("ACCEPT ACK TYPE")=$E($P(VALUE,"ACCEPT ACK TYPE=",2),1,2)
119 .S HDR("APP ACK TYPE")=$E($P(VALUE,"APP ACK TYPE=",2),1,2)
120 .S HDR("BATCH COMMENT")=$$DESCAPE($P(HDR(2),FS,5))
121 .S HDR("BATCH CONTROL ID")=$$DESCAPE($P($P(HDR(2),FS,6),CS))
122 .S HDR("REFERENCE BATCH CONTROL ID")=$$DESCAPE($P($P(HDR(2),FS,7),CS))
123 .;
124 Q 1
125 ;
126DESCAPE(VALUE) ;
127 Q $$DESCAPE^HLOPRS1(VALUE,FS,CS,SUBCOMP,REP,ESCAPE)
128 ;
129GET(SEG,FIELD,COMP,SUBCOMP,REP) ;
130 ;This function gets a specified value from a segment that was parsed by
131 ;$$NEXTSEG. The FIELD,COMP,SUBCOMP,REP parameters are optional - if not
132 ;specified, they default to 1.
133 ; Example:
134 ; $$GET^HLOPRS(.SEG,1) will return the value of the first field, first
135 ; component, first subcomponent, in the first occurrence of field #1.
136 ;Input:
137 ;SEG - (required, pass by reference) - this is the array where the parsed segment was placed by $$NEXTSEG
138 ;FIELD - the sequence # of the field (optional, defaults to 1)
139 ;COMP - the # of the component (optional, defaults to 1)
140 ;SUBCOMP - the # of the subcomponent (optional, defaults to 1)
141 ;REP - the occurrence# (optional, defaults to 1) For a non-repeating field, the occurrence # need not be provided, because it would be 1.
142 ;Output:
143 ; Function returns the requested value on success, "" if not valued.
144 ;
145 ;allow the segment type to be obtained via field #0 (shorthand)
146 I $D(FIELD),$G(FIELD)=0 Q $G(SEG("SEGMENT TYPE"))
147 S:'$G(FIELD) FIELD=1
148 ;
149 ;for MSH or BHS, SEQ#1 is the field separator
150 I FIELD=1,$G(SEG("SEGMENT TYPE"))="MSH"!($G(SEG("SEGMENT TYPE"))="BHS"),$G(REP)<2,$G(COMP)<2,$G(SUBCOMP)<2 Q SEG("FIELD SEPARATOR")
151 I FIELD=1,$G(SEG("SEGMENT TYPE"))="MSH"!($G(SEG("SEGMENT TYPE"))="BHS") Q ""
152 ;
153 S:'$G(COMP) COMP=1
154 S:'$G(SUBCOMP) SUBCOMP=1
155 S:'$G(REP) REP=1
156 Q $G(SEG(FIELD,REP,COMP,SUBCOMP))
Note: See TracBrowser for help on using the repository browser.