XTRCMP ;SF-ISC/RWF - Compare two routines. ;12/01/2005
;;7.3;TOOLKIT;**92**;Apr 25, 1995;Build 1
A ;Compare two routines in account
N DIR,DIRUT,RTN1,RTN2,%N,XCNP,DIF,%DEBUG,XTEND,%ZIS,ZTDESC,ZTRTN,ZTSAVE
N %,%1,%2,%3,%4,%H,%T,%Y,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
S U="^" S:'$D(DTIME) DTIME=$$DTIME^XUP($G(DUZ),$G(IOS))
W !,"Compares two routines"
S DIR("A")="First Routine" D RSEL G QUIT:$D(DIRUT) S RTN1=X,DIR("A")="Compare to Routine: " D RSEL G QUIT:$D(DIRUT) S RTN2=X
S %ZIS="Q" D ^%ZIS G QUIT:POP
I '$D(IO("Q")) W !,"Loading Routines." G CHECK
S ZTRTN="CHECK^XTRCMP",ZTDESC="Routine Compare",ZTSAVE("RTN1")="",ZTSAVE("RTN2")=""
D ^%ZTLOAD D HOME^%ZIS
G QUIT
;
CHECK ;
S DIF="^TMP($J,1," D LOAD(RTN1) S O=XCNP-1
S DIF="^TMP($J,2," D LOAD(RTN2) S F=XCNP-1
U IO W @IOF,!,RTN1,?(IOM\2),RTN2
D LINE,^XMPC W !
D ^%ZISC
G QUIT
;
LOAD(X) ;Load Routine from Disk, Line count in XCNP.
S XCNP=0 X ^%ZOSF("LOAD")
Q
RSEL S DIR(0)="F^1:8^D TEST^XTRCMP(X)",DIR("?")="Routine name to do compare on."
D ^DIR K DIR
Q
TEST(X) ;Test if Routine is on Disk
X ^%ZOSF("TEST") I '$T W !,"Routine ",X," missing." K X
Q
END S XTEND=1
Q
;
QUIT K ^TMP($J)
Q
LINE S X="",$P(X,"-",IOM-3)="-" W !,X
Q
;
TAPE ;Read a tape and compare to disk.
N DIR,DIRUT,RTN1,RTN2,%N,XCNP,DIF,XTAPE,X1
N %,%1,%2,%3,%4,%H,%T,%Y,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
S U="^"
W !!,"Compares routines from tape/file with what's on disk."
S %ZIS="",%ZIS("A")="Device with Routines: " D ^%ZIS Q:POP S XTAPE=IO F I="IOT","IOST","IOST(0)","IOS" S XTAPE(I)=@I
U XTAPE R X:10,Y:10 U IO(0) W !!,"Tape header",!,X,!,Y
S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="Yes" D ^DIR K DIR G EXIT:$D(DIRUT)!('Y)
S IO=IO(0),%ZIS="",%ZIS("A")="Output Report on Device: " D ^%ZIS G EXIT:POP
U IO W !,"Compare of routines from file (",XTAPE,") and disk",!
F X1=0:0 D TIN Q:X="" D DIN I $D(X) D CMP("Tape")
U IO W !,"DONE"
EXIT S IO=XTAPE F I="IOT","IOST","IOST(0)","IOS" S @I=XTAPE(I)
D ^%ZISC
K ^TMP($J)
Q
;
TIN ;Read one routine from tape
N I
U XTAPE R RTN1:10 ;Read routine name
;Cache has more than just the name. 32 char max name.
F I=2:1:32 Q:($E(RTN1,I)'?1AN)
S RTN1=$E(RTN1,1,I-1)
I (RTN1'?1.8AN)&(RTN1'?1"%".7AN) S X="" Q
K ^TMP($J,1)
F I=1:1 R X:10 Q:X="" S ^TMP($J,1,I,0)=$TR(X,$C(9)," ")
S X=RTN1,O=I-1 U IO
Q
;
DIN X ^%ZOSF("TEST") I '$T U IO W !,"Routine ",X," not on disk" D LINE K X Q
K ^TMP($J,2) S DIF="^TMP($J,2," D LOAD(X) S F=XCNP-1
Q
;
CMP(S1) ;
U IO W !,"Routine ",RTN1,!?3,S1,?IOM\2+3,"Disk"
I $G(%DEBUG) F I=1,2 S ^TMP($J,2,I,0)=^TMP($J,1,I,0)
D LINE,^XMPC
Q
;
KIN(RN) ;KIDS routine in
K ^TMP($J,1) S R=$NA(^XTMP("XPDI",XPDST,"RTN",RN))
F I=1:1 Q:'$D(@R@(I)) S ^TMP($J,1,I,0)=@R@(I,0)
S X=RN,O=I-1
Q
;
XPD ;Compair a KIDS install to Disk
N RTN1,RTN2,O,F,%N,XCNP
;Get the install
S %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))",XPDST=$$LOOK^XPDI1(%)
S XPDNM=$$GET1^DIQ(9.7,XPDST_",",.01)
Q:'XPDST!$D(XPDQUIT)
S %ZIS="M" D ^%ZIS Q:POP
D XPDDO(XPDST)
D ^%ZISC
Q
;
XPDDO(XPDST) ;Do the KIDS compare
N RTN1,RTN2,O,F,%N,XCNP,X
U IO W !,"Compare of routines from KIDS ",XPDNM,", and disk",!
S RTN1="" F S RTN1=$O(^XTMP("XPDI",XPDST,"RTN",RTN1)) Q:RTN1="" S X=^(RTN1) D
. I X W:X=1 !!,"DELETE Routine: ",RTN1,! Q
. D KIN(RTN1),DIN I $D(X) S F=XCNP-1 D CMP("KIDS")
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTRCMP 3469 printed Apr 09, 2024@21:43:09 Page 2
XTRCMP ;SF-ISC/RWF - Compare two routines. ;12/01/2005
+1 ;;7.3;TOOLKIT;**92**;Apr 25, 1995;Build 1
A ;Compare two routines in account
+1 NEW DIR,DIRUT,RTN1,RTN2,%N,XCNP,DIF,%DEBUG,XTEND,%ZIS,ZTDESC,ZTRTN,ZTSAVE
+2 NEW %,%1,%2,%3,%4,%H,%T,%Y,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
+3 SET U="^"
if '$DATA(DTIME)
SET DTIME=$$DTIME^XUP($GET(DUZ),$GET(IOS))
+4 WRITE !,"Compares two routines"
+5 SET DIR("A")="First Routine"
DO RSEL
if $DATA(DIRUT)
GOTO QUIT
SET RTN1=X
SET DIR("A")="Compare to Routine: "
DO RSEL
if $DATA(DIRUT)
GOTO QUIT
SET RTN2=X
+6 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO QUIT
+7 IF '$DATA(IO("Q"))
WRITE !,"Loading Routines."
GOTO CHECK
+8 SET ZTRTN="CHECK^XTRCMP"
SET ZTDESC="Routine Compare"
SET ZTSAVE("RTN1")=""
SET ZTSAVE("RTN2")=""
+9 DO ^%ZTLOAD
DO HOME^%ZIS
+10 GOTO QUIT
+11 ;
CHECK ;
+1 SET DIF="^TMP($J,1,"
DO LOAD(RTN1)
SET O=XCNP-1
+2 SET DIF="^TMP($J,2,"
DO LOAD(RTN2)
SET F=XCNP-1
+3 USE IO
WRITE @IOF,!,RTN1,?(IOM\2),RTN2
+4 DO LINE
DO ^XMPC
WRITE !
+5 DO ^%ZISC
+6 GOTO QUIT
+7 ;
LOAD(X) ;Load Routine from Disk, Line count in XCNP.
+1 SET XCNP=0
XECUTE ^%ZOSF("LOAD")
+2 QUIT
RSEL SET DIR(0)="F^1:8^D TEST^XTRCMP(X)"
SET DIR("?")="Routine name to do compare on."
+1 DO ^DIR
KILL DIR
+2 QUIT
TEST(X) ;Test if Routine is on Disk
+1 XECUTE ^%ZOSF("TEST")
IF '$TEST
WRITE !,"Routine ",X," missing."
KILL X
+2 QUIT
END SET XTEND=1
+1 QUIT
+2 ;
QUIT KILL ^TMP($JOB)
+1 QUIT
LINE SET X=""
SET $PIECE(X,"-",IOM-3)="-"
WRITE !,X
+1 QUIT
+2 ;
TAPE ;Read a tape and compare to disk.
+1 NEW DIR,DIRUT,RTN1,RTN2,%N,XCNP,DIF,XTAPE,X1
+2 NEW %,%1,%2,%3,%4,%H,%T,%Y,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
+3 SET U="^"
+4 WRITE !!,"Compares routines from tape/file with what's on disk."
+5 SET %ZIS=""
SET %ZIS("A")="Device with Routines: "
DO ^%ZIS
if POP
QUIT
SET XTAPE=IO
FOR I="IOT","IOST","IOST(0)","IOS"
SET XTAPE(I)=@I
+6 USE XTAPE
READ X:10,Y:10
USE IO(0)
WRITE !!,"Tape header",!,X,!,Y
+7 SET DIR(0)="Y"
SET DIR("A")="OK to continue"
SET DIR("B")="Yes"
DO ^DIR
KILL DIR
if $DATA(DIRUT)!('Y)
GOTO EXIT
+8 SET IO=IO(0)
SET %ZIS=""
SET %ZIS("A")="Output Report on Device: "
DO ^%ZIS
if POP
GOTO EXIT
+9 USE IO
WRITE !,"Compare of routines from file (",XTAPE,") and disk",!
+10 FOR X1=0:0
DO TIN
if X=""
QUIT
DO DIN
IF $DATA(X)
DO CMP("Tape")
+11 USE IO
WRITE !,"DONE"
EXIT SET IO=XTAPE
FOR I="IOT","IOST","IOST(0)","IOS"
SET @I=XTAPE(I)
+1 DO ^%ZISC
+2 KILL ^TMP($JOB)
+3 QUIT
+4 ;
TIN ;Read one routine from tape
+1 NEW I
+2 ;Read routine name
USE XTAPE
READ RTN1:10
+3 ;Cache has more than just the name. 32 char max name.
+4 FOR I=2:1:32
if ($EXTRACT(RTN1,I)'?1AN)
QUIT
+5 SET RTN1=$EXTRACT(RTN1,1,I-1)
+6 IF (RTN1'?1.8AN)&(RTN1'?1"%".7AN)
SET X=""
QUIT
+7 KILL ^TMP($JOB,1)
+8 FOR I=1:1
READ X:10
if X=""
QUIT
SET ^TMP($JOB,1,I,0)=$TRANSLATE(X,$CHAR(9)," ")
+9 SET X=RTN1
SET O=I-1
USE IO
+10 QUIT
+11 ;
DIN XECUTE ^%ZOSF("TEST")
IF '$TEST
USE IO
WRITE !,"Routine ",X," not on disk"
DO LINE
KILL X
QUIT
+1 KILL ^TMP($JOB,2)
SET DIF="^TMP($J,2,"
DO LOAD(X)
SET F=XCNP-1
+2 QUIT
+3 ;
CMP(S1) ;
+1 USE IO
WRITE !,"Routine ",RTN1,!?3,S1,?IOM\2+3,"Disk"
+2 IF $GET(%DEBUG)
FOR I=1,2
SET ^TMP($JOB,2,I,0)=^TMP($JOB,1,I,0)
+3 DO LINE
DO ^XMPC
+4 QUIT
+5 ;
KIN(RN) ;KIDS routine in
+1 KILL ^TMP($JOB,1)
SET R=$NAME(^XTMP("XPDI",XPDST,"RTN",RN))
+2 FOR I=1:1
if '$DATA(@R@(I))
QUIT
SET ^TMP($JOB,1,I,0)=@R@(I,0)
+3 SET X=RN
SET O=I-1
+4 QUIT
+5 ;
XPD ;Compair a KIDS install to Disk
+1 NEW RTN1,RTN2,O,F,%N,XCNP
+2 ;Get the install
+3 SET %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))"
SET XPDST=$$LOOK^XPDI1(%)
+4 SET XPDNM=$$GET1^DIQ(9.7,XPDST_",",.01)
+5 if 'XPDST!$DATA(XPDQUIT)
QUIT
+6 SET %ZIS="M"
DO ^%ZIS
if POP
QUIT
+7 DO XPDDO(XPDST)
+8 DO ^%ZISC
+9 QUIT
+10 ;
XPDDO(XPDST) ;Do the KIDS compare
+1 NEW RTN1,RTN2,O,F,%N,XCNP,X
+2 USE IO
WRITE !,"Compare of routines from KIDS ",XPDNM,", and disk",!
+3 SET RTN1=""
FOR
SET RTN1=$ORDER(^XTMP("XPDI",XPDST,"RTN",RTN1))
if RTN1=""
QUIT
SET X=^(RTN1)
Begin DoDot:1
+4 IF X
if X=1
WRITE !!,"DELETE Routine: ",RTN1,!
QUIT
+5 DO KIN(RTN1)
DO DIN
IF $DATA(X)
SET F=XCNP-1
DO CMP("KIDS")
+6 QUIT
End DoDot:1
+7 QUIT
