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

YSGAFHL7.m

Go to the documentation of this file. 
  1. YSGAFHL7 ;ALB/SCK-HL7 MENTAL HEALTH ROUTINES ;8/10/98
  1.  ;;5.01;MENTAL HEALTH;**43,81**;Dec 30, 1994
  1.  ;
  1.  Q
  1. EN(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO) ; Main entry point Mental Health ADT message builder
  1.  ;
  1.  ; Input
  1.  ;     DFN - Pointer to entry in PATIENT file (#2) to build message for
  1.  ;     EVNTYP   - HL7 ADT event to build message for (Defaults to A08)
  1.  ;                Currently only A08 supported
  1.  ;     EVNTDT   - Date/Time event occurred in FIleMAn format
  1.  ;     OBXINFO  - Array containing the Observation information
  1.  ;                OBXINFO(seq number)=Field value
  1.  ;     EVNTINFO - Array containing further event information needed
  1.  ;                when building HL7 segments/message.  Defaults to
  1.  ;                ^TMP("YSGAF",$J,"EVNTINFO")
  1.  ;                 Current subscripts include:
  1.  ;                   EVNTINFO("REASON",X) = Reason Code
  1.  ;                   EVNTINFO("SERVER PROTOCOL")= Server Protocol
  1.  ;
  1.  ; Output : Message ID - ADT=Axx message ID
  1.  ;          ErrorCode^ErrorText - Error generating ADT-Axx message
  1.  ;
  1.  ;
  1.  ;; Check Input
  1.  S DFN=+$G(DFN)
  1.  Q:('$D(^DPT(DFN,0))) "-1^Could not find entry in PATIENT file"
  1.  S EVNTYP=$G(EVNTYP)
  1.  S:(EVNTYP="") EVNTYP="A08"
  1.  S EVNTDT=+$G(EVNTDT)
  1.  S:('EVNTDT) EVNTDT=$$NOW^XLFDT
  1.  Q:($O(@OBXINFO@(""))="") "-1^There was no Observation data to send"
  1.  S EVNTINFO=$G(EVNTINFO)
  1.  S:(EVNTINFO="") EVNTINFO="^TMP(""YSGAF"","_$J_",""EVNTINFO"")"
  1.  ;
  1.  N GLOREF,YSOK,RETURN
  1.  ;; Check for supported event
  1.  Q:("A08"'[EVNTYP) "-1^Event type not supported"
  1.  ; 
  1.  ;; Initialize transmission global
  1.  S GLOREF="^TMP(""HLS"","_$J_")"
  1.  K @GLOREF
  1.  ;
  1.  ;; Load EVNTINFO array
  1.  S @EVNTINFO@("DFN")=DFN
  1.  S @EVNTINFO@("EVENT")=EVNTYP
  1.  S @EVNTINFO@("DATE")=EVNTDT
  1.  ;
  1.  ;; Build and send ADT-Axx message
  1.  S RETURN=$$BLDMSG(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO,GLOREF)
  1.  I (+RETURN>0) D
  1.  . S RETURN=$$SNDMSG(EVNTYP,EVNTINFO)
  1.  ;
  1.  D CLRVAR
  1.  Q $G(RETURN)
  1.  ;
  1. CLRVAR ; Common point for clearing variables used
  1.  K @GLOREF,@EVNTINFO@("DFN"),@EVNTINFO@("EVENT"),@EVNTINFO@("DATE")
  1.  Q
  1.  ;
  1. BLDMSG(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO,XMITARRY) ;
  1.  ;
  1.  N HLEID,HL,HLFS,HLECH,HLQ
  1.  N VAFSTR,LASTLINE,LINESADD
  1.  ;
  1.  K HL
  1.  S XMITARRY=$G(XMITARRY)
  1.  S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"
  1.  ;
  1.  ;; Check for server protocol
  1.  Q:$G(@EVNTINFO@("SERVER PROTOCOL"))']"" "-1^Server Protocol not defined"
  1.  I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" D
  1.  . D INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.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,4"
  1.  S VAFEVN=$$EN^VAFHLEVN(EVNTYP,EVNTDT,VAFSTR,HL("Q"),HL("FS"))
  1.  S $P(VAFEVN,HL("FS"),2)=EVNTYP
  1.  S $P(VAFEVN,HL("FS"),4)=$S($G(@EVNTINFO@("REASON"))]"":$G(@EVNTINFO@("REASON")),1:HL("Q"))
  1.  ;; Add EVN segment to transmission array
  1.  S LASTLINE=1+$G(LASTLINE)
  1.  S @XMITARRY@(LASTLINE)=VAFEVN
  1.  ;
  1.  ;; Build PID segment
  1.  N VAFPID
  1.  S VAFSTR="1,2,3,4,5,6,7,8,10N,11,12,13,14,16,17,19,22"
  1.  S VAFPID=$$EN^VAFHLPID(DFN,VAFSTR)
  1.  S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPID(""),-1)
  1.  M @XMITARRY@(LASTLINE)=VAFPID
  1.  ;
  1.  ;; Build OBX segment
  1.  N VAFOBX,OBX1
  1.  S VAFSTR="1,2,3,4,5,11,14,16"
  1.  ;
  1.  ;; Set Observation Identifier if not already set
  1.  S @OBXINFO@(3)=$G(@OBXINFO@(3))
  1.  S:(@OBXINFO@(3)="") @OBXINFO@(3)="GAF~Global Assessment of Function~AXIS 5"
  1.  ;; Set Observation Result status to default if not passed in
  1.  S @OBXINFO@(11)=$G(@OBXINFO@(11))
  1.  S:(@OBXINFO@(11)="") @OBXINFO@(11)="F"
  1.  ;
  1.  ;; Set Value type to defualt if not passed in
  1.  S @OBXINFO@(2)=$G(@OBXINFO@(2))
  1.  S:(@OBXINFO@(2)="") @OBXINFO@(2)="ST"
  1.  ;
  1.  M OBX1=@OBXINFO
  1.  S VAFOBX=$$EN^VAFHLOBX(.OBX1,,VAFSTR)
  1.  S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFOBX(""),-1)
  1.  M @XMITARRY@(LASTLINE)=VAFOBX
  1.  ;
  1.  Q LASTLINE_"^"_LINESADD
  1.  ;
  1. SNDMSG(EVNTYP,EVNTINFO,XMITARRY) ; Send ADT HL7 message
  1.  ;
  1.  N ARRY4HL7,KILLARRY,HL,HLP,HLRESLT
  1.  S XMITARRY=$G(XMITARRY)
  1.  S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"
  1.  Q:($O(@XMITARRY@(""))="") "-1^Can not send empty message"
  1.  ;
  1.  K HL
  1.  S ARRY4HL7="^TMP(""HLS"","_$J_")"
  1.  ;
  1.  ;; If server is not specified then quit with error
  1.  Q:$G(@EVNTINFO@("SERVER PROTOCOL"))']"" "-1^Server Protocol not defined"
  1.  ;
  1.  ;; Initialize HL7 variables
  1.  I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" D
  1.  . D INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)
  1.  Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
  1.  ;
  1.  ;; Check if XMITARRY is ^TMP("HLS",$J)
  1.  S KILLARRY=0
  1.  I (XMITARRY'=ARRY4HL7) D
  1.  . ;;Make sure '$J' wasn't used
  1.  . Q:(XMITARRY="TMP(""HLS"",$J)")
  1.  . K @ARRY4HL7
  1.  . M @ARRY4HL7=@XMITARRY
  1.  . S KILLARRY=1
  1.  ;
  1.  ;; Broadcast message
  1.  D GENERATE^HLMA(@EVNTINFO@("SERVER PROTOCOL"),"GM",1,.HLRESLT,"",.HLP)
  1.  S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
  1.  ;
  1.  ;; Delete ^TMP("HLS",$J) if XMITARRY was different
  1.  K:(KILLARRY) @ARRY4HL7
  1.  ;
  1.  Q $G(HLRESLT)