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/XPDZVER.m@ 824

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1XPDZVER ;FGO/JHS;Revised Verify Checksums ; 11-09-98 [5/18/99 2:28pm]
2 ;;8.0;KERNEL;**L33**;Jul 10, 1995
3EN1 ;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"
12ENBAT S AAQFILE="Transport Global",AAQGLOB="^XTMP(""XPDI"")",AAQHDR=0 W ! D @Y
13 G EXIT
14PNT(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
33SUM(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
40CHK(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
45HDR W !,"PACKAGE: ",$P(XPD0,U)," ",AAQUCI_" "_XPDDT,?69,"PAGE ",XPDPG,!,$E(XPDUL,1,75)
46 Q
47EXIT K %,AAQFILE,AAQGLOB,AAQHDR,AAQUCI,C
48 Q
Note: See TracBrowser for help on using the repository browser.