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

TIUSROI.m

Go to the documentation of this file.
  1. TIUSROI ; SLC/JER - TIU/Surgery Interface Routine ; 04/19/2004
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173**;Jun 20, 1997
  1. Q
  1. GETOP(TIUY,TIUDA,SROTYP) ; Get Op-Top
  1. N SROVP
  1. S SROVP=$P($G(^TIU(8925,TIUDA,14)),U,5),SROTYP=$G(SROTYP,"OP")
  1. S TIUY=$S(SROTYP="OP":$NA(^TMP("SROP",$J,+SROVP)),1:$NA(^TMP("SRNOR",$J,+SROVP)))
  1. I $P(SROVP,";",2)'="SRF(" Q
  1. D @$S(SROTYP="OP":"OPTOP^SROSRPT(+SROVP)",1:"OPTOP^SRONP(+SROVP)")
  1. I +$G(@TIUY@(0))=0 K @TIUY Q
  1. I '$D(XWBOS),'$D(ZTQUEUED),($E($G(IOST))="C"),(@TIUY@(0)=2) D
  1. . N SEEOP S SEEOP=0
  1. . I $S(+$D(XQADATA):1,$G(TIUEVNT)["SIGN":1,1:0) D Q:+SEEOP
  1. . . W ! S SEEOP=+$$READ^TIUU("YA","Do you want to see the Op Top? ","YES")
  1. . K @TIUY
  1. I $D(XWBOS),($G(@TIUY@(0))'=1) K @TIUY
  1. Q
  1. GETCASE(DFN,DA) ; Match Operation Report to an open Surgical Case
  1. ; Call with: [DFN] - patient file entry number
  1. ; Returns: TIUY - Variable pointer to Surgical Case
  1. AGN ; Loop for handling repeated attempts
  1. N TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUY,TIUMTSTR,TIUMLST,TIUCNT,X,TIULIST
  1. I +DFN'>0 S TIUOUT=1 Q 0
  1. I +$G(DA) D G:+TIUX>0 GETX
  1. . I +$P($G(^TIU(8925,+DA,14)),U,5) S TIUX=+$P($G(^(14)),U,5) Q
  1. . I +$$ISADDNDM^TIULC1(+DA) S TIUX=+$$DADSC(DA)
  1. 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
  1. D LIST^SROESTV(.TIULIST,DFN,"","","",0) ; Call Surgery to get list of cases
  1. ; If no Surgeries for patient, then quit
  1. I '$D(@TIULIST) D Q -1
  1. . W !!,$C(7),"No SURGICAL CASES to Result for ",$$PTNAME^TIULC1(DFN),".",!
  1. S (TIUCNT,TIUI)=0 F S TIUI=+$O(@TIULIST@(TIUI)) Q:+TIUI'>0 D
  1. . S TIUCNT=+$G(TIUCNT)+1
  1. W !,"You must link your Result to a SURGICAL CASE...",!
  1. D INDEX(TIULIST)
  1. D I +TIUER Q:+$G(TIUOUT) 0 G AGN
  1. . W !,"The following SURGICAL CASE",$S(+TIUCNT>1:"(S) are",1:" is")," available:"
  1. . S (TIUER,TIUOK,TIUI)=0
  1. . F S TIUI=$O(@TIULIST@(TIUI)) Q:+TIUI'>0!+TIUER!+TIUOK D
  1. . . S TIUII=TIUI,TIUX=$G(@TIULIST@(TIUI))
  1. . . D WRITE I '(TIUI#5) D BREAK
  1. . Q:$D(TIUOUT)
  1. . I +TIUER S TIUOUT=1 Q
  1. . I TIUII#5 D BREAK Q:$D(TIUOUT)
  1. . I +TIUER S TIUOUT=1 Q
  1. . S TIUX=+@TIULIST@(TIUOK),^DISV(DUZ,"^SRF(",DFN)=+TIUX
  1. . W " ",+TIUX
  1. GETX S TIUY=+TIUX_";SRF(" K @TIULIST
  1. Q $G(TIUY)
  1. BREAK ; Handle prompting
  1. W !,"CHOOSE 1-",TIUII W:$D(@TIULIST@(TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT" W ": " R X:DTIME
  1. I $S('$T!(X["^"):1,X=""&'$D(@TIULIST@(TIUII+1)):1,1:0) S TIUER=1 Q
  1. I X="" Q
  1. I X=" ",$D(^DISV(DUZ,"^SRF(",DFN)) S TIUX=^(DFN) S TIUOK=+$O(@TIULIST@("C",+TIUX,0)) Q
  1. I X'=+X!'$D(@TIULIST@(+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
  1. S TIUOK=X
  1. Q
  1. DADSC(DA) ; Get the Surgical Case associated with the parent record
  1. N TIUDADA,TIUY S TIUDADA=$P($G(^TIU(8925,+DA,0)),U,6)
  1. S TIUY=$P($G(^TIU(8925,TIUDADA,14)),U,5)
  1. Q TIUY
  1. WRITE ; Writes each case
  1. W !,$J(TIUI,4),"> ",$$DATE^TIULS($P(TIUX,U,3),"AMTH DD, CCYY")
  1. W " Case #",$P(TIUX,U),?34,$E($P(TIUX,U,2),1,25),?60,$E($P($P(TIUX,U,4),";",2),1,20)
  1. Q
  1. INDEX(TIULIST) ; Build index of list
  1. N TIUI S TIUI=0
  1. F S TIUI=$O(@TIULIST@(TIUI)) Q:+TIUI'>0 D
  1. . S @TIULIST@("C",+@TIULIST@(TIUI),TIUI)=""
  1. Q
  1. ISSURG(TIUY,TITLE) ; Boolean RPC to evaluate whether TITLE is a SURGERY REPORT
  1. N TIUCLASS,TIUI S TIUY=0
  1. F TIUI="SURGICAL REPORTS","PROCEDURE REPORTS (NON-O.R.)" D Q:TIUY>0
  1. . S TIUCLASS=+$$CLASS(TIUI)
  1. . I +TIUCLASS'>0 Q
  1. . S TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
  1. Q
  1. RBOR(TIUDA) ; Roll back OPERATION REPORT when TIU changes require it
  1. N SRODA S SRODA=+$P($G(^TIU(8925,TIUDA,14)),U,5) Q:+SRODA'>0
  1. D OS^SROTIUD(SRODA)
  1. Q
  1. RBPR(TIUDA) ; Roll back NON-O.R. PROC 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 NON^SROTIUD(SRODA)
  1. Q
  1. CLASS(CLNAME) ; What is the TIU Class (or Document Class) for SURGERY REPORTS
  1. N TIUY S TIUY=+$O(^TIU(8925.1,"B",CLNAME,0))
  1. 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
  1. Q TIUY
  1. ES(TIUDA,TIUDUZ) ; Apply user's e-Sig to Document
  1. N TIUES S TIUDUZ=$G(TIUDUZ,DUZ)
  1. I '+$G(^TIU(8925,TIUDA,0)) Q
  1. S TIUES="1^"_$$SIGNAME^TIULS(TIUDUZ)_U_$$SIGTITL^TIULS(TIUDUZ)
  1. D ES^TIURS(TIUDA,TIUES)
  1. Q
  1. ENTEROP(DFN,TIUTYP) ; Re-direct entry of Op and Proc Reports
  1. N TIUDA,TIUD0,TIUX,TIUPRM0,TIUPRM1,SUCCESS,TIUBUF,TIUTNM
  1. S TIUTNM=$$PNAME^TIULC1(TIUTYP)
  1. ; -- Exclude NIR and AR from Entry
  1. I $S(TIUTNM["ANESTH":1,TIUTNM["NURS":1,1:0) D Q
  1. . W !!,TIUTNM,"s may only be entered through the Surgery Options.",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . W !
  1. ; -- first, determine the correct TIU DOCUMENT record --
  1. F D Q:$D(DUOUT)!$D(DIROUT)!+$G(TIUOUT)
  1. . N D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV
  1. . S X=+$G(DFN)
  1. . I X'>0 D Q
  1. . . W !!,"No Patient Specified...",!
  1. . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . . S TIUOUT=1 W !
  1. . S DIC=8925,DIC(0)="UXEV",D="C"
  1. . W ! S DIC("W")="D DICW^TIUPUTS(+Y)",DIC("S")="I +$G(^TIU(8925,+Y,0))=TIUTYP"
  1. . D IX^DIC
  1. . I +Y'>0 D Q
  1. . . W !!,$S(+$O(^TIU(8925,"C",+X,0))'>0:"No "_TIUTNM_"s Available.",1:"No "_TIUTNM_" Selected..."),!
  1. . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . . S TIUOUT=1 W !
  1. . D BROWS1^TIURA2("TIU BROWSE FOR TRANSCRIPTION",+Y)
  1. . S TIUOUT=1 W !
  1. Q
  1. REASSOP(DFN,TIUODA) ; Re-direct REASSIGNMENT of Op and Proc Reports
  1. N TIUDA,TIUD0,TIUD12,TIUTYP,TIUTNM,TIUSCRN
  1. S TIUD0(0)=$G(^TIU(8925,+TIUODA,0)),TIUD12(0)=$G(^(12))
  1. I DFN=$P(TIUD0(0),U,2) D CHANGE^TIUSROI1(TIUODA) Q
  1. S TIUTYP=+TIUD0(0)
  1. S TIUTNM=$$PNAME^TIULC1(TIUTYP)
  1. I +$$ISADDNDM^TIULC1(TIUODA),$S($$GET1^DIQ(8925,TIUODA,.06)["ANESTH":1,$$GET1^DIQ(8925,TIUODA,.06)["NURS":1,1:0) D G REASSOPX
  1. . W !!,"ADDENDUMs to ",$$GET1^DIQ(8925,TIUODA,.06),"s may not be reassigned.",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...")
  1. . S TIUOUT=1 W !
  1. S TIUDA=0
  1. I $S(TIUTNM["ANESTH":1,TIUTNM["NURS":1,1:0) D G REASSOPX
  1. . W !!,TIUTNM,"s may only be created through the Surgery Options..."
  1. . W !,"Reassignment is not allowed.",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . S TIUOUT=1 W !
  1. W ! S SROVP=$$GETCASE^TIUSROI(DFN)
  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(^TIU(8925,TIUODA,14),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 TIUDA=$$TARGET^TIUSROI1(SROVP)
  1. ; if target document is of a different type than source, quit
  1. I $$TYPE^TIUSROI1(TIUDA)'=$$TYPE^TIUSROI1(TIUODA) D Q
  1. . W !!,$C(7),"Incompatible document type. No changes made.",!
  1. . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
  1. I +TIUDA'>0 D G REASSOPX
  1. . W !!,"No Destination Document Selected: Aborting Transaction,",!," No Harm Done...",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. ; -- If original and target are the same --
  1. I +TIUDA=+TIUODA D G REASSOPX
  1. . W !!,$C(7),"You've selected the original case. No changes made.",!
  1. . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
  1. ; -- Confirm selection --
  1. I '$$FROMTO^TIUSROI1(TIUODA,TIUDA,TIUTNM) D G REASSOPX
  1. . W !!,"Aborting Transaction, No Harm Done...",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. ; -- Conditionally Retract Original --
  1. I (+$P(TIUD0(0),U,5)>5) D
  1. . 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...")
  1. . W !!,TIUMSG,!,"A RETRACTED copy will be retained.",!
  1. . S TIURTCT=$$RETRACT^TIURD2(TIUODA,"",15)
  1. ; -- Copy AUTHOR from original to target/Update target status --
  1. D AUTHSTAT(TIUDA,TIUODA,.TIUD12)
  1. ; -- Copy contents of original into target --
  1. D COPYTEXT^TIURC1(TIUODA,TIUDA) K ^TIU(8925,TIUDA,15)
  1. I $D(^TIU(8925,TIUDA,"TEMP")) D
  1. . N TIU
  1. . D GETTIU^TIULD(.TIU,TIUDA)
  1. . D MERGTEXT^TIUEDI1(TIUDA,.TIU)
  1. . K ^TIU(8925,TIUDA,"TEMP")
  1. ; -- Conditionally roll back original --
  1. I +$P(TIUD0(0),U,5)>5 D
  1. . N TIUDA,TIUDELX
  1. . S TIUDA=TIUODA
  1. . S TIUDELX=$$DELETE^TIULC1(+$G(TIUD0(0)))
  1. . I TIUDELX]"" X TIUDELX
  1. I +$P(TIUD0(0),U,5)'>5 D
  1. . N TIUX,SUCCESS
  1. . K ^TIU(8925,TIUODA,"TEXT")
  1. . S TIUX(.05)=1
  1. . D FILE^TIUSRVP(.SUCCESS,TIUODA,.TIUX,1)
  1. ; -- Send Signature Alerts for target --
  1. D SEND^TIUALRT(TIUDA)
  1. ; -- Delete Signature Alerts for Original --
  1. D ALERTDEL^TIUALRT(TIUODA)
  1. ; -- Audit Reassignment of target --
  1. S TIUD0(1)=$G(^TIU(8925,+TIUDA,0)),TIUD12(1)=$G(^(12))
  1. D AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
  1. ; -- Register audit trail for original
  1. I +$G(TIUODA) D AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
  1. S TIUCHNG=1
  1. REASSOPX Q
  1. AUTHSTAT(TIUDA,TIUODA,TIUD12) ; Copy Author, update status
  1. N TIUX,SUCCESS
  1. S TIUX(.05)=5
  1. S TIUX(1406)=TIUODA
  1. I +$P(TIUD12(0),U,2) S TIUX(1202)=$P(TIUD12(0),U,2)
  1. D FILE^TIUSRVP(.SUCCESS,TIUDA,.TIUX,1)
  1. Q
  1. SELOP(DFN,TIUTYP,TIUSCRN) ; Select an Op or Proc Report
  1. N DUOUT,DTOUT,D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV,TIUY,TIUTNM
  1. S TIUY=0
  1. S TIUTNM=$$PNAME^TIULC1(TIUTYP)
  1. S TIUSCRN=$G(TIUSCRN,"I +$G(^TIU(8925,+Y,0))=TIUTYP")
  1. S X=+$G(DFN)
  1. I X'>0 D G SELOPX
  1. . W !!,"No Patient Specified...",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . W !
  1. S DIC=8925,DIC(0)="UXEV",D="C"
  1. W !
  1. S DIC("W")="D DICW^TIUPUTS(+Y)"
  1. S DIC("S")=TIUSCRN
  1. D IX^DIC
  1. I +Y'>0 D
  1. . W !!,"No "_TIUTNM
  1. . W $S(+$O(^TIU(8925,"APT",DFN,TIUTYP,0))'>0:"s On File.",+$O(^(0))>2:"s Available.",1:" Selected..."),!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. . W !
  1. S TIUY=+Y
  1. SELOPX Q TIUY