MHV7TB ;WAS/GPM - HL7 BOLUS TRANSMITTER ; [12/31/07 6:15pm]
;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
BOLUS(MSGROOT,XMT,HL) ; Build and Transmit large messages in Bolus mode
; Walks message in MSGROOT and transmits multiple response messages
; based on the desired message size in XMT("MAX SIZE").
; Always creates at least one message with at least one record.
; Messages may exceed the maximum size by the size of the last record
; added to the message.
;
; Algorithm:
; Copy original message to temporary storage
; Extract header segments common to all mesages (MSA,QPD,QRD,QAK,etc)
; Determine QAK segment postion if exists
; For each message in the bolus response
; merge in the common header segments
; add segments by walking the original message
; if reach end of orginal message or exceed maximum size
; if QAK exists update with hit counts
; transmit message
;
; Integration Agreements:
; 2164 : GENERATE^HLMA
;
; Input:
; MSGROOT - Global root of message array
; XMT - Transmission parameters
; XMT("PROTOCOL") - Protocol for deferred transmissions
; XMT("BUILDER") - Name/tag of message builder routine
; XMT("MAX SIZE") - Maximum message size
; XMT("BREAK SEGMENT") - Segment that marks new record
; HL - HL7 package array variable
;
; Output: HL7 Messages Transmitted
;
N ORGROOT,ORGCNT,MSGHEAD,HEADSIZE,HEADCNT,QAKPOS,QAKSEG,MSGSIZE,MSGCNT,MAXSIZE,HIT,HITTOT,HITREM,CNT,SEG,SEGTYPE,BREAKPT,FS,END,XMIT,HLRSLT,HLP
;
D LOG^MHVUL2("TRANSMIT "_$P(XMT("BUILDER"),"^")_" BOLUS","BEGIN","S","DEBUG")
;
S ORGROOT="^TMP(""MHV7 BOLUS ROOT"",$J)"
M @ORGROOT=@MSGROOT
K @MSGROOT
S BREAKPT=XMT("BREAK SEGMENT")
S MAXSIZE=XMT("MAX SIZE")
S QAKPOS=0,QAKSEG=""
S HEADCNT=0,HEADSIZE=0,ORGCNT=0
S FS=HL("FS") ;field separator
;
; Pull out header segments (MSA,QAK,QPD,QRD,etc)
;-----------------------------------------
F D Q:SEG=""!(SEGTYPE=BREAKPT)
. S ORGCNT=ORGCNT+1
. S SEG=$G(@ORGROOT@(ORGCNT))
. Q:SEG=""
. S SEGTYPE=$E(SEG,1,3)
. Q:SEGTYPE=BREAKPT
. S MSGHEAD(ORGCNT)=SEG
. S HEADSIZE=HEADSIZE+$L(SEG)
. S HEADCNT=HEADCNT+1
. I SEGTYPE="QAK" D
. . S QAKPOS=ORGCNT
. . S QAKSEG=SEG
. . S HITTOT=$P(QAKSEG,FS,5)
. . S HITREM=HITTOT
. . Q
. Q
;
; Create and send message bolus messages
;-----------------------------------------
S END=0
F MSGCNT=1:1 D Q:END
. ; Merge in header segments
. M @MSGROOT=MSGHEAD
. S MSGSIZE=HEADSIZE
. S CNT=HEADCNT
. S HIT=0,XMIT=0
. ; Merge segments into message
. F D Q:XMIT!END
. . K SEG S SEG=""
. . I '$D(@ORGROOT@(ORGCNT)) S END=1 Q
. . M SEG=@ORGROOT@(ORGCNT)
. . S SEGTYPE=$E(SEG,1,3)
. . S MSGSIZE=MSGSIZE+$$SIZE(SEG)
. . I SEGTYPE=BREAKPT,MSGSIZE>MAXSIZE,HIT>0 S XMIT=1 Q
. . I SEGTYPE=BREAKPT S HIT=HIT+1
. . S CNT=CNT+1
. . M @MSGROOT@(CNT)=SEG
. . S ORGCNT=ORGCNT+1
. . Q
. ; Update QAK
. I QAKPOS D ;Update QAK
. . S $P(QAKSEG,FS,6)=HIT ;Hits this payload
. . S HITREM=HITREM-HIT
. . S $P(QAKSEG,FS,7)=HITREM ;Hits remaining
. . S @MSGROOT@(QAKPOS)=QAKSEG
. . Q
. D LOG^MHVUL2("BOLUS MESSAGE:"_MSGCNT,HIT_" HITS","S","DEBUG")
. D LOG^MHVUL2("MESSAGE "_MSGCNT,MSGROOT,"I","DEBUG")
. ; Transmit message
. D GENERATE^HLMA(XMT("PROTOCOL"),"GM",1,.HLRSLT,"",.HLP)
. K @MSGROOT
. D LOG^MHVUL2("TRANSMIT MESSAGE:"_MSGCNT,.HLRSLT,"M","DEBUG")
. Q
;
K @ORGROOT
D LOG^MHVUL2("TRANSMIT "_$P(XMT("BUILDER"),"^")_" BOLUS","END","S","DEBUG")
Q
;
SIZE(SEG) ; Calculate the size of a segment
N LEN,I
S LEN=$L(SEG)
S I="" F S I=$O(SEG(I)) Q:I="" S LEN=LEN+$L(SEG(I))
Q LEN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7TB 3886 printed Apr 09, 2024@21:17:42 Page 2
MHV7TB ;WAS/GPM - HL7 BOLUS TRANSMITTER ; [12/31/07 6:15pm]
+1 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
BOLUS(MSGROOT,XMT,HL) ; Build and Transmit large messages in Bolus mode
+1 ; Walks message in MSGROOT and transmits multiple response messages
+2 ; based on the desired message size in XMT("MAX SIZE").
+3 ; Always creates at least one message with at least one record.
+4 ; Messages may exceed the maximum size by the size of the last record
+5 ; added to the message.
+6 ;
+7 ; Algorithm:
+8 ; Copy original message to temporary storage
+9 ; Extract header segments common to all mesages (MSA,QPD,QRD,QAK,etc)
+10 ; Determine QAK segment postion if exists
+11 ; For each message in the bolus response
+12 ; merge in the common header segments
+13 ; add segments by walking the original message
+14 ; if reach end of orginal message or exceed maximum size
+15 ; if QAK exists update with hit counts
+16 ; transmit message
+17 ;
+18 ; Integration Agreements:
+19 ; 2164 : GENERATE^HLMA
+20 ;
+21 ; Input:
+22 ; MSGROOT - Global root of message array
+23 ; XMT - Transmission parameters
+24 ; XMT("PROTOCOL") - Protocol for deferred transmissions
+25 ; XMT("BUILDER") - Name/tag of message builder routine
+26 ; XMT("MAX SIZE") - Maximum message size
+27 ; XMT("BREAK SEGMENT") - Segment that marks new record
+28 ; HL - HL7 package array variable
+29 ;
+30 ; Output: HL7 Messages Transmitted
+31 ;
+32 NEW ORGROOT,ORGCNT,MSGHEAD,HEADSIZE,HEADCNT,QAKPOS,QAKSEG,MSGSIZE,MSGCNT,MAXSIZE,HIT,HITTOT,HITREM,CNT,SEG,SEGTYPE,BREAKPT,FS,END,XMIT,HLRSLT,HLP
+33 ;
+34 DO LOG^MHVUL2("TRANSMIT "_$PIECE(XMT("BUILDER"),"^")_" BOLUS","BEGIN","S","DEBUG")
+35 ;
+36 SET ORGROOT="^TMP(""MHV7 BOLUS ROOT"",$J)"
+37 MERGE @ORGROOT=@MSGROOT
+38 KILL @MSGROOT
+39 SET BREAKPT=XMT("BREAK SEGMENT")
+40 SET MAXSIZE=XMT("MAX SIZE")
+41 SET QAKPOS=0
SET QAKSEG=""
+42 SET HEADCNT=0
SET HEADSIZE=0
SET ORGCNT=0
+43 ;field separator
SET FS=HL("FS")
+44 ;
+45 ; Pull out header segments (MSA,QAK,QPD,QRD,etc)
+46 ;-----------------------------------------
+47 FOR
Begin DoDot:1
+48 SET ORGCNT=ORGCNT+1
+49 SET SEG=$GET(@ORGROOT@(ORGCNT))
+50 if SEG=""
QUIT
+51 SET SEGTYPE=$EXTRACT(SEG,1,3)
+52 if SEGTYPE=BREAKPT
QUIT
+53 SET MSGHEAD(ORGCNT)=SEG
+54 SET HEADSIZE=HEADSIZE+$LENGTH(SEG)
+55 SET HEADCNT=HEADCNT+1
+56 IF SEGTYPE="QAK"
Begin DoDot:2
+57 SET QAKPOS=ORGCNT
+58 SET QAKSEG=SEG
+59 SET HITTOT=$PIECE(QAKSEG,FS,5)
+60 SET HITREM=HITTOT
+61 QUIT
End DoDot:2
+62 QUIT
End DoDot:1
if SEG=""!(SEGTYPE=BREAKPT)
QUIT
+63 ;
+64 ; Create and send message bolus messages
+65 ;-----------------------------------------
+66 SET END=0
+67 FOR MSGCNT=1:1
Begin DoDot:1
+68 ; Merge in header segments
+69 MERGE @MSGROOT=MSGHEAD
+70 SET MSGSIZE=HEADSIZE
+71 SET CNT=HEADCNT
+72 SET HIT=0
SET XMIT=0
+73 ; Merge segments into message
+74 FOR
Begin DoDot:2
+75 KILL SEG
SET SEG=""
+76 IF '$DATA(@ORGROOT@(ORGCNT))
SET END=1
QUIT
+77 MERGE SEG=@ORGROOT@(ORGCNT)
+78 SET SEGTYPE=$EXTRACT(SEG,1,3)
+79 SET MSGSIZE=MSGSIZE+$$SIZE(SEG)
+80 IF SEGTYPE=BREAKPT
IF MSGSIZE>MAXSIZE
IF HIT>0
SET XMIT=1
QUIT
+81 IF SEGTYPE=BREAKPT
SET HIT=HIT+1
+82 SET CNT=CNT+1
+83 MERGE @MSGROOT@(CNT)=SEG
+84 SET ORGCNT=ORGCNT+1
+85 QUIT
End DoDot:2
if XMIT!END
QUIT
+86 ; Update QAK
+87 ;Update QAK
IF QAKPOS
Begin DoDot:2
+88 ;Hits this payload
SET $PIECE(QAKSEG,FS,6)=HIT
+89 SET HITREM=HITREM-HIT
+90 ;Hits remaining
SET $PIECE(QAKSEG,FS,7)=HITREM
+91 SET @MSGROOT@(QAKPOS)=QAKSEG
+92 QUIT
End DoDot:2
+93 DO LOG^MHVUL2("BOLUS MESSAGE:"_MSGCNT,HIT_" HITS","S","DEBUG")
+94 DO LOG^MHVUL2("MESSAGE "_MSGCNT,MSGROOT,"I","DEBUG")
+95 ; Transmit message
+96 DO GENERATE^HLMA(XMT("PROTOCOL"),"GM",1,.HLRSLT,"",.HLP)
+97 KILL @MSGROOT
+98 DO LOG^MHVUL2("TRANSMIT MESSAGE:"_MSGCNT,.HLRSLT,"M","DEBUG")
+99 QUIT
End DoDot:1
if END
QUIT
+100 ;
+101 KILL @ORGROOT
+102 DO LOG^MHVUL2("TRANSMIT "_$PIECE(XMT("BUILDER"),"^")_" BOLUS","END","S","DEBUG")
+103 QUIT
+104 ;
SIZE(SEG) ; Calculate the size of a segment
+1 NEW LEN,I
+2 SET LEN=$LENGTH(SEG)
+3 SET I=""
FOR
SET I=$ORDER(SEG(I))
if I=""
QUIT
SET LEN=LEN+$LENGTH(SEG(I))
+4 QUIT LEN
+5 ;
