source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIEVT.m@ 1005

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

initial load of WorldVistAEHR

File size: 7.5 KB
Line 
1GMRCIEVT ;SLC/JFR - process events and build HL7 message; 1/27/03 09:23
2 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31**;DEC 27, 1997
3 ;
4 Q ;don't start at the top
5TRIGR(IEN,ACTN) ;determine what action was taken on IFC and call event point
6 ;Input:
7 ; IEN = consult number from file 123
8 ; ACT = ien in 40 multiple corresponding to activity
9 ;
10 N ACTYPE
11 S ACTYPE=$P(^GMR(123,IEN,40,ACTN,0),U,2)
12 I 'ACTYPE Q
13 I ACTYPE=26 Q ;don't send admin corrections yet...
14 ;
15 ; check bkgrd job and run if overdue
16 I '$D(ZTQUEUED),$$GONOGO^GMRCIBKG D
17 . N ZTQUEUED S ZTQUEUED=1 D EN^GMRCIBKG ;remove ZTQUEUED?
18 ;
19 I $O(^GMR(123.6,"AC",IEN,ACTN),-1) D Q ;earlier pending activities
20 . I ACTYPE=22 Q ; not a trigger or not done here
21 . I ACTYPE=6 N GMRCQT D I $D(GMRCQT) Q
22 .. ;complete all transactions if IFC DC'd before request ever sent
23 .. I $O(^GMR(123.6,"AC",IEN,ACTN),-1)'=1 Q ;new request already sent
24 .. S GMRCQT=1
25 .. N DA,DIE,DR,GMRCACTS
26 .. S GMRCACTS=0
27 .. F S GMRCACTS=$O(^GMR(123.6,"AC",IEN,GMRCACTS)) Q:'GMRCACTS D
28 ... S DIE="^GMR(123.6,",DA=$O(^GMR(123.6,"AC",IEN,GMRCACTS,1,0))
29 ... S DR=".06///@" D ^DIE
30 . D LOGMSG^GMRCIUTL(IEN,ACTN,"",902) ;msg log entry but no msg sent
31 I ACTYPE=2!(ACTYPE=1) D NW(IEN) Q ;send new order
32 I ACTYPE=9!(ACTYPE=14) D RSLT(IEN,ACTN) Q ;inc report or add'l notes
33 I ACTYPE=10,$P(^GMR(123,IEN,40,ACTN,0),U,9) D RSLT(IEN,ACTN) Q ;comp
34 I ACTYPE=12 D RSLT(IEN,ACTN) Q ;dis-associate result
35 I ACTYPE=11 D RESUB^GMRCIEV1(IEN,ACTN) Q ;ed/resubmit
36 I ACTYPE=13 D RSLT(IEN,ACTN) Q ; addendum added
37 I ACTYPE=4 D SF^GMRCIEV1(IEN,ACTN) Q ; sig finding update
38 I ACTYPE=22 Q ;printed to is not a trigger
39 I ACTYPE=17 D FWD^GMRCIEV1(IEN,ACTN) Q ; forward
40 I ACTYPE=25 D FWD2IFC^GMRCIEV1(IEN,ACTN) Q ; FWD into an IFC service
41 D GENUPD(IEN,ACTN) ;all other updates
42 Q
43NW(GMRCDA) ;build new order message for IFC
44 ; Input:
45 ; GMRCDA = ien from file 123
46 ;
47 N HL,HLL,SEG,GMRC773,GMRCIQT
48 S SEG=1
49 K ^TMP("HLS",$J)
50 D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
51 I $G(HL) D Q ; if HL array can't be built, log it with an error
52 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
53 D I $D(GMRCIQT) D NOMPI(GMRCDA,1) Q ;build PID seg if not a local ICN
54 . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
55 . I '$G(GMRCDFN) S GMRCIQT=1 Q
56 . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
57 . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
58 . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
59 . S SEG=SEG+1
60 . Q
61 S ^TMP("HLS",$J,SEG)=$$NWORC^GMRCISG1(GMRCDA) ; get ORC for new ord
62 S SEG=SEG+1
63 S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA) ;get OBR segment
64 S SEG=SEG+1
65 D ;build reason for request into OBX segment(s)
66 . K ^TMP("GMRCRFR",$J)
67 . D OBXWP^GMRCISEG(GMRCDA,"NW",1,$NA(^TMP("GMRCRFR",$J)))
68 . I '$D(^TMP("GMRCRFR",$J)) Q
69 . N I S I=0
70 . F S I=$O(^TMP("GMRCRFR",$J,I)) Q:'I D
71 .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCRFR",$J,I)
72 .. S SEG=SEG+1
73 . K ^TMP("GMRCRFR",$J)
74 . Q
75 S ^TMP("HLS",$J,SEG)=$$OBXPD^GMRCISG1(GMRCDA) ; build prov DX in OBX
76 S SEG=SEG+1
77 S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always send local time zone
78 S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
79 . D LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
80 D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
81 N ERR S ERR=$S($P(GMRC773,U,2):904,1:"")
82 D LOGMSG^GMRCIUTL(GMRCDA,1,+GMRC773,ERR)
83 Q
84 ;
85GENUPD(GMRCDA,GMRCACT) ;build msg and send upon REC, SC or ADD CMT event
86 N HL,HLL,SEG,GMRC773,GMRCIQT
87 S SEG=1
88 K ^TMP("HLS",$J)
89 D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
90 I $G(HL) D Q ; if HL array can't be built, log it with an error
91 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
92 D I $D(GMRCIQT) D NOMPI(GMRCDA,GMRCACT) Q ;build PID seg if nat'l ICN
93 . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
94 . I '$G(GMRCDFN) S GMRCIQT=1 Q
95 . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
96 . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
97 . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
98 . S SEG=SEG+1
99 . Q
100 D ;build ORC seg based on GMRCACT
101 . N ACTVT,OC,OS
102 . S ACTVT=$P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2) ; get activity
103 . ;set order control for ORC seg:
104 . ; v-- IP=cmt RE=adm comp OD=DC OC=cancel SC=sch or receive
105 . S OC=$S(ACTVT=20:"IP",ACTVT=10:"RE",ACTVT=6:"OD",ACTVT=19:"OC",1:"SC")
106 . ;set order status for ORC seg:
107 . ; v-- SC=sch RE=adm comp DC=DC CA=cancel IP=cmt or receive
108 . S OS=$S(ACTVT=8:"SC",ACTVT=10:"CM",ACTVT=6:"DC",ACTVT=19:"CA",1:"IP")
109 . S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,OC,OS,GMRCACT)
110 . S SEG=SEG+1
111 . Q
112 I $L($P(^GMR(123,GMRCDA,0),U,19)) D ;send sig findings
113 . S ^TMP("HLS",$J,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
114 . S SEG=SEG+1
115 I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up a comment if there
116 . N I
117 . K ^TMP("GMRCMT",$J)
118 . I $P(^TMP("HLS",$J,SEG-1),"|",2)'["O" D
119 .. D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
120 . I $P(^TMP("HLS",$J,SEG-1),"|",2)["O" D
121 .. N GMRCMT
122 .. D NTE^GMRCISEG(GMRCDA,GMRCACT,.GMRCMT)
123 .. I $D(GMRCMT) M ^TMP("GMRCMT",$J)=GMRCMT
124 . Q:'$O(^TMP("GMRCMT",$J,0))
125 . S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
126 .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
127 .. S SEG=SEG+1
128 . K ^TMP("GMRCMT",$J)
129 . Q
130 S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
131 S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
132 . D LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
133 D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
134 N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
135 D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
136 Q
137 ;
138RSLT(GMRCDA,GMRCACT) ;attach or dis-associate results and update
139 N HL,HLL,SEG,GMRC773,GMRCIQT
140 S SEG=1
141 K ^TMP("HLS",$J)
142 D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
143 I $G(HL) D Q ; if HL array can't be built, log it with an error
144 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
145 D I $D(GMRCIQT) D NOMPI(GMRCDA,GMRCACT) Q ;build PID seg if nat'l ICN
146 . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
147 . I '$G(GMRCDFN) S GMRCIQT=1 Q
148 . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
149 . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
150 . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
151 . S SEG=SEG+1
152 . Q
153 D ;build ORC seg based on GMRCACT
154 . N ACTVT,OC,OS
155 . S ACTVT=$P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2) ; get activity
156 . S OC="RE"
157 . S OS=$S(ACTVT=9:"A",ACTVT=12:"IP",1:"CM") ; A=part res CM=comp IP=dis
158 . S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,OC,OS,GMRCACT)
159 . S SEG=SEG+1
160 I $P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2)'=99 D
161 . S ^TMP("HLS",$J,SEG)=$$OBXRSLT^GMRCISEG(GMRCDA,GMRCACT)
162 . S SEG=SEG+1
163 S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
164 S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
165 . D LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
166 D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
167 N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
168 D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
169 Q
170 ;
171NOMPI(GMRCIEN,GMRCACTV) ;process MPI exception
172 N GMRCDFN
173 S GMRCDFN=$P(^GMR(123,GMRCIEN,0),U,2)
174 D PTMPIER^GMRCIERR(GMRCDFN) ; send msg to local group for ICN problem
175 D LOGMSG^GMRCIUTL(GMRCIEN,GMRCACTV,,202) ;put inc. entry in MSG log
176 Q
177 ;
178ROUTE(GMRCDA) ; determine correct routing for IFC msg
179 ; Input:
180 ; GMRCDA = ien from file 123
181 ;
182 ; Output:
183 ; the logical link to send the message to in format
184 ; "GMRC IFC SUBSC^VHAHIN"
185 ;
186 N SITE,GMRCLINK,STA
187 S SITE=$P(^GMR(123,GMRCDA,0),U,23) I 'SITE Q "" ;no ROUTING FACILITY
188 S STA=$$STA^XUAF4(SITE)
189 I '$L(STA) Q "" ;can't find station num for that site
190 D LINK^HLUTIL3(STA,.GMRCLINK,"I")
191 S GMRCLINK=$O(GMRCLINK(0)) I 'GMRCLINK Q "" ; no link for that site
192 S GMRCLINK=GMRCLINK(GMRCLINK) I '$L(GMRCLINK) Q "" ;no link name
193 Q "GMRC IFC SUBSC^"_GMRCLINK
Note: See TracBrowser for help on using the repository browser.