TIUEDITR ; SLC/JER - Enter/Edit a Document for Transcriber ;6/11/2002
;;1.0;TEXT INTEGRATION UTILITIES;**7,41,48,100,109,112**;Jun 20, 1997
; 2/2: Update DIE from TIUEDIT to TIUEDI4
MAIN(TIUCLASS) ; Control Branching
N TIUPREF,TIUOUT,TIUAUTH
; --- Get user's preferences ---
S TIUPREF=$$PERSPRF^TIULE(DUZ)
; --- Get the author to be used for multiple patients
S TIUAUTH=+$$AUTHOR^TIULA2
I TIUAUTH'>0 Q
F D Q:+$G(TIUOUT)
. N DFN,TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUNEW,TIUTYP,TIUDPRM
. N TIUASK,TIU,VAIN,VADM,TIULMETH,TIUVMETH,TIUENTRY,TIUEXIT,TIUCMMTX
. N DA ;10/3/00
. ;Removed with TIU*1*41 - Joel didn't think it was appropriate
. ;I $P(TIUPREF,U,6)="M" D MAIN^TIUEDIM(TIUCLASS,.TIUOUT) Q
. ; --- Get a patient ---
. S DFN=+$$PATIENT^TIULA I +DFN'>0 S TIUOUT=1 Q
. S TIUCLASS=$G(TIUCLASS,38)
. ; --- Get a document type ---
. D DOCSPICK^TIULA2(.TIUTYP,TIUCLASS,"1A","LAST","","$P(^TIU(8925.1,+Y,0),U,7)'=13,+$$CANENTR^TIULP(+Y)")
. I +$G(TIUTYP)'>0 S TIUOUT=1 Q
. S TIUTYP=+$P($G(TIUTYP(1)),U,2)
. ; --- Re-direct surgical reports ---
. I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS")) D ENTEROP^TIUSROI(DFN,TIUTYP) Q
. ; --- Initialize document parameters ---
. D DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
. ; --- If an ENTRY ACTION exists, execute it ---
. S TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)
. I $L(TIUENTRY) X TIUENTRY
. Q:+$G(TIUOUT) ; If entry action sets TIUOUT=1 Abort Entry
. ; --- Get associated visit ---
. I +$$SUPPVSIT^TIULC1(TIUTYP)'>0 D I 1
. . S TIULMETH=$$GETLMETH^TIUEDI1(TIUTYP)
. . I '$L(TIULMETH) D S TIUOUT=1 Q
. . . W !,$C(7),"No Visit Linkage Method defined for "
. . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
. . X TIULMETH
. E D
. . D EVENT^TIUSRVP1(.TIU,DFN)
. I $S($D(DIROUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 Q
. I '$D(TIU("VSTR")) D Q
. . W !,$C(7),"Patient & Visit required." H 2
. ; --- Validate Selection ---
. S TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)
. I '$L(TIUVMETH) D S TIUOUT=1 Q
. . W !,$C(7),"No Validation Method defined for "
. . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
. X TIUVMETH
. I $D(TIU),+$G(TIUASK) D
. . ;S DA=$$GETREC^TIUEDI1(DFN,.TIU,1,.TIUNEW,.TIUDPRM,1)
. . S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1)
. . I +DA'>0 W !,"Unable to enter/edit." Q
. . S TIUEDIT=$S('+$G(TIUNEW):$$CANDO^TIULP(DA,"EDIT RECORD"),1:1)
. . I '+TIUEDIT D Q
. . . W !,$P(TIUEDIT,U,2) ; Echo denial message
. . . D ADDENDUM^TIUADD(DA,"",.TIUCHNG)
. . N TIUQUIT,TIUADD
. . D DIE^TIUEDI4(DA,.TIUQUIT) Q:+$G(TIUQUIT)=2 ; **100**
. . ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
. . I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP),+$G(TIUQUIT)=1,+$P($G(^TIU(8925,+DA,14)),U,5)>0 Q
. . I $$EMPTYDOC^TIULF(DA) D DELETE^TIUEDIT(DA,0) S:'+$G(TIUNEW) TIUCHNG("DELETE")=1 H:'+$G(TIUNEW) 2 Q
. . Q:+$G(TIUQUIT)
. . I +$G(TIUONCE) S TIUNDA(+$G(DA))=""
. . I +$G(TIU("STOP")) D DEFER^TIUVSIT(DA,TIU("STOP")) I 1
. . E D QUE^TIUPXAP1
. . ; --- Execute COMMIT procedure ---
. . S TIUCMMTX=$$COMMIT^TIULC1(+$G(^TIU(8925,+DA,0)))
. . I TIUCMMTX]"" X TIUCMMTX
. . ; --- Execute RELEASE procedure ---
. . D RELEASE^TIUT(DA)
. . ; --- Execute VERIFY procedure ---
. . D VERIFY^TIUT(DA)
. . ; --- Execute SIGNATURE procedure ---
. . D EDSIG^TIURS(DA)
. . ; --- If an EXIT ACTION exists, execute it ---
. . S TIUEXIT=$$GETEXIT^TIUEDI2(+$P(TIUTYP(1),U,2))
. . I $L(TIUEXIT) X TIUEXIT
. . ; --- If required, prompt for print
. . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEDITR 3645 printed Oct 16, 2024@18:40:38 Page 2
TIUEDITR ; SLC/JER - Enter/Edit a Document for Transcriber ;6/11/2002
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**7,41,48,100,109,112**;Jun 20, 1997
+2 ; 2/2: Update DIE from TIUEDIT to TIUEDI4
MAIN(TIUCLASS) ; Control Branching
+1 NEW TIUPREF,TIUOUT,TIUAUTH
+2 ; --- Get user's preferences ---
+3 SET TIUPREF=$$PERSPRF^TIULE(DUZ)
+4 ; --- Get the author to be used for multiple patients
+5 SET TIUAUTH=+$$AUTHOR^TIULA2
+6 IF TIUAUTH'>0
QUIT
+7 FOR
Begin DoDot:1
+8 NEW DFN,TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUNEW,TIUTYP,TIUDPRM
+9 NEW TIUASK,TIU,VAIN,VADM,TIULMETH,TIUVMETH,TIUENTRY,TIUEXIT,TIUCMMTX
+10 ;10/3/00
NEW DA
+11 ;Removed with TIU*1*41 - Joel didn't think it was appropriate
+12 ;I $P(TIUPREF,U,6)="M" D MAIN^TIUEDIM(TIUCLASS,.TIUOUT) Q
+13 ; --- Get a patient ---
+14 SET DFN=+$$PATIENT^TIULA
IF +DFN'>0
SET TIUOUT=1
QUIT
+15 SET TIUCLASS=$GET(TIUCLASS,38)
+16 ; --- Get a document type ---
+17 DO DOCSPICK^TIULA2(.TIUTYP,TIUCLASS,"1A","LAST","","$P(^TIU(8925.1,+Y,0),U,7)'=13,+$$CANENTR^TIULP(+Y)")
+18 IF +$GET(TIUTYP)'>0
SET TIUOUT=1
QUIT
+19 SET TIUTYP=+$PIECE($GET(TIUTYP(1)),U,2)
+20 ; --- Re-direct surgical reports ---
+21 IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS"))
DO ENTEROP^TIUSROI(DFN,TIUTYP)
QUIT
+22 ; --- Initialize document parameters ---
+23 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
+24 ; --- If an ENTRY ACTION exists, execute it ---
+25 SET TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)
+26 IF $LENGTH(TIUENTRY)
XECUTE TIUENTRY
+27 ; If entry action sets TIUOUT=1 Abort Entry
if +$GET(TIUOUT)
QUIT
+28 ; --- Get associated visit ---
+29 IF +$$SUPPVSIT^TIULC1(TIUTYP)'>0
Begin DoDot:2
+30 SET TIULMETH=$$GETLMETH^TIUEDI1(TIUTYP)
+31 IF '$LENGTH(TIULMETH)
Begin DoDot:3
+32 WRITE !,$CHAR(7),"No Visit Linkage Method defined for "
+33 WRITE $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
End DoDot:3
SET TIUOUT=1
QUIT
+34 XECUTE TIULMETH
End DoDot:2
IF 1
+35 IF '$TEST
Begin DoDot:2
+36 DO EVENT^TIUSRVP1(.TIU,DFN)
End DoDot:2
+37 IF $SELECT($DATA(DIROUT):1,$DATA(DTOUT):1,1:0)
SET TIUQUIT=1
QUIT
+38 IF '$DATA(TIU("VSTR"))
Begin DoDot:2
+39 WRITE !,$CHAR(7),"Patient & Visit required."
HANG 2
End DoDot:2
QUIT
+40 ; --- Validate Selection ---
+41 SET TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)
+42 IF '$LENGTH(TIUVMETH)
Begin DoDot:2
+43 WRITE !,$CHAR(7),"No Validation Method defined for "
+44 WRITE $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
End DoDot:2
SET TIUOUT=1
QUIT
+45 XECUTE TIUVMETH
+46 IF $DATA(TIU)
IF +$GET(TIUASK)
Begin DoDot:2
+47 ;S DA=$$GETREC^TIUEDI1(DFN,.TIU,1,.TIUNEW,.TIUDPRM,1)
+48 SET DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1)
+49 IF +DA'>0
WRITE !,"Unable to enter/edit."
QUIT
+50 SET TIUEDIT=$SELECT('+$GET(TIUNEW):$$CANDO^TIULP(DA,"EDIT RECORD"),1:1)
+51 IF '+TIUEDIT
Begin DoDot:3
+52 ; Echo denial message
WRITE !,$PIECE(TIUEDIT,U,2)
+53 DO ADDENDUM^TIUADD(DA,"",.TIUCHNG)
End DoDot:3
QUIT
+54 NEW TIUQUIT,TIUADD
+55 ; **100**
DO DIE^TIUEDI4(DA,.TIUQUIT)
if +$GET(TIUQUIT)=2
QUIT
+56 ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
+57 IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP)
IF +$GET(TIUQUIT)=1
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,5)>0
QUIT
+58 IF $$EMPTYDOC^TIULF(DA)
DO DELETE^TIUEDIT(DA,0)
if '+$GET(TIUNEW)
SET TIUCHNG("DELETE")=1
if '+$GET(TIUNEW)
HANG 2
QUIT
+59 if +$GET(TIUQUIT)
QUIT
+60 IF +$GET(TIUONCE)
SET TIUNDA(+$GET(DA))=""
+61 IF +$GET(TIU("STOP"))
DO DEFER^TIUVSIT(DA,TIU("STOP"))
IF 1
+62 IF '$TEST
DO QUE^TIUPXAP1
+63 ; --- Execute COMMIT procedure ---
+64 SET TIUCMMTX=$$COMMIT^TIULC1(+$GET(^TIU(8925,+DA,0)))
+65 IF TIUCMMTX]""
XECUTE TIUCMMTX
+66 ; --- Execute RELEASE procedure ---
+67 DO RELEASE^TIUT(DA)
+68 ; --- Execute VERIFY procedure ---
+69 DO VERIFY^TIUT(DA)
+70 ; --- Execute SIGNATURE procedure ---
+71 DO EDSIG^TIURS(DA)
+72 ; --- If an EXIT ACTION exists, execute it ---
+73 SET TIUEXIT=$$GETEXIT^TIUEDI2(+$PIECE(TIUTYP(1),U,2))
+74 IF $LENGTH(TIUEXIT)
XECUTE TIUEXIT
+75 ; --- If required, prompt for print
+76 IF +$PIECE($GET(TIUDPRM(0)),U,8)
DO PRINT^TIUEPRNT(DA)
End DoDot:2
End DoDot:1
if +$GET(TIUOUT)
QUIT
+77 QUIT
