- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVRCRES 1850 printed Feb 19, 2025@00:08:29 Page 2
- 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
