HLTP ;AISC/SAW-Transaction Processor Module ;09/13/2006
;;1.6;HEALTH LEVEL SEVEN;**14,43,133**;Oct 13, 1995;Build 13
;Per VHA Directive 2004-038, this routine should not be modified.
GENERATE(HLMID,HLMTIEN,HLEID,HLARYTYP,HLFORMAT,HLRESLT,HLP) ;Generate an
;outgoing message
;
;This is a subroutine call with parameter passing. It returns a value
;in the variable HLRESLT of null if no error occurs, or the following
;two piece value if an error occurs: error code^error description
;
;Required Input Parameters
; HLMID = Message ID of message being generated
; HLMTIEN = IEN in Message Text file where message being generated
; will be stored
; HLEID = IEN of event driver protocol in the Protocol file
; HLARYTYP = Array type. One of the following codes:
; LM = local array containing a single message
; LB = local array containig a batch of messages
; GM = global array containing a single message
; GB = global array containing a batch of messages
; HLFORMAT = Format of array, 1 for pre-formatted in HL7 format,
; otherwise 0
;NOTE: The parameter HLRESLT must be passed by reference
; HLRESLT = The variable that will be returned to the calling
; application as descibed above
;Optional Parameters
; HLP("SECURITY") = A 1 to 40 character string
; HLP("CONTPTR") = Continuation pointer, a 1 to 180 character string
; HLP("GROUTINE") = The M code to execute to generate the HL7 message
;
S HLRESLT=""
;
;Check for required parameters
I '$G(HLMID)!('$G(HLMTIEN))!('$G(HLEID))!($G(HLARYTYP)']"")!($G(HLFORMAT)']"") S HLRESLT="7^"_$G(^HL(771.7,7,0))_" at GENERATE^HLTP entry point" G EXIT
;Extract data from file 101 and store in separate variables
D EVENT^HLUTIL1(HLEID,770,.HLN) S HLSAN=$P($G(^HL(771,+$P(HLN(770),"^"),0)),"^"),HLQ=""""""
S HLP("MSGTYPE")=$E(HLARYTYP,2)
;Update zero node of Message Text file
D UPDATE^HLTF0(HLMTIEN,HLMTIEN,"O",HLEID,"",+$P(HLN(770),"^"),HLPRIO,"","",.HLP)
;Update status to Being Generated
D STATUS^HLTF0(HLMTIEN,8)
;Check that local/global array exists and store in Message Text file
; if pre-compiled
I HLFORMAT D I +$G(HLRESLT) G EXIT
.I $E(HLARYTYP)="G" D I +$G(HLRESLT) D STATUS^HLTF0(HLMTIEN,4,+HLRESLT) Q
..I $O(^TMP("HLS",$J,0))']"" S HLRESLT="8^"_$G(^HL(771.7,8,0)) Q
..D MERGE^HLTF1("G",HLMTIEN,"HLS")
.I $E(HLARYTYP)="L" D I +$G(HLRESLT) D STATUS^HLTF0(HLMTIEN,4,+HLRESLT) Q
..I $O(HLA("HLS",0))']"" S HLRESLT="8^"_$G(^HL(771.7,8,0)) Q
..D MERGE^HLTF1("L",HLMTIEN,"HLS")
;If array is not pre-compiled, call message generation routine
I 'HLFORMAT N HLERR D I $D(HLERR) S HLRESLT="9^"_HLERR D STATUS^HLTF0(HLMTIEN,4,9,HLERR) G EXIT
.S HLP("GROUTINE")=HLP("GROUTINE")_"("_HLMID_","_HLMTIEN_","_HLQ_HLARYTYP_HLQ_","_HLSAN_","_$P($G(^HL(771.2,$P(HLN(770),"^",3),0)),"^")_","_$P($G(^HL(779.001,$P(HLN(770),"^",4),0)),"^")_","_HLQ_$TR($P(HLN(770),"^",6),"id","ID")_HLQ_")"
.X HLP("GROUTINE")
;**CIRN**
S ZMID=HLMID ; Save original parent message IEN
I $D(HLL("LINKS")),HLPRIO'="I" D FWD^HLCS2 K HLL
;Invoke communication server module to
;send message to subscribers
;K HLARYTYP,HLFORMAT,HLN,HLP,HLQ
D SEND^HLCS(HLMTIEN,HLEID,.HLRESLT)
EXIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTP 3328 printed Dec 13, 2024@01:59:56 Page 2
HLTP ;AISC/SAW-Transaction Processor Module ;09/13/2006
+1 ;;1.6;HEALTH LEVEL SEVEN;**14,43,133**;Oct 13, 1995;Build 13
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
GENERATE(HLMID,HLMTIEN,HLEID,HLARYTYP,HLFORMAT,HLRESLT,HLP) ;Generate an
+1 ;outgoing message
+2 ;
+3 ;This is a subroutine call with parameter passing. It returns a value
+4 ;in the variable HLRESLT of null if no error occurs, or the following
+5 ;two piece value if an error occurs: error code^error description
+6 ;
+7 ;Required Input Parameters
+8 ; HLMID = Message ID of message being generated
+9 ; HLMTIEN = IEN in Message Text file where message being generated
+10 ; will be stored
+11 ; HLEID = IEN of event driver protocol in the Protocol file
+12 ; HLARYTYP = Array type. One of the following codes:
+13 ; LM = local array containing a single message
+14 ; LB = local array containig a batch of messages
+15 ; GM = global array containing a single message
+16 ; GB = global array containing a batch of messages
+17 ; HLFORMAT = Format of array, 1 for pre-formatted in HL7 format,
+18 ; otherwise 0
+19 ;NOTE: The parameter HLRESLT must be passed by reference
+20 ; HLRESLT = The variable that will be returned to the calling
+21 ; application as descibed above
+22 ;Optional Parameters
+23 ; HLP("SECURITY") = A 1 to 40 character string
+24 ; HLP("CONTPTR") = Continuation pointer, a 1 to 180 character string
+25 ; HLP("GROUTINE") = The M code to execute to generate the HL7 message
+26 ;
+27 SET HLRESLT=""
+28 ;
+29 ;Check for required parameters
+30 IF '$GET(HLMID)!('$GET(HLMTIEN))!('$GET(HLEID))!($GET(HLARYTYP)']"")!($GET(HLFORMAT)']"")
SET HLRESLT="7^"_$GET(^HL(771.7,7,0))_" at GENERATE^HLTP entry point"
GOTO EXIT
+31 ;Extract data from file 101 and store in separate variables
+32 DO EVENT^HLUTIL1(HLEID,770,.HLN)
SET HLSAN=$PIECE($GET(^HL(771,+$PIECE(HLN(770),"^"),0)),"^")
SET HLQ=""""""
+33 SET HLP("MSGTYPE")=$EXTRACT(HLARYTYP,2)
+34 ;Update zero node of Message Text file
+35 DO UPDATE^HLTF0(HLMTIEN,HLMTIEN,"O",HLEID,"",+$PIECE(HLN(770),"^"),HLPRIO,"","",.HLP)
+36 ;Update status to Being Generated
+37 DO STATUS^HLTF0(HLMTIEN,8)
+38 ;Check that local/global array exists and store in Message Text file
+39 ; if pre-compiled
+40 IF HLFORMAT
Begin DoDot:1
+41 IF $EXTRACT(HLARYTYP)="G"
Begin DoDot:2
+42 IF $ORDER(^TMP("HLS",$JOB,0))']""
SET HLRESLT="8^"_$GET(^HL(771.7,8,0))
QUIT
+43 DO MERGE^HLTF1("G",HLMTIEN,"HLS")
End DoDot:2
IF +$GET(HLRESLT)
DO STATUS^HLTF0(HLMTIEN,4,+HLRESLT)
QUIT
+44 IF $EXTRACT(HLARYTYP)="L"
Begin DoDot:2
+45 IF $ORDER(HLA("HLS",0))']""
SET HLRESLT="8^"_$GET(^HL(771.7,8,0))
QUIT
+46 DO MERGE^HLTF1("L",HLMTIEN,"HLS")
End DoDot:2
IF +$GET(HLRESLT)
DO STATUS^HLTF0(HLMTIEN,4,+HLRESLT)
QUIT
End DoDot:1
IF +$GET(HLRESLT)
GOTO EXIT
+47 ;If array is not pre-compiled, call message generation routine
+48 IF 'HLFORMAT
NEW HLERR
Begin DoDot:1
+49 SET HLP("GROUTINE")=HLP("GROUTINE")_"("_HLMID_","_HLMTIEN_","_HLQ_HLARYTYP_HLQ_","_HLSAN_","_$PIECE($GET(^HL(771.2,$PIECE(HLN(770),"^",3),0)),"^")_","_$PIECE(...
... $GET(^HL(779.001,$PIECE(HLN(770),"^",4),0)),"^")_","_HLQ_$TRANSLATE($PIECE(HLN(770),"^",6),"id","ID")_HLQ_")"
+50 XECUTE HLP("GROUTINE")
End DoDot:1
IF $DATA(HLERR)
SET HLRESLT="9^"_HLERR
DO STATUS^HLTF0(HLMTIEN,4,9,HLERR)
GOTO EXIT
+51 ;**CIRN**
+52 ; Save original parent message IEN
SET ZMID=HLMID
+53 IF $DATA(HLL("LINKS"))
IF HLPRIO'="I"
DO FWD^HLCS2
KILL HLL
+54 ;Invoke communication server module to
+55 ;send message to subscribers
+56 ;K HLARYTYP,HLFORMAT,HLN,HLP,HLQ
+57 DO SEND^HLCS(HLMTIEN,HLEID,.HLRESLT)
EXIT QUIT
