YSGAFHL7 ;ALB/SCK-HL7 MENTAL HEALTH ROUTINES ;8/10/98
;;5.01;MENTAL HEALTH;**43,81**;Dec 30, 1994
;
Q
EN(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO) ; Main entry point Mental Health ADT message builder
;
; Input
; DFN - Pointer to entry in PATIENT file (#2) to build message for
; EVNTYP - HL7 ADT event to build message for (Defaults to A08)
; Currently only A08 supported
; EVNTDT - Date/Time event occurred in FIleMAn format
; OBXINFO - Array containing the Observation information
; OBXINFO(seq number)=Field value
; EVNTINFO - Array containing further event information needed
; when building HL7 segments/message. Defaults to
; ^TMP("YSGAF",$J,"EVNTINFO")
; Current subscripts include:
; EVNTINFO("REASON",X) = Reason Code
; EVNTINFO("SERVER PROTOCOL")= Server Protocol
;
; Output : Message ID - ADT=Axx message ID
; ErrorCode^ErrorText - Error generating ADT-Axx message
;
;
;; Check Input
S DFN=+$G(DFN)
Q:('$D(^DPT(DFN,0))) "-1^Could not find entry in PATIENT file"
S EVNTYP=$G(EVNTYP)
S:(EVNTYP="") EVNTYP="A08"
S EVNTDT=+$G(EVNTDT)
S:('EVNTDT) EVNTDT=$$NOW^XLFDT
Q:($O(@OBXINFO@(""))="") "-1^There was no Observation data to send"
S EVNTINFO=$G(EVNTINFO)
S:(EVNTINFO="") EVNTINFO="^TMP(""YSGAF"","_$J_",""EVNTINFO"")"
;
N GLOREF,YSOK,RETURN
;; Check for supported event
Q:("A08"'[EVNTYP) "-1^Event type not supported"
;
;; Initialize transmission global
S GLOREF="^TMP(""HLS"","_$J_")"
K @GLOREF
;
;; Load EVNTINFO array
S @EVNTINFO@("DFN")=DFN
S @EVNTINFO@("EVENT")=EVNTYP
S @EVNTINFO@("DATE")=EVNTDT
;
;; Build and send ADT-Axx message
S RETURN=$$BLDMSG(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO,GLOREF)
I (+RETURN>0) D
. S RETURN=$$SNDMSG(EVNTYP,EVNTINFO)
;
D CLRVAR
Q $G(RETURN)
;
CLRVAR ; Common point for clearing variables used
K @GLOREF,@EVNTINFO@("DFN"),@EVNTINFO@("EVENT"),@EVNTINFO@("DATE")
Q
;
BLDMSG(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO,XMITARRY) ;
;
N HLEID,HL,HLFS,HLECH,HLQ
N VAFSTR,LASTLINE,LINESADD
;
K HL
S XMITARRY=$G(XMITARRY)
S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"
;
;; Check for server protocol
Q:$G(@EVNTINFO@("SERVER PROTOCOL"))']"" "-1^Server Protocol not defined"
I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" D
. D INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)
Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
;
;; Build EVN segment
N VAFEVN,VAFSTR
S VAFSTR="1,2,4"
S VAFEVN=$$EN^VAFHLEVN(EVNTYP,EVNTDT,VAFSTR,HL("Q"),HL("FS"))
S $P(VAFEVN,HL("FS"),2)=EVNTYP
S $P(VAFEVN,HL("FS"),4)=$S($G(@EVNTINFO@("REASON"))]"":$G(@EVNTINFO@("REASON")),1:HL("Q"))
;; Add EVN segment to transmission array
S LASTLINE=1+$G(LASTLINE)
S @XMITARRY@(LASTLINE)=VAFEVN
;
;; Build PID segment
N VAFPID
S VAFSTR="1,2,3,4,5,6,7,8,10N,11,12,13,14,16,17,19,22"
S VAFPID=$$EN^VAFHLPID(DFN,VAFSTR)
S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPID(""),-1)
M @XMITARRY@(LASTLINE)=VAFPID
;
;; Build OBX segment
N VAFOBX,OBX1
S VAFSTR="1,2,3,4,5,11,14,16"
;
;; Set Observation Identifier if not already set
S @OBXINFO@(3)=$G(@OBXINFO@(3))
S:(@OBXINFO@(3)="") @OBXINFO@(3)="GAF~Global Assessment of Function~AXIS 5"
;; Set Observation Result status to default if not passed in
S @OBXINFO@(11)=$G(@OBXINFO@(11))
S:(@OBXINFO@(11)="") @OBXINFO@(11)="F"
;
;; Set Value type to defualt if not passed in
S @OBXINFO@(2)=$G(@OBXINFO@(2))
S:(@OBXINFO@(2)="") @OBXINFO@(2)="ST"
;
M OBX1=@OBXINFO
S VAFOBX=$$EN^VAFHLOBX(.OBX1,,VAFSTR)
S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFOBX(""),-1)
M @XMITARRY@(LASTLINE)=VAFOBX
;
Q LASTLINE_"^"_LINESADD
;
SNDMSG(EVNTYP,EVNTINFO,XMITARRY) ; Send ADT HL7 message
;
N ARRY4HL7,KILLARRY,HL,HLP,HLRESLT
S XMITARRY=$G(XMITARRY)
S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"
Q:($O(@XMITARRY@(""))="") "-1^Can not send empty message"
;
K HL
S ARRY4HL7="^TMP(""HLS"","_$J_")"
;
;; If server is not specified then quit with error
Q:$G(@EVNTINFO@("SERVER PROTOCOL"))']"" "-1^Server Protocol not defined"
;
;; Initialize HL7 variables
I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" D
. D INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)
Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
;
;; Check if XMITARRY is ^TMP("HLS",$J)
S KILLARRY=0
I (XMITARRY'=ARRY4HL7) D
. ;;Make sure '$J' wasn't used
. Q:(XMITARRY="TMP(""HLS"",$J)")
. K @ARRY4HL7
. M @ARRY4HL7=@XMITARRY
. S KILLARRY=1
;
;; Broadcast message
D GENERATE^HLMA(@EVNTINFO@("SERVER PROTOCOL"),"GM",1,.HLRESLT,"",.HLP)
S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
;
;; Delete ^TMP("HLS",$J) if XMITARRY was different
K:(KILLARRY) @ARRY4HL7
;
Q $G(HLRESLT)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSGAFHL7 4895 printed Sep 23, 2025@19:50:40 Page 2
YSGAFHL7 ;ALB/SCK-HL7 MENTAL HEALTH ROUTINES ;8/10/98
+1 ;;5.01;MENTAL HEALTH;**43,81**;Dec 30, 1994
+2 ;
+3 QUIT
EN(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO) ; Main entry point Mental Health ADT message builder
+1 ;
+2 ; Input
+3 ; DFN - Pointer to entry in PATIENT file (#2) to build message for
+4 ; EVNTYP - HL7 ADT event to build message for (Defaults to A08)
+5 ; Currently only A08 supported
+6 ; EVNTDT - Date/Time event occurred in FIleMAn format
+7 ; OBXINFO - Array containing the Observation information
+8 ; OBXINFO(seq number)=Field value
+9 ; EVNTINFO - Array containing further event information needed
+10 ; when building HL7 segments/message. Defaults to
+11 ; ^TMP("YSGAF",$J,"EVNTINFO")
+12 ; Current subscripts include:
+13 ; EVNTINFO("REASON",X) = Reason Code
+14 ; EVNTINFO("SERVER PROTOCOL")= Server Protocol
+15 ;
+16 ; Output : Message ID - ADT=Axx message ID
+17 ; ErrorCode^ErrorText - Error generating ADT-Axx message
+18 ;
+19 ;
+20 ;; Check Input
+21 SET DFN=+$GET(DFN)
+22 if ('$DATA(^DPT(DFN,0)))
QUIT "-1^Could not find entry in PATIENT file"
+23 SET EVNTYP=$GET(EVNTYP)
+24 if (EVNTYP="")
SET EVNTYP="A08"
+25 SET EVNTDT=+$GET(EVNTDT)
+26 if ('EVNTDT)
SET EVNTDT=$$NOW^XLFDT
+27 if ($ORDER(@OBXINFO@(""))="")
QUIT "-1^There was no Observation data to send"
+28 SET EVNTINFO=$GET(EVNTINFO)
+29 if (EVNTINFO="")
SET EVNTINFO="^TMP(""YSGAF"","_$JOB_",""EVNTINFO"")"
+30 ;
+31 NEW GLOREF,YSOK,RETURN
+32 ;; Check for supported event
+33 if ("A08"'[EVNTYP)
QUIT "-1^Event type not supported"
+34 ;
+35 ;; Initialize transmission global
+36 SET GLOREF="^TMP(""HLS"","_$JOB_")"
+37 KILL @GLOREF
+38 ;
+39 ;; Load EVNTINFO array
+40 SET @EVNTINFO@("DFN")=DFN
+41 SET @EVNTINFO@("EVENT")=EVNTYP
+42 SET @EVNTINFO@("DATE")=EVNTDT
+43 ;
+44 ;; Build and send ADT-Axx message
+45 SET RETURN=$$BLDMSG(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO,GLOREF)
+46 IF (+RETURN>0)
Begin DoDot:1
+47 SET RETURN=$$SNDMSG(EVNTYP,EVNTINFO)
End DoDot:1
+48 ;
+49 DO CLRVAR
+50 QUIT $GET(RETURN)
+51 ;
CLRVAR ; Common point for clearing variables used
+1 KILL @GLOREF,@EVNTINFO@("DFN"),@EVNTINFO@("EVENT"),@EVNTINFO@("DATE")
+2 QUIT
+3 ;
BLDMSG(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO,XMITARRY) ;
+1 ;
+2 NEW HLEID,HL,HLFS,HLECH,HLQ
+3 NEW VAFSTR,LASTLINE,LINESADD
+4 ;
+5 KILL HL
+6 SET XMITARRY=$GET(XMITARRY)
+7 if (XMITARRY="")
SET XMITARRY="^TMP(""HLS"","_$JOB_")"
+8 ;
+9 ;; Check for server protocol
+10 if $GET(@EVNTINFO@("SERVER PROTOCOL"))']""
QUIT "-1^Server Protocol not defined"
+11 IF $GET(@EVNTINFO@("SERVER PROTOCOL"))]""
Begin DoDot:1
+12 DO INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)
End DoDot:1
+13 if ($ORDER(HL(""))="")
QUIT "-1^Unable to initialize HL7 variables"
+14 ;
+15 ;; Build EVN segment
+16 NEW VAFEVN,VAFSTR
+17 SET VAFSTR="1,2,4"
+18 SET VAFEVN=$$EN^VAFHLEVN(EVNTYP,EVNTDT,VAFSTR,HL("Q"),HL("FS"))
+19 SET $PIECE(VAFEVN,HL("FS"),2)=EVNTYP
+20 SET $PIECE(VAFEVN,HL("FS"),4)=$SELECT($GET(@EVNTINFO@("REASON"))]"":$GET(@EVNTINFO@("REASON")),1:HL("Q"))
+21 ;; Add EVN segment to transmission array
+22 SET LASTLINE=1+$GET(LASTLINE)
+23 SET @XMITARRY@(LASTLINE)=VAFEVN
+24 ;
+25 ;; Build PID segment
+26 NEW VAFPID
+27 SET VAFSTR="1,2,3,4,5,6,7,8,10N,11,12,13,14,16,17,19,22"
+28 SET VAFPID=$$EN^VAFHLPID(DFN,VAFSTR)
+29 SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFPID(""),-1)
+30 MERGE @XMITARRY@(LASTLINE)=VAFPID
+31 ;
+32 ;; Build OBX segment
+33 NEW VAFOBX,OBX1
+34 SET VAFSTR="1,2,3,4,5,11,14,16"
+35 ;
+36 ;; Set Observation Identifier if not already set
+37 SET @OBXINFO@(3)=$GET(@OBXINFO@(3))
+38 if (@OBXINFO@(3)="")
SET @OBXINFO@(3)="GAF~Global Assessment of Function~AXIS 5"
+39 ;; Set Observation Result status to default if not passed in
+40 SET @OBXINFO@(11)=$GET(@OBXINFO@(11))
+41 if (@OBXINFO@(11)="")
SET @OBXINFO@(11)="F"
+42 ;
+43 ;; Set Value type to defualt if not passed in
+44 SET @OBXINFO@(2)=$GET(@OBXINFO@(2))
+45 if (@OBXINFO@(2)="")
SET @OBXINFO@(2)="ST"
+46 ;
+47 MERGE OBX1=@OBXINFO
+48 SET VAFOBX=$$EN^VAFHLOBX(.OBX1,,VAFSTR)
+49 SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFOBX(""),-1)
+50 MERGE @XMITARRY@(LASTLINE)=VAFOBX
+51 ;
+52 QUIT LASTLINE_"^"_LINESADD
+53 ;
SNDMSG(EVNTYP,EVNTINFO,XMITARRY) ; Send ADT HL7 message
+1 ;
+2 NEW ARRY4HL7,KILLARRY,HL,HLP,HLRESLT
+3 SET XMITARRY=$GET(XMITARRY)
+4 if (XMITARRY="")
SET XMITARRY="^TMP(""HLS"","_$JOB_")"
+5 if ($ORDER(@XMITARRY@(""))="")
QUIT "-1^Can not send empty message"
+6 ;
+7 KILL HL
+8 SET ARRY4HL7="^TMP(""HLS"","_$JOB_")"
+9 ;
+10 ;; If server is not specified then quit with error
+11 if $GET(@EVNTINFO@("SERVER PROTOCOL"))']""
QUIT "-1^Server Protocol not defined"
+12 ;
+13 ;; Initialize HL7 variables
+14 IF $GET(@EVNTINFO@("SERVER PROTOCOL"))]""
Begin DoDot:1
+15 DO INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)
End DoDot:1
+16 if ($ORDER(HL(""))="")
QUIT "-1^Unable to initialize HL7 variables"
+17 ;
+18 ;; Check if XMITARRY is ^TMP("HLS",$J)
+19 SET KILLARRY=0
+20 IF (XMITARRY'=ARRY4HL7)
Begin DoDot:1
+21 ;;Make sure '$J' wasn't used
+22 if (XMITARRY="TMP(""HLS"",$J)")
QUIT
+23 KILL @ARRY4HL7
+24 MERGE @ARRY4HL7=@XMITARRY
+25 SET KILLARRY=1
End DoDot:1
+26 ;
+27 ;; Broadcast message
+28 DO GENERATE^HLMA(@EVNTINFO@("SERVER PROTOCOL"),"GM",1,.HLRESLT,"",.HLP)
+29 if ('HLRESLT)
SET HLRESLT=$PIECE(HLRESLT,"^",2,3)
+30 ;
+31 ;; Delete ^TMP("HLS",$J) if XMITARRY was different
+32 if (KILLARRY)
KILL @ARRY4HL7
+33 ;
+34 QUIT $GET(HLRESLT)
