source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCTIUE.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 7.7 KB
Line 
1GMRCTIUE ;SLC/DCM,DLT,JFR - Complete/Update TIU notes ;07/10/03 15:26
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,10,14,12,15,17,35**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2410,#2694,#2833,#2699,#2700
5 ;
6 Q
7ENTER(GMRCO) ; Enter a note in TIU for the consult result
8 ;If consult from list is defined in GMRCO, then use it.
9 K GMRCQUT N TIUDA,TIUCLASS,GMRCLCK
10 N GMRCMC
11 I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO)
12 Q:$D(GMRCQUT)!'$L($G(GMRCO))
13 I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D D EDEX Q
14 . N DIR
15 . W !,"The requesting facility may not complete an inter-facility "
16 . W "consult."
17 . S DIR(0)="E" D ^DIR
18 I '$$LOCK^GMRCA1(GMRCO) D EDEX Q
19 S GMRCLCK=1
20 D CHKSTS I $G(GMRCQUT) D EDEX Q
21 I $D(VALM) D FULL^VALM1
22 ;
23 ;Find out access if a Clinical Procedure request
24 N GMRCCP
25 S GMRCCP=$$CPACTM^GMRCCP(+GMRCO)
26 ;
27 ;If service administrative user, then use administrative complete logic
28 N GMRCAU
29 S GMRCAU=$$VALID^GMRCAU($P(^GMR(123,GMRCO,0),U,5))
30 I GMRCAU=3 D Q
31 . I $P(^GMR(123,+GMRCO,0),U,12)'=2,'GMRCCP S GMRCMC=$$MED(GMRCO)
32 . I $G(GMRCMC),$P(^GMR(123,+GMRCO,0),U,12)=2 D EDEX Q
33 . W !,$$CJ^XLFSTR("- Proceeding with Administrative Complete -",80)
34 . D COMP^GMRCAAC(+GMRCO)
35 . D EDEX
36 ;
37 I GMRCAU=4 D I $G(GMRCQIT)=1 D EDEX Q
38 . N DIRUT
39 . I $P(^GMR(123,+GMRCO,0),U,12)'=2,'GMRCCP S GMRCMC=$$MED(GMRCO)
40 . I $G(GMRCMC),$P(^GMR(123,+GMRCO,0),U,12)=2 Q
41 . S DIR(0)="YA",DIR("A")="Administratively complete this request? "
42 . D ^DIR I $D(DIRUT) S GMRCQIT=1 Q
43 . I Y<1 Q
44 . W !,$$CJ^XLFSTR("- Proceeding with Administrative Complete -",80)
45 . D COMP^GMRCAAC(+GMRCO) S GMRCQIT=1
46 . Q
47 ;
48 ;Assume the user is a clinical user
49 I GMRCCP=0 S GMRCMC=$$MED(GMRCO) ;only go med if not a CP
50 ;If a Procedure, allow Medicine or fall through to a note
51 I $G(GMRCMC) D I $G(GMRCQIT)=1 D EDEX Q
52 . N DUOUT,DTOUT,DIROUT,DIRUT,X,Y,DIR
53 . W !
54 . S DIR(0)="YA",DIR("B")="Y",DIR("A")="Continue with Note Entry? "
55 . D ^DIR I Y<1 S GMRCQIT=1
56 . W !
57 . Q
58 ;
59 ;Get list of notes If no new notes, add new then quit
60 S GMRCDFN=$P(^GMR(123,+GMRCO,0),"^",2)
61 I $D(VALM) D FULL^VALM1
62 I '$$GETLIST(GMRCDFN,GMRCO,.GMRCTIUC) D D EDEX Q
63 . I GMRCCP>1,GMRCCP'=4 D CPGUI Q
64 . D NEW
65 ;
66 ;If TIU Document already exists, use single record edit, and quit
67 S GMRCVF="TIU(8925,"
68 I GMRCTIUC(GMRCVF)=1 D Q
69 . I GMRCCP=3 D CPGUI Q ;incomplete CP document, must go to GUI
70 . N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
71 . D SHOWTIU^GMRCTIUL
72 . S DIR(0)="YA",DIR("B")="Yes",DIR("A")="Edit/Review this note? "
73 . D ^DIR I Y>0 D
74 .. S GMRCTUFN=$$SINGLE(GMRCVF)
75 .. I +GMRCTUFN D EDITNOTE(GMRCTUFN)
76 . S DIR(0)="YA"
77 . S DIR("B")="No",DIR("A")="Would you like to enter a new note? "
78 . W ! D ^DIR I Y>0 D NEW
79 . D EDEX
80 . Q
81 ;
82 ;Show the list of multiple tiu results for selection
83 D SHOWTIU^GMRCTIUL
84 ;
85 ;Select a note from the list and then get the TIU internal entry
86 S GMRCSELR=$$SELR^GMRCTIUL(.GMRCTIUC)
87 I $D(GMRCQUT) D EDEX Q
88 I '+(GMRCSELR) D D EDEX Q
89 . ;didn't select existing note, allow a new entry
90 . N DIR,X,Y
91 . S DIR(0)="Y",DIR("A")="Would you like to enter a new note"
92 . S DIR("B")="N" D ^DIR
93 . I Y<1 K DTOUT,DUOUT,X,Y Q
94 . D NEW
95 S GMRCTUFN=$$GETTUFN(GMRCSELR)
96 ;
97 I +GMRCTUFN D EDITNOTE(GMRCTUFN)
98 ;
99 D EDEX
100 Q
101 ;
102MED(GMRCO) ;allow med results if appropriate
103 ;If a Procedure and setu properly, allow Medicine
104 N GMRCMED,GMRCQIT S GMRCMED=0
105 I $P(^GMR(123,+GMRCO,0),U,17)="P" D
106 . Q:'$P(^GMR(123.3,+$P(^GMR(123,+GMRCO,0),U,8),0),U,5)
107 . D FULL^VALM1
108 . N DIR,DIROUT,DTOUT,DUOUT,X,Y
109 . S DIR(0)="YA",DIR("B")="Y"
110 . S DIR("A",1)=" ",DIR("A")="Attach Medicine Results? "
111 . D ^DIR Q:Y<1
112 . K DIR
113 . S GMRCMED=1
114 . D ARMED^GMRCAR
115 Q GMRCMED
116 ;
117SAUSER() ; admin user?
118 N GMRCSS,GMRCADUS
119 S GMRCSS=+$P($G(^GMR(123,+GMRCO,0)),"^",5) Q:'+GMRCSS 0
120 I $D(^GMR(123.5,+$P($G(^GMR(123,+GMRCO,0)),"^",5),123.33,"B",DUZ)) Q 1
121 I '$L($TEXT(VALIDU^GMRCAU)) Q 0
122 S GMRCADUS=0
123 I $L($TEXT(VALIDU^GMRCAU)) D TEAM^GMRCAU(.GMRCADUS,123.34,DUZ)
124 Q +GMRCADUS
125 ;
126CHKSTS ;Check the order status before allowing entry of a note
127 N STATUS S STATUS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
128 I $S(STATUS=1:1,STATUS=13:1,1:0) D
129 . W !,"This order has been "
130 . W $S(STATUS=1:"DISCONTINUED",1:"CANCELLED")
131 . W ". A note cannot be entered."
132 . D PAUSE S GMRCQUT=1
133 Q
134 ;
135EDITNOTE(GMRCTUFN) ;use TIU LM for an existing note
136 I +$D(^TIU(8925,+GMRCTUFN,0)) D Q
137 . D EXSTNOTE^TIUBR1(+GMRCDFN,+GMRCTUFN)
138 ;
139 ; link is missing
140 W !,"A note #"_+GMRCTUFN_" is linked to the consult,"
141 W !," but the note is no longer in TIU!"
142 D PAUSE
143 Q
144 ;
145SINGLE(GMRCVF) ;Get the single result entry from the list for the file type
146 N RSLT,GMRCVP
147 S RSLT="",GMRCVP=0
148 F S RSLT=$O(^TMP("GMRC50",$J,RSLT)) Q:RSLT="" D Q:+GMRCVP
149 . I $P(RSLT,";",2)=GMRCVF S GMRCVP=RSLT
150 Q +GMRCVP
151 ;
152GETTUFN(GMRCSELR) ;Get the result entry from the selected entry
153 N RSLT
154 S RSLT=$O(^TMP("GMRC50R",$J,GMRCSELR,""))
155 Q RSLT
156 ;
157NEW ;Enter a new result through TIU if implemented or old Completion logic
158 S TIUCLASS=+$$CLASS(+$$CPACTM^GMRCCP(+GMRCO))
159 I TIUCLASS'>0 D Q
160 . W !!,$C(7),"Consult Resulting through TIU is not yet implemented."
161 . W !,"Proceeding with Administrative Complete."
162 . D COMP^GMRCAAC(+GMRCO)
163 ;
164 N GMRCTIDA
165 D MAIN^TIUEDIT(TIUCLASS,.GMRCTIDA,GMRCDFN,"","","","",1)
166 ;
167 Q
168 ;
169CLASS(CPSTAT) ; Get TIU doc def for CONSULTS OR clinical procedures
170 N GMRCY,GMRCDTYP,ERR
171 I 'CPSTAT D
172 . S GMRCY=$$FIND1^DIC(8925.1,,"X","CONSULTS","B",,"ERR")
173 I '$D(GMRCY) D
174 . S GMRCY=$$FIND1^DIC(8925.1,,"X","CLINICAL PROCEDURES","B",,"ERR")
175 S GMRCDTYP=$$GET1^DIQ(8925.1,+GMRCY,.04,"I")
176 I +GMRCY>0,$S(GMRCDTYP="CL":0,GMRCDTYP="DC":0,1:1) S GMRCY=0
177 Q GMRCY
178 ;
179GETLIST(GMRCDFN,GMRCO,GMRCLIST) ;
180 ;
181 N GMRCVF
182 ;
183 D GETLIST^GMRCTIUL(GMRCO,2,1,.GMRCTIUC)
184 S GMRCVF="TIU(8925,"
185 Q +$G(GMRCTIUC(GMRCVF))
186 ;
187ADDEND(GMRCO) ; Make an addendum action for a selected consult
188 N TIUDA,GMRCTX,GMRCDFN,GMRCADUZ,RSLTINFO,GMRCACT,GMRCTIUC
189 N GMRCLCK,RSLTIEN
190 K GMRCQUT
191 I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO)
192 Q:$D(GMRCQUT)!'+($G(GMRCO))
193 ;
194 ;If service administrative user, then QUIT.
195 I $$VALID^GMRCAU($P(^GMR(123,+GMRCO,0),U,5))=3 D Q
196 . D EXAC^GMRCADC("You do not have the ability to edit this note.")
197 ;
198 ;Assume the user is a clinical user
199 ;
200 ;Get list of notes for this consult. if no notes, then quit.
201 S GMRCDFN=$P(^GMR(123,+GMRCO,0),"^",2)
202 I '$$GETLIST(GMRCDFN,+GMRCO,.GMRCTIUC) D Q
203 . W !,"This consult does not yet have an associated note."
204 . W !," Use the Complete action to enter a new note."
205 . D PAUSE,EDEX
206 ;
207 I '$$LOCK^GMRCA1(GMRCO) D EDEX Q
208 S GMRCLCK=1
209 ;If TIU Document already exists, use single record edit, and quit
210 S GMRCVF="TIU(8925,"
211 I GMRCTIUC(GMRCVF)=1 D D EDEX Q
212 . S GMRCTUFN=$$SINGLE(GMRCVF)
213 . Q:'+GMRCTUFN
214 . D SHOWTIU^GMRCTIUL
215 . N GMRCVP,RSLTINFO,AUTHOR
216 . S GMRCVP=+GMRCTUFN_";"_GMRCVF
217 . S RSLTIEN=$O(^TMP("GMRC50",$J,GMRCVP,0))
218 . S RSLTINFO=$G(^TMP("GMRC50",$J,GMRCVP,RSLTIEN))
219 . I $P(RSLTINFO,"^",6)="completed" D ADDEND1(+GMRCTUFN) Q
220 . I (DUZ=+$P(RSLTINFO,"^",4)) D EDITNOTE(+GMRCTUFN) Q
221 . W !,"You may not addend to the incomplete associated note."
222 . W !,"You are not the author of the existing note."
223 . I $$READ^GMRCACMT("Y","Do you want to add a new note ","YES") D NEW
224 . Q
225 ;
226 ;Show the list of multiple tiu results for selection
227 D SHOWTIU^GMRCTIUL
228 ;
229 ;Select a note from the list and then get the TIU internal entry
230 S GMRCSELR=$$SELR^GMRCTIUL(.GMRCTIUC)
231 I $D(GMRCQUT)!'+(GMRCSELR) D EDEX Q
232 S GMRCTUFN=$$GETTUFN(GMRCSELR)
233 ;
234 I +GMRCTUFN D ADDEND1(+GMRCTUFN),EDEX Q
235 ;
236 D EDEX
237 Q
238ADDEND1(TIUDA) ;Add an addendum
239 ;
240 D FULL^VALM1,ADDEND1^TIURA1
241 Q
242 ;
243EDEX ;
244 I $G(GMRCLCK) D UNLOCK^GMRCA1(GMRCO)
245 K GMRCDFN,GMRCO,GMRCQUT,GMRCTUFN,GMRCSEL,GMRCQIT
246 Q
247 ;
248PAUSE ; Pause for user
249 ;
250 N X W !,"Press <RETURN> to continue: " R X:DTIME E W " (timeout)"
251 Q
252 ;
253CPGUI ;it's GUI way or no way
254 N MSG
255 S MSG="You must use the CPRS GUI to complete this Clinical Procedure"
256 D EXAC^GMRCADC(MSG)
257 Q
Note: See TracBrowser for help on using the repository browser.