- 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 Jan 18, 2025@03:40:58 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