TIUDPEDT ; SLC/JER - Document Parameter Edit ;2/19/93 16:15
;;1.0;TEXT INTEGRATION UTILITIES;**198,206,212,282,288**;Jun 20, 1997;Build 4
;Per VHA Directive 2004-038, this routine should not be modified
MAIN ; Controls branching
N DIC,DA,DIE,DR,DLAYGO,X,Y,DWPK,TIUFPRIV S TIUFPRIV=1
W !,"First edit Institution-wide parameters:",!
;VMP OIFO BAY PINES;ELR;TIU*1.0*198 MODIFIED FROM HERE DOWN
S (DIC,DLAYGO)=8925.95,DIC(0)="AEMQLZ",DIC("A")="Select DOCUMENT DEFINITION: "
D ^DIC K DLAYGO Q:+Y'>0 S DA=+Y
I +$P(Y,U,3)=1 K X,Y,DIC N TIUERR D LOCK Q:$G(TIUERR) G CONT1
N TIUPRMPT,TIUDSPLY S TIUPRMPT=+$P(Y,U,2),TIUDSPLY=$G(Y(0,0))
K X,Y,DIC
;VMP OIFO BAY PINES;ELR;TIU*1.0*198;REMOVED .01 FROM INPUT TEMPLATE AND ADDED WARNING MSG.
; *288 vmp - Do not allow edit of .01 field
N TIURESP,TIURESP1,TIUOK
F S TIURESP=$$READ^TIUU("8925.95,.01:O",,) D Q:TIUOK
. I $P(TIURESP,U)="@"!($G(DIRUT))!($P(TIURESP,U)=TIUPRMPT) S TIUOK=1 Q
. S TIUOK=0 W !,"This field cannot be modified."
S TIURESP=$P(TIURESP,U)
I $G(TIURESP)="@" S TIURESP=TIURESP_U_TIURESP K DIRUT G CONT
I (($D(DIRUT))!(+TIURESP<0)) K DIRUT Q
CONT ;
; *288 Only display this message when attempting to delete
I $P(TIURESP,U)="@" D Q:'+$G(TIURESP1)
. S TIURESP1=$$READ^TIUU("Y","You are about to lose the document parameters for "_TIUDSPLY_". Do you wish to continue","NO")
N TIUDR
;*288 allow delete
S TIUDR=$S($P($G(TIURESP),U)="@":$P($G(TIURESP),U),1:"`"_$P($G(TIURESP),U))
Q:$L(TIUDR)'>0
;*282 - Prevent filing error
;*288 Allow delete
S DIE="^TIU(8925.95,",DR=".01///"_TIUDR
L +^TIU(8925.95,DA):0 I '$T W !,"Another user is editing this entry" H 1 Q
N TIUSAVDA S TIUSAVDA=DA
D ^DIE
I $P($G(TIURESP),U)="@" S DA=TIUSAVDA G END
CONT1 ;
S DIE=8925.95,DR="[TIU DOCUMENT PARAMETER EDIT]"
D ^DIE
END L -^TIU(8925.95,DA)
Q
LOCK ;
L +^TIU(8925.95,DA):0 I '$T W !,"Another user is editing this entry" H 1 S TIUERR=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUDPEDT 1951 printed Dec 13, 2024@02:39:49 Page 2
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
+2 ;Per VHA Directive 2004-038, this routine should not be modified
MAIN ; Controls branching
+1 NEW DIC,DA,DIE,DR,DLAYGO,X,Y,DWPK,TIUFPRIV
SET TIUFPRIV=1
+2 WRITE !,"First edit Institution-wide parameters:",!
+3 ;VMP OIFO BAY PINES;ELR;TIU*1.0*198 MODIFIED FROM HERE DOWN
+4 SET (DIC,DLAYGO)=8925.95
SET DIC(0)="AEMQLZ"
SET DIC("A")="Select DOCUMENT DEFINITION: "
+5 DO ^DIC
KILL DLAYGO
if +Y'>0
QUIT
SET DA=+Y
+6 IF +$PIECE(Y,U,3)=1
KILL X,Y,DIC
NEW TIUERR
DO LOCK
if $GET(TIUERR)
QUIT
GOTO CONT1
+7 NEW TIUPRMPT,TIUDSPLY
SET TIUPRMPT=+$PIECE(Y,U,2)
SET TIUDSPLY=$GET(Y(0,0))
+8 KILL X,Y,DIC
+9 ;VMP OIFO BAY PINES;ELR;TIU*1.0*198;REMOVED .01 FROM INPUT TEMPLATE AND ADDED WARNING MSG.
+10 ; *288 vmp - Do not allow edit of .01 field
+11 NEW TIURESP,TIURESP1,TIUOK
+12 FOR
SET TIURESP=$$READ^TIUU("8925.95,.01:O",,)
Begin DoDot:1
+13 IF $PIECE(TIURESP,U)="@"!($GET(DIRUT))!($PIECE(TIURESP,U)=TIUPRMPT)
SET TIUOK=1
QUIT
+14 SET TIUOK=0
WRITE !,"This field cannot be modified."
End DoDot:1
if TIUOK
QUIT
+15 SET TIURESP=$PIECE(TIURESP,U)
+16 IF $GET(TIURESP)="@"
SET TIURESP=TIURESP_U_TIURESP
KILL DIRUT
GOTO CONT
+17 IF (($DATA(DIRUT))!(+TIURESP<0))
KILL DIRUT
QUIT
CONT ;
+1 ; *288 Only display this message when attempting to delete
+2 IF $PIECE(TIURESP,U)="@"
Begin DoDot:1
+3 SET TIURESP1=$$READ^TIUU("Y","You are about to lose the document parameters for "_TIUDSPLY_". Do you wish to continue","NO")
End DoDot:1
if '+$GET(TIURESP1)
QUIT
+4 NEW TIUDR
+5 ;*288 allow delete
+6 SET TIUDR=$SELECT($PIECE($GET(TIURESP),U)="@":$PIECE($GET(TIURESP),U),1:"`"_$PIECE($GET(TIURESP),U))
+7 if $LENGTH(TIUDR)'>0
QUIT
+8 ;*282 - Prevent filing error
+9 ;*288 Allow delete
+10 SET DIE="^TIU(8925.95,"
SET DR=".01///"_TIUDR
+11 LOCK +^TIU(8925.95,DA):0
IF '$TEST
WRITE !,"Another user is editing this entry"
HANG 1
QUIT
+12 NEW TIUSAVDA
SET TIUSAVDA=DA
+13 DO ^DIE
+14 IF $PIECE($GET(TIURESP),U)="@"
SET DA=TIUSAVDA
GOTO END
CONT1 ;
+1 SET DIE=8925.95
SET DR="[TIU DOCUMENT PARAMETER EDIT]"
+2 DO ^DIE
END LOCK -^TIU(8925.95,DA)
+1 QUIT
LOCK ;
+1 LOCK +^TIU(8925.95,DA):0
IF '$TEST
WRITE !,"Another user is editing this entry"
HANG 1
SET TIUERR=1
+2 QUIT
