source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSROI1.m@ 1261

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

initial load of WorldVistAEHR

File size: 7.5 KB
Line 
1TIUSROI1 ; SLC/JER - Reassign actions ; 04/19/2004
2 ;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173**;Jun 20, 1997
3 Q
4FROMTO(TIUODA,TIUDA,TIUTNM) ; Display the from/to information
5 N TIUF,TIUF12,TIUT,TIUT12,TIUFEDT,TIUFLDT,TIUTEDT,TIUTLDT
6 D GETTIU^TIULD(.TIUF,+TIUODA)
7 D GETTIU^TIULD(.TIUT,+TIUDA)
8 S TIUFEDT=$$DATE^TIULS($P(TIUF("EDT"),U),"MM/DD/YY HR:MIN")
9 S TIUFLDT=$$DATE^TIULS($P(TIUF("LDT"),U),"MM/DD/YY HR:MIN")
10 S TIUTEDT=$$DATE^TIULS($P(TIUT("EDT"),U),"MM/DD/YY HR:MIN")
11 S TIUTLDT=$$DATE^TIULS($P(TIUT("LDT"),U),"MM/DD/YY HR:MIN")
12 S TIUF12=$G(^TIU(8925,TIUODA,12)),TIUT12=$G(^TIU(8925,TIUDA,12))
13 W !!,"You are about to move the ",TIUTNM," as follows:",!
14 W !,?5,"From",?45,"To",!
15 W !,$P(TIUF("DOCTYP"),U,2),?35," --> ",?40,$P(TIUT("DOCTYP"),U,2)
16 W !,TIUF("PNM")," ",TIUF("PID"),?35," --> ",?40,TIUT("PNM")," ",TIUT("PID")
17 W !,TIUFEDT,$S(+TIUFLDT:" - "_TIUFLDT,1:""),?35," --> "
18 W ?40,TIUTEDT,$S(+TIUTLDT:" - "_TIUTLDT,1:""),!
19 W !," Surgeon: ",$$PERSNAME^TIULC1(+$P(TIUF12,U,2)),?35," --> "
20 W ?40,$$PERSNAME^TIULC1(+$P(TIUF12,U,2))
21 W !," Attending: ",$$PERSNAME^TIULC1(+$P(TIUF12,U,9)),?35," --> "
22 W ?40,$$PERSNAME^TIULC1(+$P(TIUT12,U,9))
23 W !,"Surg. Case #: ",+$P($G(^TIU(8925,TIUODA,14)),U,5),?35," --> "
24 W ?40,+$P($G(^TIU(8925,TIUDA,14)),U,5),!
25 Q +$$READ^TIUU("YA"," ... Ok? ","NO")
26ANES(TIUDA) ; Roll back ANESTHESIA REPORT when TIU changes require it
27 N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5)
28 Q:+SRODA'>0
29 D ANES^SROTIUD(SRODA)
30 Q
31NURS(TIUDA) ; Roll back NURSE INTRAOPERATIVE REPORT when TIU changes require it
32 N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5)
33 Q:+SRODA'>0
34 D NURS^SROTIUD(SRODA)
35 Q
36RETRACT(TIUDA) ;
37 N CNT,TITLE,TIUACT,TIUDATA
38 S TIUDATA="ANESTHESIA REPORTS^NURSE INTRAOPERATIVE REPORTS^OPERATION REPORTS^PROCEDURE REPORT (NON-O.R.)"
39 F CNT=1:1:$L(TIUDATA,U) S TITLE=$P(TIUDATA,U,CNT) I $$BELONGS^TIULX(TIUDA,$$FIND1^DIC(8925.1,"","BX",TITLE)) D
40 . S TIUACT=$S(CNT=1:"ANES^TIUSROI1(TIUDA)",CNT=2:"NURS^TIUSROI1(TIUDA)",CNT=3:"RBOR^TIUSROI(TIUDA)",CNT=4:"RBPR^TIUSROI(TIUDA)",1:"QUIT")
41 . I TIUACT="QUIT" Q
42 . D @TIUACT
43 Q
44CHANGE(TIUDA) ; Redirect the TIU Document to a different Surgical Case
45 N DFN,SROVP,TIUD0,TIUD14,TIUNDA,TIUACT
46 S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD14=$G(^(14)),SROVP=$P(TIUD14,U,5)
47 S DFN=$P(TIUD0,U,2) Q:+DFN'>0
48 ; choose destination case
49 W ! S SROVP=$$GETCASE^TIUSROI(DFN)
50 ; if no case is selected, quit
51 I +SROVP'>0 D Q
52 . W !!,$C(7),"Okay, no harm done...",!
53 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
54 ; if target case is same as current, quit
55 I +SROVP=+$P(TIUD14,U,5) D Q
56 . W !!,$C(7),"You've selected the original case. No changes made.",!
57 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
58 ; Get the document for the target surgical case
59 S TIUNDA=$$TARGET(SROVP)
60 ; if target document is of a different type than source, quit
61 I $$TYPE(TIUNDA)'=$$TYPE(TIUDA) D Q
62 . W !!,$C(7),"Incompatible document type. No changes made.",!
63 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
64 ; if target case has empty report, replace
65 S TIUTYP=+TIUD0
66 S TIUTNM=$$PNAME^TIULC1(TIUTYP)
67 I '$$FROMTO^TIUSROI1(TIUDA,TIUNDA,TIUTNM) D Q
68 . W !!,"Aborting Transaction, No Harm Done...",!
69 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
70 I +$$EMPTYDOC^TIULF(TIUNDA) D Q
71 . W !!,"Moving document ",TIUDA," to Surgical Case #",+SROVP,"...",!
72 . I '+$$READ^TIUU("YA","Are you sure? ","NO") Q
73 . D REPLACE(TIUDA,TIUNDA)
74 ; else, ask whether to swap or replace
75 S TIUACT=$$ASKACT($$TITLE(TIUNDA))
76 I $P(TIUACT,U)="E"!($P(TIUACT,U)="") D Q
77 . W !!,"Great. No harm done.",!
78 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
79 I $P(TIUACT,U)="R" D Q
80 . W !!,"Replacing ",$$TITLE(TIUNDA)," on Surgical Case #",+SROVP,"...",!
81 . I '+$$READ^TIUU("YA","Are you sure? ","NO") Q
82 . D REPLACE(TIUDA,TIUNDA)
83 I $P(TIUACT,U)="S" D
84 . W !!,"Swapping with ",$$TITLE(TIUNDA)," on Surgical Case #",+SROVP,"...",!
85 . I '+$$READ^TIUU("YA","Are you sure? ","NO") Q
86 . D SWAP(TIUDA,TIUNDA)
87 Q
88ASKACT(TITLE) ; ask user to choose replace or swap
89 N TIUY,TIUSET S TIUY=""
90 W !!,"Please choose the appropriate action for this "_TITLE_":"
91 S TIUSET="R:replace target document with this document"
92 S TIUSET=TIUSET_";S:swap target document with this document"
93 S TIUSET=TIUSET_";E:exit and do nothing"
94 S TIUY=$$READ^TIUU("S^"_TIUSET,"Select Action","exit")
95 Q TIUY
96TITLE(TIUDA) ; resolve title of document
97 Q $P($G(^TIU(8925.1,+$G(^TIU(8925,TIUDA,0)),0)),U)
98TYPE(TIUDA) ; identifies type of document (i.e., Op Report or Proc Report)
99 N TIUY,TIUCOR,TIUCPR S TIUY=""
100 S TIUCOR=+$$CLASS^TIUSROI("OPERATION REPORTS")
101 S TIUCPR=+$$CLASS^TIUSROI("PROCEDURE REPORT (NON-O.R.)")
102 I +$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),TIUCOR) S TIUY="OS" I 1
103 E I +$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),TIUCPR) S TIUY="PR"
104 Q TIUY
105TARGET(TIUCASE) ; Get report ien for case
106 N TIUI,TIUNDA,TIUCOR,TIUCPR S (TIUI,TIUNDA)=0
107 S TIUCOR=+$$CLASS^TIUSROI("OPERATION REPORTS")
108 S TIUCPR=+$$CLASS^TIUSROI("PROCEDURE REPORT (NON-O.R.)")
109 F S TIUI=$O(^TIU(8925,"G",TIUCASE,TIUI)) Q:+TIUI'>0 D Q:+TIUNDA
110 . I $P($G(^TIU(8925,TIUI,0)),U,5)=15 Q
111 . I +$$ISA^TIULX(+$G(^TIU(8925,TIUI,0)),TIUCOR) S TIUNDA=TIUI Q
112 . I +$$ISA^TIULX(+$G(^TIU(8925,TIUI,0)),TIUCPR) S TIUNDA=TIUI
113 Q TIUNDA
114REPLACE(TIUDA1,TIUDA2) ; Replace TIUDA2 with TIUDA1
115 N SRODA1,SRODA2,TIUD01,TIUD02,TIUD141,TIUD142,TIUTYPE,TIUNODEL
116 S TIUD01=$G(^TIU(8925,TIUDA1,0)),TIUD02=$G(^TIU(8925,TIUDA2,0))
117 I +TIUD01'=+TIUD02 D Q
118 . W !!,$C(7),"The two documents are of different types. No changes made.",!
119 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
120 S TIUD141=$G(^TIU(8925,TIUDA1,14)),SRODA1=+$P(TIUD141,U,5)
121 S TIUD142=$G(^TIU(8925,TIUDA2,14)),SRODA2=+$P(TIUD142,U,5)
122 ; 1. Swap comments for TIUDA1 and TIUDA2
123 D SWAPCOMM(TIUDA1,TIUDA2)
124 ; 2. Redirect TIUDA1 to TIUDA2's surgical case
125 D RDTIU(TIUDA1,SRODA2)
126 ; 3. Redirect TIUDA2's surgical case to TIUDA1
127 D RDSURG(SRODA2,TIUDA1)
128 ; 4. Delete or Retract TIUDA2
129 I +$P(TIUD02,U,5)<6 D DIK^TIURB2(TIUDA2,1) I 1
130 E S TIUNODEL=1,TIUDA2=$$RETRACT^TIURD2(TIUDA2,"",14)
131 ; 5. Rollback SRODA1 (create new stub)
132 S TIUTYPE=$$TYPE(TIUDA1)
133 I TIUTYPE="OS" D OS^SROTIUD(SRODA1) I 1
134 E I TIUTYPE="PR" D NON^SROTIUD(SRODA1)
135 Q
136SWAP(TIUDA1,TIUDA2) ; Swap TIUDA1 with TIUDA2
137 N SRODA1,SRODA2,TIUD01,TIUD02,TIUD141,TIUD142
138 S TIUD01=$G(^TIU(8925,TIUDA1,0)),TIUD02=$G(^TIU(8925,TIUDA2,0))
139 I +TIUD01'=+TIUD02 D Q
140 . W !!,$C(7),"The two documents are of different types. No changes made.",!
141 . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
142 S TIUD141=$G(^TIU(8925,TIUDA1,14)),SRODA1=+$P(TIUD141,U,5)
143 S TIUD142=$G(^TIU(8925,TIUDA2,14)),SRODA2=+$P(TIUD142,U,5)
144 ; 1. Redirect TIUDA1 to TIUDA2's surgical case
145 D RDTIU(TIUDA1,SRODA2)
146 ; 2. Redirect TIUDA2 to TIUDA1's surgical case
147 D RDTIU(TIUDA2,SRODA1)
148 ; 3. Redirect TIUDA1's surgical case to TIUDA2
149 D RDSURG(SRODA1,TIUDA2)
150 ; 4. Redirect TIUDA2's surgical case to TIUDA1
151 D RDSURG(SRODA2,TIUDA1)
152 ; 5. Swap comments for TIUDA1 and TIUDA2
153 D SWAPCOMM(TIUDA1,TIUDA2)
154 Q
155RDSURG(SRODA,TIUDA) ; Redirect surgical case to new document
156 N DA,DIE,DR,TIUTYP S TIUTYP=$$TYPE(TIUDA) Q:TIUTYP']""
157 S DIE=130,DA=SRODA,DR=$S(TIUTYP="OS":1000,TIUTYP="PR":1002,1:"")
158 S DR=DR_"////^S X=TIUDA" D ^DIE
159 Q
160RDTIU(TIUDA,SRODA) ; Redirect document to new surgical case
161 N DA,DIE,DR,SROVP S SROVP=SRODA_";SRF("
162 S DIE=8925,DA=TIUDA,DR="1405////^S X=SROVP" D ^DIE
163 Q
164SWAPCOMM(TIUDA1,TIUDA2) ; Swap the comments field for two TIU Documents
165 N DA,DIE,DR,COMM1,COMM2
166 S COMM1=$G(^TIU(8925,TIUDA1,17)),COMM2=$G(^TIU(8925,TIUDA2,17))
167 S DA=TIUDA1,DIE=8925,DR="1701////^S X=COMM2" D ^DIE
168 S DA=TIUDA2,DIE=8925,DR="1701////^S X=COMM1" D ^DIE
169 Q
Note: See TracBrowser for help on using the repository browser.