- 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 Feb 18, 2025@23:25:01 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)