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  Sep 23, 2025@19:36:03                                                                                                                                                                                                        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