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

TIUEDI2.m

Go to the documentation of this file. 
  1. TIUEDI2 ; SLC/JER - Additional Edit Code ; 7-MAR-2000 10:57:50
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1,89,299**;Jun 20, 1997;Build 3
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1. GETENTRY(TIUTYP) ; Get Entry Action, enforce inheritance
  1.  N TIUDAD,TIUY S TIUDAD=0
  1.  S TIUY=$G(^TIU(8925.1,+TIUTYP,4.6))
  1.  I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
  1.  I +TIUDAD S TIUY=$$GETENTRY(TIUDAD)
  1.  Q TIUY
  1. GETEXIT(TIUTYP) ; Get Validation method, enforce enheritance
  1.  N TIUDAD,TIUY S TIUDAD=0
  1.  S TIUY=$G(^TIU(8925.1,+TIUTYP,4.7))
  1.  I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
  1.  I +TIUDAD S TIUY=$$GETEXIT(TIUDAD)
  1.  Q TIUY
  1. EXSTNOTE(DFN) ; Sample/display existing notes
  1.  N TIUSMPL,TIUTOTL,TIUEDT,TIULDT,TIUPRMT,TIURVW,TIUPNOUN,TIUSEE,TIUOUT
  1.  N TIUA,TIUI,TIUJ,TIULAST,TIULIST,TIUREC,TIURTN,TIUSTOP,TIUY,TIUZ,TIUQUIT
  1.  I '$D(TIUPRM0) D SETPARM^TIULE
  1.  I '$D(TIUPREF) S TIUPREF=$$PERSPRF^TIULE(DUZ)
  1.  I +$P(TIUPREF,U,11) Q
  1.  I +$P(TIUPRM0,U,7),$S($P(TIUPREF,U,11)=0:0,1:1) Q
  1.  I +$O(^TIU(8925,"ACLPT",3,DFN,0))'>0 Q
  1.  D SELPAT^TIULA2(.TIURTN,3,DFN,1)
  1.  I +$G(TIURTN)'>0,($D(TIURTN)=1) D  S TIUOUT=1 Q
  1.  . W !!,"Nothing selected.",!
  1.  S TIUI=0
  1.  F  S TIUI=$O(TIURTN(TIUI)) Q:+TIUI'>0  D  Q:$D(DUOUT)!$D(DIROUT)!+$G(TIUOUT)
  1.  . N TIUDA
  1.  . S TIUDA=+$G(TIURTN(TIUI)) Q:TIUDA'>0
  1.  . D GETTIU^TIULD(.TIU,+TIUDA)
  1.  . I $D(TIU) D
  1.  . . S TIUSEE=$$CANDO^TIULP(TIUDA,"VIEW")
  1.  . . I 'TIUSEE D  Q
  1.  . . . W !!,$C(7),$P(TIUSEE,U,2),! K DFN
  1.  . . . I $D(ORVP) S TIUOUT=1
  1.  . . . S TIU=$$READ^TIUU("FOA","Press RETURN to continue...")
  1.  . . D EN^VALM("TIU BROWSE FOR CLINICIAN")
  1.  . . K ^TMP("TIUVIEW",$J),DFN
  1.  . . S:$D(TIUQUIT) TIUOUT=1
  1.  Q
  1. CHEKSAVE(DUZ) ; Checks for entry in ^TIU(8925,"ASAVE",DUZ,TIUDA)
  1.  Q +$O(^TIU(8925,"ASAVE",DUZ,0))
  1. EDITSAVE(DUZ) ; Evaluates whether an unsaved document exists, allows edit
  1.  N TIUDA,TIUPRMT,TIUY,TIU,TIUEDIT
  1.  ;*299 
  1.  S TIUDA=0 F  S TIUDA=$O(^TIU(8925,"ASAVE",DUZ,TIUDA)) Q:'TIUDA  D
  1.  . ; If the document is gone, then delete the save flag and Quit
  1.  . I '$D(^TIU(8925,+TIUDA,0)) K ^TIU(8925,"ASAVE",DUZ,+TIUDA) Q
  1.  . I $P($G(^TIU(8925,TIUDA,13)),U,2)'=DUZ K ^TIU(8925,"ASAVE",DUZ,TIUDA) Q
  1.  . S TIUEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
  1.  . I '+TIUEDIT  K ^TIU(8925,"ASAVE",DUZ,TIUDA) Q
  1.  ;
  1.  S TIUDA=$$CHEKSAVE(DUZ)
  1.  I +TIUDA'>0 Q
  1.   ; If Lock can't be acquired, quit
  1.  L +^TIU(8925,+TIUDA,0):1
  1.  E  Q
  1.  W !!,"You have an unsaved document in your buffer."
  1.  W !,"Depending on your preferred editor, you may"
  1.  W !,"have lost some of the text.",!
  1.  S TIUPRMT="Would you like to resume editing now"
  1.  S TIUY=$$READ^TIUU("Y",TIUPRMT,"YES")
  1.  I +TIUY'>0 W !!,"Okay. You can catch up with it later!",! H 1 G EDSAVEX
  1.  W !!,"Good.  Here we go then!",!
  1.  I $D(^TIU(8925,+TIUDA,"TEMP")),'$D(^TIU(8925,+TIUDA,"TEXT")) D
  1.  . D GETTIU^TIULD(.TIU,TIUDA)
  1.  . D MERGTEXT^TIUEDI1(TIUDA,.TIU)
  1.  D EDIT1^TIURA
  1. EDSAVEX L -^TIU(8925,+TIUDA,0)
  1.  Q