Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCNRT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCNRT.m
r613 r623 1 HLOCNRT ;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 ; 14 EN(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 1 HLOCNRT ;DAOU/ALA-Generate HL7 Optimized Message ;03/15/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,132,134**;Oct 13, 1995;Build 30 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 ; 14 EN(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 HLL are supported for input: 20 ; "SECURITY" 21 ; "CONTPTR" 22 ; "APP ACK RESPONSE" = <tag^routine> to call when the app ack is received 23 ; 24 ; HLL (optional, pass by reference) Additional message recipients being dynamically added 25 ; 26 ; Output 27 ; RESULT (pass-by-reference)=<subscriber protocol ien>^<link ien>^<message id>^<0 if sucess, error code if failure>^<optional error message> 28 ; If the message was sent to more than 1 destination, 29 ; the addtional mssage ids returned as RESULT(1), RESULT(2), etc. 30 ; ZTSTOP = Stop processing flag (used by HDR) 31 ; Function returns 1 on success, else returns an error message 32 ; 33 NEW HLORESL,HLMSTATE,APPARMS,WHOTO,ERROR,WHO 34 S ZTSTOP=0,HLORESL=1,RESULT="" 35 ; 36 ; Get IEN of protocol if name is passed 37 I '$L(HLOPRTCL) S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL 38 I ('HLOPRTCL)!(HLOPRTCL'=+HLOPRTCL) S HLOPRTCL=+$O(^ORD(101,"B",HLOPRTCL,0)) 39 I 'HLOPRTCL S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL 40 I '$D(^ORD(101,HLOPRTCL)) S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL 41 ; 42 ; If the VistA HL7 Protocol exists, call the Conversion Utility 43 ; to set up the APPARMS, WHOTO arrays from protocol logical link, 44 ; and the optional HLL and HLP arrays 45 D APAR^HLOCVU(HLOPRTCL,.APPARMS,.WHO,.WHOTO,.HLP,.HLL) 46 ; 47 ; If special HLP parameters are defined, convert them 48 I $D(HLP) D 49 . I $G(HLP("SECURITY"))'="" S APPARMS("SECURITY")=HLP("SECURITY") 50 . I $G(HLP("CONTPTR"))'="" S APPARMS("CONTINUATION POINTER")=HLP("CONTPTR") 51 . I $G(HLP("QUEUE"))'="" S APPARMS("QUEUE")=HLP("QUEUE") 52 . I $G(HLP("APP ACK RESPONSE"))'="" S APPARMS("APP ACK RESPONSE")=HLP("APP ACK RESPONSE") 53 ; 54 ; Create HL Optimized message 55 I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR) S HLORESL="^99^"_ERROR,ZTSTOP=1,RESULT="^^"_HLORESL Q HLORESL 56 I $E(ARYTYP,1)="G" S HLOMESG="^TMP(""HLS"",$J)" 57 I $E(ARYTYP,1)="L" S HLOMESG="HLA(""HLS"")" 58 ; 59 ; Move the existing message from array into HL Optimized 60 D MOVEMSG^HLOAPI(.HLMSTATE,HLOMESG) 61 ; 62 ; Send message via HL Optimized 63 I $D(WHOTO) D 64 .N COUNT 65 .I '$$SENDMANY^HLOAPI1(.HLMSTATE,.APPARMS,.WHOTO) D 66 ..S HLORESL="^99^Unable to send message",ZTSTOP=1 67 .I $G(WHOTO(1,"IEN")) D 68 ..S RESULT=WHO(1)_"^"_$P($G(^HLB(WHOTO(1,"IEN"),0)),"^")_"^"_$S($G(WHOTO(1,"QUEUED")):0,1:1)_"^"_$G(WHOTO(1,"ERROR")) 69 .E D 70 ..S RESULT=WH0(1)_"^^1^"_$G(WHOTO(1,"ERROR")) 71 ..S HLORESL="^99^"_$G(WHOTO(1,"ERROR")),ZTSTOP=1 72 .S COUNT=1 73 .F S COUNT=$O(WHOTO(COUNT)) Q:'COUNT D 74 ..I $G(WHOTO(COUNT,"IEN")) D 75 ...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")) 76 ..E D 77 ...S RESULT(COUNT-1)=WH0(COUNT)_"^^1^"_$G(WHOTO(COUNT,"ERROR")) 78 ; 79 E S HLORESL="^99^Unable to send message",ZTSTOP=1,RESULT="^^"_HLORESL 80 Q HLORESL
Note:
See TracChangeset
for help on using the changeset viewer.
