Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUSROI1

TIUSROI1.m

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