Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTSUMBLD

XTSUMBLD.m

Go to the documentation of this file.
  1. XTSUMBLD ;SF/RWF - BUILD PACKAGE INTEG ROUTINE ; 3/21/06 2:50MP
  1. ;;7.3;TOOLKIT;**11,20,66,70,94,100**;Apr 25, 1995;Build 4
  1. A ;
  1. K ^UTILITY($J),DIR D MSG
  1. S DIR(0)="SM^P:Package;B:Build",DIR("A")="Build from" D ^DIR K DIR Q:X[U
  1. G PKG:Y="P",BUILD:Y="B" Q
  1. PKG W !!,"This will build a checksum routine for a package from the package file",!
  1. S DIC=9.4,DIC(0)="AEMQZ" D ^DIC G EXIT:Y'>0
  1. D NAME($P(Y(0),U,2)) G EXIT:'$D(XTRNAME)
  1. X ^%ZOSF("RSEL") G EXIT:$O(^UTILITY($J,""))=""
  1. G BLD
  1. ;
  1. BUILD W !!,"This will build a checksum routine from the BUILD file."
  1. S DIC="^XPD(9.6,",DIC(0)="AEMQZ" D ^DIC G EXIT:Y'>0 S BLDA=+Y
  1. I $P(Y(0),U,2)'>0 W !!,"There isn't a package file pointer." G EXIT
  1. S X=$P(^DIC(9.4,+$P(Y(0),U,2),0),U,2) D NAME(X) G EXIT:'$D(XTRNAME)
  1. F IX=0:0 S IX=$O(^XPD(9.6,BLDA,"KRN",9.8,"NM",IX)) Q:IX'>0 S X=^(IX,0) S:'$P(X,U,3) ^UTILITY($J,$P(X,U))=""
  1. F IX="INI","INIT","PRE" S X=$G(^XPD(9.6,BLDA,IX)) I X]"" S ^UTILITY($J,$S(X[U:$P(X,U,2),1:X))=""
  1. G EXIT:$O(^UTILITY($J,""))=""
  1. G BLD
  1. ;
  1. NAME(Y) S XTRNAME=Y_"NTEG" W !,"I will create a routine ",XTRNAME
  1. S X=XTRNAME X ^%ZOSF("TEST") I $T S DIR(0)="YA",DIR("A")="But you already have one on file! OK to replace? ",DIR("B")="NO" D ^DIR I Y'=1 K XTRNAME
  1. Q
  1. ;
  1. BLD S X=XTRNAME F I=0:0 K ^UTILITY($J,X) S X=$O(^UTILITY($J,X)) Q:X'[XTRNAME
  1. I $O(^UTILITY($J,""))="" W !,"Routine list is empty" G EXIT
  1. W !,"Calculating check-sums" S XTDT=$$NOW^XLFDT()
  1. S X=" " F I=0:0 S X=$O(^UTILITY($J,X)) Q:X="" D
  1. . W !,X X ^%ZOSF("TEST") I '$T W ?10,"Routine not in this UCI." Q
  1. . X ^%ZOSF("RSUM") S ^UTILITY($J,X)=Y Q
  1. W !,"Building routine" S RN=" ",XTRNCNT=0
  1. B K ^UTILITY($J,0) S XTSIZE=0,XCN=0,DIE="^UTILITY($J,0,",XTRNEXT=$E(XTRNAME,1,7)_XTRNCNT,XTRNCNT=XTRNCNT+1
  1. F I=1:1 S XT=$P($T(ROU+I),";;",2,99) D ADD Q:$E(XT,1,3)="ROU"
  1. S @(DIE_"1,0)")=XTRNAME_$P($T(ROU+1),";;",2)_XTDT,@(DIE_"3,0)")=" ;;"_$P($T(+2),";",3)_";"_XTDT
  1. F I=0:0 S RN=$O(^UTILITY($J,RN)) Q:RN="" S %=^(RN),XT=RN_" ;;"_% D ADD Q:XTSIZE>3700
  1. I RN]"" S @(DIE_"6,0)")=" G CONT^"_XTRNEXT
  1. S XCN=0,X=XTRNAME W !!,"Filing routine ",XTRNAME X ^%ZOSF("SAVE") S XTRNAME=XTRNEXT G:RN]"" B
  1. W !," DONE",!
  1. EXIT K ^UTILITY($J),DIC,DIR,XCN,XTRNAME,XTRNCNT,XU1,XTSIZE,XTDT,DIE,XTRNEXT,XT,X,Y
  1. Q
  1. ADD S XCN=XCN+1,XTSIZE=XTSIZE+$L(XT)+2,@(DIE_XCN_",0)")=XT Q
  1. Q
  1. CHECK ;Print the values of a set of routines.
  1. N XPCH,X,DIR D MSG
  1. S DIR(0)="SM^P:Package;B:Build",DIR("A")="Build from" D ^DIR K DIR Q:X[U
  1. G CHKPKG:Y="P",CHKBLD:Y="B" Q
  1. CHKPKG W !! K ^UTILITY($J) X ^%ZOSF("RSEL") I $O(^UTILITY($J,0))']"" W !!,"NO SELECTED ROUTINES" G EXIT
  1. CHK2 S X=" " F XU1=0:0 S X=$O(^UTILITY($J,X)) Q:X']"" D
  1. . W !,X,?10 X ^%ZOSF("TEST") I '$T W "Routine not in this UCI." Q
  1. . I $G(XUCHFLG)=1 X ^%ZOSF("RSUM1") W "value = ",Y
  1. . E X ^%ZOSF("RSUM") W "value = ",Y
  1. . I $D(XPCH) X XPCH
  1. . Q
  1. W !,"done" G EXIT
  1. CHKBLD W !!,"This will check the routines from a BUILD file."
  1. S DIC="^XPD(9.6,",DIC(0)="AEMQZ" D ^DIC G EXIT:Y'>0
  1. S BLDA=+Y,X=$P(Y,"^",2)
  1. I X["*" S XPCH="S L=$T(+2^@X) I $P(L,"";"",5)'?.E1P1"""_$P(X,"*",3)_"""1P.E W ?30,""Missing patch number"""
  1. F IX=0:0 S IX=$O(^XPD(9.6,BLDA,"KRN",9.8,"NM",IX)) Q:IX'>0 S X=^(IX,0) S:'$P(X,U,3) ^UTILITY($J,$P(X,U))=""
  1. F IX="INI","INIT","PRE" S X=$G(^XPD(9.6,BLDA,IX)) I X]"" S ^UTILITY($J,$S(X[U:$P(X,U,2),1:X))=""
  1. G EXIT:$O(^UTILITY($J,""))=""
  1. G CHK2
  1. ;
  1. MSG W !!,"This option determines the current checksum of selected routine(s)."
  1. W !,"The Checksum of the routine is determined as follows:",!
  1. W !,"1. Any comment line with a single semi-colon is presumed to be"
  1. W !," followed by comments and only the line tag will be included."
  1. W !!,"2. Line 2 will be excluded from the count.",!
  1. W !,"3. The total value of the routine is determined (excluding"
  1. W !," exceptions noted above) by multiplying the ASCII value of each"
  1. W !," character by its position on the line "
  1. I $G(XUCHFLG)=1 W "and position of the line in ",!," the routine "
  1. W "being checked."
  1. Q
  1. ;
  1. CHECK1 ;New CheckSum logic
  1. W !,"New CheckSum CHECK1^XTSUMBLD:"
  1. N XUCHFLG S XUCHFLG=1 D CHECK
  1. Q
  1. ;
  1. CHCKSUM ;
  1. W !,"This option determines the current Old (CHECK^XTSUMBLD) or New (CHECK1^XTSUMBLD) logic checksum of selected routine(s)."
  1. N OON
  1. S OON=$$ASKOON Q:OON<1 ;Return 1 or 2
  1. I OON=1 D CHECK
  1. I OON=2 D CHECK1
  1. Q
  1. ;
  1. ASKOON() ;
  1. ;Ask if user wants old/new checksum
  1. ;Return 1 or 2.
  1. N DIR,DIOUT
  1. S DIR(0)="S^1:Old;2:New",DIR("A")="New or Old Checksums",DIR("B")="New"
  1. D ^DIR
  1. I $D(DIRUT) S Y=-1
  1. Q Y
  1. ROU ;;
  1. ;; ;ISC/XTSUMBLD KERNEL - Package checksum checker ;
  1. ;; ;;0.0;
  1. ;; ;;7.3;10/1/94
  1. ;; S XT4="I 1",X=$T(+3) W !!,"Checksum routine created on ",$P(X,";",4)," by KERNEL V",$P(X,";",3),!
  1. ;;CONT F XT1=1:1 S XT2=$T(ROU+XT1) Q:XT2="" S X=$P(XT2," ",1),XT3=$P(XT2,";",3) X XT4 I $T W !,X X ^%ZOSF("TEST") S:'$T XT3=0 X:XT3 ^%ZOSF("RSUM") W ?10,$S('XT3:"Routine not in UCI",XT3'=Y:"Calculated "_$C(7)_Y_", off by "_(Y-XT3),1:"ok")
  1. ;; ;
  1. ;; K %1,%2,%3,X,Y,XT1,XT2,XT3,XT4 Q
  1. ;;ONE S XT4="I $D(^UTILITY($J,X))",X=$T(+3) W !!,"Checksum routine created on ",$P(X,";",4)," by KERNEL V",$P(X,";",3),!
  1. ;; W !,"Check a subset of routines:" K ^UTILITY($J) X ^%ZOSF("RSEL")
  1. ;; W ! G CONT
  1. ;;ROU ;;