HLTP1 ;AISC/SAW-Transaction Processor Module (Cont'd) ;09/13/2006
;;1.6;HEALTH LEVEL SEVEN;**34,47,91,133**;Oct 13, 1995;Build 13
;Per VHA Directive 2004-038, this routine should not be modified.
GENACK(HLMIDA,HLMTIENA,HLEIDS,HLARYTYP,HLFORMAT,HLRESLTA,HLP) ;
;Entry point to generate an acknowledgement message
;
;This is a subroutine call with parameter passing. It returns a value
;in the variable HLRESLTA of null if no error occurs, or the following
;two piece value if an error occurs: error code^error description
;
;Required Input Parameters
; HLMIDA = Message ID of aknowledgement message
; HLMTIENA = IEN of entry in Message Text file where acknowledgement
; message will be stored
; HLEIDS = IEN of subscriber protocol from 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 variable HLRESLTA must be passed by reference
; HLRESLTA = The variable that will be returned to the calling
; application as descibed above
;Optional Parameters
; HLP("SECURITY") = A 1 to 40 character string
; HLP("GROUTINE") = The M code to execute to generate the
; acknowledgement message
; HLP("MSACK") = 1 if this acknowledgment message is being
; generated by the Messaging System
; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
;
S HLRESLTA=""
;
;Check for required parameters
I '$G(HLMIDA)!('$G(HLMTIENA))!('$G(HLEIDS))!($G(HLARYTYP)']"")!($G(HLFORMAT)']"") S HLRESLTA="7^"_$G(^HL(771.7,7,0))_" at GENACK^HLTP1 entry point" G EXIT
;Extract data from file 101 and store in separate variables
D EVENT^HLUTIL1(HLEIDS,770,.HLN)
S HLSAN=$P($G(^HL(771,+$P(HLN(770),"^",2),0)),"^"),HLQ=""""""
S HLP("MSGTYPE")=$E(HLARYTYP,2)
;Update zero node of Message Text file
D UPDATE^HLTF0(HLMTIENA,HLP("MTIENS"),"O",HLEIDS,"",$P(HLN(770),"^",2),"",$P($G(^HL(772,HLP("MTIENS"),0)),"^",8),"",.HLP)
;Update status to Being Generated
D STATUS^HLTF0(HLMTIENA,8)
;Check that local/global array exists and store in Message Text file
; if pre-compiled
I HLFORMAT D I (+$G(HLRESLTA)) D STATUS^HLTF0(HLMTIENA,4,+HLRESLTA) G EXIT
.I $E(HLARYTYP)="G" D
..I $O(^TMP("HLA",$J,0))']"" S HLRESLTA="8^"_$G(^HL(771.7,8,0)) Q
..D MERGE^HLTF1("G",HLMTIENA,"HLA")
.I $E(HLARYTYP)="L" D
..I $O(HLA("HLA",0))']"" S HLRESLTA="8^"_$G(^HL(771.7,8,0)) Q
..D MERGE^HLTF1("L",HLMTIENA,"HLA")
;If array is not pre-compiled, call message generation routine
I 'HLFORMAT N HLERR D I $D(HLERR) S HLRESLTA="9^"_HLERR D STATUS^HLTF0(HLMTIENA,4,9,HLERR) G EXIT
.S HLP("GROUTINE")=HLP("GROUTINE")_"("_HLMIDA_","_HLMTIENA_","_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")
;Invoke communication server module to send message to subscribers
K HLARYTYP,HLFORMAT,HLQ
D SENDACK^HLCS(HLMTIENA,HLP("EID"),HLEIDS,.HLRESLTA) ;,$G(HLP("MSACK")))
EXIT K HLQ,HLSAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTP1 3452 printed Oct 16, 2024@18:00:46 Page 2
HLTP1 ;AISC/SAW-Transaction Processor Module (Cont'd) ;09/13/2006
+1 ;;1.6;HEALTH LEVEL SEVEN;**34,47,91,133**;Oct 13, 1995;Build 13
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
GENACK(HLMIDA,HLMTIENA,HLEIDS,HLARYTYP,HLFORMAT,HLRESLTA,HLP) ;
+1 ;Entry point to generate an acknowledgement message
+2 ;
+3 ;This is a subroutine call with parameter passing. It returns a value
+4 ;in the variable HLRESLTA 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 ; HLMIDA = Message ID of aknowledgement message
+9 ; HLMTIENA = IEN of entry in Message Text file where acknowledgement
+10 ; message will be stored
+11 ; HLEIDS = IEN of subscriber protocol from 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 variable HLRESLTA must be passed by reference
+20 ; HLRESLTA = 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("GROUTINE") = The M code to execute to generate the
+25 ; acknowledgement message
+26 ; HLP("MSACK") = 1 if this acknowledgment message is being
+27 ; generated by the Messaging System
+28 ; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
+29 ;
+30 SET HLRESLTA=""
+31 ;
+32 ;Check for required parameters
+33 IF '$GET(HLMIDA)!('$GET(HLMTIENA))!('$GET(HLEIDS))!($GET(HLARYTYP)']"")!($GET(HLFORMAT)']"")
SET HLRESLTA="7^"_$GET(^HL(771.7,7,0))_" at GENACK^HLTP1 entry point"
GOTO EXIT
+34 ;Extract data from file 101 and store in separate variables
+35 DO EVENT^HLUTIL1(HLEIDS,770,.HLN)
+36 SET HLSAN=$PIECE($GET(^HL(771,+$PIECE(HLN(770),"^",2),0)),"^")
SET HLQ=""""""
+37 SET HLP("MSGTYPE")=$EXTRACT(HLARYTYP,2)
+38 ;Update zero node of Message Text file
+39 DO UPDATE^HLTF0(HLMTIENA,HLP("MTIENS"),"O",HLEIDS,"",$PIECE(HLN(770),"^",2),"",$PIECE($GET(^HL(772,HLP("MTIENS"),0)),"^",8),"",.HLP)
+40 ;Update status to Being Generated
+41 DO STATUS^HLTF0(HLMTIENA,8)
+42 ;Check that local/global array exists and store in Message Text file
+43 ; if pre-compiled
+44 IF HLFORMAT
Begin DoDot:1
+45 IF $EXTRACT(HLARYTYP)="G"
Begin DoDot:2
+46 IF $ORDER(^TMP("HLA",$JOB,0))']""
SET HLRESLTA="8^"_$GET(^HL(771.7,8,0))
QUIT
+47 DO MERGE^HLTF1("G",HLMTIENA,"HLA")
End DoDot:2
+48 IF $EXTRACT(HLARYTYP)="L"
Begin DoDot:2
+49 IF $ORDER(HLA("HLA",0))']""
SET HLRESLTA="8^"_$GET(^HL(771.7,8,0))
QUIT
+50 DO MERGE^HLTF1("L",HLMTIENA,"HLA")
End DoDot:2
End DoDot:1
IF (+$GET(HLRESLTA))
DO STATUS^HLTF0(HLMTIENA,4,+HLRESLTA)
GOTO EXIT
+51 ;If array is not pre-compiled, call message generation routine
+52 IF 'HLFORMAT
NEW HLERR
Begin DoDot:1
+53 SET HLP("GROUTINE")=HLP("GROUTINE")_"("_HLMIDA_","_HLMTIENA_","_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_")"
+54 XECUTE HLP("GROUTINE")
End DoDot:1
IF $DATA(HLERR)
SET HLRESLTA="9^"_HLERR
DO STATUS^HLTF0(HLMTIENA,4,9,HLERR)
GOTO EXIT
+55 ;Invoke communication server module to send message to subscribers
+56 KILL HLARYTYP,HLFORMAT,HLQ
+57 ;,$G(HLP("MSACK")))
DO SENDACK^HLCS(HLMTIENA,HLP("EID"),HLEIDS,.HLRESLTA)
EXIT KILL HLQ,HLSAN
+1 QUIT
