TIUEDIM ; SLC/JER - Enter/Edit Multiple Document ;01-Aug-2011 11:26;MGH
;;1.0;TEXT INTEGRATION UTILITIES;**7,41,52,100,109,112,1009**;Jun 20, 1997;Build 22
; 2/2: Update DIE from TIUEDIT to TIUEDI4
;IHS/ITSC/LJF 02/26/2003 added call to stuff V Note file
; added call to edit PCC visit
; 12/11/2003 review previous notes works for all notes
MAIN(TIUCLASS,TIUOUT,TIUNDA,TIUCHNG) ; Control Branching
N TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUNEW,TIUTYP,TIUPAT
N TIUI,DTOUT S TIUDFLT=""
K DIROUT
; --- Get one or more patients ---
I '$L($T(PATIENT^ORU1)) Q
D PATIENT^ORU1(.TIUPAT) I +TIUPAT'>0 S TIUOUT=1 Q
S TIUI=0 F S TIUI=+$O(TIUPAT(TIUI)) Q:+TIUI'>0!+$G(TIUOUT) D
. N DFN,DUOUT,TIUDPRM,TIU,TIULMETH,TIUVMETH,VAIN,VADM,TIUDA,TIUEDIT
. N TIUENTRY,TIUCMMTX,TIUVSUPP,CANEDIT
. S TIUVSUPP=0
. S DFN=+$G(TIUPAT(TIUI)) Q:+DFN'>0
. W !!,"For Patient ",$P(TIUPAT(TIUI),U,2)
. S TIUCLASS=$G(TIUCLASS,38)
. ;
. ;I TIUCLASS=3,$S(+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST"):0,1:1),(+$G(NOSAVE)'>0) D EXSTNOTE^TIUEDI2(DFN) D:$G(VALMAR)="^TMP(""OR"",$J,""CURRENT"")" FULL^VALM1
. I $S(+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST"):0,1:1),(+$G(NOSAVE)'>0) D EXSTNOTE^TIUEDI2(DFN) D:$G(VALMAR)="^TMP(""OR"",$J,""CURRENT"")" FULL^VALM1
. I +$G(DIROUT)!+$G(DUOUT)!+$G(DTOUT) S TIUOUT=1 Q
. ; -- Set title array TIUTYP (use TIUTITLE or ask user) --
. D SETTL^TIUEDI4(.TIUTYP,TIUCLASS,$G(TIUTITLE)) I +$G(TIUTYP)'>0 S TIUOUT=1 Q
. ; --- Re-direct surgical reports ---
. I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS")) D ENTEROP^TIUSROI(DFN,TIUTYP) Q
. ; -- Get doc parameters for title, X entry action --
. D DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
. S TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)
. I $L(TIUENTRY) X TIUENTRY
. Q:+$G(TIUOUT) ; If ENTRY ACTION sets TIUOUT=1 Abort Entry
. ; -- Set visit array TIU --
. ; NOTE: EVNTFLAG is set in TIUEDIT, prior to calling this routine
. D GETVST^TIUEDI4(DFN,TIUTYP,.TIU,EVNTFLAG)
. I $S($G(TIUQUIT):1,'$D(TIU("VSTR")):1,1:0) Q
. ; -- Ask OK --
. 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 $S($D(DIROUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 Q
. ;
. ;I $D(DUOUT) Q ;IHS/ITSC/LJF 02/26/2003 original
. I $S('$D(TIU("VISIT")):1,$D(DUOUT):1,1:0) D Q ;IHS/ITSC/LJF 02/26/2003 if no visit or ^
. . W !,$C(7),"Visit required to continue." H 2 ;IHS/ITSC/LJF 02/26/2003 give explanation for quitting
. D VEDIT^BTIUED("") ;IHS/ITSC/LJF 02/26/2003 added call to edit PCC visit
. ;
. ; -- If user OK'd basic info, go on to get text, etc.: --
. I $D(TIU),+$G(TIUASK) D
. . ; -- Get record DA --
. . ; DA is either: new stub record, ready for edit, or
. . ; existing record, for edit, or
. . ; existing record, for addendum
. . N DA
. . S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1,DUZ,.CANEDIT)
. . I +DA'>0 W !,"Unable to enter/edit." Q
. . ; -- [Addend DA and Quit] --
. . ; If record not new & user can't edit it, user said
. . ; in GETRECNW they wanted to addend, so let user write
. . ; addendum and quit:
. . I 'TIUNEW,'CANEDIT D ADDENDUM^TIUADD(DA,"",.TIUCHNG,1) Q
. . N TIUQUIT,TIUADD,TIUTDA
. . ; -- Edit new or existing DA --
. . D DIE^TIUEDI4(DA,.TIUQUIT)
. . Q:+$G(TIUQUIT)=2 ; DA doesn't exist (e.g. uparrowed w/ bad record)
. . ;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(VALMAR)="^TMP(""TIUVIEW"",$J)" VALMBCK="Q" S:'+$G(TIUNEW) TIUCHNG("DELETE")=1 H:'+$G(TIUNEW) 2 Q
. . Q:+$G(TIUQUIT)
. . S:+DA SUCCESS=+DA
. . I +$G(TIUONCE) S TIUNDA(+$G(DA))="" ; See TIURC, Across Patients
. . ; -- Misc after-edit-stuff for DA --
. . ; -- Mark to ask workload at signature;
. . ; (STOP for Stop codes for stand-alone visits): --
. . I +$G(TIU("STOP")),(+$P($G(TIUDPRM(0)),U,14)'=1) D DEFER^TIUVSIT(DA,TIU("STOP")) I 1
. . E D QUE^TIUPXAP1 ; Post workload now in background
. . S TIUCMMTX=$$COMMIT^TIULC1(+$P(TIUTYP(1),U,2))
. . I TIUCMMTX]"" X TIUCMMTX
. . ;
. . ; -- Link PN to VNote file --
. . D VNOTE^BTIUPCC(DA,TIU("VISIT"),DFN,"ADD") ;IHS/ITSC/LJF 02/26/2003
. . ;
. . D RELEASE^TIUT(DA)
. . D VERIFY^TIUT(DA)
. . ; -- Get signature for DA
. . D EDSIG^TIURS(DA)
. . ; - execute EXIT ACTION -
. . S TIUEXIT=$$GETEXIT^TIUEDI2(+$P(TIUTYP(1),U,2))
. . I $L(TIUEXIT) S TIUTDA=DA X TIUEXIT S DA=TIUTDA
. . ; -- [Prompt to print DA] --
. . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
Q
TIUEDIM ; SLC/JER - Enter/Edit Multiple Document ;01-Aug-2011 11:26;MGH
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**7,41,52,100,109,112,1009**;Jun 20, 1997;Build 22
+2 ; 2/2: Update DIE from TIUEDIT to TIUEDI4
+3 ;IHS/ITSC/LJF 02/26/2003 added call to stuff V Note file
+4 ; added call to edit PCC visit
+5 ; 12/11/2003 review previous notes works for all notes
MAIN(TIUCLASS,TIUOUT,TIUNDA,TIUCHNG) ; Control Branching
+1 NEW TIUREL,TIUCHK,TIUDA,TIUEDIT,TIUY,TIUNEW,TIUTYP,TIUPAT
+2 NEW TIUI,DTOUT
SET TIUDFLT=""
+3 KILL DIROUT
+4 ; --- Get one or more patients ---
+5 IF '$LENGTH($TEXT(PATIENT^ORU1))
QUIT
+6 DO PATIENT^ORU1(.TIUPAT)
IF +TIUPAT'>0
SET TIUOUT=1
QUIT
+7 SET TIUI=0
FOR
SET TIUI=+$ORDER(TIUPAT(TIUI))
IF +TIUI'>0!+$GET(TIUOUT)
QUIT
Begin DoDot:1
+8 NEW DFN,DUOUT,TIUDPRM,TIU,TIULMETH,TIUVMETH,VAIN,VADM,TIUDA,TIUEDIT
+9 NEW TIUENTRY,TIUCMMTX,TIUVSUPP,CANEDIT
+10 SET TIUVSUPP=0
+11 SET DFN=+$GET(TIUPAT(TIUI))
IF +DFN'>0
QUIT
+12 WRITE !!,"For Patient ",$PIECE(TIUPAT(TIUI),U,2)
+13 SET TIUCLASS=$GET(TIUCLASS,38)
+14 ;
+15 ;I TIUCLASS=3,$S(+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST"):0,1:1),(+$G(NOSAVE)'>0) D EXSTNOTE^TIUEDI2(DFN) D:$G(VALMAR)="^TMP(""OR"",$J,""CURRENT"")" FULL^VALM1
+16 IF $SELECT(+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST"):0,1:1)
IF (+$GET(NOSAVE)'>0)
DO EXSTNOTE^TIUEDI2(DFN)
IF $GET(VALMAR)="^TMP(""OR"",$J,""CURRENT"")"
DO FULL^VALM1
+17 IF +$GET(DIROUT)!+$GET(DUOUT)!+$GET(DTOUT)
SET TIUOUT=1
QUIT
+18 ; -- Set title array TIUTYP (use TIUTITLE or ask user) --
+19 DO SETTL^TIUEDI4(.TIUTYP,TIUCLASS,$GET(TIUTITLE))
IF +$GET(TIUTYP)'>0
SET TIUOUT=1
QUIT
+20 ; --- Re-direct surgical reports ---
+21 IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUSROI("SURGICAL REPORTS"))
DO ENTEROP^TIUSROI(DFN,TIUTYP)
QUIT
+22 ; -- Get doc parameters for title, X entry action --
+23 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
+24 SET TIUENTRY=$$GETENTRY^TIUEDI2(+TIUTYP)
+25 IF $LENGTH(TIUENTRY)
XECUTE TIUENTRY
+26 ; If ENTRY ACTION sets TIUOUT=1 Abort Entry
IF +$GET(TIUOUT)
QUIT
+27 ; -- Set visit array TIU --
+28 ; NOTE: EVNTFLAG is set in TIUEDIT, prior to calling this routine
+29 DO GETVST^TIUEDI4(DFN,TIUTYP,.TIU,EVNTFLAG)
+30 IF $SELECT($GET(TIUQUIT):1,'$DATA(TIU("VSTR")):1,1:0)
QUIT
+31 ; -- Ask OK --
+32 SET TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)
+33 IF '$LENGTH(TIUVMETH)
Begin DoDot:2
+34 WRITE !,$CHAR(7),"No Validation Method defined for "
+35 WRITE $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
End DoDot:2
SET TIUOUT=1
QUIT
+36 XECUTE TIUVMETH
+37 IF $SELECT($DATA(DIROUT):1,$DATA(DTOUT):1,1:0)
SET TIUQUIT=1
QUIT
+38 ;
+39 ;I $D(DUOUT) Q ;IHS/ITSC/LJF 02/26/2003 original
+40 ;IHS/ITSC/LJF 02/26/2003 if no visit or ^
IF $SELECT('$DATA(TIU("VISIT")):1,$DATA(DUOUT):1,1:0)
Begin DoDot:2
+41 ;IHS/ITSC/LJF 02/26/2003 give explanation for quitting
WRITE !,$CHAR(7),"Visit required to continue."
HANG 2
End DoDot:2
QUIT
+42 ;IHS/ITSC/LJF 02/26/2003 added call to edit PCC visit
DO VEDIT^BTIUED("")
+43 ;
+44 ; -- If user OK'd basic info, go on to get text, etc.: --
+45 IF $DATA(TIU)
IF +$GET(TIUASK)
Begin DoDot:2
+46 ; -- Get record DA --
+47 ; DA is either: new stub record, ready for edit, or
+48 ; existing record, for edit, or
+49 ; existing record, for addendum
+50 NEW DA
+51 SET DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,1,DUZ,.CANEDIT)
+52 IF +DA'>0
WRITE !,"Unable to enter/edit."
QUIT
+53 ; -- [Addend DA and Quit] --
+54 ; If record not new & user can't edit it, user said
+55 ; in GETRECNW they wanted to addend, so let user write
+56 ; addendum and quit:
+57 IF 'TIUNEW
IF 'CANEDIT
DO ADDENDUM^TIUADD(DA,"",.TIUCHNG,1)
QUIT
+58 NEW TIUQUIT,TIUADD,TIUTDA
+59 ; -- Edit new or existing DA --
+60 DO DIE^TIUEDI4(DA,.TIUQUIT)
+61 ; DA doesn't exist (e.g. uparrowed w/ bad record)
IF +$GET(TIUQUIT)=2
QUIT
+62 ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
+63 IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP)
IF +$GET(TIUQUIT)=1
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,5)>0
QUIT
+64 IF $$EMPTYDOC^TIULF(DA)
DO DELETE^TIUEDIT(DA,0)
IF $GET(VALMAR)="^TMP(""TIUVIEW"",$J)"
SET VALMBCK="Q"
IF '+$GET(TIUNEW)
SET TIUCHNG("DELETE")=1
IF '+$GET(TIUNEW)
HANG 2
QUIT
+65 IF +$GET(TIUQUIT)
QUIT
+66 IF +DA
SET SUCCESS=+DA
+67 ; See TIURC, Across Patients
IF +$GET(TIUONCE)
SET TIUNDA(+$GET(DA))=""
+68 ; -- Misc after-edit-stuff for DA --
+69 ; -- Mark to ask workload at signature;
+70 ; (STOP for Stop codes for stand-alone visits): --
+71 IF +$GET(TIU("STOP"))
IF (+$PIECE($GET(TIUDPRM(0)),U,14)'=1)
DO DEFER^TIUVSIT(DA,TIU("STOP"))
IF 1
+72 ; Post workload now in background
IF '$TEST
DO QUE^TIUPXAP1
+73 SET TIUCMMTX=$$COMMIT^TIULC1(+$PIECE(TIUTYP(1),U,2))
+74 IF TIUCMMTX]""
XECUTE TIUCMMTX
+75 ;
+76 ; -- Link PN to VNote file --
+77 ;IHS/ITSC/LJF 02/26/2003
DO VNOTE^BTIUPCC(DA,TIU("VISIT"),DFN,"ADD")
+78 ;
+79 DO RELEASE^TIUT(DA)
+80 DO VERIFY^TIUT(DA)
+81 ; -- Get signature for DA
+82 DO EDSIG^TIURS(DA)
+83 ; - execute EXIT ACTION -
+84 SET TIUEXIT=$$GETEXIT^TIUEDI2(+$PIECE(TIUTYP(1),U,2))
+85 IF $LENGTH(TIUEXIT)
SET TIUTDA=DA
XECUTE TIUEXIT
SET DA=TIUTDA
+86 ; -- [Prompt to print DA] --
+87 IF +$PIECE($GET(TIUDPRM(0)),U,8)
DO PRINT^TIUEPRNT(DA)
End DoDot:2
End DoDot:1
+88 QUIT
