source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIAC1.m@ 1487

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1GMRCIAC1 ;SLC/JFR - FILE IFC ACTIVITIES cont'd ;2/11/02 16:11
2 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
3 Q
4COMP(GMRCAR) ;process partial result, clin complete and admin complete
5 ;
6 N GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,FDA
7 N GMRCRES,GMRCERR,GMRCSTS,GMRCREAS
8 M ^TMP("GMRCIN",$J)=@GMRCAR
9 S GMRCORC=^TMP("GMRCIN",$J,"ORC")
10 S GMRCREAS=$P($P(GMRCORC,"|",16),U)
11 S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
12 S GMRCSTS=$P(^GMR(123,GMRCDA,0),U,12)
13 I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
14 . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
15 . K ^TMP("GMRCIN",$J) Q
16 ;
17 S GMRCFDA(8)=$S($P(GMRCORC,"|",5)="CM":2,GMRCSTS=2:2,1:9) ;comp or pr
18 S GMRCLAT=$S($P(GMRCORC,"|",5)="A":9,GMRCREAS="A":13,1:10)
19 S GMRCFDA(9)=GMRCLAT ;complete/upd or incomplete rpt
20 I $D(^TMP("GMRCIN",$J,"OBX",6,1)) D
21 . S GMRCFDA(15)=$P(^TMP("GMRCIN",$J,"OBX",6,1),"|",5)
22 ; v-- check to see if a duplicate transmission
23 I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC,$S(GMRCLAT=13:"",1:$G(^TMP("GMRCIN",$J,"OBX",4,1)))) Q
24 M FDA(1,123,GMRCDA_",")=GMRCFDA
25 D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and status
26 ; check GMRCERR and act if error
27 K GMRCERR
28 K GMRCFDA,FDA
29 D FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NA(^TMP("GMRCIN",$J)))
30 ; ^--- file result and activities
31 I $D(^TMP("GMRCIN",$J,"OBX",4,1)) D ;file result if there
32 . I GMRCLAT=13 Q ; addendum carries the result that it's addending
33 . I GMRCLAT=9 Q ; don't file result on inc. report
34 . I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;no comp coming from placer
35 . D FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCIN",$J,"OBX",4,1))
36 D ;send notifications
37 . I GMRCLAT=9 Q
38 . I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;filler only gets historical comp
39 . N GMRCORTX S GMRCORTX=""
40 . I $O(^GMR(123,GMRCDA,51," "),-1)>1 D
41 .. S GMRCORTX="New remote result added to "
42 . I GMRCLAT=13 S GMRCORTX="Addendum added to "
43 . S GMRCORTX=GMRCORTX_"Remote Complete Consult: "_$$ORTX^GMRCAU(+GMRCDA)
44 . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,23,,1)
45 D ;send appl ACK
46 . D APPACK^GMRCIAC2(GMRCDA,"AA")
47 ;
48 K ^TMP("GMRCIN",$J)
49 Q
50 ;
51FWD(GMRCAR) ;file forward action from a remote site
52 ;Input:
53 ; GMRCAR = array name containing message
54 ; e.g. ^TMP("GMRCIF",$J)
55 ;
56 N GMRCFDA,GMRCDA,GMRCFWSR,GMRCFROM,GMRCORC,GMRCTIFC,GMRCLAC,GMRCROL
57 M ^TMP("GMRCIN",$J)=@GMRCAR
58 I '$D(^TMP("GMRCIN",$J,"OBR")) Q
59 S GMRCORC=^TMP("GMRCIN",$J,"ORC")
60 S GMRCTIFC=$S($P($P(GMRCORC,"|",16),U)="F":0,1:1)
61 S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
62 I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
63 . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
64 . K ^TMP("GMRCIN",$J) Q
65 S GMRCROL=$P(^GMR(123,GMRCDA,12),U,5)
66 I 'GMRCTIFC D
67 . S GMRCFDA(9)=17,GMRCLAC=17
68 . I GMRCROL="F" D Q
69 .. S GMRCFROM=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
70 . S GMRCFDA(.131)=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
71 . S GMRCFROM=$P($G(^GMR(123,GMRCDA,13)),U)
72 I GMRCTIFC D
73 . S GMRCFROM=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
74 . S GMRCFDA(9)=25,GMRCLAC=25
75 ;
76 S GMRCFDA(8)=5
77 D ;get urgency to file
78 . N URG
79 . S URG=$$URG^GMRCHL7A($P($P(^TMP("GMRCIN",$J,"ORC"),"|",7),U,6))
80 . S GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
81 ; v-- chk to see if activity is a dup transmission
82 I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAC,GMRCORC) Q
83 ;
84 M FDA(1,123,GMRCDA_",")=GMRCFDA
85 D UPDATE^DIE("","FDA(1)",,"GMRCERR")
86 K GMRCFDA
87 ;
88 ; file activity tracking
89 D FILEACT^GMRCIAC2(GMRCDA,GMRCLAC,GMRCFROM,$NA(^TMP("GMRCIN",$J)))
90 ;
91 ; send alerts
92 I GMRCROL="F" D
93 . I GMRCLAC'=25 Q ; filler alerts only on FWD 2 IFC
94 . N GMRCTX
95 . S GMRCTX="New remote Consult: "_$$ORTX^GMRCAU(GMRCDA)
96 . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,27,,1)
97 . Q
98 I GMRCROL="P" D
99 . N GMRCTX
100 . S GMRCTX="Updated Remote Consult: "_$$ORTX^GMRCAU(GMRCDA)
101 . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,63,,1)
102 . Q
103 ;
104 ; print if FWD to IFC
105 I GMRCROL="F" D
106 . I GMRCLAC'=25 Q
107 . D PRNT^GMRCUTL1("",GMRCDA)
108 ;
109 D ;send app. ACK and unlock record
110 . D APPACK^GMRCIAC2(GMRCDA,"AA")
111 K ^TMP("GMRCIN",$J)
112 Q
113 ;
114SF(GMRCAR) ;add significant findings
115 ; Input:
116 ; GMRCAR = array name containing message
117 ; e.g. ^TMP("GMRCIF",$J)
118 ;
119 N FDA,GMRCERR,GMRCOSF,GMRCISF
120 M ^TMP("GMRCIS",$J)=@GMRCAR
121 I '$D(^TMP("GMRCIS",$J,"OBX",6,1)) Q ;no SF flag sent ;-(
122 S GMRCDA=$$GETDA^GMRCIAC2(^TMP("GMRCIS",$J,"ORC"))
123 I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
124 . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
125 . K ^TMP("GMRCIN",$J) Q
126 ;
127 S GMRCOSF=$P(^GMR(123,GMRCDA,0),U,19)
128 S GMRCISF=$P(^TMP("GMRCIS",$J,"OBX",6,1),"|",5)
129 S FDA(1,123,GMRCDA_",",15)=GMRCISF
130 S FDA(1,123,GMRCDA_",",9)=4
131 ; v-- quit if a duplicate activity
132 I $$DUPACT^GMRCIAC2(GMRCDA,4,^TMP("GMRCIS",$J,"ORC")) Q
133 ;
134 D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and SF
135 D FILEACT^GMRCIAC2(GMRCDA,4,,$NA(^TMP("GMRCIS",$J))) ;activity track
136 D ;send notifications
137 . I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;filler only gets hist. SF
138 . N GMRCORTX
139 . S GMRCORTX=$S(GMRCISF="N":"No ",GMRCISF="Y":"",1:"Unknown ")
140 . S GMRCORTX=GMRCORTX_"Sig Findings for "_$$ORTX^GMRCAU(+GMRCDA)
141 . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,23,,1)
142 D ;send appl ACK and unlock record
143 . D APPACK^GMRCIAC2(GMRCDA,"AA")
144 K ^TMP("GMRCIS",$J)
145 Q
146 ;
147RESUB(GMRCAR) ;resubmit a cancelled, remote consult
148 ; Input:
149 ; GMRCAR - array name containing message
150 ; e.g. ^TMP("GMRCIF",$J)
151 ;
152 K ^TMP("GMRCIN",$J)
153 M ^TMP("GMRCIN",$J)=@GMRCAR
154 N GMRCDA,GMRCFDA,FDA
155 S GMRCDA=$$GETDA^GMRCIAC2(^TMP("GMRCIN",$J,"ORC"))
156 I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
157 . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ; send app. ACK
158 . K ^TMP("GMRCIN",$J) Q
159 ;
160 S GMRCFDA(8)=5,GMRCFDA(9)=11 ;status and last action
161 ;
162 I $D(^TMP("GMRCIN",$J,"OBR")) D ; has INPATIENT or OUTPATIENT changed?
163 . N GMRCION
164 . S GMRCION=$P(^TMP("GMRCIN",$J,"OBR"),"|",18)
165 . I GMRCION'=$P(^GMR(123,GMRCDA,0),U,18) S GMRCFDA(14)=GMRCION
166 . Q
167 D ; check for change in urgency
168 . N GMRCURG
169 . S GMRCURG=$P($P(^TMP("GMRCIN",$J,"ORC"),"|",7),U,6)
170 . I '$L(GMRCURG) Q
171 . S GMRCURG=$$URG^GMRCHL7A(GMRCURG)
172 . S GMRCURG=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_GMRCURG)
173 . I GMRCURG'>1 Q
174 . I GMRCURG=$P(^GMR(123,GMRCDA,0),U,9) Q ;no change
175 . S GMRCFDA(5)=GMRCURG
176 . Q
177 I $D(^TMP("GMRCIN",$J,"OBX",2)) D ; change in Prov. DX?
178 . N PROVDX
179 . S PROVDX=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,2)
180 . I '$L(PROVDX) Q
181 . I PROVDX=$G(^GMR(123,GMRCDA,30)) Q ; no change
182 . S GMRCFDA(30)=PROVDX
183 . S GMRCFDA(30.1)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U)
184 . Q
185 ; v-- QUIT if a duplicate transmission
186 I $$DUPACT^GMRCIAC2(GMRCDA,11,^TMP("GMRCIN",$J,"ORC")) Q
187 ;
188 M FDA(1,123,GMRCDA_",")=GMRCFDA
189 D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file edits
190 K GMRCFDA,FDA
191 ;
192 I $D(^TMP("GMRCIN",$J,"OBX",1)) D ; reason for request change?
193 . D TRIMWP^GMRCIUTL($NA(^TMP("GMRCIN",$J,"OBX",1)),5)
194 . N DIFF S DIFF=0
195 . D I 'DIFF Q
196 .. I $O(^TMP("GMRCIN",$J,"OBX",1," "),-1)'=$O(^GMR(123,GMRCDA,20," "),-1) S DIFF=1 Q ; diff # of lines in new and existing
197 .. N LN S LN=0 F S LN=$O(^GMR(123,GMRCDA,20,LN)) Q:'LN!(DIFF) D
198 ... I $G(^GMR(123,GMRCDA,20,LN,0))=$G(^TMP("GMRCIN",$J,"OBX",1,LN)) Q
199 ... S DIFF=1 ;if the lines aren't the same, set DIFF and Q
200 . D WP^DIE(123,GMRCDA_",",20,"K",$NA(^TMP("GMRCIN",$J,"OBX",1)))
201 . Q
202 D ;file activity tracking
203 . D FILEACT^GMRCIAC2(GMRCDA,11,,$NA(^TMP("GMRCIN",$J)))
204 N GMRCNTIF
205 D ;determine if part of a FWD to IFC
206 . I $P(^GMR(123,GMRCDA,40,1,0),U,2)'=24 S GMRCNTIF=1 Q
207 . N ACT S ACT=1
208 . S GMRCNTIF=0
209 . F S ACT=$O(^GMR(123,GMRCDA,40,ACT)) Q:'ACT!($G(GMRCNTIF)) D
210 .. I $P(^GMR(123,GMRCDA,40,ACT,0),U,2)=25,$O(^(40,ACT)) S GMRCNTIF=1
211 ;
212 D ;print SF-513 & send notifications
213 . I '$G(GMRCNTIF) Q ;part of a FWD to IFC
214 . D PRNT^GMRCUTL1("",GMRCDA)
215 . N GMRCORTX
216 . S GMRCORTX="New remotely re-submitted consult "
217 . S GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCDA)
218 . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,27,,1)
219 ;
220 D ;send appl ACK and unlock record
221 . D APPACK^GMRCIAC2(GMRCDA,"AA")
222 ;
223 K ^TMP("GMRCIN",$J)
224 Q
225 ;
Note: See TracBrowser for help on using the repository browser.