source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSGAFHL7.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1YSGAFHL7 ;ALB/SCK-HL7 MENTAL HEALTH ROUTINES ;8/10/98
2 ;;5.01;MENTAL HEALTH;**43,81**;Dec 30, 1994
3 ;
4 Q
5EN(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO) ; Main entry point Mental Health ADT message builder
6 ;
7 ; Input
8 ; DFN - Pointer to entry in PATIENT file (#2) to build message for
9 ; EVNTYP - HL7 ADT event to build message for (Defaults to A08)
10 ; Currently only A08 supported
11 ; EVNTDT - Date/Time event occurred in FIleMAn format
12 ; OBXINFO - Array containing the Observation information
13 ; OBXINFO(seq number)=Field value
14 ; EVNTINFO - Array containing further event information needed
15 ; when building HL7 segments/message. Defaults to
16 ; ^TMP("YSGAF",$J,"EVNTINFO")
17 ; Current subscripts include:
18 ; EVNTINFO("REASON",X) = Reason Code
19 ; EVNTINFO("SERVER PROTOCOL")= Server Protocol
20 ;
21 ; Output : Message ID - ADT=Axx message ID
22 ; ErrorCode^ErrorText - Error generating ADT-Axx message
23 ;
24 ;
25 ;; Check Input
26 S DFN=+$G(DFN)
27 Q:('$D(^DPT(DFN,0))) "-1^Could not find entry in PATIENT file"
28 S EVNTYP=$G(EVNTYP)
29 S:(EVNTYP="") EVNTYP="A08"
30 S EVNTDT=+$G(EVNTDT)
31 S:('EVNTDT) EVNTDT=$$NOW^XLFDT
32 Q:($O(@OBXINFO@(""))="") "-1^There was no Observation data to send"
33 S EVNTINFO=$G(EVNTINFO)
34 S:(EVNTINFO="") EVNTINFO="^TMP(""YSGAF"","_$J_",""EVNTINFO"")"
35 ;
36 N GLOREF,YSOK,RETURN
37 ;; Check for supported event
38 Q:("A08"'[EVNTYP) "-1^Event type not supported"
39 ;
40 ;; Initialize transmission global
41 S GLOREF="^TMP(""HLS"","_$J_")"
42 K @GLOREF
43 ;
44 ;; Load EVNTINFO array
45 S @EVNTINFO@("DFN")=DFN
46 S @EVNTINFO@("EVENT")=EVNTYP
47 S @EVNTINFO@("DATE")=EVNTDT
48 ;
49 ;; Build and send ADT-Axx message
50 S RETURN=$$BLDMSG(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO,GLOREF)
51 I (+RETURN>0) D
52 . S RETURN=$$SNDMSG(EVNTYP,EVNTINFO)
53 ;
54 D CLRVAR
55 Q $G(RETURN)
56 ;
57CLRVAR ; Common point for clearing variables used
58 K @GLOREF,@EVNTINFO@("DFN"),@EVNTINFO@("EVENT"),@EVNTINFO@("DATE")
59 Q
60 ;
61BLDMSG(DFN,EVNTYP,EVNTDT,OBXINFO,EVNTINFO,XMITARRY) ;
62 ;
63 N HLEID,HL,HLFS,HLECH,HLQ
64 N VAFSTR,LASTLINE,LINESADD
65 ;
66 K HL
67 S XMITARRY=$G(XMITARRY)
68 S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"
69 ;
70 ;; Check for server protocol
71 Q:$G(@EVNTINFO@("SERVER PROTOCOL"))']"" "-1^Server Protocol not defined"
72 I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" D
73 . D INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)
74 Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
75 ;
76 ;; Build EVN segment
77 N VAFEVN,VAFSTR
78 S VAFSTR="1,2,4"
79 S VAFEVN=$$EN^VAFHLEVN(EVNTYP,EVNTDT,VAFSTR,HL("Q"),HL("FS"))
80 S $P(VAFEVN,HL("FS"),2)=EVNTYP
81 S $P(VAFEVN,HL("FS"),4)=$S($G(@EVNTINFO@("REASON"))]"":$G(@EVNTINFO@("REASON")),1:HL("Q"))
82 ;; Add EVN segment to transmission array
83 S LASTLINE=1+$G(LASTLINE)
84 S @XMITARRY@(LASTLINE)=VAFEVN
85 ;
86 ;; Build PID segment
87 N VAFPID
88 S VAFSTR="1,2,3,4,5,6,7,8,10N,11,12,13,14,16,17,19,22"
89 S VAFPID=$$EN^VAFHLPID(DFN,VAFSTR)
90 S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPID(""),-1)
91 M @XMITARRY@(LASTLINE)=VAFPID
92 ;
93 ;; Build OBX segment
94 N VAFOBX,OBX1
95 S VAFSTR="1,2,3,4,5,11,14,16"
96 ;
97 ;; Set Observation Identifier if not already set
98 S @OBXINFO@(3)=$G(@OBXINFO@(3))
99 S:(@OBXINFO@(3)="") @OBXINFO@(3)="GAF~Global Assessment of Function~AXIS 5"
100 ;; Set Observation Result status to default if not passed in
101 S @OBXINFO@(11)=$G(@OBXINFO@(11))
102 S:(@OBXINFO@(11)="") @OBXINFO@(11)="F"
103 ;
104 ;; Set Value type to defualt if not passed in
105 S @OBXINFO@(2)=$G(@OBXINFO@(2))
106 S:(@OBXINFO@(2)="") @OBXINFO@(2)="ST"
107 ;
108 M OBX1=@OBXINFO
109 S VAFOBX=$$EN^VAFHLOBX(.OBX1,,VAFSTR)
110 S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFOBX(""),-1)
111 M @XMITARRY@(LASTLINE)=VAFOBX
112 ;
113 Q LASTLINE_"^"_LINESADD
114 ;
115SNDMSG(EVNTYP,EVNTINFO,XMITARRY) ; Send ADT HL7 message
116 ;
117 N ARRY4HL7,KILLARRY,HL,HLP,HLRESLT
118 S XMITARRY=$G(XMITARRY)
119 S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"
120 Q:($O(@XMITARRY@(""))="") "-1^Can not send empty message"
121 ;
122 K HL
123 S ARRY4HL7="^TMP(""HLS"","_$J_")"
124 ;
125 ;; If server is not specified then quit with error
126 Q:$G(@EVNTINFO@("SERVER PROTOCOL"))']"" "-1^Server Protocol not defined"
127 ;
128 ;; Initialize HL7 variables
129 I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" D
130 . D INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)
131 Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
132 ;
133 ;; Check if XMITARRY is ^TMP("HLS",$J)
134 S KILLARRY=0
135 I (XMITARRY'=ARRY4HL7) D
136 . ;;Make sure '$J' wasn't used
137 . Q:(XMITARRY="TMP(""HLS"",$J)")
138 . K @ARRY4HL7
139 . M @ARRY4HL7=@XMITARRY
140 . S KILLARRY=1
141 ;
142 ;; Broadcast message
143 D GENERATE^HLMA(@EVNTINFO@("SERVER PROTOCOL"),"GM",1,.HLRESLT,"",.HLP)
144 S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
145 ;
146 ;; Delete ^TMP("HLS",$J) if XMITARRY was different
147 K:(KILLARRY) @ARRY4HL7
148 ;
149 Q $G(HLRESLT)
Note: See TracBrowser for help on using the repository browser.