source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSROI.m@ 1671

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

initial load of FOIAVistA 6/30/08 version

File size: 9.3 KB
Line 
1TIUSROI ; SLC/JER - TIU/Surgery Interface Routine ; 04/19/2004
2 ;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173**;Jun 20, 1997
3 Q
4GETOP(TIUY,TIUDA,SROTYP) ; Get Op-Top
5 N SROVP
6 S SROVP=$P($G(^TIU(8925,TIUDA,14)),U,5),SROTYP=$G(SROTYP,"OP")
7 S TIUY=$S(SROTYP="OP":$NA(^TMP("SROP",$J,+SROVP)),1:$NA(^TMP("SRNOR",$J,+SROVP)))
8 I $P(SROVP,";",2)'="SRF(" Q
9 D @$S(SROTYP="OP":"OPTOP^SROSRPT(+SROVP)",1:"OPTOP^SRONP(+SROVP)")
10 I +$G(@TIUY@(0))=0 K @TIUY Q
11 I '$D(XWBOS),'$D(ZTQUEUED),($E($G(IOST))="C"),(@TIUY@(0)=2) D
12 . N SEEOP S SEEOP=0
13 . I $S(+$D(XQADATA):1,$G(TIUEVNT)["SIGN":1,1:0) D Q:+SEEOP
14 . . W ! S SEEOP=+$$READ^TIUU("YA","Do you want to see the Op Top? ","YES")
15 . K @TIUY
16 I $D(XWBOS),($G(@TIUY@(0))'=1) K @TIUY
17 Q
18GETCASE(DFN,DA) ; Match Operation Report to an open Surgical Case
19 ; Call with: [DFN] - patient file entry number
20 ; Returns: TIUY - Variable pointer to Surgical Case
21AGN ; Loop for handling repeated attempts
22 N TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUY,TIUMTSTR,TIUMLST,TIUCNT,X,TIULIST
23 I +DFN'>0 S TIUOUT=1 Q 0
24 I +$G(DA) D G:+TIUX>0 GETX
25 . I +$P($G(^TIU(8925,+DA,14)),U,5) S TIUX=+$P($G(^(14)),U,5) Q
26 . I +$$ISADDNDM^TIULC1(+DA) S TIUX=+$$DADSC(DA)
27 D ISSURG^TIUSROI(.TIUY,+$G(^TIU(8925,+TIUDA,0))) I +TIUY W !,"This action is no longer permitted for SURGICAL REPORTS" H 3 Q 0
28 D LIST^SROESTV(.TIULIST,DFN,"","","",0) ; Call Surgery to get list of cases
29 ; If no Surgeries for patient, then quit
30 I '$D(@TIULIST) D Q -1
31 . W !!,$C(7),"No SURGICAL CASES to Result for ",$$PTNAME^TIULC1(DFN),".",!
32 S (TIUCNT,TIUI)=0 F S TIUI=+$O(@TIULIST@(TIUI)) Q:+TIUI'>0 D
33 . S TIUCNT=+$G(TIUCNT)+1
34 W !,"You must link your Result to a SURGICAL CASE...",!
35 D INDEX(TIULIST)
36 D I +TIUER Q:+$G(TIUOUT) 0 G AGN
37 . W !,"The following SURGICAL CASE",$S(+TIUCNT>1:"(S) are",1:" is")," available:"
38 . S (TIUER,TIUOK,TIUI)=0
39 . F S TIUI=$O(@TIULIST@(TIUI)) Q:+TIUI'>0!+TIUER!+TIUOK D
40 . . S TIUII=TIUI,TIUX=$G(@TIULIST@(TIUI))
41 . . D WRITE I '(TIUI#5) D BREAK
42 . Q:$D(TIUOUT)
43 . I +TIUER S TIUOUT=1 Q
44 . I TIUII#5 D BREAK Q:$D(TIUOUT)
45 . I +TIUER S TIUOUT=1 Q
46 . S TIUX=+@TIULIST@(TIUOK),^DISV(DUZ,"^SRF(",DFN)=+TIUX
47 . W " ",+TIUX
48GETX S TIUY=+TIUX_";SRF(" K @TIULIST
49 Q $G(TIUY)
50BREAK ; Handle prompting
51 W !,"CHOOSE 1-",TIUII W:$D(@TIULIST@(TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT" W ": " R X:DTIME
52 I $S('$T!(X["^"):1,X=""&'$D(@TIULIST@(TIUII+1)):1,1:0) S TIUER=1 Q
53 I X="" Q
54 I X=" ",$D(^DISV(DUZ,"^SRF(",DFN)) S TIUX=^(DFN) S TIUOK=+$O(@TIULIST@("C",+TIUX,0)) Q
55 I X'=+X!'$D(@TIULIST@(+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
56 S TIUOK=X
57 Q
58DADSC(DA) ; Get the Surgical Case associated with the parent record
59 N TIUDADA,TIUY S TIUDADA=$P($G(^TIU(8925,+DA,0)),U,6)
60 S TIUY=$P($G(^TIU(8925,TIUDADA,14)),U,5)
61 Q TIUY
62WRITE ; Writes each case
63 W !,$J(TIUI,4),"> ",$$DATE^TIULS($P(TIUX,U,3),"AMTH DD, CCYY")
64 W " Case #",$P(TIUX,U),?34,$E($P(TIUX,U,2),1,25),?60,$E($P($P(TIUX,U,4),";",2),1,20)
65 Q
66INDEX(TIULIST) ; Build index of list
67 N TIUI S TIUI=0
68 F S TIUI=$O(@TIULIST@(TIUI)) Q:+TIUI'>0 D
69 . S @TIULIST@("C",+@TIULIST@(TIUI),TIUI)=""
70 Q
71ISSURG(TIUY,TITLE) ; Boolean RPC to evaluate whether TITLE is a SURGERY REPORT
72 N TIUCLASS,TIUI S TIUY=0
73 F TIUI="SURGICAL REPORTS","PROCEDURE REPORTS (NON-O.R.)" D Q:TIUY>0
74 . S TIUCLASS=+$$CLASS(TIUI)
75 . I +TIUCLASS'>0 Q
76 . S TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
77 Q
78RBOR(TIUDA) ; Roll back OPERATION REPORT when TIU changes require it
79 N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5) Q:+SRODA'>0
80 D OS^SROTIUD(SRODA)
81 Q
82RBPR(TIUDA) ; Roll back NON-O.R. PROC REPORT when TIU changes require it
83 N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5)
84 Q:+SRODA'>0
85 D NON^SROTIUD(SRODA)
86 Q
87CLASS(CLNAME) ; What is the TIU Class (or Document Class) for SURGERY REPORTS
88 N TIUY S TIUY=+$O(^TIU(8925.1,"B",CLNAME,0))
89 I +TIUY>0,$S($P($G(^TIU(8925.1,+TIUY,0)),U,4)="CL":0,$P($G(^(0)),U,4)="DC":0,1:1) S TIUY=0
90 Q TIUY
91ES(TIUDA,TIUDUZ) ; Apply user's e-Sig to Document
92 N TIUES S TIUDUZ=$G(TIUDUZ,DUZ)
93 I '+$G(^TIU(8925,TIUDA,0)) Q
94 S TIUES="1^"_$$SIGNAME^TIULS(TIUDUZ)_U_$$SIGTITL^TIULS(TIUDUZ)
95 D ES^TIURS(TIUDA,TIUES)
96 Q
97ENTEROP(DFN,TIUTYP) ; Re-direct entry of Op and Proc Reports
98 N TIUDA,TIUD0,TIUX,TIUPRM0,TIUPRM1,SUCCESS,TIUBUF,TIUTNM
99 S TIUTNM=$$PNAME^TIULC1(TIUTYP)
100 ; -- Exclude NIR and AR from Entry
101 I $S(TIUTNM["ANESTH":1,TIUTNM["NURS":1,1:0) D Q
102 . W !!,TIUTNM,"s may only be entered through the Surgery Options.",!
103 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
104 . W !
105 ; -- first, determine the correct TIU DOCUMENT record --
106 F D Q:$D(DUOUT)!$D(DIROUT)!+$G(TIUOUT)
107 . N D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV
108 . S X=+$G(DFN)
109 . I X'>0 D Q
110 . . W !!,"No Patient Specified...",!
111 . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
112 . . S TIUOUT=1 W !
113 . S DIC=8925,DIC(0)="UXEV",D="C"
114 . W ! S DIC("W")="D DICW^TIUPUTS(+Y)",DIC("S")="I +$G(^TIU(8925,+Y,0))=TIUTYP"
115 . D IX^DIC
116 . I +Y'>0 D Q
117 . . W !!,$S(+$O(^TIU(8925,"C",+X,0))'>0:"No "_TIUTNM_"s Available.",1:"No "_TIUTNM_" Selected..."),!
118 . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
119 . . S TIUOUT=1 W !
120 . D BROWS1^TIURA2("TIU BROWSE FOR TRANSCRIPTION",+Y)
121 . S TIUOUT=1 W !
122 Q
123REASSOP(DFN,TIUODA) ; Re-direct REASSIGNMENT of Op and Proc Reports
124 N TIUDA,TIUD0,TIUD12,TIUTYP,TIUTNM,TIUSCRN
125 S TIUD0(0)=$G(^TIU(8925,+TIUODA,0)),TIUD12(0)=$G(^(12))
126 I DFN=$P(TIUD0(0),U,2) D CHANGE^TIUSROI1(TIUODA) Q
127 S TIUTYP=+TIUD0(0)
128 S TIUTNM=$$PNAME^TIULC1(TIUTYP)
129 I +$$ISADDNDM^TIULC1(TIUODA),$S($$GET1^DIQ(8925,TIUODA,.06)["ANESTH":1,$$GET1^DIQ(8925,TIUODA,.06)["NURS":1,1:0) D G REASSOPX
130 . W !!,"ADDENDUMs to ",$$GET1^DIQ(8925,TIUODA,.06),"s may not be reassigned.",!
131 . I $$READ^TIUU("EA","Press RETURN to continue...")
132 . S TIUOUT=1 W !
133 S TIUDA=0
134 I $S(TIUTNM["ANESTH":1,TIUTNM["NURS":1,1:0) D G REASSOPX
135 . W !!,TIUTNM,"s may only be created through the Surgery Options..."
136 . W !,"Reassignment is not allowed.",!
137 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
138 . S TIUOUT=1 W !
139 W ! S SROVP=$$GETCASE^TIUSROI(DFN)
140 I +SROVP'>0 D Q
141 . W !!,$C(7),"Okay, no harm done...",!
142 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
143 ; if target case is same as current, quit
144 I +SROVP=+$P(^TIU(8925,TIUODA,14),U,5) D Q
145 . W !!,$C(7),"You've selected the original case. No changes made.",!
146 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
147 ; Get the document for the target surgical case
148 S TIUDA=$$TARGET^TIUSROI1(SROVP)
149 ; if target document is of a different type than source, quit
150 I $$TYPE^TIUSROI1(TIUDA)'=$$TYPE^TIUSROI1(TIUODA) D Q
151 . W !!,$C(7),"Incompatible document type. No changes made.",!
152 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
153 I +TIUDA'>0 D G REASSOPX
154 . W !!,"No Destination Document Selected: Aborting Transaction,",!," No Harm Done...",!
155 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
156 ; -- If original and target are the same --
157 I +TIUDA=+TIUODA D G REASSOPX
158 . W !!,$C(7),"You've selected the original case. No changes made.",!
159 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
160 ; -- Confirm selection --
161 I '$$FROMTO^TIUSROI1(TIUODA,TIUDA,TIUTNM) D G REASSOPX
162 . W !!,"Aborting Transaction, No Harm Done...",!
163 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
164 ; -- Conditionally Retract Original --
165 I (+$P(TIUD0(0),U,5)>5) D
166 . N TIUMSG,TIURTCT S TIUMSG=$S(DFN=+$P(TIUD0(0),U,2):"Reassigning document...",DFN'=+$P(TIUD0(0),U,2):"Moving signed document to another Patient...")
167 . W !!,TIUMSG,!,"A RETRACTED copy will be retained.",!
168 . S TIURTCT=$$RETRACT^TIURD2(TIUODA,"",15)
169 ; -- Copy AUTHOR from original to target/Update target status --
170 D AUTHSTAT(TIUDA,TIUODA,.TIUD12)
171 ; -- Copy contents of original into target --
172 D COPYTEXT^TIURC1(TIUODA,TIUDA) K ^TIU(8925,TIUDA,15)
173 I $D(^TIU(8925,TIUDA,"TEMP")) D
174 . N TIU
175 . D GETTIU^TIULD(.TIU,TIUDA)
176 . D MERGTEXT^TIUEDI1(TIUDA,.TIU)
177 . K ^TIU(8925,TIUDA,"TEMP")
178 ; -- Conditionally roll back original --
179 I +$P(TIUD0(0),U,5)>5 D
180 . N TIUDA,TIUDELX
181 . S TIUDA=TIUODA
182 . S TIUDELX=$$DELETE^TIULC1(+$G(TIUD0(0)))
183 . I TIUDELX]"" X TIUDELX
184 I +$P(TIUD0(0),U,5)'>5 D
185 . N TIUX,SUCCESS
186 . K ^TIU(8925,TIUODA,"TEXT")
187 . S TIUX(.05)=1
188 . D FILE^TIUSRVP(.SUCCESS,TIUODA,.TIUX,1)
189 ; -- Send Signature Alerts for target --
190 D SEND^TIUALRT(TIUDA)
191 ; -- Delete Signature Alerts for Original --
192 D ALERTDEL^TIUALRT(TIUODA)
193 ; -- Audit Reassignment of target --
194 S TIUD0(1)=$G(^TIU(8925,+TIUDA,0)),TIUD12(1)=$G(^(12))
195 D AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
196 ; -- Register audit trail for original
197 I +$G(TIUODA) D AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
198 S TIUCHNG=1
199REASSOPX Q
200AUTHSTAT(TIUDA,TIUODA,TIUD12) ; Copy Author, update status
201 N TIUX,SUCCESS
202 S TIUX(.05)=5
203 S TIUX(1406)=TIUODA
204 I +$P(TIUD12(0),U,2) S TIUX(1202)=$P(TIUD12(0),U,2)
205 D FILE^TIUSRVP(.SUCCESS,TIUDA,.TIUX,1)
206 Q
207SELOP(DFN,TIUTYP,TIUSCRN) ; Select an Op or Proc Report
208 N DUOUT,DTOUT,D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV,TIUY,TIUTNM
209 S TIUY=0
210 S TIUTNM=$$PNAME^TIULC1(TIUTYP)
211 S TIUSCRN=$G(TIUSCRN,"I +$G(^TIU(8925,+Y,0))=TIUTYP")
212 S X=+$G(DFN)
213 I X'>0 D G SELOPX
214 . W !!,"No Patient Specified...",!
215 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
216 . W !
217 S DIC=8925,DIC(0)="UXEV",D="C"
218 W !
219 S DIC("W")="D DICW^TIUPUTS(+Y)"
220 S DIC("S")=TIUSCRN
221 D IX^DIC
222 I +Y'>0 D
223 . W !!,"No "_TIUTNM
224 . W $S(+$O(^TIU(8925,"APT",DFN,TIUTYP,0))'>0:"s On File.",+$O(^(0))>2:"s Available.",1:" Selected..."),!
225 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
226 . W !
227 S TIUY=+Y
228SELOPX Q TIUY
Note: See TracBrowser for help on using the repository browser.