HLOPRS ;IRMFO-ALB/CJM -RTNs for parsing messages;03/24/2004 14:43 ;09/13/2006
;;1.6;HEALTH LEVEL SEVEN;**118,126,133**;Oct 13, 1995;Build 13
;Per VHA Directive 2004-038, this routine should not be modified.
;
STARTMSG(MSG,IEN,HDR) ;
;Description: This function begins the parsing of the message, parsing
;the header and returning the individual values in the array HDR().
;Input:
; IEN - The internal entry number of the message in file 778.
;Output:
; Function returns 1 on success, 0 on failure. Failure would indicate that the message was not found.
; 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!
; HDR (pass by reference, optional) This array contains the results of parsing the message header.
K MSG,HDR
Q:'$G(IEN) 0
Q:'$$GETMSG^HLOMSG(IEN,.MSG) 0
M HDR=MSG("HDR")
Q:'$$PARSEHDR(.HDR) 0
M MSG("HDR")=HDR
Q 1
;
NEXTSEG(MSG,SEG) ;
;Description: Advances parsing to the next segment and returns the parsed values from that segment.
;Input:
; 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!
;Output:
; 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.
; MSG - (pass by reference, required)
; SEG - (pass by reference, required) The segment is returned in this array.
;
N TEMP,CODES
K SEG
I '$$HLNEXT^HLOMSG(.MSG,.TEMP) Q 0
S CODES=MSG("HDR","ENCODING CHARACTERS")
Q $$PARSE^HLOPRS1(MSG("HDR","FIELD SEPARATOR"),$E(CODES,2),$E(CODES,1),$E(CODES,4),$E(CODES,3),.TEMP,.SEG)
;
NEXTMSG(MSG,MSH) ;
;Description: Advances to the next message within the batch, with the MSH segment returned.
;Input:
; 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!
;OUTPUT:
; Function returns 1 on success, 0 if there are no more messages
; MSG - (pass by reference)
; MSH - (pass by reference, required) Returns the parsed message header
;
K MSH
N NODE
Q:'$$NEXTMSG^HLOMSG(.MSG,.MSH) 0
Q:'$$PARSEHDR(.MSH) 0
S MSG("BATCH","CURRENT MESSAGE","EVENT")=MSH("EVENT")
S MSG("BATCH","CURRENT MESSAGE","MESSAGE CONTROL ID")=MSH("MESSAGE CONTROL ID")
S NODE=$G(^HLB(MSG("IEN"),3,MSG("BATCH","CURRENT MESSAGE"),0))
S MSG("BATCH","CURRENT MESSAGE","ACK TO")=$P(NODE,"^",3)
S MSG("BATCH","CURRENT MESSAGE","ACK BY")=$P(NODE,"^",4)
;
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"))
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"))
;
Q 1
;
PARSEHDR(HDR) ;
;Parses the segment (HDR, pass by reference) into the HDR() array using meaningful subscripts.
;Input:
; HDR (pass by reference, required) contains the segment in the format HDR(1),HDR(2), etc..
;Output:
; 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
; Function - returns 1 if the segment is indeed an MSH or BHS segment, 0 otherwise
;
N VALUE,FS,CS,REP,SUBCOMP,ESCAPE
S VALUE=$E(HDR(1),1,3)
I VALUE'="MSH",VALUE'="BHS" Q 0
S HDR("SEGMENT TYPE")=VALUE
S FS=$E(HDR(1),4)
Q:FS="" 0
S HDR("ENCODING CHARACTERS")=$P(HDR(1),FS,2)
S CS=$E(HDR("ENCODING CHARACTERS"),1)
S REP=$E(HDR("ENCODING CHARACTERS"),2)
S ESCAPE=$E(HDR("ENCODING CHARACTERS"),3)
S SUBCOMP=$E(HDR("ENCODING CHARACTERS"),4)
Q:REP="" 0
S HDR("FIELD SEPARATOR")=FS
S HDR("COMPONENT SEPARATOR")=CS
S HDR("REPETITION SEPARATOR")=REP
S HDR("ESCAPE CHARACTER")=ESCAPE
S HDR("SUBCOMPONENT SEPARATOR")=SUBCOMP
S HDR("SENDING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(HDR(1),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
S VALUE=$P(HDR(1),FS,4)
S HDR("SENDING FACILITY",1)=$P(VALUE,CS)
S HDR("SENDING FACILITY",2)=$$DESCAPE^HLOPRS1($P(VALUE,CS,2),FS,CS,SUBCOMP,REP,ESCAPE)
S HDR("SENDING FACILITY",3)=$P(VALUE,CS,3)
S HDR("RECEIVING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(HDR(1),FS,5),CS),FS,CS,SUBCOMP,REP,ESCAPE)
S VALUE=$P(HDR(1),FS,6)
S HDR("RECEIVING FACILITY",1)=$P(VALUE,CS)
S HDR("RECEIVING FACILITY",2)=$$DESCAPE^HLOPRS1($P(VALUE,CS,2),FS,CS,SUBCOMP,REP,ESCAPE)
S HDR("RECEIVING FACILITY",3)=$P(VALUE,CS,3)
S HDR("DT/TM OF MESSAGE")=$$FMDATE^HLFNC($P($P(HDR(2),FS,2),CS))
S HDR("SECURITY")=$$DESCAPE^HLOPRS1($P($P(HDR(2),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
;
I HDR("SEGMENT TYPE")="MSH" D
.S VALUE=$P(HDR(2),FS,4)
.S HDR("MESSAGE TYPE")=$P(VALUE,CS)
.S HDR("EVENT")=$P(VALUE,CS,2)
.S HDR("MESSAGE STRUCTURE")=$P(VALUE,CS,3)
.S HDR("MESSAGE CONTROL ID")=$P($P(HDR(2),FS,5),CS)
.S VALUE=$P(HDR(2),FS,6)
.S HDR("PROCESSING ID")=$P(VALUE,CS)
.S HDR("PROCESSING MODE")=$P(VALUE,CS,2)
.S HDR("VERSION")=$$DESCAPE^HLOPRS1($P($P(HDR(2),FS,7),CS),FS,CS,SUBCOMP,REP,ESCAPE)
.S HDR("CONTINUATION POINTER")=$P($P(HDR(2),FS,9),CS)
.S HDR("ACCEPT ACK TYPE")=$P($P(HDR(2),FS,10),CS)
.S HDR("APP ACK TYPE")=$P($P(HDR(2),FS,11),CS)
.S HDR("COUNTRY")=$P($P(HDR(2),FS,12),CS)
;
I HDR("SEGMENT TYPE")="BHS" D
.S VALUE=$P(HDR(2),FS,4)
.S HDR("BATCH NAME/ID/TYPE")=$$DESCAPE^HLOPRS1(VALUE,FS,CS,SUBCOMP,REP,ESCAPE)
.S HDR("PROCESSING ID")=$E($P(VALUE,"PROCESSING ID=",2),1)
.S HDR("ACCEPT ACK TYPE")=$E($P(VALUE,"ACCEPT ACK TYPE=",2),1,2)
.S HDR("APP ACK TYPE")=$E($P(VALUE,"APP ACK TYPE=",2),1,2)
.S HDR("BATCH COMMENT")=$$DESCAPE^HLOPRS1($P(HDR(2),FS,5),FS,CS,SUBCOMP,REP,ESCAPE)
.S HDR("BATCH CONTROL ID")=$P($P(HDR(2),FS,6),CS)
.S HDR("REFERENCE BATCH CONTROL ID")=$P($P(HDR(2),FS,7),CS)
.;
Q 1
;
GET(SEG,FIELD,COMP,SUBCOMP,REP) ;
;This function gets a specified value from a segment that was parsed by
;$$NEXTSEG. The FIELD,COMP,SUBCOMP,REP parameters are optional - if not
;specified, they default to 1.
; Example:
; $$GET^HLOPRS(.SEG,1) will return the value of the first field, first
; component, first subcomponent, in the first occurrence of field #1.
;Input:
;SEG - (required, pass by reference) - this is the array where the parsed segment was placed by $$NEXTSEG
;FIELD - the sequence # of the field (optional, defaults to 1)
;COMP - the # of the component (optional, defaults to 1)
;SUBCOMP - the # of the subcomponent (optional, defaults to 1)
;REP - the occurrence# (optional, defaults to 1) For a non-repeating field, the occurrence # need not be provided, because it would be 1.
;Output:
; Function returns the requested value on success, "" if not valued.
;
;allow the segment type to be obtained via field #0 (shorthand)
I $D(FIELD),$G(FIELD)=0 Q $G(SEG("SEGMENT TYPE"))
S:'$G(FIELD) FIELD=1
;
;for MSH or BHS, SEQ#1 is the field separator
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")
I FIELD=1,$G(SEG("SEGMENT TYPE"))="MSH"!($G(SEG("SEGMENT TYPE"))="BHS") Q ""
;
;For segments other than MSH or BHS, the first subscript in the SEG array needs to be incremented by 1, because SEG(1,1,1,1) is taken by the segment type, which technically isn't a field. (for convenience,we call it SEQ=0).
I $G(SEG("SEGMENT TYPE"))'="BHS",$G(SEG("SEGMENT TYPE"))'="MSH" S FIELD=FIELD+1
S:'$G(COMP) COMP=1
S:'$G(SUBCOMP) SUBCOMP=1
S:'$G(REP) REP=1
Q $G(SEG(FIELD,REP,COMP,SUBCOMP))
;
HLOPRS ;IRMFO-ALB/CJM -RTNs for parsing messages;03/24/2004 14:43 ;09/13/2006
+1 ;;1.6;HEALTH LEVEL SEVEN;**118,126,133**;Oct 13, 1995;Build 13
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
STARTMSG(MSG,IEN,HDR) ;
+1 ;Description: This function begins the parsing of the message, parsing
+2 ;the header and returning the individual values in the array HDR().
+3 ;Input:
+4 ; IEN - The internal entry number of the message in file 778.
+5 ;Output:
+6 ; Function returns 1 on success, 0 on failure. Failure would indicate that the message was not found.
+7 ; 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!
+8 ; HDR (pass by reference, optional) This array contains the results of parsing the message header.
+9 KILL MSG,HDR
+10 IF '$GET(IEN)
QUIT 0
+11 IF '$$GETMSG^HLOMSG(IEN,.MSG)
QUIT 0
+12 MERGE HDR=MSG("HDR")
+13 IF '$$PARSEHDR(.HDR)
QUIT 0
+14 MERGE MSG("HDR")=HDR
+15 QUIT 1
+16 ;
NEXTSEG(MSG,SEG) ;
+1 ;Description: Advances parsing to the next segment and returns the parsed values from that segment.
+2 ;Input:
+3 ; 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!
+4 ;Output:
+5 ; 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.
+6 ; MSG - (pass by reference, required)
+7 ; SEG - (pass by reference, required) The segment is returned in this array.
+8 ;
+9 NEW TEMP,CODES
+10 KILL SEG
+11 IF '$$HLNEXT^HLOMSG(.MSG,.TEMP)
QUIT 0
+12 SET CODES=MSG("HDR","ENCODING CHARACTERS")
+13 QUIT $$PARSE^HLOPRS1(MSG("HDR","FIELD SEPARATOR"),$EXTRACT(CODES,2),$EXTRACT(CODES,1),$EXTRACT(CODES,4),$EXTRACT(CODES,3),.TEMP,.SEG)
+14 ;
NEXTMSG(MSG,MSH) ;
+1 ;Description: Advances to the next message within the batch, with the MSH segment returned.
+2 ;Input:
+3 ; 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!
+4 ;OUTPUT:
+5 ; Function returns 1 on success, 0 if there are no more messages
+6 ; MSG - (pass by reference)
+7 ; MSH - (pass by reference, required) Returns the parsed message header
+8 ;
+9 KILL MSH
+10 NEW NODE
+11 IF '$$NEXTMSG^HLOMSG(.MSG,.MSH)
QUIT 0
+12 IF '$$PARSEHDR(.MSH)
QUIT 0
+13 SET MSG("BATCH","CURRENT MESSAGE","EVENT")=MSH("EVENT")
+14 SET MSG("BATCH","CURRENT MESSAGE","MESSAGE CONTROL ID")=MSH("MESSAGE CONTROL ID")
+15 SET NODE=$GET(^HLB(MSG("IEN"),3,MSG("BATCH","CURRENT MESSAGE"),0))
+16 SET MSG("BATCH","CURRENT MESSAGE","ACK TO")=$PIECE(NODE,"^",3)
+17 SET MSG("BATCH","CURRENT MESSAGE","ACK BY")=$PIECE(NODE,"^",4)
+18 ;
+19 IF MSG("BATCH","CURRENT MESSAGE","ACK TO")]""
SET MSG("BATCH","CURRENT MESSAGE","ACK TO IEN")=$$ACKTOIEN^HLOMSG1(MSG("MESSAGE CONTROL ID"),MSG("BATCH","CURRENT MESSAGE","ACK TO"))
+20 IF MSG("BATCH","CURRENT MESSAGE","ACK BY")]""
SET MSG("BATCH","CURRENT MESSAGE","ACK BY IEN")=$$ACKBYIEN^HLOMSG1(MSG("MESSAGE CONTROL ID"),MSG("BATCH","CURRENT MESSAGE","ACK BY"))
+21 ;
+22 QUIT 1
+23 ;
PARSEHDR(HDR) ;
+1 ;Parses the segment (HDR, pass by reference) into the HDR() array using meaningful subscripts.
+2 ;Input:
+3 ; HDR (pass by reference, required) contains the segment in the format HDR(1),HDR(2), etc..
+4 ;Output:
+5 ; 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
+6 ; Function - returns 1 if the segment is indeed an MSH or BHS segment, 0 otherwise
+7 ;
+8 NEW VALUE,FS,CS,REP,SUBCOMP,ESCAPE
+9 SET VALUE=$EXTRACT(HDR(1),1,3)
+10 IF VALUE'="MSH"
IF VALUE'="BHS"
QUIT 0
+11 SET HDR("SEGMENT TYPE")=VALUE
+12 SET FS=$EXTRACT(HDR(1),4)
+13 IF FS=""
QUIT 0
+14 SET HDR("ENCODING CHARACTERS")=$PIECE(HDR(1),FS,2)
+15 SET CS=$EXTRACT(HDR("ENCODING CHARACTERS"),1)
+16 SET REP=$EXTRACT(HDR("ENCODING CHARACTERS"),2)
+17 SET ESCAPE=$EXTRACT(HDR("ENCODING CHARACTERS"),3)
+18 SET SUBCOMP=$EXTRACT(HDR("ENCODING CHARACTERS"),4)
+19 IF REP=""
QUIT 0
+20 SET HDR("FIELD SEPARATOR")=FS
+21 SET HDR("COMPONENT SEPARATOR")=CS
+22 SET HDR("REPETITION SEPARATOR")=REP
+23 SET HDR("ESCAPE CHARACTER")=ESCAPE
+24 SET HDR("SUBCOMPONENT SEPARATOR")=SUBCOMP
+25 SET HDR("SENDING APPLICATION")=$$DESCAPE^HLOPRS1($PIECE($PIECE(HDR(1),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
+26 SET VALUE=$PIECE(HDR(1),FS,4)
+27 SET HDR("SENDING FACILITY",1)=$PIECE(VALUE,CS)
+28 SET HDR("SENDING FACILITY",2)=$$DESCAPE^HLOPRS1($PIECE(VALUE,CS,2),FS,CS,SUBCOMP,REP,ESCAPE)
+29 SET HDR("SENDING FACILITY",3)=$PIECE(VALUE,CS,3)
+30 SET HDR("RECEIVING APPLICATION")=$$DESCAPE^HLOPRS1($PIECE($PIECE(HDR(1),FS,5),CS),FS,CS,SUBCOMP,REP,ESCAPE)
+31 SET VALUE=$PIECE(HDR(1),FS,6)
+32 SET HDR("RECEIVING FACILITY",1)=$PIECE(VALUE,CS)
+33 SET HDR("RECEIVING FACILITY",2)=$$DESCAPE^HLOPRS1($PIECE(VALUE,CS,2),FS,CS,SUBCOMP,REP,ESCAPE)
+34 SET HDR("RECEIVING FACILITY",3)=$PIECE(VALUE,CS,3)
+35 SET HDR("DT/TM OF MESSAGE")=$$FMDATE^HLFNC($PIECE($PIECE(HDR(2),FS,2),CS))
+36 SET HDR("SECURITY")=$$DESCAPE^HLOPRS1($PIECE($PIECE(HDR(2),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
+37 ;
+38 IF HDR("SEGMENT TYPE")="MSH"
Begin DoDot:1
+39 SET VALUE=$PIECE(HDR(2),FS,4)
+40 SET HDR("MESSAGE TYPE")=$PIECE(VALUE,CS)
+41 SET HDR("EVENT")=$PIECE(VALUE,CS,2)
+42 SET HDR("MESSAGE STRUCTURE")=$PIECE(VALUE,CS,3)
+43 SET HDR("MESSAGE CONTROL ID")=$PIECE($PIECE(HDR(2),FS,5),CS)
+44 SET VALUE=$PIECE(HDR(2),FS,6)
+45 SET HDR("PROCESSING ID")=$PIECE(VALUE,CS)
+46 SET HDR("PROCESSING MODE")=$PIECE(VALUE,CS,2)
+47 SET HDR("VERSION")=$$DESCAPE^HLOPRS1($PIECE($PIECE(HDR(2),FS,7),CS),FS,CS,SUBCOMP,REP,ESCAPE)
+48 SET HDR("CONTINUATION POINTER")=$PIECE($PIECE(HDR(2),FS,9),CS)
+49 SET HDR("ACCEPT ACK TYPE")=$PIECE($PIECE(HDR(2),FS,10),CS)
+50 SET HDR("APP ACK TYPE")=$PIECE($PIECE(HDR(2),FS,11),CS)
+51 SET HDR("COUNTRY")=$PIECE($PIECE(HDR(2),FS,12),CS)
End DoDot:1
+52 ;
+53 IF HDR("SEGMENT TYPE")="BHS"
Begin DoDot:1
+54 SET VALUE=$PIECE(HDR(2),FS,4)
+55 SET HDR("BATCH NAME/ID/TYPE")=$$DESCAPE^HLOPRS1(VALUE,FS,CS,SUBCOMP,REP,ESCAPE)
+56 SET HDR("PROCESSING ID")=$EXTRACT($PIECE(VALUE,"PROCESSING ID=",2),1)
+57 SET HDR("ACCEPT ACK TYPE")=$EXTRACT($PIECE(VALUE,"ACCEPT ACK TYPE=",2),1,2)
+58 SET HDR("APP ACK TYPE")=$EXTRACT($PIECE(VALUE,"APP ACK TYPE=",2),1,2)
+59 SET HDR("BATCH COMMENT")=$$DESCAPE^HLOPRS1($PIECE(HDR(2),FS,5),FS,CS,SUBCOMP,REP,ESCAPE)
+60 SET HDR("BATCH CONTROL ID")=$PIECE($PIECE(HDR(2),FS,6),CS)
+61 SET HDR("REFERENCE BATCH CONTROL ID")=$PIECE($PIECE(HDR(2),FS,7),CS)
+62 ;
End DoDot:1
+63 QUIT 1
+64 ;
GET(SEG,FIELD,COMP,SUBCOMP,REP) ;
+1 ;This function gets a specified value from a segment that was parsed by
+2 ;$$NEXTSEG. The FIELD,COMP,SUBCOMP,REP parameters are optional - if not
+3 ;specified, they default to 1.
+4 ; Example:
+5 ; $$GET^HLOPRS(.SEG,1) will return the value of the first field, first
+6 ; component, first subcomponent, in the first occurrence of field #1.
+7 ;Input:
+8 ;SEG - (required, pass by reference) - this is the array where the parsed segment was placed by $$NEXTSEG
+9 ;FIELD - the sequence # of the field (optional, defaults to 1)
+10 ;COMP - the # of the component (optional, defaults to 1)
+11 ;SUBCOMP - the # of the subcomponent (optional, defaults to 1)
+12 ;REP - the occurrence# (optional, defaults to 1) For a non-repeating field, the occurrence # need not be provided, because it would be 1.
+13 ;Output:
+14 ; Function returns the requested value on success, "" if not valued.
+15 ;
+16 ;allow the segment type to be obtained via field #0 (shorthand)
+17 IF $DATA(FIELD)
IF $GET(FIELD)=0
QUIT $GET(SEG("SEGMENT TYPE"))
+18 IF '$GET(FIELD)
SET FIELD=1
+19 ;
+20 ;for MSH or BHS, SEQ#1 is the field separator
+21 IF FIELD=1
IF $GET(SEG("SEGMENT TYPE"))="MSH"!($GET(SEG("SEGMENT TYPE"))="BHS")
IF $GET(REP)<2
IF $GET(COMP)<2
IF $GET(SUBCOMP)<2
QUIT SEG("FIELD SEPARATOR")
+22 IF FIELD=1
IF $GET(SEG("SEGMENT TYPE"))="MSH"!($GET(SEG("SEGMENT TYPE"))="BHS")
QUIT ""
+23 ;
+24 ;For segments other than MSH or BHS, the first subscript in the SEG array needs to be incremented by 1, because SEG(1,1,1,1) is taken by the segment type, which technically isn't a field. (for convenience,we call it SEQ=0).
+25 IF $GET(SEG("SEGMENT TYPE"))'="BHS"
IF $GET(SEG("SEGMENT TYPE"))'="MSH"
SET FIELD=FIELD+1
+26 IF '$GET(COMP)
SET COMP=1
+27 IF '$GET(SUBCOMP)
SET SUBCOMP=1
+28 IF '$GET(REP)
SET REP=1
+29 QUIT $GET(SEG(FIELD,REP,COMP,SUBCOMP))
+30 ;
