source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDDCS.m@ 623

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1XPDDCS ;SFISC/RSD - Display Checksum for a package ;06/05/2006
2 ;;8.0;KERNEL;**2,44,108,202,393**;Jul 10, 1995;Build 12
3EN1 ;Verify checksums in Transport Global
4 N D0,DIC,X,XPD,XPDS,XPDST,XPDT,Y,Z
5 ;S DIC="^XPD(9.7,",DIC(0)="AEQMZ",DIC("S")="I $D(^XTMP(""XPDI"",Y))"
6 ;D ^DIC Q:Y<0
7 S XPDS="I $D(^XTMP(""XPDI"",Y))"
8 S XPDST=$$LOOK^XPDI1(XPDS) Q:XPDST'>0
9 S XPDSHW=$$ASK Q:$D(DIRUT)
10 S XPD("XPDT(")="",XPD("XPDST")="",XPD("XPDSHW")="",X="XUTMDEVQ"
11 ;during Virgin install, XUTMDEVQ might not exists
12 X ^%ZOSF("TEST") E D Q
13 .S IOSL=99999,IOM=80,IOF="#",IOST="",$Y=0 D LST1(9.7)
14 S Y="LST1^XPDDCS(9.7)",Z="Checksum Print"
15 ;p345-rename AND* to XPD*
16 I '$G(XPDAUTO) D EN^XUTMDEVQ(Y,Z,.XPD)
17 I $G(XPDAUTO) S IO=XPDDEV U XPDDEV D LST1^XPDDCS(9.7)
18 Q
19 ;
20ASK() ;Ask if want each routine listed
21 N DIR
22 I $D(XPDAUTO) Q 1
23 S DIR(0)="YAO",DIR("A")="Want each Routine Listed with Checksums: ",DIR("A",1)="",DIR("B")="Yes"
24 D ^DIR
25 Q Y
26 ;
27EN2 ;print from build (system)
28 N D0,DIC,XPD,XPDT,XPDST,Y,Z
29 ;S DIC="^XPD(9.6,",DIC(0)="AEQMZ"
30 ;D ^DIC Q:Y<0
31 S XPDST=$$LOOK^XPDB1() Q:XPDST'>0
32 S XPDSHW=$$ASK Q:$D(DIRUT)
33 S XPD("XPDT(")="",XPD("XPDSHW")="",Y="LST1^XPDDCS(9.6)",Z="Checksum Print"
34 ;p345-rename AND* to XPD*
35 I '$G(XPDAUTO) D EN^XUTMDEVQ(Y,Z,.XPD)
36 I $G(XPDAUTO) S:'$D(XPDDEV) XPDDEV=0 U XPDDEV D LST1^XPDDCS(9.6)
37 Q
38 ;
39LST1(FILE) ;Print group
40 N XPDI S XPDI=0
41 F S XPDI=$O(XPDT(XPDI)) Q:XPDI'>0 S D0=+XPDT(XPDI) D PNT(FILE)
42 Q
43 ;
44PNT(XPDFIL) ;print
45 N XPD0,XPDC,XPDDT,XPDE,XPDI,XPDJ,XPDPG,XPDQ,XPDUL,X
46 Q:'$D(^XPD(XPDFIL,D0,0)) S XPD0=^(0),XPDPG=1,$P(XPDUL,"-",IOM)="",XPDDT=$$HTE^XLFDT($H,"1PM")
47 W:$E(IOST,1,2)="C-" @IOF D HDR
48 W !
49 S XPDI="",(XPDQ,XPDE)=0
50 ;XPDFIL=9.7 use transport global exists
51 I XPDFIL=9.7 D
52 .I '$D(^XTMP("XPDI",D0)) W !!," ** Transport Global doesn't exist **" S XPDQ=1 Q
53 .;check for missing nodes in transport global
54 .I '$D(^XTMP("XPDI",D0,"BLD"))="" W !!," **Transport Global corrupted, please reload **" S XPDQ=1 Q
55 .F XPDC=0:1 S XPDI=$O(^XTMP("XPDI",D0,"RTN",XPDI)) Q:XPDI="" S XPDJ=$G(^(XPDI)) D Q:XPDQ
56 ..I XPDJ="" W !," **Transport Global corrupted, please reload **" S XPDQ=1 Q
57 ..;if deleting at site, there is no checksum
58 ..I +XPDJ=1 S XPDC=XPDC-1 Q
59 ..D SUM(XPDI,$NA(^XTMP("XPDI",D0,"RTN",XPDI)),$P(XPDJ,U,3),$P(XPDJ,U,4))
60 ..S XPDQ=$$CHK(4)
61 ;check build file
62 E D
63 .F XPDC=0:1 S XPDI=$O(^XPD(9.6,D0,"KRN",9.8,"NM","B",XPDI)) Q:XPDI="" S XPDJ=$O(^(XPDI,0)) D Q:XPDQ
64 ..Q:'$D(^XPD(9.6,D0,"KRN",9.8,"NM",+XPDJ,0)) S XPDJ=$P(^(0),U,4)
65 ..;quit if no checksum, routine wasn't loaded
66 ..I XPDJ="" S XPDC=XPDC-1 Q
67 ..N DIF,XCNP,%N
68 ..S X=XPDI,DIF="^TMP($J,""RTN"",XPDI,",XCNP=0
69 ..X ^%ZOSF("TEST") E W !,XPDI,?10,"Doesn't Exist" Q
70 ..X ^%ZOSF("LOAD")
71 ..D SUM(XPDI,$NA(^TMP($J,"RTN",XPDI)),XPDJ,"")
72 ..S XPDQ=$$CHK(4)
73 Q:XPDQ
74 W !!?3,XPDC," Routine"_$S(XPDC>1:"s",1:"")_" checked, ",XPDE," failed.",!
75 ;p345-rename AND* to XPD*
76 I $G(XPDAUTO) S XPDCHKSM=XPDE
77 Q
78 ;
79 ;XPDR=routine name, Z=global root, XPD=check sum, XPDBS=before Checksum from FORUM
80SUM(XPDR,Z,XPD,XPDBS) ;check checksum
81 N Y
82 ;See if we have a before checksum and compare.
83 I $L(XPDBS) D BEFORE(XPDR,XPDBS)
84 ;first char. is the sum tag used in XPDRSUM
85 I XPD'?1U1.N W !,XPDR,?10,"ERROR in Checksum" S XPDE=XPDE+1 Q
86 S @("Y=$$SUM"_$E(XPD)_"^XPDRSUM(Z)"),XPD=$E(XPD,2,255)
87 I Y=XPD,XPDSHW W !,XPDR,?10,"Calculated "_$J(XPD,10)
88 I Y'=XPD W !,XPDR,?10,"Calculated "_$C(7)_$J(Y,10)_", expected value "_XPD S XPDE=XPDE+1
89 Q
90 ;
91BEFORE(RN,SUM) ;Check a before Checksum
92 N DIF,XCNP,%N,X
93 I SUM'?1U1.N Q
94 S X=RN,DIF="^TMP($J,""XPDDCS"",RN,",XCNP=0
95 X ^%ZOSF("TEST") E W !,RN,?10,"Not on current system." Q
96 X ^%ZOSF("LOAD")
97 S DIF=$NA(^TMP($J,"XPDDCS",RN))
98 S @("Y=$$SUM"_$E(SUM)_"^XPDRSUM(DIF)"),SUM=$E(SUM,2,255)
99 I Y'=SUM W !,RN,?10,"Before Checksum Calculated "_Y_" expected value "_SUM
100 Q
101 ;
102CHK(Y) ;Y=excess lines, return 1 to exit
103 Q:$Y<(IOSL-Y) 0
104 I $E(IOST,1,2)="C-" D Q:'Y 1
105 .N DIR,I,J,K,X
106 .S DIR(0)="E" D ^DIR
107 S XPDPG=XPDPG+1
108 W @IOF D HDR
109 Q 0
110 ;
111HDR W !,"PACKAGE: ",$P(XPD0,U)," ",XPDDT,?70,"PAGE ",XPDPG,!,XPDUL,!
112 Q
Note: See TracBrowser for help on using the repository browser.