1 | XPDZVER ;FGO/JHS;Revised Verify Checksums ; 11-09-98 [5/18/99 2:28pm]
|
---|
2 | ;;8.0;KERNEL;**L33**;Jul 10, 1995
|
---|
3 | EN1 ;print from Transport Global
|
---|
4 | N D0,DIC,X,XPD,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 D0=+Y,XPD("D0")="",X="XUTMDEVQ"
|
---|
8 | ;during Virgin install, XUTMDEVQ might not exists
|
---|
9 | X ^%ZOSF("TEST") E D Q
|
---|
10 | .S IOSL=99999,IOM=80,IOF="#",IOST="",$Y=0 D PNT(9.7)
|
---|
11 | S Y="PNT^XPDZVER(9.7)",Z="Checksum Print"
|
---|
12 | ENBAT S AAQFILE="Transport Global",AAQGLOB="^XTMP(""XPDI"")",AAQHDR=0 W ! D @Y
|
---|
13 | G EXIT
|
---|
14 | PNT(XPDFIL) ;print
|
---|
15 | N XPD0,XPDC,XPDDT,XPDE,XPDI,XPDJ,XPDPG,XPDQ,XPDUL,X
|
---|
16 | Q:'$D(^XPD(XPDFIL,D0,0)) S XPD0=^(0),XPDPG=1,$P(XPDUL,"-",IOM)="",XPDDT=$$HTE^XLFDT($H,"1M")
|
---|
17 | D HDR
|
---|
18 | S XPDI="",(XPDQ,XPDE)=0
|
---|
19 | ;XPDFIL=9.7 use transport global exists
|
---|
20 | I XPDFIL=9.7 D
|
---|
21 | .I '$D(^XTMP("XPDI",D0)) W !!," ** Transport Global doesn't exist **" S XPDQ=1 Q
|
---|
22 | .;check for missing nodes in transport global
|
---|
23 | .I '$D(^XTMP("XPDI",D0,"BLD"))="" W !!," **Transport Global corrupted, please reload **" S XPDQ=1 Q
|
---|
24 | .F XPDC=0:1 S XPDI=$O(^XTMP("XPDI",D0,"RTN",XPDI)) Q:XPDI="" S XPDJ=$G(^(XPDI)) D Q:XPDQ
|
---|
25 | ..I XPDJ="" W !," **Transport Global corrupted, please reload **" S XPDQ=1 Q
|
---|
26 | ..;if deleting at site, there is no checksum
|
---|
27 | ..I +XPDJ=1 S XPDC=XPDC-1 Q
|
---|
28 | ..D SUM(XPDI,$NA(^XTMP("XPDI",D0,"RTN",XPDI)),$P(XPDJ,U,3))
|
---|
29 | ..S XPDQ=$$CHK(4)
|
---|
30 | Q:XPDQ
|
---|
31 | W !!?3,XPDC," Routine checked, ",XPDE," failed.",!
|
---|
32 | Q
|
---|
33 | SUM(XPDR,Z,XPD) ;check checksum
|
---|
34 | N Y
|
---|
35 | ;first char. is the sum tag used in XPDRSUM
|
---|
36 | I XPD'?1U1.N W !,XPDR,?10,"ERROR in Checksum" S XPDE=XPDE+1 Q
|
---|
37 | S @("Y=$$SUM"_$E(XPD)_"^XPDRSUM(Z)"),XPD=$E(XPD,2,255)
|
---|
38 | I Y'=XPD W !,XPDR,?10,"Calculated "_$C(7)_Y_", should be "_XPD S XPDE=XPDE+1
|
---|
39 | Q
|
---|
40 | CHK(Y) ;Y=excess lines, return 1 to exit
|
---|
41 | Q:$Y<(IOSL-Y) 0
|
---|
42 | I $E(IOST,1,2)="C-" D Q:'Y 1
|
---|
43 | .N DIR,I,J,K,X
|
---|
44 | Q 0
|
---|
45 | HDR W !,"PACKAGE: ",$P(XPD0,U)," ",AAQUCI_" "_XPDDT,?69,"PAGE ",XPDPG,!,$E(XPDUL,1,75)
|
---|
46 | Q
|
---|
47 | EXIT K %,AAQFILE,AAQGLOB,AAQHDR,AAQUCI,C
|
---|
48 | Q
|
---|