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@ 628

XPDCOM ;SFISC/RSD - Compare Transport Global ;09/22/2005  574322.260552
 ;;8.0;KERNEL;**21,58,108,124,393**;Jul 10, 1995;Build 12
EN1 ;compare to current system
 N DIC,DIR,DIRUT,POP,XPD,XPDA,XPDC,XPDNM,XPDT,XPDST,Y,Z,%ZIS
 ;S DIC="^XPD(9.7,",DIC(0)="AEQMZ",DIC("S")="I '$P(^(0),U,9),$D(^XTMP(""XPDI"",Y))"
 ;D ^DIC Q:Y<0  S XPDA=+Y,XPDNM=Y(0,0)
 S XPDST=$$LOOK^XPDI1("I '$P(^(0),U,9),$D(^XTMP(""XPDI"",Y))",1) Q:XPDST'>0
 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
 D ^DIR Q:$D(DTOUT)!$D(DUOUT)
 S XPDC=Y,Y="JOB^XPDCOM",Z="Transport Global Compare",XPD("XPDNM")="",XPD("XPDC")="",XPD("XPDT(")=""
 D EN^XUTMDEVQ(Y,Z,.XPD)
 Q
JOB ;Loop thru XPDT
 N XPDIT
 F XPDIT=0:0 S XPDIT=$O(XPDT(XPDIT)) Q:XPDIT'>0  D COM(+XPDT(XPDIT))
 Q
 ;
COM(XPDA) ;XPDA=ien of package in ^XTMP("XPDI"
 Q:'$D(^XTMP("XPDI",$G(XPDA)))
 S:$D(XPDT("DA",XPDA)) XPDNM=$P(XPDT(+XPDT("DA",XPDA)),U,2)
 D HDR,COMR(5):XPDC<4,XPDDO^XTRCMP(XPDA):XPDC=4,EN^XPDCOMG:XPDC=1 ;rwf
 Q
 ;compare routines
COMR(NL) ;NL=number of lines to check ahead
 N DL,XL,XPDI,X,XL,Y,YL
 S:'$G(NL) NL=5 S XPDI=""
 F  S XPDI=$O(^XTMP("XPDI",XPDA,"RTN",XPDI)) Q:XPDI=""  S X=$G(^(XPDI)) D
 .I X W:X=1 !!,"DELETE Routine: ",XPDI,! Q
 .S X=XPDI X ^%ZOSF("TEST") E  W !!,"ADD Routine: ",XPDI,! Q
 .W !!," Routine: ",XPDI
 .;check 2nd line only
 .I XPDC=2 D  Q
 ..S X=$G(^XTMP("XPDI",XPDA,"RTN",XPDI,2,0)),Y=$T(+2^@XPDI)
 ..W !,"<TG> ",X,!,"<SYS>",Y Q:X=Y!(X'["**")
 ..;check patch string
 ..S X=$P(X,"**",2),XL=$L(X,","),Y=$P(Y,"**",2),YL=$L(Y,",")
 ..Q:X=Y
 ..;incoming has more patches than system, check for missing patches
 ..I XL>YL W:$P(X,",",1,(XL-1))'=Y !,"*** WARNING, you are missing one or more Patches ***" Q
 ..I YL>XL W !,"*** WARNING, your routine has more patches than the incoming routine ***" Q
 .F %=1:1 Q:'$D(^XTMP("XPDI",XPDA,"RTN",XPDI,%))
 .;XL=lines in routine in XTMP, DL=line in routine on disk
 .S XL=%-1,DL=$$LD(XPDI)
 .D COMP K ^TMP($J,XPDI)
 Q
COMP ;taken from XMPC routine
 N D1,DI,I,J,K,X1,XI,Y1
 S (XI,DI)=0
 ;check each line in the incoming routine,X1, against the routine on disk,D1
 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)
 .S X1=^XTMP("XPDI",XPDA,"RTN",XPDI,XI,0),Y1=0
 .;if lines are not the same, look ahead five lines in D1
 .F I=DI:1:$S(DI+NL<DL:DI+NL,1:DL) S D1=^TMP($J,XPDI,I,0) D  Q:Y1
 ..F K=1:5:26 Q:$L($E(D1,K,K+10))<7  I $F(X1,$E(D1,K,K+10))  D  Q
 ...;print the lines upto the line that are the same
 ...F J=DI:1:I-1 D WP(^TMP($J,XPDI,J,0),2)
 ...;quit if the lines are equal
 ...S DI=I,Y1=1 Q:D1=X1
 ...;if lines are equal, print old and new
 ...D WP(D1,3),WP(X1,4)
 .Q:Y1  D WP(X1,1) S DI=DI-1
 ;check remaining lines in routines
 I XI>XL&(DI<(DL+1)) F I=DI:1:DL D WP(^TMP($J,XPDI,I,0),2)
 I DI>DL&(XI<(XL+1)) F I=XI:1:XL D WP(^XTMP("XPDI",XPDA,"RTN",XPDI,I,0),1)
 Q
WP(X,Y) W !,"* "_$P("ADD^DEL^OLD^NEW",U,Y)_" *  ",X
 Q
 ;load system routine into TMP global
LD(X) N %N,DIF,XCNP
 K ^TMP($J,X)
 S DIF="^TMP($J,X,",XCNP=0
 X ^%ZOSF("LOAD")
 Q XCNP-1
 ;
HDR S $P(XPDUL,"-",80)=""
 W @IOF,"Compare ",XPDNM," to current site",!
 I XPDC>1 W:XPDC=2 "2nd Line of " W "Routines Only",!
 W XPDUL,!
 Q