HLOCLNT2 ;ALB/CJM- Performs message updates for the client - 10/4/94 1pm ;03/07/2012
;;1.6;HEALTH LEVEL SEVEN;**126,130,131,133,134,137,143,158**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
GETWORK(WORK) ;
;
N OLD,DOLLARJ,SUCCESS,NOW
S SUCCESS=0
S NOW=$$NOW^XLFDT
S (OLD,DOLLARJ)=$G(WORK("DOLLARJ"))
F S DOLLARJ=$O(^HLTMP("CLIENT UPDATES",DOLLARJ)) Q:DOLLARJ="" D Q:SUCCESS
.L +^HLTMP("CLIENT UPDATES",DOLLARJ):0
.Q:'$T
.N TIME S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,""))
.I $$FMDIFF^XLFDT(NOW,TIME,2)<2 L -^HLTMP("CLIENT UPDATES",DOLLARJ) Q
.S SUCCESS=1
;
I OLD'="",'SUCCESS F S DOLLARJ=$O(^HLTMP("CLIENT UPDATES",DOLLARJ)) Q:DOLLARJ="" Q:DOLLARJ>OLD D Q:SUCCESS
.L +^HLTMP("CLIENT UPDATES",DOLLARJ):0
.Q:'$T
.N TIME S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,""))
.I $$FMDIFF^XLFDT(NOW,TIME,2)<2 L -^HLTMP("CLIENT UPDATES",DOLLARJ) Q
.S SUCCESS=1
S WORK("DOLLARJ")=DOLLARJ,WORK("NOW")=NOW
Q $S($L(WORK("DOLLARJ")):1,1:0)
;
DOWORK(WORK) ;
;
N DOLLARJ,TIME,IEN,PARMS,SYSTEM
S TIME=""
S DOLLARJ=WORK("DOLLARJ")
D SYSPARMS^HLOSITE(.SYSTEM)
F S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME)) Q:TIME="" Q:$$FMDIFF^XLFDT(WORK("NOW"),TIME,2)<2 D
.S IEN=0
.F S IEN=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)) Q:'IEN D
..N NODE
..S NODE=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN))
..S PARMS("LINK")=$P(NODE,"^")
..S PARMS("QUEUE")=$P(NODE,"^",2)
..S PARMS("STATUS")=$P(NODE,"^",3)
..S PARMS("PURGE")=$P(NODE,"^",4)
..S PARMS("ACK TO IEN")=+$P($P(NODE,"^",4),"-",2)
..S PARMS("ACCEPT ACK")=$P(NODE,"^",5)
..S PARMS("RECEIVING APP")=$P(NODE,"^",6)
..S:PARMS("RECEIVING APP")="" PARMS("RECEIVING APP")="UNKNOWN RECEIVING APPLICATION"
..S PARMS("MSA")=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"MSA"))
..S PARMS("ACTION")=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"ACTION"))
..D UPDATE(IEN,TIME,.PARMS)
..K ^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)
L -^HLTMP("CLIENT UPDATES",DOLLARJ)
Q
;
UPDATE(MSGIEN,TIME,PARMS) ;
S:PARMS("STATUS")]"" $P(^HLB(MSGIEN,0),"^",20)=PARMS("STATUS")
I PARMS("STATUS")="ER" D
.S ^HLB("ERRORS",PARMS("RECEIVING APP"),TIME,MSGIEN_"^")=""
.D COUNT^HLOESTAT("OUT",PARMS("RECEIVING APP"),$$GETSAP(MSGIEN),$$GETMTYPE(MSGIEN))
S:PARMS("ACCEPT ACK") $P(^HLB(MSGIEN,0),"^",17)=PARMS("ACCEPT ACK")
S $P(^HLB(MSGIEN,0),"^",16)=TIME
S:PARMS("MSA")]"" ^HLB(MSGIEN,4)=TIME_"^"_PARMS("MSA")
I PARMS("PURGE"),PARMS("ACTION")="" D SETPURGE^HLOF778A(MSGIEN,PARMS("STATUS"),PARMS("ACK TO IEN"))
D:PARMS("ACTION")]""
.N PURGE
.S PURGE=PARMS("PURGE")
.S:PARMS("ACK TO IEN") PURGE("ACKTOIEN")=PARMS("ACK TO IEN")
.D INQUE^HLOQUE(PARMS("LINK"),PARMS("QUEUE"),MSGIEN,PARMS("ACTION"),.PURGE)
Q
;
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:
; "ACCEPT ACK RESPONSE" - if the sending app requested notification of the accept ack, this is the routine to perform
; "ACK TO IEN" - if this is an app ack to a message not in a batch, this is the ien of the original message
; "ACK BY"
; "STATUS"
; "BATCH" = 1 if this is a batch message, 0 if not
; "CURRENT MESSAGE" - defined only for batch messages - a counterused 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.
; "LINE COUNT" - a counter used during writing of the
; messages to indicate the current line. For
; batch messages where each message within the batch is stored
; separately, this field indicates the position within the current
; individual message
; "HDR" at these lower subscripts:
; 1 - components 1-6
; 2 - components 7-end
; "ACCEPT ACK TYPE" = "AL" or "NE"
; "APP ACK TYPE" = "AL" or "NE"
; "MESSAGE CONTROL ID" - defined if NOT batch
; "BATCH CONTROL ID" - defined if batch
;
; "ID" - message id from the header
; "IEN" - ien, file 778
; "STATUS","SEQUENCE QUEUE")=name of the sequence queue (optional)
;
K MSG
Q:'$G(IEN) 0
N NODE,FS,CS,REP,SUBCOMP,ESCAPE
S MSG("IEN")=IEN
S NODE=$G(^HLB(IEN,0))
S MSG("BODY")=$P(NODE,"^",2)
S MSG("ID")=$P(NODE,"^")
Q:'MSG("BODY") 0
;
S MSG("ACK BY")=$P(NODE,"^",7)
S MSG("STATUS")=$P(NODE,"^",20)
;
;
S MSG("STATUS","ACCEPTED")=$P(NODE,"^",17)
S MSG("DT/TM")=$P(NODE,"^",16)
S MSG("STATUS","QUEUE")=$P(NODE,"^",6)
I MSG("STATUS","QUEUE")="" S MSG("STATUS","QUEUE")="DEFAULT"
S MSG("ACCEPT ACK RESPONSE")=$P(NODE,"^",12,13)
I MSG("ACCEPT ACK RESPONSE")="^" S MSG("ACCEPT ACK RESPONSE")=""
;
S MSG("BATCH")=+$P($G(^HLA(MSG("BODY"),0)),"^",2)
I MSG("BATCH") D
.S MSG("BATCH","CURRENT MESSAGE")=0
E D
.N ACKTO
.S ACKTO=$P(NODE,"^",3)
.I ACKTO]"" S ACKTO=$$ACKTOIEN^HLOMSG1(MSG("ID"),ACKTO)
.I ACKTO,+ACKTO=ACKTO S MSG("ACK TO IEN")=ACKTO
S MSG("LINE COUNT")=0
S MSG("HDR",1)=$G(^HLB(IEN,1))
S MSG("HDR",2)=$G(^HLB(IEN,2))
S FS=$E(MSG("HDR",1),4)
S CS=$E(MSG("HDR",1),5)
S REP=$E(MSG("HDR",1),6)
S ESCAPE=$E(MSG("HDR",1),7)
S SUBCOMP=$E(MSG("HDR",1),8)
S MSG("HDR","FIELD SEPARATOR")=FS
S MSG("HDR","SENDING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(MSG("HDR",1),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
S MSG("HDR","RECEIVING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(MSG("HDR",1),FS,5),CS),FS,CS,SUBCOMP,REP,ESCAPE)
I 'MSG("BATCH") D
.S MSG("HDR","MESSAGE TYPE")=$P($P(MSG("HDR",2),FS,4),CS)
.S MSG("HDR","EVENT")=$P($P(MSG("HDR",2),FS,4),CS,2)
.S MSG("HDR","ACCEPT ACK TYPE")=$E($P(MSG("HDR",2),FS,10),1,2)
.S MSG("HDR","APP ACK TYPE")=$E($P(MSG("HDR",2),FS,11),1,2)
.S MSG("HDR","MESSAGE CONTROL ID")=MSG("ID")
E D
.S MSG("HDR","BATCH CONTROL ID")=MSG("ID")
.S MSG("HDR","ACCEPT ACK TYPE")=$E($P($P(MSG("HDR",2),FS,4),"ACCEPT ACK TYPE=",2),1,2)
.S MSG("HDR","APP ACK TYPE")=$E($P($P(MSG("HDR",2),FS,4),"APP ACK TYPE=",2),1,2)
S MSG("STATUS","SEQUENCE QUEUE")=$P($G(^HLB(IEN,5)),"^")
Q 1
;
GETMTYPE(MSGIEN) ;returns <message type>~<event> OR "BATCH"
Q:'$G(MSGIEN) "UNKNOWN"
N FS,CS,HDR1,HDR2
S HDR1=$G(^HLB(IEN,1))
I $E(HDR1,1,3)="BHS" Q "BATCH"
S HDR2=$G(^HLB(IEN,2))
S FS=$E(HDR1,4)
S CS=$E(HDR1,5)
Q $P($P(HDR2,FS,4),CS)_"~"_$P($P(HDR2,FS,4),CS,2)
;
GETEVENT(MSGIEN) ; returns event if not a batch message
Q:'$G(MSGIEN) ""
N FS,CS,HDR1,HDR2
S HDR1=$G(^HLB(MSGIEN,1))
I $E(HDR1,1,3)="BHS" Q ""
S HDR2=$G(^HLB(MSGIEN,2))
S FS=$E(HDR1,4)
S CS=$E(HDR1,5)
Q $P($P(HDR2,FS,4),CS,2)
;
GETSAP(MSGIEN) ;
;
;
Q:'$G(MSGIEN) "UNKNOWN"
N FS,CS,HDR1,REP,ESCAPE,SUBCOMP
S HDR1=$G(^HLB(MSGIEN,1))
S FS=$E(HDR1,4)
S CS=$E(HDR1,5)
S REP=$E(HDR1,6)
S ESCAPE=$E(HDR1,7)
S SUBCOMP=$E(HDR1,8)
Q $$DESCAPE^HLOPRS1($P($P(HDR1,FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOCLNT2 7160 printed Dec 13, 2024@01:58:36 Page 2
HLOCLNT2 ;ALB/CJM- Performs message updates for the client - 10/4/94 1pm ;03/07/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,133,134,137,143,158**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
GETWORK(WORK) ;
+1 ;
+2 NEW OLD,DOLLARJ,SUCCESS,NOW
+3 SET SUCCESS=0
+4 SET NOW=$$NOW^XLFDT
+5 SET (OLD,DOLLARJ)=$GET(WORK("DOLLARJ"))
+6 FOR
SET DOLLARJ=$ORDER(^HLTMP("CLIENT UPDATES",DOLLARJ))
if DOLLARJ=""
QUIT
Begin DoDot:1
+7 LOCK +^HLTMP("CLIENT UPDATES",DOLLARJ):0
+8 if '$TEST
QUIT
+9 NEW TIME
SET TIME=$ORDER(^HLTMP("CLIENT UPDATES",DOLLARJ,""))
+10 IF $$FMDIFF^XLFDT(NOW,TIME,2)<2
LOCK -^HLTMP("CLIENT UPDATES",DOLLARJ)
QUIT
+11 SET SUCCESS=1
End DoDot:1
if SUCCESS
QUIT
+12 ;
+13 IF OLD'=""
IF 'SUCCESS
FOR
SET DOLLARJ=$ORDER(^HLTMP("CLIENT UPDATES",DOLLARJ))
if DOLLARJ=""
QUIT
if DOLLARJ>OLD
QUIT
Begin DoDot:1
+14 LOCK +^HLTMP("CLIENT UPDATES",DOLLARJ):0
+15 if '$TEST
QUIT
+16 NEW TIME
SET TIME=$ORDER(^HLTMP("CLIENT UPDATES",DOLLARJ,""))
+17 IF $$FMDIFF^XLFDT(NOW,TIME,2)<2
LOCK -^HLTMP("CLIENT UPDATES",DOLLARJ)
QUIT
+18 SET SUCCESS=1
End DoDot:1
if SUCCESS
QUIT
+19 SET WORK("DOLLARJ")=DOLLARJ
SET WORK("NOW")=NOW
+20 QUIT $SELECT($LENGTH(WORK("DOLLARJ")):1,1:0)
+21 ;
DOWORK(WORK) ;
+1 ;
+2 NEW DOLLARJ,TIME,IEN,PARMS,SYSTEM
+3 SET TIME=""
+4 SET DOLLARJ=WORK("DOLLARJ")
+5 DO SYSPARMS^HLOSITE(.SYSTEM)
+6 FOR
SET TIME=$ORDER(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME))
if TIME=""
QUIT
if $$FMDIFF^XLFDT(WORK("NOW"),TIME,2)<2
QUIT
Begin DoDot:1
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN))
if 'IEN
QUIT
Begin DoDot:2
+9 NEW NODE
+10 SET NODE=$GET(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN))
+11 SET PARMS("LINK")=$PIECE(NODE,"^")
+12 SET PARMS("QUEUE")=$PIECE(NODE,"^",2)
+13 SET PARMS("STATUS")=$PIECE(NODE,"^",3)
+14 SET PARMS("PURGE")=$PIECE(NODE,"^",4)
+15 SET PARMS("ACK TO IEN")=+$PIECE($PIECE(NODE,"^",4),"-",2)
+16 SET PARMS("ACCEPT ACK")=$PIECE(NODE,"^",5)
+17 SET PARMS("RECEIVING APP")=$PIECE(NODE,"^",6)
+18 if PARMS("RECEIVING APP")=""
SET PARMS("RECEIVING APP")="UNKNOWN RECEIVING APPLICATION"
+19 SET PARMS("MSA")=$GET(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"MSA"))
+20 SET PARMS("ACTION")=$GET(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"ACTION"))
+21 DO UPDATE(IEN,TIME,.PARMS)
+22 KILL ^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)
End DoDot:2
End DoDot:1
+23 LOCK -^HLTMP("CLIENT UPDATES",DOLLARJ)
+24 QUIT
+25 ;
UPDATE(MSGIEN,TIME,PARMS) ;
+1 if PARMS("STATUS")]""
SET $PIECE(^HLB(MSGIEN,0),"^",20)=PARMS("STATUS")
+2 IF PARMS("STATUS")="ER"
Begin DoDot:1
+3 SET ^HLB("ERRORS",PARMS("RECEIVING APP"),TIME,MSGIEN_"^")=""
+4 DO COUNT^HLOESTAT("OUT",PARMS("RECEIVING APP"),$$GETSAP(MSGIEN),$$GETMTYPE(MSGIEN))
End DoDot:1
+5 if PARMS("ACCEPT ACK")
SET $PIECE(^HLB(MSGIEN,0),"^",17)=PARMS("ACCEPT ACK")
+6 SET $PIECE(^HLB(MSGIEN,0),"^",16)=TIME
+7 if PARMS("MSA")]""
SET ^HLB(MSGIEN,4)=TIME_"^"_PARMS("MSA")
+8 IF PARMS("PURGE")
IF PARMS("ACTION")=""
DO SETPURGE^HLOF778A(MSGIEN,PARMS("STATUS"),PARMS("ACK TO IEN"))
+9 if PARMS("ACTION")]""
Begin DoDot:1
+10 NEW PURGE
+11 SET PURGE=PARMS("PURGE")
+12 if PARMS("ACK TO IEN")
SET PURGE("ACKTOIEN")=PARMS("ACK TO IEN")
+13 DO INQUE^HLOQUE(PARMS("LINK"),PARMS("QUEUE"),MSGIEN,PARMS("ACTION"),.PURGE)
End DoDot:1
+14 QUIT
+15 ;
GETMSG(IEN,MSG) ;
+1 ;
+2 ;Description: given the message ien=MSGIEN (required), it returns the MSG array containing information about the message, defined below.
+3 ;Input:
+4 ; IEN - the ien of the message in file 778
+5 ;Output:
+6 ; Function returns 1 on success, 0 on failure
+7 ; MSG (pass by reference, required) These are the subscripts returned:
+8 ; "ACCEPT ACK RESPONSE" - if the sending app requested notification of the accept ack, this is the routine to perform
+9 ; "ACK TO IEN" - if this is an app ack to a message not in a batch, this is the ien of the original message
+10 ; "ACK BY"
+11 ; "STATUS"
+12 ; "BATCH" = 1 if this is a batch message, 0 if not
+13 ; "CURRENT MESSAGE" - defined only for batch messages - a counterused 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 ; "LINE COUNT" - a counter used during writing of the
+16 ; messages to indicate the current line. For
+17 ; batch messages where each message within the batch is stored
+18 ; separately, this field indicates the position within the current
+19 ; individual message
+20 ; "HDR" at these lower subscripts:
+21 ; 1 - components 1-6
+22 ; 2 - components 7-end
+23 ; "ACCEPT ACK TYPE" = "AL" or "NE"
+24 ; "APP ACK TYPE" = "AL" or "NE"
+25 ; "MESSAGE CONTROL ID" - defined if NOT batch
+26 ; "BATCH CONTROL ID" - defined if batch
+27 ;
+28 ; "ID" - message id from the header
+29 ; "IEN" - ien, file 778
+30 ; "STATUS","SEQUENCE QUEUE")=name of the sequence queue (optional)
+31 ;
+32 KILL MSG
+33 if '$GET(IEN)
QUIT 0
+34 NEW NODE,FS,CS,REP,SUBCOMP,ESCAPE
+35 SET MSG("IEN")=IEN
+36 SET NODE=$GET(^HLB(IEN,0))
+37 SET MSG("BODY")=$PIECE(NODE,"^",2)
+38 SET MSG("ID")=$PIECE(NODE,"^")
+39 if 'MSG("BODY")
QUIT 0
+40 ;
+41 SET MSG("ACK BY")=$PIECE(NODE,"^",7)
+42 SET MSG("STATUS")=$PIECE(NODE,"^",20)
+43 ;
+44 ;
+45 SET MSG("STATUS","ACCEPTED")=$PIECE(NODE,"^",17)
+46 SET MSG("DT/TM")=$PIECE(NODE,"^",16)
+47 SET MSG("STATUS","QUEUE")=$PIECE(NODE,"^",6)
+48 IF MSG("STATUS","QUEUE")=""
SET MSG("STATUS","QUEUE")="DEFAULT"
+49 SET MSG("ACCEPT ACK RESPONSE")=$PIECE(NODE,"^",12,13)
+50 IF MSG("ACCEPT ACK RESPONSE")="^"
SET MSG("ACCEPT ACK RESPONSE")=""
+51 ;
+52 SET MSG("BATCH")=+$PIECE($GET(^HLA(MSG("BODY"),0)),"^",2)
+53 IF MSG("BATCH")
Begin DoDot:1
+54 SET MSG("BATCH","CURRENT MESSAGE")=0
End DoDot:1
+55 IF '$TEST
Begin DoDot:1
+56 NEW ACKTO
+57 SET ACKTO=$PIECE(NODE,"^",3)
+58 IF ACKTO]""
SET ACKTO=$$ACKTOIEN^HLOMSG1(MSG("ID"),ACKTO)
+59 IF ACKTO
IF +ACKTO=ACKTO
SET MSG("ACK TO IEN")=ACKTO
End DoDot:1
+60 SET MSG("LINE COUNT")=0
+61 SET MSG("HDR",1)=$GET(^HLB(IEN,1))
+62 SET MSG("HDR",2)=$GET(^HLB(IEN,2))
+63 SET FS=$EXTRACT(MSG("HDR",1),4)
+64 SET CS=$EXTRACT(MSG("HDR",1),5)
+65 SET REP=$EXTRACT(MSG("HDR",1),6)
+66 SET ESCAPE=$EXTRACT(MSG("HDR",1),7)
+67 SET SUBCOMP=$EXTRACT(MSG("HDR",1),8)
+68 SET MSG("HDR","FIELD SEPARATOR")=FS
+69 SET MSG("HDR","SENDING APPLICATION")=$$DESCAPE^HLOPRS1($PIECE($PIECE(MSG("HDR",1),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
+70 SET MSG("HDR","RECEIVING APPLICATION")=$$DESCAPE^HLOPRS1($PIECE($PIECE(MSG("HDR",1),FS,5),CS),FS,CS,SUBCOMP,REP,ESCAPE)
+71 IF 'MSG("BATCH")
Begin DoDot:1
+72 SET MSG("HDR","MESSAGE TYPE")=$PIECE($PIECE(MSG("HDR",2),FS,4),CS)
+73 SET MSG("HDR","EVENT")=$PIECE($PIECE(MSG("HDR",2),FS,4),CS,2)
+74 SET MSG("HDR","ACCEPT ACK TYPE")=$EXTRACT($PIECE(MSG("HDR",2),FS,10),1,2)
+75 SET MSG("HDR","APP ACK TYPE")=$EXTRACT($PIECE(MSG("HDR",2),FS,11),1,2)
+76 SET MSG("HDR","MESSAGE CONTROL ID")=MSG("ID")
End DoDot:1
+77 IF '$TEST
Begin DoDot:1
+78 SET MSG("HDR","BATCH CONTROL ID")=MSG("ID")
+79 SET MSG("HDR","ACCEPT ACK TYPE")=$EXTRACT($PIECE($PIECE(MSG("HDR",2),FS,4),"ACCEPT ACK TYPE=",2),1,2)
+80 SET MSG("HDR","APP ACK TYPE")=$EXTRACT($PIECE($PIECE(MSG("HDR",2),FS,4),"APP ACK TYPE=",2),1,2)
End DoDot:1
+81 SET MSG("STATUS","SEQUENCE QUEUE")=$PIECE($GET(^HLB(IEN,5)),"^")
+82 QUIT 1
+83 ;
GETMTYPE(MSGIEN) ;returns <message type>~<event> OR "BATCH"
+1 if '$GET(MSGIEN)
QUIT "UNKNOWN"
+2 NEW FS,CS,HDR1,HDR2
+3 SET HDR1=$GET(^HLB(IEN,1))
+4 IF $EXTRACT(HDR1,1,3)="BHS"
QUIT "BATCH"
+5 SET HDR2=$GET(^HLB(IEN,2))
+6 SET FS=$EXTRACT(HDR1,4)
+7 SET CS=$EXTRACT(HDR1,5)
+8 QUIT $PIECE($PIECE(HDR2,FS,4),CS)_"~"_$PIECE($PIECE(HDR2,FS,4),CS,2)
+9 ;
GETEVENT(MSGIEN) ; returns event if not a batch message
+1 if '$GET(MSGIEN)
QUIT ""
+2 NEW FS,CS,HDR1,HDR2
+3 SET HDR1=$GET(^HLB(MSGIEN,1))
+4 IF $EXTRACT(HDR1,1,3)="BHS"
QUIT ""
+5 SET HDR2=$GET(^HLB(MSGIEN,2))
+6 SET FS=$EXTRACT(HDR1,4)
+7 SET CS=$EXTRACT(HDR1,5)
+8 QUIT $PIECE($PIECE(HDR2,FS,4),CS,2)
+9 ;
GETSAP(MSGIEN) ;
+1 ;
+2 ;
+3 if '$GET(MSGIEN)
QUIT "UNKNOWN"
+4 NEW FS,CS,HDR1,REP,ESCAPE,SUBCOMP
+5 SET HDR1=$GET(^HLB(MSGIEN,1))
+6 SET FS=$EXTRACT(HDR1,4)
+7 SET CS=$EXTRACT(HDR1,5)
+8 SET REP=$EXTRACT(HDR1,6)
+9 SET ESCAPE=$EXTRACT(HDR1,7)
+10 SET SUBCOMP=$EXTRACT(HDR1,8)
+11 QUIT $$DESCAPE^HLOPRS1($PIECE($PIECE(HDR1,FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
