- XTVRC2 ; JLI/SF-ISC.SEATTLE ** PRODUCE LISTING OF CHANGE HISTORY FOR ROUTINE ;12/7/93 15:20
- ;;7.3;TOOLKIT;;Apr 25, 1995
- W !!,"This routine lists the changes in program code that have been noted.",!!
- RSEL U IO(0) W !!,"Select the routine(s) which you want changes listed for:",!
- K ^TMP($J) X ^%ZOSF("RSEL") G:$O(^UTILITY($J,""))="" KILL S %X="^UTILITY($J,",%Y="^TMP($J," D %XY^%RCR K ^UTILITY($J)
- R "Show changes back to DATE",!?5,"(none if number of changes is to be specified): ",X:DTIME Q:'$T S:X="" X=0,Y=0 S %DT="QE" D:X'=0 ^%DT K %DT S XTVDAT=+Y I XTVDAT>0 S X=10000 G A2
- A1 R !!,"Show changes for how many past versions (or ALL): 1// ",X:DTIME Q:'$T!(X[U) S:X="" X=1 S:"Aa"[$E(X) X=10000 I +X'=X!(X'>0) W:X'["?" $C(7)," ??" W !,"Enter a number indicating the number of past versions you want to see changes",! G A1
- A2 S XTVNV=X
- S %ZIS="QM" D ^%ZIS G:POP KILL I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^XTVRC2",ZTIO=ION,ZTDESC="Routine Changes",ZTSAVE("^TMP($J,")="",ZTSAVE("XTVDAT")="",ZTSAVE("XTVNV")="" D ^%ZTLOAD K ZTRTN,ZTIO,ZTDESC,ZTSAVE G KILL
- ;
- DQ ;
- S X="N",%DT="T" D ^%DT S XTVTIM=Y
- U IO S DIR(0)="E",XTVNAM="" F XTVA=0:0 S XTVNAM=$O(^TMP($J,XTVNAM)) Q:XTVNAM="" D ONE Q:$D(DIRUT)
- G:$D(DIRUT) KILL I $D(^TMP($J," NEW")) W !!,"The following routines ARE NEW to the file (no prior version to compare):",!! S XTVNAM="" F XTVI=0:0 S XTVNAM=$O(^TMP($J," NEW",XTVNAM)) Q:XTVNAM="" W:XTVI#7 ! W $J(XTVNAM,10)
- I $D(^TMP($J," NO CHANGE")) W !!,"The following routines showed no change in the specified number of versions:",!! S XTVNAM="" F XTVI=0:0 S XTVNAM=$O(^TMP($J," NO CHANGE",XTVNAM)) Q:XTVNAM="" W:XTVI#7 ! W $J(XTVNAM,10)
- W !
- I '$D(ZTQUEUED) D ^%ZISC G RSEL
- U IO W:IOST'["C-" @IOF
- KILL D ^%ZISC
- K XTVA,XTVC,XTVD,XTVDAT,XTVDAT1,XTVI,XTVJ,XTVK,XTVL,XTVNV,XTVNAM,ZTRTN,ZTSAVE,ZTIO,X,Y,M,DA,POP,DIRUT,DIR
- Q
- ;
- ONE ;
- S DA=$O(^XTV(8991,"B",XTVNAM,0)) S XTROU=XTVNAM I DA'>0 D LCHEK^XTVRC1 Q:'L D LOOP^XTVRC1 S DA=$O(^XTV(8991,"B",XTVNAM,0)) Q:DA'>0 S ^TMP($J," NEW",XTVNAM)="" Q
- S XTVDA=DA D LOOP^XTVRC1 S DA=XTVDA ; MAKE SURE WE HAVE INCLUDED THE CURRENT VERSION
- S XTVJ=0 F XTVL=0:0 S XTVL=$O(^XTV(8991,DA,1,XTVL)) Q:XTVL'>0 S XTVJ=XTVL
- S XTVC=0,XTVDAT1=+^XTV(8991,DA,1,XTVJ,0) F XTVL=XTVJ-1:-1 Q:XTVDAT1'>XTVDAT Q:XTVL'>0!(XTVL'>(XTVJ-XTVNV-1)) I $D(^XTV(8991,DA,1,XTVL)) S XTVDATX=XTVDAT1,XTVDAT1=+^(XTVL,0) I XTVDATX>XTVDAT D LIST Q:$D(DIRUT)
- I XTVC'>0 S ^TMP($J," NO CHANGE",XTVNAM)=""
- Q
- ;
- LIST ;
- I $O(^XTV(8991,DA,1,XTVL,1,0))=2,$O(^(2,0))="DEL",$O(^XTV(8991,DA,1,XTVL,1,2))=3,$O(^(3,0))="INS",$O(^XTV(8991,DA,1,XTVL,1,3))="" Q
- D:(6>(IOSL-$Y)) DIX Q:$D(DIRUT)
- S %=XTVDATX_"00000",XTVDATX=$E(%,4,5)_"/"_$E(%,6,7)_"/"_$E(%,2,3)_" "_$E(%,9,10)_":"_$E(%,11,12),XTVC=XTVC+1 W !!,XTVNAM," changes in code ",XTVJ-XTVL," version",$S(XTVJ-XTVL>1:"s",1:"")," back (recorded ",XTVDATX,")" K %
- S XTVD=0,XTVI=0 F XTVK=0:0 S XTVK=$O(^XTV(8991,DA,1,XTVL,1,XTVK)) Q:XTVK'>0 D:$D(^(XTVK,"DEL"))&(XTVD<XTVK) DELETE D:(XTVI<XTVK)&$D(^XTV(8991,DA,1,XTVL,1,XTVK,"INS")) INSERT Q:$D(DIRUT)
- Q
- ;
- DELETE ;
- I $D(^XTV(8991,DA,1,XTVL,1,XTVK+1,"INS",1)),'$D(^(2)) D CHANGE Q
- D:(4>(IOSL-$Y)) DIX Q:$D(DIRUT) W !!?4,"original line ",XTVK," deleted. code was:",!,^XTV(8991,DA,1,XTVL,1,XTVK,"DEL")
- S XTVD=XTVK
- Q
- ;
- INSERT ;
- D:(5>(IOSL-$Y)) DIX Q:$D(DIRUT) W !!?4,"new line",$S($D(^XTV(8991,DA,1,XTVL,1,XTVK,"INS",2)):"s",1:"")," inserted **BEFORE** original line ",XTVK-1
- F M=0:0 S M=$O(^XTV(8991,DA,1,XTVL,1,XTVK,"INS",M)) Q:M'>0 D:(2>(IOSL-$Y)) DIX Q:$D(DIRUT) W !,^(M,0)
- S XTVI=XTVK
- Q
- ;
- CHANGE ;
- S X=^XTV(8991,DA,1,XTVL,1,XTVK,"DEL"),Y=^XTV(8991,DA,1,XTVL,1,XTVK+1,"INS",1,0)
- S N1=0 F M=1:1:$L(X) I $E(X,M)'=$E(Y,M) S N1=M Q
- S N2X=$L(X)+1,N2Y=$L(Y)+1,N2M=N2X I N2Y<N2X S N2M=N2Y
- F M=0:0 S N2X=N2X-1,N2Y=N2Y-1 Q:N2X'>0!(N2Y'>0) I $E(X,N2X)'=$E(Y,N2Y) Q
- I N1=0 S N1=$S($L(X)<$L(Y):$L(X)+1,1:$L(Y)+1)
- D:(6>(IOSL-$Y)) DIX Q:$D(DIRUT) W !!?4,"line ",XTVK," replaced:"
- W !,$E(X,$S(N1>5:N1-6,1:1),N2X+6),!?4,"with:"
- W !,$E(Y,$S(N1>5:N1-6,1:1),N2Y+6)
- S XTVD=XTVK,XTVI=XTVK+1
- Q
- ;
- DIX N X,Y I '$D(ZTQUEUED),IOST["C-" D ^DIR Q:$D(DIRUT)
- W @IOF
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVRC2 4148 printed Feb 19, 2025@00:08:28 Page 2
- XTVRC2 ; JLI/SF-ISC.SEATTLE ** PRODUCE LISTING OF CHANGE HISTORY FOR ROUTINE ;12/7/93 15:20
- +1 ;;7.3;TOOLKIT;;Apr 25, 1995
- +2 WRITE !!,"This routine lists the changes in program code that have been noted.",!!
- RSEL USE IO(0)
- WRITE !!,"Select the routine(s) which you want changes listed for:",!
- +1 KILL ^TMP($JOB)
- XECUTE ^%ZOSF("RSEL")
- if $ORDER(^UTILITY($JOB,""))=""
- GOTO KILL
- SET %X="^UTILITY($J,"
- SET %Y="^TMP($J,"
- DO %XY^%RCR
- KILL ^UTILITY($JOB)
- +2 READ "Show changes back to DATE",!?5,"(none if number of changes is to be specified): ",X:DTIME
- if '$TEST
- QUIT
- if X=""
- SET X=0
- SET Y=0
- SET %DT="QE"
- if X'=0
- DO ^%DT
- KILL %DT
- SET XTVDAT=+Y
- IF XTVDAT>0
- SET X=10000
- GOTO A2
- A1 READ !!,"Show changes for how many past versions (or ALL): 1// ",X:DTIME
- if '$TEST!(X[U)
- QUIT
- if X=""
- SET X=1
- if "Aa"[$EXTRACT(X)
- SET X=10000
- IF +X'=X!(X'>0)
- if X'["?"
- WRITE $CHAR(7)," ??"
- WRITE !,"Enter a number indicating the number of past versions you want to see changes",!
- GOTO A1
- A2 SET XTVNV=X
- +1 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO KILL
- IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="DQ^XTVRC2"
- SET ZTIO=ION
- SET ZTDESC="Routine Changes"
- SET ZTSAVE("^TMP($J,")=""
- SET ZTSAVE("XTVDAT")=""
- SET ZTSAVE("XTVNV")=""
- DO ^%ZTLOAD
- KILL ZTRTN,ZTIO,ZTDESC,ZTSAVE
- GOTO KILL
- +2 ;
- DQ ;
- +1 SET X="N"
- SET %DT="T"
- DO ^%DT
- SET XTVTIM=Y
- +2 USE IO
- SET DIR(0)="E"
- SET XTVNAM=""
- FOR XTVA=0:0
- SET XTVNAM=$ORDER(^TMP($JOB,XTVNAM))
- if XTVNAM=""
- QUIT
- DO ONE
- if $DATA(DIRUT)
- QUIT
- +3 if $DATA(DIRUT)
- GOTO KILL
- IF $DATA(^TMP($JOB," NEW"))
- WRITE !!,"The following routines ARE NEW to the file (no prior version to compare):",!!
- SET XTVNAM=""
- FOR XTVI=0:0
- SET XTVNAM=$ORDER(^TMP($JOB," NEW",XTVNAM))
- if XTVNAM=""
- QUIT
- if XTVI#7
- WRITE !
- WRITE $JUSTIFY(XTVNAM,10)
- +4 IF $DATA(^TMP($JOB," NO CHANGE"))
- WRITE !!,"The following routines showed no change in the specified number of versions:",!!
- SET XTVNAM=""
- FOR XTVI=0:0
- SET XTVNAM=$ORDER(^TMP($JOB," NO CHANGE",XTVNAM))
- if XTVNAM=""
- QUIT
- if XTVI#7
- WRITE !
- WRITE $JUSTIFY(XTVNAM,10)
- +5 WRITE !
- +6 IF '$DATA(ZTQUEUED)
- DO ^%ZISC
- GOTO RSEL
- +7 USE IO
- if IOST'["C-"
- WRITE @IOF
- KILL DO ^%ZISC
- +1 KILL XTVA,XTVC,XTVD,XTVDAT,XTVDAT1,XTVI,XTVJ,XTVK,XTVL,XTVNV,XTVNAM,ZTRTN,ZTSAVE,ZTIO,X,Y,M,DA,POP,DIRUT,DIR
- +2 QUIT
- +3 ;
- ONE ;
- +1 SET DA=$ORDER(^XTV(8991,"B",XTVNAM,0))
- SET XTROU=XTVNAM
- IF DA'>0
- DO LCHEK^XTVRC1
- if 'L
- QUIT
- DO LOOP^XTVRC1
- SET DA=$ORDER(^XTV(8991,"B",XTVNAM,0))
- if DA'>0
- QUIT
- SET ^TMP($JOB," NEW",XTVNAM)=""
- QUIT
- +2 ; MAKE SURE WE HAVE INCLUDED THE CURRENT VERSION
- SET XTVDA=DA
- DO LOOP^XTVRC1
- SET DA=XTVDA
- +3 SET XTVJ=0
- FOR XTVL=0:0
- SET XTVL=$ORDER(^XTV(8991,DA,1,XTVL))
- if XTVL'>0
- QUIT
- SET XTVJ=XTVL
- +4 SET XTVC=0
- SET XTVDAT1=+^XTV(8991,DA,1,XTVJ,0)
- FOR XTVL=XTVJ-1:-1
- if XTVDAT1'>XTVDAT
- QUIT
- if XTVL'>0!(XTVL'>(XTVJ-XTVNV-1))
- QUIT
- IF $DATA(^XTV(8991,DA,1,XTVL))
- SET XTVDATX=XTVDAT1
- SET XTVDAT1=+^(XTVL,0)
- IF XTVDATX>XTVDAT
- DO LIST
- if $DATA(DIRUT)
- QUIT
- +5 IF XTVC'>0
- SET ^TMP($JOB," NO CHANGE",XTVNAM)=""
- +6 QUIT
- +7 ;
- LIST ;
- +1 IF $ORDER(^XTV(8991,DA,1,XTVL,1,0))=2
- IF $ORDER(^(2,0))="DEL"
- IF $ORDER(^XTV(8991,DA,1,XTVL,1,2))=3
- IF $ORDER(^(3,0))="INS"
- IF $ORDER(^XTV(8991,DA,1,XTVL,1,3))=""
- QUIT
- +2 if (6>(IOSL-$Y))
- DO DIX
- if $DATA(DIRUT)
- QUIT
- +3 SET %=XTVDATX_"00000"
- SET XTVDATX=$EXTRACT(%,4,5)_"/"_$EXTRACT(%,6,7)_"/"_$EXTRACT(%,2,3)_" "_$EXTRACT(%,9,10)_":"_$EXTRACT(%,11,12)
- SET XTVC=XTVC+1
- WRITE !!,XTVNAM," changes in code ",XTVJ-XTVL," version",$SELECT(XTVJ-XTVL>1:"s",1:"")," back (recorded ",XTVDATX,")"
- KILL %
- +4 SET XTVD=0
- SET XTVI=0
- FOR XTVK=0:0
- SET XTVK=$ORDER(^XTV(8991,DA,1,XTVL,1,XTVK))
- if XTVK'>0
- QUIT
- if $DATA(^(XTVK,"DEL"))&(XTVD<XTVK)
- DO DELETE
- if (XTVI<XTVK)&$DATA(^XTV(8991,DA,1,XTVL,1,XTVK,"INS"))
- DO INSERT
- if $DATA(DIRUT)
- QUIT
- +5 QUIT
- +6 ;
- DELETE ;
- +1 IF $DATA(^XTV(8991,DA,1,XTVL,1,XTVK+1,"INS",1))
- IF '$DATA(^(2))
- DO CHANGE
- QUIT
- +2 if (4>(IOSL-$Y))
- DO DIX
- if $DATA(DIRUT)
- QUIT
- WRITE !!?4,"original line ",XTVK," deleted. code was:",!,^XTV(8991,DA,1,XTVL,1,XTVK,"DEL")
- +3 SET XTVD=XTVK
- +4 QUIT
- +5 ;
- INSERT ;
- +1 if (5>(IOSL-$Y))
- DO DIX
- if $DATA(DIRUT)
- QUIT
- WRITE !!?4,"new line",$SELECT($DATA(^XTV(8991,DA,1,XTVL,1,XTVK,"INS",2)):"s",1:"")," inserted **BEFORE** original line ",XTVK-1
- +2 FOR M=0:0
- SET M=$ORDER(^XTV(8991,DA,1,XTVL,1,XTVK,"INS",M))
- if M'>0
- QUIT
- if (2>(IOSL-$Y))
- DO DIX
- if $DATA(DIRUT)
- QUIT
- WRITE !,^(M,0)
- +3 SET XTVI=XTVK
- +4 QUIT
- +5 ;
- CHANGE ;
- +1 SET X=^XTV(8991,DA,1,XTVL,1,XTVK,"DEL")
- SET Y=^XTV(8991,DA,1,XTVL,1,XTVK+1,"INS",1,0)
- +2 SET N1=0
- FOR M=1:1:$LENGTH(X)
- IF $EXTRACT(X,M)'=$EXTRACT(Y,M)
- SET N1=M
- QUIT
- +3 SET N2X=$LENGTH(X)+1
- SET N2Y=$LENGTH(Y)+1
- SET N2M=N2X
- IF N2Y<N2X
- SET N2M=N2Y
- +4 FOR M=0:0
- SET N2X=N2X-1
- SET N2Y=N2Y-1
- if N2X'>0!(N2Y'>0)
- QUIT
- IF $EXTRACT(X,N2X)'=$EXTRACT(Y,N2Y)
- QUIT
- +5 IF N1=0
- SET N1=$SELECT($LENGTH(X)<$LENGTH(Y):$LENGTH(X)+1,1:$LENGTH(Y)+1)
- +6 if (6>(IOSL-$Y))
- DO DIX
- if $DATA(DIRUT)
- QUIT
- WRITE !!?4,"line ",XTVK," replaced:"
- +7 WRITE !,$EXTRACT(X,$SELECT(N1>5:N1-6,1:1),N2X+6),!?4,"with:"
- +8 WRITE !,$EXTRACT(Y,$SELECT(N1>5:N1-6,1:1),N2Y+6)
- +9 SET XTVD=XTVK
- SET XTVI=XTVK+1
- +10 QUIT
- +11 ;
- DIX NEW X,Y
- IF '$DATA(ZTQUEUED)
- IF IOST["C-"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- +1 WRITE @IOF
- +2 QUIT
