TIUDPEDT.m

TIUDPEDT ; SLC/JER - Document Parameter Edit ;2/19/93  16:15

 ;;1.0;TEXT INTEGRATION UTILITIES;**198,206,212**;Jun 20, 1997

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.

 N TIURESP,TIURESP1 S TIURESP=$$READ^TIUU("8925.95,.01:O",,)

 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 ;

 I $P(TIURESP,U)'=TIUPRMPT 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

 S TIUDR=$S($P($G(TIURESP),U)="@":$P($G(TIURESP),U),1:$P($G(^TIU(8925.1,$P(TIURESP,U),0)),U))

 Q:$L(TIUDR)'>0

 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

TIUDPEDT  ; SLC/JER - Document Parameter Edit ;2/19/93  16:15

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**198,206,212**;Jun 20, 1997

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       NEW TIURESP,TIURESP1

           SET TIURESP=$$READ^TIUU("8925.95,.01:O",,)

 +11       SET TIURESP=$PIECE(TIURESP,U)

 +12       IF $GET(TIURESP)="@"

               SET TIURESP=TIURESP_U_TIURESP

               KILL DIRUT

               GOTO CONT

 +13       IF (($DATA(DIRUT))!(+TIURESP<0))

               KILL DIRUT

               QUIT 

CONT      ;

 +1        IF $PIECE(TIURESP,U)'=TIUPRMPT

               Begin DoDot:1

 +2                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 

 +3        NEW TIUDR

 +4        SET TIUDR=$SELECT($PIECE($GET(TIURESP),U)="@":$PIECE($GET(TIURESP),U),1:$PIECE($GET(^TIU(8925.1,$PIECE(TIURESP,U),0)),U))

 +5        IF $LENGTH(TIUDR)'>0

               QUIT 

 +6        SET DIE="^TIU(8925.95,"

           SET DR=".01///"_TIUDR

 +7        LOCK +^TIU(8925.95,DA):0

           IF '$TEST

               WRITE !,"Another user is editing this entry"

               HANG 1

               QUIT 

 +8        NEW TIUSAVDA

           SET TIUSAVDA=DA

 +9        DO ^DIE

 +10       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