HLOMSG ;ALB/CJM-HL7 - APIs for files 777/778 ;07/31/2008
;;1.6;HEALTH LEVEL SEVEN;**126,134,137,138**;Oct 13, 1995;Build 34
;Per VHA Directive 2004-038, this routine should not be modified.
;
GETMSG(IEN,MSG) ;
;Description: given the message ien=MSGIEN (required), it returns the MSG array containing information about the message, defined below.
;Input:
; IEN - the ien of the message in file 778
;Output:
; Function returns 1 on success, 0 on failure
; MSG (pass by reference, required) These are the subscripts returned:
;
; "ACK BY" - msg id of msg that acknowledges this one
; "ACK BY IEN" - msg IEN of msg that acknowledges this one. If the message is in the batch, the value is <ien>^<subien>
; "ACK TO" - msg id of msg that this msg acknowledges
; "ACK TO IEN" - msg IEN of msg that this msg acknowledges. If the message is in a batch, the value is <ien>^<subien>
; "BATCH" = 1 if this is a batch message, 0 if not
; "CURRENT MESSAGE" - defined only for batch messages - a counter used during building and parsing messages to indicate the current message. It will be set to 0 initially.
; "BODY" - ptr to file 778 which contains the body of the message.
; "DIRECTION" - "IN" if incoming, "OUT" if outgoing
; "DT/TM" - date/time the message was sent or received
; "DT/TM CREATED" - date/time the record was created (.01 field, file #777)
; "LINE COUNT" - a counter used during building and parsing of
; messages to indicate the current line within the message. For
; batch messages where each message within the batch is stored
; separately, this field indicates the position within the current
; individual message
; "HDR" - the header segment, NOT parsed, as HDR(1) and HDR(2)
; "ID" - Message Control ID for an individual message, Batch Control ID for a batch message
; "IEN" - ien, file 778
; "EVENT" - HL7 event, only defined if NOT batch
; "MESSAGE TYPE" - HL7 message type, only defined if NOT batch
; "STATUS" - the completion status
;
; These are lower level subscripts of "STATUS":
; "ACCEPT ACK RESPONSE" - the application's <tag>^<rtn> to Xecute when the accept ack is received
; "ACCEPT ACK'D" - 1 if an accept ack was sent or received in response to this message
; "APP ACK RESPONSE" - the application's <tag>^<rtn> to Xecute when app ack is received
; "APP ACK'D" - 1 if an application ack was sent or received in response to this message
; "ERROR TEXT" - if in error status, a description of the error
; "LINK NAME" the link the message was transmitted through
; "PORT" - remote port over which the message was transmitted
; "PURGE" - scheduled purge dt/tm
; "QUEUE" - the queue that the message was placed on
; "SEQUENCE QUEUE" - the sequence queue (optional)
;
K MSG
Q:'$G(IEN) 0
N NODE
S MSG("IEN")=IEN
S NODE=$G(^HLB(IEN,0))
S MSG("ID")=$P(NODE,"^")
S MSG("BODY")=$P(NODE,"^",2)
S MSG("DIRECTION")=$S($E($P(NODE,"^",4))="O":"OUT",$E($P(NODE,"^",4))="I":"IN",1:"")
S MSG("ACK TO")=$P(NODE,"^",3)
S MSG("ACK BY")=$P(NODE,"^",7)
I MSG("ACK TO")]"" S MSG("ACK TO IEN")=$$ACKTOIEN^HLOMSG1($P(NODE,"^"),MSG("ACK TO"))
I MSG("ACK BY")]"" S MSG("ACK BY IEN")=$$ACKBYIEN^HLOMSG1($P(NODE,"^"),MSG("ACK BY"))
S MSG("DT/TM")=$P(NODE,"^",16)
S MSG("STATUS")=$P(NODE,"^",20)
;
D
.N NODE4
.S NODE4=$G(^HLB(IEN,4))
.S MSG("STATUS","QUEUE")=$P(NODE,"^",6)
.S MSG("STATUS","LINK NAME")=$P(NODE,"^",5)
.S MSG("STATUS","PORT")=$P(NODE,"^",8)
.S MSG("STATUS","PURGE")=$P(NODE,"^",9)
.S MSG("STATUS","ERROR TEXT")=$P(NODE,"^",21)
.S MSG("STATUS","APP ACK RESPONSE")=$P(NODE,"^",10,11)
.I MSG("STATUS","APP ACK RESPONSE")="^" S MSG("STATUS","APP ACK RESPONSE")=""
.;** START 138 cjm
.I MSG("DIRECTION")="IN" S MSG("STATUS","ACTION")=MSG("STATUS","APP ACK RESPONSE")
.;**END 138 CJM
.S MSG("STATUS","ACCEPT ACK RESPONSE")=$P(NODE,"^",12,13)
.I MSG("STATUS","ACCEPT ACK RESPONSE")="^" S MSG("STATUS","ACCEPT ACK RESPONSE")=""
.S MSG("STATUS","ACCEPT ACK'D")=$P(NODE,"^",17)
.S MSG("STATUS","APP ACK'D")=$P(NODE,"^",18)
.S MSG("STATUS")=$P(NODE,"^",20)
.S MSG("STATUS","APP HANDOFF")=$P(NODE,"^",19)
.S MSG("STATUS","ACCEPT ACK DT/TM")=$P(NODE4,"^")
.S MSG("STATUS","ACCEPT ACK ID")=$P(NODE4,"^",2)
.S MSG("STATUS","ACCEPT ACK MSA")=$P(NODE4,"^",3,99)
;
S MSG("LINE COUNT")=0
S MSG("HDR",1)=$G(^HLB(IEN,1))
S MSG("HDR",2)=$G(^HLB(IEN,2))
I 'MSG("BODY") D Q 0
.S MSG("DT/TM CREATED")=""
.S MSG("BATCH")=""
.S MSG("MESSAGE TYPE")=""
.S MSG("EVENT")=""
;
S NODE=$G(^HLA(MSG("BODY"),0))
S MSG("DT/TM CREATED")=+NODE
S MSG("BATCH")=+$P(NODE,"^",2)
I MSG("BATCH") S MSG("BATCH","CURRENT MESSAGE")=0
I 'MSG("BATCH") D
.S MSG("MESSAGE TYPE")=$P(NODE,"^",3)
.S MSG("EVENT")=$P(NODE,"^",4)
I MSG("DIRECTION")="OUT" D
.N NODE5
.S NODE5=$G(^HLB(IEN,5))
.S MSG("STATUS","SEQUENCE QUEUE")=$P(NODE5,"^")
.S MSG("STATUS","MOVED TO OUT QUEUE")=$P(NODE5,"^",2)
.S MSG("STATUS","SEQUENCE EXCEPTION RAISED")=$P(NODE5,"^",3)
Q 1
;
HLNEXT(MSG,SEG) ;
;Description: Returns the next segment as a set of lines stored in SEG.
;Input:
; MSG (pass by reference, required)
;Output:
; Function returns 1 on success, 0 on failure (no more segments)
; SEG (pass by reference, required)
;
K SEG
Q:MSG("LINE COUNT")=-1 0
I 'MSG("BATCH") D
.N I,J,NODE,START
.S START=0
.S J=1,I=MSG("LINE COUNT")
.F S I=$O(^HLA(MSG("BODY"),1,I)) Q:'I S NODE=$G(^HLA(MSG("BODY"),1,I,0)) Q:(START&(NODE="")) I NODE'="" S SEG(J)=NODE,J=J+1,START=1
.I 'I D
..S MSG("LINE COUNT")=-1
.E S MSG("LINE COUNT")=I
I MSG("BATCH") D
.N I,J,NODE,START
.S J=1,I=MSG("LINE COUNT"),START=0
.F S I=$O(^HLA(MSG("BODY"),2,MSG("BATCH","CURRENT MESSAGE"),1,I)) Q:'I S NODE=$G(^HLA(MSG("BODY"),2,MSG("BATCH","CURRENT MESSAGE"),1,I,0)) Q:(START&(NODE="")) I NODE'="" S SEG(J)=NODE,J=J+1,START=1
.I 'I D
..S MSG("LINE COUNT")=-1
.E S MSG("LINE COUNT")=I
Q $S($D(SEG):1,1:0)
;
NEXTMSG(MSG,HDR) ;
;Advances to the next message in the batch
;Input:
; MSG (pass by reference, required) - defined by $$GETMSG()
;Output:
; Function returns 1 on success, 0 if no more messages
; MSG - updated with current position in the message
; HDR (pass by reference, required) returns the header as an array of lines
;
;
K HDR
S MSG("LINE COUNT")=0
N SUBIEN,I
;
;if completed parsing, don't start over
I MSG("BATCH","CURRENT MESSAGE")=-1 Q 0
;
S I=$O(^HLB(MSG("IEN"),3,"B",MSG("BATCH","CURRENT MESSAGE")))
I 'I S MSG("BATCH","CURRENT MESSAGE")=-1 Q 0
S MSG("BATCH","CURRENT MESSAGE")=I
S SUBIEN=$O(^HLB(MSG("IEN"),3,"B",I,0))
S HDR(1)=$G(^HLB(MSG("IEN"),3,SUBIEN,1))
S HDR(2)=$G(^HLB(MSG("IEN"),3,SUBIEN,2))
Q $S($D(HDR):1,1:0)
;
ADDSEG(HLMSTATE,SEG) ;Adds a segment to the message.
;Input:
; HLMSTATE() - (pass by reference, required)
; SEG() - (pass by reference, required) The segment as lines SEG(<i>)
;
;Output:
; HLMSTATE()
;
N I,J S I=0
S J=HLMSTATE("LINE COUNT")
;
;insure a blank line between segments
I J S J=J+1,HLMSTATE("UNSTORED LINES",$S(HLMSTATE("BATCH"):HLMSTATE("BATCH","CURRENT MESSAGE"),1:1),HLMSTATE("CURRENT SEGMENT"),J)=""
;
S HLMSTATE("CURRENT SEGMENT")=HLMSTATE("CURRENT SEGMENT")+1
F S I=$O(SEG(I)) Q:'I D
.S J=J+1
.S HLMSTATE("UNSTORED LINES",$S(HLMSTATE("BATCH"):HLMSTATE("BATCH","CURRENT MESSAGE"),1:1),HLMSTATE("CURRENT SEGMENT"),J)=SEG(I),HLMSTATE("UNSTORED LINES")=HLMSTATE("UNSTORED LINES")+$L(SEG(I))+50
.I HLMSTATE("UNSTORED LINES")>HLMSTATE("SYSTEM","BUFFER") D
..I HLMSTATE("DIRECTION")="IN",$$SAVEMSG^HLOF778(.HLMSTATE) Q
..I HLMSTATE("DIRECTION")="OUT",$$SAVEMSG^HLOF777(.HLMSTATE)
;
S HLMSTATE("LINE COUNT")=J
Q
;
ADDMSG(HLMSTATE,PARMS) ;
;For outgoing messages, adds a message in the batch. There is no MSH yet, just the message type and event.
;Input:
; HLMSTATE() - (pass by reference, required)
; PARMS("EVENT")
; PARMS("MESSAGE TYPE")
;
;Output:
; HLMSTATE() - (pass by reference, required)
;
N I
S I=HLMSTATE("BATCH","CURRENT MESSAGE")+1,HLMSTATE("BATCH","CURRENT MESSAGE")=I
S HLMSTATE("UNSTORED LINES",I)=PARMS("MESSAGE TYPE")_"^"_PARMS("EVENT")
M:$G(PARMS("ACK TO"))]"" HLMSTATE("BATCH","ACK TO",I)=PARMS("ACK TO")
S HLMSTATE("CURRENT SEGMENT")=0
S HLMSTATE("LINE COUNT")=0
S HLMSTATE("UNSTORED LINES")=HLMSTATE("UNSTORED LINES")+100
Q
;
ADDMSG2(HLMSTATE,MSH) ;
;For incoming messages adds a message to the batch. This differs from ADDMSG in that the MSH segment is passed in to be stored in file 778.
;Input:
; HLMSTATE() - (pass by reference, required)
; MSH(<i>) - the MSH segment as a set of lines
;
;Output:
; HLMSTATE() - (pass by reference, required)
;
N FS,CS,VALUE
I (HLMSTATE("UNSTORED LINES")+200)>HLMSTATE("SYSTEM","BUFFER"),$$SAVEMSG^HLOF778(.HLMSTATE) ;first stores body in 777, then headers in file 778
;
S HLMSTATE("BATCH","CURRENT MESSAGE")=HLMSTATE("BATCH","CURRENT MESSAGE")+1
S FS=$E(MSH(1),4)
S CS=$E(MSH(1),5)
S VALUE=$P(MSH(2),FS,4)
S HLMSTATE("UNSTORED LINES",HLMSTATE("BATCH","CURRENT MESSAGE"))=$P(VALUE,CS)_"^"_$P(VALUE,CS,2)
S HLMSTATE("UNSTORED MSH")=1
M HLMSTATE("UNSTORED MSH",HLMSTATE("BATCH","CURRENT MESSAGE"))=MSH
S HLMSTATE("CURRENT SEGMENT")=0
S HLMSTATE("LINE COUNT")=0
S HLMSTATE("UNSTORED LINES")=HLMSTATE("UNSTORED LINES")+200
;I HLMSTATE("UNSTORED LINES")>HLMSTATE("SYSTEM","BUFFER"),$$SAVEMSG^HLOF778(.HLMSTATE) ;first stores stuff in 777, then headers in file 778
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOMSG 9640 printed Dec 13, 2024@01:58:46 Page 2
HLOMSG ;ALB/CJM-HL7 - APIs for files 777/778 ;07/31/2008
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,134,137,138**;Oct 13, 1995;Build 34
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
GETMSG(IEN,MSG) ;
+1 ;Description: given the message ien=MSGIEN (required), it returns the MSG array containing information about the message, defined below.
+2 ;Input:
+3 ; IEN - the ien of the message in file 778
+4 ;Output:
+5 ; Function returns 1 on success, 0 on failure
+6 ; MSG (pass by reference, required) These are the subscripts returned:
+7 ;
+8 ; "ACK BY" - msg id of msg that acknowledges this one
+9 ; "ACK BY IEN" - msg IEN of msg that acknowledges this one. If the message is in the batch, the value is <ien>^<subien>
+10 ; "ACK TO" - msg id of msg that this msg acknowledges
+11 ; "ACK TO IEN" - msg IEN of msg that this msg acknowledges. If the message is in a batch, the value is <ien>^<subien>
+12 ; "BATCH" = 1 if this is a batch message, 0 if not
+13 ; "CURRENT MESSAGE" - defined only for batch messages - a counter used during building and parsing messages to indicate the current message. It will be set to 0 initially.
+14 ; "BODY" - ptr to file 778 which contains the body of the message.
+15 ; "DIRECTION" - "IN" if incoming, "OUT" if outgoing
+16 ; "DT/TM" - date/time the message was sent or received
+17 ; "DT/TM CREATED" - date/time the record was created (.01 field, file #777)
+18 ; "LINE COUNT" - a counter used during building and parsing of
+19 ; messages to indicate the current line within the message. For
+20 ; batch messages where each message within the batch is stored
+21 ; separately, this field indicates the position within the current
+22 ; individual message
+23 ; "HDR" - the header segment, NOT parsed, as HDR(1) and HDR(2)
+24 ; "ID" - Message Control ID for an individual message, Batch Control ID for a batch message
+25 ; "IEN" - ien, file 778
+26 ; "EVENT" - HL7 event, only defined if NOT batch
+27 ; "MESSAGE TYPE" - HL7 message type, only defined if NOT batch
+28 ; "STATUS" - the completion status
+29 ;
+30 ; These are lower level subscripts of "STATUS":
+31 ; "ACCEPT ACK RESPONSE" - the application's <tag>^<rtn> to Xecute when the accept ack is received
+32 ; "ACCEPT ACK'D" - 1 if an accept ack was sent or received in response to this message
+33 ; "APP ACK RESPONSE" - the application's <tag>^<rtn> to Xecute when app ack is received
+34 ; "APP ACK'D" - 1 if an application ack was sent or received in response to this message
+35 ; "ERROR TEXT" - if in error status, a description of the error
+36 ; "LINK NAME" the link the message was transmitted through
+37 ; "PORT" - remote port over which the message was transmitted
+38 ; "PURGE" - scheduled purge dt/tm
+39 ; "QUEUE" - the queue that the message was placed on
+40 ; "SEQUENCE QUEUE" - the sequence queue (optional)
+41 ;
+42 KILL MSG
+43 if '$GET(IEN)
QUIT 0
+44 NEW NODE
+45 SET MSG("IEN")=IEN
+46 SET NODE=$GET(^HLB(IEN,0))
+47 SET MSG("ID")=$PIECE(NODE,"^")
+48 SET MSG("BODY")=$PIECE(NODE,"^",2)
+49 SET MSG("DIRECTION")=$SELECT($EXTRACT($PIECE(NODE,"^",4))="O":"OUT",$EXTRACT($PIECE(NODE,"^",4))="I":"IN",1:"")
+50 SET MSG("ACK TO")=$PIECE(NODE,"^",3)
+51 SET MSG("ACK BY")=$PIECE(NODE,"^",7)
+52 IF MSG("ACK TO")]""
SET MSG("ACK TO IEN")=$$ACKTOIEN^HLOMSG1($PIECE(NODE,"^"),MSG("ACK TO"))
+53 IF MSG("ACK BY")]""
SET MSG("ACK BY IEN")=$$ACKBYIEN^HLOMSG1($PIECE(NODE,"^"),MSG("ACK BY"))
+54 SET MSG("DT/TM")=$PIECE(NODE,"^",16)
+55 SET MSG("STATUS")=$PIECE(NODE,"^",20)
+56 ;
+57 Begin DoDot:1
+58 NEW NODE4
+59 SET NODE4=$GET(^HLB(IEN,4))
+60 SET MSG("STATUS","QUEUE")=$PIECE(NODE,"^",6)
+61 SET MSG("STATUS","LINK NAME")=$PIECE(NODE,"^",5)
+62 SET MSG("STATUS","PORT")=$PIECE(NODE,"^",8)
+63 SET MSG("STATUS","PURGE")=$PIECE(NODE,"^",9)
+64 SET MSG("STATUS","ERROR TEXT")=$PIECE(NODE,"^",21)
+65 SET MSG("STATUS","APP ACK RESPONSE")=$PIECE(NODE,"^",10,11)
+66 IF MSG("STATUS","APP ACK RESPONSE")="^"
SET MSG("STATUS","APP ACK RESPONSE")=""
+67 ;** START 138 cjm
+68 IF MSG("DIRECTION")="IN"
SET MSG("STATUS","ACTION")=MSG("STATUS","APP ACK RESPONSE")
+69 ;**END 138 CJM
+70 SET MSG("STATUS","ACCEPT ACK RESPONSE")=$PIECE(NODE,"^",12,13)
+71 IF MSG("STATUS","ACCEPT ACK RESPONSE")="^"
SET MSG("STATUS","ACCEPT ACK RESPONSE")=""
+72 SET MSG("STATUS","ACCEPT ACK'D")=$PIECE(NODE,"^",17)
+73 SET MSG("STATUS","APP ACK'D")=$PIECE(NODE,"^",18)
+74 SET MSG("STATUS")=$PIECE(NODE,"^",20)
+75 SET MSG("STATUS","APP HANDOFF")=$PIECE(NODE,"^",19)
+76 SET MSG("STATUS","ACCEPT ACK DT/TM")=$PIECE(NODE4,"^")
+77 SET MSG("STATUS","ACCEPT ACK ID")=$PIECE(NODE4,"^",2)
+78 SET MSG("STATUS","ACCEPT ACK MSA")=$PIECE(NODE4,"^",3,99)
End DoDot:1
+79 ;
+80 SET MSG("LINE COUNT")=0
+81 SET MSG("HDR",1)=$GET(^HLB(IEN,1))
+82 SET MSG("HDR",2)=$GET(^HLB(IEN,2))
+83 IF 'MSG("BODY")
Begin DoDot:1
+84 SET MSG("DT/TM CREATED")=""
+85 SET MSG("BATCH")=""
+86 SET MSG("MESSAGE TYPE")=""
+87 SET MSG("EVENT")=""
End DoDot:1
QUIT 0
+88 ;
+89 SET NODE=$GET(^HLA(MSG("BODY"),0))
+90 SET MSG("DT/TM CREATED")=+NODE
+91 SET MSG("BATCH")=+$PIECE(NODE,"^",2)
+92 IF MSG("BATCH")
SET MSG("BATCH","CURRENT MESSAGE")=0
+93 IF 'MSG("BATCH")
Begin DoDot:1
+94 SET MSG("MESSAGE TYPE")=$PIECE(NODE,"^",3)
+95 SET MSG("EVENT")=$PIECE(NODE,"^",4)
End DoDot:1
+96 IF MSG("DIRECTION")="OUT"
Begin DoDot:1
+97 NEW NODE5
+98 SET NODE5=$GET(^HLB(IEN,5))
+99 SET MSG("STATUS","SEQUENCE QUEUE")=$PIECE(NODE5,"^")
+100 SET MSG("STATUS","MOVED TO OUT QUEUE")=$PIECE(NODE5,"^",2)
+101 SET MSG("STATUS","SEQUENCE EXCEPTION RAISED")=$PIECE(NODE5,"^",3)
End DoDot:1
+102 QUIT 1
+103 ;
HLNEXT(MSG,SEG) ;
+1 ;Description: Returns the next segment as a set of lines stored in SEG.
+2 ;Input:
+3 ; MSG (pass by reference, required)
+4 ;Output:
+5 ; Function returns 1 on success, 0 on failure (no more segments)
+6 ; SEG (pass by reference, required)
+7 ;
+8 KILL SEG
+9 if MSG("LINE COUNT")=-1
QUIT 0
+10 IF 'MSG("BATCH")
Begin DoDot:1
+11 NEW I,J,NODE,START
+12 SET START=0
+13 SET J=1
SET I=MSG("LINE COUNT")
+14 FOR
SET I=$ORDER(^HLA(MSG("BODY"),1,I))
if 'I
QUIT
SET NODE=$GET(^HLA(MSG("BODY"),1,I,0))
if (START&(NODE=""))
QUIT
IF NODE'=""
SET SEG(J)=NODE
SET J=J+1
SET START=1
+15 IF 'I
Begin DoDot:2
+16 SET MSG("LINE COUNT")=-1
End DoDot:2
+17 IF '$TEST
SET MSG("LINE COUNT")=I
End DoDot:1
+18 IF MSG("BATCH")
Begin DoDot:1
+19 NEW I,J,NODE,START
+20 SET J=1
SET I=MSG("LINE COUNT")
SET START=0
+21 FOR
SET I=$ORDER(^HLA(MSG("BODY"),2,MSG("BATCH","CURRENT MESSAGE"),1,I))
if 'I
QUIT
SET NODE=$GET(^HLA(MSG("BODY"),2,MSG("BATCH","CURRENT MESSAGE"),1,I,0))
if (START&(NODE=""))
QUIT
IF NODE'=""
SET SEG(J)=NODE
SET J=J+1
SET START=1
+22 IF 'I
Begin DoDot:2
+23 SET MSG("LINE COUNT")=-1
End DoDot:2
+24 IF '$TEST
SET MSG("LINE COUNT")=I
End DoDot:1
+25 QUIT $SELECT($DATA(SEG):1,1:0)
+26 ;
NEXTMSG(MSG,HDR) ;
+1 ;Advances to the next message in the batch
+2 ;Input:
+3 ; MSG (pass by reference, required) - defined by $$GETMSG()
+4 ;Output:
+5 ; Function returns 1 on success, 0 if no more messages
+6 ; MSG - updated with current position in the message
+7 ; HDR (pass by reference, required) returns the header as an array of lines
+8 ;
+9 ;
+10 KILL HDR
+11 SET MSG("LINE COUNT")=0
+12 NEW SUBIEN,I
+13 ;
+14 ;if completed parsing, don't start over
+15 IF MSG("BATCH","CURRENT MESSAGE")=-1
QUIT 0
+16 ;
+17 SET I=$ORDER(^HLB(MSG("IEN"),3,"B",MSG("BATCH","CURRENT MESSAGE")))
+18 IF 'I
SET MSG("BATCH","CURRENT MESSAGE")=-1
QUIT 0
+19 SET MSG("BATCH","CURRENT MESSAGE")=I
+20 SET SUBIEN=$ORDER(^HLB(MSG("IEN"),3,"B",I,0))
+21 SET HDR(1)=$GET(^HLB(MSG("IEN"),3,SUBIEN,1))
+22 SET HDR(2)=$GET(^HLB(MSG("IEN"),3,SUBIEN,2))
+23 QUIT $SELECT($DATA(HDR):1,1:0)
+24 ;
ADDSEG(HLMSTATE,SEG) ;Adds a segment to the message.
+1 ;Input:
+2 ; HLMSTATE() - (pass by reference, required)
+3 ; SEG() - (pass by reference, required) The segment as lines SEG(<i>)
+4 ;
+5 ;Output:
+6 ; HLMSTATE()
+7 ;
+8 NEW I,J
SET I=0
+9 SET J=HLMSTATE("LINE COUNT")
+10 ;
+11 ;insure a blank line between segments
+12 IF J
SET J=J+1
SET HLMSTATE("UNSTORED LINES",$SELECT(HLMSTATE("BATCH"):HLMSTATE("BATCH","CURRENT MESSAGE"),1:1),HLMSTATE("CURRENT SEGMENT"),J)=""
+13 ;
+14 SET HLMSTATE("CURRENT SEGMENT")=HLMSTATE("CURRENT SEGMENT")+1
+15 FOR
SET I=$ORDER(SEG(I))
if 'I
QUIT
Begin DoDot:1
+16 SET J=J+1
+17 SET HLMSTATE("UNSTORED LINES",$SELECT(HLMSTATE("BATCH"):HLMSTATE("BATCH","CURRENT MESSAGE"),1:1),HLMSTATE("CURRENT SEGMENT"),J)=SEG(I)
SET HLMSTATE("UNSTORED LINES")=HLMSTATE("UNSTORED LINES")+$LENGTH(SEG(I))+50
+18 IF HLMSTATE("UNSTORED LINES")>HLMSTATE("SYSTEM","BUFFER")
Begin DoDot:2
+19 IF HLMSTATE("DIRECTION")="IN"
IF $$SAVEMSG^HLOF778(.HLMSTATE)
QUIT
+20 IF HLMSTATE("DIRECTION")="OUT"
IF $$SAVEMSG^HLOF777(.HLMSTATE)
End DoDot:2
End DoDot:1
+21 ;
+22 SET HLMSTATE("LINE COUNT")=J
+23 QUIT
+24 ;
ADDMSG(HLMSTATE,PARMS) ;
+1 ;For outgoing messages, adds a message in the batch. There is no MSH yet, just the message type and event.
+2 ;Input:
+3 ; HLMSTATE() - (pass by reference, required)
+4 ; PARMS("EVENT")
+5 ; PARMS("MESSAGE TYPE")
+6 ;
+7 ;Output:
+8 ; HLMSTATE() - (pass by reference, required)
+9 ;
+10 NEW I
+11 SET I=HLMSTATE("BATCH","CURRENT MESSAGE")+1
SET HLMSTATE("BATCH","CURRENT MESSAGE")=I
+12 SET HLMSTATE("UNSTORED LINES",I)=PARMS("MESSAGE TYPE")_"^"_PARMS("EVENT")
+13 if $GET(PARMS("ACK TO"))]""
MERGE HLMSTATE("BATCH","ACK TO",I)=PARMS("ACK TO")
+14 SET HLMSTATE("CURRENT SEGMENT")=0
+15 SET HLMSTATE("LINE COUNT")=0
+16 SET HLMSTATE("UNSTORED LINES")=HLMSTATE("UNSTORED LINES")+100
+17 QUIT
+18 ;
ADDMSG2(HLMSTATE,MSH) ;
+1 ;For incoming messages adds a message to the batch. This differs from ADDMSG in that the MSH segment is passed in to be stored in file 778.
+2 ;Input:
+3 ; HLMSTATE() - (pass by reference, required)
+4 ; MSH(<i>) - the MSH segment as a set of lines
+5 ;
+6 ;Output:
+7 ; HLMSTATE() - (pass by reference, required)
+8 ;
+9 NEW FS,CS,VALUE
+10 ;first stores body in 777, then headers in file 778
IF (HLMSTATE("UNSTORED LINES")+200)>HLMSTATE("SYSTEM","BUFFER")
IF $$SAVEMSG^HLOF778(.HLMSTATE)
+11 ;
+12 SET HLMSTATE("BATCH","CURRENT MESSAGE")=HLMSTATE("BATCH","CURRENT MESSAGE")+1
+13 SET FS=$EXTRACT(MSH(1),4)
+14 SET CS=$EXTRACT(MSH(1),5)
+15 SET VALUE=$PIECE(MSH(2),FS,4)
+16 SET HLMSTATE("UNSTORED LINES",HLMSTATE("BATCH","CURRENT MESSAGE"))=$PIECE(VALUE,CS)_"^"_$PIECE(VALUE,CS,2)
+17 SET HLMSTATE("UNSTORED MSH")=1
+18 MERGE HLMSTATE("UNSTORED MSH",HLMSTATE("BATCH","CURRENT MESSAGE"))=MSH
+19 SET HLMSTATE("CURRENT SEGMENT")=0
+20 SET HLMSTATE("LINE COUNT")=0
+21 SET HLMSTATE("UNSTORED LINES")=HLMSTATE("UNSTORED LINES")+200
+22 ;I HLMSTATE("UNSTORED LINES")>HLMSTATE("SYSTEM","BUFFER"),$$SAVEMSG^HLOF778(.HLMSTATE) ;first stores stuff in 777, then headers in file 778
+23 QUIT
