- 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 Feb 19, 2025@00:08: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