XTVRCRES ;ISC-SF/JLI - RESTORE ROUTINE BACK TO SELECTED VERSION - BE SAVED UNDER ANOTHER NAME ;8/24/93 14:53
;;7.3;TOOLKIT;;Apr 25, 1995
;;
EN ;
K ^TMP($J) S DIC("A")="Name of ROUTINE to be restored: ",DIC(0)="AEQM",DIC="^XTV(8991," D ^DIC K DIC G:Y'>0 EXIT S DA=+Y,XTROU=$P(Y,U,2),XTDA=DA D D LOOP^XTVRC1 S DA=XTDA
. S X="N",%DT="T" D ^%DT K %DT S XTVTIM=+Y
R !,"Save RESTORED ROUTINE as: ",X:DTIME G:'$T!(X="")!(X["^") EXIT I $E(X)'?1A!($L(X)>8) W $C(7)," ??",! G EN
S XTROUA=X X ^%ZOSF("TEST") I $T W !?5,$C(7),"Must be a routine name not currently in use.",!! G EN
S DIC="^XTV(8991,XTDA,1,",DA(1)=XTDA,DIC(0)="AEQ" D ^DIC K DIC Q:Y'>0 S DA=+Y
S XTMAX=0 F I=0:0 S I=$O(^XTV(8991,XTDA,1,I)) Q:I'>0 S XTMAX=XTMAX+1,XTMAX(XTMAX)=I
S %X="^XTV(8991,XTDA,1,XTMAX,1,",%Y="^TMP($J,""A""," D %XY^%RCR
S XTDA1=DA F DA1=XTMAX-1:-1 Q:'$D(XTMAX(DA1)) S DA=XTMAX(DA1) Q:DA<XTDA1 K ^TMP($J,0) S %X="^TMP($J,""A"",",%Y="^TMP($J,0," D %XY^%RCR K ^TMP($J,"A") D A
S X=XTROUA,DIE="^TMP($J,""A"",",XCN=0 X ^%ZOSF("SAVE")
Q
;
A ;S X=XTROU,XCNP=0,DIF="^TMP($J,0," X ^%ZOSF("LOAD")
F I=0:0 S I=$O(^XTV(8991,XTDA,1,DA,1,I)) Q:I'>0 I $D(^(I,"DEL")) S ^TMP($J,"A",I,0)=^("DEL")
S K=0 F I=0:0 S I=$O(^XTV(8991,XTDA,1,DA,1,I)) Q:I'>0 S N1=0 K ^TMP($J,"I") F J=0:0 S J=$O(^XTV(8991,XTDA,1,DA,1,I,"INS",J)) D:J'>0 Q:J'>0 S N1=N1+1,^TMP($J,"I",N1,0)=^(J,0)
. Q:N1'>0 S X=0 F M=K+1:1 Q:$O(^TMP($J,0,M-1))'>0 I $D(^TMP($J,0,M)) D Q:X
.. S X=1 F P=1:1:N1 I ^TMP($J,"I",P,0)'=^TMP($J,0,(M+P-1),0) S X=0 Q
.. I X F P=1:1:N1 K ^TMP($J,0,(M+P-1))
.. I X S K=M K ^TMP($J,"I")
. I 'X W !!,K F P=1:1:N1 W !,^TMP($J,"I",P,0)
S K=0 F I=1:1 I '$D(^XTV(8991,XTDA,1,DA,1,I,"DEL")) S K=$O(^TMP($J,0,K)) Q:K'>0 S X=^(K,0),^TMP($J,"A",I,0)=X
Q
;
EXIT ;
K %X,%Y,DA,DA1,DIC,DIE,I,J,K,M,N1,P,X,XCN,XTDA,XTDA1,XTMAX,XTROU,XTROUA,Y
XTVRCRES ;ISC-SF/JLI - RESTORE ROUTINE BACK TO SELECTED VERSION - BE SAVED UNDER ANOTHER NAME ;8/24/93 14:53
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 ;;
EN ;
+1 KILL ^TMP($JOB)
SET DIC("A")="Name of ROUTINE to be restored: "
SET DIC(0)="AEQM"
SET DIC="^XTV(8991,"
DO ^DIC
KILL DIC
IF Y'>0
GOTO EXIT
SET DA=+Y
SET XTROU=$PIECE(Y,U,2)
SET XTDA=DA
Begin DoDot:1
+2 SET X="N"
SET %DT="T"
DO ^%DT
KILL %DT
SET XTVTIM=+Y
End DoDot:1
DO LOOP^XTVRC1
SET DA=XTDA
+3 READ !,"Save RESTORED ROUTINE as: ",X:DTIME
IF '$TEST!(X="")!(X["^")
GOTO EXIT
IF $EXTRACT(X)'?1A!($LENGTH(X)>8)
WRITE $CHAR(7)," ??",!
GOTO EN
+4 SET XTROUA=X
XECUTE ^%ZOSF("TEST")
IF $TEST
WRITE !?5,$CHAR(7),"Must be a routine name not currently in use.",!!
GOTO EN
+5 SET DIC="^XTV(8991,XTDA,1,"
SET DA(1)=XTDA
SET DIC(0)="AEQ"
DO ^DIC
KILL DIC
IF Y'>0
QUIT
SET DA=+Y
+6 SET XTMAX=0
FOR I=0:0
SET I=$ORDER(^XTV(8991,XTDA,1,I))
IF I'>0
QUIT
SET XTMAX=XTMAX+1
SET XTMAX(XTMAX)=I
+7 SET %X="^XTV(8991,XTDA,1,XTMAX,1,"
SET %Y="^TMP($J,""A"","
DO %XY^%RCR
+8 SET XTDA1=DA
FOR DA1=XTMAX-1:-1
IF '$DATA(XTMAX(DA1))
QUIT
SET DA=XTMAX(DA1)
IF DA<XTDA1
QUIT
KILL ^TMP($JOB,0)
SET %X="^TMP($J,""A"","
SET %Y="^TMP($J,0,"
DO %XY^%RCR
KILL ^TMP($JOB,"A")
DO A
+9 SET X=XTROUA
SET DIE="^TMP($J,""A"","
SET XCN=0
XECUTE ^%ZOSF("SAVE")
+10 QUIT
+11 ;
A ;S X=XTROU,XCNP=0,DIF="^TMP($J,0," X ^%ZOSF("LOAD")
+1 FOR I=0:0
SET I=$ORDER(^XTV(8991,XTDA,1,DA,1,I))
IF I'>0
QUIT
IF $DATA(^(I,"DEL"))
SET ^TMP($JOB,"A",I,0)=^("DEL")
+2 SET K=0
FOR I=0:0
SET I=$ORDER(^XTV(8991,XTDA,1,DA,1,I))
IF I'>0
QUIT
SET N1=0
KILL ^TMP($JOB,"I")
FOR J=0:0
SET J=$ORDER(^XTV(8991,XTDA,1,DA,1,I,"INS",J))
IF J'>0
Begin DoDot:1
+3 IF N1'>0
QUIT
SET X=0
FOR M=K+1:1
IF $ORDER(^TMP($JOB,0,M-1))'>0
QUIT
IF $DATA(^TMP($JOB,0,M))
Begin DoDot:2
+4 SET X=1
FOR P=1:1:N1
IF ^TMP($JOB,"I",P,0)'=^TMP($JOB,0,(M+P-1),0)
SET X=0
QUIT
+5 IF X
FOR P=1:1:N1
KILL ^TMP($JOB,0,(M+P-1))
+6 IF X
SET K=M
KILL ^TMP($JOB,"I")
End DoDot:2
IF X
QUIT
+7 IF 'X
WRITE !!,K
FOR P=1:1:N1
WRITE !,^TMP($JOB,"I",P,0)
End DoDot:1
IF J'>0
QUIT
SET N1=N1+1
SET ^TMP($JOB,"I",N1,0)=^(J,0)
+8 SET K=0
FOR I=1:1
IF '$DATA(^XTV(8991,XTDA,1,DA,1,I,"DEL"))
SET K=$ORDER(^TMP($JOB,0,K))
IF K'>0
QUIT
SET X=^(K,0)
SET ^TMP($JOB,"A",I,0)=X
+9 QUIT
+10 ;
EXIT ;
+1 KILL %X,%Y,DA,DA1,DIC,DIE,I,J,K,M,N1,P,X,XCN,XTDA,XTDA1,XTMAX,XTROU,XTROUA,Y
