source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTVRCRES.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1XTVRCRES ;ISC-SF/JLI - RESTORE ROUTINE BACK TO SELECTED VERSION - BE SAVED UNDER ANOTHER NAME ;8/24/93 14:53
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 ;;
4EN ;
5 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
6 . S X="N",%DT="T" D ^%DT K %DT S XTVTIM=+Y
7 R !,"Save RESTORED ROUTINE as: ",X:DTIME G:'$T!(X="")!(X["^") EXIT I $E(X)'?1A!($L(X)>8) W $C(7)," ??",! G EN
8 S XTROUA=X X ^%ZOSF("TEST") I $T W !?5,$C(7),"Must be a routine name not currently in use.",!! G EN
9 S DIC="^XTV(8991,XTDA,1,",DA(1)=XTDA,DIC(0)="AEQ" D ^DIC K DIC Q:Y'>0 S DA=+Y
10 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
11 S %X="^XTV(8991,XTDA,1,XTMAX,1,",%Y="^TMP($J,""A""," D %XY^%RCR
12 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
13 S X=XTROUA,DIE="^TMP($J,""A"",",XCN=0 X ^%ZOSF("SAVE")
14 Q
15 ;
16A ;S X=XTROU,XCNP=0,DIF="^TMP($J,0," X ^%ZOSF("LOAD")
17 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")
18 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)
19 . 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
20 .. 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
21 .. I X F P=1:1:N1 K ^TMP($J,0,(M+P-1))
22 .. I X S K=M K ^TMP($J,"I")
23 . I 'X W !!,K F P=1:1:N1 W !,^TMP($J,"I",P,0)
24 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
25 Q
26 ;
27EXIT ;
28 K %X,%Y,DA,DA1,DIC,DIE,I,J,K,M,N1,P,X,XCN,XTDA,XTDA1,XTMAX,XTROU,XTROUA,Y
Note: See TracBrowser for help on using the repository browser.