| 1 | HLOPRS ;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 | ; | 
|---|
| 5 | STARTMSG(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 | ; | 
|---|
| 22 | NEXTSEG(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 | ; | 
|---|
| 37 | NEXTMSG(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 | ; | 
|---|
| 61 | PARSEHDR(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 | ; | 
|---|
| 126 | DESCAPE(VALUE) ; | 
|---|
| 127 | Q $$DESCAPE^HLOPRS1(VALUE,FS,CS,SUBCOMP,REP,ESCAPE) | 
|---|
| 128 | ; | 
|---|
| 129 | GET(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)) | 
|---|