HLOF778 ;ALB/CJM-HL7 - Saving messages to file 778 ;03/07/2012
;;1.6;HEALTH LEVEL SEVEN;**126,134,137,138,158**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
SAVEMSG(HLMSTATE) ;
;If a record has not yet been created in file 778, then it will be created. Will file any segments into 777 not yet stored. For batch messages, will store the MSH segments in 778 as the individual messages are stored in 777.
;Input:
; HLMSTATE (pass by reference) - contains information about the message
; These subscripts must be defined:
; ("BATCH")=1 if batch, 0 otherwise
; ("BATCH","BTS")=BTS segment if end of batch reached
; ("BODY")=ien file 777 if stored
; ("DIRECTION")=<"IN" or "OUT">
; ("IEN")=ien,file 778 if stored
; ("UNSTORED LINES") - count of lines to be stored. The lines are at the a lower subscript level <msg>,<segment>,<line>=<line to be stored>
; ("UNSTORED MSH") For batch messages, set to 1 if there are MSH in cache. Cached MSH at ("UNSTORED MSH",<subfile ien>,<1 & 2>)
;
;Output:
; Function - returns the ien of the msg (file 778)
; HLMSTATE
; ("BODY") - set to ien, file 777 if newly created
; ("IEN") - set to ien, file 778 if newly created
; ("UNSTORED LINES")-set to 0 as this function will store them
; ("UNSTORED MSH")- set to 0 as this function will store it
;
;
I '$D(HLMSTATE("DT/TM")) S HLMSTATE("DT/TM")=$S(HLMSTATE("DIRECTION")="IN":$$NOW^XLFDT,1:"")
;
;insure that 777 entry created & all segments stored
I ('HLMSTATE("BODY"))!($G(HLMSTATE("UNSTORED LINES")))!($L($G(HLMSTATE("BATCH","BTS")))),'$$SAVEMSG^HLOF777(.HLMSTATE) Q 0
;
;insure 778 entry created
I 'HLMSTATE("IEN") Q:'$$NEW^HLOF778A(.HLMSTATE) 0
;
;for batch messages, store MSH segments in 778
I HLMSTATE("BATCH") D
.N IEN S IEN=HLMSTATE("IEN")
.;
.;incoming messages cache the MSH segments in memory
.I HLMSTATE("DIRECTION")="IN",HLMSTATE("UNSTORED MSH") D
..N ORDER S ORDER=0
..F S ORDER=$O(HLMSTATE("UNSTORED MSH",ORDER)) Q:'ORDER D
...N FS,MSGID
...S FS=$E(HLMSTATE("UNSTORED MSH",ORDER,1),4)
...S MSGID=$P(HLMSTATE("UNSTORED MSH",ORDER,2),FS,5)
...S ^HLB(IEN,3,ORDER,0)=ORDER_"^"_MSGID_"^"_$G(HLMSTATE("BATCH","ACK TO",ORDER))
...S ^HLB(IEN,3,ORDER,1)=HLMSTATE("UNSTORED MSH",ORDER,1)
...S ^HLB(IEN,3,ORDER,2)=HLMSTATE("UNSTORED MSH",ORDER,2)
...S ^HLB(IEN,3,"B",ORDER,ORDER)=""
...I MSGID]"" S ^HLB("AE",MSGID,IEN_"^"_ORDER)="" ;whole file index for individual message id
..K HLMSTATE("UNSTORED MSH") S HLMSTATE("UNSTORED MSH")=0
.;
.;
.I HLMSTATE("DIRECTION")="OUT" D
..;must build the MSH segments!
..N HDR,FS,MSG,CS
..S FS=HLMSTATE("HDR","FIELD SEPARATOR")
..S CS=$E(HLMSTATE("HDR","ENCODING CHARACTERS"),1)
..S HLMSTATE("HDR","MESSAGE TYPE")=" "
..S HLMSTATE("HDR","EVENT")=" "
..D BUILDHDR^HLOPBLD1(.HLMSTATE,"MSH",.HDR)
..S HLMSTATE("BATCH","CURRENT MESSAGE")=$O(^HLB(HLMSTATE("IEN"),3,"B",";"),-1)
..F Q:'$$NEXTMSG(.HLMSTATE,.MSG) D
...N MSGID,CUR
...S CUR=HLMSTATE("BATCH","CURRENT MESSAGE")
...S MSGID=HLMSTATE("HDR","BATCH CONTROL ID")_"-"_CUR
...S $P(HDR(2),FS,4)=MSG("MESSAGE TYPE")_CS_MSG("EVENT")
...S $P(HDR(2),FS,5)=MSGID
...S ^HLB(IEN,3,CUR,0)=CUR_"^"_MSGID_"^"_$G(HLMSTATE("BATCH","ACK TO",CUR))
...S ^HLB(IEN,3,CUR,1)=HDR(1)
...S ^HLB(IEN,3,CUR,2)=HDR(2)
...S ^HLB(IEN,3,"B",CUR,CUR)=""
...S ^HLB("AE",MSGID,IEN_"^"_CUR)="" ;whole file index for individual message id
..;
.;if the messages are application acks, then update the original message
.N SUBIEN S SUBIEN=0
.F S SUBIEN=$O(HLMSTATE("BATCH","ACK TO",SUBIEN)) Q:'SUBIEN I $G(HLMSTATE("BATCH","ACK TO",SUBIEN,"IEN"))]"" D
..N ACKTO
..M ACKTO=HLMSTATE("BATCH","ACK TO",SUBIEN)
..;
..;for outgoing msgs, we just created the msgid, for incoming msgs we already had it
..S:HLMSTATE("DIRECTION")="OUT" ACKTO("ACK BY")=HLMSTATE("HDR","BATCH CONTROL ID")_"-"_SUBIEN
..;
..D ACKTO(.HLMSTATE,.ACKTO)
.K HLMSTATE("BATCH","ACK TO")
;
;if the msg is an app ack, update the original if not done already
I $G(HLMSTATE("ACK TO IEN"))]"",'$G(HLMSTATE("ACK TO","DONE")) D
.N ACKTO
.M ACKTO=HLMSTATE("ACK TO")
.S ACKTO("IEN")=HLMSTATE("ACK TO IEN")
.S ACKTO("ACK BY")=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
.D ACKTO(.HLMSTATE,.ACKTO)
.S HLMSTATE("ACK TO","DONE")=1 ;so the update isn't done again
Q HLMSTATE("IEN")
;
NEXTMSG(HLMSTATE,MSG) ;
;Traverses file 777 to return the next message in the batch - as
;indicated by HLMSTATE("BATCH","CURRENT MESSAGE") Set to 0 to start,
;returns 0 when there are no more messages
;
;Input: HLMSTATE (pass by reference,required)
;Output:
; HLMSTATE
; ("BATCH","CURRENT MESSAGE")
; MSG -pass by reference:
; ("EVENT")
; ("MESSAGE TYPE")
;
;
N SUBIEN,NODE
K MSG
Q:'$G(HLMSTATE("BODY")) 0
S SUBIEN=$O(^HLA(HLMSTATE("BODY"),2,HLMSTATE("BATCH","CURRENT MESSAGE")))
Q:'SUBIEN 0
S NODE=$G(^HLA(HLMSTATE("BODY"),2,SUBIEN,0))
S MSG("MESSAGE TYPE")=$P(NODE,"^",2)
S MSG("EVENT")=$P(NODE,"^",3)
S HLMSTATE("BATCH","CURRENT MESSAGE")=SUBIEN
Q SUBIEN
;
ACKTO(HLMSTATE,ACKTO) ;if this is an application ack, update the original message - but do not overlay if already valued
;ACKTO = (msgid of msg being ack'd)
; uses these subscripts ("IEN")=ien^subien,("ACK BY")=msgid of acking msg,("STATUS")=status for the initial msg determined by the ack)
;
N STATUS,IEN,SUBIEN,NODE,SKIP
S SKIP=0
S STATUS=$G(ACKTO("STATUS"))
S IEN=+ACKTO("IEN"),SUBIEN=$P(ACKTO("IEN"),"^",2)
S NODE=$G(^HLB(IEN,0))
I 'SUBIEN D
.;ack is to a message NOT in a batch
.I $P(NODE,"^",7)'="",$P(NODE,"^",7)'=ACKTO("ACK BY") S SKIP=1 Q
.I STATUS="" S STATUS="SU"
.S $P(^HLB(IEN,0),"^",7)=ACKTO("ACK BY")
.S $P(^HLB(IEN,0),"^",18)=1
.S $P(^HLB(IEN,0),"^",20)=STATUS
.S $P(^HLB(IEN,0),"^",21)=$G(ACKTO("ERROR TEXT"))
E D
.;ack is to a message that IS in a batch
.S $P(^HLB(IEN,3,SUBIEN,0),"^",4)=$G(ACKTO("ACK BY"))
.S $P(^HLB(IEN,3,SUBIEN,0),"^",5)=STATUS
I (STATUS="ER"),'SKIP D
.N APP
.S APP=HLMSTATE("HDR","RECEIVING APPLICATION")
.I APP="" S APP="UNKNOWN"
.S ^HLB("ERRORS",APP,$$NOW^XLFDT,ACKTO("IEN"))=""
.;don't count the error - the app ack was already counted as an error.
.D COUNT^HLOESTAT("IN",$G(HLMSTATE("HDR","RECEIVING APPLICATION")),$G(HLMSTATE("HDR","SENDING APPLICATION")),$S(HLMSTATE("BATCH"):"BATCH",1:$G(HLMSTATE("HDR","MESSAGE TYPE"))),$G(HLMSTATE("HDR","EVENT")))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOF778 6578 printed Nov 22, 2024@17:08:50 Page 2
HLOF778 ;ALB/CJM-HL7 - Saving messages to file 778 ;03/07/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,134,137,138,158**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
SAVEMSG(HLMSTATE) ;
+1 ;If a record has not yet been created in file 778, then it will be created. Will file any segments into 777 not yet stored. For batch messages, will store the MSH segments in 778 as the individual messages are stored in 777.
+2 ;Input:
+3 ; HLMSTATE (pass by reference) - contains information about the message
+4 ; These subscripts must be defined:
+5 ; ("BATCH")=1 if batch, 0 otherwise
+6 ; ("BATCH","BTS")=BTS segment if end of batch reached
+7 ; ("BODY")=ien file 777 if stored
+8 ; ("DIRECTION")=<"IN" or "OUT">
+9 ; ("IEN")=ien,file 778 if stored
+10 ; ("UNSTORED LINES") - count of lines to be stored. The lines are at the a lower subscript level <msg>,<segment>,<line>=<line to be stored>
+11 ; ("UNSTORED MSH") For batch messages, set to 1 if there are MSH in cache. Cached MSH at ("UNSTORED MSH",<subfile ien>,<1 & 2>)
+12 ;
+13 ;Output:
+14 ; Function - returns the ien of the msg (file 778)
+15 ; HLMSTATE
+16 ; ("BODY") - set to ien, file 777 if newly created
+17 ; ("IEN") - set to ien, file 778 if newly created
+18 ; ("UNSTORED LINES")-set to 0 as this function will store them
+19 ; ("UNSTORED MSH")- set to 0 as this function will store it
+20 ;
+21 ;
+22 IF '$DATA(HLMSTATE("DT/TM"))
SET HLMSTATE("DT/TM")=$SELECT(HLMSTATE("DIRECTION")="IN":$$NOW^XLFDT,1:"")
+23 ;
+24 ;insure that 777 entry created & all segments stored
+25 IF ('HLMSTATE("BODY"))!($GET(HLMSTATE("UNSTORED LINES")))!($LENGTH($GET(HLMSTATE("BATCH","BTS"))))
IF '$$SAVEMSG^HLOF777(.HLMSTATE)
QUIT 0
+26 ;
+27 ;insure 778 entry created
+28 IF 'HLMSTATE("IEN")
if '$$NEW^HLOF778A(.HLMSTATE)
QUIT 0
+29 ;
+30 ;for batch messages, store MSH segments in 778
+31 IF HLMSTATE("BATCH")
Begin DoDot:1
+32 NEW IEN
SET IEN=HLMSTATE("IEN")
+33 ;
+34 ;incoming messages cache the MSH segments in memory
+35 IF HLMSTATE("DIRECTION")="IN"
IF HLMSTATE("UNSTORED MSH")
Begin DoDot:2
+36 NEW ORDER
SET ORDER=0
+37 FOR
SET ORDER=$ORDER(HLMSTATE("UNSTORED MSH",ORDER))
if 'ORDER
QUIT
Begin DoDot:3
+38 NEW FS,MSGID
+39 SET FS=$EXTRACT(HLMSTATE("UNSTORED MSH",ORDER,1),4)
+40 SET MSGID=$PIECE(HLMSTATE("UNSTORED MSH",ORDER,2),FS,5)
+41 SET ^HLB(IEN,3,ORDER,0)=ORDER_"^"_MSGID_"^"_$GET(HLMSTATE("BATCH","ACK TO",ORDER))
+42 SET ^HLB(IEN,3,ORDER,1)=HLMSTATE("UNSTORED MSH",ORDER,1)
+43 SET ^HLB(IEN,3,ORDER,2)=HLMSTATE("UNSTORED MSH",ORDER,2)
+44 SET ^HLB(IEN,3,"B",ORDER,ORDER)=""
+45 ;whole file index for individual message id
IF MSGID]""
SET ^HLB("AE",MSGID,IEN_"^"_ORDER)=""
End DoDot:3
+46 KILL HLMSTATE("UNSTORED MSH")
SET HLMSTATE("UNSTORED MSH")=0
End DoDot:2
+47 ;
+48 ;
+49 IF HLMSTATE("DIRECTION")="OUT"
Begin DoDot:2
+50 ;must build the MSH segments!
+51 NEW HDR,FS,MSG,CS
+52 SET FS=HLMSTATE("HDR","FIELD SEPARATOR")
+53 SET CS=$EXTRACT(HLMSTATE("HDR","ENCODING CHARACTERS"),1)
+54 SET HLMSTATE("HDR","MESSAGE TYPE")=" "
+55 SET HLMSTATE("HDR","EVENT")=" "
+56 DO BUILDHDR^HLOPBLD1(.HLMSTATE,"MSH",.HDR)
+57 SET HLMSTATE("BATCH","CURRENT MESSAGE")=$ORDER(^HLB(HLMSTATE("IEN"),3,"B",";"),-1)
+58 FOR
if '$$NEXTMSG(.HLMSTATE,.MSG)
QUIT
Begin DoDot:3
+59 NEW MSGID,CUR
+60 SET CUR=HLMSTATE("BATCH","CURRENT MESSAGE")
+61 SET MSGID=HLMSTATE("HDR","BATCH CONTROL ID")_"-"_CUR
+62 SET $PIECE(HDR(2),FS,4)=MSG("MESSAGE TYPE")_CS_MSG("EVENT")
+63 SET $PIECE(HDR(2),FS,5)=MSGID
+64 SET ^HLB(IEN,3,CUR,0)=CUR_"^"_MSGID_"^"_$GET(HLMSTATE("BATCH","ACK TO",CUR))
+65 SET ^HLB(IEN,3,CUR,1)=HDR(1)
+66 SET ^HLB(IEN,3,CUR,2)=HDR(2)
+67 SET ^HLB(IEN,3,"B",CUR,CUR)=""
+68 ;whole file index for individual message id
SET ^HLB("AE",MSGID,IEN_"^"_CUR)=""
End DoDot:3
+69 ;
End DoDot:2
+70 ;if the messages are application acks, then update the original message
+71 NEW SUBIEN
SET SUBIEN=0
+72 FOR
SET SUBIEN=$ORDER(HLMSTATE("BATCH","ACK TO",SUBIEN))
if 'SUBIEN
QUIT
IF $GET(HLMSTATE("BATCH","ACK TO",SUBIEN,"IEN"))]""
Begin DoDot:2
+73 NEW ACKTO
+74 MERGE ACKTO=HLMSTATE("BATCH","ACK TO",SUBIEN)
+75 ;
+76 ;for outgoing msgs, we just created the msgid, for incoming msgs we already had it
+77 if HLMSTATE("DIRECTION")="OUT"
SET ACKTO("ACK BY")=HLMSTATE("HDR","BATCH CONTROL ID")_"-"_SUBIEN
+78 ;
+79 DO ACKTO(.HLMSTATE,.ACKTO)
End DoDot:2
+80 KILL HLMSTATE("BATCH","ACK TO")
End DoDot:1
+81 ;
+82 ;if the msg is an app ack, update the original if not done already
+83 IF $GET(HLMSTATE("ACK TO IEN"))]""
IF '$GET(HLMSTATE("ACK TO","DONE"))
Begin DoDot:1
+84 NEW ACKTO
+85 MERGE ACKTO=HLMSTATE("ACK TO")
+86 SET ACKTO("IEN")=HLMSTATE("ACK TO IEN")
+87 SET ACKTO("ACK BY")=$SELECT(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
+88 DO ACKTO(.HLMSTATE,.ACKTO)
+89 ;so the update isn't done again
SET HLMSTATE("ACK TO","DONE")=1
End DoDot:1
+90 QUIT HLMSTATE("IEN")
+91 ;
NEXTMSG(HLMSTATE,MSG) ;
+1 ;Traverses file 777 to return the next message in the batch - as
+2 ;indicated by HLMSTATE("BATCH","CURRENT MESSAGE") Set to 0 to start,
+3 ;returns 0 when there are no more messages
+4 ;
+5 ;Input: HLMSTATE (pass by reference,required)
+6 ;Output:
+7 ; HLMSTATE
+8 ; ("BATCH","CURRENT MESSAGE")
+9 ; MSG -pass by reference:
+10 ; ("EVENT")
+11 ; ("MESSAGE TYPE")
+12 ;
+13 ;
+14 NEW SUBIEN,NODE
+15 KILL MSG
+16 if '$GET(HLMSTATE("BODY"))
QUIT 0
+17 SET SUBIEN=$ORDER(^HLA(HLMSTATE("BODY"),2,HLMSTATE("BATCH","CURRENT MESSAGE")))
+18 if 'SUBIEN
QUIT 0
+19 SET NODE=$GET(^HLA(HLMSTATE("BODY"),2,SUBIEN,0))
+20 SET MSG("MESSAGE TYPE")=$PIECE(NODE,"^",2)
+21 SET MSG("EVENT")=$PIECE(NODE,"^",3)
+22 SET HLMSTATE("BATCH","CURRENT MESSAGE")=SUBIEN
+23 QUIT SUBIEN
+24 ;
ACKTO(HLMSTATE,ACKTO) ;if this is an application ack, update the original message - but do not overlay if already valued
+1 ;ACKTO = (msgid of msg being ack'd)
+2 ; uses these subscripts ("IEN")=ien^subien,("ACK BY")=msgid of acking msg,("STATUS")=status for the initial msg determined by the ack)
+3 ;
+4 NEW STATUS,IEN,SUBIEN,NODE,SKIP
+5 SET SKIP=0
+6 SET STATUS=$GET(ACKTO("STATUS"))
+7 SET IEN=+ACKTO("IEN")
SET SUBIEN=$PIECE(ACKTO("IEN"),"^",2)
+8 SET NODE=$GET(^HLB(IEN,0))
+9 IF 'SUBIEN
Begin DoDot:1
+10 ;ack is to a message NOT in a batch
+11 IF $PIECE(NODE,"^",7)'=""
IF $PIECE(NODE,"^",7)'=ACKTO("ACK BY")
SET SKIP=1
QUIT
+12 IF STATUS=""
SET STATUS="SU"
+13 SET $PIECE(^HLB(IEN,0),"^",7)=ACKTO("ACK BY")
+14 SET $PIECE(^HLB(IEN,0),"^",18)=1
+15 SET $PIECE(^HLB(IEN,0),"^",20)=STATUS
+16 SET $PIECE(^HLB(IEN,0),"^",21)=$GET(ACKTO("ERROR TEXT"))
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 ;ack is to a message that IS in a batch
+19 SET $PIECE(^HLB(IEN,3,SUBIEN,0),"^",4)=$GET(ACKTO("ACK BY"))
+20 SET $PIECE(^HLB(IEN,3,SUBIEN,0),"^",5)=STATUS
End DoDot:1
+21 IF (STATUS="ER")
IF 'SKIP
Begin DoDot:1
+22 NEW APP
+23 SET APP=HLMSTATE("HDR","RECEIVING APPLICATION")
+24 IF APP=""
SET APP="UNKNOWN"
+25 SET ^HLB("ERRORS",APP,$$NOW^XLFDT,ACKTO("IEN"))=""
+26 ;don't count the error - the app ack was already counted as an error.
+27 DO COUNT^HLOESTAT("IN",$GET(HLMSTATE("HDR","RECEIVING APPLICATION")),$GET(HLMSTATE("HDR","SENDING APPLICATION")),$SELECT(HLMSTATE("BATCH"):"BATCH",1:$GET(HLMSTATE("HDR","MESSAGE TYPE"))),$GET(HLMSTATE("HDR","EVENT")))
End DoDot:1
+28 QUIT
