XTVRC1A ;ISC-SF/JLI - SHOW SUMMARY OF ROUTINES MOST RECENTLY UPDATED ;10/27/10
;;7.3;TOOLKIT;**127**; Apr 25, 1995;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
ENTRY W ! K ^TMP($J) X ^%ZOSF("RSEL") Q:$O(^UTILITY($J,""))="" S %X="^UTILITY($J,",%Y="^TMP($J," D %XY^%RCR K ^UTILITY($J)
S DIR(0)="D",DIR("A")="List CHANGES since DATE" D ^DIR K DIR S XTVRDAT=+Y G:Y'>0 ENTRY
S %ZIS="QM" D ^%ZIS Q:POP I IO'=IO(0) S ZTRTN="DQENT^XTVRC1A",ZTIO=ION,ZTSAVE("^TMP($J,")="",ZTSAVE("XTVRDAT")="",ZTDESC="XTVRC1A-IDENTIFY ROUTINES RECENTLY LOGGED AS CHANGED" D ^%ZTLOAD G EXIT
;
DQENT ;
S X="N",%DT="T" D ^%DT S XTVTIM=Y
W:'$D(ZTQUEUED) "Please wait..."
S XTROU="" F DA=0:0 S XTROU=$O(^TMP($J,XTROU)) Q:XTROU="" D
. S DA=$O(^XTV(8991,"B",XTROU,0)) I DA'>0 D LCHEK^XTVRC1 Q:'L D LOOP^XTVRC1 S DA=$O(^XTV(8991,"B",XTROU,0)) Q:DA'>0
. S XTVDA=DA D LOOP^XTVRC1 S DA=XTVDA
. D DOIT
FINISH U IO D OUTPUT D ^%ZISC
EXIT K %DT,%X,%Y,%ZIS,A,D,D1,DA,I,J,K,L,POP,X,X1,X11,X12,XS,XTROU,XTVDA,XTVRDAT,XTVRDATE,XTVTIM,XTVUT,Y,ZTDESC,ZTIO,ZTRTN,NAME,XTVR,Z,ZTSAVE
Q
;
ALL ;
S DIR(0)="D",DIR("A")="List CHANGES since DATE" D ^DIR K DIR S XTVRDAT=+Y G:Y'>0 EXIT
W ! K ^TMP($J)
S %ZIS="QM" D ^%ZIS Q:POP I IO'=IO(0) S ZTRTN="DQALL^XTVRC1A",ZTSAVE("XTVRDAT")="",ZTIO=ION,ZTDESC="XTVRC1A-IDENTIFY ROUTINES RECENTLY LOGGED AS CHANGED" D ^%ZTLOAD G EXIT
;
DQALL ;
K ^TMP($J)
F DA=0:0 S DA=$O(^XTV(8991,DA)) Q:DA'>0 S XTROU=$P(^(DA,0),U) D DOIT W:'$D(ZTQUEUED) "."
G FINISH
Q
DOIT ;
S K=0,X1=0,X11="",X12="",XS=" " F J=0:0 S J=$O(^XTV(8991,DA,1,J)) S:J'>0&(X1>0) ^TMP($J,XS,(9999999-X1),XTROU)=+X1,^(XTROU,1)=X11,^(2)=X12 Q:J'>0 D CHK S K=J
Q
OUTPUT ;
S XTVUT=0,D1=0,XTVRDATE=$E(XTVRDAT,4,5)_"/"_$E(XTVRDAT,6,7)_"/"_$E(XTVRDAT,2,3) W !!,"The following routines have been logged as NEW ROUTINES since ",XTVRDATE,!!
S XTVR=0 F I=0:0 Q:XTVUT S I=$O(^TMP($J," N",I)) Q:I'>0 S A="" F J=0:0 S A=$O(^TMP($J," N",I,A)) Q:A="" S D=^(A),X11=^(A,1),X12=^(2) W:(D\1'=D1) ! S D1=D\1 D:A'=$P(X11," ") NAME D PRNT S XTVR=XTVR+1 Q:XTVUT
Q:XTVUT
W !!,$S(XTVR>0:XTVR,1:"No")," NEW routines were logged",!!,"The following routines have logged CHANGES since ",XTVRDATE,!!
S XTVR=0 F I=0:0 Q:XTVUT S I=$O(^TMP($J," ",I)) Q:I'>0 S A="" F J=0:0 S A=$O(^TMP($J," ",I,A)) Q:A="" S D=^(A),X11=^(A,1),X12=^(2) Q:D<XTVRDAT W:(D\1'=D1) ! S D1=D\1 D:A'=$P(X11," ") NAME D PRNT S XTVR=XTVR+1 Q:XTVUT
Q:XTVUT
W !!,$S(XTVR>0:XTVR,1:"No")," old routines were CHANGED",!!,"The following routines have NOT LOGGED CHANGES since ",XTVRDATE,!!
S XTVR=0 F I=9999999-XTVRDAT:0 Q:XTVUT S I=$O(^TMP($J," ",I)) Q:I'>0 S A="" F J=0:0 S A=$O(^TMP($J," ",I,A)) Q:A="" S D=^(A),X11=^(A,1),X12=^(2) W:(D\1'=D1) ! S D1=D\1 D:A'=$P(X11," ") NAME D PRNT S XTVR=XTVR+1 Q:XTVUT
Q:XTVUT
W !!,$S(XTVR>0:XTVR,1:"No")," UNCHANGED routines were included",!!,"The following routines were previously LOGGED BUT NOT IN THE ACCOUNT",!,"Routines were searched for using 2 letter namespaces from routines",!,"originally specified.",!
S NAME="" F S NAME=$O(^TMP($J,NAME)) Q:NAME="" S ^TMP($J," X",$E(NAME,1,2))=""
S XTVR=0,NAME="" F S NAME=$O(^TMP($J," X",NAME)) Q:NAME="" D
. I $D(^XTV(8991,"B",NAME)),'$D(^XTV($J,NAME)) S X=NAME X ^%ZOSF("TEST") I '$T S ^TMP($J," Y",NAME)=""
. S X=NAME F S X=$O(^XTV(8991,"B",X)) Q:X=""!($E(X,1,$L(NAME))'=NAME) I '$D(^TMP($J,X)) X ^%ZOSF("TEST") I '$T S ^TMP($J," Y",X)=""
S NAME="" F I=0:1 S NAME=$O(^TMP($J," Y",NAME)) Q:NAME="" W:'(I#8) ! W ?((I#8)*10+1),NAME S XTVR=XTVR+1
W !!,$S(XTVR>0:XTVR,1:"No")," DELETED routines identified using 2 letter namespaces input",!!
Q
;
PRNT ;
S D=D_$S(D'[".":".",1:"")_"0000" D:($Y+3>IOSL) PAGE Q:XTVUT W !,A,?10,$E(D,4,5),"/",$E(D,6,7),"/",$E(D,2,3)," ",$E(D,9,10),":",$E(D,11,12)," ",$P(X11,";",3),?45," "_$P(X12,";",3,6)
Q
;
CHK ;
I J=1,+^XTV(8991,DA,1,J,0)'<XTVRDAT S XS=" N"
S:$S('$D(^XTV(8991,DA,1,J,1,1,0)):0,^(0)="":0,1:1) X11=^(0) S:$S('$D(^XTV(8991,DA,1,J,1,2,0)):0,^(0)="":0,1:1) X12=^(0)
I J>1,$O(^XTV(8991,DA,1,K,1,0))=2,$O(^(2))=3,$O(^(3))'>0,$O(^(2,0))="DEL",$O(^("DEL"))="",$O(^XTV(8991,DA,1,K,1,3,0))="INS",$O(^("INS",0))=1,$O(^(1))'>0 Q
S X1=^XTV(8991,DA,1,J,0)
Q
;
PAGE S XTVUT=0 I IOST["C-" R !?20,"Enter RETURN to continue... ",Z:DTIME I '$T!(Z[U) S XTVUT=1 Q
W @IOF
Q
;
NAME W !,A,?15,$P(X11," ")," is shown as name on first line"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVRC1A 4411 printed Apr 09, 2024@21:44:41 Page 2
XTVRC1A ;ISC-SF/JLI - SHOW SUMMARY OF ROUTINES MOST RECENTLY UPDATED ;10/27/10
+1 ;;7.3;TOOLKIT;**127**; Apr 25, 1995;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
ENTRY WRITE !
KILL ^TMP($JOB)
XECUTE ^%ZOSF("RSEL")
if $ORDER(^UTILITY($JOB,""))=""
QUIT
SET %X="^UTILITY($J,"
SET %Y="^TMP($J,"
DO %XY^%RCR
KILL ^UTILITY($JOB)
+1 SET DIR(0)="D"
SET DIR("A")="List CHANGES since DATE"
DO ^DIR
KILL DIR
SET XTVRDAT=+Y
if Y'>0
GOTO ENTRY
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
IF IO'=IO(0)
SET ZTRTN="DQENT^XTVRC1A"
SET ZTIO=ION
SET ZTSAVE("^TMP($J,")=""
SET ZTSAVE("XTVRDAT")=""
SET ZTDESC="XTVRC1A-IDENTIFY ROUTINES RECENTLY LOGGED AS CHANGED"
DO ^%ZTLOAD
GOTO EXIT
+3 ;
DQENT ;
+1 SET X="N"
SET %DT="T"
DO ^%DT
SET XTVTIM=Y
+2 if '$DATA(ZTQUEUED)
WRITE "Please wait..."
+3 SET XTROU=""
FOR DA=0:0
SET XTROU=$ORDER(^TMP($JOB,XTROU))
if XTROU=""
QUIT
Begin DoDot:1
+4 SET DA=$ORDER(^XTV(8991,"B",XTROU,0))
IF DA'>0
DO LCHEK^XTVRC1
if 'L
QUIT
DO LOOP^XTVRC1
SET DA=$ORDER(^XTV(8991,"B",XTROU,0))
if DA'>0
QUIT
+5 SET XTVDA=DA
DO LOOP^XTVRC1
SET DA=XTVDA
+6 DO DOIT
End DoDot:1
FINISH USE IO
DO OUTPUT
DO ^%ZISC
EXIT KILL %DT,%X,%Y,%ZIS,A,D,D1,DA,I,J,K,L,POP,X,X1,X11,X12,XS,XTROU,XTVDA,XTVRDAT,XTVRDATE,XTVTIM,XTVUT,Y,ZTDESC,ZTIO,ZTRTN,NAME,XTVR,Z,ZTSAVE
+1 QUIT
+2 ;
ALL ;
+1 SET DIR(0)="D"
SET DIR("A")="List CHANGES since DATE"
DO ^DIR
KILL DIR
SET XTVRDAT=+Y
if Y'>0
GOTO EXIT
+2 WRITE !
KILL ^TMP($JOB)
+3 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
IF IO'=IO(0)
SET ZTRTN="DQALL^XTVRC1A"
SET ZTSAVE("XTVRDAT")=""
SET ZTIO=ION
SET ZTDESC="XTVRC1A-IDENTIFY ROUTINES RECENTLY LOGGED AS CHANGED"
DO ^%ZTLOAD
GOTO EXIT
+4 ;
DQALL ;
+1 KILL ^TMP($JOB)
+2 FOR DA=0:0
SET DA=$ORDER(^XTV(8991,DA))
if DA'>0
QUIT
SET XTROU=$PIECE(^(DA,0),U)
DO DOIT
if '$DATA(ZTQUEUED)
WRITE "."
+3 GOTO FINISH
+4 QUIT
DOIT ;
+1 SET K=0
SET X1=0
SET X11=""
SET X12=""
SET XS=" "
FOR J=0:0
SET J=$ORDER(^XTV(8991,DA,1,J))
if J'>0&(X1>0)
SET ^TMP($JOB,XS,(9999999-X1),XTROU)=+X1
SET ^(XTROU,1)=X11
SET ^(2)=X12
if J'>0
QUIT
DO CHK
SET K=J
+2 QUIT
OUTPUT ;
+1 SET XTVUT=0
SET D1=0
SET XTVRDATE=$EXTRACT(XTVRDAT,4,5)_"/"_$EXTRACT(XTVRDAT,6,7)_"/"_$EXTRACT(XTVRDAT,2,3)
WRITE !!,"The following routines have been logged as NEW ROUTINES since ",XTVRDATE,!!
+2 SET XTVR=0
FOR I=0:0
if XTVUT
QUIT
SET I=$ORDER(^TMP($JOB," N",I))
if I'>0
QUIT
SET A=""
FOR J=0:0
SET A=$ORDER(^TMP($JOB," N",I,A))
if A=""
QUIT
SET D=^(A)
SET X11=^(A,1)
SET X12=^(2)
if (D\1'=D1)
WRITE !
SET D1=D\1
if A'=$PIECE(X11," ")
DO NAME
DO PRNT
SET XTVR=XTVR+1
if XTVUT
QUIT
+3 if XTVUT
QUIT
+4 WRITE !!,$SELECT(XTVR>0:XTVR,1:"No")," NEW routines were logged",!!,"The following routines have logged CHANGES since ",XTVRDATE,!!
+5 SET XTVR=0
FOR I=0:0
if XTVUT
QUIT
SET I=$ORDER(^TMP($JOB," ",I))
if I'>0
QUIT
SET A=""
FOR J=0:0
SET A=$ORDER(^TMP($JOB," ",I,A))
if A=""
QUIT
SET D=^(A)
SET X11=^(A,1)
SET X12=^(2)
if D<XTVRDAT
QUIT
if (D\1'=D1)
WRITE !
SET D1=D\1
if A'=$PIECE(X11," ")
DO NAME
DO PRNT
SET XTVR=XTVR+1
if XTVUT
QUIT
+6 if XTVUT
QUIT
+7 WRITE !!,$SELECT(XTVR>0:XTVR,1:"No")," old routines were CHANGED",!!,"The following routines have NOT LOGGED CHANGES since ",XTVRDATE,!!
+8 SET XTVR=0
FOR I=9999999-XTVRDAT:0
if XTVUT
QUIT
SET I=$ORDER(^TMP($JOB," ",I))
if I'>0
QUIT
SET A=""
FOR J=0:0
SET A=$ORDER(^TMP($JOB," ",I,A))
if A=""
QUIT
SET D=^(A)
SET X11=^(A,1)
SET X12=^(2)
if (D\1'=D1)
WRITE !
SET D1=D\1
if A'=$PIECE(X11," ")
DO NAME
DO PRNT
SET XTVR=XTVR+1
if XTVUT
QUIT
+9 if XTVUT
QUIT
+10 WRITE !!,$SELECT(XTVR>0:XTVR,1:"No")," UNCHANGED routines were included",!!,"The following routines were previously LOGGED BUT NOT IN THE ACCOUNT",!,"Routines were searched for using 2 letter namespaces from routines",!,"originally specified."
,!
+11 SET NAME=""
FOR
SET NAME=$ORDER(^TMP($JOB,NAME))
if NAME=""
QUIT
SET ^TMP($JOB," X",$EXTRACT(NAME,1,2))=""
+12 SET XTVR=0
SET NAME=""
FOR
SET NAME=$ORDER(^TMP($JOB," X",NAME))
if NAME=""
QUIT
Begin DoDot:1
+13 IF $DATA(^XTV(8991,"B",NAME))
IF '$DATA(^XTV($JOB,NAME))
SET X=NAME
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET ^TMP($JOB," Y",NAME)=""
+14 SET X=NAME
FOR
SET X=$ORDER(^XTV(8991,"B",X))
if X=""!($EXTRACT(X,1,$LENGTH(NAME))'=NAME)
QUIT
IF '$DATA(^TMP($JOB,X))
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET ^TMP($JOB," Y",X)=""
End DoDot:1
+15 SET NAME=""
FOR I=0:1
SET NAME=$ORDER(^TMP($JOB," Y",NAME))
if NAME=""
QUIT
if '(I#8)
WRITE !
WRITE ?((I#8)*10+1),NAME
SET XTVR=XTVR+1
+16 WRITE !!,$SELECT(XTVR>0:XTVR,1:"No")," DELETED routines identified using 2 letter namespaces input",!!
+17 QUIT
+18 ;
PRNT ;
+1 SET D=D_$SELECT(D'[".":".",1:"")_"0000"
if ($Y+3>IOSL)
DO PAGE
if XTVUT
QUIT
WRITE !,A,?10,$EXTRACT(D,4,5),"/",$EXTRACT(D,6,7),"/",$EXTRACT(D,2,3)," ",$EXTRACT(D,9,10),":",$EXTRACT(D,11,12)," ",$PIECE(X11,";",3),?45," "_$PIECE(X12,";",3,6)
+2 QUIT
+3 ;
CHK ;
+1 IF J=1
IF +^XTV(8991,DA,1,J,0)'<XTVRDAT
SET XS=" N"
+2 if $SELECT('$DATA(^XTV(8991,DA,1,J,1,1,0))
SET X11=^(0)
if $SELECT('$DATA(^XTV(8991,DA,1,J,1,2,0))
SET X12=^(0)
+3 IF J>1
IF $ORDER(^XTV(8991,DA,1,K,1,0))=2
IF $ORDER(^(2))=3
IF $ORDER(^(3))'>0
IF $ORDER(^(2,0))="DEL"
IF $ORDER(^("DEL"))=""
IF $ORDER(^XTV(8991,DA,1,K,1,3,0))="INS"
IF $ORDER(^("INS",0))=1
IF $ORDER(^(1))'>0
QUIT
+4 SET X1=^XTV(8991,DA,1,J,0)
+5 QUIT
+6 ;
PAGE SET XTVUT=0
IF IOST["C-"
READ !?20,"Enter RETURN to continue... ",Z:DTIME
IF '$TEST!(Z[U)
SET XTVUT=1
QUIT
+1 WRITE @IOF
+2 QUIT
+3 ;
NAME WRITE !,A,?15,$PIECE(X11," ")," is shown as name on first line"
+1 QUIT
