TIUSROI1 ; SLC/JER - Reassign actions ; 04/19/2004
;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173**;Jun 20, 1997
Q
FROMTO(TIUODA,TIUDA,TIUTNM) ; Display the from/to information
N TIUF,TIUF12,TIUT,TIUT12,TIUFEDT,TIUFLDT,TIUTEDT,TIUTLDT
D GETTIU^TIULD(.TIUF,+TIUODA)
D GETTIU^TIULD(.TIUT,+TIUDA)
S TIUFEDT=$$DATE^TIULS($P(TIUF("EDT"),U),"MM/DD/YY HR:MIN")
S TIUFLDT=$$DATE^TIULS($P(TIUF("LDT"),U),"MM/DD/YY HR:MIN")
S TIUTEDT=$$DATE^TIULS($P(TIUT("EDT"),U),"MM/DD/YY HR:MIN")
S TIUTLDT=$$DATE^TIULS($P(TIUT("LDT"),U),"MM/DD/YY HR:MIN")
S TIUF12=$G(^TIU(8925,TIUODA,12)),TIUT12=$G(^TIU(8925,TIUDA,12))
W !!,"You are about to move the ",TIUTNM," as follows:",!
W !,?5,"From",?45,"To",!
W !,$P(TIUF("DOCTYP"),U,2),?35," --> ",?40,$P(TIUT("DOCTYP"),U,2)
W !,TIUF("PNM")," ",TIUF("PID"),?35," --> ",?40,TIUT("PNM")," ",TIUT("PID")
W !,TIUFEDT,$S(+TIUFLDT:" - "_TIUFLDT,1:""),?35," --> "
W ?40,TIUTEDT,$S(+TIUTLDT:" - "_TIUTLDT,1:""),!
W !," Surgeon: ",$$PERSNAME^TIULC1(+$P(TIUF12,U,2)),?35," --> "
W ?40,$$PERSNAME^TIULC1(+$P(TIUF12,U,2))
W !," Attending: ",$$PERSNAME^TIULC1(+$P(TIUF12,U,9)),?35," --> "
W ?40,$$PERSNAME^TIULC1(+$P(TIUT12,U,9))
W !,"Surg. Case #: ",+$P($G(^TIU(8925,TIUODA,14)),U,5),?35," --> "
W ?40,+$P($G(^TIU(8925,TIUDA,14)),U,5),!
Q +$$READ^TIUU("YA"," ... Ok? ","NO")
ANES(TIUDA) ; Roll back ANESTHESIA REPORT when TIU changes require it
N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5)
Q:+SRODA'>0
D ANES^SROTIUD(SRODA)
Q
NURS(TIUDA) ; Roll back NURSE INTRAOPERATIVE REPORT when TIU changes require it
N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5)
Q:+SRODA'>0
D NURS^SROTIUD(SRODA)
Q
RETRACT(TIUDA) ;
N CNT,TITLE,TIUACT,TIUDATA
S TIUDATA="ANESTHESIA REPORTS^NURSE INTRAOPERATIVE REPORTS^OPERATION REPORTS^PROCEDURE REPORT (NON-O.R.)"
F CNT=1:1:$L(TIUDATA,U) S TITLE=$P(TIUDATA,U,CNT) I $$BELONGS^TIULX(TIUDA,$$FIND1^DIC(8925.1,"","BX",TITLE)) D
. 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")
. I TIUACT="QUIT" Q
. D @TIUACT
Q
CHANGE(TIUDA) ; Redirect the TIU Document to a different Surgical Case
N DFN,SROVP,TIUD0,TIUD14,TIUNDA,TIUACT
S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD14=$G(^(14)),SROVP=$P(TIUD14,U,5)
S DFN=$P(TIUD0,U,2) Q:+DFN'>0
; choose destination case
W ! S SROVP=$$GETCASE^TIUSROI(DFN)
; if no case is selected, quit
I +SROVP'>0 D Q
. W !!,$C(7),"Okay, no harm done...",!
. W:$$READ^TIUU("EA","Press RETURN to continue...") ""
; if target case is same as current, quit
I +SROVP=+$P(TIUD14,U,5) D Q
. W !!,$C(7),"You've selected the original case. No changes made.",!
. W:$$READ^TIUU("EA","Press RETURN to continue...") ""
; Get the document for the target surgical case
S TIUNDA=$$TARGET(SROVP)
; if target document is of a different type than source, quit
I $$TYPE(TIUNDA)'=$$TYPE(TIUDA) D Q
. W !!,$C(7),"Incompatible document type. No changes made.",!
. W:$$READ^TIUU("EA","Press RETURN to continue...") ""
; if target case has empty report, replace
S TIUTYP=+TIUD0
S TIUTNM=$$PNAME^TIULC1(TIUTYP)
I '$$FROMTO^TIUSROI1(TIUDA,TIUNDA,TIUTNM) D Q
. W !!,"Aborting Transaction, No Harm Done...",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
I +$$EMPTYDOC^TIULF(TIUNDA) D Q
. W !!,"Moving document ",TIUDA," to Surgical Case #",+SROVP,"...",!
. I '+$$READ^TIUU("YA","Are you sure? ","NO") Q
. D REPLACE(TIUDA,TIUNDA)
; else, ask whether to swap or replace
S TIUACT=$$ASKACT($$TITLE(TIUNDA))
I $P(TIUACT,U)="E"!($P(TIUACT,U)="") D Q
. W !!,"Great. No harm done.",!
. W:$$READ^TIUU("EA","Press RETURN to continue...") ""
I $P(TIUACT,U)="R" D Q
. W !!,"Replacing ",$$TITLE(TIUNDA)," on Surgical Case #",+SROVP,"...",!
. I '+$$READ^TIUU("YA","Are you sure? ","NO") Q
. D REPLACE(TIUDA,TIUNDA)
I $P(TIUACT,U)="S" D
. W !!,"Swapping with ",$$TITLE(TIUNDA)," on Surgical Case #",+SROVP,"...",!
. I '+$$READ^TIUU("YA","Are you sure? ","NO") Q
. D SWAP(TIUDA,TIUNDA)
Q
ASKACT(TITLE) ; ask user to choose replace or swap
N TIUY,TIUSET S TIUY=""
W !!,"Please choose the appropriate action for this "_TITLE_":"
S TIUSET="R:replace target document with this document"
S TIUSET=TIUSET_";S:swap target document with this document"
S TIUSET=TIUSET_";E:exit and do nothing"
S TIUY=$$READ^TIUU("S^"_TIUSET,"Select Action","exit")
Q TIUY
TITLE(TIUDA) ; resolve title of document
Q $P($G(^TIU(8925.1,+$G(^TIU(8925,TIUDA,0)),0)),U)
TYPE(TIUDA) ; identifies type of document (i.e., Op Report or Proc Report)
N TIUY,TIUCOR,TIUCPR S TIUY=""
S TIUCOR=+$$CLASS^TIUSROI("OPERATION REPORTS")
S TIUCPR=+$$CLASS^TIUSROI("PROCEDURE REPORT (NON-O.R.)")
I +$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),TIUCOR) S TIUY="OS" I 1
E I +$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),TIUCPR) S TIUY="PR"
Q TIUY
TARGET(TIUCASE) ; Get report ien for case
N TIUI,TIUNDA,TIUCOR,TIUCPR S (TIUI,TIUNDA)=0
S TIUCOR=+$$CLASS^TIUSROI("OPERATION REPORTS")
S TIUCPR=+$$CLASS^TIUSROI("PROCEDURE REPORT (NON-O.R.)")
F S TIUI=$O(^TIU(8925,"G",TIUCASE,TIUI)) Q:+TIUI'>0 D Q:+TIUNDA
. I $P($G(^TIU(8925,TIUI,0)),U,5)=15 Q
. I +$$ISA^TIULX(+$G(^TIU(8925,TIUI,0)),TIUCOR) S TIUNDA=TIUI Q
. I +$$ISA^TIULX(+$G(^TIU(8925,TIUI,0)),TIUCPR) S TIUNDA=TIUI
Q TIUNDA
REPLACE(TIUDA1,TIUDA2) ; Replace TIUDA2 with TIUDA1
N SRODA1,SRODA2,TIUD01,TIUD02,TIUD141,TIUD142,TIUTYPE,TIUNODEL
S TIUD01=$G(^TIU(8925,TIUDA1,0)),TIUD02=$G(^TIU(8925,TIUDA2,0))
I +TIUD01'=+TIUD02 D Q
. W !!,$C(7),"The two documents are of different types. No changes made.",!
. W:$$READ^TIUU("EA","Press RETURN to continue...") ""
S TIUD141=$G(^TIU(8925,TIUDA1,14)),SRODA1=+$P(TIUD141,U,5)
S TIUD142=$G(^TIU(8925,TIUDA2,14)),SRODA2=+$P(TIUD142,U,5)
; 1. Swap comments for TIUDA1 and TIUDA2
D SWAPCOMM(TIUDA1,TIUDA2)
; 2. Redirect TIUDA1 to TIUDA2's surgical case
D RDTIU(TIUDA1,SRODA2)
; 3. Redirect TIUDA2's surgical case to TIUDA1
D RDSURG(SRODA2,TIUDA1)
; 4. Delete or Retract TIUDA2
I +$P(TIUD02,U,5)<6 D DIK^TIURB2(TIUDA2,1) I 1
E S TIUNODEL=1,TIUDA2=$$RETRACT^TIURD2(TIUDA2,"",14)
; 5. Rollback SRODA1 (create new stub)
S TIUTYPE=$$TYPE(TIUDA1)
I TIUTYPE="OS" D OS^SROTIUD(SRODA1) I 1
E I TIUTYPE="PR" D NON^SROTIUD(SRODA1)
Q
SWAP(TIUDA1,TIUDA2) ; Swap TIUDA1 with TIUDA2
N SRODA1,SRODA2,TIUD01,TIUD02,TIUD141,TIUD142
S TIUD01=$G(^TIU(8925,TIUDA1,0)),TIUD02=$G(^TIU(8925,TIUDA2,0))
I +TIUD01'=+TIUD02 D Q
. W !!,$C(7),"The two documents are of different types. No changes made.",!
. W:$$READ^TIUU("EA","Press RETURN to continue...") ""
S TIUD141=$G(^TIU(8925,TIUDA1,14)),SRODA1=+$P(TIUD141,U,5)
S TIUD142=$G(^TIU(8925,TIUDA2,14)),SRODA2=+$P(TIUD142,U,5)
; 1. Redirect TIUDA1 to TIUDA2's surgical case
D RDTIU(TIUDA1,SRODA2)
; 2. Redirect TIUDA2 to TIUDA1's surgical case
D RDTIU(TIUDA2,SRODA1)
; 3. Redirect TIUDA1's surgical case to TIUDA2
D RDSURG(SRODA1,TIUDA2)
; 4. Redirect TIUDA2's surgical case to TIUDA1
D RDSURG(SRODA2,TIUDA1)
; 5. Swap comments for TIUDA1 and TIUDA2
D SWAPCOMM(TIUDA1,TIUDA2)
Q
RDSURG(SRODA,TIUDA) ; Redirect surgical case to new document
N DA,DIE,DR,TIUTYP S TIUTYP=$$TYPE(TIUDA) Q:TIUTYP']""
S DIE=130,DA=SRODA,DR=$S(TIUTYP="OS":1000,TIUTYP="PR":1002,1:"")
S DR=DR_"////^S X=TIUDA" D ^DIE
Q
RDTIU(TIUDA,SRODA) ; Redirect document to new surgical case
N DA,DIE,DR,SROVP S SROVP=SRODA_";SRF("
S DIE=8925,DA=TIUDA,DR="1405////^S X=SROVP" D ^DIE
Q
SWAPCOMM(TIUDA1,TIUDA2) ; Swap the comments field for two TIU Documents
N DA,DIE,DR,COMM1,COMM2
S COMM1=$G(^TIU(8925,TIUDA1,17)),COMM2=$G(^TIU(8925,TIUDA2,17))
S DA=TIUDA1,DIE=8925,DR="1701////^S X=COMM2" D ^DIE
S DA=TIUDA2,DIE=8925,DR="1701////^S X=COMM1" D ^DIE
Q
TIUSROI1 ; SLC/JER - Reassign actions ; 04/19/2004
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173**;Jun 20, 1997
+2 QUIT
FROMTO(TIUODA,TIUDA,TIUTNM) ; Display the from/to information
+1 NEW TIUF,TIUF12,TIUT,TIUT12,TIUFEDT,TIUFLDT,TIUTEDT,TIUTLDT
+2 DO GETTIU^TIULD(.TIUF,+TIUODA)
+3 DO GETTIU^TIULD(.TIUT,+TIUDA)
+4 SET TIUFEDT=$$DATE^TIULS($PIECE(TIUF("EDT"),U),"MM/DD/YY HR:MIN")
+5 SET TIUFLDT=$$DATE^TIULS($PIECE(TIUF("LDT"),U),"MM/DD/YY HR:MIN")
+6 SET TIUTEDT=$$DATE^TIULS($PIECE(TIUT("EDT"),U),"MM/DD/YY HR:MIN")
+7 SET TIUTLDT=$$DATE^TIULS($PIECE(TIUT("LDT"),U),"MM/DD/YY HR:MIN")
+8 SET TIUF12=$GET(^TIU(8925,TIUODA,12))
SET TIUT12=$GET(^TIU(8925,TIUDA,12))
+9 WRITE !!,"You are about to move the ",TIUTNM," as follows:",!
+10 WRITE !,?5,"From",?45,"To",!
+11 WRITE !,$PIECE(TIUF("DOCTYP"),U,2),?35," --> ",?40,$PIECE(TIUT("DOCTYP"),U,2)
+12 WRITE !,TIUF("PNM")," ",TIUF("PID"),?35," --> ",?40,TIUT("PNM")," ",TIUT("PID")
+13 WRITE !,TIUFEDT,$SELECT(+TIUFLDT:" - "_TIUFLDT,1:""),?35," --> "
+14 WRITE ?40,TIUTEDT,$SELECT(+TIUTLDT:" - "_TIUTLDT,1:""),!
+15 WRITE !," Surgeon: ",$$PERSNAME^TIULC1(+$PIECE(TIUF12,U,2)),?35," --> "
+16 WRITE ?40,$$PERSNAME^TIULC1(+$PIECE(TIUF12,U,2))
+17 WRITE !," Attending: ",$$PERSNAME^TIULC1(+$PIECE(TIUF12,U,9)),?35," --> "
+18 WRITE ?40,$$PERSNAME^TIULC1(+$PIECE(TIUT12,U,9))
+19 WRITE !,"Surg. Case #: ",+$PIECE($GET(^TIU(8925,TIUODA,14)),U,5),?35," --> "
+20 WRITE ?40,+$PIECE($GET(^TIU(8925,TIUDA,14)),U,5),!
+21 QUIT +$$READ^TIUU("YA"," ... Ok? ","NO")
ANES(TIUDA) ; Roll back ANESTHESIA REPORT when TIU changes require it
+1 NEW SRODA
SET SRODA=+$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
+2 IF +SRODA'>0
QUIT
+3 DO ANES^SROTIUD(SRODA)
+4 QUIT
NURS(TIUDA) ; Roll back NURSE INTRAOPERATIVE REPORT when TIU changes require it
+1 NEW SRODA
SET SRODA=+$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
+2 IF +SRODA'>0
QUIT
+3 DO NURS^SROTIUD(SRODA)
+4 QUIT
RETRACT(TIUDA) ;
+1 NEW CNT,TITLE,TIUACT,TIUDATA
+2 SET TIUDATA="ANESTHESIA REPORTS^NURSE INTRAOPERATIVE REPORTS^OPERATION REPORTS^PROCEDURE REPORT (NON-O.R.)"
+3 FOR CNT=1:1:$LENGTH(TIUDATA,U)
SET TITLE=$PIECE(TIUDATA,U,CNT)
IF $$BELONGS^TIULX(TIUDA,$$FIND1^DIC(8925.1,"","BX",TITLE))
Begin DoDot:1
+4 SET TIUACT=$SELECT(CNT=1:"ANES^TIUSROI1(TIUDA)",CNT=2:"NURS^TIUSROI1(TIUDA)",CNT=3:"RBOR^TIUSROI(TIUDA)",CNT=4:"RBPR^TIUSROI(TIUDA)",1:"QUIT")
+5 IF TIUACT="QUIT"
QUIT
+6 DO @TIUACT
End DoDot:1
+7 QUIT
CHANGE(TIUDA) ; Redirect the TIU Document to a different Surgical Case
+1 NEW DFN,SROVP,TIUD0,TIUD14,TIUNDA,TIUACT
+2 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD14=$GET(^(14))
SET SROVP=$PIECE(TIUD14,U,5)
+3 SET DFN=$PIECE(TIUD0,U,2)
IF +DFN'>0
QUIT
+4 ; choose destination case
+5 WRITE !
SET SROVP=$$GETCASE^TIUSROI(DFN)
+6 ; if no case is selected, quit
+7 IF +SROVP'>0
Begin DoDot:1
+8 WRITE !!,$CHAR(7),"Okay, no harm done...",!
+9 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+10 ; if target case is same as current, quit
+11 IF +SROVP=+$PIECE(TIUD14,U,5)
Begin DoDot:1
+12 WRITE !!,$CHAR(7),"You've selected the original case. No changes made.",!
+13 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+14 ; Get the document for the target surgical case
+15 SET TIUNDA=$$TARGET(SROVP)
+16 ; if target document is of a different type than source, quit
+17 IF $$TYPE(TIUNDA)'=$$TYPE(TIUDA)
Begin DoDot:1
+18 WRITE !!,$CHAR(7),"Incompatible document type. No changes made.",!
+19 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+20 ; if target case has empty report, replace
+21 SET TIUTYP=+TIUD0
+22 SET TIUTNM=$$PNAME^TIULC1(TIUTYP)
+23 IF '$$FROMTO^TIUSROI1(TIUDA,TIUNDA,TIUTNM)
Begin DoDot:1
+24 WRITE !!,"Aborting Transaction, No Harm Done...",!
+25 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+26 IF +$$EMPTYDOC^TIULF(TIUNDA)
Begin DoDot:1
+27 WRITE !!,"Moving document ",TIUDA," to Surgical Case #",+SROVP,"...",!
+28 IF '+$$READ^TIUU("YA","Are you sure? ","NO")
QUIT
+29 DO REPLACE(TIUDA,TIUNDA)
End DoDot:1
QUIT
+30 ; else, ask whether to swap or replace
+31 SET TIUACT=$$ASKACT($$TITLE(TIUNDA))
+32 IF $PIECE(TIUACT,U)="E"!($PIECE(TIUACT,U)="")
Begin DoDot:1
+33 WRITE !!,"Great. No harm done.",!
+34 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+35 IF $PIECE(TIUACT,U)="R"
Begin DoDot:1
+36 WRITE !!,"Replacing ",$$TITLE(TIUNDA)," on Surgical Case #",+SROVP,"...",!
+37 IF '+$$READ^TIUU("YA","Are you sure? ","NO")
QUIT
+38 DO REPLACE(TIUDA,TIUNDA)
End DoDot:1
QUIT
+39 IF $PIECE(TIUACT,U)="S"
Begin DoDot:1
+40 WRITE !!,"Swapping with ",$$TITLE(TIUNDA)," on Surgical Case #",+SROVP,"...",!
+41 IF '+$$READ^TIUU("YA","Are you sure? ","NO")
QUIT
+42 DO SWAP(TIUDA,TIUNDA)
End DoDot:1
+43 QUIT
ASKACT(TITLE) ; ask user to choose replace or swap
+1 NEW TIUY,TIUSET
SET TIUY=""
+2 WRITE !!,"Please choose the appropriate action for this "_TITLE_":"
+3 SET TIUSET="R:replace target document with this document"
+4 SET TIUSET=TIUSET_";S:swap target document with this document"
+5 SET TIUSET=TIUSET_";E:exit and do nothing"
+6 SET TIUY=$$READ^TIUU("S^"_TIUSET,"Select Action","exit")
+7 QUIT TIUY
TITLE(TIUDA) ; resolve title of document
+1 QUIT $PIECE($GET(^TIU(8925.1,+$GET(^TIU(8925,TIUDA,0)),0)),U)
TYPE(TIUDA) ; identifies type of document (i.e., Op Report or Proc Report)
+1 NEW TIUY,TIUCOR,TIUCPR
SET TIUY=""
+2 SET TIUCOR=+$$CLASS^TIUSROI("OPERATION REPORTS")
+3 SET TIUCPR=+$$CLASS^TIUSROI("PROCEDURE REPORT (NON-O.R.)")
+4 IF +$$ISA^TIULX(+$GET(^TIU(8925,TIUDA,0)),TIUCOR)
SET TIUY="OS"
IF 1
+5 IF '$TEST
IF +$$ISA^TIULX(+$GET(^TIU(8925,TIUDA,0)),TIUCPR)
SET TIUY="PR"
+6 QUIT TIUY
TARGET(TIUCASE) ; Get report ien for case
+1 NEW TIUI,TIUNDA,TIUCOR,TIUCPR
SET (TIUI,TIUNDA)=0
+2 SET TIUCOR=+$$CLASS^TIUSROI("OPERATION REPORTS")
+3 SET TIUCPR=+$$CLASS^TIUSROI("PROCEDURE REPORT (NON-O.R.)")
+4 FOR
SET TIUI=$ORDER(^TIU(8925,"G",TIUCASE,TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^TIU(8925,TIUI,0)),U,5)=15
QUIT
+6 IF +$$ISA^TIULX(+$GET(^TIU(8925,TIUI,0)),TIUCOR)
SET TIUNDA=TIUI
QUIT
+7 IF +$$ISA^TIULX(+$GET(^TIU(8925,TIUI,0)),TIUCPR)
SET TIUNDA=TIUI
End DoDot:1
IF +TIUNDA
QUIT
+8 QUIT TIUNDA
REPLACE(TIUDA1,TIUDA2) ; Replace TIUDA2 with TIUDA1
+1 NEW SRODA1,SRODA2,TIUD01,TIUD02,TIUD141,TIUD142,TIUTYPE,TIUNODEL
+2 SET TIUD01=$GET(^TIU(8925,TIUDA1,0))
SET TIUD02=$GET(^TIU(8925,TIUDA2,0))
+3 IF +TIUD01'=+TIUD02
Begin DoDot:1
+4 WRITE !!,$CHAR(7),"The two documents are of different types. No changes made.",!
+5 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+6 SET TIUD141=$GET(^TIU(8925,TIUDA1,14))
SET SRODA1=+$PIECE(TIUD141,U,5)
+7 SET TIUD142=$GET(^TIU(8925,TIUDA2,14))
SET SRODA2=+$PIECE(TIUD142,U,5)
+8 ; 1. Swap comments for TIUDA1 and TIUDA2
+9 DO SWAPCOMM(TIUDA1,TIUDA2)
+10 ; 2. Redirect TIUDA1 to TIUDA2's surgical case
+11 DO RDTIU(TIUDA1,SRODA2)
+12 ; 3. Redirect TIUDA2's surgical case to TIUDA1
+13 DO RDSURG(SRODA2,TIUDA1)
+14 ; 4. Delete or Retract TIUDA2
+15 IF +$PIECE(TIUD02,U,5)<6
DO DIK^TIURB2(TIUDA2,1)
IF 1
+16 IF '$TEST
SET TIUNODEL=1
SET TIUDA2=$$RETRACT^TIURD2(TIUDA2,"",14)
+17 ; 5. Rollback SRODA1 (create new stub)
+18 SET TIUTYPE=$$TYPE(TIUDA1)
+19 IF TIUTYPE="OS"
DO OS^SROTIUD(SRODA1)
IF 1
+20 IF '$TEST
IF TIUTYPE="PR"
DO NON^SROTIUD(SRODA1)
+21 QUIT
SWAP(TIUDA1,TIUDA2) ; Swap TIUDA1 with TIUDA2
+1 NEW SRODA1,SRODA2,TIUD01,TIUD02,TIUD141,TIUD142
+2 SET TIUD01=$GET(^TIU(8925,TIUDA1,0))
SET TIUD02=$GET(^TIU(8925,TIUDA2,0))
+3 IF +TIUD01'=+TIUD02
Begin DoDot:1
+4 WRITE !!,$CHAR(7),"The two documents are of different types. No changes made.",!
+5 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+6 SET TIUD141=$GET(^TIU(8925,TIUDA1,14))
SET SRODA1=+$PIECE(TIUD141,U,5)
+7 SET TIUD142=$GET(^TIU(8925,TIUDA2,14))
SET SRODA2=+$PIECE(TIUD142,U,5)
+8 ; 1. Redirect TIUDA1 to TIUDA2's surgical case
+9 DO RDTIU(TIUDA1,SRODA2)
+10 ; 2. Redirect TIUDA2 to TIUDA1's surgical case
+11 DO RDTIU(TIUDA2,SRODA1)
+12 ; 3. Redirect TIUDA1's surgical case to TIUDA2
+13 DO RDSURG(SRODA1,TIUDA2)
+14 ; 4. Redirect TIUDA2's surgical case to TIUDA1
+15 DO RDSURG(SRODA2,TIUDA1)
+16 ; 5. Swap comments for TIUDA1 and TIUDA2
+17 DO SWAPCOMM(TIUDA1,TIUDA2)
+18 QUIT
RDSURG(SRODA,TIUDA) ; Redirect surgical case to new document
+1 NEW DA,DIE,DR,TIUTYP
SET TIUTYP=$$TYPE(TIUDA)
IF TIUTYP']""
QUIT
+2 SET DIE=130
SET DA=SRODA
SET DR=$SELECT(TIUTYP="OS":1000,TIUTYP="PR":1002,1:"")
+3 SET DR=DR_"////^S X=TIUDA"
DO ^DIE
+4 QUIT
RDTIU(TIUDA,SRODA) ; Redirect document to new surgical case
+1 NEW DA,DIE,DR,SROVP
SET SROVP=SRODA_";SRF("
+2 SET DIE=8925
SET DA=TIUDA
SET DR="1405////^S X=SROVP"
DO ^DIE
+3 QUIT
SWAPCOMM(TIUDA1,TIUDA2) ; Swap the comments field for two TIU Documents
+1 NEW DA,DIE,DR,COMM1,COMM2
+2 SET COMM1=$GET(^TIU(8925,TIUDA1,17))
SET COMM2=$GET(^TIU(8925,TIUDA2,17))
+3 SET DA=TIUDA1
SET DIE=8925
SET DR="1701////^S X=COMM2"
DO ^DIE
+4 SET DA=TIUDA2
SET DIE=8925
SET DR="1701////^S X=COMM1"
DO ^DIE
+5 QUIT
