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/XPDZCHK.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1XPDZCHK ;FGO/JHS;Transport/Build Checksums ; 11-07-98 [4/13/00 4:39pm]
2 ;;8.0;KERNEL;**L33**;Jul 10, 1995
3 D UCI^%ZOSV S AAQUCI=$P(Y,",",1) K Y S AAQDT=$$HTE^XLFDT($H,"1M") D HOME^%ZIS
4ASKCHK R !!,"Do you want checksums for (T)ransport Global Pre-Install values,",!,?23,"or (B)uild File Post-Install values?: ",AAQCHK:60 G:AAQCHK="^" EXIT
5 I AAQCHK?1L.E S AAQCHK=$$UP^XLFSTR(AAQCHK)
6 I $E(AAQCHK,1)'="T",$E(AAQCHK,1)'="B" W $C(7),!!,"Enter uppercase T or B, `^' to quit." G ASKCHK
7 G:AAQCHK="B" BLD
8TRN ;print from Transport Global
9 N D0,DIC,X,XPD,Y,Z W !
10 I $D(AAQP) S DIC("B")=AAQP ;used only by XPDZPAT
11 S DIC="^XPD(9.7,",DIC(0)="AEQMZ",DIC("S")="I $D(^XTMP(""XPDI"",Y))"
12 D ^DIC Q:Y<0
13 S D0=+Y,XPD("D0")="",X="XUTMDEVQ",AAQD0=D0,AAQPAT=$P(Y,U,2)
14 ;during Virgin install, XUTMDEVQ might not exists
15 X ^%ZOSF("TEST") E D Q
16 .S IOSL=99999,IOM=80,IOF="#",IOST="",$Y=0 D PNT(9.7)
17 S Y="PNT^XPDZCHK(9.7)",Z="Checksum Print"
18ASKTRN W !!,"Default 'NO' will list checksums for routines on the system."
19 S %=2 W !,"Do you want to also list Transport Global RSUM Values" D YN^DICN G:%=1 TPRT
20 I %=0 W !!,"Enter 'Y' to list Transport Global information,",!,"Enter 'N' or Press Return to list Routine information only." G ASKTRN
21 G:%=-1 EXIT G:%=2 PRE
22TPRT S AAQFILE="Transport Global",AAQGLOB="^XTMP(""XPDI"")",AAQHDR=0 W ! D @Y
23PRE S X=$$NOW^XLFDT,AAQDT=$$FMTE^XLFDT(X) W !!,"Pre-Install Values from Transport Global "_AAQUCI_" Routines "_AAQDT,!!,"Routine",?10,"Checksum",?22,"2nd Line Patches",!
24 S (XPDC,XPDI,XPDQ)=0
25 F XPDC=0:1 S XPDI=$O(^XTMP("XPDI",AAQD0,"RTN",XPDI)) Q:XPDI="" S XPDJ=$G(^(XPDI)) D Q:XPDQ
26 .I XPDJ="" W !," **Transport Global corrupted, please reload **" S XPDQ=1 Q
27 .S ^UTILITY($J,XPDI)=""
28 G EXIT:$O(^UTILITY($J,""))=""
29 S RN="" F S RN=$O(^UTILITY($J,RN)) G:RN="" EXIT D
30 . S X=RN X ^%ZOSF("TEST") E W !,RN," is not on the system." Q
31 . S X=RN,XCNP=0,DIF="RTN(" K RTN X ^%ZOSF("LOAD") S LC=XCNP-1
32 . D RSUM S Y=$O(^DIC(9.8,"B",RN,0)) Q:Y'>0
33 . S X=RTN(2,0) W !,RN,?10,$J(RSUM,8),?22,$P(X,";",5)
34 . Q
35 Q
36RSUM N Y,Y2,%,%1,%2,%3 S (Y,Y2)=0
37 F %=1,3:1:LC S %1=RTN(%,0),%3=$F(%1," "),%3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y,Y2=$A(%1,%2)*(%2+%)+Y2
38 S RSUM=Y,RSUM2=Y2
39 Q
40BLD ;print from Build File
41 N D0,DIC,X,XPD,Y,Z W !
42 S DIC="^XPD(9.6,",DIC(0)="AEQMZ"
43 D ^DIC Q:Y<0
44 S D0=+Y
45ENBLD D UCI^%ZOSV S AAQUCI=$P(Y,",",1),AAQDT=$$HTE^XLFDT($H,"1M") D HOME^%ZIS S AAQD0=D0
46 S Y="PNT^XPDZCHK(9.6)",Z="Checksum Print",XPD("D0")="",XPDI=0
47ASKBLD W !!,"Default 'NO' will list checksums for routines on the system."
48 S %=2 W !,"Do you want to also list Build File RSUM Values" D YN^DICN G:%=1 BPRT
49 I %=0 W !!,"Enter 'Y' to list Build File information,",!,"Enter 'N' or Press Return to list Routine information only." G ASKBLD
50 G:%=2 POST G:%=-1 EXIT
51BPRT S AAQFILE="Build File",AAQGLOB="^XPD(9.6)",AAQHDR=0 W ! D @Y
52POST S BLDA=D0 D CALL^XTZRUTL
53 G EXIT
54PNT(XPDFIL) ;print
55 N XPD0,XPDC,XPDE,XPDI,XPDJ,XPDQ,XPDUL,X
56 Q:'$D(^XPD(XPDFIL,D0,0)) S XPD0=^(0),$P(XPDUL,"-",IOM-4)=""
57 S X=$$NOW^XLFDT,AAQDT=$$FMTE^XLFDT(X) D HDR W !
58 S XPDI="",(XPDQ,XPDE)=0
59 I XPDFIL=9.7 S D0=0,D0=$O(^XPD(9.7,"B",AAQPAT,D0)) D
60 .I '$D(^XTMP("XPDI",AAQD0)) W !!," ** Transport Global doesn't exist **" S XPDQ=1 Q
61 .;check for missing nodes in transport global
62 .I '$D(^XTMP("XPDI",AAQD0,"BLD"))="" W !!," **Transport Global corrupted, please reload **" S XPDQ=1 Q
63 .F XPDC=0:1 S XPDI=$O(^XTMP("XPDI",AAQD0,"RTN",XPDI)) Q:XPDI="" S XPDJ=$G(^(XPDI)) D Q:XPDQ
64 ..I XPDJ="" W !," **Transport Global corrupted, please reload **" S XPDQ=1 Q
65 ..;if deleting at site, there is no checksum
66 ..I +XPDJ=1 S XPDC=XPDC-1 Q
67 ..;list Routine, RSUM, and second line from Transport Global
68 ..W !,XPDI,?10,$P(XPDJ,U,3),?22,"**"_$P(^XTMP("XPDI",AAQD0,"RTN",XPDI,2,0),"**",2)_"**"
69 ..S XPDQ=$$CHK(4)
70 ;check build file
71 E D
72 .F XPDC=0:1 S XPDI=$O(^XPD(9.6,AAQD0,"KRN",9.8,"NM","B",XPDI)) Q:XPDI="" S XPDJ=$O(^(XPDI,0)) D Q:XPDQ
73 ..Q:'$D(^XPD(9.6,AAQD0,"KRN",9.8,"NM",+XPDJ,0)) S XPDJ=$P(^(0),U,4)
74 ..;quit if no checksum, routine wasn't loaded
75 ..I XPDJ="" S XPDC=XPDC-1 Q
76 ..N DIF,XCNP,%N
77 ..S X=XPDI,DIF="^TMP($J,""RTN"",XPDI,",XCNP=0
78 ..X ^%ZOSF("TEST") E W !,XPDI,?10,"Doesn't Exist" Q
79 ..;list Routine and RSUM from Build File
80 ..W !,XPDI,?10,XPDJ
81 ..S XPDQ=$$CHK(4)
82 Q
83CHK(Y) ;Y=excess lines, return 1 to exit
84 Q:$Y<(IOSL-Y) 0
85 I $E(IOST,1,2)="C-" D Q:'Y 1
86 .N DIR,I,J,K,X
87 Q 0
88HDR W:AAQHDR=0 !,AAQFILE_" Checksums: ",$P(XPD0,U),?57,AAQDT,!,$E(XPDUL,1,75),! S AAQHDR=AAQHDR+1
89 W !,AAQFILE," ",AAQGLOB," Entry #",D0
90 W !!,"Routine",?10,"RSUM Values" W:AAQFILE["Transport" ?22,"2nd Line Patches"
91 Q
92EXIT K %N,%Y,AAQCHK,AAQFILE,AAQGLOB,AAQHDR,AAQLOC,AAQUCI,BLDA,C,DIF,LC,RN,RSUM,RSUM2,RTN,X,XCNP,XPDC,XPDI,XPDJ,XPDQ,Y,Z,^UTILITY($J) D ^%ZISC
93 ;AAQD0, AAQP, and AAQPAT are used by XPDZPAT and killed at EXIT.
94 ;When running this routine from [XPDZ CHECKSUMS/2ND LINE] option,
95 ;these variables are killed in the menu option Exit Action.
96 Q
Note: See TracBrowser for help on using the repository browser.