TIUSROI ; SLC/JER - TIU/Surgery Interface Routine ; 04/19/2004
;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173**;Jun 20, 1997
Q
GETOP(TIUY,TIUDA,SROTYP) ; Get Op-Top
N SROVP
S SROVP=$P($G(^TIU(8925,TIUDA,14)),U,5),SROTYP=$G(SROTYP,"OP")
S TIUY=$S(SROTYP="OP":$NA(^TMP("SROP",$J,+SROVP)),1:$NA(^TMP("SRNOR",$J,+SROVP)))
I $P(SROVP,";",2)'="SRF(" Q
D @$S(SROTYP="OP":"OPTOP^SROSRPT(+SROVP)",1:"OPTOP^SRONP(+SROVP)")
I +$G(@TIUY@(0))=0 K @TIUY Q
I '$D(XWBOS),'$D(ZTQUEUED),($E($G(IOST))="C"),(@TIUY@(0)=2) D
. N SEEOP S SEEOP=0
. I $S(+$D(XQADATA):1,$G(TIUEVNT)["SIGN":1,1:0) D Q:+SEEOP
. . W ! S SEEOP=+$$READ^TIUU("YA","Do you want to see the Op Top? ","YES")
. K @TIUY
I $D(XWBOS),($G(@TIUY@(0))'=1) K @TIUY
Q
GETCASE(DFN,DA) ; Match Operation Report to an open Surgical Case
; Call with: [DFN] - patient file entry number
; Returns: TIUY - Variable pointer to Surgical Case
AGN ; Loop for handling repeated attempts
N TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUY,TIUMTSTR,TIUMLST,TIUCNT,X,TIULIST
I +DFN'>0 S TIUOUT=1 Q 0
I +$G(DA) D G:+TIUX>0 GETX
. I +$P($G(^TIU(8925,+DA,14)),U,5) S TIUX=+$P($G(^(14)),U,5) Q
. I +$$ISADDNDM^TIULC1(+DA) S TIUX=+$$DADSC(DA)
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
D LIST^SROESTV(.TIULIST,DFN,"","","",0) ; Call Surgery to get list of cases
; If no Surgeries for patient, then quit
I '$D(@TIULIST) D Q -1
. W !!,$C(7),"No SURGICAL CASES to Result for ",$$PTNAME^TIULC1(DFN),".",!
S (TIUCNT,TIUI)=0 F S TIUI=+$O(@TIULIST@(TIUI)) Q:+TIUI'>0 D
. S TIUCNT=+$G(TIUCNT)+1
W !,"You must link your Result to a SURGICAL CASE...",!
D INDEX(TIULIST)
D I +TIUER Q:+$G(TIUOUT) 0 G AGN
. W !,"The following SURGICAL CASE",$S(+TIUCNT>1:"(S) are",1:" is")," available:"
. S (TIUER,TIUOK,TIUI)=0
. F S TIUI=$O(@TIULIST@(TIUI)) Q:+TIUI'>0!+TIUER!+TIUOK D
. . S TIUII=TIUI,TIUX=$G(@TIULIST@(TIUI))
. . D WRITE I '(TIUI#5) D BREAK
. Q:$D(TIUOUT)
. I +TIUER S TIUOUT=1 Q
. I TIUII#5 D BREAK Q:$D(TIUOUT)
. I +TIUER S TIUOUT=1 Q
. S TIUX=+@TIULIST@(TIUOK),^DISV(DUZ,"^SRF(",DFN)=+TIUX
. W " ",+TIUX
GETX S TIUY=+TIUX_";SRF(" K @TIULIST
Q $G(TIUY)
BREAK ; Handle prompting
W !,"CHOOSE 1-",TIUII W:$D(@TIULIST@(TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT" W ": " R X:DTIME
I $S('$T!(X["^"):1,X=""&'$D(@TIULIST@(TIUII+1)):1,1:0) S TIUER=1 Q
I X="" Q
I X=" ",$D(^DISV(DUZ,"^SRF(",DFN)) S TIUX=^(DFN) S TIUOK=+$O(@TIULIST@("C",+TIUX,0)) Q
I X'=+X!'$D(@TIULIST@(+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
S TIUOK=X
Q
DADSC(DA) ; Get the Surgical Case associated with the parent record
N TIUDADA,TIUY S TIUDADA=$P($G(^TIU(8925,+DA,0)),U,6)
S TIUY=$P($G(^TIU(8925,TIUDADA,14)),U,5)
Q TIUY
WRITE ; Writes each case
W !,$J(TIUI,4),"> ",$$DATE^TIULS($P(TIUX,U,3),"AMTH DD, CCYY")
W " Case #",$P(TIUX,U),?34,$E($P(TIUX,U,2),1,25),?60,$E($P($P(TIUX,U,4),";",2),1,20)
Q
INDEX(TIULIST) ; Build index of list
N TIUI S TIUI=0
F S TIUI=$O(@TIULIST@(TIUI)) Q:+TIUI'>0 D
. S @TIULIST@("C",+@TIULIST@(TIUI),TIUI)=""
Q
ISSURG(TIUY,TITLE) ; Boolean RPC to evaluate whether TITLE is a SURGERY REPORT
N TIUCLASS,TIUI S TIUY=0
F TIUI="SURGICAL REPORTS","PROCEDURE REPORTS (NON-O.R.)" D Q:TIUY>0
. S TIUCLASS=+$$CLASS(TIUI)
. I +TIUCLASS'>0 Q
. S TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
Q
RBOR(TIUDA) ; Roll back OPERATION REPORT when TIU changes require it
N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5) Q:+SRODA'>0
D OS^SROTIUD(SRODA)
Q
RBPR(TIUDA) ; Roll back NON-O.R. PROC REPORT when TIU changes require it
N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5)
Q:+SRODA'>0
D NON^SROTIUD(SRODA)
Q
CLASS(CLNAME) ; What is the TIU Class (or Document Class) for SURGERY REPORTS
N TIUY S TIUY=+$O(^TIU(8925.1,"B",CLNAME,0))
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
Q TIUY
ES(TIUDA,TIUDUZ) ; Apply user's e-Sig to Document
N TIUES S TIUDUZ=$G(TIUDUZ,DUZ)
I '+$G(^TIU(8925,TIUDA,0)) Q
S TIUES="1^"_$$SIGNAME^TIULS(TIUDUZ)_U_$$SIGTITL^TIULS(TIUDUZ)
D ES^TIURS(TIUDA,TIUES)
Q
ENTEROP(DFN,TIUTYP) ; Re-direct entry of Op and Proc Reports
N TIUDA,TIUD0,TIUX,TIUPRM0,TIUPRM1,SUCCESS,TIUBUF,TIUTNM
S TIUTNM=$$PNAME^TIULC1(TIUTYP)
; -- Exclude NIR and AR from Entry
I $S(TIUTNM["ANESTH":1,TIUTNM["NURS":1,1:0) D Q
. W !!,TIUTNM,"s may only be entered through the Surgery Options.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. W !
; -- first, determine the correct TIU DOCUMENT record --
F D Q:$D(DUOUT)!$D(DIROUT)!+$G(TIUOUT)
. N D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV
. S X=+$G(DFN)
. I X'>0 D Q
. . W !!,"No Patient Specified...",!
. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. . S TIUOUT=1 W !
. S DIC=8925,DIC(0)="UXEV",D="C"
. W ! S DIC("W")="D DICW^TIUPUTS(+Y)",DIC("S")="I +$G(^TIU(8925,+Y,0))=TIUTYP"
. D IX^DIC
. I +Y'>0 D Q
. . W !!,$S(+$O(^TIU(8925,"C",+X,0))'>0:"No "_TIUTNM_"s Available.",1:"No "_TIUTNM_" Selected..."),!
. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. . S TIUOUT=1 W !
. D BROWS1^TIURA2("TIU BROWSE FOR TRANSCRIPTION",+Y)
. S TIUOUT=1 W !
Q
REASSOP(DFN,TIUODA) ; Re-direct REASSIGNMENT of Op and Proc Reports
N TIUDA,TIUD0,TIUD12,TIUTYP,TIUTNM,TIUSCRN
S TIUD0(0)=$G(^TIU(8925,+TIUODA,0)),TIUD12(0)=$G(^(12))
I DFN=$P(TIUD0(0),U,2) D CHANGE^TIUSROI1(TIUODA) Q
S TIUTYP=+TIUD0(0)
S TIUTNM=$$PNAME^TIULC1(TIUTYP)
I +$$ISADDNDM^TIULC1(TIUODA),$S($$GET1^DIQ(8925,TIUODA,.06)["ANESTH":1,$$GET1^DIQ(8925,TIUODA,.06)["NURS":1,1:0) D G REASSOPX
. W !!,"ADDENDUMs to ",$$GET1^DIQ(8925,TIUODA,.06),"s may not be reassigned.",!
. I $$READ^TIUU("EA","Press RETURN to continue...")
. S TIUOUT=1 W !
S TIUDA=0
I $S(TIUTNM["ANESTH":1,TIUTNM["NURS":1,1:0) D G REASSOPX
. W !!,TIUTNM,"s may only be created through the Surgery Options..."
. W !,"Reassignment is not allowed.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. S TIUOUT=1 W !
W ! S SROVP=$$GETCASE^TIUSROI(DFN)
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(^TIU(8925,TIUODA,14),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 TIUDA=$$TARGET^TIUSROI1(SROVP)
; if target document is of a different type than source, quit
I $$TYPE^TIUSROI1(TIUDA)'=$$TYPE^TIUSROI1(TIUODA) D Q
. W !!,$C(7),"Incompatible document type. No changes made.",!
. W:$$READ^TIUU("EA","Press RETURN to continue...") ""
I +TIUDA'>0 D G REASSOPX
. W !!,"No Destination Document Selected: Aborting Transaction,",!," No Harm Done...",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
; -- If original and target are the same --
I +TIUDA=+TIUODA D G REASSOPX
. W !!,$C(7),"You've selected the original case. No changes made.",!
. W:$$READ^TIUU("EA","Press RETURN to continue...") ""
; -- Confirm selection --
I '$$FROMTO^TIUSROI1(TIUODA,TIUDA,TIUTNM) D G REASSOPX
. W !!,"Aborting Transaction, No Harm Done...",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
; -- Conditionally Retract Original --
I (+$P(TIUD0(0),U,5)>5) D
. 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...")
. W !!,TIUMSG,!,"A RETRACTED copy will be retained.",!
. S TIURTCT=$$RETRACT^TIURD2(TIUODA,"",15)
; -- Copy AUTHOR from original to target/Update target status --
D AUTHSTAT(TIUDA,TIUODA,.TIUD12)
; -- Copy contents of original into target --
D COPYTEXT^TIURC1(TIUODA,TIUDA) K ^TIU(8925,TIUDA,15)
I $D(^TIU(8925,TIUDA,"TEMP")) D
. N TIU
. D GETTIU^TIULD(.TIU,TIUDA)
. D MERGTEXT^TIUEDI1(TIUDA,.TIU)
. K ^TIU(8925,TIUDA,"TEMP")
; -- Conditionally roll back original --
I +$P(TIUD0(0),U,5)>5 D
. N TIUDA,TIUDELX
. S TIUDA=TIUODA
. S TIUDELX=$$DELETE^TIULC1(+$G(TIUD0(0)))
. I TIUDELX]"" X TIUDELX
I +$P(TIUD0(0),U,5)'>5 D
. N TIUX,SUCCESS
. K ^TIU(8925,TIUODA,"TEXT")
. S TIUX(.05)=1
. D FILE^TIUSRVP(.SUCCESS,TIUODA,.TIUX,1)
; -- Send Signature Alerts for target --
D SEND^TIUALRT(TIUDA)
; -- Delete Signature Alerts for Original --
D ALERTDEL^TIUALRT(TIUODA)
; -- Audit Reassignment of target --
S TIUD0(1)=$G(^TIU(8925,+TIUDA,0)),TIUD12(1)=$G(^(12))
D AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
; -- Register audit trail for original
I +$G(TIUODA) D AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
S TIUCHNG=1
REASSOPX Q
AUTHSTAT(TIUDA,TIUODA,TIUD12) ; Copy Author, update status
N TIUX,SUCCESS
S TIUX(.05)=5
S TIUX(1406)=TIUODA
I +$P(TIUD12(0),U,2) S TIUX(1202)=$P(TIUD12(0),U,2)
D FILE^TIUSRVP(.SUCCESS,TIUDA,.TIUX,1)
Q
SELOP(DFN,TIUTYP,TIUSCRN) ; Select an Op or Proc Report
N DUOUT,DTOUT,D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV,TIUY,TIUTNM
S TIUY=0
S TIUTNM=$$PNAME^TIULC1(TIUTYP)
S TIUSCRN=$G(TIUSCRN,"I +$G(^TIU(8925,+Y,0))=TIUTYP")
S X=+$G(DFN)
I X'>0 D G SELOPX
. W !!,"No Patient Specified...",!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. W !
S DIC=8925,DIC(0)="UXEV",D="C"
W !
S DIC("W")="D DICW^TIUPUTS(+Y)"
S DIC("S")=TIUSCRN
D IX^DIC
I +Y'>0 D
. W !!,"No "_TIUTNM
. W $S(+$O(^TIU(8925,"APT",DFN,TIUTYP,0))'>0:"s On File.",+$O(^(0))>2:"s Available.",1:" Selected..."),!
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
. W !
S TIUY=+Y
SELOPX Q TIUY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSROI 9727 printed Apr 09, 2024@21:42:48 Page 2
TIUSROI ; SLC/JER - TIU/Surgery Interface Routine ; 04/19/2004
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173**;Jun 20, 1997
+2 QUIT
GETOP(TIUY,TIUDA,SROTYP) ; Get Op-Top
+1 NEW SROVP
+2 SET SROVP=$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
SET SROTYP=$GET(SROTYP,"OP")
+3 SET TIUY=$SELECT(SROTYP="OP":$NAME(^TMP("SROP",$JOB,+SROVP)),1:$NAME(^TMP("SRNOR",$JOB,+SROVP)))
+4 IF $PIECE(SROVP,";",2)'="SRF("
QUIT
+5 DO @$SELECT(SROTYP="OP":"OPTOP^SROSRPT(+SROVP)",1:"OPTOP^SRONP(+SROVP)")
+6 IF +$GET(@TIUY@(0))=0
KILL @TIUY
QUIT
+7 IF '$DATA(XWBOS)
IF '$DATA(ZTQUEUED)
IF ($EXTRACT($GET(IOST))="C")
IF (@TIUY@(0)=2)
Begin DoDot:1
+8 NEW SEEOP
SET SEEOP=0
+9 IF $SELECT(+$DATA(XQADATA):1,$GET(TIUEVNT)["SIGN":1,1:0)
Begin DoDot:2
+10 WRITE !
SET SEEOP=+$$READ^TIUU("YA","Do you want to see the Op Top? ","YES")
End DoDot:2
if +SEEOP
QUIT
+11 KILL @TIUY
End DoDot:1
+12 IF $DATA(XWBOS)
IF ($GET(@TIUY@(0))'=1)
KILL @TIUY
+13 QUIT
GETCASE(DFN,DA) ; Match Operation Report to an open Surgical Case
+1 ; Call with: [DFN] - patient file entry number
+2 ; Returns: TIUY - Variable pointer to Surgical Case
AGN ; Loop for handling repeated attempts
+1 NEW TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUY,TIUMTSTR,TIUMLST,TIUCNT,X,TIULIST
+2 IF +DFN'>0
SET TIUOUT=1
QUIT 0
+3 IF +$GET(DA)
Begin DoDot:1
+4 IF +$PIECE($GET(^TIU(8925,+DA,14)),U,5)
SET TIUX=+$PIECE($GET(^(14)),U,5)
QUIT
+5 IF +$$ISADDNDM^TIULC1(+DA)
SET TIUX=+$$DADSC(DA)
End DoDot:1
if +TIUX>0
GOTO GETX
+6 DO ISSURG^TIUSROI(.TIUY,+$GET(^TIU(8925,+TIUDA,0)))
IF +TIUY
WRITE !,"This action is no longer permitted for SURGICAL REPORTS"
HANG 3
QUIT 0
+7 ; Call Surgery to get list of cases
DO LIST^SROESTV(.TIULIST,DFN,"","","",0)
+8 ; If no Surgeries for patient, then quit
+9 IF '$DATA(@TIULIST)
Begin DoDot:1
+10 WRITE !!,$CHAR(7),"No SURGICAL CASES to Result for ",$$PTNAME^TIULC1(DFN),".",!
End DoDot:1
QUIT -1
+11 SET (TIUCNT,TIUI)=0
FOR
SET TIUI=+$ORDER(@TIULIST@(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+12 SET TIUCNT=+$GET(TIUCNT)+1
End DoDot:1
+13 WRITE !,"You must link your Result to a SURGICAL CASE...",!
+14 DO INDEX(TIULIST)
+15 Begin DoDot:1
+16 WRITE !,"The following SURGICAL CASE",$SELECT(+TIUCNT>1:"(S) are",1:" is")," available:"
+17 SET (TIUER,TIUOK,TIUI)=0
+18 FOR
SET TIUI=$ORDER(@TIULIST@(TIUI))
if +TIUI'>0!+TIUER!+TIUOK
QUIT
Begin DoDot:2
+19 SET TIUII=TIUI
SET TIUX=$GET(@TIULIST@(TIUI))
+20 DO WRITE
IF '(TIUI#5)
DO BREAK
End DoDot:2
+21 if $DATA(TIUOUT)
QUIT
+22 IF +TIUER
SET TIUOUT=1
QUIT
+23 IF TIUII#5
DO BREAK
if $DATA(TIUOUT)
QUIT
+24 IF +TIUER
SET TIUOUT=1
QUIT
+25 SET TIUX=+@TIULIST@(TIUOK)
SET ^DISV(DUZ,"^SRF(",DFN)=+TIUX
+26 WRITE " ",+TIUX
End DoDot:1
IF +TIUER
if +$GET(TIUOUT)
QUIT 0
GOTO AGN
GETX SET TIUY=+TIUX_";SRF("
KILL @TIULIST
+1 QUIT $GET(TIUY)
BREAK ; Handle prompting
+1 WRITE !,"CHOOSE 1-",TIUII
if $DATA(@TIULIST@(TIUII+1))
WRITE !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
WRITE ": "
READ X:DTIME
+2 IF $SELECT('$TEST!(X["^"):1,X=""&'$DATA(@TIULIST@(TIUII+1)):1,1:0)
SET TIUER=1
QUIT
+3 IF X=""
QUIT
+4 IF X=" "
IF $DATA(^DISV(DUZ,"^SRF(",DFN))
SET TIUX=^(DFN)
SET TIUOK=+$ORDER(@TIULIST@("C",+TIUX,0))
QUIT
+5 IF X'=+X!'$DATA(@TIULIST@(+X))
WRITE !!,$CHAR(7),"INVALID RESPONSE",!
GOTO BREAK
+6 SET TIUOK=X
+7 QUIT
DADSC(DA) ; Get the Surgical Case associated with the parent record
+1 NEW TIUDADA,TIUY
SET TIUDADA=$PIECE($GET(^TIU(8925,+DA,0)),U,6)
+2 SET TIUY=$PIECE($GET(^TIU(8925,TIUDADA,14)),U,5)
+3 QUIT TIUY
WRITE ; Writes each case
+1 WRITE !,$JUSTIFY(TIUI,4),"> ",$$DATE^TIULS($PIECE(TIUX,U,3),"AMTH DD, CCYY")
+2 WRITE " Case #",$PIECE(TIUX,U),?34,$EXTRACT($PIECE(TIUX,U,2),1,25),?60,$EXTRACT($PIECE($PIECE(TIUX,U,4),";",2),1,20)
+3 QUIT
INDEX(TIULIST) ; Build index of list
+1 NEW TIUI
SET TIUI=0
+2 FOR
SET TIUI=$ORDER(@TIULIST@(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+3 SET @TIULIST@("C",+@TIULIST@(TIUI),TIUI)=""
End DoDot:1
+4 QUIT
ISSURG(TIUY,TITLE) ; Boolean RPC to evaluate whether TITLE is a SURGERY REPORT
+1 NEW TIUCLASS,TIUI
SET TIUY=0
+2 FOR TIUI="SURGICAL REPORTS","PROCEDURE REPORTS (NON-O.R.)"
Begin DoDot:1
+3 SET TIUCLASS=+$$CLASS(TIUI)
+4 IF +TIUCLASS'>0
QUIT
+5 SET TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
End DoDot:1
if TIUY>0
QUIT
+6 QUIT
RBOR(TIUDA) ; Roll back OPERATION REPORT when TIU changes require it
+1 NEW SRODA
SET SRODA=+$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
if +SRODA'>0
QUIT
+2 DO OS^SROTIUD(SRODA)
+3 QUIT
RBPR(TIUDA) ; Roll back NON-O.R. PROC 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 NON^SROTIUD(SRODA)
+4 QUIT
CLASS(CLNAME) ; What is the TIU Class (or Document Class) for SURGERY REPORTS
+1 NEW TIUY
SET TIUY=+$ORDER(^TIU(8925.1,"B",CLNAME,0))
+2 IF +TIUY>0
IF $SELECT($PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)="CL":0,$PIECE($GET(^(0)),U,4)="DC":0,1:1)
SET TIUY=0
+3 QUIT TIUY
ES(TIUDA,TIUDUZ) ; Apply user's e-Sig to Document
+1 NEW TIUES
SET TIUDUZ=$GET(TIUDUZ,DUZ)
+2 IF '+$GET(^TIU(8925,TIUDA,0))
QUIT
+3 SET TIUES="1^"_$$SIGNAME^TIULS(TIUDUZ)_U_$$SIGTITL^TIULS(TIUDUZ)
+4 DO ES^TIURS(TIUDA,TIUES)
+5 QUIT
ENTEROP(DFN,TIUTYP) ; Re-direct entry of Op and Proc Reports
+1 NEW TIUDA,TIUD0,TIUX,TIUPRM0,TIUPRM1,SUCCESS,TIUBUF,TIUTNM
+2 SET TIUTNM=$$PNAME^TIULC1(TIUTYP)
+3 ; -- Exclude NIR and AR from Entry
+4 IF $SELECT(TIUTNM["ANESTH":1,TIUTNM["NURS":1,1:0)
Begin DoDot:1
+5 WRITE !!,TIUTNM,"s may only be entered through the Surgery Options.",!
+6 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+7 WRITE !
End DoDot:1
QUIT
+8 ; -- first, determine the correct TIU DOCUMENT record --
+9 FOR
Begin DoDot:1
+10 NEW D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV
+11 SET X=+$GET(DFN)
+12 IF X'>0
Begin DoDot:2
+13 WRITE !!,"No Patient Specified...",!
+14 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+15 SET TIUOUT=1
WRITE !
End DoDot:2
QUIT
+16 SET DIC=8925
SET DIC(0)="UXEV"
SET D="C"
+17 WRITE !
SET DIC("W")="D DICW^TIUPUTS(+Y)"
SET DIC("S")="I +$G(^TIU(8925,+Y,0))=TIUTYP"
+18 DO IX^DIC
+19 IF +Y'>0
Begin DoDot:2
+20 WRITE !!,$SELECT(+$ORDER(^TIU(8925,"C",+X,0))'>0:"No "_TIUTNM_"s Available.",1:"No "_TIUTNM_" Selected..."),!
+21 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+22 SET TIUOUT=1
WRITE !
End DoDot:2
QUIT
+23 DO BROWS1^TIURA2("TIU BROWSE FOR TRANSCRIPTION",+Y)
+24 SET TIUOUT=1
WRITE !
End DoDot:1
if $DATA(DUOUT)!$DATA(DIROUT)!+$GET(TIUOUT)
QUIT
+25 QUIT
REASSOP(DFN,TIUODA) ; Re-direct REASSIGNMENT of Op and Proc Reports
+1 NEW TIUDA,TIUD0,TIUD12,TIUTYP,TIUTNM,TIUSCRN
+2 SET TIUD0(0)=$GET(^TIU(8925,+TIUODA,0))
SET TIUD12(0)=$GET(^(12))
+3 IF DFN=$PIECE(TIUD0(0),U,2)
DO CHANGE^TIUSROI1(TIUODA)
QUIT
+4 SET TIUTYP=+TIUD0(0)
+5 SET TIUTNM=$$PNAME^TIULC1(TIUTYP)
+6 IF +$$ISADDNDM^TIULC1(TIUODA)
IF $SELECT($$GET1^DIQ(8925,TIUODA,.06)["ANESTH":1,$$GET1^DIQ(8925,TIUODA,.06)["NURS":1,1:0)
Begin DoDot:1
+7 WRITE !!,"ADDENDUMs to ",$$GET1^DIQ(8925,TIUODA,.06),"s may not be reassigned.",!
+8 IF $$READ^TIUU("EA","Press RETURN to continue...")
+9 SET TIUOUT=1
WRITE !
End DoDot:1
GOTO REASSOPX
+10 SET TIUDA=0
+11 IF $SELECT(TIUTNM["ANESTH":1,TIUTNM["NURS":1,1:0)
Begin DoDot:1
+12 WRITE !!,TIUTNM,"s may only be created through the Surgery Options..."
+13 WRITE !,"Reassignment is not allowed.",!
+14 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+15 SET TIUOUT=1
WRITE !
End DoDot:1
GOTO REASSOPX
+16 WRITE !
SET SROVP=$$GETCASE^TIUSROI(DFN)
+17 IF +SROVP'>0
Begin DoDot:1
+18 WRITE !!,$CHAR(7),"Okay, no harm done...",!
+19 if $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+20 ; if target case is same as current, quit
+21 IF +SROVP=+$PIECE(^TIU(8925,TIUODA,14),U,5)
Begin DoDot:1
+22 WRITE !!,$CHAR(7),"You've selected the original case. No changes made.",!
+23 if $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+24 ; Get the document for the target surgical case
+25 SET TIUDA=$$TARGET^TIUSROI1(SROVP)
+26 ; if target document is of a different type than source, quit
+27 IF $$TYPE^TIUSROI1(TIUDA)'=$$TYPE^TIUSROI1(TIUODA)
Begin DoDot:1
+28 WRITE !!,$CHAR(7),"Incompatible document type. No changes made.",!
+29 if $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+30 IF +TIUDA'>0
Begin DoDot:1
+31 WRITE !!,"No Destination Document Selected: Aborting Transaction,",!," No Harm Done...",!
+32 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
GOTO REASSOPX
+33 ; -- If original and target are the same --
+34 IF +TIUDA=+TIUODA
Begin DoDot:1
+35 WRITE !!,$CHAR(7),"You've selected the original case. No changes made.",!
+36 if $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
GOTO REASSOPX
+37 ; -- Confirm selection --
+38 IF '$$FROMTO^TIUSROI1(TIUODA,TIUDA,TIUTNM)
Begin DoDot:1
+39 WRITE !!,"Aborting Transaction, No Harm Done...",!
+40 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
GOTO REASSOPX
+41 ; -- Conditionally Retract Original --
+42 IF (+$PIECE(TIUD0(0),U,5)>5)
Begin DoDot:1
+43 NEW TIUMSG,TIURTCT
SET TIUMSG=$SELECT(DFN=+$PIECE(TIUD0(0),U,2):"Reassigning document...",DFN'=+$PIECE(TIUD0(0),U,2):"Moving signed document to another Patient...")
+44 WRITE !!,TIUMSG,!,"A RETRACTED copy will be retained.",!
+45 SET TIURTCT=$$RETRACT^TIURD2(TIUODA,"",15)
End DoDot:1
+46 ; -- Copy AUTHOR from original to target/Update target status --
+47 DO AUTHSTAT(TIUDA,TIUODA,.TIUD12)
+48 ; -- Copy contents of original into target --
+49 DO COPYTEXT^TIURC1(TIUODA,TIUDA)
KILL ^TIU(8925,TIUDA,15)
+50 IF $DATA(^TIU(8925,TIUDA,"TEMP"))
Begin DoDot:1
+51 NEW TIU
+52 DO GETTIU^TIULD(.TIU,TIUDA)
+53 DO MERGTEXT^TIUEDI1(TIUDA,.TIU)
+54 KILL ^TIU(8925,TIUDA,"TEMP")
End DoDot:1
+55 ; -- Conditionally roll back original --
+56 IF +$PIECE(TIUD0(0),U,5)>5
Begin DoDot:1
+57 NEW TIUDA,TIUDELX
+58 SET TIUDA=TIUODA
+59 SET TIUDELX=$$DELETE^TIULC1(+$GET(TIUD0(0)))
+60 IF TIUDELX]""
XECUTE TIUDELX
End DoDot:1
+61 IF +$PIECE(TIUD0(0),U,5)'>5
Begin DoDot:1
+62 NEW TIUX,SUCCESS
+63 KILL ^TIU(8925,TIUODA,"TEXT")
+64 SET TIUX(.05)=1
+65 DO FILE^TIUSRVP(.SUCCESS,TIUODA,.TIUX,1)
End DoDot:1
+66 ; -- Send Signature Alerts for target --
+67 DO SEND^TIUALRT(TIUDA)
+68 ; -- Delete Signature Alerts for Original --
+69 DO ALERTDEL^TIUALRT(TIUODA)
+70 ; -- Audit Reassignment of target --
+71 SET TIUD0(1)=$GET(^TIU(8925,+TIUDA,0))
SET TIUD12(1)=$GET(^(12))
+72 DO AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
+73 ; -- Register audit trail for original
+74 IF +$GET(TIUODA)
DO AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
+75 SET TIUCHNG=1
REASSOPX QUIT
AUTHSTAT(TIUDA,TIUODA,TIUD12) ; Copy Author, update status
+1 NEW TIUX,SUCCESS
+2 SET TIUX(.05)=5
+3 SET TIUX(1406)=TIUODA
+4 IF +$PIECE(TIUD12(0),U,2)
SET TIUX(1202)=$PIECE(TIUD12(0),U,2)
+5 DO FILE^TIUSRVP(.SUCCESS,TIUDA,.TIUX,1)
+6 QUIT
SELOP(DFN,TIUTYP,TIUSCRN) ; Select an Op or Proc Report
+1 NEW DUOUT,DTOUT,D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV,TIUY,TIUTNM
+2 SET TIUY=0
+3 SET TIUTNM=$$PNAME^TIULC1(TIUTYP)
+4 SET TIUSCRN=$GET(TIUSCRN,"I +$G(^TIU(8925,+Y,0))=TIUTYP")
+5 SET X=+$GET(DFN)
+6 IF X'>0
Begin DoDot:1
+7 WRITE !!,"No Patient Specified...",!
+8 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+9 WRITE !
End DoDot:1
GOTO SELOPX
+10 SET DIC=8925
SET DIC(0)="UXEV"
SET D="C"
+11 WRITE !
+12 SET DIC("W")="D DICW^TIUPUTS(+Y)"
+13 SET DIC("S")=TIUSCRN
+14 DO IX^DIC
+15 IF +Y'>0
Begin DoDot:1
+16 WRITE !!,"No "_TIUTNM
+17 WRITE $SELECT(+$ORDER(^TIU(8925,"APT",DFN,TIUTYP,0))'>0:"s On File.",+$ORDER(^(0))>2:"s Available.",1:" Selected..."),!
+18 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+19 WRITE !
End DoDot:1
+20 SET TIUY=+Y
SELOPX QUIT TIUY
