source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCNRT.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1HLOCNRT ;DAOU/ALA-Generate HL7 Optimized Message ;07/24/2007
2 ;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137**;Oct 13, 1995;Build 21
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;**Program Description**
6 ; This program takes a current HL7 1.6 message and converts
7 ; it to use the new HL Optimized code if it follows the standard
8 ; 1.6 methodology of protocols.
9 ;
10 ; **If the VistA HL7 Protocol does not exist, calls to HL Optimized
11 ; will have to be coded separately and this program cannot be used**
12 Q
13 ;
14EN(HLOPRTCL,ARYTYP,HLP,HLL,RESULT) ;Entry Point
15 ; Input Parameters
16 ; HLOPRTCL = Protocol IEN or Protocol Name
17 ; ARYTYP = The array where HL7 message resides
18 ; HLP = Additional HL7 message parameters (optional, pass by reference)
19 ; These optional subscripts to HLP are supported for input:
20 ; "APP ACK RESPONSE" = <tag^routine> to call when the app ack is received
21 ; "CONTPTR"
22 ; "SECURITY"
23 ; "SEQUENCE QUEUE" - queue used to maintain the order of the messages via application acks. If used, the application MUST specify that both an accept ack and application ack be returned.
24 ;
25 ; HLL (optional, pass by reference) Additional message recipients being dynamically added
26 ;
27 ; Output
28 ; RESULT (pass-by-reference)=<subscriber protocol ien>^<link ien>^<message id>^<0 if sucess, error code if failure>^<optional error message>
29 ; If the message was sent to more than 1 destination,
30 ; the addtional mssage ids returned as RESULT(1), RESULT(2), etc.
31 ; ZTSTOP = Stop processing flag (used by HDR)
32 ; Function returns 1 on success, else returns an error message
33 ;
34 NEW HLORESL,HLMSTATE,APPARMS,WHOTO,ERROR,WHO
35 S ZTSTOP=0,HLORESL=1,RESULT=""
36 ;
37 ; Get IEN of protocol if name is passed
38 I '$L(HLOPRTCL) S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
39 I ('HLOPRTCL)!(HLOPRTCL'=+HLOPRTCL) S HLOPRTCL=+$O(^ORD(101,"B",HLOPRTCL,0))
40 I 'HLOPRTCL S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
41 I '$D(^ORD(101,HLOPRTCL)) S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
42 ;
43 ; If the VistA HL7 Protocol exists, call the Conversion Utility
44 ; to set up the APPARMS, WHOTO arrays from protocol logical link,
45 ; and the optional HLL and HLP arrays
46 D APAR^HLOCVU(HLOPRTCL,.APPARMS,.WHO,.WHOTO,.HLP,.HLL)
47 ;
48 ; If special HLP parameters are defined, convert them
49 I $D(HLP) D
50 . I $G(HLP("SECURITY"))'="" S APPARMS("SECURITY")=HLP("SECURITY")
51 . I $G(HLP("CONTPTR"))'="" S APPARMS("CONTINUATION POINTER")=HLP("CONTPTR")
52 . I $G(HLP("QUEUE"))'="" S APPARMS("QUEUE")=HLP("QUEUE")
53 . I $G(HLP("SEQUENCE QUEUE"))'="" S APPARMS("SEQUENCE QUEUE")=HLP("SEQUENCE QUEUE")
54 . I $G(HLP("APP ACK RESPONSE"))'="" S APPARMS("APP ACK RESPONSE")=HLP("APP ACK RESPONSE")
55 ;
56 ; Create HL Optimized message
57 I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR) S HLORESL="^99^"_ERROR,ZTSTOP=1,RESULT="^^"_HLORESL Q HLORESL
58 I $E(ARYTYP,1)="G" S HLOMESG="^TMP(""HLS"",$J)"
59 I $E(ARYTYP,1)="L" S HLOMESG="HLA(""HLS"")"
60 ;
61 ; Move the existing message from array into HL Optimized
62 D MOVEMSG^HLOAPI(.HLMSTATE,HLOMESG)
63 ;
64 ; Send message via HL Optimized
65 I $D(WHOTO) D
66 .N COUNT
67 .I '$$SENDMANY^HLOAPI1(.HLMSTATE,.APPARMS,.WHOTO) D
68 ..S HLORESL="^99^Unable to send message",ZTSTOP=1
69 .I $G(WHOTO(1,"IEN")) D
70 ..S RESULT=WHO(1)_"^"_$P($G(^HLB(WHOTO(1,"IEN"),0)),"^")_"^"_$S($G(WHOTO(1,"QUEUED")):0,1:1)_"^"_$G(WHOTO(1,"ERROR"))
71 .E D
72 ..S RESULT=WH0(1)_"^^1^"_$G(WHOTO(1,"ERROR"))
73 ..S HLORESL="^99^"_$G(WHOTO(1,"ERROR")),ZTSTOP=1
74 .S COUNT=1
75 .F S COUNT=$O(WHOTO(COUNT)) Q:'COUNT D
76 ..I $G(WHOTO(COUNT,"IEN")) D
77 ...S RESULT(COUNT-1)=WHO(COUNT)_"^"_$P($G(^HLB(WHOTO(COUNT,"IEN"),0)),"^")_"^"_$S($G(WHOTO(COUNT,"QUEUED")):0,1:1)_"^"_$G(WHOTO(COUNT,"ERROR"))
78 ..E D
79 ...S RESULT(COUNT-1)=WH0(COUNT)_"^^1^"_$G(WHOTO(COUNT,"ERROR"))
80 ;
81 E S HLORESL="^99^Unable to send message",ZTSTOP=1,RESULT="^^"_HLORESL
82 Q HLORESL
Note: See TracBrowser for help on using the repository browser.