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

TIUDPEDT.m

Go to the documentation of this file.
  1. TIUDPEDT ; SLC/JER - Document Parameter Edit ;2/19/93 16:15
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**198,206,212,282,288**;Jun 20, 1997;Build 4
  1. ;Per VHA Directive 2004-038, this routine should not be modified
  1. MAIN ; Controls branching
  1. N DIC,DA,DIE,DR,DLAYGO,X,Y,DWPK,TIUFPRIV S TIUFPRIV=1
  1. W !,"First edit Institution-wide parameters:",!
  1. ;VMP OIFO BAY PINES;ELR;TIU*1.0*198 MODIFIED FROM HERE DOWN
  1. S (DIC,DLAYGO)=8925.95,DIC(0)="AEMQLZ",DIC("A")="Select DOCUMENT DEFINITION: "
  1. D ^DIC K DLAYGO Q:+Y'>0 S DA=+Y
  1. I +$P(Y,U,3)=1 K X,Y,DIC N TIUERR D LOCK Q:$G(TIUERR) G CONT1
  1. N TIUPRMPT,TIUDSPLY S TIUPRMPT=+$P(Y,U,2),TIUDSPLY=$G(Y(0,0))
  1. K X,Y,DIC
  1. ;VMP OIFO BAY PINES;ELR;TIU*1.0*198;REMOVED .01 FROM INPUT TEMPLATE AND ADDED WARNING MSG.
  1. ; *288 vmp - Do not allow edit of .01 field
  1. N TIURESP,TIURESP1,TIUOK
  1. F S TIURESP=$$READ^TIUU("8925.95,.01:O",,) D Q:TIUOK
  1. . I $P(TIURESP,U)="@"!($G(DIRUT))!($P(TIURESP,U)=TIUPRMPT) S TIUOK=1 Q
  1. . S TIUOK=0 W !,"This field cannot be modified."
  1. S TIURESP=$P(TIURESP,U)
  1. I $G(TIURESP)="@" S TIURESP=TIURESP_U_TIURESP K DIRUT G CONT
  1. I (($D(DIRUT))!(+TIURESP<0)) K DIRUT Q
  1. CONT ;
  1. ; *288 Only display this message when attempting to delete
  1. I $P(TIURESP,U)="@" D Q:'+$G(TIURESP1)
  1. . S TIURESP1=$$READ^TIUU("Y","You are about to lose the document parameters for "_TIUDSPLY_". Do you wish to continue","NO")
  1. N TIUDR
  1. ;*288 allow delete
  1. S TIUDR=$S($P($G(TIURESP),U)="@":$P($G(TIURESP),U),1:"`"_$P($G(TIURESP),U))
  1. Q:$L(TIUDR)'>0
  1. ;*282 - Prevent filing error
  1. ;*288 Allow delete
  1. S DIE="^TIU(8925.95,",DR=".01///"_TIUDR
  1. L +^TIU(8925.95,DA):0 I '$T W !,"Another user is editing this entry" H 1 Q
  1. N TIUSAVDA S TIUSAVDA=DA
  1. D ^DIE
  1. I $P($G(TIURESP),U)="@" S DA=TIUSAVDA G END
  1. CONT1 ;
  1. S DIE=8925.95,DR="[TIU DOCUMENT PARAMETER EDIT]"
  1. D ^DIE
  1. END L -^TIU(8925.95,DA)
  1. Q
  1. LOCK ;
  1. L +^TIU(8925.95,DA):0 I '$T W !,"Another user is editing this entry" H 1 S TIUERR=1
  1. Q