- XTVRC1A ;ISC-SF/JLI - SHOW SUMMARY OF ROUTINES MOST RECENTLY UPDATED ;10/27/10
- ;;7.3;TOOLKIT;**127**; Apr 25, 1995;Build 5
- ;;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
- XTVRC1A ;ISC-SF/JLI - SHOW SUMMARY OF ROUTINES MOST RECENTLY UPDATED ;10/27/10
- +1 ;;7.3;TOOLKIT;**127**; Apr 25, 1995;Build 5
- +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
