source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTRCMP.m@ 1736

Last change on this file since 1736 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1XTRCMP ;SF-ISC/RWF - Compare two routines. ;12/01/2005
2 ;;7.3;TOOLKIT;**92**;Apr 25, 1995;Build 1
3A ;Compare two routines in account
4 N DIR,DIRUT,RTN1,RTN2,%N,XCNP,DIF,%DEBUG,XTEND,%ZIS,ZTDESC,ZTRTN,ZTSAVE
5 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
6 S U="^" S:'$D(DTIME) DTIME=$$DTIME^XUP($G(DUZ),$G(IOS))
7 W !,"Compares two routines"
8 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
9 S %ZIS="Q" D ^%ZIS G QUIT:POP
10 I '$D(IO("Q")) W !,"Loading Routines." G CHECK
11 S ZTRTN="CHECK^XTRCMP",ZTDESC="Routine Compare",ZTSAVE("RTN1")="",ZTSAVE("RTN2")=""
12 D ^%ZTLOAD D HOME^%ZIS
13 G QUIT
14 ;
15CHECK ;
16 S DIF="^TMP($J,1," D LOAD(RTN1) S O=XCNP-1
17 S DIF="^TMP($J,2," D LOAD(RTN2) S F=XCNP-1
18 U IO W @IOF,!,RTN1,?(IOM\2),RTN2
19 D LINE,^XMPC W !
20 D ^%ZISC
21 G QUIT
22 ;
23LOAD(X) ;Load Routine from Disk, Line count in XCNP.
24 S XCNP=0 X ^%ZOSF("LOAD")
25 Q
26RSEL S DIR(0)="F^1:8^D TEST^XTRCMP(X)",DIR("?")="Routine name to do compare on."
27 D ^DIR K DIR
28 Q
29TEST(X) ;Test if Routine is on Disk
30 X ^%ZOSF("TEST") I '$T W !,"Routine ",X," missing." K X
31 Q
32END S XTEND=1
33 Q
34 ;
35QUIT K ^TMP($J)
36 Q
37LINE S X="",$P(X,"-",IOM-3)="-" W !,X
38 Q
39 ;
40TAPE ;Read a tape and compare to disk.
41 N DIR,DIRUT,RTN1,RTN2,%N,XCNP,DIF,XTAPE,X1
42 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
43 S U="^"
44 W !!,"Compares routines from tape/file with what's on disk."
45 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
46 U XTAPE R X:10,Y:10 U IO(0) W !!,"Tape header",!,X,!,Y
47 S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="Yes" D ^DIR K DIR G EXIT:$D(DIRUT)!('Y)
48 S IO=IO(0),%ZIS="",%ZIS("A")="Output Report on Device: " D ^%ZIS G EXIT:POP
49 U IO W !,"Compare of routines from file (",XTAPE,") and disk",!
50 F X1=0:0 D TIN Q:X="" D DIN I $D(X) D CMP("Tape")
51 U IO W !,"DONE"
52EXIT S IO=XTAPE F I="IOT","IOST","IOST(0)","IOS" S @I=XTAPE(I)
53 D ^%ZISC
54 K ^TMP($J)
55 Q
56 ;
57TIN ;Read one routine from tape
58 N I
59 U XTAPE R RTN1:10 ;Read routine name
60 ;Cache has more than just the name. 32 char max name.
61 F I=2:1:32 Q:($E(RTN1,I)'?1AN)
62 S RTN1=$E(RTN1,1,I-1)
63 I (RTN1'?1.8AN)&(RTN1'?1"%".7AN) S X="" Q
64 K ^TMP($J,1)
65 F I=1:1 R X:10 Q:X="" S ^TMP($J,1,I,0)=$TR(X,$C(9)," ")
66 S X=RTN1,O=I-1 U IO
67 Q
68 ;
69DIN X ^%ZOSF("TEST") I '$T U IO W !,"Routine ",X," not on disk" D LINE K X Q
70 K ^TMP($J,2) S DIF="^TMP($J,2," D LOAD(X) S F=XCNP-1
71 Q
72 ;
73CMP(S1) ;
74 U IO W !,"Routine ",RTN1,!?3,S1,?IOM\2+3,"Disk"
75 I $G(%DEBUG) F I=1,2 S ^TMP($J,2,I,0)=^TMP($J,1,I,0)
76 D LINE,^XMPC
77 Q
78 ;
79KIN(RN) ;KIDS routine in
80 K ^TMP($J,1) S R=$NA(^XTMP("XPDI",XPDST,"RTN",RN))
81 F I=1:1 Q:'$D(@R@(I)) S ^TMP($J,1,I,0)=@R@(I,0)
82 S X=RN,O=I-1
83 Q
84 ;
85XPD ;Compair a KIDS install to Disk
86 N RTN1,RTN2,O,F,%N,XCNP
87 ;Get the install
88 S %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))",XPDST=$$LOOK^XPDI1(%)
89 S XPDNM=$$GET1^DIQ(9.7,XPDST_",",.01)
90 Q:'XPDST!$D(XPDQUIT)
91 S %ZIS="M" D ^%ZIS Q:POP
92 D XPDDO(XPDST)
93 D ^%ZISC
94 Q
95 ;
96XPDDO(XPDST) ;Do the KIDS compare
97 N RTN1,RTN2,O,F,%N,XCNP,X
98 U IO W !,"Compare of routines from KIDS ",XPDNM,", and disk",!
99 S RTN1="" F S RTN1=$O(^XTMP("XPDI",XPDST,"RTN",RTN1)) Q:RTN1="" S X=^(RTN1) D
100 . I X W:X=1 !!,"DELETE Routine: ",RTN1,! Q
101 . D KIN(RTN1),DIN I $D(X) S F=XCNP-1 D CMP("KIDS")
102 . Q
103 Q
Note: See TracBrowser for help on using the repository browser.