1 | HLMA1 ;AISC/SAW-Message Administration Module (Cont'd) ;09/13/2006
|
---|
2 | ;;1.6;HEALTH LEVEL SEVEN;**19,43,91,109,108,133**;Oct 13, 1995;Build 13
|
---|
3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | GENACK(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,HLRESLTA,HLMTIENA,HLP) ;
|
---|
5 | ;Entry point to generate an acknowledgement message
|
---|
6 | ;
|
---|
7 | ;This is a subroutine call with parameter passing. It returns a value
|
---|
8 | ;in the variable HLRESLTA of null if no error occurs, or the following
|
---|
9 | ;two piece value if an error occurs: error code^error description
|
---|
10 | ;
|
---|
11 | ;Required Input Parameters
|
---|
12 | ; HLEID = IEN of event driver protocol from the Protocol file
|
---|
13 | ; HLMTIENS = IEN of entry in Message Text file for subscriber
|
---|
14 | ; application
|
---|
15 | ; HLEIDS = IEN of subscriber event from the Protocol file
|
---|
16 | ; HLARYTYP = Array type. One of the following codes:
|
---|
17 | ; LM = local array containing a single message
|
---|
18 | ; LB = local array containig a batch of messages
|
---|
19 | ; GM = global array containing a single message
|
---|
20 | ; GB = global array containing a batch of messages
|
---|
21 | ; HLFORMAT = Format of array, 1 for pre-formatted in HL7 format,
|
---|
22 | ; otherwise 0
|
---|
23 | ;NOTE: The parameter HLRESLTA must be passed by reference
|
---|
24 | ; HLRESLTA = The variable that will be returned to the calling
|
---|
25 | ; application as descibed above
|
---|
26 | ;Optional Parameters
|
---|
27 | ; HLMTIENA = IEN of entry in Message Text file where the
|
---|
28 | ; acknowledgement message will be stored. This
|
---|
29 | ; parameter is only passed for a batch acknowledgment
|
---|
30 | ; HLP("SECURITY") = A 1 to 40 character string
|
---|
31 | ; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
|
---|
32 | ;
|
---|
33 | ;
|
---|
34 | ;HLRESLTA is to return the results and should not be initially defined
|
---|
35 | N HLRESLT
|
---|
36 | S HLRESLT=""
|
---|
37 | K HLRESLTA
|
---|
38 | ;
|
---|
39 | ;Check for required parameters
|
---|
40 | 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
|
---|
41 | I 'HLEIDS S HLEIDS=$O(^ORD(101,"B",HLEIDS,0)) I 'HLEIDS S HLRESLTA="0^1^"_$G(^HL(771.7,1,0)) G EXIT
|
---|
42 | ;Extract data from Protocol file
|
---|
43 | D EVENT^HLUTIL1(HLEIDS,"15,20,772",.HLN)
|
---|
44 | N HLEXROU,HLMIDAR
|
---|
45 | S HLMIDAR=0,HLENROU=$G(HLN(20)),HLEXROU=$G(HLN(15))
|
---|
46 | S HLP("GROUTINE")=$G(HLN(772)) K HLN I HLP("GROUTINE")']"",'HLFORMAT S HLRESLTA="0^3^"_$G(^HL(771.7,3,0)) G EXIT
|
---|
47 | I "GL"'[$E($G(HLARYTYP)) S HLRESLTA="0^4^"_$G(^HL(771.7,4,0)) G EXIT
|
---|
48 | I '$D(HLP("SECURITY")) S HLP("SECURITY")=""
|
---|
49 | I $L(HLP("SECURITY"))>40 S HLRESLTA="0^6^"_$G(^HL(771.7,6,0)) G EXIT
|
---|
50 | ;$D(HLTCP) tcp connection will be used
|
---|
51 | I $D(HLTCP) D GENACK^HLTP4 G EXIT
|
---|
52 | ;Create message ID and Message Text IEN if Message Text IEN not
|
---|
53 | ;previously created ('$G(HLMTIENA))
|
---|
54 | I '$G(HLMTIENA) D CREATE^HLTF(.HLMIDA,.HLMTIENA,.HLDTA,.HLDT1A)
|
---|
55 | ;Get message ID if Message Text IEN not already created
|
---|
56 | I '$G(HLMIDA) D
|
---|
57 | .S HLDTA=$G(^HL(772,HLMTIENA,0))
|
---|
58 | .S HLDT1A=$$HLDATE^HLFNC(+HLDTA),HLMIDA=$P(HLDTA,"^",6),HLDTA=+HLDTA
|
---|
59 | S HLRESLTA=HLMIDA,HLP("DTM")=HLDT1A,HLP("DT")=HLDTA,HLP("MTIENS")=HLMTIENS,HLP("EID")=HLEID
|
---|
60 | ;Execute entry action for subscriber protocol
|
---|
61 | I HLENROU]"" X HLENROU
|
---|
62 | ;Invoke transaction processor to generate acknowledgement
|
---|
63 | K HLDTA,HLDT1A,HLEID,HLENROU,HLMTIENS
|
---|
64 | S HLRESLT=""
|
---|
65 | D GENACK^HLTP1(HLMIDA,HLMTIENA,HLEIDS,HLARYTYP,HLFORMAT,.HLRESLT,.HLP)
|
---|
66 | ;HLMIDAR is array of message IDs, only set for broadcast messages
|
---|
67 | I HLMIDAR K HLMIDAR("N") M HLRESLTA=HLMIDAR
|
---|
68 | S HLRESLTA=HLRESLTA_"^"_HLRESLT
|
---|
69 | ;Update status to Awaiting Acknowledgement or Error in Transmission
|
---|
70 | 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:""))
|
---|
71 | ;Execute exit action for subscriber protocol
|
---|
72 | X:HLEXROU]"" HLEXROU
|
---|
73 | EXIT K HLDTA,HLDT1A,HLMIDA,HLENROU,HLEXROU
|
---|
74 | Q
|
---|