source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIEV1.m@ 846

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

initial load of WorldVistAEHR
File size: 5.6 KB
RevLine 
[613]1GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ;01/27/03 09:28
2 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31**;DEC 27, 1997
3 Q ;no-no-no
4RESUB(GMRCDA,GMRCACT) ;build HL7 msg with edits from resubit
5 ;Input:
6 ; GMRCDA = ien from file 123
7 ; GMRCACT = ien of the activity from 40 multiple
8 ;
9 N HL,HLL,SEG,GMRC773,GMRCIQT
10 S SEG=1
11 K ^TMP("HLS",$J)
12 D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
13 I $G(HL) D Q ; if HL array can't be built, log it with an error
14 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
15 D I $D(GMRCIQT) D NOMPI^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
16 . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
17 . I '$G(GMRCDFN) S GMRCIQT=1 Q
18 . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
19 . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
20 . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
21 . S SEG=SEG+1
22 . Q
23 ;
24 ;build ORC seg based on GMRCACT
25 S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"XO","IP",GMRCACT)
26 S SEG=SEG+1
27 ;
28 ; include Inpatient or Outpatient
29 S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
30 S SEG=SEG+1
31 ;
32 D ;load up reason for request
33 . K ^TMP("GMRCRFR",$J)
34 . D OBXWP^GMRCISEG(GMRCDA,"XO",GMRCACT,$NA(^TMP("GMRCRFR",$J)))
35 . I '$D(^TMP("GMRCRFR",$J)) Q
36 . N I S I=0
37 . F S I=$O(^TMP("GMRCRFR",$J,I)) Q:'I D
38 .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCRFR",$J,I)
39 .. S SEG=SEG+1
40 . K ^TMP("GMRCRFR",$J)
41 . Q
42 D ;prov DX changed, send it
43 . S ^TMP("HLS",$J,SEG)=$$OBXPD^GMRCISG1(GMRCDA)
44 . S SEG=SEG+1
45 ;
46 D ;send ed-res comment and file as is
47 . N I
48 . K ^TMP("GMRCMT",$J)
49 . D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
50 . Q:'$O(^TMP("GMRCMT",$J,0))
51 . S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
52 .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
53 .. S SEG=SEG+1
54 . K ^TMP("GMRCMT",$J)
55 . Q
56 S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
57 S HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
58 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
59 D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
60 N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
61 D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
62 Q
63 ;
64SF(GMRCDA,GMRCACT) ;send SIG FINDING update
65 ;Input:
66 ; GMRCDA = ien from file 123
67 ; GMRCACT = ien of the activity from 40 multiple
68 N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS
69 S SEG=1
70 K ^TMP("HLS",$J)
71 D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
72 I $G(HL) D Q ; if HL array can't be built, log it with an error
73 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
74 D I $D(GMRCIQT) D NOMPI^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
75 . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
76 . I '$G(GMRCDFN) S GMRCIQT=1 Q
77 . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
78 . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
79 . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
80 . S SEG=SEG+1
81 . Q
82 ;
83 ;build ORC seg based on GMRCACT
84 S GMRCOS=$S($P(^GMR(123,GMRCDA,0),U,12)="2":"CM",1:"IP")
85 S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"RE","CM",GMRCACT)
86 S SEG=SEG+1
87 I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up comment to send
88 . K ^TMP("GMRCMT",$J)
89 . D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
90 . Q:'$O(^TMP("GMRCMT",$J,0))
91 . N I S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
92 .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
93 .. S SEG=SEG+1
94 . K ^TMP("GMRCMT",$J)
95 . Q
96 S ^TMP("HLS",$J,SEG)=$$OBXSF^GMRCISEG(GMRCDA),SEG=SEG+1
97 S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
98 S HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
99 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
100 D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
101 N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
102 D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
103 Q
104 ;
105FWD(GMRCDA,GMRCACT) ;bld HL7 msg upon FWD action
106 ;Input:
107 ; GMRCDA = ien from file 123
108 ; GMRCACT = ien of the activity from 40 multiple
109 N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS
110 S SEG=1
111 K ^TMP("HLS",$J)
112 D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
113 I $G(HL) D Q ; if HL array can't be built, log it with an error
114 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
115 D I $D(GMRCIQT) D NOMPI^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
116 . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
117 . I '$G(GMRCDFN) S GMRCIQT=1 Q
118 . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
119 . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
120 . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
121 . S SEG=SEG+1
122 . Q
123 ;
124 ;build ORC seg based on GMRCACT
125 S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"XX","IP",GMRCACT)
126 S SEG=SEG+1
127 S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT),SEG=SEG+1
128 I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up comment to send
129 . K ^TMP("GMRCMT",$J)
130 . D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
131 . Q:'$O(^TMP("GMRCMT",$J,0))
132 . N I S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
133 .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
134 .. S SEG=SEG+1
135 . K ^TMP("GMRCMT",$J)
136 . Q
137 S ^TMP("HLS",$J,SEG)=$$OBXSF^GMRCISEG(GMRCDA),SEG=SEG+1
138 S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
139 S HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
140 . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
141 D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
142 N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
143 D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
144 Q
145 ;
146FWD2IFC(GMRCDA,GMRCACT) ;pkg up and send request upon fwd'ing into IFC serv
147 ;Input:
148 ; GMRCDA = ien from file 123
149 ; GMRCACT = ien of the activity from 40 multiple
150 N GMRCACTN
151 I '$P(^GMR(123,GMRCDA,0),U,22),'$D(^GMR(123.6,"C",GMRCDA)) D Q
152 . D NW^GMRCIEVT(GMRCDA)
153 . S GMRCACTN=1
154 . F S GMRCACTN=$O(^GMR(123,GMRCDA,40,GMRCACTN)) Q:'GMRCACTN D
155 .. D TRIGR^GMRCIEVT(GMRCDA,GMRCACTN)
156 D FWD(GMRCDA,GMRCACT)
157 Q
Note: See TracBrowser for help on using the repository browser.