Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLOCNRT

HLOCNRT.m

Go to the documentation of this file. 
  1. HLOCNRT ;DAOU/ALA-Generate HL7 Optimized Message ;05/12/2009
  1.  ;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137,146**;Oct 13, 1995;Build 16
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;**Program Description**
  1.  ;  This program uses the traditional protocol setup and hard-coded
  1.  ;  message builders  of HL7 1.6 to send messages via HL7 Optimized code.
  1.  Q
  1.  ;
  1. EN(HLOPRTCL,ARYTYP,HLP,HLL,RESULT) ;
  1.  ;Input:
  1.  ;   HLOPRTCL (required) Protocol IEN or Protocol Name
  1.  ;   ARYTYP   (required) set to "GM" if the message is contained in the global array ^TMP("HLS",$J), or set to "LM" if the message is contained in the local array HLA("HLS").
  1.  ;   HLP  (optional, pass-by-reference) Additional HL7 message
  1.  ;        parameters. These optional subscripts to HLP are supported:
  1.  ;             "APP ACK RESPONSE" = <tag^routine> to call when the app ack is received
  1.  ;             "CONTPTR"
  1.  ;             "SECURITY"
  1.  ;             "SEQUENCE QUEUE" - A queue used to maintain the order of
  1.  ;                   the messages via application acks. If used, the
  1.  ;                   application MUST specify that both an accept ack
  1.  ;                   and application ack be returned. 
  1.  ;        
  1.  ;   HLL  (optional, pass-by-reference) Used to dynamically add message
  1.  ;        recipients.  The format is HLL("LINKS",<i>)=<destination protocol name or ien>^<destination link or ien>.
  1.  ;       
  1.  ;
  1.  ;  Output
  1.  ;    RESULT (pass-by-reference)
  1.  ;            On success:
  1.  ;                 <subscriber protocol ien>^<link ien>^<message id>^0
  1.  ;            On failure:
  1.  ;                 <subscriber protocol ien>^<link ien>^<message id>^<error code>^<optional error message>
  1.  ;
  1.  ;    RESULT("IEN")=the ien, file 778, if a message record in file 778
  1.  ;                  was created, regardless of whether or not the message
  1.  ;                  was successfully queued for transmission.
  1.  ;
  1.  ;            If the message was sent to more than 1 destination,
  1.  ;            the addtional message statuses are returned as RESULT(1),
  1.  ;            RESULT(2), etc., in the same format as above, as the iens
  1.  ;            of message records created are returned as RESULT(1,"IEN"),
  1.  ;            RESULT(2,"IEN"), etc.
  1.  ;    ZTSTOP = Stop processing flag (used by HDR)
  1.  ;    Function returns:
  1.  ;            On success:  1
  1.  ;            On failure:  ^<error code>^<error message>
  1.  ;
  1.  NEW HLORESL,HLMSTATE,APPARMS,WHOTO,ERROR,WHO
  1.  S ZTSTOP=0,HLORESL=1,RESULT=""
  1.  ;
  1.  ;  Get IEN of protocol if name is passed
  1.  I '$L(HLOPRTCL) S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
  1.  I ('HLOPRTCL)!(HLOPRTCL'=+HLOPRTCL) S HLOPRTCL=+$O(^ORD(101,"B",HLOPRTCL,0))
  1.  I 'HLOPRTCL S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
  1.  I '$D(^ORD(101,HLOPRTCL)) S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
  1.  ;
  1.  ;  If the VistA HL7 Protocol exists, call the Conversion Utility
  1.  ;  to set up the APPARMS, WHOTO arrays from protocol logical link,
  1.  ;   and the optional HLL and HLP arrays
  1.  D APAR^HLOCVU(HLOPRTCL,.APPARMS,.WHO,.WHOTO,.HLP,.HLL)
  1.  ;
  1.  ; If special HLP parameters are defined, convert them
  1.  I $D(HLP) D
  1.  . I $G(HLP("SECURITY"))'="" S APPARMS("SECURITY")=HLP("SECURITY")
  1.  . I $G(HLP("CONTPTR"))'="" S APPARMS("CONTINUATION POINTER")=HLP("CONTPTR")
  1.  . I $G(HLP("QUEUE"))'="" S APPARMS("QUEUE")=HLP("QUEUE")
  1.  . I $G(HLP("SEQUENCE QUEUE"))'="" S APPARMS("SEQUENCE QUEUE")=HLP("SEQUENCE QUEUE")
  1.  . I $G(HLP("APP ACK RESPONSE"))'="" S APPARMS("APP ACK RESPONSE")=HLP("APP ACK RESPONSE")
  1.  ;
  1.  ;  Create HL Optimized message
  1.  I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR) S HLORESL="^99^"_ERROR,ZTSTOP=1,RESULT="^^"_HLORESL Q HLORESL
  1.  I $E(ARYTYP,1)="G" S HLOMESG="^TMP(""HLS"",$J)"
  1.  I $E(ARYTYP,1)="L" S HLOMESG="HLA(""HLS"")"
  1.  ;
  1.  ;  Move the existing message from array into HL Optimized
  1.  D MOVEMSG^HLOAPI(.HLMSTATE,HLOMESG)
  1.  ; 
  1.  ;  Send message via HL Optimized
  1.  I $D(WHOTO) D
  1.  .N COUNT
  1.  .I '$$SENDMANY^HLOAPI1(.HLMSTATE,.APPARMS,.WHOTO) D
  1.  ..S HLORESL="^99^Unable to send message",ZTSTOP=1
  1.  .I $G(WHOTO(1,"IEN")) D
  1.  ..S RESULT=WHO(1)_"^"_$P($G(^HLB(WHOTO(1,"IEN"),0)),"^")_"^"_$S($G(WHOTO(1,"QUEUED")):0,1:1)_"^"_$G(WHOTO(1,"ERROR"))
  1.  ..;**P146 START CJM
  1.  ..S RESULT("IEN")=WHOTO(1,"IEN")
  1.  ..;**P146 END CJM
  1.  .E  D
  1.  ..S RESULT=$G(WH0(1))_"^^1^"_$G(WHOTO(1,"ERROR"))
  1.  ..;**P146 START CJM
  1.  ..S RESULT("IEN")=""
  1.  ..;**P146 END CJM
  1.  ..S HLORESL="^99^"_$G(WHOTO(1,"ERROR")),ZTSTOP=1
  1.  .S COUNT=1
  1.  .F  S COUNT=$O(WHOTO(COUNT)) Q:'COUNT  D
  1.  ..I $G(WHOTO(COUNT,"IEN")) D
  1.  ...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"))
  1.  ...;**P146 START CJM
  1.  ...S RESULT(COUNT-1,"IEN")=WHOTO(COUNT,"IEN")
  1.  ...;**P146 END CJM
  1.  ..E  D
  1.  ...S RESULT(COUNT-1)=WH0(COUNT)_"^^1^"_$G(WHOTO(COUNT,"ERROR"))
  1.  ...;**P146 START CJM
  1.  ...S RESULT(COUNT-1,"IEN")=""
  1.  ...;**P146 END CJM
  1.  ;
  1.  E  S HLORESL="^99^Unable to send message",ZTSTOP=1,RESULT="^^"_HLORESL
  1.  Q HLORESL