HLMA1 ;AISC/SAW-Message Administration Module (Cont'd) ;09/13/2006
;;1.6;HEALTH LEVEL SEVEN;**19,43,91,109,108,133**;Oct 13, 1995;Build 13
;Per VHA Directive 2004-038, this routine should not be modified.
GENACK(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,HLRESLTA,HLMTIENA,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
; HLEID = IEN of event driver protocol from the Protocol file
; HLMTIENS = IEN of entry in Message Text file for subscriber
; application
; HLEIDS = IEN of subscriber event 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 parameter HLRESLTA must be passed by reference
; HLRESLTA = The variable that will be returned to the calling
; application as descibed above
;Optional Parameters
; HLMTIENA = IEN of entry in Message Text file where the
; acknowledgement message will be stored. This
; parameter is only passed for a batch acknowledgment
; HLP("SECURITY") = A 1 to 40 character string
; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
;
;
;HLRESLTA is to return the results and should not be initially defined
N HLRESLT
S HLRESLT=""
K HLRESLTA
;
;Check for required parameters
I $G(HLEIDS)']""!('$G(HLMTIENS))!($G(HLARYTYP)']"")!($G(HLFORMAT)']"") S HLRESLTA="0^7^"_$G(^HL(771.7,7,0))_" at GENACK^HLMA1 entry point" G EXIT
I 'HLEIDS S HLEIDS=$O(^ORD(101,"B",HLEIDS,0)) I 'HLEIDS S HLRESLTA="0^1^"_$G(^HL(771.7,1,0)) G EXIT
;Extract data from Protocol file
D EVENT^HLUTIL1(HLEIDS,"15,20,772",.HLN)
N HLEXROU,HLMIDAR
S HLMIDAR=0,HLENROU=$G(HLN(20)),HLEXROU=$G(HLN(15))
S HLP("GROUTINE")=$G(HLN(772)) K HLN I HLP("GROUTINE")']"",'HLFORMAT S HLRESLTA="0^3^"_$G(^HL(771.7,3,0)) G EXIT
I "GL"'[$E($G(HLARYTYP)) S HLRESLTA="0^4^"_$G(^HL(771.7,4,0)) G EXIT
I '$D(HLP("SECURITY")) S HLP("SECURITY")=""
I $L(HLP("SECURITY"))>40 S HLRESLTA="0^6^"_$G(^HL(771.7,6,0)) G EXIT
;$D(HLTCP) tcp connection will be used
I $D(HLTCP) D GENACK^HLTP4 G EXIT
;Create message ID and Message Text IEN if Message Text IEN not
;previously created ('$G(HLMTIENA))
I '$G(HLMTIENA) D CREATE^HLTF(.HLMIDA,.HLMTIENA,.HLDTA,.HLDT1A)
;Get message ID if Message Text IEN not already created
I '$G(HLMIDA) D
.S HLDTA=$G(^HL(772,HLMTIENA,0))
.S HLDT1A=$$HLDATE^HLFNC(+HLDTA),HLMIDA=$P(HLDTA,"^",6),HLDTA=+HLDTA
S HLRESLTA=HLMIDA,HLP("DTM")=HLDT1A,HLP("DT")=HLDTA,HLP("MTIENS")=HLMTIENS,HLP("EID")=HLEID
;Execute entry action for subscriber protocol
I HLENROU]"" X HLENROU
;Invoke transaction processor to generate acknowledgement
K HLDTA,HLDT1A,HLEID,HLENROU,HLMTIENS
S HLRESLT=""
D GENACK^HLTP1(HLMIDA,HLMTIENA,HLEIDS,HLARYTYP,HLFORMAT,.HLRESLT,.HLP)
;HLMIDAR is array of message IDs, only set for broadcast messages
I HLMIDAR K HLMIDAR("N") M HLRESLTA=HLMIDAR
S HLRESLTA=HLRESLTA_"^"_HLRESLT
;Update status to Awaiting Acknowledgement or Error in Transmission
D STATUS^HLTF0(HLMTIENA,$S($P(HLRESLTA,"^",2):4,1:3),$S($P(HLRESLTA,"^",2):$P(HLRESLTA,"^",2),1:""),$S($P(HLRESLTA,"^",2):$P(HLRESLTA,"^",3),1:""))
;Execute exit action for subscriber protocol
X:HLEXROU]"" HLEXROU
EXIT K HLDTA,HLDT1A,HLMIDA,HLENROU,HLEXROU
Q
HLMA1 ;AISC/SAW-Message Administration Module (Cont'd) ;09/13/2006
+1 ;;1.6;HEALTH LEVEL SEVEN;**19,43,91,109,108,133**;Oct 13, 1995;Build 13
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
GENACK(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,HLRESLTA,HLMTIENA,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 ; HLEID = IEN of event driver protocol from the Protocol file
+9 ; HLMTIENS = IEN of entry in Message Text file for subscriber
+10 ; application
+11 ; HLEIDS = IEN of subscriber event 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 parameter 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 ; HLMTIENA = IEN of entry in Message Text file where the
+24 ; acknowledgement message will be stored. This
+25 ; parameter is only passed for a batch acknowledgment
+26 ; HLP("SECURITY") = A 1 to 40 character string
+27 ; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
+28 ;
+29 ;
+30 ;HLRESLTA is to return the results and should not be initially defined
+31 NEW HLRESLT
+32 SET HLRESLT=""
+33 KILL HLRESLTA
+34 ;
+35 ;Check for required parameters
+36 IF $GET(HLEIDS)']""!('$GET(HLMTIENS))!($GET(HLARYTYP)']"")!($GET(HLFORMAT)']"")
SET HLRESLTA="0^7^"_$GET(^HL(771.7,7,0))_" at GENACK^HLMA1 entry point"
GOTO EXIT
+37 IF 'HLEIDS
SET HLEIDS=$ORDER(^ORD(101,"B",HLEIDS,0))
IF 'HLEIDS
SET HLRESLTA="0^1^"_$GET(^HL(771.7,1,0))
GOTO EXIT
+38 ;Extract data from Protocol file
+39 DO EVENT^HLUTIL1(HLEIDS,"15,20,772",.HLN)
+40 NEW HLEXROU,HLMIDAR
+41 SET HLMIDAR=0
SET HLENROU=$GET(HLN(20))
SET HLEXROU=$GET(HLN(15))
+42 SET HLP("GROUTINE")=$GET(HLN(772))
KILL HLN
IF HLP("GROUTINE")']""
IF 'HLFORMAT
SET HLRESLTA="0^3^"_$GET(^HL(771.7,3,0))
GOTO EXIT
+43 IF "GL"'[$EXTRACT($GET(HLARYTYP))
SET HLRESLTA="0^4^"_$GET(^HL(771.7,4,0))
GOTO EXIT
+44 IF '$DATA(HLP("SECURITY"))
SET HLP("SECURITY")=""
+45 IF $LENGTH(HLP("SECURITY"))>40
SET HLRESLTA="0^6^"_$GET(^HL(771.7,6,0))
GOTO EXIT
+46 ;$D(HLTCP) tcp connection will be used
+47 IF $DATA(HLTCP)
DO GENACK^HLTP4
GOTO EXIT
+48 ;Create message ID and Message Text IEN if Message Text IEN not
+49 ;previously created ('$G(HLMTIENA))
+50 IF '$GET(HLMTIENA)
DO CREATE^HLTF(.HLMIDA,.HLMTIENA,.HLDTA,.HLDT1A)
+51 ;Get message ID if Message Text IEN not already created
+52 IF '$GET(HLMIDA)
Begin DoDot:1
+53 SET HLDTA=$GET(^HL(772,HLMTIENA,0))
+54 SET HLDT1A=$$HLDATE^HLFNC(+HLDTA)
SET HLMIDA=$PIECE(HLDTA,"^",6)
SET HLDTA=+HLDTA
End DoDot:1
+55 SET HLRESLTA=HLMIDA
SET HLP("DTM")=HLDT1A
SET HLP("DT")=HLDTA
SET HLP("MTIENS")=HLMTIENS
SET HLP("EID")=HLEID
+56 ;Execute entry action for subscriber protocol
+57 IF HLENROU]""
XECUTE HLENROU
+58 ;Invoke transaction processor to generate acknowledgement
+59 KILL HLDTA,HLDT1A,HLEID,HLENROU,HLMTIENS
+60 SET HLRESLT=""
+61 DO GENACK^HLTP1(HLMIDA,HLMTIENA,HLEIDS,HLARYTYP,HLFORMAT,.HLRESLT,.HLP)
+62 ;HLMIDAR is array of message IDs, only set for broadcast messages
+63 IF HLMIDAR
KILL HLMIDAR("N")
MERGE HLRESLTA=HLMIDAR
+64 SET HLRESLTA=HLRESLTA_"^"_HLRESLT
+65 ;Update status to Awaiting Acknowledgement or Error in Transmission
+66 DO STATUS^HLTF0(HLMTIENA,$SELECT($PIECE(HLRESLTA,"^",2):4,1:3),$SELECT($PIECE(HLRESLTA,"^",2):$PIECE(HLRESLTA,"^",2),1:""),$SELECT($PIECE(HLRESLTA,"^",2):$PIECE(HLRESLTA,"^",3),1:""))
+67 ;Execute exit action for subscriber protocol
+68 IF HLEXROU]""
XECUTE HLEXROU
EXIT KILL HLDTA,HLDT1A,HLMIDA,HLENROU,HLEXROU
+1 QUIT
