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

DGMSTHL7.m

Go to the documentation of this file.
  1. DGMSTHL7 ;ALB/SCK - Military Sexual Trauma HL7 Message builder ;8 Jan 99
  1. ;;5.3;Registration;**195**;Aug 13, 1993
  1. Q
  1. ;
  1. EVENT(DFN,DGEVNT,DGRSLT) ; Entry point to initiate HL7 ADT message for a MST status event
  1. ; Input
  1. ; DFN - IEN of patient in the PATIENT File, #2
  1. ; DGEVNT - Event type, currently only A08 supported, Optional
  1. ; Default is A08
  1. ; DGRSLT - Location of results from event trigger
  1. ;
  1. ; Output
  1. ; DGRSLT= results of event action
  1. ;
  1. N EVNTDT,EVNTINFO
  1. ;
  1. S DFN=$G(DFN)
  1. I 'DFN S @DGRSLT="-1^Invalid DFN" Q
  1. ;
  1. S DGEVNT=$G(DGEVNT)
  1. S:'(DGEVNT]"") DGEVNT="A08"
  1. I DGEVNT'["A08" S @DGRSLT="-1^Event type not supported" Q
  1. ;
  1. S DGRSLT=$G(DGRSLT)
  1. Q:'(DGRSLT]"")
  1. ;
  1. N GLOREF
  1. S GLOREF="^TMP(""HLS"","_$J_")"
  1. K @GLOREF
  1. ;
  1. S EVNTINFO("DFN")=DFN
  1. S EVNTINFO("EVENT")="A08"
  1. S EVNTINFO("DATE")=$$NOW^XLFDT
  1. S EVNTINFO("SERVER")="DGMST A08 SERVER"
  1. ;
  1. S @DGRSLT=$$BLDMSG(.EVNTINFO,GLOREF)
  1. I (+@DGRSLT>0) D
  1. . S @DGRSLT=$$SENDMSG(.EVNTINFO,GLOREF)
  1. Q
  1. ;
  1. BLDMSG(EVNTINFO,XMTARRY) ;
  1. ; Input
  1. ; EVNTINFO - Array of event information
  1. ; ("DATE") - Event date
  1. ; ("DFN") - IEN of patient in PATIENT File (#2)
  1. ; ("EVENT") - HL7 message event
  1. ; ("SERVER") - HL7 Server protocol
  1. ;
  1. ; XMTARRY - Location to place HL7 message array, Optional
  1. ; Default is ^TMP("HLS",$J)
  1. ;
  1. ; Output
  1. ; XMTARRY - HL7 Message
  1. ;
  1. N HLEID,HL,HLFS,HLECH,HLQ,LASTLINE,VAFSTR,LINESADD,HLP
  1. ;
  1. S XMTARRY=$G(XMTARRY)
  1. S:(XMTARRY="") XMTARRY="^TMP(""HLS"","_$J_")"
  1. ;
  1. Q:$G(EVNTINFO("SERVER"))']"" "-1^Server protocol not defined"
  1. I $G(EVNTINFO("SERVER"))]"" D
  1. . D INIT^HLFNC2(EVNTINFO("SERVER"),.HL)
  1. Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
  1. ;
  1. ;; Build EVN segment
  1. N VAFEVN,VAFSTR
  1. S VAFSTR="1,2,"
  1. S VAFEVN=$$EN^VAFHLEVN(EVNTINFO("EVENT"),EVNTINFO("DATE"),VAFSTR,HL("Q"),HL("FS"))
  1. S $P(VAFEVN,HL("FS"),2)=EVNTINFO("EVENT")
  1. S LASTLINE=1+$G(LASTLINE)
  1. S @XMTARRY@(LASTLINE)=VAFEVN
  1. ;
  1. ;; Build PID segment
  1. N VAFPID
  1. S VAFSTR="1,2,3,4,5,6,7,8,10,11,12,13,14,16,17,19,"
  1. S VAFPID=$$EN^VAFHLPID(EVNTINFO("DFN"),VAFSTR)
  1. S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPID(""),-1)
  1. M @XMTARRY@(LASTLINE)=VAFPID
  1. ;
  1. ;; Build ZEL segment, include only the MST status and status change date
  1. N VAFZEL
  1. S VAFSTR="1,23,24,"
  1. S VAFZEL=$$EN^VAFHLZEL(EVNTINFO("DFN"),VAFSTR)
  1. S LASTLINE=1+$G(LASTLINE)
  1. M @XMTARRY@(LASTLINE)=VAFZEL
  1. ;
  1. Q LASTLINE_U_LINESADD
  1. ;
  1. SENDMSG(EVNTINFO,XMTARRY) ; Send ADT HL7 message
  1. ; Input
  1. ; EVNTINFO
  1. ; XMTARRY
  1. ;
  1. ; Output
  1. ;
  1. ;
  1. N ARRY4HL7,KILLARRY,HL,HLRESLT
  1. S XMTARRY=$G(XMTARRY)
  1. S:'(XMTARRY]"") XMTARRY="^TMP(""HLS"","_$J_")"
  1. Q:($O(@XMTARRY@(""))="") "-1^Can not send empty message"
  1. ;
  1. K HL
  1. S ARRY4HL7="^TMP(""HLS"","_$J_")"
  1. ;
  1. ;; If server not specified, then quit with error
  1. Q:$G(EVNTINFO("SERVER"))']"" "-1^Server protocol not defined"
  1. ;
  1. ;; Initialize HL7 variables
  1. I $G(EVNTINFO("SERVER"))]"" D
  1. . D INIT^HLFNC2(EVNTINFO("SERVER"),.HL)
  1. Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
  1. ;
  1. ;; Check if XMTARRY is ^TMP("HLS",$J)
  1. S KILLARRY=0
  1. I (XMTARRY'=ARRY4HL7) D
  1. . ;; make sure '$J' wasn't used
  1. . Q:(XMTARRY="TMP(""HLS"",$J")
  1. . K @ARRY4HL7
  1. . M @ARRY4HL7=@XMTARRY
  1. . S KILLARRY=1
  1. ;
  1. ;; Broadcast message
  1. D GENERATE^HLMA(EVNTINFO("SERVER"),"GM",1,.HLRESLT,"",.HLP)
  1. S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
  1. ;
  1. ;; Delete ^TMP("HLS",$J) if XMTARRY was different
  1. K:(KILLARRY) @ARRY4HL7
  1. ;
  1. Q $G(HLRESLT)