- 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 Feb 19, 2025@00:12:07 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