- HLMA1 ;AISC/SAW-Message Administration Module (Cont'd) ;09/13/2006
- ;;1.6;HEALTH LEVEL SEVEN;**19,43,91,109,108,133,161**;Oct 13, 1995;Build 6
- ;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, however the format of the variable cannot be
- ;relied on. Please refer to the developer manual or ICR #2165 for more info.
- ;
- ;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
- ;if HLRESLTA is undefined set to NULL ("") HL*1.6*161 RRA ticket #63271
- I $G(HLRESLTA)="" S HLRESLTA=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLMA1 3997 printed Jan 18, 2025@02:59:33 Page 2
- HLMA1 ;AISC/SAW-Message Administration Module (Cont'd) ;09/13/2006
- +1 ;;1.6;HEALTH LEVEL SEVEN;**19,43,91,109,108,133,161**;Oct 13, 1995;Build 6
- +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, however the format of the variable cannot be
- +5 ;relied on. Please refer to the developer manual or ICR #2165 for more info.
- +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 ;if HLRESLTA is undefined set to NULL ("") HL*1.6*161 RRA ticket #63271
- +2 IF $GET(HLRESLTA)=""
- SET HLRESLTA=""
- +3 QUIT