| 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 | 
|---|