source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDCOM.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1XPDCOM ;SFISC/RSD - Compare Transport Global ;09/22/2005 574322.260552
2 ;;8.0;KERNEL;**21,58,108,124,393**;Jul 10, 1995;Build 12
3EN1 ;compare to current system
4 N DIC,DIR,DIRUT,POP,XPD,XPDA,XPDC,XPDNM,XPDT,XPDST,Y,Z,%ZIS
5 ;S DIC="^XPD(9.7,",DIC(0)="AEQMZ",DIC("S")="I '$P(^(0),U,9),$D(^XTMP(""XPDI"",Y))"
6 ;D ^DIC Q:Y<0 S XPDA=+Y,XPDNM=Y(0,0)
7 S XPDST=$$LOOK^XPDI1("I '$P(^(0),U,9),$D(^XTMP(""XPDI"",Y))",1) Q:XPDST'>0
8 S DIR(0)="S^1:Full Comparison;2:Second line of Routines only;3:Routines only;4:Columnar Routine compare",DIR("A")="Type of Compare",DIR("?")="Enter the type of comparison." ;rwf
9 D ^DIR Q:$D(DTOUT)!$D(DUOUT)
10 S XPDC=Y,Y="JOB^XPDCOM",Z="Transport Global Compare",XPD("XPDNM")="",XPD("XPDC")="",XPD("XPDT(")=""
11 D EN^XUTMDEVQ(Y,Z,.XPD)
12 Q
13JOB ;Loop thru XPDT
14 N XPDIT
15 F XPDIT=0:0 S XPDIT=$O(XPDT(XPDIT)) Q:XPDIT'>0 D COM(+XPDT(XPDIT))
16 Q
17 ;
18COM(XPDA) ;XPDA=ien of package in ^XTMP("XPDI"
19 Q:'$D(^XTMP("XPDI",$G(XPDA)))
20 S:$D(XPDT("DA",XPDA)) XPDNM=$P(XPDT(+XPDT("DA",XPDA)),U,2)
21 D HDR,COMR(5):XPDC<4,XPDDO^XTRCMP(XPDA):XPDC=4,EN^XPDCOMG:XPDC=1 ;rwf
22 Q
23 ;compare routines
24COMR(NL) ;NL=number of lines to check ahead
25 N DL,XL,XPDI,X,XL,Y,YL
26 S:'$G(NL) NL=5 S XPDI=""
27 F S XPDI=$O(^XTMP("XPDI",XPDA,"RTN",XPDI)) Q:XPDI="" S X=$G(^(XPDI)) D
28 .I X W:X=1 !!,"DELETE Routine: ",XPDI,! Q
29 .S X=XPDI X ^%ZOSF("TEST") E W !!,"ADD Routine: ",XPDI,! Q
30 .W !!," Routine: ",XPDI
31 .;check 2nd line only
32 .I XPDC=2 D Q
33 ..S X=$G(^XTMP("XPDI",XPDA,"RTN",XPDI,2,0)),Y=$T(+2^@XPDI)
34 ..W !,"<TG> ",X,!,"<SYS>",Y Q:X=Y!(X'["**")
35 ..;check patch string
36 ..S X=$P(X,"**",2),XL=$L(X,","),Y=$P(Y,"**",2),YL=$L(Y,",")
37 ..Q:X=Y
38 ..;incoming has more patches than system, check for missing patches
39 ..I XL>YL W:$P(X,",",1,(XL-1))'=Y !,"*** WARNING, you are missing one or more Patches ***" Q
40 ..I YL>XL W !,"*** WARNING, your routine has more patches than the incoming routine ***" Q
41 .F %=1:1 Q:'$D(^XTMP("XPDI",XPDA,"RTN",XPDI,%))
42 .;XL=lines in routine in XTMP, DL=line in routine on disk
43 .S XL=%-1,DL=$$LD(XPDI)
44 .D COMP K ^TMP($J,XPDI)
45 Q
46COMP ;taken from XMPC routine
47 N D1,DI,I,J,K,X1,XI,Y1
48 S (XI,DI)=0
49 ;check each line in the incoming routine,X1, against the routine on disk,D1
50 F S XI=XI+1,DI=DI+1 Q:XI>XL!(DI>DL) D:^XTMP("XPDI",XPDA,"RTN",XPDI,XI,0)'=^TMP($J,XPDI,DI,0)
51 .S X1=^XTMP("XPDI",XPDA,"RTN",XPDI,XI,0),Y1=0
52 .;if lines are not the same, look ahead five lines in D1
53 .F I=DI:1:$S(DI+NL<DL:DI+NL,1:DL) S D1=^TMP($J,XPDI,I,0) D Q:Y1
54 ..F K=1:5:26 Q:$L($E(D1,K,K+10))<7 I $F(X1,$E(D1,K,K+10)) D Q
55 ...;print the lines upto the line that are the same
56 ...F J=DI:1:I-1 D WP(^TMP($J,XPDI,J,0),2)
57 ...;quit if the lines are equal
58 ...S DI=I,Y1=1 Q:D1=X1
59 ...;if lines are equal, print old and new
60 ...D WP(D1,3),WP(X1,4)
61 .Q:Y1 D WP(X1,1) S DI=DI-1
62 ;check remaining lines in routines
63 I XI>XL&(DI<(DL+1)) F I=DI:1:DL D WP(^TMP($J,XPDI,I,0),2)
64 I DI>DL&(XI<(XL+1)) F I=XI:1:XL D WP(^XTMP("XPDI",XPDA,"RTN",XPDI,I,0),1)
65 Q
66WP(X,Y) W !,"* "_$P("ADD^DEL^OLD^NEW",U,Y)_" * ",X
67 Q
68 ;load system routine into TMP global
69LD(X) N %N,DIF,XCNP
70 K ^TMP($J,X)
71 S DIF="^TMP($J,X,",XCNP=0
72 X ^%ZOSF("LOAD")
73 Q XCNP-1
74 ;
75HDR S $P(XPDUL,"-",80)=""
76 W @IOF,"Compare ",XPDNM," to current site",!
77 I XPDC>1 W:XPDC=2 "2nd Line of " W "Routines Only",!
78 W XPDUL,!
79 Q
Note: See TracBrowser for help on using the repository browser.